[VCL] Textbreite in Pixeln ohne Canvas ermitteln?

[Der schöne Günther]

Zitat von Darlo:

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.