Registriert seit: 23. Okt 2003
159 Beiträge
Delphi 2010 Architect
|
Re: Richtungs bzw. Vektorpfeil zeichnen
30. Jun 2007, 01:53
Delphi-Quellcode:
procedure ArrowTo(RC:TCanvas;xa,ya,xe,ye,pb,pl:integer;Fill:boolean);
var
m,t,sqm : real;
x1,y1,x2,y2,xs,ys,la : real;
begin
la:=sqrt(sqr(xe-xa)+sqr(ye-ya));
if la<0.01 then exit;
t:=(la-pl)/la;
xs:=xa+t*(xe-xa);
if xe<>xa then
begin
m:=(ye-ya)/(xe-xa);
ys:=ya+t*m*(xe-xa);
if m<>0 then
begin
sqm:=sqrt(1+1/sqr(m));
x1:=xs+pb/sqm;
y1:=ys-(x1-xs)/m;
x2:=xs-pb/sqm;
y2:=ys-(x2-xs)/m;
end
else
begin
x1:=xs; x2:=xs;
y1:=ys+pb/1.0;
y2:=ys-pb/1.0;
end;
end
else
begin
xs:=xa;
ys:=ya+t*(ye-ya);
x1:=xs-pb/1.0;
x2:=xs+pb/1.0;
y1:=ys; y2:=ys;
end;
RC.MoveTo(xa,ya);
RC.LineTo(round(xs),round(ys));
if Fill then
begin
RC.Brush.Color:=RC.Pen.Color;
RC.Brush.Style:=bsSolid;
RC.Polygon([Point(xe,ye),Point(round(x1),round(y1)), Point(round(x2),round(y2)),Point(xe,ye)]);
end
else
RC.Polyline([Point(xe,ye),Point(round(x1),round(y1)), Point(round(x2),round(y2)),Point(xe,ye)]);
end;
hier gefunden
danke für die mithilfe und inspiration!
|
|
Zitat
|