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;

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

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

    Only registered users can participate in poll. Log in, please.

    Пользуетесь ли FMX?

    Share post

    Similar posts

    Comments 5

      0
      В голосовалке не хватает варианта «был искренне уверен, что делфи уже умер». Шутка. Хороший пост. Лично мне не пригодится, но познавательно.
        +1
        Шли годы, мимо проходили «убийцы Delphi», некоторые «убийцы» — умирали и забывались.
        Будущее в котором все в вебе, так и не наступало, а Delphi продолжал оставаться лучшим средством разработки нативных WIn32 приложений с нативным интерфейсом, появилась многоплатформенность, язык продолжал развиваться и использоваться :)
        +1
        Пиши еще, интересно.
          0
          Не пользуюсь FM, и ничего против не имею, но глядя на картинку к посту и на название поста — в голове крутится мысль: «Тут уже ничего не поможет».

          p.s. Сохраню картинку тут, для истории.
          image
            0
            История с картинкой — проста, не знал что поставить для привлечения внимания, наткнулся на свой пиксельарт, нарисованный во время хайпа Трампа, ради прикола, и заменил фон.

          Only users with full accounts can post comments. Log in, please.