Автоматическое изменение размера кнопки Delphi - PullRequest
Новая
       13

Автоматическое изменение размера кнопки Delphi

9 голосов
/ 13 марта 2012

Я хочу динамически изменить заголовок на TButton.Проблема в том, что TButton не меняет свой размер, если заголовок слишком длинный, чтобы поместиться на кнопке;поэтому текст обливается по краям кнопки.

Как заставить кнопку изменить размер в соответствии с заголовком?

Некоторые идеи:

  • Использованиедругой компонент кнопки, который может изменить свой размер.Есть ли один?
  • Подкласс TButton и установите AutoSize=True (не пробовал, не знаю, сработает ли он).
  • Рассчитайте размер заголовка в пикселяхи вручную меняйте ширину каждый раз, когда я изменяю заголовок.

Ответы [ 2 ]

18 голосов
/ 13 марта 2012

Подкласс 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;

Обновление:

По адресу Комментарий Дэвида о том, почему жестко запрограммировано 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;

И я должен быть честным: это выглядит лучше.

5 голосов
/ 14 марта 2012

В итоге я выбрал вариант 3 («Рассчитать размер заголовка в пикселях и вручную изменять ширину при каждом изменении заголовка»)

Мой код выглядит примерно так: 

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