Auto Resize Delphi Button

I want to dynamically change the title to TButton . The problem is that TButton does not resize if the label is too long to fit on the button; therefore, the text bleeds around the edges of the button.

How can I get a button to resize to sign a signature?

Some ideas:

  • Use another button component that can resize. There is one?
  • Subclass TButton and set AutoSize=True (I have not tried this, I don’t know if it will work).
  • Calculate the title size in pixels and manually change the width each time the title is changed.
+8
button delphi delphi-2010 autosize
source share
2 answers

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

My code looks something like this:

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

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.

+17
source share

All Articles