[VCL] Textbreite in Pixeln ohne Canvas ermitteln?

[Der schöne Günther]

Ich möchte die Pixelbreite eines Textes (z.B. die

Delphi-Quellcode:

Caption

eines

Delphi-Quellcode:

TButton

) ermitteln. Ich finde immer nur Beispiele welche die Methode

Delphi-Quellcode:

TextWidth(..)

eines

Delphi-Quellcode:

TCanvas

benutzen.

Im Falle eines

Delphi-Quellcode:

TButton

habe ich leider keinen Canvas. Was tue ich dann?

[Darlo]

Quick and dirty habe ich das gestern (selbes Problem :-) ) so gelöst.

Delphi-Quellcode:

var
lab: TLabel;
begin
lab := TLabel.create(form1);
lab.autosize := true;
lab.font := button1.font;
lab.caption := button1.caption;
result := lab.width;
lab.free;
end;

[sx2008]

Man kann sich auch den Canvas vom Desktop holen:

Delphi-Quellcode:

function windowsDesktopCanvas: TCanvas; 
var 
DC: HDc; 
begin 
 DC := getWindowDC ( GetDeskTopWindow() ); 
 result := TCanvas.Create; 
 result.Handle := DC; 
end;

[himitsu]

Oder man macht das wie dat FMX am Anfang und erstellt sich einmal ein internes Canvas, das man dann für diese Berechnungen benutzt.

Zitat:

Zitat von Der schöne Günther (Beitrag 1276908)

Ich finde immer nur Beispiele welche die Methode

Delphi-Quellcode:

TextWidth(..)

eines

Delphi-Quellcode:

TCanvas

benutzen.

Vielleicht solltest du lernen die SuFu richtig zu benutzen?
Es ist garnicht so selten etwas zu finden, wo kein TCanvas benutzt wird, indem man direkt die WinAPIs benutzt, welche TCanvas.TextWidth intern benutzt.
Oder wo man sich Ein TCanvas auf dem Desktop erstellt, ohne eigene Zeichenfläche ala TBitmap.

TextWidth

[Amateurprofi]

Delphi-Quellcode:

FUNCTION TextExtent(FontHandle:HFont; const S:String):TSize;
var DC:HDC; OldFont:HFONT;
begin
   DC:=GetDC(0);
   try
      OldFont:=SelectObject(DC,FontHandle);
      GetTextExtentPoint32(DC,S,Length(S),Result);
      SelectObject(DC,OldFont);
   finally
      ReleaseDC(0,DC);
   end;
end;

Delphi-Quellcode:

FUNCTION TextWidth(FontHandle:HFont; const S:String):Integer;
begin
   result:=TextExtent(FontHandle,S).cx;
end;

[himitsu]

Lösen diese APIs überhaupt Exceptions aus?

IMHO geben die doch nur FehlerCodes zurück, welche man auswerten sollte.

Und dafür kann man dann auf das Try-Finally verzichten. Aber wenn es da wirklich mal knallen sollte, dann ist eh alles zuspät und das System ist so defekt, daß man die Anwendung sowieso beenden kann.



PS: Man kann sowas in der CL auch nachtragen/ändern lassen, wenn man bessere/alternative Lösungen kennt.

[Der schöne Günther]

Zitat:

Zitat von Darlo (Beitrag 1276909)

Quick and dirty habe ich das gestern (selbes Problem :-) ) so gelöst.

So werde ich das dann auch tun. Den im Endeffekt scheint sich das TLabel in seiner AdjustBounds-Methode auch wieder den Desktop-Canvas zu holen und tut dann irgendwelche mir unverständlichen Dinge damit.

Deshalb nehme ich jetzt auch ein Hilfslabel, schaue wie breit das werden würde und übernehme das dann für meinen Button.

Falls es noch interessiert, in Form einer Hilfsklasse sieht das dann so aus:

Delphi-Quellcode:

uses Helper.Vcl.ButtonAutosize;
[...]
Button1.Caption := 'Hallo Welt'; // Breite passt sich automatisch an

Delphi-Quellcode:

///   <summary>
///      <para>Überschreibt <c>Vcl.StdCtrls.TButton</c> dahingehend, dass er sich
///      wie ein <c>TLabel</c> mit <c>AutoSize=True</c> verhält: Ändert man
///      die <c>Caption</c>, passt sich seine Breite an.</para>
///      <para>Weiterhin kann für eine <c>TCaption</c> auch die Pixelbreite für
///      eine zu spezifizierende Schriftgröße abgefragt werden</para>
///   </summary>
///   <remarks>
///      <para>Wurde nicht mit Zeilenumbrüchen in der Caption getestet</para>
///      <para>Wenn man die AutoSize nicht will, kann man die neue Property
///         <c>CaptionNoAutoSize</c> verwenden
///      </para>
///   </remarks>
unit Helper.Vcl.ButtonAutoSize;

