Ein Control rotieren, logik-probleme

[KodeZwerg]

Hallo Gemeinde.
Aufgrund einer Frage im englischen Forum (rotate any control) habe ich mich mal rangesetzt um so etwas zu realisieren aber stoße an meine Grenzen und würde gerne mal Wissen wie es richtig gemacht wird und ob es dafür auch eine crossplatform variante gibt, ich habe es mit Hilfe der Windows API versucht zu lösen.
Im Anhang ist mein komplettes Demo projekt, es funktioniert soweit auch ganz gut aber ich habe arge probleme das wenn ich mein control drehe es nicht mehr in die Dimensionen passt und somit abgeschnitten gezeichnet wird.
Ich habe es kommentiert so gut ich konnte damit man nachvollziehen kann was ich da so versuche
Hier der problematische Teil:

Code: Alles auswählen

procedure TMyButton.Paint;
var
  SavedLeft, SavedTop: Integer;
  SavedDC: Integer;
  XForm: TXForm;
  R: TRect;
  Size: TSize;
  lp: TPoint;
  dp: TPoint;
begin
  SavedDC := SaveDC(Self.Canvas.Handle);
  try
    SetGraphicsMode(Self.Canvas.Handle, GM_ADVANCED);
    // Save the current transformation matrix
    GetWorldTransform(Self.Canvas.Handle, XForm);
    XForm.eM11 := Cos(DegToRad(FAngle));
    XForm.eM12 := Sin(DegToRad(FAngle));
    XForm.eM21 := -Sin(DegToRad(FAngle));
    XForm.eM22 := Cos(DegToRad(FAngle));
    XForm.eDx := 0;
    XForm.eDy := 0;
    // Save the original Left and Top properties
    SavedLeft := Self.Left;
    SavedTop := Self.Top;
    // Apply the rotation transformation
    SetWorldTransform(Self.Canvas.Handle, XForm);
    // Get the bounding rectangle of the rotated text
    GetTextExtentPoint32(Self.Canvas.Handle, PChar(FText), Length(FText), Size);
    lp.x := Size.cx;
    lp.y := Size.cy;
    LPtoDP(Self.Canvas.Handle, lp, 1);
    // Calculate the new width and height
    dp.x := Round(lp.x * XForm.eM11 + lp.y * XForm.eM21);
    dp.y := Round(lp.x * XForm.eM12 + lp.y * XForm.eM22);
    // Set the bounding rectangle
    SetRect(R, 0, 0, dp.x, dp.y);
    // Restore the original transformation matrix
    SetWorldTransform(Self.Canvas.Handle, XForm);
    // Draw the background
    Self.Canvas.Brush.Color := clBtnFace; // Set the background color
    Self.Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height)); // Fill the control with the background color
    // Draw the border
    Self.Canvas.Pen.Color := clWindowFrame; // Set the border color
    Self.Canvas.Rectangle(0, 0, Self.Width-1, Self.Height-1); // Draw the border
    // Draw the text
    Self.Canvas.Pen.Color := clBtnText; // Set the font color
    R := Rect(0, 0, Self.Width, Self.Height);
    DrawText(Self.Canvas.Handle, PChar(FText), Length(FText), R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    // Restore the original Left and Top properties
    Self.Left := SavedLeft;
    Self.Top := SavedTop;
  finally
    RestoreDC(Self.Canvas.Handle, SavedDC);
  end;
end;

[wp_xyz]

Bist du sicher, dass man damit ein so komplexes Control wie ein TEdit drehen kann, so dass es noch funktioniert? Ich stehe weiterhin zu meiner Aussage im englischen Forum, dass man im allgemeinen die Lazarus-Controls nicht drehen kann. (OK - mit sehr viel Aufwand vielleicht, aber da kann ich mir gleich etwas Eigenes schreiben).

[wp_xyz]

Im Anhang ist mein komplettes Demo projekt, es funktioniert soweit auch ganz gut aber ich habe arge probleme das wenn ich mein control drehe es nicht mehr in die Dimensionen passt und somit abgeschnitten gezeichnet wird.

Da musst du die Bounds neu berechnen. Ich habe das beim TLabel (in Abhängigkeit von Font.Orientation) eingebaut. Bei einem Control, das eng mit Clicks verknüpft ist, wie einem Button, musst du dann aber aufpassen, dass der Click wirklich nur auf dem Button registriert wird. (Eine Möglichkeit dafür wäre, für den gedrehten Button ein schwarz/weiß-Bitmap anzulegen, in dem die eigentliche Button-Fläche schwarz ist, die Umgebung weiß. Wenn das Pixel unter dem Cursor dann schwaz ist, ware der Click auf dem Button, andernfalls auf dem Außenbereich und der Click wäre zu ignorieren; sowas ähnliches hat vor kurzem jemand für TShape implementiert, und dort funktioniert es).

[KodeZwerg]

Bist du sicher, dass man damit ein so komplexes Control wie ein TEdit drehen kann, so dass es noch funktioniert? Ich stehe weiterhin zu meiner Aussage im englischen Forum, dass man im allgemeinen die Lazarus-Controls nicht drehen kann. (OK - mit sehr viel Aufwand vielleicht, aber da kann ich mir gleich etwas Eigenes schreiben).

Hi wp, ich weiß jetzt nicht wie Du auf ein TEdit oder andere controls kommst, mir geht es wirklich nur um ein selbstgemachtes TCustomControl (TMyButton = class(TCustomControl)) das man drehen kann und nicht um eine Möglichkeit alle Controls irgendwie drehbar zu machen wie es im englischen Forum gefordert wurde.
Momentan ist mein "Ding" wie "StaticText" aber ohne Event support.
Es soll mir später als Vorlage für komplexere Controls dienen falls ich sowas jemals vorhaben sollte zu machen, gerade jetzt dient es mir lediglich als Lernprozess wie ich eigene Controls erstellen kann.
Ich gebe zu, TMyButton ist ein irreführender name, TMyControl wäre momentan die bessere Wahl

Da musst du die Bounds neu berechnen.

Ich hatte mit "Self.SetBounds()" rum experimentiert aber bin auf keinen guten Nenner gekommen, meine Berechnungen sind da total falsch, deswegen dieser Post hier wo ich um Hilfe mit exakt diesem Problem bitte, plus halt die Frage, wie mache ich das ganze ohne Windows API um dem FPC/Lazarus motto WOCA gerecht zu werden.

[KodeZwerg]

]Und falls sich jemand mit so etwas schonmal beschäftigt hat und mir einen Tipp geben könnte wie ich das Control von der Mitte aus um sich selbst drehen kann und nicht wie jetzt gerade von Position 0,0, das wäre echt nett mich da ein bisschen zu unterrichten!

