Небольшой обмен опытом. О размере текста, TTextLaout.

[Error]

*** Небольшой обмен опытом ***

Вижу что вопросы о размере текста довольно частые, поделюсь своими наработками.

function CalcTextSize(Text: string; Font: TFont; Size: Single = 0): TSizeF;

Функция для расчета размера прямоугольника, занимаемого однострочным текстом.

Параметры:

• Text - Текст
• Font - Шрифт с которым будет выводиться текст
• Size - если 0, то Font.Size будет использоваться из Font, иначе из данного параметра

Исходный код:

uses
  System.Types, FMX.Types, FMX.Graphics, FMX.TextLayout, System.Math, System.SysUtils;

function CalcTextSize(Text: string; Font: TFont; Size: Single = 0): TSizeF;
var
  TextLayout: TTextLayout;
begin
  TextLayout := TTextLayoutManager.DefaultTextLayout.Create;
  try
    TextLayout.BeginUpdate;
    try
      TextLayout.Text := Text;
      TextLayout.MaxSize := TPointF.Create(9999, 9999);
      TextLayout.Font.Assign(Font);
      if not SameValue(0, Size) then
      begin
        TextLayout.Font.Size := Size;
      end;
      TextLayout.WordWrap := False;
      TextLayout.Trimming := TTextTrimming.None;
      TextLayout.HorizontalAlign := TTextAlign.Leading;
      TextLayout.VerticalAlign := TTextAlign.Leading;
    finally
      TextLayout.EndUpdate;
    end;

    Result.Width := TextLayout.Width;
    Result.Height := TextLayout.Height;
  finally
    TextLayout.Free;
  end;
end;

function FontSizeForBox(Text: string; Font: TFont; Width, Height: Single; MaxFontSize: Single = cMaxFontSize): Integer;

Функция возвращающая максимально возможный размер шрифта, для текста вписанного в заданный прямоугольник.

Параметры:

• Text - Текст
• Font - Шрифт с которым будет выводиться текст
• Width, Height - Ширина и высота прямоугольника
• MaxFontSize - Максимально возможный размер шрифта

Исходный код:

uses
  System.Types, FMX.Types, FMX.Graphics, FMX.TextLayout, System.Math, System.SysUtils;

const
  cMaxFontSize = 512;

function FontSizeForBox(Text: string; Font: TFont; Width, Height: Single; MaxFontSize: Single = cMaxFontSize): Integer;
var
  Size, Max, Min, MaxIterations: Integer;
  Current: TSizeF;
begin
  Max := Trunc(MaxFontSize);
  Min := 0;

  MaxIterations := 20;
  repeat
    Size := (Max + Min) div 2;

    Current := CalcTextSize(Text, Font, Size);

    if ((Abs(Width - Current.Width) < 1) and (Width >= Current.Width)) and
      ((Abs(Height - Current.Height) < 1) and (Height >= Current.Height)) then
      break
    else
    if (Width < Current.Width) or (Height < Current.Height) then
      Max := Size
    else
      Min := Size;

    Dec(MaxIterations);
  until MaxIterations = 0;

  Result := Size;
end;

---

Также данные функции можно найти в этом юните

[Alex7wrt]

Спасибо. Очень интересно и полезно.
Некоторые пожелания:
1. Функцию FontSizeForBox можно было бы привести к типу single, так как в FMX шрифт может быть нецелым и, кроме того, функция CalcTextSize у вас определяется типом TSizeF.

2. Расширить функциональность FontSizeForBox на случай многострочного текста.

[Error]

20 минут назад, Alex7wrt сказал:

1. Функцию FontSizeForBox можно было бы привести к типу single, так как в FMX шрифт может быть нецелым и, кроме того, функция CalcTextSize у вас определяется типом TSizeF

К сожалению, это сделает функцию более медленной, я был перед выбором или скорость или точность, учитывая уже имеющиеся тормоза FMX я решил выбрать скорость. Но даже так функция работает весьма не плохо.

23 минуты назад, Alex7wrt сказал:

2. Расширить функциональность FontSizeForBox на случай многострочного текста.

Да, в будущем расширю обе функции для этого.