自动调整Delphi按钮的大小

Question

自动调整Delphi按钮的大小

delphibuttondelphi-2010autosize

9

我想在 TButton 上动态更改标题。问题在于，如果标题过长，TButton 不会自行调整大小，因此文本会溢出按钮的边缘。

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

一些想法：

使用可以调整大小的不同按钮组件。是否有这样的组件？
子类化 TButton 并设置 AutoSize=True (未尝试过，不知道是否有效)。
计算标题的像素大小，并在每次更改标题时手动更改宽度。

- awmross

2个回答

7

我最终选择了第三个选项（“计算字幕的像素大小，并在更改字幕时手动更改宽度”）。

我的代码大致如下：

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

- awmross

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- NGLN · Accepted Answer

继承 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的评论，问为什么硬编码为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

要考虑操作系统，请参阅获取Windows版本。通过评估Themes.ThemeServices.ThemesEnabled可以考虑主题。当为true时，可以使用GetThemeBackgroundContentRect获取为文本保留的内容矩形，并由 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;

我必须诚实地说：看起来更好。