Update damit sich das Control von der Mitte um sich selbst dreht plus ballast entsorgt

Code: Alles auswählen

procedure TMyButton.Paint;
var
  SavedLeft, SavedTop: Integer;
  SavedDC: Integer;
  XForm: TXForm;
  R: TRect;
begin
  SavedDC := SaveDC(Self.Canvas.Handle);
  try
    SetGraphicsMode(Self.Canvas.Handle, GM_ADVANCED);
    // Save the current transformation matrix
    GetWorldTransform(Self.Canvas.Handle, XForm);
    // Translate the origin to the center of the control
    XForm.eDx := Self.Width / 2;
    XForm.eDy := Self.Height / 2;
    // Apply the translation
    SetWorldTransform(Self.Canvas.Handle, XForm);
    // Apply the rotation transformation
    XForm.eM11 := Cos(DegToRad(FAngle));
    XForm.eM12 := Sin(DegToRad(FAngle));
    XForm.eM21 := -Sin(DegToRad(FAngle));
    XForm.eM22 := Cos(DegToRad(FAngle));
    // Apply the translation and rotation in a single transformation matrix
    SetWorldTransform(Self.Canvas.Handle, XForm);
    // Save the original Left and Top properties
    SavedLeft := Self.Left;
    SavedTop := Self.Top;
    // Draw the background
    Self.Canvas.Brush.Color := clBtnFace; // Set the background color
    Self.Canvas.FillRect(Rect(-Self.Width div 2, -Self.Height div 2, Self.Width div 2, Self.Height div 2)); // Fill the control with the background color
    // Draw the border
    Self.Canvas.Pen.Color := clWindowFrame; // Set the border color
    Self.Canvas.Rectangle(-Self.Width div 2, -Self.Height div 2, Pred(Self.Width div 2), Pred(Self.Height div 2)); // Draw the border
    // Draw the text
    Self.Canvas.Pen.Color := clBtnText; // Set the font color
    R := Rect(-Self.Width div 2, -Self.Height div 2, Self.Width div 2, Self.Height div 2);
    DrawText(Self.Canvas.Handle, PChar(FText), Length(FText), R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    // Restore the original Left and Top properties
    Self.Left := SavedLeft;
    Self.Top := SavedTop;
  finally
    RestoreDC(Self.Canvas.Handle, SavedDC);
  end;
end;

Jetzt fehlt mir wirklich nur noch Hilfe wie ich die Dimensionen berechnen und setzen kann.

[siro]

Ich hatte mal angefangen einen RotatedLabel zu programmieren
und mit viel Hilfe von wp_xyz entstand dann ein kleines Testprogramm.
Hier wird der Drehpunkt markiert und das umschließende Rechteck für den Text berechnet.
Diese Funktionalität hat er dann direkt in die Labelkomponente mit eingefügt.
Vielleicht hilft Dir das weiter.

Schau mal hier ein:
viewtopic.php?f=12&t=10673&hilit=DoMeasureTextPosition

[wp_xyz]

Hi wp, ich weiß jetzt nicht wie Du auf ein TEdit oder andere controls kommst, mir geht es wirklich nur um ein selbstgemachtes TCustomControl (TMyButton = class(TCustomControl)) das man drehen kann und nicht um eine Möglichkeit alle Controls irgendwie drehbar zu machen wie es im englischen Forum gefordert wurde.

Ich hatte die Frage im englischen Forum so verstanden, dass sich in dem zu drehenden Panel alle möglichen Controls befinden können.

wie mache ich das ganze ohne Windows API um dem FPC/Lazarus motto WOCA gerecht zu werden.

In Unit GraphMath gibt es eine Funktion RotateRect, die die vier Eckpunkte eines Rechtecks um die linke obere Ecke um einen beliebigen Winkel dreht, und das kleinste (normal orientierte) Rechteck zurückgibt, das das gedrehte Rechteck einschließt. Das verschiebt man dann, so dass der Fixpunkt unverändert bleibt, und übergibt es an SetBounds. Beim Text wird's komplizierter: Im Prinzip muss man den Startpunkt denselben Transformationen unterwerfen. Wenn der Text allerdings mehrzeilig wird, dann muss man das jeweils auf die einzelnen Zeilen anwenden; allerdings kenne ich keine Funktion, die die Einzelzeilen eines Wordwrap-Textes zurückliefert. Daher habe ich mir beim gedrehten Label das Leben leicht gemacht und gefordert: "Must be drawn as taLeftJustify/tlTop. No wordbreak and multiline ATM.".

[Mathias]

Mit GTK2 gehen zT. solche Rotate-Spielereien.
Hier habe ich mal ein kleines Beispiel dazu gemacht.

https://github.com/sechshelme/Lazarus-G ... tton_Label

Da die LCL auf gtk2 aufbaut, müsste es dort theoretisch auch gehen.

[KodeZwerg]

Um Crossplatform zu sein bin ich auf Graphics32 umgestiegen, habe auf stackoverflow eine gute rotations Methode gefunden somit ist es in der Theorie egal ob man mehrzeiligen text hat.
So jedenfalls mein Gedankengang obwohl mein eigentliches Control nicht für mehrzeiligen Text vorgesehen ist.
Das problem mit dem vergrößern des Controls hab ich immer noch nicht in den Griff bekommen aber bin noch am werkeln, da die Rotationsmethode netterweise ein "Autosize" bietet.
Wenn ich's nutze um mein Control zu vergrößern wird es allerdings endlos vergrößert da muss ich noch einen Zwischenschritt einlegen um immer von den Original Höhen und Breiten zu arbeiten.

Hier ist mein aktueller Quelltext für interessierte:

Code: Alles auswählen

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Windows,
  Math,
  GR32, GR32_Transforms,
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls;

type

  { TMyButton }

  TMyButton = class(TCustomControl)
  private
     FBMP: TBitmap;
     FText: string;
     FAngle,
     FWidth,
     FHeight: Integer;
     procedure SetAngle(AValue: Integer);
     procedure SetText(AValue: string);
   protected
     procedure Paint; override;
   public
     constructor Create(AOwner: TComponent); override;
   published
     property Angle: Integer read FAngle write SetAngle;
     property Text: string read FText write SetText;
//     property Width: Integer read FWidth write SetWidth;
//     property Height: Integer read FHeight write SetHeight;
   end;

  { TForm1 }

  TForm1 = class(TForm)
    TrackBar1: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private

  public
    MyButton1: TMyButton;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TMyButton }

