einen Pfeil zeichnen

[Urba]

Hallo,

Weil es mich etwas genervt hat dass es weder eine Pfeil-Funktion noch eine sinnvolle Prozedur gibt die Pfeile in alle Richtungen zeichnen kann, habe ich das mal selbst in die Hand genommen.

Die Prozedur zeichnet einen Pfeil von P1 nach P2, unabhängig wer links oder rechts liegt. Wenn P2 links von P1 liegt, dann ist der Pfeilkopf auch wirklich bei P2. Seitenlänge und Spannwinkel sind innerhalb der Prozedur änderbar

Delphi-Quellcode:

procedure ZeichnePfeil(Can: TCanvas; Col : TColor; SLange,Beta : Byte; Filled : Boolean; P1, P2: TPoint);
//created by Christof Urbaczek

  function GetDEG(Winkel: Extended): Extended; // Winkel ins Gradmaß
  begin
    Result := (Winkel * 2 * Pi) / 360;
  end;

  function GetRAD(Winkel: Extended): Extended; // Winkel im Winkelmaß
  begin
    Result := (Winkel * 360) / (2 * Pi);
  end;

var
  Punkte: array [0..2] of TPoint; // Array für die Punkte der Pfeilspitze
  Alpha, AlphaZ: Extended;        // Winkel zur horizontalen Achse durch P1

begin

  //Farben einstellen
  Can.Brush.Color := Col;
  Can.Pen.Color   := Col;

  //Linie zeichnen
  Can.Pen.Style   := psSolid;
  Can.MoveTo(P1.X, P1.Y);
  Can.LineTo(P2.X, P2.Y);

  //Pfeilspitze (1.Punkt)
  Punkte[0].X := P2.X; 
  Punkte[0].Y := P2.Y;

  //Winkel ermitteln 
  Alpha := 0;
  if P2.X = P1.X then
    AlphaZ := 0
  else
    AlphaZ := GetRAD(ArcTan((P2.Y - P1.Y) / (P2.X - P1.X)));

  if (P2.X > P1.X) and (P2.Y = P1.Y) then Alpha := 0
  else if (P2.X > P1.X) and (P2.Y < P1.Y) then Alpha := 0 - AlphaZ
  else if (P2.X = P1.X) and (P2.Y < P1.Y) then Alpha := 90
  else if (P2.X < P1.X) and (P2.Y < P1.Y) then Alpha := 180 - AlphaZ 
  else if (P2.X < P1.X) and (P2.Y = P1.Y) then Alpha := 180
  else if (P2.X < P1.X) and (P2.Y > P1.Y) then Alpha := 180 - AlphaZ
  else if (P2.X = P1.X) and (P2.Y > P1.Y) then Alpha := 270
  else if (P2.X > P1.X) and (P2.Y > P1.Y) then Alpha := 360 - AlphaZ;

  //2.Punkt
  Punkte[1].X := round(P2.X - sLange * cos(GetDEG(Alpha - Beta div 2)));
  Punkte[1].Y := round(P2.Y + sLange * sin(GetDEG(Alpha - Beta div 2)));

  //3.Punkt
  Punkte[2].X := round(P2.X - sLange * cos(GetDEG(Alpha + Beta div 2)));
  Punkte[2].Y := round(P2.Y + sLange * sin(GetDEG(Alpha + Beta div 2))); 

  //Pfeil zeichnen
  if Filled then Can.Polygon(Punkte) else begin
    Can.MoveTo(Punkte[0].X, Punkte[0].Y);
    Can.LineTo(Punkte[1].X, Punkte[1].Y);
    Can.MoveTo(Punkte[0].X, Punkte[0].Y);
    Can.LineTo(Punkte[2].X, Punkte[2].Y);
  end;
end;

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ZeichnePfeil(Image1.Canvas,clBlue,10,50,FALSE,Point(50,50),Point(100,100));
  ZeichnePfeil(Image1.Canvas,clRed ,10,50,TRUE ,Point(50,50),Point(100, 20));
end;

Gruss
Urba