За годы существования фреймворк Fire-Monkey(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; Надеюсь данная заметка оказалась вам полезной 🙂
ссылка на оригинал статьи https://habrahabr.ru/post/317814/
Добавить комментарий