画中画着画不出的画 画好看的箭头线_Delphi教程_网络编程_码蚁之家_www.codes51.com
返回首页
专题
网络编程
ASP教程 .NET教程 PHP教程 JSP教程 C#教程 Java教程 Delphi教程 VB教程 C/C++教程 Android开发 IOS开发 Windows Phone开发 Python教程 Ruby教程 移动开发 其他编程教程
网页制作
HTML教程 CSS教程 Dreamweaver教程 FrontPages教程 Javascript教程 web前端
数据库
SqlServer MySql Oracle Access DB2 SQLite 其他数据库
图形设计
photoshop教程 Fireworks教程 CorelDraw教程 Illustrator教程 AutoCad教程 FLASH教程
操作系统
Windows xp教程 Windows 7教程 Windows 8教程 Windows 2003教程 Windows Server 2008教程 Linux教程 Windows 10
网站运营
建站经验 SEO优化 站长心得 网赚技巧 网站推广 站长故事
手机学院
手机速递 安卓教程 iphone教程 手机评测 手机技巧 手机知识 手机应用 手机游戏 手机导购
网店宝典
开店指导 开店经验 网店装修 网店推广 网店seo 网购技巧
软件教程
办公软件 系统工具 媒体工具 压缩工具 图文处理 文件管理
范文之家
自我介绍 自我鉴定 写作模板 合同范本 工作总结 贺词祝福语 演讲致辞 思想汇报 入党申请书 实习报告 心得体会 工作计划 简历模板 工作报告 导游词 评语寄语 口号大全 策划书范文
信息工程
软件工程 企业开发 系统运维 软件测试
移民之家
移民动态 移民政策 移民百科 移民生活 技术移民 投资移民
知识大全
母婴 数码 摄影 装修 美文 常识 时尚 婚嫁 美食 养生 旅游 兴趣 职场 教育 文学 健康
问答大全
电脑网络 手机数码 QQ专区 生活 游戏 体育运动 娱乐明星 休闲爱好 文化艺术 社会民生 教育科学 健康医疗 商业理财 情感家庭 地区问题 其他
编程问答
IOS Android .NET Java C/C++ Delphi VC/MFC 其他语言 PHP MSSQL MYSQL Oracle 其他数据库 Web开发 Windows Linux 硬件/嵌入开发 网络通信 移动开发 云计算 企业IT 游戏开发
笑话大全
幽默笑话 爱情笑话 成人笑话 校园笑话 爆笑笑话 综合笑话 古代笑话 现代笑话 国外笑话

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

来源:互联网  时间:2017/11/30 11:50:42

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

 画好看的箭头线


上一篇TClientDataSet数据源设置
下一篇Delphi7 GDI+学习
明星图片
相关文章
《画中画着画不出的画 画好看的箭头线》由码蚁之家搜集整理于网络,
联系邮箱:mxgf168#qq.com(#改为@)