{***************************************************}
{                                                   }
{             FastReport v4.0                       }
{          Things missing in FMX                    }
{                                                   }
{         Copyright (c) 1998-2011                   }
{         by Alexander Tzyganenko,                  }
{            Fast Reports Inc.                      }
{                                                   }
{***************************************************}

unit FMX.frxFMX;

interface

{$I fmx.inc}
{$I frx.inc}

uses
  System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Controls,
  System.Types, System.UIConsts, FMX.ListBox, FMX.Objects, System.Math,
  FMX.TreeView, FMX.Edit, FMX.Forms, FMX.Platform, System.Variants
{$IFDEF DELPHI18}
  ,FMX.StdCtrls
{$ENDIF}
{$IFDEF DELPHI19}
  , FMX.TextLayout , FMX.Graphics
{$ENDIF}
{$IFDEF DELPHI20}
  , System.Math.Vectors
{$ENDIF}
{$IFDEF MSWINDOWS}
, Winapi.Windows, Winapi.WinSpool, Winapi.Messages
{$ENDIF}
{$IFDEF LINUX}
 ,FMUX.Api
{$ENDIF}
{$IFDEF MACOS}
, Macapi.CoreText, Macapi.CoreFoundation, MacApi.CocoaTypes, Macapi.Foundation, FMX.Canvas.Mac, MacApi.CoreGraphics, Macapi.AppKit
{$ENDIF}
{$IFDEF DELPHI28}
  , FMX.BaseTypeAliases, FMX.FormTypeAliases
{$ENDIF};

const
  DMBIN_AUTO = 7;
{$EXTERNALSYM DMBIN_AUTO}
  DMPAPER_A4 = 9;
{$EXTERNALSYM DMPAPER_A4}
  DMPAPER_USER = 256;
{$EXTERNALSYM DMPAPER_USER}
  VK_F1 = vkF1;
{$EXTERNALSYM VK_F1}
  poPortrait = TPrinterOrientation.poPortrait;
  poLandscape = TPrinterOrientation.poLandscape;
  fsBold = TFontStyle.fsBold;
  fsItalic = TFontStyle.fsItalic;
  fsUnderline = TFontStyle.fsUnderline;
  fsStrikeout = TFontStyle.fsStrikeout;
  mbLeft = TMouseButton.mbLeft;
  mbRight = TMouseButton.mbRight;
  alLeft = TAlignLayout.alLeft;
  alClient = TAlignLayout.alClient;
  taCenter = TTextAlign.taCenter;
  wsMaximized = TWindowState.wsMaximized;
  {$IFDEF LINUX}
	DefFontName = 'Liberation Sans';
  {$ELSE}
	DefFontName = 'Arial';
  {$ENDIF}

  DefFontSize = 10;
  frxDefPPIUnits = 72;
  frxDefDPIUnits = 96;

  { WIN Paper consts for paper linkage }
  FRX_DMPAPER_LETTER               = 1;
  FRX_DMPAPER_LETTERSMALL          = 2;
  FRX_DMPAPER_TABLOID              = 3;
  FRX_DMPAPER_LEDGER               = 4;
  FRX_DMPAPER_LEGAL                = 5;
  FRX_DMPAPER_STATEMENT            = 6;
  FRX_DMPAPER_EXECUTIVE            = 7;
  FRX_DMPAPER_A3                   = 8;
  FRX_DMPAPER_A4                   = 9;
  FRX_DMPAPER_A4SMALL             = 10;
  FRX_DMPAPER_A5                  = 11;
  FRX_DMPAPER_B4                  = 12;
  FRX_DMPAPER_B5                  = 13;
  FRX_DMPAPER_FOLIO               = 14;
  FRX_DMPAPER_QUARTO              = 15;
  FRX_DMPAPER_10X14               = 16;
  FRX_DMPAPER_11X17               = 17;
  FRX_DMPAPER_NOTE                = 18;
  FRX_DMPAPER_ENV_9               = 19;
  FRX_DMPAPER_ENV_10              = 20;
  FRX_DMPAPER_ENV_11              = 21;
  FRX_DMPAPER_ENV_12              = 22;
  FRX_DMPAPER_ENV_14              = 23;
  FRX_DMPAPER_CSHEET              = 24;
  FRX_DMPAPER_DSHEET              = 25;
  FRX_DMPAPER_ESHEET              = 26;
  FRX_DMPAPER_ENV_DL              = 27;
  FRX_DMPAPER_ENV_C5              = 28;
  FRX_DMPAPER_ENV_C3              = 29;
  FRX_DMPAPER_ENV_C4              = 30;
  FRX_DMPAPER_ENV_C6              = 31;
  FRX_DMPAPER_ENV_C65             = 32;
  FRX_DMPAPER_ENV_B4              = 33;
  FRX_DMPAPER_ENV_B5              = 34;
  FRX_DMPAPER_ENV_B6              = 35;
  FRX_DMPAPER_ENV_ITALY           = 36;
  FRX_DMPAPER_ENV_MONARCH         = 37;
  FRX_DMPAPER_ENV_PERSONAL        = 38;
  FRX_DMPAPER_FANFOLD_US          = 39;
  FRX_DMPAPER_FANFOLD_STD_GERMAN  = 40;
  FRX_DMPAPER_FANFOLD_LGL_GERMAN  = 41;
  FRX_DMPAPER_ISO_B4              = 42;
  FRX_DMPAPER_JAPANESE_POSTCARD   = 43;
  FRX_DMPAPER_9X11                = 44;
  FRX_DMPAPER_10X11               = 45;
  FRX_DMPAPER_15X11               = 46;
  FRX_DMPAPER_ENV_INVITE          = 47;
  FRX_DMPAPER_RESERVED_48         = 48;
  FRX_DMPAPER_RESERVED_49         = 49;
  FRX_DMPAPER_LETTER_EXTRA        = 50;
  FRX_DMPAPER_LEGAL_EXTRA         = 51;
  FRX_DMPAPER_TABLOID_EXTRA       = 52;
  FRX_DMPAPER_A4_EXTRA            = 53;
  FRX_DMPAPER_LETTER_TRANSVERSE   = 54;
  FRX_DMPAPER_A4_TRANSVERSE       = 55;
  FRX_DMPAPER_LETTER_EXTRA_TRANSVERSE = 56;
  FRX_DMPAPER_A_PLUS              = 57;
  FRX_DMPAPER_B_PLUS              = 58;
  FRX_DMPAPER_LETTER_PLUS         = 59;
  FRX_DMPAPER_A4_PLUS             = 60;
  FRX_DMPAPER_A5_TRANSVERSE       = 61;
  FRX_DMPAPER_B5_TRANSVERSE       = 62;
  FRX_DMPAPER_A3_EXTRA            = 63;
  FRX_DMPAPER_A5_EXTRA            = 64;
  FRX_DMPAPER_B5_EXTRA            = 65;
  FRX_DMPAPER_A2                  = 66;
  FRX_DMPAPER_A3_TRANSVERSE       = 67;
  FRX_DMPAPER_A3_EXTRA_TRANSVERSE = 68;
  FRX_DMPAPER_DBL_JAPANESE_POSTCARD = 69;
  FRX_DMPAPER_A6                  = 70;
  FRX_DMPAPER_JENV_KAKU2          = 71;
  FRX_DMPAPER_JENV_KAKU3          = 72;
  FRX_DMPAPER_JENV_CHOU3          = 73;
  FRX_DMPAPER_JENV_CHOU4          = 74;
  FRX_DMPAPER_LETTER_ROTATED      = 75;
  FRX_DMPAPER_A3_ROTATED          = 76;
  FRX_DMPAPER_A4_ROTATED          = 77;
  FRX_DMPAPER_A5_ROTATED          = 78;
  FRX_DMPAPER_B4_JIS_ROTATED      = 79;
  FRX_DMPAPER_B5_JIS_ROTATED      = 80;
  FRX_DMPAPER_JAPANESE_POSTCARD_ROTATED = 81;
  FRX_DMPAPER_DBL_JAPANESE_POSTCARD_ROTATED = 82;
  FRX_DMPAPER_A6_ROTATED          = 83;
  FRX_DMPAPER_JENV_KAKU2_ROTATED  = 84;
  FRX_DMPAPER_JENV_KAKU3_ROTATED  = 85;
  FRX_DMPAPER_JENV_CHOU3_ROTATED  = 86;
  FRX_DMPAPER_JENV_CHOU4_ROTATED  = 87;
  FRX_DMPAPER_B6_JIS              = 88;
  FRX_DMPAPER_B6_JIS_ROTATED      = 89;
  FRX_DMPAPER_12X11               = 90;
  FRX_DMPAPER_JENV_YOU4           = 91;
  FRX_DMPAPER_JENV_YOU4_ROTATED   = 92;
  FRX_DMPAPER_P16K                = 93;
  FRX_DMPAPER_P32K                = 94;
  FRX_DMPAPER_P32KBIG             = 95;
  FRX_DMPAPER_PENV_1              = 96;
  FRX_DMPAPER_PENV_2              = 97;
  FRX_DMPAPER_PENV_3              = 98;
  FRX_DMPAPER_PENV_4              = 99;
  FRX_DMPAPER_PENV_5              = 100;
  FRX_DMPAPER_PENV_6              = 101;
  FRX_DMPAPER_PENV_7              = 102;
  FRX_DMPAPER_PENV_8              = 103;
  FRX_DMPAPER_PENV_9              = 104;
  FRX_DMPAPER_PENV_10             = 105;
  FRX_DMPAPER_P16K_ROTATED        = 106;
  FRX_DMPAPER_P32K_ROTATED        = 107;
  FRX_DMPAPER_P32KBIG_ROTATED     = 108;
  FRX_DMPAPER_PENV_1_ROTATED      = 109;
  FRX_DMPAPER_PENV_2_ROTATED      = 110;
  FRX_DMPAPER_PENV_3_ROTATED      = 111;
  FRX_DMPAPER_PENV_4_ROTATED      = 112;
  FRX_DMPAPER_PENV_5_ROTATED      = 113;
  FRX_DMPAPER_PENV_6_ROTATED      = 114;
  FRX_DMPAPER_PENV_7_ROTATED      = 115;
  FRX_DMPAPER_PENV_8_ROTATED      = 116;
  FRX_DMPAPER_PENV_9_ROTATED      = 117;
  FRX_DMPAPER_PENV_10_ROTATED     = 118;

  FRX_DMBIN_UPPER         = 1;
  FRX_DMBIN_ONLYONE       = 1;
  FRX_DMBIN_LOWER         = 2;
  FRX_DMBIN_MIDDLE        = 3;
  FRX_DMBIN_MANUAL        = 4;
  FRX_DMBIN_ENVELOPE      = 5;
  FRX_DMBIN_ENVMANUAL     = 6;
  FRX_DMBIN_AUTO          = 7;
  FRX_DMBIN_TRACTOR       = 8;
  FRX_DMBIN_SMALLFMT      = 9;
  FRX_DMBIN_LARGEFMT      = 10;
  FRX_DMBIN_LARGECAPACITY = 11;
  FRX_DMBIN_CASSETTE      = 14;
  FRX_DMBIN_FORMSOURCE    = 15;

type
{$IFDEF DELPHI28}
   TStringsChangeOpHelper = record helper for TCustomListBox.TStringsChangeOp
    const
      tsoAdded = TCustomListBox.TStringsChangeOp.Added deprecated 'Use TCustomListBox.TStringsChangeOp.Added';
      tsoDeleted = TCustomListBox.TStringsChangeOp.Deleted deprecated 'Use TCustomListBox.TStringsChangeOp.Deleted';
      tsoClear = TCustomListBox.TStringsChangeOp.Clear deprecated 'Use TCustomListBox.TStringsChangeOp.Clear';
   end;
{$ENDIF}
  { VCL TFont compatibility }
  TfrxFont = class(TPersistent)
  private
    FName: String;
    FSize: Single;
    FPixelsPerInch: Single;
    FStyle: TFontStyles;
    FColor: TAlphaColor;
    FOnChange: TNotifyEvent;
    procedure SetName(const Value: string);
    procedure SetSize(Value: Single);
    procedure SetStyle(Value: TFontStyles);
    procedure SetColor(Value: TAlphaColor);
    procedure SetHeight(Value: Single);
    procedure DoChange;
  protected
    function GetHeight: Single; overload;
  public
    constructor Create;
    procedure Assign(Value: TfrxFont); reintroduce;
    procedure AssignToFont(Value: TFont);
    procedure AssignToCanvas(Canvas: TCanvas);
    function GetHeight(Canvas: TCanvas): Single; overload;
    function IsEqual(ToFont: TObject): Boolean;
  published
    property Name: String read FName write SetName;
    property Size: Single read FSize write SetSize stored False;
    property PixelsPerInch: Single read FPixelsPerInch write FPixelsPerInch;
    property Style: TFontStyles read FStyle write SetStyle;
    property Color: TAlphaColor read FColor write SetColor;
    property Height: Single read GetHeight write SetHeight;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TfrxImageList = class(TComponent)
  private
    FImages: TList;
    FWidth: Integer;
    FHeight: Integer;
    function GetCount: Integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear;
{$IFDEF DELPHI19}
    procedure AddMasked(Bmp: FMX.Graphics.TBitmap; Color: TAlphaColor);
    function Get(Index: Integer): FMX.Graphics.TBitmap;
 {$ELSE}
    procedure AddMasked(Bmp: FMX.Types.TBitmap; Color: TAlphaColor);
    function Get(Index: Integer): FMX.Types.TBitmap;
{$ENDIF}
    procedure Draw(Canvas: TCanvas; x, y: Single; Index: Integer);
    property Width: Integer read FWidth write FWidth;
    property Height: Integer read FHeight write FHeight;
    property Count: Integer read GetCount;
  end;

