1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:

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;

//Aufruf:
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;