Subclass TButton , make the existing 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 hard-coded 8 pixels: Simply put, this looks just fine. But I did a little visual study on the width of the borders of the 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 into account the operating system, see Obtaining a version of Windows . They could be taken into account by rating Themes.ThemeServices.ThemesEnabled . When true, the contents of rect are reserved for text, which can be obtained using GetThemeBackgroundContentRect , which is wrapped in 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 using this procedure shows a constant border size of 3 pixels in any version and with any button state. Thus, 8 pixels of total margin leaves 1 pixel of text space for text.
And to take into account the font size, 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 have to be honest: it looks better.