Habe den Code eben noch geändert nach Angaben von wp_xyz:
Hängt sich leider immer noch auf:
Könnt Ihr bitte mal drauf schauen, was da noch falsch sein könnte.
Code: Alles auswählen
{ Ein Label mit zusätzlicher Rotation }
{ 17.04.2017 Siro }
{ Drehen bisher nur von 0..90 Grad }
{ darüber gibts noch einige Problemchen :-) }
unit Laz_RotateLabel;
interface
uses
Classes,
Graphics,
StdCtrls;
Type TRotateLabel = class(TCustomLabel)
private
FAngle : Integer; // Winkel in Grad (Altgrad)
protected
procedure SetAngle(newAngle:Integer);
procedure CalcTextRect(out r:TRect);
procedure CalcTextPos(out tp:TPoint);
procedure CalculatePreferredSize(
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
public
constructor create(AOwner:TComponent); override;
procedure paint; override;
published
property Angle : Integer read FAngle write SetAngle;
property Font;
property Caption;
property AutoSize;
end;
procedure Register;
implementation
{-------------------------------------------------------------------------}
{ liefert das äussere umschliessende Rechteck eines Punkte-Arrays zurück }
Procedure GetPointsRect(var Points: array of TPoint; out res:Trect);
var i:Integer; MinX,MaxX,MinY,MaxY:Integer;
begin
// !! nicht mit 0 initialisieren
// wir initialisieren auf die Koordinaten des ersten Punktes
MinX:=Points[0].x;
MaxX:=MinX;
MinY:=Points[0].y;
MaxY:=MinY;
// index 0 braucht man eigentlich nicht abfragen ....
for i:=1 to High(Points) do begin
if Points[i].x < MinX then MinX:=Points[i].x;
if Points[i].x > MaxX then MaxX:=Points[i].x;
if Points[i].y < MinY then MinY:=Points[i].y;
if Points[i].y > MaxY then MaxY:=Points[i].y;
end;
res:=Rect(MinX,MinY,MaxX,MaxY);
end;
{------------------------------------------------------------------------------}
procedure RotatePoints(out Points : array of TPoint; // Punkte Array
RotationPoint : TPoint; // Punkt der Rotation
Angle : Double); // Drehwinkel in Grad 0..360 im Uhrzeigersinn
var i:Integer;
var p:TPoint; { !!! Zwischenvariable zwingend erforderlich }
begin
Angle := -Angle * pi / 180; // Winkel Grad nach Rad(Bogenmaß) wandeln
for i:=0 to High(Points) do begin // alle Polygonpunkte durchlaufen
{ neue X Kooordinate des Punktes berechnen }
p.x:=round( RotationPoint.x // Original Position
+ (Points[i].x - RotationPoint.x) * cos(Angle) // + deltaX * cos(w)
- (Points[i].y - RotationPoint.y) * sin(Angle) // - deltaY * sin(w)
);
{ neue Y Kooordinate des Punktes berechnen }
p.y:=round( RotationPoint.y // Original Position
+ (Points[i].x - RotationPoint.x) * sin(Angle) // + deltaX * sin(w)
+ (Points[i].y - RotationPoint.y) * cos(Angle) // + deltaY * cos(w)
);
{ ! erst jetzt die neuen beiden Werte für x und y übernehmen }
Points[i].x:=p.x;
Points[i].y:=p.y;
end;
end;
{ brechnet das Umschliessende Textrechteck bei dem entsprechendem Winkel }
Procedure TRotateLabel.CalcTextRect(out r:TRect);
var w,h:Integer;
var p:Array[0..3] of TPoint;
begin
// Breite und Höhe bei ungedrehtem Text ermitteln
// dazu den momentanen Winkel vorrübergehend auf 0 setzen
canvas.font.orientation:=0; // Winkel 0 Grad
// nun die Breite und Höhe des ungedrehten Textes ermitteln
w:=canvas.TextWidth (caption);
h:=canvas.TextHeight(caption);
// den ursprünglichen Winkel zurück setzen
canvas.font.orientation:=Angle*10; // in Grad
// die 4 Eckpunkte des umschliessenden Rechtecks in ein Punkte Array wandeln
p[0]:=Point(0,0); // links oben
p[1]:=Point(0,h); // links unten
p[2]:=Point(w,h); // rechts unten
p[3]:=Point(w,0); // rechts oben
// Das 4 Punkte Array drehen,
RotatePoints(p,point(0,0),Angle);
// Das umschliessende gedrehte Rechteck zurück liefern
GetPointsRect(p,r)
end;
{ ermittelt die Textposition für die gedrehte Textausgabe }
{ Vorläufige Batselversion, geht von 0..90 Grad}
{ rotiert wird um die obere linke Ecke }
procedure TRotateLabel.CalcTextPos(out tp:TPoint);
var rp:TPoint; // Drehpunkt
var dx,dy:Integer;
begin
Font.Orientation:=0;
tp:=Point(0,0); // Text Aufhängepunkt oben links
rp:=point(canvas.textwidth(caption),0); // Drehpunkt gegenüber liegende obere Ecke
RotatePoints(rp,tp,Angle); // Ecke drehen
dx:=tp.x-rp.x; // x differnez zum Aufhängepunkt
dy:=tp.y-rp.y; // y differnez zum Aufhängepunkt
// tp.x:=tp.x+dx;
tp.y:=tp.y+dy; // Text y Position wandert nach unten beim Drehen
Font.Orientation:=Angle*10; // Winkel zurück stellen
end;
constructor TRotateLabel.create(AOwner:TComponent);
begin
inherited;
end;
procedure TRotateLabel.paint;
var p:TPoint;
begin
CalcTextPos(p);
Canvas.TextOut(p.x,p.y, caption);
end;
procedure TRotateLabel.SetAngle(newAngle:Integer);
begin
if newAngle = fAngle then exit;
fAngle:=NewAngle;
Font.Orientation:=fAngle*10;
// CalculateN;
invalidate;
end;
procedure TRotateLabel.CalculatePreferredSize(
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean);
var r:Trect;
begin
inherited;
CalcTextRect(r);
PreferredWidth := abs(r.right-r.Left);
PreferredHeight:= abs(r.bottom-r.top);
end;
procedure Register;
begin
RegisterComponents('LAZ_Siro', [TRotateLabel]);
end;
end.