画好看的箭头线

2017-12-01 08:53:21来源:cnblogs.com作者:涂磊人点击

分享

FormShow()->FormMouseDown->FormMouseMove->FormMouseUp

初始化            鼠标按下,起点         移动鼠标                 鼠标弹起 ,终点 

 网上下的例子:

unit   Unit1; interface uses    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.

  

我的代码改进版:

unit   Unit1; interface uses    Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,    Dialogs; const    Penwidth   =   1;//画笔的粗细    Len   =   15;//箭头线的长度    {说明:这两个常量应该一起变化,具体值由效果来定。    当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);    private        {   Private   declarations   }    public        {   Public   declarations   }    end; var    Form1:   TForm1;    xs,   ys:   integer;//画线开始处的坐标  start    xl,   yl:   integer;//记录第一条箭头线的端点坐标   left       三角形左边顶点    xr,   yr:   integer;//记录第二条箭头线的端点坐标    rift    xt,   yt:   integer;//记录鼠标前一时刻的坐标     termoei    B:   boolean;//判断是否已经开始画线 implementation {$R   *.dfm} 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);var    m ,n: array[0..2] of TPoint;begin    if   B   then    begin        Form1.Canvas.Pen.Mode   :=   pmNotXor;  //pmNotXor 将旧三角形用背景色 划线,即清除旧的        Form1.Canvas.Pen.Color   :=   clRed;        Form1.Canvas.Pen.Width   :=   PenWidth;        if   xl   <>   -1   then       //pmNotXor 将旧三角形用背景色 划线,即        begin            Form1.Canvas.Brush.Color:=clRed;     //清除  三角形            m[0]:=   Point(xt,   yt);            m[1]:=   Point(xl,   yl);            m[2]:=  Point(xr,   yr);            Form1.Canvas.Polygon( m);            //------------------------------------            n[0]:=   Point(xs,   ys);            n[1]:=   Point(xl,   yl);            n[2]:=  Point(xr,   yr);            Form1.Canvas.Polygon( n);        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.Brush.Color:=clRed;     //填充三角形            m[0]:=   Point(x,   y);            m[1]:=   Point(xl,   yl);            m[2]:=  Point(xr,   yr);            Form1.Canvas.Polygon( m);            //------------------------------------            n[0]:=   Point(xs,   ys);            n[1]:=   Point(xl,   yl);            n[2]:=  Point(xr,   yr);            Form1.Canvas.Polygon( n);                    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; end.

  

 

QQ软件的箭头:离QQ的还是有一定的距离

最新文章

123

最新摄影

闪念基因

微信扫一扫

第七城市微信公众平台