delphi - Delphi FireMonkeyのテキストに合わせてボタンのサイズを調整するには?

Question

ボタンのサイズ (幅と高さ) はできるだけ小さくしたいが、テキストに合わせたい。コード例はありますか? Delphi XE4 FireMonkey モバイル アプリケーション。

Answer 1

FireMonkey は、TTextLayoutクラスを使用するメソッドを介してテキストをレンダリングします。
クラスヘルパーを介してこのメ​​ソッドにアクセスし、レイアウトによって提供される情報に基づいてボタンのサイズを変更できます。

uses FMX.TextLayout;

type
  TextHelper = class helper for TText
     function getLayout : TTextLayout;
  end;

function TextHelper.getLayout;
begin
  result := Self.fLayout;
end;

procedure ButtonAutoSize(Button : TButton);
var
  bCaption : TText;
  m : TBounds;
begin
  bCaption := TText(Button.FindStyleResource('text',false));
  bCaption.HorzTextAlign := TTextAlign.taLeading;
  bCaption.VertTextAlign := TTextAlign.taLeading;
  m := bCaption.Margins;
  Button.Width  := bCaption.getLayout.Width  + m.Left + m.Right;
  Button.Height := bCaption.getLayout.Height + m.Top  + m.Bottom;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ButtonAutoSize(Sender as TButton);
end;

---

アップデート

これは、プライベート クラス フィールドを公開する必要のない、より将来性のあるソリューションです。

uses FMX.Objects;

procedure ButtonAutoSizeEx(Button: TButton);
var
  Bitmap: TBitmap;
  Margins: TBounds;
  Width, Height: Single;
begin
  Bitmap := TBitmap.Create;
  Bitmap.Canvas.Font.Assign(Button.TextSettings.Font);
  Width := Bitmap.Canvas.TextWidth(Button.Text);
  Height := Bitmap.Canvas.TextHeight(Button.Text);
  Margins := (Button.FindStyleResource('text', false) as TText).Margins;
  Button.TextSettings.HorzAlign := TTextAlign.Leading;
  Button.Width := Width + Margins.Left + Margins.Right;
  Button.Height := Height + Margins.Top + Margins.Bottom;
end;

この例では、単語の折り返しや文字のトリミングが省略されています。

Answer 2

@Peter の回答に基づいていますが、ビットマップを作成する必要はありません。

//...

type
    TButtonHelper = class helper for TButton
        procedure FitToText(AOnlyWidth: Boolean = False);
    end;

implementation

//...

// Adapt button size to text.
// This code does not account for word wrapping or character trimming.
procedure TButtonHelper.FitToText(AOnlyWidth: Boolean = False);
var
    Margins: TBounds;
    TextWidth, TextHeight: Single;
    Obj: TFmxObject;
const
    CLONE_NO = False;
begin
    Obj := FindStyleResource('text', CLONE_NO);
    if Obj is TText then    //from Stackoverflow comments: Some time FindStyleResource returns nil making the app crash
    begin
        Margins := (Obj as TText).Margins;
        TextWidth := Canvas.TextWidth(Text);
        if not AOnlyWidth then
          TextHeight := Canvas.TextHeight(Text);
        TextSettings.HorzAlign := TTextAlign.taLeading;    //works in XE4
        //later FMX-Versions ?: TextSettings.HorzAlign := TTextAlign.Leading;
        Width := TextWidth + Margins.Left + Margins.Right;
        if not AOnlyWidth then
          Height := TextHeight + Margins.Top + Margins.Bottom;
    end;
end;