einen Pfeil zeichnen
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:
Gruss
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; Urba |
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:20 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz