Font.GetTextWidth

[Vlad04]

Уважаемые форумчане!
Возникла необходимость в программе изменять шрифт на форме и, соответственно этому изменять размер и положение компонентов на форме. Для изменения размеров компонентов написал такую процедуру:

Код: Выделить всё

uses StrUtils ;

procedure SetSize(C : TControl ; MaxLStr : word) ;
var
  St : ansistring ;
begin
  St := dupestring('W',MaxLStr) ;
  C.ClientWidth := C.Font.GetTextWidth(St) ;
  C.ClientHeight := C.Font.GetTextHeight(St) ;
end ;


которая на входе принимает компонент и максимальный размер строки ввода. Однако она не работает, функции GetTextWidth и GetTextHeight выдают неверные значения (очень маленькие).
Что скажете?

[alexs]

А почему нельзя использовать привязки и свойство AutoSize, которое есть практически у всех компонентов?
И ничего не надо самому считать...

[Vlad04]

А почему нельзя использовать привязки и свойство AutoSize

Потому что AutoSize у TComboBox и TMaskEdit не работает. У других не проверял, но подозреваю, что оно не работает у всех компонентов, поддерживающих редактирование данных.

[alexs]

По высоте работает.
А по ширине решается привязками.

[sign]

Используйте .Canvas.GetTextWidth(St) и будет вам счастье.

[Vlad04]

alexs, привязки работают при изменении размера формы, а сама форма, при изменении размера шрифта не увеличивается. Таким образом, получается замкнутый круг: для увеливения компонентов надо увеличить форму, а для увеличения формы надо знать размер увеличенных компонентов. Плюс, если в ширину расположено несколько элементов, то привязки не дают желаемого рузельтата - элементы перекрывают друг друга.
sign, у TControl и TWinControl свойство Canvas отсутствует, также как и у TMaskEdit. А писать отдельную процедуру для каждого типа компонета не очень "красиво".
Нашел обходной маневр

Код: Выделить всё

procedure SetSize(C : TControl ; MaxLStr : word) ; // подгонка размеров компонента под размер строки
var
  St : ansistring ;
begin
  St := dupestring('W',MaxLStr) ;
  C.ClientWidth := TCustomControl(C.Parent).Canvas.TextWidth(St) ;
  C.ClientHeight := TCustomControl(C.Parent).Canvas.TextHeight(St) ;
end ;

посмотрим, насколько он будет действеннен.
Однако, вопрос остаётся: почему Font.GetTextWidth(St) выдает неправильный размер?

Добавлено спустя 9 часов 55 минут 31 секунду:
Также встает вопрос: что делать с TGroupBox, TRadioGroup и TCheckGroup?...

[sign]

А что вы хотите с ними делать?

[Vlad04]

Они могут содержать компоненты, следовательно являются для них родителями, а свойства Canvas не имеют и "обходной манёвр" с ними не сработает.

[sign]

А в чём проблема найти родителя по цепочке вверх, который имеет канвас?

Добавлено спустя 22 минуты 18 секунд:

Код: Выделить всё

procedure SetSize(C : TControl ; const S: String);
var w, h: Integer;
    Cnv: TCanvas;
  function FindCanvas: TCanvas;
  var P: TComponent;
  begin
    P := TComponent(C).Owner;
    while Assigned(P) do begin
      if P is TGraphicControl then Exit(TGraphicControl(P).Canvas) else
      if P is TCustomControl then Exit(TCustomControl(P).Canvas);
      P  := P.Owner;
    end;
    Result := nil;
  end;
begin
  Cnv := FindCanvas;
  if Assigned(C) then Cnv.GetTextSize(S, w, h) else Exit;
  C.ClientWidth := w + 10;
  C.ClientHeight := h;
end ;

procedure TfBook.SpeedButton1Click(Sender: TObject);
var S: String;
begin
  S := 'Проверка ширины вводимого текста';
  SetSize(Edit1, S);
  Edit1.Text := S;
end;

procedure TfBook.SpeedButton2Click(Sender: TObject);
var S: String;
begin
  S := 'Проверка ширины вводимого текста. А это ещё длиннее';
  SetSize(Edit1, S);
  Edit1.Text := S;
end;


[Vlad04]

Вы правы: проблем нет.