• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号
登陆 注册

Delphi7画好看的箭头线

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

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.

　　使用GDI+，更进一步了

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);
        procedure   FormCreate(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}
uses
GDIPAPI,GDIPOBJ; //包含这两个GDI+单元
 
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 : array[1..4] of TPoint;

var
g: TGPGraphics;
p: TGPPen;
sb: TGPSolidBrush;
pts: array[1..4] of TGPPoint;
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[1]:=   Point(xt,   yt);
//            m[2]:=   Point(xl,   yl);
//            m[3]:=  Point(xs,   ys);
//            m[4]:=  Point(xr,   yr);
//            Form1.Canvas.Polygon( m);

g := TGPGraphics.Create(Canvas.Handle);
g.SetSmoothingMode( SmoothingModeAntiAlias);{指定平滑（抗锯齿）}
p := TGPPen.Create(MakeColor(255,255,255),1);
sb := TGPSolidBrush.Create(MakeColor(255,255,255));


pts[1].X := xt;pts[1].Y := yt;
pts[2].X := xl;pts[2].Y := yl;
pts[3].X := xs; pts[3].Y := ys;
pts[4].X := xr; pts[4].Y := yr;


g.FillPolygon(sb, PGPPoint(@pts), 4); {第三个参数是顶点数}
g.DrawPolygon(p, PGPPoint(@pts), Length(pts));{第二个参数是指针类型, 需亚转换}

p.Free;
sb.Free;
g.Free;




        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[1]:=   Point(x,   y);
//            m[2]:=   Point(xl,   yl);
//            m[3]:=  Point(xs,   ys);
//            m[4]:=  Point(xr,   yr);
//            Form1.Canvas.Polygon( m);


g := TGPGraphics.Create(Canvas.Handle);
g.SetSmoothingMode( SmoothingModeAntiAlias);{指定平滑（抗锯齿）}

sb := TGPSolidBrush.Create(MakeColor(255,0,255));


pts[1].X := x;  pts[1].Y := y;
pts[2].X := xl ;pts[2].Y := yl;
pts[3].X := xs; pts[3].Y := ys;
pts[4].X := xr; pts[4].Y := yr;

g.FillPolygon(sb, PGPPoint(@pts), 4); {第三个参数是顶点数}

sb.Free;
g.Free;


        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

end;

end.

　　

　

 

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

 

鲜花
握手
雷人
路过
鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
More+
上一篇：
Delphi2010正式版的代码格式化及自动完成发布时间：2022-07-18
下一篇：
Delphi将图片缩放成指定大小发布时间：2022-07-18
热门推荐
More+
热门话题
More+
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）

在线QQ客服
地址：深圳市南山区西丽大学城创智工业园
电邮：jeky_zhao#qq.com
移动电话：139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap