印刷で波線を引くには (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;

←解決時は質問者本人がここをチェックしてください。

戻る