如何在delphi 中畫帶箭頭的直線(改自網上一位論壇版主的vb代碼)

procedure TLineItem.Draw(aCanvas: TCanvas);

var

  Xa, Ya, Xb, Yb: real;

  D: real;

  X1, Y1, X0, Y0: Integer;

begin

  aCanvas.Pen.Style := PsSolid;

  aCanvas.Pen.Color := clWhite;

//畫直線

  aCanvas.MoveTo(PtStart.X, PtStart.Y);

  aCanvas.LineTo(PtEnd.X, PtEnd.Y);

  //畫箭頭

  X0 := PtStart.X;//PtStart是箭頭的起點,PtEnd是終點,都是Tpoint

  Y0 := PtStart.Y;

  X1 := PtEnd.X;

  Y1 := PtEnd.Y;

  D := Sqrt((Y1 - Y0) * (Y1 - Y0) + (X1 - X0) * (X1 - X0));

  if D > 0 then begin

    Xa := X1 + ARROWLEN * ((X0 - X1) + (Y0 - Y1) / 2) / D;

    Ya := Y1 + ARROWLEN * ((Y0 - Y1) - (X0 - X1) / 2) / D;

    Xb := X1 + ARROWLEN * ((X0 - X1) - (Y0 - Y1) / 2) / D;

    Yb := Y1 + ARROWLEN * ((Y0 - Y1) + (X0 - X1) / 2) / D;

    aCanvas.MoveTo(PtEnd.X, PtEnd.Y);

    aCanvas.LineTo(Trunc(Xa), Trunc(Ya));

    aCanvas.MoveTo(PtEnd.X, PtEnd.Y);

    aCanvas.LineTo(Trunc(Xb), Trunc(Yb));

  end;

//如果選中畫出焦點矩形,可以不要

  if FSelected = true then begin

    aCanvas.Rectangle((PtStart.X - FORCUSRANGE),

      (PtStart.Y - FORCUSRANGE),

      (PtStart.X + FORCUSRANGE),

      (PtStart.Y + FORCUSRANGE));

    aCanvas.Rectangle((PtEnd.X - FORCUSRANGE),

      (PtEnd.Y - FORCUSRANGE),

      (PtEnd.X + FORCUSRANGE),

      (PtEnd.Y + FORCUSRANGE));

  end;

end;

 <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />

canvas是任何一個擁有畫筆的組件的canvas都可以。具體幾何依據原作者沒有講。但是經過底下驗算。有三個特點。

1.       箭頭兩翼端點連線和直線垂直(斜率之積等於-1)。

2.       .箭頭兩翼長度相同。(等腰三角形)

3.       箭頭兩翼長度和兩翼端點間的距離比值一定。(決定了夾角)

 

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章