Delphi

本类阅读TOP10

·分布式网络考试系统原型分析及实现
·游戏外挂设计技术探讨①
·使用HOOK随心监视Windows
·Delphi 水晶报表打包解决
·试题库开发中非文本数据的处理
·如何将几个DBGRID里的内容导入同一个EXCEL表中....的问题
·如何使用Delphi设计强大的服务器程序
·工人线程中关闭窗体的实现
·用DLL方式封装MDI子窗体。
·支持XP下托盘栏气球提示的托盘单元

分类导航
VC语言Delphi
VB语言ASP
PerlJava
Script数据库
其他语言游戏开发
文件格式网站制作
软件工程.NET开发
如何在delphi 中画带箭头的直线(改自网上一位论坛版主的vb代码)

作者:未知 来源:月光软件站 加入时间:2005-2-28 月光软件站

procedure TLineItem.Draw(aCanvas: TCanvas);

var

  Xa, Ya, Xb, Yb: real;

  D: real;

  X1, Y1, X0, Y0: Integer;

begin

  aCanvas.Pen.Style := PsSolid;

  aCanvas.Pen.Color := clWhite;

//画直线

  aCanvas.MoveTo(PtStart.X, PtStart.Y);

  aCanvas.LineTo(PtEnd.X, PtEnd.Y);

  //画箭头

  X0 := PtStart.X;//PtStart是箭头的起点,PtEnd是终点,都是Tpoint

  Y0 := PtStart.Y;

  X1 := PtEnd.X;

  Y1 := PtEnd.Y;

  D := Sqrt((Y1 - Y0) * (Y1 - Y0) + (X1 - X0) * (X1 - X0));

  if D > 0 then begin

    Xa := X1 + ARROWLEN * ((X0 - X1) + (Y0 - Y1) / 2) / D;

    Ya := Y1 + ARROWLEN * ((Y0 - Y1) - (X0 - X1) / 2) / D;

    Xb := X1 + ARROWLEN * ((X0 - X1) - (Y0 - Y1) / 2) / D;

    Yb := Y1 + ARROWLEN * ((Y0 - Y1) + (X0 - X1) / 2) / D;

    aCanvas.MoveTo(PtEnd.X, PtEnd.Y);

    aCanvas.LineTo(Trunc(Xa), Trunc(Ya));

    aCanvas.MoveTo(PtEnd.X, PtEnd.Y);

    aCanvas.LineTo(Trunc(Xb), Trunc(Yb));

  end;

//如果选中画出焦点矩形,可以不要

  if FSelected = true then begin

    aCanvas.Rectangle((PtStart.X - FORCUSRANGE),

      (PtStart.Y - FORCUSRANGE),

      (PtStart.X + FORCUSRANGE),

      (PtStart.Y + FORCUSRANGE));

    aCanvas.Rectangle((PtEnd.X - FORCUSRANGE),

      (PtEnd.Y - FORCUSRANGE),

      (PtEnd.X + FORCUSRANGE),

      (PtEnd.Y + FORCUSRANGE));

  end;

end;

 

canvas是任何一个拥有画笔的组件的canvas都可以。具体几何依据原作者没有讲。但是经过底下验算。有三个特点。

1.       箭头两翼端点连线和直线垂直(斜率之积等于-1)。

2.       .箭头两翼长度相同。(等腰三角形)

3.       箭头两翼长度和两翼端点间的距离比值一定。(决定了夹角)

 




相关文章

相关软件