constructor TMyButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAngle := 0;
  FText := 'Custom Control';
  FBMP := TBitmap.Create;
end;

procedure TMyButton.SetAngle(AValue: Integer);
begin
  if FAngle = AValue then
    Exit;
  if ((AValue < 0) or (AValue > 360)) then
    Exit;
  FAngle := AValue;
  Self.Invalidate;
end;

procedure TMyButton.SetText(AValue: string);
begin
  if (FText <> AValue) then
  begin
    FText := AValue;
    Self.Invalidate;
  end;
end;

procedure RotateBitmapGR32(Bmp: TBitmap32; Degs: Integer; AdjustSize: Boolean;
  BkColor: TColor = clNone; Transparent: Boolean = False);
var
  Tmp: TBitmap32;
  Transformation: TAffineTransformation;
begin
  Tmp := TBitmap32.Create;
  Transformation := TAffineTransformation.Create;
  try
    Transformation.BeginUpdate;
    Transformation.SrcRect := FloatRect(0, 0, Bmp.Width, Bmp.Height);
    Transformation.Translate(-0.5 * Bmp.Width, -0.5 * Bmp.Height);
    Transformation.Rotate(0, 0, -Degs);
    if AdjustSize then
      with Transformation.GetTransformedBounds do
        Tmp.SetSize(Round(Right - Left), Round(Bottom - Top))
    else
      Tmp.SetSize(Bmp.Width, Bmp.Height);
    Transformation.Translate(0.5 * Tmp.Width, 0.5 * Tmp.Height);
    Transformation.EndUpdate;
    Tmp.Clear(Color32(BkColor));
    if not Transparent then
      Bmp.DrawMode := dmOpaque
    else
      Bmp.DrawMode := dmTransparent;
    Transform(Tmp, Bmp, Transformation);
    Bmp.Assign(Tmp);
    Bmp.OuterColor := Color32(BkColor);
