Text Rechteck ermitteln

Für allgemeine Fragen zur Programmierung, welche nicht! direkt mit Lazarus zu tun haben.
siro
Beiträge: 730
Registriert: Di 23. Aug 2016, 14:25
OS, Lazarus, FPC: Windows 11
CPU-Target: 64Bit
Wohnort: Berlin

Re: Text Rechteck ermitteln

Beitrag von siro »

Habt erstmal Dank für eure Infos.
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.         
Zuletzt geändert von siro am Mo 17. Apr 2017, 16:13, insgesamt 6-mal geändert.
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...

siro
Beiträge: 730
Registriert: Di 23. Aug 2016, 14:25
OS, Lazarus, FPC: Windows 11
CPU-Target: 64Bit
Wohnort: Berlin

Re: Text Rechteck ermitteln

Beitrag von siro »

nochmal angepasst..
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...

wp_xyz
Beiträge: 4869
Registriert: Fr 8. Apr 2011, 09:01

Re: Text Rechteck ermitteln

Beitrag von wp_xyz »

Gute Knobelaufgabe...

Anbei eine Lösung, bei der die linke obere Label-Ecke fix bleibt, die Größe des umgebenden Rechtecks angepasst wird und der Label-Text so verschoben wird, dass er immer in diesem Rechteck bleibt.

Der Routine RotatePoints werden die zu drehenden Punkte mit Hilfe eines out-Parameters übergeben - das ist falsch. Ein out-Parameter hat definierte Werte nur bei der Ausgabe. Nimm stattdessen "var".

In TRotateLabel.Paint rufst du CalcTextPos auf. Dort wird aber die Orientierung des Fonts verstellt, was wieder ein Neuzeichnen bewirkt. Das ist wahrscheinlich die Ursache für die Totschleife.

Generell würde ich etwas anders vorgehen:
  • Angle ist unnötig, es muss reichen, Font.Orientation zu ändern. (Du holst dir in deiner Variante das Problem, dass man Font.Orientation ändern kann, die Komponente das aber nicht mitkriegt).
  • Ich würde nur CalculatePreferredSize und DoMeasureTextPosition überschreiben, das erstere, weil es bei allen die Größe betreffenden Änderungen aufgerufen wird, das zweite, weil dort der ansonsten fixe Drehpunkt verschoben werden kann, so dass der Labeltext das umgebende Rechteck nie verlässt. Du kannst ja mal probehalber gleich nach den "inherited" wieder rausspringen.
  • Eigentlich sollte damit alles funktionieren. Allerdings wird in der Paint-Methode der Canvas noch geclippt, wodurch der Text teilweise abgeschnitten wird. Ich habe einfach das von TCustomLabel geerbte Paint in die neue Komponente kopiert und dort "Canvas.Clipping := true" auskommentiert (auch das Alignment ist auskommentiert, zum einen weil die entsprechende BiDi-Prozedur nicht vorhanden ist, zum anderen, weil man das ganze bei mittigem und rechtsbündigem Text nochmals überdenken muss - was ich dir überlassen will). Wenn du mit einem transparenten Label leben kannst, reicht es aber auch, stattdessen einfach die Eigenschaft Transparent auf true zu setzen.
Dateianhänge
RotatedLabel.zip
(4.13 KiB) 110-mal heruntergeladen

siro
Beiträge: 730
Registriert: Di 23. Aug 2016, 14:25
OS, Lazarus, FPC: Windows 11
CPU-Target: 64Bit
Wohnort: Berlin

Re: Text Rechteck ermitteln

Beitrag von siro »

Also Hut ab, das sieht doch wirklich supi aus. "Vielen DANK" für deine Mühe.
Da steckt einige Zeit drin, ich glaub ich kann das gut abschätzen...

Ich wuste garnicht, dass Font schon ein Orientation hat, Peinlich aber wahr... :oops:
Natürlich ist es dann sinnvoll auch diesen zu benutzen. Damit ist Angle auch völlig unnötig, gar keine Frage.

Die Schleife bei mir konnte ich klären und beseitigen, das war genau wie Du sagt. Dur die Mehrfachberechnung von TextPos.
Ich hab diese probehalber mal Global in der Komponente abgelegt nur einmal berechnet und die Rehursion war verschwunden.
Durch diese Änderung funktionierte eigentich soweit alles richtg.

Das Drehen über 90 Grad ging bei mir noch nicht. Das läuft aber mit deiner Änderung auch hervorragend.
Ich kann mit dieser Version supi Leben. Würde sofort nen Kaffe ausgeben. :wink:

Siro
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...

Mathias
Beiträge: 6165
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Text Rechteck ermitteln

Beitrag von Mathias »

Ich wuste gar nicht, dass Font schon ein Orientation hat, Peinlich aber wahr...


So wird der Text 90° verschoben geschrieben.

Code: Alles auswählen

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Font.Orientation := -900;
  Canvas.TextOut(50, 50, 'Hello World');
end;


Mache ich es aber bei einem Label, dann wird der Text abgeschnitten, da sich das Rechteck des Label nicht anpasst. Ausser man entfernt AutoSize, und macht das Rechteck manuell.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Antworten