?? anyline.pas
字號:
unit anyline;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
Tlinepoint = record
X,Y:SmallInt;
end;
Tanyline = class(TGraphicControl)
private
FlineWidth : integer;
procedure Setlinewidth(value:integer);
protected
procedure Paint; override;
//NCHitTest on used on Twincontrol
//procedure NCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
// procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
public
linepoints:array[1..8] of Tlinepoint;
linepointnum :integer;
constructor Create(AOwner: TComponent);override;
procedure drawby(const thepointarray:array of Tpoint);
function getmidpoint:Tpoint;
published
property Align;
property color;
// property DragCursor;
// property DragMode;
// property Enabled;
property linewidth :integer read Flinewidth write Setlinewidth;
// property ParentColor;
// property ParentShowHint;
// property ShowHint;
property Visible;
// property OnDragDrop;
// property OnDragOver;
// property OnEndDrag;
// property OnMouseDown;
// property OnMouseMove;
// property OnMouseUp;
// property OnStartDrag;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Graph', [Tanyline]);
end;
constructor Tanyline.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csOpaque];
Width := 10;
Height := 10;
Flinewidth := 1;
color := clBlack;
enabled := False;
//Sendtoback;
end;
{// NCHitTest on used on Twincontrol
procedure Tanyline.NCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
Msg.Result := HTTRANSPARENT;
end;
}
procedure Tanyline.Paint;
var i,j:integer;
linelength:integer; // approxiate line length , sqr((x1-x2)^2+(y1-y2)^2)+ sqr((x2-x3)^2+(y2-y3)^2)+...
INVALUENUM :integer;
XX,YY:integer;
t,tt,ttt,f1,f2,f3,f4:real;
function getlength(n:integer):real; //(n,n+1) point distance
var XX,YY:integer;
k:integer;
begin
XX := (linepoints[n].X - linepoints[n+1].X);
XX := XX * XX;
YY := (linepoints[n].Y - linepoints[n+1].Y);
YY := YY * YY;
result := sqrt(XX + YY);
end;
begin
with canvas do
begin
pen.color := color;
pen.width := Flinewidth;
pen.style := psSolid;
if linepointnum = 2 then
begin
MoveTo(linepoints[1].X,linepoints[1].Y);
LineTo(linepoints[2].X,linepoints[2].Y);
end
else if linepointnum = 3 then
begin
INVALUENUM := Round(getlength(1));
MoveTo(linepoints[1].X,linepoints[1].Y);
for i := 0 to INVALUENUM do
begin
t := i*0.5/(INVALUENUM+1);
tt := t*t ;
f1 := 2*tt - 3*t +1;
f2 := 4*t - 4*tt;
f3 := 2*tt - t;
xx := round(f1* linepoints[1].X + f2* linepoints[2].X + f3* linepoints[3].X );
yy := round(f1* linepoints[1].Y + f2* linepoints[2].Y + f3* linepoints[3].Y );
lineto(xx,yy);
end;
INVALUENUM := Round(getlength(2));
for i := 0 to INVALUENUM do
begin
t := 0.5 + i*0.5/(INVALUENUM+1);
tt := t*t ;
f1 := 2*tt - 3*t +1;
f2 := 4*t - 4*tt;
f3 := 2*tt - t;
xx := round(f1* linepoints[1].X + f2* linepoints[2].X + f3* linepoints[3].X );
yy := round(f1* linepoints[1].Y + f2* linepoints[2].Y + f3* linepoints[3].Y );
lineto(xx,yy);
end;
end
else if linepointnum > 3 then
begin
INVALUENUM := Round(getlength(1));
MoveTo(linepoints[1].X,linepoints[1].Y);
for i := 0 to INVALUENUM do
begin
t := i*0.5/(INVALUENUM+1);
tt := t*t ;
f1 := 2*tt - 3*t +1;
f2 := 4*t - 4*tt;
f3 := 2*tt - t;
xx := round(f1* linepoints[1].X + f2* linepoints[2].X + f3* linepoints[3].X );
yy := round(f1* linepoints[1].Y + f2* linepoints[2].Y + f3* linepoints[3].Y );
lineto(xx,yy);
end;
for j := 1 to linepointnum - 3 do
begin
INVALUENUM := Round(getlength(j+1));
for i := 0 to INVALUENUM do
begin
t := i*0.5/(INVALUENUM+1);
tt := t*t;
ttt := t*t*t;
f1 := 4*tt - t - 4*ttt;
f2 := 1 - 10*tt + 12*ttt;
f3 := t + 8*tt - 12*ttt;
f4 := 4*ttt - 2*tt;
xx := round(f1* linepoints[j].X + f2* linepoints[j+1].X + f3* linepoints[j+2].X + f4* linepoints[j+3].X);
yy := round(f1* linepoints[j].Y + f2* linepoints[j+1].Y + f3* linepoints[j+2].Y + f4* linepoints[j+3].Y);
lineto(xx,yy);
end;
end;
INVALUENUM := Round(getlength(linepointnum-1));
for i := 0 to INVALUENUM do
begin
t := 0.5 + i*0.5/(INVALUENUM+1);
tt := t*t ;
f1 := 2*tt - 3*t +1;
f2 := 4*t - 4*tt;
f3 := 2*tt - t;
xx := round(f1* linepoints[linepointnum-2].X + f2* linepoints[linepointnum-1].X + f3* linepoints[linepointnum].X );
yy := round(f1* linepoints[linepointnum-2].Y + f2* linepoints[linepointnum-1].Y + f3* linepoints[linepointnum].Y );
lineto(xx,yy);
end;
end;
end;
end;
procedure Tanyline.drawby(const thepointarray:array of Tpoint);
var i:integer;
begin
linepointnum := High(thepointarray)+1;
for i := 1 to linepointnum do
begin
linepoints[i].X := thepointarray[i-1].X;
linepoints[i].Y := thepointarray[i-1].Y;
end;
Invalidate;
// Update;
end;
function Tanyline.getmidpoint:Tpoint;
var
XX,YY:integer;
t,tt,ttt,f1,f2,f3,f4:real;
begin
if linepointnum = 2 then
begin
result.X := (linepoints[1].X + linepoints[2].X) div 2;
result.Y := (linepoints[1].Y + linepoints[2].Y) div 2;
end
else if linepointnum > 2 then
begin
t := 0.75;
tt := t*t ;
f1 := 2*tt - 3*t +1;
f2 := 4*t - 4*tt;
f3 := 2*tt - t;
result.X := round(f1* linepoints[linepointnum-2].X + f2* linepoints[linepointnum-1].X + f3* linepoints[linepointnum].X );
result.Y := round(f1* linepoints[linepointnum-2].Y + f2* linepoints[linepointnum-1].Y + f3* linepoints[linepointnum].Y );
end;
end;
procedure Tanyline.Setlinewidth(value:integer);
begin
if Flinewidth <> Value then
begin
Flinewidth := Value;
Invalidate;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -