delphi 画带箭头的线-白红宇

delphi 画带箭头的线

阅读量：5068 次

发布时间：2019-06-12

本文共 5580 字，大约阅读时间需要 18 分钟。

unit   Unit1;interfaceuses    Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,    Dialogs;const    Penwidth   =   1;//画笔的粗细    Len   =   20;//箭头线的长度    {说明：这两个常量应该一起变化，具体值由效果来定。    当Penwidth很小时，显示的效果不是太好}type    TForm1   =   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;var    Form1:   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))   then    begin        Form1.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);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);            Form1.Canvas.MoveTo(xl,   yl);            Form1.Canvas.LineTo(xr,   yr);        end;        //记录下原坐标        xt   :=   x;        yt   :=   y;        if   x   >   xs   then        begin            xl   :=   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));        end        else            if   x   <   xs   then            begin                xl   :=   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));            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));                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));                    end                    else                    begin                        xl   :=   -1;                        yl   :=   -1;                        xr   :=   -1;                        yr   :=   -1;                    end;        if   xl   <>   -1   then        begin            Form1.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);begin    Form1.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);begin    Form1.BorderIcons   :=   [biSystemMenu];end;end.

转载于:https://www.cnblogs.com/jxsoft/archive/2011/12/12/2284937.html

你可能感兴趣的文章

【连载】 FPGA Verilog HDL 系列实例--------十进制加减法计数器

查看>>