{$I frxFMX_PlatformsAttribute.inc}
  TfrxToolButton = class(TSpeedButton)
  private
{$IFDEF DELPHI19}
	FBitmap: FMX.Graphics.TBitmap;
 {$ELSE}
    FBitmap: FMX.Types.TBitmap;
{$ENDIF}
    FDown: Boolean;
{$IFDEF DELPHI19}
	procedure SetBitmap(const Value: FMX.Graphics.TBitmap);
 {$ELSE}
    procedure SetBitmap(const Value: FMX.Types.TBitmap);
{$ENDIF}
  protected
    procedure DoMouseEnter; override;
    procedure DoMouseLeave; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoPaint; override;
    property Down: Boolean read FDown write FDown;
  published
{$IFDEF DELPHI19}
	property Bitmap: FMX.Graphics.TBitmap read FBitmap write SetBitmap;
{$ELSE}
    property Bitmap: FMX.Types.TBitmap read FBitmap write SetBitmap;
{$ENDIF}
    property Hint;
{$IFDEF Delphi17}
    property TabOrder;
{$ENDIF}
  end;

  TfrxToolSeparator = class(TControl)
  public
    procedure Paint; override;
{$IFDEF Delphi17}
  published
    property Position;
    property Width;
    property Height;
{$ENDIF}
  end;

  TfrxToolGrip = class(TControl)
  public
    procedure Paint; override;
{$IFDEF Delphi17}
  published
    property Position;
    property Width;
    property Height;
{$ENDIF}
  end;

  TfrxTreeViewItem = class(TTreeViewItem)
  private
    FButton: TCustomButton;
    FCloseImageIndex: Integer;
    FOpenImageIndex: Integer;
    FImgPos: Single;
    FData: TObject;
{$IFDEF DELPHI19}
    function GetBitmap(): FMX.Graphics.TBitmap;
{$ELSE}
    function GetBitmap(): FMX.Types.TBitmap;
{$ENDIF}

  protected
    procedure ApplyStyle; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
    property CloseImageIndex: Integer read FCloseImageIndex write FCloseImageIndex;
    property OpenImageIndex: Integer read FOpenImageIndex write FOpenImageIndex;
    property Data: TObject read FData write FData;
  end;

  TfrxOnEditedEvent = procedure(Sender: TObject; Node: TfrxTreeViewItem; var S: String) of Object;
  TfrxOnBeforeChangeEvent = procedure(Sender: TObject; OldNode: TfrxTreeViewItem; NewNode: TfrxTreeViewItem) of Object;

{$I frxFMX_PlatformsAttribute.inc}
  TfrxTreeView = class(TTreeView)
  private
{$IFDEF DELPHI19}
	FPicBitmap: FMX.Graphics.TBitmap;
{$ELSE}
    FPicBitmap: FMX.Types.TBitmap;
{$ENDIF}
    FIconWidth: Integer;
    FIconHeight: Integer;
    FEditBox: TEdit;
    FIsEditing: Boolean;
    FEditable: Boolean;
    FFreePicOnDelete: Boolean;
    FOnEdited: TfrxOnEditedEvent;
    FOnBeforeChange: TfrxOnBeforeChangeEvent;
    FManualDragAndDrop: Boolean;
  protected
    procedure DoEditKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
    procedure DoExit; override;
    procedure SetSelected(const Value: TTreeViewItem); override;
    procedure DblClick; override;
    procedure DoExitEdit (Sender: TObject);
    procedure BeginAutoDrag; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoEdit();
    procedure EndEdit(Accept: Boolean);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
    procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
    procedure LoadResouces(Stream: TStream; IconWidth, IconHeight: Integer);
{$IFDEF DELPHI19}
    property PicPitmap: FMX.Graphics.TBitmap read FPicBitmap write FPicBitmap;
{$ELSE}
    property PicPitmap: FMX.Types.TBitmap read FPicBitmap write FPicBitmap;
{$ENDIF}
    property IconWidth: Integer read FIconWidth write FIconWidth;
    property IconHeight: Integer read FIconHeight write FIconHeight;
    function GetBitmapRect(Index: Integer): TRectF;
    procedure DragOver(const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF}); override;
    procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
    function AddItem(Root: TFmxObject; Text: String): TfrxTreeViewItem;
{$IFDEF DELPHI19}
	procedure SetImages(Bmp: FMX.Graphics.TBitmap);
{$ELSE}
    procedure SetImages(Bmp: FMX.Types.TBitmap);
{$ENDIF}
    property IsEditing: Boolean read FIsEditing;
    property ManualDragAndDrop: Boolean read FManualDragAndDrop write FManualDragAndDrop;
  published
    property StyleLookup;
    property CanFocus default True;
    property DisableFocusEffect;
    property TabOrder;
    property AllowDrag default False;
    property AlternatingRowBackground default False;
    property ItemHeight;
{$IFNDEF Delphi17}
    property HideSelectionUnfocused default False;
{$ENDIF}
    property MultiSelect default False;
    property ShowCheckboxes default False;
    property Sorted default False;
    property OnChange;
    property OnChangeCheck;
    property OnCompare;
    property OnDragChange;
    property OnEdited: TfrxOnEditedEvent read FOnEdited write FOnEdited;
    property OnBeforeChange: TfrxOnBeforeChangeEvent read FOnBeforeChange write FOnBeforeChange;
    property Editable: Boolean read FEditable write FEditable;
  end;

  TfrxListBoxItem = class(TListBoxItem)
  private
    FButton: TButton;
    FCheck: TCheckBox;
    FCheckVisible : Boolean;
    function GetCheckVisible: Boolean;
    procedure SetCheckVisible(const Value: Boolean);
    procedure OnBtnClick(Sender: TObject);
  protected
    procedure ApplyStyle; override;
    procedure FreeStyle; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property CheckVisible: Boolean read GetCheckVisible write SetCheckVisible;
  end;

  TfrxOnButtonClick = procedure (Sender: TObject; aButton: TObject; aItem: TfrxListBoxItem) of Object;

{$I frxFMX_PlatformsAttribute.inc}
  TfrxListBox = class(TListBox)
  private type
    TfrxListBoxStrings = class(TStrings)
    private
      [Weak] FListBox: TCustomListBox;
      procedure ReadData(Reader: TReader);
      procedure WriteData(Writer: TWriter);
    protected
      procedure Put(Index: Integer; const S: string); override;
      function Get(Index: Integer): string; override;
      function GetCount: Integer; override;
      function GetObject(Index: Integer): TObject; override;
      procedure PutObject(Index: Integer; AObject: TObject); override;
      procedure SetUpdateState(Updating: Boolean); override;
      procedure DefineProperties(Filer: TFiler); override;
    public
      function Add(const S: string): Integer; override;
      procedure Clear; override;
      procedure Delete(Index: Integer); override;
      procedure Exchange(Index1, Index2: Integer); override;
      function IndexOf(const S: string): Integer; override;
      procedure Insert(Index: Integer; const S: string); override;
    end;
  private
    FManualDragAndDrop: Boolean;
    FOnButtonClickEvnt: TfrxOnButtonClick;
    FItems: TStrings;
    FCheckBoxText: String;
    FButtonText: String;
    FShowButtons: Boolean;
    function ItemsStored: Boolean;
    procedure SetItems(const Value: TStrings);
  protected
    procedure BeginAutoDrag; override;
    procedure DragEnd; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
    procedure DragOver(const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF}); override;
    procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
    procedure DoButtonClick(aButton: TObject; aItem: TfrxListBoxItem);
    procedure Assign(Source: TPersistent); override;
    property ManualDragAndDrop: Boolean read FManualDragAndDrop write FManualDragAndDrop;
    property Items: TStrings read FItems write SetItems stored ItemsStored;
  published
    property StyleLookup;
    property CanFocus default True;
    property DisableFocusEffect;
    property TabOrder;
    property AllowDrag default False;
    property AlternatingRowBackground default False;
    property ItemHeight;
    property MultiSelect default False;
    property ShowCheckboxes default False;
    property Sorted default False;
    property OnChange;
    property OnChangeCheck;
    property OnCompare;
    property OnDragChange;
    property ShowButtons: Boolean read FShowButtons write FShowButtons;
    property CheckBoxText: String read FCheckBoxText write FCheckBoxText;
    property ButtonText: String read FButtonText write FButtonText;
    property OnButtonClick: TfrxOnButtonClick read FOnButtonClickEvnt write FOnButtonClickEvnt;
  end;

  TfrxStringList = class(TStringList)
  private
    FUseUnicode: Boolean;
  protected
    function CompareStrings(const S1, S2: string): Integer; override;
  public
    constructor Create; overload;
    constructor Create(UseUnicode: Boolean); overload;
  end;

 type
{$IFDEF DELPHI19}
  { fake class - do not use instances of this canvas for Full draw , only Text draw ! }
  TfrxFastCanvasLayer = class(TCanvas)
  protected
    FContext: THandle;
    FCanvas: TCanvas;
    function GetContext: THandle; virtual;
    procedure SetContext(const Value: THandle); virtual;
    procedure SetFont(const Value: TFont); virtual;
    procedure SetCanvas(const Value: TCanvas); virtual;
    function DoBeginScene({$IFNDEF DELPHI28}const{$ENDIF} AClipRects: PClipRects = nil; AContextHandle: THandle = 0): Boolean; override;
    procedure DoEndScene; override;
    { empty }
{$IFDEF DELPHI21}
    class function DoInitializeBitmap(const Width, Height: Integer; const Scale: Single; var PixelFormat: TPixelFormat): THandle; override;
    class procedure DoFinalizeBitmap(var Bitmap: THandle); override;
    class function DoMapBitmap(const Bitmap: THandle; const Access: TMapAccess; var Data: TBitmapData): Boolean; override;
    class procedure DoUnmapBitmap(const Bitmap: THandle; var Data: TBitmapData); override;
   function DoFillPolygon(const Points: TPolygon; const AOpacity: Single; const ABrush: TBrush): Boolean; override;
{$ELSE}
{$IFDEF DELPHI19}
    class procedure DoInitializeBitmap(const Bitmap: FMX.Graphics.TBitmap); override;
    class procedure DoFinalizeBitmap(const Bitmap: FMX.Graphics.TBitmap); override;
    class function DoMapBitmap(const Bitmap: FMX.Graphics.TBitmap; const Access: TMapAccess; var Data: TBitmapData): Boolean; override;
    class procedure DoUnmapBitmap(const Bitmap: FMX.Graphics.TBitmap; var Data: TBitmapData); override;
{$ENDIF}
{$ENDIF}

    procedure DoFillRect(const ARect: TRectF; const AOpacity: Single; const ABrush: TBrush); override;
    procedure DoFillPath(const APath: TPathData; const AOpacity: Single; const ABrush: TBrush); override;
    procedure DoFillEllipse(const ARect: TRectF; const AOpacity: Single; const ABrush: TBrush); override;
{$IFDEF DELPHI19}
    procedure DoDrawBitmap(const ABitmap: FMX.Graphics.TBitmap; const SrcRect, DstRect: TRectF; const AOpacity: Single;
      const HighSpeed: Boolean = False); override;
{$ELSE}
    procedure DoDrawBitmap(const ABitmap: FMX.Types.TBitmap; const SrcRect, DstRect: TRectF; const AOpacity: Single;
      const HighSpeed: Boolean = False); override;
{$ENDIF}
    procedure DoDrawLine(const APt1, APt2: TPointF; const AOpacity: Single; const ABrush: TStrokeBrush); override;
    procedure DoDrawRect(const ARect: TRectF; const AOpacity: Single; const ABrush: TStrokeBrush); override;
    procedure DoDrawPath(const APath: TPathData; const AOpacity: Single; const ABrush: TStrokeBrush); override;
    procedure DoDrawEllipse(const ARect: TRectF; const AOpacity: Single; const ABrush: TStrokeBrush); override;
    { empty end }
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure ClearCache; virtual;
    procedure UpdateHandle(AParent: TFmxObject); virtual;
    { empty }
    procedure Clear(const Color: TAlphaColor); override;
    procedure ClearRect(const ARect: TRectF; const AColor: TAlphaColor = 0); override;
    procedure IntersectClipRect(const ARect: TRectF); override;
    procedure ExcludeClipRect(const ARect: TRectF); override;
    function PtInPath(const APoint: TPointF; const APath: TPathData): Boolean; override;
    { empty end }
    procedure FillText(const ARect: TRectF; const AText: string; const WordWrap: Boolean; const AOpacity: Single; const Flags: TFillTextFlags;  const ATextAlign, AVTextAlign: TTextAlign); override;
    procedure MeasureText(var ARect: TRectF; const AText: string; const WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign); override;
    function CalcHeight(aText: String): Single; virtual;
    function CalcWidth(aText: String): Single; virtual;
    property Font: TFont write SetFont;
    property Context: THandle read GetContext write SetContext;
    property Canvas: TCanvas read FCanvas write SetCanvas;
  end;
{$IFDEF MACoS}
  TfrxFastCanvas = class(TfrxFastCanvasLayer)
  private
    FCurentFont: CTFontRef;
    FFontCacheList: TStringList;
    FFontTransformMatrix: CGAffineTransform;
    FColorSpace: CGColorSpaceRef;
    FOpacity: Single;
    FText: String;
    FTextAlign: TTextAlign;
    FWordWrap: Boolean;
    FFlags: TFillTextFlags;
    FPath: CGMutablePathRef;
    FTextHeight: Single;
    FTextWidth: Single;
    function CreateCTFont(const AFont: TFont): CTFontRef;
    function GetCTFont(const AFont: TFont): CTFontRef;
    function GetFontNameHash(const AFont: TFont): String;
    function AddCTFontToList(const aNameFont: String; aFontRef: CTFontRef): Integer;
    procedure ClearFontCache;
    procedure SetFont(const Value: TFont); reintroduce;
    procedure CreateFrame(Canvas: TCanvas; StringRef: CFStringRef; var AttributedS: CFMutableAttributedStringRef; var Frame: CTFrameRef);
    procedure AddFontAttribute(AAttribute: CFMutableAttributedStringRef;
    AFont: TFont; const AStart, ALength: Integer);
    function CalcHeight(Frame: CTFrameRef): Single; reintroduce;
    function CalcWidth(Frame: CTFrameRef): Single; reintroduce;
  protected
    function GetContext: THandle; override;
    procedure SetCanvas(const Value: TCanvas); reintroduce;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure FillText(const ARect: TRectF; const AText: string; const WordWrap: Boolean; const AOpacity: Single; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign); override;
    procedure MeasureText(var ARect: TRectF; const AText: string; const WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign); override;
  end;
{$ENDIF}

{$IFDEF MSWINDOWS}
  TfrxFastCanvas = class(TfrxFastCanvasLayer)
  private
    FFontCacheList: TStringList;

    function GetFontNameHash(const AFont: TFont; WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign: TTextAlign; const VTextAlign: TTextAlign): String;
    procedure ClearFontCache;
  protected
    function GetContext: THandle; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure FillText(const ARect: TRectF; const AText: string; const WordWrap: Boolean; const AOpacity: Single; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign); override;
    procedure MeasureText(var ARect: TRectF; const AText: string; const WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign); override;
  end;
{$ENDIF}
{$ELSE}
  TfrxFastCanvasLayer = class(TCanvas)
  protected
    FContext: THandle;
    FCanvas: TCanvas;
  public
    procedure ClearCache; virtual; abstract;
    procedure UpdateHandle(AParent: TFmxObject); virtual;
    property Context: THandle read FContext write FContext;
    property Canvas: TCanvas read FCanvas write FCanvas;
  end;
{$ENDIF}

function GetLongHint(const Hint: string): string;
function GetShortHint(const Hint: string): string;

procedure FillFontsList(List: TStrings);
function GetComponentForm(Comp: TFmxObject): TCommonCustomForm;
procedure SetClipboard(const Value: String);
function GetClipboard: String;
{$IFDEF DELPHI19}
function CreateRotationMatrix(const Angle: Single): TMatrix;
function CreateScaleMatrix(const ScaleX, ScaleY: Single): TMatrix;
function CreateTranslateMatrix(const DX, DY: Single): TMatrix;
function MatrixMultiply(const M1, M2: TMatrix): TMatrix;
{$ENDIF}

{$IFDEF MACOS}
procedure ShellExecute(fName: String);
{$ENDIF}

function frxCompareText(s1: String; s2: String): Integer;
//    procedure FillText(aLayout: TTextLayout; Canvas: TCanvas; const ARect: TRectF; const AText: string; const WordWrap: Boolean; const AOpacity: Single; const Flags: TFillTextFlags;  const ATextAlign, AVTextAlign: TTextAlign);
//    procedure MeasureText(aLayout: TTextLayout; Canvas: TCanvas; var ARect: TRectF; const AText: string{;
//  const WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign,
//  AVTextAlign: TTextAlign});
implementation

uses FMX.frxClass, FMX.Consts;

const
  IdentityMatrix: TMatrix = (m11: 1.0; m12: 0.0; m13: 0.0; m21: 0.0; m22: 1.0; m23: 0.0; m31: 0.0; m32: 0.0; m33: 1.0);

{$IFDEF MACOS}
const
  kUCCollateComposeInsensitiveMask = 1 shl 1;
  kUCCollateWidthInsensitiveMask = 1 shl 2;
  kUCCollateCaseInsensitiveMask = 1 shl 3;
  kUCCollateDiacritInsensitiveMask = 1 shl 4;
  kUCCollatePunctuationSignificantMask = 1 shl 15;
  kUCCollateDigitsOverrideMask  = 1 shl 16;
  kUCCollateDigitsAsNumberMask  = 1 shl 17;


{$IFDEF UNDERSCOREIMPORTNAME}
  _PFX = '_';
{$ELSE}
  _PFX = '';
{$ENDIF}

{$EXTERNALSYM _PFX}

const
{$IFDEF MACOS64}
  libUnicodeCore = '/System/Library/Frameworks/CoreServices.framework/Frameworks/CarbonCore.framework/CarbonCore';
{$ELSE}
  libUnicodeCore = '/System/Library/Frameworks/CoreServices.framework/Frameworks/CarbonCore.framework/CarbonCore';
{$ENDIF}


var
  collatorRef: Pointer;
  collatorRefIgnoreCase: Pointer;


function UCCreateCollator(locale: Pointer; opVariant: PUInt32; options: UInt32; collatorRef: Pointer): OSStatus; cdecl; external libUnicodeCore name _PFX + 'UCCreateCollator';
function UCDisposeCollator(collatorRef: Pointer): OSStatus; cdecl; external libUnicodeCore name _PFX + 'UCDisposeCollator';

function UCCompareText(collatorRef: Pointer; text1Ptr: PWideChar; text1Length: UInt32; text2Ptr: PWideChar; text2Length: UInt32; equivalent: PBoolean; order: PInteger): OSStatus; cdecl; external libUnicodeCore name _PFX + 'UCCompareText';

procedure ShellExecute(fName: String);
var
  wspace: NSWorkspace;
begin
  wspace := TNSWorkspace.Create;
  try
    if FileExists(fName) then
      wspace.openFile(NSSTR(fName));
  finally
    wspace.release;
  end;
end;
{$ENDIF}

{$IFDEF MSWINDOWS}
var
  frxDefaultPPI: Integer;
{$ENDIF}

function frxCompareText(s1: String; s2: String): Integer;
{$IFDEF MACOS}
begin
  Result := -1;
  try
    UCCompareText(collatorRefIgnoreCase, PWideChar(s1), Length(s1), PWideChar(s2), Length(s2), nil, @Result);
  finally
  end;
end;
{$ELSE}
begin
  Result := AnsiCompareText(s1, s2);
end;
{$ENDIF}

function frxCompareStr(const S1, S2: string): Integer;
{$IFDEF MACOS}
begin
  Result := -1;
  try
    UCCompareText(collatorRef, PWideChar(s1), Length(s1), PWideChar(s2), Length(s2), nil, @Result);
  finally
  end;
end;
{$ELSE}
begin
  Result := CompareStr(s1, s2);
end;
{$ENDIF}

type
  THackCustomListBox = class(TCustomListBox);
function CreateScaleMatrix(const ScaleX, ScaleY: Single): TMatrix;
begin
  Result := IdentityMatrix;
  Result.m11 := ScaleX;
  Result.m22 := ScaleY;
end;


function CreateTranslateMatrix(const DX, DY: Single): TMatrix;
begin
  Result := IdentityMatrix;
  Result.m31 := DX;
  Result.m32 := DY;
end;

function CreateRotationMatrix(const Angle: Single): TMatrix;
var
  cosine, sine: Extended;
begin
  SinCos(Angle, sine, cosine);

  Result.m11 := cosine;
  Result.m12 := sine;
  Result.m13 := 0;
  Result.m21 := -sine;
  Result.m22 := cosine;
  Result.m23 := 0;

  Result.m31 := 0;
  Result.m32 := 0;
  Result.m33 := 1;
end;

function MatrixMultiply(const M1, M2: TMatrix): TMatrix;
begin
  Result.m11 := M1.m11 * M2.m11 + M1.m12 * M2.m21 + M1.m13 * M2.m31;
  Result.m12 := M1.m11 * M2.m12 + M1.m12 * M2.m22 + M1.m13 * M2.m32;
  Result.m13 := M1.m11 * M2.m13 + M1.m12 * M2.m23 + M1.m13 * M2.m33;
  Result.m21 := M1.m21 * M2.m11 + M1.m22 * M2.m21 + M1.m23 * M2.m31;
  Result.m22 := M1.m21 * M2.m12 + M1.m22 * M2.m22 + M1.m23 * M2.m32;
  Result.m23 := M1.m21 * M2.m13 + M1.m22 * M2.m23 + M1.m23 * M2.m33;
  Result.m31 := M1.m31 * M2.m11 + M1.m32 * M2.m21 + M1.m33 * M2.m31;
  Result.m32 := M1.m31 * M2.m12 + M1.m32 * M2.m22 + M1.m33 * M2.m32;
  Result.m33 := M1.m31 * M2.m13 + M1.m32 * M2.m23 + M1.m33 * M2.m33;
end;
{$IFDEF DELPHI19}
{$ENDIF}

function GetLongHint(const Hint: string): string;
var
  I: Integer;
begin
  I := Pos('|', Hint);
  if I = 0 then
    Result := Hint else
    Result := Copy(Hint, I + 1, Maxint);
end;

function GetShortHint(const Hint: string): string;
var
  I: Integer;
begin
  I := Pos('|', Hint);
  if I = 0 then
    Result := Hint else
    Result := Copy(Hint, 1, I - 1);
end;

procedure SetClipboard(const Value: String);
{$IFDEF Delphi17}
var
  ClipService: IFMXClipboardService;
begin
  if TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(ClipService)) then
    ClipService.SetClipboard(Value);
end;
{$ELSE}
begin
  Platform.SetClipboard(Value);
end;
{$ENDIF}

function GetClipboard: String;
{$IFDEF Delphi17}
var
  ClipService: IFMXClipboardService;
begin
  if TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(ClipService)) then
    Result := ClipService.GetClipboard.ToString
  else
    Result := '';
end;
{$ELSE}
begin
  Result := VarToStr(Platform.GetClipboard);
end;
{$ENDIF}


{$IFDEF MSWINDOWS}
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
    FontType: DWORD; Data: LPARAM): Integer; stdcall;
begin
  if(Data <> 0) then
    if (TStrings(Data).IndexOf(LogFont.lfFaceName) < 0) then
      TStringList(Data).Add(LogFont.lfFaceName);
  Result := 1;
end;

procedure FillFontsList(List: TStrings);
var
  dc: HDC;
  sortedList: TStringList;
  LFont: TLogFont;

begin
  sortedList := TStringList.Create;
  dc := GetDC(0);
  try
    FillChar(LFont, sizeof(LFont), 0);
    LFont.lfCharset := DEFAULT_CHARSET;
    EnumFontFamiliesEx(dc, LFont, @EnumFontsProc, LPARAM(sortedList), 0);
  finally
    ReleaseDC(0, dc);
  end;
  sortedList.Sort;

  List.BeginUpdate;
  List.Clear;
  List.AddStrings(sortedList);
  List.EndUpdate;
  sortedList.Free;
end;
 {$ENDIF}
{$IFDEF LINUX}
procedure FillFontsList(List: TStrings);
var
  sortedList: TStringList;
  i, c: Integer;
begin
  sortedList := TStringList.Create;
    sortedList.BeginUpdate;
  try
    sortedList.Clear;
    c := FmuxGetFontCount;
    for i := 0 to c - 1 do
      sortedList.Add(FmuxGetFontName(i));
  finally
    sortedList.EndUpdate;
  end;

  sortedList.Sort;

  List.BeginUpdate;
  List.Clear;
  List.AddStrings(sortedList);
  List.EndUpdate;
  sortedList.Free;
end;
{$ENDIF}
{$IFDEF MACOS}
var
  kCTFontFamilyNameAttribute_: Pointer = nil;

function kCTFontFamilyNameAttribute: Pointer;
var
  CTLib: HMODULE;
begin
  if kCTFontFamilyNameAttribute_ = nil then
  begin
    CTLib := LoadLibrary(libCoreText);
    kCTFontFamilyNameAttribute_ := Pointer(GetProcAddress(CTLib, PWideChar('kCTFontFamilyNameAttribute'))^);
    FreeLibrary(CTLib);
  end;
  Result := kCTFontFamilyNameAttribute_;
end;

function ConvCFString(const Value: CFStringRef): String;
begin
  if Assigned(Value) then
    Result := string(TNSString.Wrap(Value).UTF8String)
  else
    Result := '';
end;

procedure FillFontsList(List: TStrings);
var
  collection: CTFontCollectionRef;
  arr: CFArrayRef;
  fontDescr: CTFontDescriptorRef;
  fontName: String;
  i, arrnum: Integer;
  sortedList: TStringList;
begin
  sortedList := TStringList.Create;
  sortedList.Sorted := True;
  try
    collection := CTFontCollectionCreateFromAvailableFonts(nil);
    arr := CTFontCollectionCreateMatchingFontDescriptors(collection);
    try
      arrnum := CFArrayGetCount(arr);
      for i := 0 to arrnum - 1 do
      begin
        fontDescr := CFArrayGetValueAtIndex(arr, i);
        fontName := ConvCFString(CTFontDescriptorCopyAttribute(fontDescr, kCTFontFamilyNameAttribute));
        if sortedList.IndexOf(fontName) = -1 then
          sortedList.Add(fontName);
      end;
    finally
      CFRelease(arr);
      CFRelease(collection);
    end;
  except
    sortedList.Add('Unable to retrieve fonts');
  end;

  List.BeginUpdate;
  List.Clear;
  List.AddStrings(sortedList);
  List.EndUpdate;
  sortedList.Free;
end;
{$ENDIF}

{$IFDEF DELPHI19}
type
  TTextLayoutHack = class(TTextLayout);
{$IFDEF MACOS}
  TQuartzBitmap = class
  private
    FData: Pointer;
    FContext: CGContextRef;
    FImage: CGImageRef;
    function GetImage: CGImageRef;
  end;
    TRGBFloat = packed record
    r, g, b, a: single;
  end;

function CGColor(const C: TAlphaColor; Opacity: single = 1): TRGBFloat;
var
  cc: TAlphaColor;
begin
  cc := MakeColor(C, Opacity);
  Result.a := TAlphaColorRec(cc).a / $FF;
  Result.r := TAlphaColorRec(cc).r / $FF;
  Result.g := TAlphaColorRec(cc).g / $FF;
  Result.b := TAlphaColorRec(cc).b / $FF;
end;


const
  ItalicMatrix: CGAffineTransform = (
    a: 1;
    b: 0;
    c: 0.176326981;
    d: 1;
    tx: 0;
    ty: 0
  );

function CreateFont(const AFont: TFont): CTFontRef;
var
  FontRefCopy: CTFontRef;
  m: PCGAffineTransform;
begin
  m := nil;
  Result := CTFontCreateWithName(CFSTR(AFont.Family), AFont.Size * 1, nil);
  try
    if TFontStyle.fsItalic in AFont.Style then
    begin
      FontRefCopy := CTFontCreateCopyWithSymbolicTraits(Result, 0, nil,
        kCTFontItalicTrait, kCTFontItalicTrait);
      if Assigned(FontRefCopy) then
      begin
        CFRelease(Result);
        Result := FontRefCopy;
      end
      else
      begin
        m := @ItalicMatrix;

        FontRefCopy := CTFontCreateWithName(CFSTR(AFont.Family), AFont.Size * 1, @ItalicMatrix);
        if Assigned(FontRefCopy) then
        begin
          CFRelease(Result);
          Result := FontRefCopy;
        end;
      end;
    end;
    if TFontStyle.fsBold in AFont.Style then
    begin
      FontRefCopy := CTFontCreateCopyWithSymbolicTraits(Result, 0, m,
        kCTFontBoldTrait, kCTFontBoldTrait);
      if Assigned(FontRefCopy) then
      begin
        CFRelease(Result);
        Result := FontRefCopy;
      end;
    end;
  except
    CFRelease(Result);
  end;
end;
{$ENDIF}
{$ENDIF}

function GetComponentForm(Comp: TFmxObject): TCommonCustomForm;
begin
  Result := nil;
  while (Comp.Parent <> nil) do
  begin
    if (Comp.Parent is TCommonCustomForm) then
    begin
      Result := Comp.Parent as TCommonCustomForm;
      Exit;
    end;
    Comp := Comp.Parent;
  end;
end;

{ TfrxFont }

constructor TfrxFont.Create;
begin
  FName := DefFontName;
  FSize := DefFontSize;
  FColor := claBlack;
  FPixelsPerInch := frxDefPPI;
end;

procedure TfrxFont.Assign(Value: TfrxFont);
begin
  FName := Value.Name;
  FSize := Value.Size;
  FStyle := Value.Style;
  FColor := Value.Color;
  DoChange;
end;

procedure TfrxFont.AssignToFont(Value: TFont);
{$IFDEF Delphi25}
{$IFDEF MSWINDOWS}
var
  NewStyleExt: TFontStyleExt;
{$ENDIF}
{$ENDIF}
begin
  Value.Family := FName;
  Value.Size := FSize;
  Value.Style := FStyle;
{$IFDEF Delphi25}
{$IFDEF MSWINDOWS}
  { D2D campatibility with GDI+ name }
  if Pos('NARROW', UpperCase(Name)) <> 0  then
  begin
    NewStyleExt := TFontStyleExt.Create(Value.StyleExt.Weight, Value.StyleExt.Slant, Value.StyleExt.Stretch, Value.Style);
    NewStyleExt.Stretch := TFontStretch.Condensed;
    Value.StyleExt := NewStyleExt;
  end;
{$ENDIF}
{$ENDIF}
end;

{$IFDEF MSWINDOWS}
type
  THackCanvas = class(TCanvas);
{$ENDIF}

procedure TfrxFont.AssignToCanvas(Canvas: TCanvas);
var
  ScaleF: Single;
{$IFDEF MSWINDOWS}
  IsD2D: Boolean;
  aScaleX: Single;
{$IFDEF Delphi25}
  NewStyleExt: TFontStyleExt;
{$ENDIF}
{$ENDIF}
begin
  Canvas.Font.Family := Name;
  ScaleF := FPixelsPerInch / 72;
{ we need increase D2D font height a bit to make it look the same as in GDIp }
{ cause of this code - canvas implimentation hidden inside modules }
{$IFDEF MSWINDOWS}
  IsD2D := (CompareText(Canvas.ClassName, 'TCanvasD2D') = 0);
  if IsD2D then
    ScaleF := ScaleF + 1 / 72 * 5;
  aScaleX := frxDefaultPPI / 96;
{$IFNDEF Delphi17}
  if not IsD2D and Assigned(THackCanvas(Canvas).FBitmap) and (aScaleX > 1) then
{$ELSE}
  if not IsD2D and Assigned(Canvas.Bitmap) and (aScaleX > 1) then
{$ENDIF}
    ScaleF := ScaleF * aScaleX;
{$ENDIF}
  Canvas.Font.Size := Size * ScaleF;
  Canvas.Font.Style := Style;
  Canvas.Fill.Color := Color;
{$IFDEF MSWINDOWS}
{$IFDEF Delphi25}
  { D2D campatibility with GDI+ name }
  if IsD2D and (Pos('NARROW', UpperCase(Name)) <> 0) then
  begin
    NewStyleExt := TFontStyleExt.Create(Canvas.Font.StyleExt.Weight, Canvas.Font.StyleExt.Slant, Canvas.Font.StyleExt.Stretch, Canvas.Font.Style);
    NewStyleExt.Stretch := TFontStretch.Condensed;
    Canvas.Font.StyleExt := NewStyleExt;
  end;
{$ENDIF}
{$ENDIF}
end;

procedure TfrxFont.DoChange;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

function TfrxFont.GetHeight(Canvas: TCanvas): Single;
begin
// todo
  Result := Size * FPixelsPerInch / 72;
end;

function TfrxFont.IsEqual(ToFont: TObject): Boolean;
begin
  Result := (ToFont is TFont) and SameValue(Size * FPixelsPerInch / 72, TFont(ToFont).Size, 1E-2) and (Name = TFont(ToFont).Family) and
    (Style = TFont(ToFont).Style);
end;

procedure TfrxFont.SetName(const Value: string);
begin
  if FName <> Value then
  begin
    FName := Value;
    DoChange;
  end;
end;

procedure TfrxFont.SetSize(Value: Single);
begin
  if FSize <> Value then
  begin
    FSize := Value;
    DoChange;
  end;
end;

procedure TfrxFont.SetStyle(Value: TFontStyles);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    DoChange;
  end;
end;

