自动调整 Delphi 按钮的大小答案

【问题标题】：Automatically resize a Delphi button自动调整 Delphi 按钮的大小
【发布时间】：2012-03-13 03:35:03
【问题描述】：

我想动态更改 TButton 上的标题。问题是TButton 不会在标题太长而无法放在按钮上时自行调整大小；所以文本会溢出按钮的边缘。

如何让按钮改变大小以适应标题？

一些想法：

使用其他可以调整自身大小的按钮组件。有吗？
子类TButton并设置AutoSize=True（这个没试过，不知道行不行）。
以像素为单位计算标题的大小，并在每次更改标题时手动更改宽度。

【问题讨论】：

标签： delphi button delphi-2010 autosize

【解决方案1】：

子类TButton，将已经存在的AutoSize属性公开，并实现CanAutoSize：

type
  TButton = class(StdCtrls.TButton)
  private
    procedure CMFontchanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMTextchanged(var Message: TMessage); message CM_TEXTCHANGED;
  protected
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
  public
    property AutoSize;
  end;

function TButton.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
const
  WordBreak: array[Boolean] of Cardinal = (0, DT_WORDBREAK);
var
  DC: HDC;
  R: TRect;
  SaveFont: HFONT;
  DrawFlags: Cardinal;
begin
  DC := GetDC(Handle);
  try
    SetRect(R, 0, 0, NewWidth - 8, NewHeight - 8);
    SaveFont := SelectObject(DC, Font.Handle);
    DrawFlags := DT_LEFT or DT_CALCRECT or WordBreak[WordWrap];
    DrawText(DC, PChar(Caption), Length(Caption), R, DrawFlags);
    SelectObject(DC, SaveFont);
    NewWidth := R.Right + 8;
    NewHeight := R.Bottom + 8;
  finally
    ReleaseDC(Handle, DC);
  end;
  Result := True;
end;

procedure TButton.CMFontchanged(var Message: TMessage);
begin
  inherited;
  AdjustSize;
end;

procedure TButton.CMTextchanged(var Message: TMessage);
begin
  inherited;
  AdjustSize;
end;

更新：

解决David's comment 为什么硬编码 8 像素：简单地说，它看起来很好。但我对按钮的边框宽度做了一点视觉研究：

   Button state               Windows XP         Windows 7
                              Classic  Themed    Classic  Themed
   Focused, incl. focus rect     5        4         5        3
   Focused, excl. focus rect     3        4         3        3
   Not focused                   2        2         2        2
   Disabled                      2        1         2        2

要考虑操作系统，请参阅Getting the Windows version。可以通过评估 Themes.ThemeServices.ThemesEnabled 来考虑主题。当为 true 时，可以使用 GetThemeBackgroundContentRect 获得为文本保留的内容 rect，它由 ThemeServices 变量包裹：

uses
  Themes;
var
  DC: HDC;
  Button: TThemedButton;
  Details: TThemedElementDetails;
  R: TRect;
begin
  DC := GetDC(Button2.Handle);
  try
    SetRect(R, 0, 0, Button2.Width, Button2.Height);
    Memo1.Lines.Add(IntToStr(R.Right - R.Left));
    Button := tbPushButtonNormal;
    Details := ThemeServices.GetElementDetails(Button);
    R := ThemeServices.ContentRect(DC, Details, R);

使用此例程重复我的测试显示，在任一版本和任何按钮状态下，边框大小均为 3 像素。因此 8 像素的总边距为文本留下 1 像素的喘息空间。

考虑到字体大小，我建议进行以下更改：

function TButton.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
const
  WordBreak: array[Boolean] of Cardinal = (0, DT_WORDBREAK);
var
  DC: HDC;
  Margin: Integer;
  R: TRect;
  SaveFont: HFONT;
  DrawFlags: Cardinal;
begin
  DC := GetDC(Handle);
  try
    Margin := 8 + Abs(Font.Height) div 5;
    SetRect(R, 0, 0, NewWidth - Margin, NewHeight - Margin);
    SaveFont := SelectObject(DC, Font.Handle);
    DrawFlags := DT_LEFT or DT_CALCRECT or WordBreak[WordWrap];
    DrawText(DC, PChar(Caption), -1, R, DrawFlags);
    SelectObject(DC, SaveFont);
    NewWidth := R.Right + Margin;
    NewHeight := R.Bottom + Margin;
  finally
    ReleaseDC(Handle, DC);
  end;
  Result := True;
end;

我必须说实话：它看起来更好。

【讨论】：

+1，我打算对我的答案进行审查，但我不会像你那样高效。
+1 +8 有什么用？那是标准的 VCL 主义吗？这将导致高像素密度显示器或更大字体的痛苦。我认为理想情况下，边距应该针对典型的字符高度或宽度进行无量纲化。
伟大而彻底的答案。我几乎为我没有使用它而感到羞耻:-)
如果您希望 TLama 收到通知，请在评论中添加 @TLama。另外：如果你没有运行代码，你怎么认为它不是解决方案？顺便说一句，没有难过的感觉。
@NGLN 这不是解决方案对我来说，因为我不想添加和维护一个新的自定义组件，而我可以只添加一行代码。 OTOH 如果这是我必须定期解决的问题，我会尝试您的解决方案。

【解决方案2】：

我最终选择了选项 3（“以像素为单位计算标题的大小，并在每次更改标题时手动更改宽度”）

我的代码看起来像这样：

// Called from the form containing the button
button.Caption := newCaption;
button.Width := self.Canvas.TextWidth(newCaption);

【讨论】：