Fire-Monkey help and tips

Over the years, the Fire-Monkey (FMX) framework has undergone many changes, and if from the very beginning it was very raw and unreliable, now it is a much more stable and reliable platform.

This article is a collection of several useful tips for developers using this framework.

')
If the note is positively received by the community, I will periodically publish notes about FMX in this format.

Text size calculation

Questions about the size of the text are quite frequent, to calculate the size of the text, you can use the following function:

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

This is a function for calculating the size of a rectangle occupied by single-line text.

Options:

• Text - Text
• Font - Font with which the text will be displayed
• Size - if 0, then Font. Size will be used from Font, otherwise from this parameter

Source:

 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; 

The maximum possible font size for text inscribed in a given rectangle

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

The function returns the maximum possible font size for text inscribed in the specified rectangle.

Options:

• Text - Text
• Font - Font with which the text will be displayed
• Width, Height - The width and height of the rectangle.
• MaxFontSize - Maximum possible font size

Source:

 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; 

What is wrong with FindStyleResource and what to do

FAQ:

I will describe the "bugofich" that I came across.

Suppose that you are writing your component inherited from TStyledControl (or any other component that inherits from TStyledControl ), you usually use FindStyleResource ('Resource Name') to access the style elements (there is a variant in the form FindStyleResource <Class> ('Resource Name', Variable) ), for example, the TImageControl component receives an Image object like this:

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

FindStyleResource works fine as long as the desired object in the style tree lies in NOT TStyledControl (and their heirs), that is, FindStyleResource will successfully find an object that is located on the TRectangle , but does not find it, but on TPanel !

Example:

Code in the ApplyStyle procedure:

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

What does this code do? - When a style object is found, it gives an appropriate message.

Consider the style:



As you can see in option A , “Selection” is NOT the heir from TStyledControl . By running the program, you can make sure that FindStyleResource <TControl> ('selection', T) finds the Selection object.

In option B , at startup, you can be surprised to find that FindStyleResource <TControl> ('selection', T) does not find the Selection object!

Why is that?

Judging by the source code, the search in the nested TStyledControl is broken specially so that no more glitches \ problems emerge (but I didn’t study the issue in great detail, the internal code for working with loading and searching for styles is complete hell, with different years of Fire-Monkey layering ).

How can I get around the problem?

Through several iterations, the function EsFindStyleResource was written, which finds the desired style object, in contrast to the FindStyleResource .

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

Options:

• Self - TStyledControl
• StyleName - Name of the object being searched.

Source:

 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; 

Risks (Ticks) at TTrackBar

In the Fire-Monkey component, TTrackBar does not have a built-in ability to draw “risks”, but this feature is sometimes necessary, the DrawTicks function allows you to “return” this feature to FMX .
The function must be called in the OnPainting handler of the TTrackBar component.

The result of the function:

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

Options:

• Control - TTrackBar on which to draw risks
• Offset - Shift from start
• PageSize - Distance between risks
• DrawBounds - Draw or not boundary risks
• LineKind - Line type (TLineKind = (Up, Down, Left, Right, Both))
• LineWidth - Line Length
• LineSpace - The distance from the center of the component to the beginning of the line.
• Color - Line color

Source:

 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, LY + Trunc(Cnt.Height / 2) - LineWidth + 0.5), PointF(Coord + 0.5, LY + 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, LY + Trunc(Cnt.Height / 2) + LineSpace + 0.5), PointF(Coord + 0.5, LY + 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, LY + Trunc(Cnt.Height / 2) - LineSpace - 0.5), PointF(Coord + 0.5, LY + 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(LX + Trunc(Cnt.Width / 2) - LineWidth + 0.5, Coord + 0.5), PointF(LX + 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(LX + Trunc(Cnt.Width / 2) + LineWidth + 0.5, Coord + 0.5), PointF(LX + 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(LX + Trunc(Cnt.Width / 2) - LineWidth - 0.5, Coord + 0.5), PointF(LX + 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; 

I hope this post was helpful to you.

Do not forget to vote :)