如何在delphi 中画带箭头的直线(改自网上一位论坛版主的vb代码)

王朝delphi·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

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;

canvas是任何一个拥有画笔的组件的canvas都可以。具体几何依据原作者没有讲。但是经过底下验算。有三个特点。

1. 箭头两翼端点连线和直线垂直(斜率之积等于-1)。

2. .箭头两翼长度相同。(等腰三角形)

3. 箭头两翼长度和两翼端点间的距离比值一定。(决定了夹角)

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航