DELPHI中怎么画出带有箭头的线来？高分相送

Question

DELPHI中怎么画出带有箭头的线来？高分相送

Answer 1

var
  x1,y1:real;
begin
  image1.canvas.Rectangle(0,0,width,height);
  x1:=0;
  y1:=(form1.image1.Left+form1.Image1.Width)/4;
  image1.Canvas.pen.Color:=clRed;
  image1.canvas.pen.style:=psDash;  image1.Canvas.MoveTo(0,trunc(y1));
  image1.canvas.lineto(image1.width,trunc(y1));  image1.canvas.moveto(image1.width div 2,0);
  image1.canvas.lineto(image1.width div 2,image1.height);  image1.canvas.pen.style:=psSolid;  image1.canvas.MoveTo(image1.width-15,trunc(y1)-7);
  image1.canvas.lineto(image1.width,trunc(y1));
  image1.canvas.MoveTo(image1.width-15,trunc(y1)+7);
  image1.canvas.lineto(image1.width,trunc(y1));  image1.canvas.MoveTo((image1.width div 2)-7,15);
  image1.canvas.lineto(image1.width div 2,0);
  image1.canvas.MoveTo((image1.width div 2)+7,15);
  image1.canvas.lineto(image1.width div 2,0);

Answer 2

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;const
  Penwidth = 5;//画笔的粗细
  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);
    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);
    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.

Answer 3

都怪我没有解释清楚，我想问的是有没有类似与lineto那样画线的函数，画出来的线带有箭头，呵呵，请高手指教

Answer 4

上面的写的够清楚了，楼主改一下不就好了，
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;const
  Penwidth = 5;//画笔的粗细
  Len = 20;//箭头线的长度
  {说明：这两个常量应该一起变化，具体值由效果来定。
  当Penwidth很小时，显示的效果不是太好}type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  xs, ys: integer;implementation{$R *.dfm}procedure line(xs,ys,x,y:integer);
//从（xs,ys）到(x,y)的直线，并在末尾加箭头
var
  xl, yl: integer;//记录第一条箭头线的端点坐标
  xr, yr: integer;//记录第二条箭头线的端点坐标
begin
  form1.Canvas.Pen.Width := Penwidth;
  form1.Canvas.MoveTo(xs,ys);
  Form1.Canvas.LineTo(x, 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);
  end;
end;procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  xs := x;
  ys := y;
end;procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  line(xs, ys, x, y);
end;end.