Einzelnen Beitrag anzeigen

Cyberstorm

Registriert seit: 23. Okt 2003
159 Beiträge
 
Delphi 2010 Architect
 
#8

Re: Richtungs bzw. Vektorpfeil zeichnen

  Alt 30. Jun 2007, 00: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!
  Mit Zitat antworten Zitat