//    if Transparent then
//      Bmp.DrawMode := dmTransparent;
  finally
    Transformation.Free;
    Tmp.Free;
  end;
end;

procedure RotateBitmap(Bmp: TBitmap; Degs: Integer; AdjustSize: Boolean;
  BkColor: TColor = clNone);
var
  Tmp: TBitmap32;
  Transparent: Boolean;
begin
  Tmp := TBitmap32.Create;
  try
    Transparent := Bmp.Transparent;
    Tmp.Assign(Bmp);
    RotateBitmapGR32(Tmp, Degs, AdjustSize, BkColor, Transparent);
    Bmp.Assign(Tmp);
    if Transparent then
      Bmp.Transparent := True;
  finally
    Tmp.Free;
  end;
end;

procedure TMyButton.Paint;
var
  LBMP: TBitmap;
  R: TRect;
begin
  // Create a buffer bitmap and set its size to match the control
  LBMP := TBitmap.Create;
  try
    LBMP.SetSize(Self.Width, Self.Height);
//    LBMP.Transparent := True;

    // Draw the background, border, and text onto the buffer bitmap
    with LBMP.Canvas do
    begin
      Brush.Style := bsSolid;
      Brush.Color := clLime; // clBtnFace;
      FillRect(Rect(0, 0, Self.Width, Self.Height));
      Pen.Style := psSolid;
      Pen.Color := clWindowFrame;
      Rectangle(0, 0, Pred(Self.Width), Pred(Self.Height));
      Pen.Color := clBtnText;
      R := Rect(0, 0, Self.Width, Self.Height);
      DrawText(Handle, PChar(FText), Length(FText), R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    end;

    RotateBitmap(LBMP, FAngle, True, clDefault);

//    Self.Width := LBMP.Width;
//    Self.Height := LBMP.Height;

    FBMP.Assign(LBMP);

    // Draw the rotated bitmap onto the control's canvas
    Self.Canvas.Draw(0, 0, FBMP);
  finally
    LBMP.Free;
  end;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyButton1 := TMyButton.Create(Self);
  try
    MyButton1.Width := 150;
    MyButton1.Height := 30;
    MyButton1.Parent := Self;
    MyButton1.Left := 200;
    MyButton1.Top := 200;
    MyButton1.Visible := True;
    MyButton1.Text := 'Test Text';
    MyButton1.Angle := 0;
  finally
  end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  MyButton1.Angle := Self.TrackBar1.Position;
end;

end.

[KodeZwerg]

Ach menno, die unit "Windows" muss raus und dafür "LCLType und LCLIntf" rein, unit Math kann auch raus.

[KodeZwerg]

Ich glaube es ist vollbracht, wenn jemand die Zeit hat dies auf Fehler zu testen wäre ich dankbar.
Im Anhang ist ein komplettes Demo projekt.
Graphics32 wird benötigt (erhältich über OPM)

[theo]

Ich hab's jetzt nicht genau angeschaut, aber was unterscheidet nun dieses "Control" von einem gedrehten Bitmap?
Für mich ist ein "Control" im engeren Sinne etwas anderes.

[KodeZwerg]

Dargestellt ist es als Bitmap auf dem Canvas eines TCustomControl, also hat es erstmal all dessen Eigenschaften plus das was ich ihm noch spendiert habe, was man auf dem Bild erkennen kann.

[wennerer]

Hallo,
ich wollte es grade mal probieren. Leider scheitere ich schon am installieren von Graphics32. Klappt weder über OPM noch mit fpcupdeluxe.
Mein OS ist Linux Mint 20 Cinnamon und Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-gtk2. Vielleicht schon zu alt?

Viele Grüße
Bernd

[KodeZwerg]

Hallo,
ich wollte es grade mal probieren. Leider scheitere ich schon am installieren von Graphics32. Klappt weder über OPM noch mit fpcupdeluxe.
Mein OS ist Linux Mint 20 Cinnamon und Lazarus 2.2.6 (rev lazarus_2_2_6) FPC 3.2.2 x86_64-linux-gtk2. Vielleicht schon zu alt?

Viele Grüße
Bernd

Ohne Fehlerbericht schwer einzuschätzen.
Ich hab mal ein Bild rangepappt was meine Version zeigt wobei ich mir da nicht mal so sicher bin da OPM mir eine andere version anzeigt als die installierte... oder sind generell 2 verschiedene nummern, bin da leider keine Profi