unit   Unit1;interfaceusesWindows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,Dialogs;constPenwidth   =   1;//画笔的粗细Len   =   20;//箭头线的长度{说明：这两个常量应该一起变化，具体值由效果来定。当Penwidth很小时，显示的效果不是太好}typeTForm1   =   class(TForm)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);procedure   FormShow(Sender:   TObject);procedure   FormCreate(Sender:   TObject);private{   Private   declarations   }public{   Public   declarations   }end;varForm1:   TForm1;xs,   ys:   integer;//画线开始处的坐标xt,   yt:   integer;//记录鼠标前一时刻的坐标xl,   yl:   integer;//记录第一条箭头线的端点坐标xr,   yr:   integer;//记录第二条箭头线的端点坐标B:   boolean;//判断是否已经开始画线implementation{$R   *.dfm}procedure   TForm1.FormMouseUp(Sender:   TObject;   Button:   TMouseButton;Shift:   TShiftState;   X,   Y:   Integer);
begin{画线结尾时，将线重新填充一遍，以免有部分空白}if   not   ((x   =   xs)   and   (y   =   ys))   thenbeginForm1.Canvas.Pen.Mode   :=   pmCopy;Form1.Canvas.Pen.Color   :=   clRed;Form1.Canvas.Pen.Width   :=   PenWidth;Form1.Canvas.MoveTo(xs,   ys);Form1.Canvas.LineTo(x,   y);Form1.Canvas.MoveTo(x,   y);Form1.Canvas.LineTo(xl,   yl);Form1.Canvas.MoveTo(x,   y);Form1.Canvas.LineTo(xr,   yr);end;B   :=   False;
end;procedure   TForm1.FormMouseDown(Sender:   TObject;   Button:   TMouseButton;Shift:   TShiftState;   X,   Y:   Integer);
beginxs   :=   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);
beginif   B   thenbeginForm1.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   thenbeginForm1.Canvas.MoveTo(xt,   yt);Form1.Canvas.LineTo(xl,   yl);Form1.Canvas.MoveTo(xt,   yt);Form1.Canvas.LineTo(xr,   yr);Form1.Canvas.MoveTo(xl,   yl);Form1.Canvas.LineTo(xr,   yr);end;//记录下原坐标xt   :=   x;yt   :=   y;if   x   >   xs   thenbeginxl   :=   trunc(x   -   Len   *   Cos(ArcTan((y   -   ys)   /   (x   -   xs))   -   Pi   /   6));yl   :=   trunc(y   -   Len   *   Sin(ArcTan((y   -   ys)   /   (x   -   xs))   -   Pi   /   6));xr   :=   trunc(x   -   Len   *   Cos(ArcTan((y   -   ys)   /   (x   -   xs))   +   Pi   /   6));yr   :=   trunc(y   -   Len   *   Sin(ArcTan((y   -   ys)   /   (x   -   xs))   +   Pi   /   6));endelseif   x   <   xs   thenbeginxl   :=   trunc(x   +   Len   *   Cos(ArcTan((y   -   ys)   /   (x   -   xs))   -   Pi   /   6));yl   :=   trunc(y   +   Len   *   Sin(ArcTan((y   -   ys)   /   (x   -   xs))   -   Pi   /   6));xr   :=   trunc(x   +   Len   *   Cos(ArcTan((y   -   ys)   /   (x   -   xs))   +   Pi   /   6));yr   :=   trunc(y   +   Len   *   Sin(ArcTan((y   -   ys)   /   (x   -   xs))   +   Pi   /   6));endelseif   y   <   ys   thenbeginxl   :=   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));endelseif   y   >   ys   thenbeginxl   :=   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));endelsebeginxl   :=   -1;yl   :=   -1;xr   :=   -1;yr   :=   -1;end;if   xl   <>   -1   thenbeginForm1.Canvas.MoveTo(x,   y);Form1.Canvas.LineTo(xl,   yl);Form1.Canvas.MoveTo(x,   y);Form1.Canvas.LineTo(xr,   yr);Form1.Canvas.MoveTo(xl,   yl);Form1.Canvas.LineTo(xr,   yr);end;end;
end;procedure   TForm1.FormShow(Sender:   TObject);
beginForm1.Color   :=   clWhite;Form1.Caption   :=   '画带箭头的直线 ';Form1.WindowState   :=   wsMaximized;B   :=   False;xt   :=   -1;yt   :=   -1;xl   :=   -1;yl   :=   -1;xr   :=   -1;yr   :=   -1;
end;procedure   TForm1.FormCreate(Sender:   TObject);
beginForm1.BorderIcons   :=   [biSystemMenu];
end;end.