Fire-Monkey help and tips

За годы существования фреймворк Fire-Monkey(FMX) претерпел множество изменений, и если с самого начала он был очень сырым и ненадежным, то сейчас это намного более стабильная и надежная платформа.

Данная заметка представляет из себя сборник из нескольких полезных советов для разработчиков использующих данный фреймворк.


Если заметка будет положительно воспринята сообществом, то я буду периодически публиковать заметки о FMX в таком формате.

Расчет размера текста

Вопросы о размере текста довольно частые, для расчета размера текста можно воспользоваться следующей функцией:

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;

Что не так с FindStyleResource и что делать

ЧАВО:

Опишу «багофичу» на которую я наткнулся.

Предположим, что вы пишете свой компонент, наследуемый от TStyledControl (или любого другого компонента, который наследуется от TStyledControl), для доступа к элементам стиля обычно используют FindStyleResource('ИмяРесурса') (есть вариант в виде FindStyleResource<Класс>('ИмяРесурса', Переменная)), например компонент TImageControl получает объект Image так:

procedure TImageControl.ApplyStyle;
begin
  inherited;
  if FindStyleResource<TImage>('image', FImage) then
    UpdateImage;
end;

FindStyleResource работает отлично, пока в дереве стиля искомый объект лежит на НЕ TStyledControl-ах(и их наследниках), то есть FindStyleResource будет успешно находить объект, который расположен на TRectangle, но не найдет его же, но на TPanel!

Пример:

Код, в процедуре ApplyStyle:

procedure TEsImageSelection.ApplyStyle;
var
  T: TControl;
begin
  inherited ApplyStyle;
  if FindStyleResource<TControl>('selection', T) then
    ShowMessage('"selection" founded!');
end;

Что делает данный код? — При нахождении стилевого объекта выдает соответствующее сообщение.

Рассмотрим стиль:



Как видите в варианте A, «Selection» лежит на НЕ наследнике от TStyledControl. Запустив программу можно убедиться что FindStyleResource<TControl>('selection', T) найдет объект Selection.

В варианте B, при запуске можно с удивлением обнаружить что FindStyleResource<TControl>('selection', T) не находит объект Selection!

Почему так?

Судя по исходникам поиск во вложенных TStyledControl-ах сломан специально, дабы не всплывали еще большие глюки\проблемы.(но я не изучал вопрос очень подробно, внутренний код работы с загрузкой и поиском стилей — кромешный ад, с наслаиванием истории Fire-Monkey разных лет).

Как можно обойти проблему?

Путем нескольких итераций была написана функция EsFindStyleResource, которая находит искомый стилевой объект, в отличии от FindStyleResource.

function EsFindStyleResource(Self: TStyledControl; StyleName: string): TFmxObject;

Параметры:

• Self — TStyledControl
• StyleName — Имя искомого объекта

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

type
  TOpenStyledControl = class(TStyledControl);

function EsFindStyleResource(Self: TStyledControl; StyleName: string): TFmxObject;
var
  StyleObject: TFmxObject;
begin
  // если Self.ChildrenCount < 1 то в компоненте не загружен стиль,
  // т.к. известно что главный эллемент стиля ВСЕГДА находиться по нулевому индексу.
  if (TOpenStyledControl(Self).ResourceLink = nil) or (Self.ChildrenCount < 1) then
    Exit(nil);

  StyleObject := nil;

  Self.Children[0].EnumObjects(
    function (Obj: TFmxObject): TEnumProcResult
    begin
      if Obj.StyleName.ToLower = StyleName.ToLower then
      begin
        Result := TEnumProcResult.Stop;
        StyleObject := Obj;
      end else
        Result := TEnumProcResult.Continue;
    end);

  Result := StyleObject;
end;

Риски(Ticks) у TTrackBar

В Fire-Monkey компонент TTrackBar не имеет встроенной возможности отрисовывать «риски», но такая возможность иногда необходима, функция DrawTicks позволяет «вернуть» в FMX эту возможность.
Функцию необходимо вызывать в обработчике OnPainting компонента TTrackBar.

Результат работы функции:

procedure DrawTicks(Control: TTrackBar; Offset: Single; PageSize: Single; DrawBounds: Boolean;
  LineKind: TLineKind; LineWidth, LineSpace: Single; Color: TAlphaColor);

Параметры:

• Control — TTrackBar на котором надо нарисовать риски
• Offset — Сдвиг от начала
• PageSize — Расстояние между рисками
• DrawBounds — Рисовать или нет граничные риски
• LineKind — Тип линий (TLineKind = (Up, Down, Left, Right, Both))
• LineWidth — Длина линии
• LineSpace — Расстояние от центра компонента, до начала линии
• Color — Цвет линий

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

type
  TLineKind = (Up, Down, Left, Right, Both);

procedure DrawTicks(Control: TTrackBar; Offset: Single; PageSize: Single; DrawBounds: Boolean;
  LineKind: TLineKind; LineWidth, LineSpace: Single; Color: TAlphaColor);
var
  Obj: TFmxObject;
  Cnt: TControl;
  L: TPointF;
  Coord, RealCoord: Single;

  function GetCoord(Value: Single): Single;
  begin
    if Control.Orientation = TOrientation.Horizontal then
      Result := Ceil(THTrackBar(Control).GetThumbRect(Value).CenterPoint.X)//  + Crutch
    else
      Result := Ceil(THTrackBar(Control).GetThumbRect(Value).CenterPoint.Y);//  + Crutch;
  end;

  procedure DrawLine(Coord: Single);
  begin
    if Control.Orientation = TOrientation.Horizontal then
    begin
      if (SameValue(LineSpace, 0)) and (LineKind = TLineKind.Both) then
      begin
        Control.Canvas.DrawLine(
          PointF(Coord + 0.5, L.Y + Trunc(Cnt.Height / 2) - LineWidth + 0.5),
          PointF(Coord + 0.5, L.Y + Trunc(Cnt.Height / 2) + LineWidth - 0.5), 1)
      end else
      begin
        if (LineKind = TLineKind.Down) or (LineKind = TLineKind.Both) then
          Control.Canvas.DrawLine(
            PointF(Coord + 0.5, L.Y + Trunc(Cnt.Height / 2) + LineSpace + 0.5),
            PointF(Coord + 0.5, L.Y + Trunc(Cnt.Height / 2) + LineSpace + LineWidth - 0.5), 1);
        if (LineKind = TLineKind.Up) or (LineKind = TLineKind.Both) then
          Control.Canvas.DrawLine(
            PointF(Coord + 0.5, L.Y + Trunc(Cnt.Height / 2) - LineSpace - 0.5),
            PointF(Coord + 0.5, L.Y + Trunc(Cnt.Height / 2) - LineSpace - LineWidth + 0.5), 1);
      end;
    end else
    begin
      if (SameValue(LineSpace, 0)) and (LineKind = TLineKind.Both) then
      begin
        Control.Canvas.DrawLine(
          PointF(L.X + Trunc(Cnt.Width / 2) - LineWidth + 0.5, Coord + 0.5),
          PointF(L.X + Trunc(Cnt.Width / 2) + LineWidth - 0.5, Coord + 0.5), 1)
      end else
      begin
        if (LineKind = TLineKind.Right) or (LineKind = TLineKind.Both) then
          Control.Canvas.DrawLine(
            PointF(L.X + Trunc(Cnt.Width / 2) + LineWidth + 0.5, Coord + 0.5),
            PointF(L.X + Trunc(Cnt.Width / 2) + LineWidth + LineWidth - 0.5, Coord + 0.5), 1);
        if (LineKind = TLineKind.Left) or (LineKind = TLineKind.Both) then
          Control.Canvas.DrawLine(
            PointF(L.X + Trunc(Cnt.Width / 2) - LineWidth - 0.5, Coord + 0.5),
            PointF(L.X + Trunc(Cnt.Width / 2) - LineWidth - LineWidth + 0.5, Coord + 0.5), 1);
      end;
    end;
  end;

begin
  if Control.Orientation = TOrientation.Horizontal then
    Obj := Control.FindStyleResource('htrack')
  else
    Obj := Control.FindStyleResource('vtrack');

  if Obj = nil then
    Exit;

  Cnt := Obj.FindStyleResource('background') as TControl;
  if Cnt = nil then
    Exit;

  Control.Canvas.Stroke.Thickness := 1;
  Control.Canvas.Stroke.Kind := TBrushKind.Solid;
  Control.Canvas.Stroke.Color := Color;

  L := Cnt.LocalToAbsolute(PointF(0, 0)) - Control.LocalToAbsolute(PointF(0, 0));
  if DrawBounds and not SameValue(Offset, 0.0) then
    DrawLine(GetCoord(Control.Min));

  Coord := Offset + Control.Min;
  while Coord <= Control.Max - Control.Min do
  begin
    if (Coord >= Control.Min) and (Coord <= Control.Max) then
    begin
      RealCoord := GetCoord(Coord);
      DrawLine(RealCoord);
    end;
    Coord := Coord + PageSize;
  end;

  if DrawBounds and not SameValue(GetCoord(Control.Max), GetCoord(Coord - PageSize)) then
    DrawLine(GetCoord(Control.Max));
end;

Надеюсь, данная заметка оказалась вам полезной.

Не забываем голосовать :)