ASP源码.NET源码PHP源码JSP源码JAVA源码DELPHI源码PB源码VC源码VB源码Android源码
当前位置:首页 >> 网络编程 >> Delphi教程 >> 画中画着画不出的画 画好看的箭头线

画中画着画不出的画 画好看的箭头线

来源:网络整理     时间:2017-11-30     关键词:画中画着画不出的画

本篇文章主要介绍了"画中画着画不出的画 画好看的箭头线",主要涉及到画中画着画不出的画方面的内容,对于Delphi教程感兴趣的同学可以参考一下: FormShow()->FormMouseDown->FormMouseMove->FormMouseUp初始化 鼠标按...

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的还是有一定的距离

 画好看的箭头线

以上就介绍了画中画着画不出的画 画好看的箭头线,包括了画中画着画不出的画方面的内容,希望对Delphi教程有兴趣的朋友有所帮助。

本文网址链接:http://www.codes51.com/article/detail_4512363.html

画中画着画不出的画相关图片

画中画着画不出的画相关文章