За годы существования фреймворк 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;

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

Не забываем голосовать :)
Пользуетесь ли FMX?

Проголосовало 42 человека. Воздержалось 16 человек.

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

Поделиться с друзьями
-->

Комментарии (5)


  1. Sirion
    20.12.2016 20:56

    В голосовалке не хватает варианта «был искренне уверен, что делфи уже умер». Шутка. Хороший пост. Лично мне не пригодится, но познавательно.


    1. Error1024
      21.12.2016 23:31
      +1

      Шли годы, мимо проходили «убийцы Delphi», некоторые «убийцы» — умирали и забывались.
      Будущее в котором все в вебе, так и не наступало, а Delphi продолжал оставаться лучшим средством разработки нативных WIn32 приложений с нативным интерфейсом, появилась многоплатформенность, язык продолжал развиваться и использоваться :)


  1. ElectroGuard
    21.12.2016 23:24
    +1

    Пиши еще, интересно.


  1. MrShoor
    26.12.2016 06:17

    Не пользуюсь FM, и ничего против не имею, но глядя на картинку к посту и на название поста — в голове крутится мысль: «Тут уже ничего не поможет».

    p.s. Сохраню картинку тут, для истории.
    image


    1. Error1024
      26.12.2016 14:08

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