procedure TfrxFont.SetColor(Value: TAlphaColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    DoChange;
  end;
end;

procedure TfrxFont.SetHeight(Value: Single);
begin
  Size := - Value * 72 / FPixelsPerInch;
end;

function TfrxFont.GetHeight: Single;
begin
  Result := - Size * FPixelsPerInch / 72;
end;


{ TfrxImageList }

constructor TfrxImageList.Create(AOwner: TComponent);
begin
  inherited;
  FImages := TList.Create;
end;

destructor TfrxImageList.Destroy;
begin
  FImages.Destroy;
  inherited;
end;


procedure TfrxImageList.Clear;
begin
  FImages.Clear;
end;

{$IFDEF DELPHI19}
	procedure TfrxImageList.AddMasked(Bmp: FMX.Graphics.TBitmap; Color: TAlphaColor);
{$ELSE}
    procedure TfrxImageList.AddMasked(Bmp: FMX.Types.TBitmap; Color: TAlphaColor);
{$ENDIF}
begin
  FImages.Add(Bmp);
end;

procedure TfrxImageList.Draw(Canvas: TCanvas; x, y: Single; Index: Integer);
begin
end;

function TfrxImageList.GetCount: Integer;
begin
  Result := FImages.Count;
end;

{$IFDEF DELPHI19}
function TfrxImageList.Get(Index: Integer): FMX.Graphics.TBitmap;
begin
  Result := FMX.Graphics.TBitmap(FImages[Index]);
end;
{$ELSE}
function TfrxImageList.Get(Index: Integer): FMX.Types.TBitmap;
begin
  Result := FMX.Types.TBitmap(FImages[Index]);
end;
{$ENDIF}

{ TfrxToolButton }

constructor TfrxToolButton.Create(AOwner: TComponent);
begin
{$IFDEF DELPHI19}
  FBitmap := FMX.Graphics.TBitmap.Create(0,0);
{$ELSE}
  FBitmap := FMX.Types.TBitmap.Create(0,0);
{$ENDIF}
  inherited;
end;

destructor TfrxToolButton.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

procedure TfrxToolButton.DoMouseEnter;
begin
  inherited;
  Repaint;
end;

procedure TfrxToolButton.DoMouseLeave;
begin
  inherited;
  Repaint;
end;

procedure TfrxToolButton.DoPaint;
var
  rect: TRectF;
  bmpRect: TRectF;
  oldM: TMatrix;
  state: TCanvasSaveState;
begin
  OldM := Canvas.Matrix;
  State := Canvas.SaveState;

  try
    Canvas.SetMatrix(CreateTranslateMatrix(AbsoluteRect.Left, AbsoluteRect.Top));
    rect := RectF(0.5, 0.5, Width - 0.5, Height - 0.5);

    bmpRect.Top := Round((Self.Height - FBitmap.Height)/ 2);
    bmpRect.Left := Round((Self.Width - FBitmap.Width) / 2);
    bmpRect.Bottom := bmpRect.Top + FBitmap.Height;
    bmpRect.Right := bmpRect.Left + FBitmap.Width;

    if csDesigning in ComponentState then
    begin
      Canvas.Stroke.Color := claBlack;
      Canvas.Stroke.Kind := TBrushKind.bkSolid;
{$IFDEF Delphi25}
      Canvas.Stroke.Thickness := 2;
{$ELSE}
      Canvas.StrokeThickness := 2;
{$ENDIF}
      Canvas.DrawRect(RectF(0, 0, Width, Height), 1, 1, AllCorners, 1, TCornerType.ctBevel);
    end;

    if Enabled then
      Canvas.DrawBitmap(FBitmap, RectF(0, 0, FBitmap.Width, FBitmap.Height), bmpRect, 1 )
    else
      Canvas.DrawBitmap(FBitmap, RectF(0, 0, FBitmap.Width, FBitmap.Height), bmpRect, 0.2 );

    if IsMouseOver or IsPressed then
    begin
      Canvas.Stroke.Color := claBlack;
      Canvas.Stroke.Kind := TBrushKind.bkSolid;
{$IFDEF Delphi25}
      Canvas.Stroke.Thickness := 1;
{$ELSE}
      Canvas.StrokeThickness := 1;
{$ENDIF}
      Canvas.Fill.Color := claBlack;
      Canvas.Fill.Kind := TBrushKind.bkSolid;
      Canvas.FillRect(rect, 1, 1, AllCorners, 0.1, TCornerType.ctInnerRound);
      Canvas.DrawRect(rect, 1, 1, AllCorners, 0.3, TCornerType.ctInnerRound);
    end;
{$IFNDEF DELPHI18}
    if Text <> '' then
      Canvas.FillText(RectF(0, 0, Width, Height), Text, False, 1, [], TTextAlign.taCenter);
{$ENDIF}
  finally
    Canvas.RestoreState(state);
    Canvas.SetMatrix(OldM);
  end;
end;

procedure TfrxToolSeparator.Paint;
begin
  with Canvas do
  begin
    Stroke.Color := claGray;
    Stroke.Kind := TBrushKind.bkSolid;
{$IFDEF Delphi25}
    Stroke.Thickness := 1;
{$ELSE}
    StrokeThickness := 1;
{$ENDIF}

    if Self.Width > Self.Height then
    begin
      DrawLine(PointF(0, 0.5), PointF(Self.Width, 0.5), 1);
      Stroke.Color := claWhite;
      DrawLine(PointF(0, 1.5), PointF(Self.Width, 1.5), 1);
    end
    else
    begin
      DrawLine(PointF(0.5, 0), PointF(0.5, Self.Height), 1);
      Stroke.Color := claWhite;
      DrawLine(PointF(1.5, 0), PointF(1.5, Self.Height), 1);
    end;
  end;
end;

procedure TfrxToolGrip.Paint;
var
  i: Integer;
begin
  with Canvas do
  begin
    Fill.Kind := TBrushKind.bkSolid;

    for i := 0 to 3 do
      if Self.Width > Self.Height then
      begin
        Fill.Color := claGray;
        FillRect(RectF(i * 4, 0, i * 4 + 2, 2), 0, 0, allCorners, 1);
      end
      else
      begin
        Fill.Color := claGray;
        FillRect(RectF(0, i * 4, 2, i * 4 + 2), 0, 0, allCorners, 1);
      end;
  end;
end;

{ TfrxTreeViewItem }

procedure TfrxTreeViewItem.ApplyStyle;
var
  B: TFmxObject;
  Offset: Single;
begin
  inherited;
  B := FindStyleResource('button');
  if (B <> nil) and (B is TCustomButton) then
  begin
    FButton := TCustomButton(B);
    B := FindStyleResource('text');
    Offset := 0;
    if Self.TreeView is TfrxTreeView then
      Offset := TfrxTreeView(Self.TreeView).IconWidth;

    if (B <> nil) and (B is TText) then
{$IFDEF DELPHI18}
      TText(B).Margins.Left := Offset;
{$ELSE}
      TText(B).Padding.Left :=  Offset;
{$ENDIF}
      FImgPos := FButton.Position.X + FButton.Width - 2;
  end;
end;


constructor TfrxTreeViewItem.Create(AOwner: TComponent);
begin
  inherited;
  FImgPos := 0;
  FCloseImageIndex := -1;
  FOpenImageIndex := -1;
end;

{$IFDEF DELPHI19}
function TfrxTreeViewItem.GetBitmap: FMX.Graphics.TBitmap;
{$ELSE}
function TfrxTreeViewItem.GetBitmap: FMX.Types.TBitmap;
{$ENDIF}
begin
  Result := nil;
  if TreeView is TfrxTreeView then
  begin
    Result := TfrxTreeView(TreeView).FPicBitmap;
  end;
end;

procedure TfrxTreeViewItem.Paint;
var
{$IFDEF DELPHI19}
  Bmp: FMX.Graphics.TBitmap;
{$ELSE}
  Bmp: FMX.Types.TBitmap;
{$ENDIF}
  IconRect: TRectF;
  Index: Integer;
begin
  inherited Paint;
  if IsExpanded then
    Index := FOpenImageIndex
  else
    Index := FCloseImageIndex;

  if Index = -1 then Exit;


  Bmp := GetBitmap;
  if TreeView is TfrxTreeView then
  begin
    IconRect := TfrxTreeView(TreeView).GetBitmapRect(Index);
  end;
  if (Bmp <> nil) and (FImgPos > 0)then
    Canvas.DrawBitmap(Bmp, IconRect, RectF(16, 0, 32, 16), 1 );
end;

{ TfrxTreeView }

function TfrxTreeView.AddItem(Root: TFmxObject; Text: String): TfrxTreeViewItem;
begin
  Result := TfrxTreeViewItem.Create(Root);
  Result.Text := Text;
  Root.AddObject(Result);
end;

constructor TfrxTreeView.Create(AOwner: TComponent);
begin
  inherited;
  FPicBitmap := nil;
  FIconWidth := 16;
  FIconHeight := 16;
  FEditBox := TEdit.Create(Self);
  FEditBox.Parent := Self;
  FEditBox.Visible := False;
  FEditBox.OnKeyDown := DoEditKeyDown;
  FEditBox.OnEnter := DoExitEdit;
  FIsEditing := False;
  FEditable := False;
  FFreePicOnDelete := False;
  FManualDragAndDrop := False;
end;

procedure TfrxTreeView.DblClick;
begin
  inherited;
  DoEdit;
end;

destructor TfrxTreeView.Destroy;
begin
  if (FPicBitmap <> nil) and FFreePicOnDelete then
    FPicBitmap.Free;

  inherited;
end;

procedure TfrxTreeView.DoEdit;
var
  r: TRectF;
begin
  if (Selected = nil) or (not FEditable) then exit;

  FEditBox.Text := Selected.Text;
  r := Self.GetItemRect(Selected);
  //p := Selected.LocalToAbsolute(PointF(Selected.Position.X, Selected.Position.Y));
  FEditBox.SetBounds(r.Left, r.Top, r.Width, r.Height);
  Selected.Visible := False;
  FEditBox.Visible := True;
  FEditBox.SetFocus;
  FIsEditing := True;
end;

procedure TfrxTreeView.DoEditKeyDown(Sender: TObject; var Key: Word;
  var KeyChar: WideChar; Shift: TShiftState);
begin
  if Key = vkReturn then
    EndEdit(True)
  else if Key = vkEscape then
    EndEdit(False);
end;

procedure TfrxTreeView.DoExit;
begin
  inherited;
  EndEdit(False);
end;

procedure TfrxTreeView.DoExitEdit(Sender: TObject);
begin
  EndEdit(False);
end;

procedure TfrxTreeView.BeginAutoDrag;
var
{$IFDEF DELPHI19}
  S: FMX.Graphics.TBitmap;
{$ELSE}
  S: FMX.Types.TBitmap;
{$ENDIF}

begin
  if (Selected = nil) or (Root = nil) then
    Exit;
  S := Selected.MakeScreenshot;
  try
{$IFNDEF DELPHI20}
    FRoot.BeginInternalDrag(Self, S);
{$ELSE}
    Root.BeginInternalDrag(Self, S);
{$ENDIF}
  finally
    S.Free;
  end;
end;

procedure TfrxTreeView.DragDrop(const Data: TDragObject; const Point: TPointF);
begin
  //inherited;
  // don't use TTreeView handlers
end;

procedure TfrxTreeView.DragOver(const Data: TDragObject; const Point: TPointF;
  {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
begin
  //inherited;
  //don't use TTreeView handlers
end;

procedure TfrxTreeView.EndEdit(Accept: Boolean);
var
  S: String;
begin
  if (Selected = nil) or (FEditBox.Text = '') or not FIsEditing then exit;
  FEditBox.Parent := Self;
  if Accept then
  begin
    Selected.Text := FEditBox.Text;
    S := Selected.Text;
   if Assigned(FOnEdited) then
   begin
    FOnEdited(Self, TfrxTreeViewItem(Selected), S);
    Selected.Text := S;
   end;
  end;
  FEditBox.Visible := False;
  Selected.Visible := True;
  Self.SetFocus;
  FIsEditing := False;
end;

function TfrxTreeView.GetBitmapRect(Index: Integer): TRectF;
var
  ColCount, ColId, RowId: Integer;
begin
  Result := RectF(0, 0, 0, 0);
  if FPicBitmap = nil then Exit;

  ColCount := FPicBitmap.Width div FIconWidth;
  RowId := Index div ColCount;
  ColId := Index mod ColCount;
  Result := RectF(FIconWidth * ColId, FIconHeight * RowId, FIconWidth * ColId + FIconWidth, FIconHeight * RowId + FIconHeight);
end;

procedure TfrxTreeView.KeyDown(var Key: Word; var KeyChar: WideChar;
  Shift: TShiftState);
begin
  inherited;
  if Key = vkReturn then
    DoEdit;
end;

procedure TfrxTreeView.LoadResouces(Stream: TStream; IconWidth,
  IconHeight: Integer);
begin
  FIconWidth := IconWidth;
  FIconHeight := IconHeight;
  FFreePicOnDelete := True;
  if FPicBitmap = nil then
{$IFDEF DELPHI19}
	FPicBitmap := FMX.Graphics.TBitmap.CreateFromStream(Stream)
{$ELSE}
	FPicBitmap := FMX.Types.TBitmap.CreateFromStream(Stream)
{$ENDIF}
  else
    FPicBitmap.LoadFromStream(Stream);
end;



procedure TfrxTreeView.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Single);
begin
  EndEdit(True);
  inherited;
{$IFDEF DELPHI18}
  if (DragMode = TDragMode.dmManual) and FManualDragAndDrop then
    BeginAutoDrag;
{$ENDIF}
end;

{$IFDEF DELPHI19}
procedure TfrxTreeView.SetImages(Bmp: FMX.Graphics.TBitmap);
{$ELSE}
procedure TfrxTreeView.SetImages(Bmp: FMX.Types.TBitmap);
{$ENDIF}
begin
  if (FPicBitmap <> nil) and FFreePicOnDelete then
    FPicBitmap.Free;
  FFreePicOnDelete := False;
  FPicBitmap := Bmp;
end;

procedure TfrxTreeView.SetSelected(const Value: TTreeViewItem);
begin
  if Assigned(FOnBeforeChange) then
    FOnBeforeChange(Self, TfrxTreeViewItem(Selected), TfrxTreeViewItem(Value));
  EndEdit(True);
  inherited;
end;

{$IFDEF DELPHI19}
procedure TfrxToolButton.SetBitmap(const Value: FMX.Graphics.TBitmap);
{$ELSE}
procedure TfrxToolButton.SetBitmap(const Value: FMX.Types.TBitmap);
{$ENDIF}
begin
  FBitmap.Assign(Value);
end;


{ TfrxListBox }

procedure TfrxListBox.Assign(Source: TPersistent);
var
  i: Integer;
  Item: TListBoxItem;
begin
  if Source is TStrings then
  begin
    BeginUpdate;
    try
      Clear;
      for i := 0 to TStrings(Source).Count - 1 do
      begin
        Item := TfrxListBoxItem.Create(Owner);
        if i <> TStrings(Source).Count - 1 then
          TfrxListBoxItem(Item).CheckVisible := True;
        Item.Parent := Self;
        Item.Text := TStrings(Source)[i];
      end;
    finally
      EndUpdate;
    end;
  end
  else
    inherited;
end;

procedure TfrxListBox.BeginAutoDrag;
var
{$IFDEF DELPHI19}
  S: FMX.Graphics.TBitmap;
{$ELSE}
  S: FMX.Types.TBitmap;
{$ENDIF}

begin
  if (Selected = nil) or (Root = nil) then
    Exit;
  S := Selected.MakeScreenshot;
  try
{$IFNDEF DELPHI20}
    FRoot.BeginInternalDrag(Self, S);
{$ELSE}
    Root.BeginInternalDrag(Self, S);
{$ENDIF}
  finally
    S.Free;
  end;
end;

constructor TfrxListBox.Create(AOwner: TComponent);
begin
  inherited;
  FManualDragAndDrop := False;
  FShowButtons := False;
  FItems := TfrxListBoxStrings.Create;
  TfrxListBoxStrings(FItems).FListBox := Self;
end;

destructor TfrxListBox.Destroy;
begin
  inherited;
  FreeAndNil(FItems);
end;

procedure TfrxListBox.DoButtonClick(aButton: TObject; aItem: TfrxListBoxItem);
begin
  if Assigned(OnButtonClick) then
    OnButtonClick(Self, aButton, aItem);
end;

procedure TfrxListBox.DragDrop(const Data: TDragObject; const Point: TPointF);
begin
  inherited;
end;

procedure TfrxListBox.DragEnd;
begin
  inherited;
  DragLeave;
end;

procedure TfrxListBox.DragOver(const Data: TDragObject; const Point: TPointF;
  {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
begin
    if Assigned(OnDragOver) then
      OnDragOver(Self, Data, Point, {$IFNDEF DELPHI20}Accept{$ELSE}Operation{$ENDIF});
  //don't use TListBox handlers
end;

function TfrxListBox.ItemsStored: Boolean;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    if ListItems[I].Stored then
      Exit(False);
  Result := True;
end;

procedure TfrxListBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Single);
begin
  inherited;
{$IFDEF DELPHI18}
  if (DragMode = TDragMode.dmManual) and FManualDragAndDrop then
    BeginAutoDrag;
{$ENDIF}
end;

procedure TfrxListBox.SetItems(const Value: TStrings);
begin
  Items.Assign(Value);
end;

{ TfrxListBox.TfrxListBoxStrings }

function TfrxListBox.TfrxListBoxStrings.Add(const S: string): Integer;
var
  Item: TListBoxItem;
begin
  Item := TfrxListBoxItem.Create(FListBox);
  try
    Item.Text := S;
    Item.Stored := False;
    FListBox.AddObject(Item);
{$IFDEF DELPHI19}
{$IFDEF LINUX}

{$ELSE}
    Item.StyleLookup := FListBox.DefaultItemStyles.ItemStyle;
    THackCustomListBox(FListBox).DispatchStringsChangeEvent(S, TCustomListBox.TStringsChangeOp.tsoAdded);
{$ENDIF}
{$ENDIF}
    Result := Item.Index;
  except
    Item.Free;
    raise;
  end;
end;

procedure TfrxListBox.TfrxListBoxStrings.Clear;
begin
  if not (csDestroying in FListBox.ComponentState) then
    FListBox.Clear;
end;

procedure TfrxListBox.TfrxListBoxStrings.DefineProperties(Filer: TFiler);
  function DoWrite: Boolean;
  begin
    if Filer.Ancestor <> nil then
    begin
      Result := True;
      if Filer.Ancestor is TStrings then
        Result := not Equals(TStrings(Filer.Ancestor))
    end
    else
      Result := Count > 0;
  end;
begin
  Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite);
end;

procedure TfrxListBox.TfrxListBoxStrings.Delete(Index: Integer);
var
  Item: TListBoxItem;
begin
  Item := FListBox.ListItems[Index];
  if Assigned(Item) then
  begin
{$IFDEF DELPHI19}
    if Item = FListBox.ItemDown then
      FListBox.ItemDown := nil;
{$ENDIF}
    FListBox.RemoveObject(Item);
    Item.Free;
  end;
end;

procedure TfrxListBox.TfrxListBoxStrings.Exchange(Index1, Index2: Integer);
begin
  FListBox.Exchange(FListBox.ItemByIndex(Index1), FListBox.ItemByIndex(Index2));

end;

function TfrxListBox.TfrxListBoxStrings.Get(Index: Integer): string;
begin
  Result := FListBox.ListItems[Index].Text;
end;

function TfrxListBox.TfrxListBoxStrings.GetCount: Integer;
begin
   Result := FListBox.Count;
end;

function TfrxListBox.TfrxListBoxStrings.GetObject(Index: Integer): TObject;
begin
  Result := FListBox.ListItems[Index].Data;
end;

function TfrxListBox.TfrxListBoxStrings.IndexOf(const S: string): Integer;
var
  I: Integer;
begin
  for I := 0 to FListBox.Count - 1 do
    if SameText(FListBox.ListItems[I].Text, S) then
      Exit(I);
  Result := -1;

end;

procedure TfrxListBox.TfrxListBoxStrings.Insert(Index: Integer;
  const S: string);
var
  Item: TListBoxItem;
begin
  Item := TfrxListBoxItem.Create(FListBox);
  try
    if Index <> Count - 1 then
      TfrxListBoxItem(Item).CheckVisible := True;
    Item.Text := S;
    Item.Stored := False;
    FListBox.InsertObject(Index, Item);
  except
    Item.Free;
    raise;
  end;

end;

procedure TfrxListBox.TfrxListBoxStrings.Put(Index: Integer; const S: string);
begin
  FListBox.ListItems[Index].Text := S;

end;

procedure TfrxListBox.TfrxListBoxStrings.PutObject(Index: Integer;
  AObject: TObject);
begin
  FListBox.ListItems[Index].Data := AObject;

end;

procedure TfrxListBox.TfrxListBoxStrings.ReadData(Reader: TReader);
begin
  Reader.ReadListBegin;
  BeginUpdate;
  try
    if TfrxListBox(FListBox).ItemsStored then
    begin
      Clear;
      while not Reader.EndOfList do
        Add(Reader.ReadString);
    end
    else
    begin
      while not Reader.EndOfList do
        Reader.ReadString;
    end;
  finally
    EndUpdate;
  end;
  Reader.ReadListEnd;
end;

procedure TfrxListBox.TfrxListBoxStrings.SetUpdateState(Updating: Boolean);
begin
  if Updating then
    FListBox.BeginUpdate
  else
    FListBox.EndUpdate;
end;

procedure TfrxListBox.TfrxListBoxStrings.WriteData(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  for I := 0 to Count - 1 do
    Writer.WriteString(Get(I));
  Writer.WriteListEnd;
end;

{ TfrxListBoxItem }

procedure TfrxListBoxItem.ApplyStyle;
var
  B: TFmxObject;
begin
  inherited;
  B := FindStyleResource('check');
  if Assigned(B) and (B is TCheckBox) then
  begin
    FCheck := TCheckBox(B);
    FCheck.Align := TAlignLayout.alRight;
    if ListBox is TfrxListBox then
    begin
      if TfrxListBox(ListBox).ShowButtons then
      begin
        FButton.Parent := FCheck.Parent;
        FButton.Visible := True;
        FButton.Align := TAlignLayout.alMostRight;
        FButton.Position.X := Width;
        FButton.Width := 40;
        FButton.Height := FCheck.Height;
        FButton.Text := TfrxListBox(ListBox).ButtonText;
        FButton.OnClick := OnBtnClick;
      end;
      FCheck.Text := TfrxListBox(ListBox).CheckBoxText;
    end;

    FCheck.Width := 90;
    FCheck.Visible := FCheckVisible;
  end;
end;

constructor TfrxListBoxItem.Create(AOwner: TComponent);
begin
  inherited;
  FButton := TButton.Create(Self);
  FCheck := nil;
  FCheckVisible := False;
end;

destructor TfrxListBoxItem.Destroy;
begin
  inherited;
end;

procedure TfrxListBoxItem.FreeStyle;
begin
  inherited;
  FCheck := nil;
end;

function TfrxListBoxItem.GetCheckVisible: Boolean;
begin
  Result := FCheckVisible;
  if FCheck <> nil then
  begin
    Result := FCheck.Visible;
  end;
end;

procedure TfrxListBoxItem.OnBtnClick(Sender: TObject);
begin
  if ListBox is TfrxListBox then
  begin
    TfrxListBox(ListBox).DoButtonClick(Sender, Self);
  end;
end;

procedure TfrxListBoxItem.SetCheckVisible(const Value: Boolean);
begin
  if FCheck <> nil then
  begin
    FCheck.Visible := Value;
  end;
  FCheckVisible := Value;
end;

{ TfrxStringList }

function TfrxStringList.CompareStrings(const S1, S2: string): Integer;
begin
  if FUseUnicode then
  begin
    if CaseSensitive then
      Result := frxCompareStr(S1, S2)
    else
      Result := frxCompareText(S1, S2);
  end
  else
  begin
    if CaseSensitive then
      Result := CompareStr(S1, S2)
    else
      Result := CompareText(S1, S2);
  end;
end;

constructor TfrxStringList.Create(UseUnicode: Boolean);
begin
  Create;
  FUseUnicode := UseUnicode;
end;

constructor TfrxStringList.Create;
begin
  Inherited Create;
  FUseUnicode := False;
end;
{$IFDEF DELPHI19}
{$IFDEF MACOS}
function TQuartzBitmap.GetImage: CGImageRef;
begin
  if FImage = nil then
    FImage := CGBitmapContextCreateImage(FContext);
  Result := FImage;
end;
{$ENDIF}

{ TfrxFastCanvas }
{$IFDEF MACoS}
function TfrxFastCanvas.AddCTFontToList(const aNameFont: String;
  aFontRef: CTFontRef): Integer;
begin
  Result := FFontCacheList.AddObject(aNameFont, TObject(aFontRef))
end;

procedure TfrxFastCanvas.AddFontAttribute(
  AAttribute: CFMutableAttributedStringRef; AFont: TFont; const AStart,
  ALength: Integer);
var
  LFontRef: CTFontRef;
  Underline: CFNumberRef;
  LValue: Cardinal;
begin
  // Font
  LFontRef := GetCTFont(AFont);
  if Assigned(LFontRef) then

    CFAttributedStringSetAttribute(AAttribute, CFRangeMake(AStart, ALength),
      kCTFontAttributeName, LFontRef);
  // Underline
  if TFontStyle.fsUnderline in AFont.Style then
  begin
    LValue := kCTUnderlineStyleSingle;
    Underline := CFNumberCreate(nil, kCFNumberSInt32Type, @LValue);
    CFAttributedStringSetAttribute(AAttribute, CFRangeMake(AStart, ALength),
      kCTUnderlineStyleAttributeName, Underline);
  end;
end;

function TfrxFastCanvas.CalcHeight(Frame: CTFrameRef): Single;
var
  fRect: CGRect;
  Lines: CFArrayRef;
  Index: CFIndex;
  Desc: CGFloat;
  Line: CTLineRef;
  LineOrigin: CGPoint;
begin
  FTextHeight := 0;
  if Assigned(Frame) then
  begin
    fRect := CGPathGetBoundingBox(FPath);
    Lines := CTFrameGetLines(Frame);
    Index := CFArrayGetCount(Lines) - 1;
    Line := CTLineRef(CFArrayGetValueAtIndex(Lines, Index));
    CTLineGetTypographicBounds(Line, nil,  @Desc, nil);
    CTFrameGetLineOrigins(Frame, CFRangeMake(Index, 1), @LineOrigin);
    FTextHeight := CGRectGetMaxY(fRect) - LineOrigin.y + Desc;
  end;
  Result := FTextHeight;
end;

function TfrxFastCanvas.CalcWidth(Frame: CTFrameRef): Single;
var
  LFrameRect: CGRect;
  Lines: CFArrayRef;
  NumLines: CFIndex;
  Index: CFIndex;
  aWidth: CGFloat;
  Line: CTLineRef;
begin
  Result := 0;
  if Assigned(Frame) then
  begin
    LFrameRect := CGPathGetBoundingBox(FPath);
    Lines := CTFrameGetLines(Frame);
    NumLines := CFArrayGetCount(Lines);
    FTextWidth := 0;
    if NumLines > 0 then
      for Index := 0 to NumLines - 1 do
      begin
        Line := CTLineRef(CFArrayGetValueAtIndex(Lines, Index));
        aWidth := CTLineGetTypographicBounds(Line, nil,  nil, nil);
        FTextWidth := Max(aWidth, FTextWidth);
      end;
    Result := FTextWidth;
  end;
end;

procedure TfrxFastCanvas.ClearFontCache;
var
  i: Integer;
begin
  for i := 0 to FFontCacheList.Count - 1 do
    CFRelease(CTFontRef(FFontCacheList.Objects[i]));
  FFontCacheList.Clear;
end;

constructor TfrxFastCanvas.Create;
begin
  // use same matrix as in FMX, because we need same output
  FFontTransformMatrix.a := 1;
  FFontTransformMatrix.b := 0;
  FFontTransformMatrix.c := Tan(10);
  FFontTransformMatrix.d := 1;
  FFontTransformMatrix.tx := 0;
  FFontTransformMatrix.ty := 0;
  FOpacity := 1;
  FCurentFont := nil;
  FFontCacheList := TfrxStringList.Create;
  FColorSpace := CGColorSpaceCreateDeviceRGB;
  FCanvas := nil;
end;

function TfrxFastCanvas.CreateCTFont(const AFont: TFont): CTFontRef;
var
  FontRefCopy: CTFontRef;
  m: PCGAffineTransform;
begin
  Result := CTFontCreateWithName(CFSTR(AFont.Family), AFont.Size * 1, nil);
  m := nil;
  try
    if TFontStyle.fsItalic in AFont.Style then
    begin
      FontRefCopy := CTFontCreateCopyWithSymbolicTraits(Result, 0, nil,
        kCTFontItalicTrait, kCTFontItalicTrait);
      if Assigned(FontRefCopy) then
      begin
        CFRelease(Result);
        Result := FontRefCopy;
      end
      else
      begin
        m := @FFontTransformMatrix;
        FontRefCopy := CTFontCreateWithName(CFSTR(AFont.Family), AFont.Size * 1, @FFontTransformMatrix);
        if Assigned(FontRefCopy) then
        begin
          CFRelease(Result);
          Result := FontRefCopy;
        end;
      end;
    end;
    if TFontStyle.fsBold in AFont.Style then
    begin
      FontRefCopy := CTFontCreateCopyWithSymbolicTraits(Result, 0, m,
        kCTFontBoldTrait, kCTFontBoldTrait);
      if Assigned(FontRefCopy) then
      begin
        CFRelease(Result);
        Result := FontRefCopy;
      end;
    end;
  except
    CFRelease(Result);
  end;
end;

procedure TfrxFastCanvas.CreateFrame(Canvas: TCanvas; StringRef: CFStringRef;
  var AttributedS: CFMutableAttributedStringRef; var Frame: CTFrameRef);
var
  Value: Cardinal;
  Ligature: CFNumberRef;
  FrameSetter: CTFramesetterRef;
  AlphaRec: TAlphaColorRec;
  rgba: array [0 .. 3] of CGFloat;
  TextColor: CGColorRef;
  Alignment: Byte;
  Direction: Byte;
  Wrapping: Byte;
  ParaSettings: array [0 .. 2] of CTParagraphStyleSetting;
  ParagraphStyle: CTParagraphStyleRef;
begin
  AttributedS := CFAttributedStringCreateMutable(kCFAllocatorDefault, 0);
  CFAttributedStringReplaceString(AttributedS, CFRangeMake(0, 0), StringRef);
  CFAttributedStringBeginEditing(AttributedS);

  AlphaRec := TAlphaColorRec(MakeColor(Canvas.Fill.Color, FOpacity));
  rgba[0] := AlphaRec.r / $FF;
  rgba[1] := AlphaRec.g / $FF;
  rgba[2] := AlphaRec.b / $FF;
  rgba[3] := AlphaRec.a / $FF;

  TextColor := CGColorCreate(FColorSpace, @rgba[0]);
  CFAttributedStringSetAttribute(AttributedS, CFRangeMake(0, FText.Length),
  kCTForegroundColorAttributeName, TextColor);
  CFRelease(TextColor);

  Value := 0;
  Ligature := CFNumberCreate(nil, kCFNumberSInt32Type, @Value);
  CFAttributedStringSetAttribute(AttributedS, CFRangeMake(0, FText.Length), kCTLigatureAttributeName, Ligature);
  AddFontAttribute(AttributedS, Canvas.Font, 0, FText.Length);

  case FTextAlign of
    TTextAlign.taCenter:
      Alignment := kCTCenterTextAlignment;
    TTextAlign.taLeading:
      Alignment := kCTLeftTextAlignment;
    TTextAlign.taTrailing:
      Alignment := kCTRightTextAlignment;
  end;
  ParaSettings[0].spec := kCTParagraphStyleSpecifierAlignment;
  ParaSettings[0].valueSize := sizeof(Alignment);
  ParaSettings[0].Value := @Alignment;

  if FWordWrap then
    Wrapping := kCTLineBreakByWordWrapping
  else
    Wrapping := kCTLineBreakByClipping;

  ParaSettings[1].spec := kCTParagraphStyleSpecifierLineBreakMode;
  ParaSettings[1].valueSize := SizeOf(Wrapping);
  ParaSettings[1].value := @Wrapping;

  if TFillTextFlag.ftRightToLeft in FFlags then
    Direction := kCTWritingDirectionRightToLeft
  else
    Direction := kCTWritingDirectionLeftToRight;
  ParaSettings[2].spec := kCTParagraphStyleSpecifierBaseWritingDirection;
  ParaSettings[2].valueSize := SizeOf(Direction);
  ParaSettings[2].value := @Direction;
  ParagraphStyle := CTParagraphStyleCreate(@ParaSettings[0], 3);

  CFAttributedStringSetAttribute(AttributedS, CFRangeMake(0, CFStringGetLength(StringRef)), kCTParagraphStyleAttributeName, ParagraphStyle);
  CFRelease(ParagraphStyle);
  CFAttributedStringEndEditing(AttributedS);
  FrameSetter := CTFramesetterCreateWithAttributedString(CFAttributedStringRef(AttributedS));
  Frame := CTFramesetterCreateFrame(FrameSetter, CFRangeMake(0, 0), FPath, nil);
end;

destructor TfrxFastCanvas.Destroy;
begin
  ClearFontCache;
  FreeAndNil(FFontCacheList);
  inherited;
end;
type TProc = procedure of object;

procedure TfrxFastCanvas.FillText(
  const ARect: TRectF; const AText: string; const WordWrap: Boolean;
  const AOpacity: Single; const Flags: TFillTextFlags; const ATextAlign,
  AVTextAlign: TTextAlign);
var
 cref: CGContextRef;
 LStringRef: CFStringRef;
 FCTFrame: CTFrameRef;
 Bounds: CGRect;
 Attr: CFMutableAttributedStringRef;
begin
  if AText.Length = 0 then Exit;
  FText := AText;
  FTextAlign := ATextAlign;
  FWordWrap := WordWrap;
  FFlags := Flags;
  FOpacity := AOpacity;
  if (CompareText(Canvas.ClassName, 'TCanvasQuartz') = 0) and (FContext <> 0) then
  begin
    FPath := CGPathCreateMutable();
    Bounds := CGRectMake(0, 0, ARect.Width, $FFFF);
    CGPathAddRect(FPath, nil, Bounds);
    LStringRef := CFStringCreateWithCharacters(kCFAllocatorDefault, PChar(AText), AText.Length);
    CreateFrame(Canvas, LStringRef, Attr, FCTFrame);

    cref := Pointer(FContext);
    CGContextSaveGState(cref);
    CGContextClipToRect(cref, CGRectMake(ARect.Left, ARect.Top, ARect.Width, ARect.Height));
    CGContextSetTextMatrix(cref, CGAffineTransformMakeScale(1.0, 1.0));
    CGContextTranslateCTM(cref, ARect.Left, ARect.Bottom);
    CGContextScaleCTM(cref, 1, -1);
    CGContextTranslateCTM(cref, 0, -($FFFF - ARect.Height));

    CalcHeight(FCTFrame);

    case AVTextAlign of
      TTextAlign.taCenter:
        CGContextTranslateCTM(cref, 0,
          -(ARect.Height - FTextHeight) / 2);
      TTextAlign.taLeading:
        CGContextTranslateCTM(cref, 0, 0);
      TTextAlign.taTrailing:
        CGContextTranslateCTM(cref, 0,
          -(ARect.Height - FTextHeight));
    end;

    CTFrameDraw(FCTFrame, cref);

    CGContextRestoreGState(cref);
    CFRelease(LStringRef);
    CFRelease(Attr);
    CFRelease(FPath);
    CFRelease(FCTFrame);
  end
  else
    Inherited;
end;

function TfrxFastCanvas.GetContext: THandle;
begin
  if Assigned(FCanvas.Bitmap) and (FCanvas.Bitmap.Handle <> 0) then
  begin
    if (TQuartzBitmap(FCanvas.Bitmap.Handle).FImage <> nil) then
    begin
      CGImageRelease(TQuartzBitmap(FCanvas.Bitmap.Handle).FImage);
      TQuartzBitmap(FCanvas.Bitmap.Handle).FImage := nil;
    end;
    FContext := THandle(CGBitmapContextCreate(TQuartzBitmap(FCanvas.Bitmap.Handle).FData, FCanvas.Bitmap.Width, FCanvas.Bitmap.Height, 8,
          FCanvas.Bitmap.Width * 4, FColorSpace, kCGImageAlphaPremultipliedLast));
  end;
  Result := FContext;
end;

function TfrxFastCanvas.GetCTFont(const AFont: TFont): CTFontRef;
var
  fName: String;
  Index: Integer;
begin
  Result := nil;
  fName := GetFontNameHash(aFont);
  Index := FFontCacheList.IndexOf(fName);
  if Index = -1 then
    Index := AddCTFontToList(fName, CreateCTFont(aFont));
  Result := CTFontRef(FFontCacheList.Objects[Index])
end;

function TfrxFastCanvas.GetFontNameHash(const AFont: TFont): String;
begin
  Result := aFont.Family;
  if fsBold in aFont.Style then
    Result := Result + 'B';
  if fsItalic in aFont.Style then
    Result := Result + 'I';
  Result := Result + FloatToStr(aFont.Size);
end;

procedure TfrxFastCanvas.MeasureText(var ARect: TRectF; const AText: string; const WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign);
var
 cref: CGContextRef;
 LStringRef: CFStringRef;
 FCTFrame: CTFrameRef;
 Bounds: CGRect;
 Attr: CFMutableAttributedStringRef;
 w, h: Double;
begin
  w := 0;
  h := 0;
  if AText.Length = 0 then
    Exit;
  FText := AText;
  FTextAlign := ATextAlign;
  FWordWrap := WordWrap;
  FFlags := Flags;
  if CompareText(Canvas.ClassName, 'TCanvasQuartz') = 0 then
  begin
    FPath := CGPathCreateMutable();
    Bounds := CGRectMake(0, 0, ARect.Width, $FFFF);
    CGPathAddRect(FPath, nil, Bounds);
    LStringRef := CFStringCreateWithCharacters(kCFAllocatorDefault, PChar(AText), AText.Length);
    CreateFrame(Canvas, LStringRef, Attr, FCTFrame);
    cref := Pointer(FContext);

    CGContextSaveGState(cref);
    CGContextClipToRect(cref, CGRectMake(ARect.Left, ARect.Top, ARect.Width, ARect.Height));
    CGContextSetTextMatrix(cref, CGAffineTransformMakeScale(1.0, 1.0));
    CGContextTranslateCTM(cref, ARect.Left, ARect.Bottom);
    CGContextScaleCTM(cref, 1, -1);
    CGContextTranslateCTM(cref, 0, -($FFFF - ARect.Height));

    w := CalcWidth(FCTFrame);
    h := CalcHeight(FCTFrame);
    CGContextRestoreGState(cref);
    CFRelease(Attr);
    CFRelease(LStringRef);
    CFRelease(FPath);
    CFRelease(FCTFrame);
  end;

  ARect.Right := ARect.Left + w;
  ARect.Bottom := ARect.Top + h;
end;

procedure TfrxFastCanvas.SetCanvas(const Value: TCanvas);
begin
  FCanvas := Value;
end;

procedure TfrxFastCanvas.SetFont(const Value: TFont);
begin
  FCurentFont := GetCTFont(Value);
end;
{$ENDIF}

{ TfrxFastCanvasLayer }

function TfrxFastCanvasLayer.CalcHeight(aText: String): Single;
begin
  Result := 0;
  if Assigned(Canvas) then
    Result := Canvas.TextHeight(aText);
end;

function TfrxFastCanvasLayer.CalcWidth(aText: String): Single;
begin
  Result := 0;
  if Assigned(Canvas) then
    Result := Canvas.TextWidth(aText);
end;

procedure TfrxFastCanvasLayer.Clear(const Color: TAlphaColor);
begin
  //fake
end;

procedure TfrxFastCanvasLayer.ClearCache;
begin
  //nothing
end;

procedure TfrxFastCanvasLayer.ClearRect(const ARect: TRectF;
  const AColor: TAlphaColor);
begin
  //fake
end;

constructor TfrxFastCanvasLayer.Create;
begin
  FContext := 0;
end;

destructor TfrxFastCanvasLayer.Destroy;
begin

  inherited;
end;

function TfrxFastCanvasLayer.DoBeginScene({$IFNDEF DELPHI28}const{$ENDIF} AClipRects: PClipRects;
  AContextHandle: THandle): Boolean;
begin
  Result := False;
  if AContextHandle = 0 then
    AContextHandle := THandle(GetContext);
  if Assigned(Canvas) then
    Result := Canvas.BeginScene(AClipRects, AContextHandle);
end;


{$IFDEF DELPHI19}
procedure TfrxFastCanvasLayer.DoDrawBitmap(const ABitmap: FMX.Graphics.TBitmap;
  const SrcRect, DstRect: TRectF; const AOpacity: Single;
  const HighSpeed: Boolean);
{$ELSE}
procedure TfrxFastCanvasLayer.DoDrawBitmap(const ABitmap: FMX.Types.TBitmap;
  const SrcRect, DstRect: TRectF; const AOpacity: Single;
  const HighSpeed: Boolean);
{$ENDIF}
begin
  inherited;

end;

procedure TfrxFastCanvasLayer.DoDrawEllipse(const ARect: TRectF;
  const AOpacity: Single; const ABrush: TStrokeBrush);
begin
  //fake
end;

procedure TfrxFastCanvasLayer.DoDrawLine(const APt1, APt2: TPointF;
  const AOpacity: Single; const ABrush: TStrokeBrush);
begin
  //fake
end;

procedure TfrxFastCanvasLayer.DoDrawPath(const APath: TPathData;
  const AOpacity: Single; const ABrush: TStrokeBrush);
begin
  //fake
end;

procedure TfrxFastCanvasLayer.DoDrawRect(const ARect: TRectF;
  const AOpacity: Single; const ABrush: TStrokeBrush);
begin
  inherited;

end;

procedure TfrxFastCanvasLayer.DoEndScene;
begin
  if Assigned(Canvas) then
    Canvas.EndScene;
end;

procedure TfrxFastCanvasLayer.DoFillEllipse(const ARect: TRectF;
  const AOpacity: Single; const ABrush: TBrush);
begin
  //fake
end;

procedure TfrxFastCanvasLayer.DoFillPath(const APath: TPathData;
  const AOpacity: Single; const ABrush: TBrush);
begin
  //fake
end;

procedure TfrxFastCanvasLayer.DoFillRect(const ARect: TRectF;
  const AOpacity: Single; const ABrush: TBrush);
begin
  //fake
end;

{$IFDEF DELPHI21}

function TfrxFastCanvasLayer.DoFillPolygon(const Points: TPolygon;
  const AOpacity: Single; const ABrush: TBrush): Boolean;
begin
  //fake
  Result := False;
end;

class procedure TfrxFastCanvasLayer.DoFinalizeBitmap(var Bitmap: THandle);
begin
  //fake
end;

class function TfrxFastCanvasLayer.DoInitializeBitmap(const Width,
  Height: Integer; const Scale: Single; var PixelFormat: TPixelFormat): THandle;
begin
  //fake
  Result := 0;
end;

class function TfrxFastCanvasLayer.DoMapBitmap(const Bitmap: THandle;
  const Access: TMapAccess; var Data: TBitmapData): Boolean;
begin
  //fake
  Result := False;
end;

class procedure TfrxFastCanvasLayer.DoUnmapBitmap(const Bitmap: THandle;
  var Data: TBitmapData);
begin
  //fake
end;
{$ELSE}
{$IFDEF DELPHI19}
class procedure TfrxFastCanvasLayer.DoInitializeBitmap(const Bitmap: FMX.Graphics.TBitmap);
begin
  //fake
end;
class procedure TfrxFastCanvasLayer.DoFinalizeBitmap(const Bitmap: FMX.Graphics.TBitmap);
begin
  //fake
end;
class function TfrxFastCanvasLayer.DoMapBitmap(const Bitmap: FMX.Graphics.TBitmap; const Access: TMapAccess; var Data: TBitmapData): Boolean;
begin
  Result := False;
  //fake
end;
class procedure TfrxFastCanvasLayer.DoUnmapBitmap(const Bitmap: FMX.Graphics.TBitmap; var Data: TBitmapData);
begin
  //fake
end;
{$ENDIF}
{$ENDIF}

procedure TfrxFastCanvasLayer.ExcludeClipRect(const ARect: TRectF);
begin
  //fake
end;

procedure TfrxFastCanvasLayer.FillText(const ARect: TRectF;
  const AText: string; const WordWrap: Boolean; const AOpacity: Single;
  const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign);
begin
  if Assigned(Canvas) then
    Canvas.FillText(ARect, AText, WordWrap, AOpacity, Flags, ATextAlign,
      AVTextAlign);
end;

function TfrxFastCanvasLayer.GetContext: THandle;
begin
  Result := FContext;
end;

procedure TfrxFastCanvasLayer.IntersectClipRect(const ARect: TRectF);
begin
  //fake
end;

procedure TfrxFastCanvasLayer.MeasureText(var ARect: TRectF;
  const AText: string; const WordWrap: Boolean; const Flags: TFillTextFlags;
  const ATextAlign, AVTextAlign: TTextAlign);
begin
  if Assigned(Canvas) then
    Canvas.MeasureText(ARect, AText, WordWrap, Flags, ATextAlign,
      AVTextAlign);
end;

function TfrxFastCanvasLayer.PtInPath(const APoint: TPointF;
  const APath: TPathData): Boolean;
begin
  //fake
  Result := False;
end;

procedure TfrxFastCanvasLayer.SetCanvas(const Value: TCanvas);
begin
  if Assigned(Value) then
  begin
    FWidth := Value.Width;
    FHeight := Value.Height;
  end;
  FCanvas := Value;
end;

procedure TfrxFastCanvasLayer.SetContext(const Value: THandle);
begin
  FContext := Value;
end;

procedure TfrxFastCanvasLayer.SetFont(const Value: TFont);
begin
  if Assigned(Canvas) then
    Canvas.Font.Assign(Value);
end;

{ TfrxFastCanvas }

{$IFDEF MSWINDOWS}
procedure TfrxFastCanvas.ClearFontCache;
var
  i: Integer;
begin
  for i := 0 to FFontCacheList.Count - 1 do
    FFontCacheList.Objects[i].Free;
  FFontCacheList.Clear;
end;

constructor TfrxFastCanvas.Create;
begin
  FFontCacheList := TfrxStringList.Create;
  FFontCacheList.Sorted := True;
end;

destructor TfrxFastCanvas.Destroy;
begin
  ClearFontCache;
  FreeAndNil(FFontCacheList);
  inherited;
end;

procedure TfrxFastCanvas.FillText(const ARect: TRectF; const AText: string;
  const WordWrap: Boolean; const AOpacity: Single; const Flags: TFillTextFlags;
  const ATextAlign, AVTextAlign: TTextAlign);
var
  DLayont: TTextLayout;
  Fonthash: String;
  Index: Integer;
begin
  if Canvas.ClassName <> 'TCanvasGdiPlus' then
  begin
    Inherited;
    Exit;
  end;
  fonthash := GetFontNameHash(FCanvas.Font, WordWrap, Flags, ATextAlign, AVTextAlign);
  Index := FFontCacheList.IndexOf(fonthash);

  if Index = -1 then
  begin
    DLayont := TTextLayoutManager.TextLayoutByCanvas(Canvas.ClassType)
      .Create(Canvas);
    DLayont.BeginUpdate;
    DLayont.Font := Canvas.Font;
    DLayont.WordWrap := WordWrap;
    DLayont.HorizontalAlign := ATextAlign;
    DLayont.VerticalAlign := AVTextAlign;
    DLayont.RightToLeft := TFillTextFlag.ftRightToLeft in Flags;
    DLayont.EndUpdate;
    DLayont.BeginUpdate;
    Index := FFontCacheList.AddObject(fonthash, DLayont);
  end;

  DLayont := TTextLayout(FFontCacheList.Objects[Index]);
  DLayont.Color := Canvas.Fill.Color;
  DLayont.Opacity := AOpacity;
  DLayont.TopLeft := ARect.TopLeft;
  DLayont.MaxSize := PointF(ARect.Width, ARect.Height);
  DLayont.Text := AText;
  TTextLayoutHack(DLayont).DoDrawLayout(Canvas);
end;

function TfrxFastCanvas.GetContext: THandle;
begin
  Result := 0;
end;

function TfrxFastCanvas.GetFontNameHash(const AFont: TFont; WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign: TTextAlign; const VTextAlign: TTextAlign): String;
begin
  Result := aFont.Family;
  if fsBold in aFont.Style then
    Result := Result + 'B';
  if fsItalic in aFont.Style then
    Result := Result + 'I';
  if fsUnderline in aFont.Style then
    Result := Result + 'U';
 if fsStrikeout in aFont.Style then
    Result := Result + 'U';
  if WordWrap then
    Result := Result + 'W';
  case ATextAlign of
    TTextAlign.taCenter: Result := Result + 'C';
    TTextAlign.taLeading: Result := Result + 'L';
    TTextAlign.taTrailing: Result := Result + 'T';
  end;
  case VTextAlign of
    TTextAlign.taCenter: Result := Result + 'VC';
    TTextAlign.taLeading: Result := Result + 'VL';
    TTextAlign.taTrailing: Result := Result + 'VT';
  end;
  if TFillTextFlag.ftRightToLeft in Flags then
    Result := Result + 'R';
  Result := Result + FloatToStr(aFont.Size);
end;


procedure TfrxFastCanvas.MeasureText(var ARect: TRectF; const AText: string;
  const WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign,
  AVTextAlign: TTextAlign);
var
  DLayont: TTextLayout;
  Fonthash: String;
  Index: Integer;
    tr: TTextRange;
  LRegion: TRegion;
  i: Integer;
begin
  if Canvas.ClassName <> 'TCanvasGdiPlus' then
  begin
    Inherited;
    Exit;
  end;
  fonthash := GetFontNameHash(FCanvas.Font, WordWrap, Flags, ATextAlign, AVTextAlign);
  Index := FFontCacheList.IndexOf(fonthash);

  if Index = -1 then
  begin
    DLayont := TTextLayoutManager.TextLayoutByCanvas(Canvas.ClassType)
      .Create(Canvas);
    DLayont.BeginUpdate;
    DLayont.Font := Canvas.Font;
    DLayont.WordWrap := WordWrap;
    DLayont.HorizontalAlign := ATextAlign;
    DLayont.VerticalAlign := AVTextAlign;
    DLayont.RightToLeft := False;
    DLayont.EndUpdate;
    DLayont.BeginUpdate;
    Index := FFontCacheList.AddObject(fonthash, DLayont);
  end;

  DLayont := TTextLayout(FFontCacheList.Objects[Index]);
  DLayont.TopLeft := ARect.TopLeft;
  DLayont.MaxSize := PointF(ARect.Width, ARect.Height);
  DLayont.Text := AText;
  DLayont.TopLeft := ARect.TopLeft;
  DLayont.MaxSize := PointF(ARect.Width, ARect.Height);
  DLayont.Text := AText;
  tr.Pos := 0;
  tr.Length := Length(AText);
  LRegion := TTextLayoutHack(DLayont).DoRegionForRange(tr);

 if Length(LRegion) > 0 then
  begin
    for i := 1 to High(LRegion) do
      LRegion[0].Union(LRegion[i]);
    ARect.Left := LRegion[0].Left;
    ARect.Top := LRegion[0].Top;
    ARect.Width := LRegion[0].Width;
    ARect.Height := LRegion[0].Height;
  end;

end;

{$ENDIF}
{$ENDIF}

{ TfrxFastCanvasLayer }

type
  TCommonCustomFormHack = class(TCommonCustomForm);

procedure TfrxFastCanvasLayer.UpdateHandle(AParent: TFmxObject);
var
  ParentForm: TFmxObject;
begin
  ParentForm := AParent;
  while (ParentForm <> nil) and not (ParentForm is TCommonCustomForm) do
    ParentForm := ParentForm.Parent;
  if (ParentForm is TCommonCustomForm) then
    Context := TCommonCustomFormHack(ParentForm).ContextHandle
  else
    Context := 0;
end;

{$IFDEF MSWINDOWS}
function frxGetDefaultPPI: Integer;
var
  dc: HDC;
begin
  dc := GetDC(0);
  try
    Result := GetDeviceCaps(dc, LOGPIXELSX);
  finally
    ReleaseDC(0, dc);
  end;
end;
{$ENDIF}

initialization
{$IFDEF MSWINDOWS}
  frxDefaultPPI := frxGetDefaultPPI;
{$ENDIF}

  frxCanvasClass;

  StartClassGroup(TFmxObject);
  ActivateClassGroup(TFmxObject);
  GroupDescendentsWith(TfrxToolButton, TFmxObject);
  GroupDescendentsWith(TfrxToolSeparator, TFmxObject);
  GroupDescendentsWith(TfrxToolGrip, TFmxObject);
  GroupDescendentsWith(TfrxFont, TFmxObject);
  GroupDescendentsWith(TfrxTreeView, TFmxObject);
  GroupDescendentsWith(TfrxTreeViewItem, TFmxObject);
  GroupDescendentsWith(TfrxImageList, TFmxObject);
  GroupDescendentsWith(TfrxListBoxItem, TFmxObject);
  GroupDescendentsWith(TfrxListBox, TFmxObject);
  RegisterFmxClasses([TfrxToolButton, TfrxTreeViewItem, TfrxTreeView, TfrxListBoxItem, TfrxListBox, TfrxToolSeparator, TfrxToolGrip, TfrxFont]);
{$IFDEF MACOS}
  UCCreateCollator(nil, nil, kUCCollateCaseInsensitiveMask, @collatorRefIgnoreCase);
  UCCreateCollator(nil, nil, 0, @collatorRef);

finalization
  UCDisposeCollator(@collatorRefIgnoreCase);
  UCDisposeCollator(@collatorRef);
{$ENDIF}
end.