如何在Delphi FireMonkey中调整按钮大小以适应文本？

Question

我希望按钮的尺寸（宽度和高度）尽可能小，但它要适应文本内容。有代码示例吗？ Delphi XE4 FireMonkey移动应用程序。

翻译

- Edijs Kolesnikovičs

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;

这个示例省略了任何换行或字符修剪。

- Peter

---

它在XE6上表现得很奇怪。如果我对同一个按钮进行连续调用，文本长度不同，那么宽度会根据需要增加，但永远不会缩小。 - Regis St-Gelais

谢谢您的评论，也感谢您提供的原始解决方案。问题仍然存在。我不想创建重复内容。也许通过重新激活并说明它在XE6上无法工作，会有人发布新的解决方案。祝好。 - Regis St-Gelais

@RegisSt-Gelais，你说得对，我已经更新了我的答案，并提供了一个替代解决方案来解决这个问题，希望能更好地应对未来。如果这解决了你的问题，请告诉我。 - Peter

它的功能很好，只有一个问题。有时“FindStyleResource”会返回nil，导致应用程序崩溃。因此，我添加了类似以下代码：Text := Button.FindStyleResource('text', false) as TText; 如果文本是TText类型，则执行以下操作... - Regis St-Gelais

我在Bitmap := TBitmap.Create;之前添加了它，以便在不需要时不创建位图。 - Regis St-Gelais

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;

- yonojoy

---

@Peter 请随意更新您的答案，加入这段代码。然后我会删除我的答案，因为这个想法是您的原创。 - yonojoy

在Android上运行得很好，但在Windows上它的大小只有应该有的一半...？（D10 Seattle） - Jerry Dodge

@JerryDodge 我在Windows上使用XE4和XE8测试过，没有遇到任何问题。Peter的解决方案（ButtonAutoSizeEx）对你有用吗？ - yonojoy