delphi 画 带箭头的线
生活随笔
收集整理的這篇文章主要介紹了
delphi 画 带箭头的线
小編覺得挺不錯的,現在分享給大家,幫大家做個參考.
unit Unit1;interfaceusesWindows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs;constPenwidth = 1;//畫筆的粗細Len = 20;//箭頭線的長度{說明:這兩個常量應該一起變化,具體值由效果來定。當Penwidth很小時,顯示的效果不是太好}typeTForm1 = 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;varForm1: 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)) thenbeginForm1.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);
beginxs := 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);
beginif B thenbeginForm1.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 thenbeginForm1.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 thenbeginxl := 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));endelseif x < xs thenbeginxl := 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));endelseif y < ys thenbeginxl := 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));endelseif y > ys thenbeginxl := 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));endelsebeginxl := -1;yl := -1;xr := -1;yr := -1;end;if xl <> -1 thenbeginForm1.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);
beginForm1.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);
beginForm1.BorderIcons := [biSystemMenu];
end;end.
?
轉載于:https://www.cnblogs.com/jxsoft/archive/2011/12/12/2284937.html
超強干貨來襲 云風專訪:近40年碼齡,通宵達旦的技術人生總結
以上是生活随笔為你收集整理的delphi 画 带箭头的线的全部內容,希望文章能夠幫你解決所遇到的問題。
- 上一篇: A == B?
- 下一篇: Enterprise Library 企