印刷で波線を引くには (ID:9957)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 波線は無いので、円弧か直線を連続して描くしかないと思います。 サンプルを作ってみましたが、画面に表示する場合は繋ぎ目が途切れる場合があります プリンターのCanvasに出力する場合は解像度が高いので きれいに表示されると思います（未確認） （Form1.CanvasをPrinter.Canvasに置き換えれば印刷できます） procedure TForm1.Button1Click(Sender: TObject); begin WebLine(50,50,300,100,30); end; procedure TForm1.WebLine(xs,ys,xe,ye,pit:integer); var LL,Xpit,Ypit:single; Q:single; N,i:integer; H,cx,cy,R:single; pxs,pxe,pys,pye:integer; const Hei=1; begin LL:=GetLong(xs,ys,xe,ye); //2点の距離 N:=round(LL/pit); //個数 Xpit:=(xe-xs)/N; //Xのピッチ Ypit:=(ye-ys)/N; //Yのピッチ Q:=GetAngle(xe,ye,xs,ys)+pi/2; //傾き H:=GetLong(xs,ys,xs+Xpit/2,ys+Ypit/2)*Hei; //波高さの係数 R:=sqrt(sqr(GetLong(xs,ys,xs+Xpit/2,ys+Ypit/2))+sqr(H)); //円弧の半径 for i:=0 to N do begin pxs:=trunc(xs+Xpit*i); pys:=trunc(ys+Ypit*i); pxe:=trunc(xs+Xpit*(i+1)); pye:=trunc(ys+Ypit*(i+1)); if Odd(i) then begin cx:=pxs+Xpit/2+Cos(Q)*H; cy:=pys+Ypit/2+Sin(Q)*H; Form1.Canvas.Arc(trunc(cx-R),trunc(cy-R),trunc(cx+R),trunc(cy+R),pxe,pye,pxs,pys); end else begin cx:=pxs+Xpit/2+Cos(Q+pi)*H; cy:=pys+Ypit/2+Sin(Q+pi)*H; Form1.Canvas.Arc(trunc(cx-R),trunc(cy-R),trunc(cx+R),trunc(cy+R),pxs,pys,pxe,pye); end; end; end; function TForm1.GetLong(x1,y1,x2,y2:single):single; var x,y:double; begin x:=abs(x1-x2); y:=abs(y1-y2); Result:=sqrt(sqr(X)+sqr(Y)); end; function TForm1.GetAngle(x1,y1,x2,y2:single):single;//X2、Y2 は中心点 begin if (x1>x2)and(y1=y2) then Result:=0 else if (x1=x2)and(y1>y2) then Result:=pi/2 else if (x1<x2)and(y1=y2) then Result:=pi else if (x1=x2)and(y1<y2) then Result:=pi/180*270 else IF (x1>x2)and(y1>y2) THEN Result:=arctan((y1-y2)/(x1-x2)) else IF (x1<x2)and(y1>y2) THEN Result:=pi-arctan((y1-y2)/(x2-x1)) else IF (x1<x2)and(y1<y2) THEN Result:=arctan((y2-y1)/(x2-x1))+pi else IF (x1>x2)and(y1<y2) THEN Result:=pi*2-arctan((y2-y1)/(x1-x2)) else Result:=0; end;