如何画出带箭头的线? ( 积分: 50 )

  • 主题发起人 主题发起人 bbcock
  • 开始时间 开始时间
B

bbcock

Unregistered / Unconfirmed
GUEST, unregistred user!
如何画出带箭头的线?类似——〉这样,怎么算出任意方向线段一头,那两个小线段的坐标?
 
如何画出带箭头的线?类似——〉这样,怎么算出任意方向线段一头,那两个小线段的坐标?
 
LineTo画出来呀
 
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
const
Penwidth = 5;//画笔的粗细
Len = 20;//箭头线的长度
{说明:这两个常量应该一起变化,具体值由效果来定。
当Penwidth很小时,显示的效果不是太好}
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormMouseUp(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
procedure FormMouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
procedure FormMouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
xs, ys: integer;//画线开始处的坐标
xt, yt: integer;//记录鼠标前一时刻的坐标
xl, yl: integer;//记录第一条箭头线的端点坐标
xr, yr: integer;//记录第二条箭头线的端点坐标
b: boolean;//判断是否已经开始画线
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
//Form1.Color := clWhite;
xt := -1;
yt := -1;
xl := -1;
yl := -1;
xr := -1;
yr := -1;
end;

procedure TForm1.FormMouseUp(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
begin
b := False;
end;

procedure TForm1.FormMouseDown(Sender: TObject;
Button: TMouseButton;
Shift: TShiftState;
X, Y: Integer);
begin
xs := x;
ys := y;
xt := x;
yt := y;
xl := -1;
yl := -1;
xr := -1;
yr := -1;
b := True;
end;

procedure TForm1.FormMouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
begin
if b then
begin
Form1.Canvas.Pen.Mode := pmNotXor;
Form1.Canvas.Pen.Color := clRed;
Form1.Canvas.Pen.Width := PenWidth;
Form1.Canvas.MoveTo(xs, ys);
Form1.Canvas.LineTo(xt, yt);
Form1.Canvas.MoveTo(xs, ys);
Form1.Canvas.LineTo(x, y);
if xl <> -1 then
begin
Form1.Canvas.MoveTo(xt, yt);
Form1.Canvas.LineTo(xl, yl);
Form1.Canvas.MoveTo(xt, yt);
Form1.Canvas.LineTo(xr, yr);
end;
xt := x;
yt := y;
if x > xs then
begin
xl := trunc(x + Len * Cos(pi - ArcTan((y - ys) / (x - xs)) + Pi / 6));
yl := trunc(y - Len * Sin(pi - ArcTan((y - ys) / (x - xs)) + Pi / 6));
xr := trunc(x + Len * Cos(pi - ArcTan((y - ys) / (x - xs)) - Pi / 6));
yr := trunc(y - Len * Sin(pi - ArcTan((y - ys) / (x - xs)) - Pi / 6));
Form1.Canvas.MoveTo(x, y);
Form1.Canvas.LineTo(xl, yl);
Form1.Canvas.MoveTo(x, y);
Form1.Canvas.LineTo(xr, yr);
end
else
if x < xs then
begin
xl := trunc(x - Len * Cos(pi - ArcTan((y - ys) / (x - xs)) + Pi / 6));
yl := trunc(y + Len * Sin(pi - ArcTan((y - ys) / (x - xs)) + Pi / 6));
xr := trunc(x - Len * Cos(pi - ArcTan((y - ys) / (x - xs)) - Pi / 6));
yr := trunc(y + Len * Sin(pi - ArcTan((y - ys) / (x - xs)) - Pi / 6));
Form1.Canvas.MoveTo(x, y);
Form1.Canvas.LineTo(xl, yl);
Form1.Canvas.MoveTo(x, y);
Form1.Canvas.LineTo(xr, yr);
end
else
if y < ys then
begin
xl := trunc(x + Len * Sin(Pi / 6));
yl := trunc(y + Len * Cos(Pi / 6));
xr := trunc(x - Len * Sin(Pi / 6));
yr := trunc(y + Len * Cos(Pi / 6));
Form1.Canvas.MoveTo(x, y);
Form1.Canvas.LineTo(xl, yl);
Form1.Canvas.MoveTo(x, y);
Form1.Canvas.LineTo(xr, yr);
end
else
begin
xl := trunc(x + Len * Sin(Pi / 6));
yl := trunc(y - Len * Cos(Pi / 6));
xr := trunc(x - Len * Sin(Pi / 6));
yr := trunc(y - Len * Cos(Pi / 6));
Form1.Canvas.MoveTo(x, y);
Form1.Canvas.LineTo(xl, yl);
Form1.Canvas.MoveTo(x, y);
Form1.Canvas.LineTo(xr, yr);
end;
end;

end;

end.
 
在畫布上通過Moveto 加上LineTo 計算好坐標就可以畫出你要的箭頭
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
后退
顶部