Automatically resize a Delphi button

Question

I want to dynamically change the caption on a TButton. The problem is that TButton doesn't resize itself if the caption is too long to fit on the button; so the text bleeds over the edges of the button.

How can I get the button to change size to fit the caption?

Some ideas:

Use a different button component that can resize itself. Is there one?
Subclass TButton and set AutoSize=True (haven't tried this, don't know if it will work).
Calculate the size of the caption in pixels and manually change the width every time I change the caption.

score 18 · Answer 1 · edited May 23 '17 at 11:58

Subclass TButton, make the already present AutoSize property public, and implement 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;

Update:

To address David's comment on why the hard coded 8 pixels: Simply put, it looks just fine. But I did a little visual research on border widths of buttons:

   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

To take the operating system into account, see Getting the Windows version. Theming could be taken into account by evaluating Themes.ThemeServices.ThemesEnabled. When true, the content rect reserved for the text can be obtained with GetThemeBackgroundContentRect which is wrapped by the ThemeServices variable:

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);

Repeating my test with this routine shows a constant border size of 3 pixels in either version and with any button state. Thus 8 pixels of total margin leaves 1 pixel breathing space for the text.

And to take the font size into account, I suggest the following change:

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;

And I must be honest: it looks better.

If you implement CanAutoSize, I think the 2 Messages procedure from TLama version should no longer kept there? +1 for simplify though. — Justmade, Mar 13 '12 at 06:03
@Justmade No, you still need them. `TControl`, in which `AutoSize` is implemented, does take `Caption` nor `Font` in consideration. — NGLN, Mar 13 '12 at 06:06
+1, I was going to make a review of my answer but I wouldn't do it as efficient as you. — TLama, Mar 13 '12 at 06:24
+1 what's with the +8? Is that a standard VCL-ism? It's going to lead to pain for high pixel density displays, or larger fonts. I think the margins ideally ought to be non-dimensionalised against a typical char height or width. — David Heffernan, Mar 13 '12 at 06:41
@NGLN, in TControl, AutoSize property and its dependencies are just inheritable behaviours to cope with alignment/docking, it does not to any "real" job. Look at DoCanAutoSize for example. And i think you are forgetting to call inherited. — OnTheFly, Mar 13 '12 at 08:53
@user539484 On `TControl` not doing any job you're quite right and I could have better said that `TControl` doesn't take ány property in consideration. Descendants still might however. As for forgetting to call inherited: I didn't. For a button, `TWinControl.CanAutoSize` hasn't much to offer since it has no children. Calling inherited is a choice, not a must. Note that `TWinControl.CanAutoSize` doesn't call inherited either. — NGLN, Mar 13 '12 at 11:55
Great and thorough answer. I almost feel ashamed I didn't use it :-) — awmross, Mar 13 '12 at 23:25
I haven't "accepted" this answer as I haven't actually run the code myself, as it wasn't the solution I was looking for. See my (accepted) answer for the solution I used. — awmross, Mar 20 '12 at 22:38
If you want TLama to be notified, then add @TLama to the comment. Also: if you didn't run the code, how did you deside it wasn't the solution? No hard feelings by the way. — NGLN, Mar 20 '12 at 23:03
@NGLN It wasn't the solution *for me* because I didn't want to add and maintain a new custom component when I could just add one line of code instead. OTOH If this was a problem I had to solve regularly I would try your solution. — awmross, Mar 27 '12 at 03:20

score 7 · Accepted Answer · answered Mar 13 '12 at 23:24

I ended up going with option 3 ("Calculate the size of the caption in pixels and manually change the width every time I change the caption")

My code looks somthing like this:

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

Automatically resize a Delphi button

2 Answers2

Update: