[英]Automatically resize a Delphi button
我想动态更改TButton
上的标题。 问题是如果标题太长而无法放在按钮上, TButton
就不会自行调整大小; 所以文字在按钮的边缘流血。
如何让按钮更改大小以适合标题?
一些想法:
TButton
并设置AutoSize=True
(没试过这个,不知道它是否会起作用)。 子类TButton
,将已存在的AutoSize
属性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
可以考虑主题Themes.ThemeServices.ThemesEnabled
。 为真时,为可与所获得的文本保留的内容RECT 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;
而且我必须诚实:它看起来更好。
我最终选择了选项3(“以像素为单位计算标题的大小,每次更改标题时手动更改宽度”)
我的代码看起来像这样:
// Called from the form containing the button
button.Caption := newCaption;
button.Width := self.Canvas.TextWidth(newCaption);
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.