interface uses Vcl.StdCtrls, Vcl.Controls, Vcl.Graphics;

type

   /// <summary>
   ///     Überschreibt den Setter der Property <c>Caption</c> sodass
   ///    die Breite des Buttons wie bei einem Label mit <c>AutoSize = True</c>
   ///    dynamisch angepasst wird.
   /// </summary>
   /// <remarks>
   ///     Es wird nur die Eigenschaft <c>ClientWidth</c> angepasst
    /// </remarks>
   TButtonHelper = class helper for Vcl.StdCtrls.TButton
      private
         procedure setInheritedCaption(const Value: TCaption);
         function getCaption(): TCaption;

      protected
         procedure setCaption(const Value: TCaption); virtual;

      public // properties
         property Caption: TCaption
            read getCaption
            write setCaption;

         property CaptionNoAutosize: TCaption
            read getCaption
            write setInheritedCaption;
   end;

   TCaptionHelper = record helper for Vcl.Controls.TCaption
      private class var
         tempLabel: TLabel;
      private class
         destructor Destroy();
      private class
         procedure checkInitTempLabel(); static;


      function ToString(): String;
      function getPixelWidth(const forFont: TFont): Integer; overload;
   end;


implementation


{ TButtonHelper }

function TButtonHelper.getCaption(): TCaption;
begin
   Result := inherited Caption;
end;

procedure TButtonHelper.setCaption(const Value: TCaption);
const
   // Das ist der Rand den das RAD Studio XE7 standardmäßig um die automatisch
   // erstellte Caption "Button1" eines TButton macht. Die Breite (nicht ClientWidth)
   // scheint standardmäßig bei 75px zu liegen:
   // Vcl.StdCtrls.TCustomButton.Create(..)
   someOffsetPx: Integer = 37;
begin
   inherited Caption := Value;
   ClientWidth := Value.getPixelWidth(Font) + someOffsetPx;
end;

procedure TButtonHelper.setInheritedCaption(const Value: TCaption);
begin
   inherited Caption := Value;
end;

{ TCaptionHelper }

class procedure TCaptionHelper.checkInitTempLabel();
begin
   if not Assigned(tempLabel) then begin
      tempLabel := TLabel.Create(nil);
      tempLabel.AutoSize := True;
   end;
end;

class destructor TCaptionHelper.Destroy();
begin
   tempLabel.Free();
end;


function TCaptionHelper.getPixelWidth(const forFont: Vcl.Graphics.TFont): Integer;
begin
   Assert( Assigned(forFont) );
   checkInitTempLabel();
   tempLabel.Font := forFont;
   tempLabel.Caption := self;

   Result := tempLabel.Width;
end;

function TCaptionHelper.ToString(): String;
begin
   Result := self;
end;

end.

[Amateurprofi]

Zitat:

Zitat von himitsu (Beitrag 1276930)

Lösen diese APIs überhaupt Exceptions aus?

IMHO geben die doch nur FehlerCodes zurück, welche man auswerten sollte.

Und dafür kann man dann auf das Try-Finally verzichten. Aber wenn es da wirklich mal knallen sollte, dann ist eh alles zuspät und das System ist so defekt, daß man die Anwendung sowieso beenden kann.

Eigentlich hast du Recht. Laut OH sollten die benutzten Funktionen keine Exceptions auslösen.
Aber ich habe mir das nicht selbst ausgedacht, sondern aus den Source-Codes von XE2 abgeschrieben.
Ich denke, die, die das so geschrieben haben, verstehen mehr von der Materie als ich, also hab ich das unverändert übernommen.

[himitsu]

Bei manchen derer Codes denk ich eher das Gegenteil :roll:
und hab manchmal das Gefühl die benutzen ihre eigenes Zeugs nicht, denn sonst wären einige Dinge bestimmt benutzerfreundlicher. (z.B. das Suchen in der RTTI, was garnicht vorhanden ist)


Nja, zumindestens ist es mal nicht falsch, einen Resourcen-Schtzblock einzubauen, sondern nur bissl "unnötig",
abe natürlich wurde dafür dann die komplette "richtige" Fehlerbehandlung vergessen, wie an vielen anderen Stellen auch. (TMemo und der Zugriff auf nichtexistierende Zeilen)