diff --git a/KI/FMX_Intf.txt b/KI/FMX_Intf.txt new file mode 100644 index 0000000..902781e --- /dev/null +++ b/KI/FMX_Intf.txt @@ -0,0 +1,18600 @@ +// Combined interfaces from directories: +// - C:\Program Files (x86)\Embarcadero\Studio\23.0\source\fmx (recursive) +// Focus mode (-fx) active for files: T:\Myc\ASTPlayground\MainForm.pas +// Generated on: 29.08.2025 17:22:17 + +uses + system.actions, + system.analytics, + system.character, + system.classes, + system.devices, + system.generics.collections, + system.generics.defaults, + system.imagelist, + system.math, + system.math.vectors, + system.messaging, + system.rtti, + system.sysutils, + system.types, + system.uiconsts, + system.uitypes, + winapi.messages; + +//================================================================================================== +//== UNIT START: FMX.ActnList (from FMX.ActnList.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + /// Interface used by the framework to access an action in a + /// class. + IActionClient = interface + ['{4CAAFEEE-73ED-4C4B-8413-8BF1C3FFD777}'] + /// The root component. This is usually a form on which the control which supports this interface is placed. + /// This function is used by framework + /// Instance of component that supports IRoot interface + function GetRoot: TComponent; + /// This method is used by the framework to determine that an instance of object which supports this + /// interface is used when working with actions. See also InitiateAction. If returns False then the + /// instance will be ignored + /// The value set using the method SetActionClient + function GetActionClient: Boolean; + /// This method sets value that the GetActionClient function returns + procedure SetActionClient(const Value: Boolean); + function GetAction: TBasicAction; + procedure SetAction(const Value: TBasicAction); + /// When the framework performs periodical execution of InitiateAction, it invokes the controls in + /// order defined by this index + function GetIndex: Integer; + /// Calls the action link's Update method if the instance is associated with an action link + /// + procedure InitiateAction; + /// Action associated with this instance + property Action: TBasicAction read GetAction write SetAction; + end; + + /// The IIsChecked interface provides access to the IsChecked + /// property for controls that can be checked. + IIsChecked = interface + ['{DE946EB7-0A6F-4458-AEB0-C911122630D0}'] + function GetIsChecked: Boolean; + procedure SetIsChecked(const Value: Boolean); + /// Determines whether the IsChecked property needs to be stored in the fmx-file + /// True if IsChecked property needs to be stored, usually if it contains non default value + /// + function IsCheckedStored: Boolean; + /// True if the control is in the ON state + property IsChecked: Boolean read GetIsChecked write SetIsChecked; + end; + + /// The IGroupName interface provides access to the GroupName + /// property for controls that need to provide exclusive checking inside a + /// group. + IGroupName = interface(IIsChecked) + ['{F5C14792-67AB-41F2-99C1-90C7F94102EE}'] + function GetGroupName: string; + procedure SetGroupName(const Value: string); + /// True if GroupName property should be stored + /// True if GroupName property needs to be stored, usually if it contains non default + /// ('', '0', '-1') value + function GroupNameStored: Boolean; + /// Name of the control group + property GroupName: string read GetGroupName write SetGroupName; + end; + + /// Interface used to access the Shortcut property of some + /// classes. + IKeyShortcut = interface + ['{1AE6E932-9291-4BCD-93D1-DDD2A3E09394}'] + function GetShortcut: TShortcut; + procedure SetShortcut(const Value: TShortcut); + /// The combination of hot keys that the class should handle + property Shortcut: TShortcut read GetShortcut write SetShortcut; + end; + + /// If an object supports the ICaption interface, when the text of + /// the object changes, the Text must also be changed. + ICaption = interface + ['{3D039C9C-8888-466F-A344-E7026EEE2C07}'] + function GetText: string; + procedure SetText(const Value: string); + /// If this function returns true, the text should be save in the fmx-file. + function TextStored: Boolean; + /// This property is used to changed the display text. + property Text: string read GetText write SetText; + end; + + /// Declares basic methods and properties used to manage lists of + /// images. + IGlyph = interface + ['{62BDCA4F-820A-4058-B57A-FE8931DB3CCC}'] + function GetImageIndex: TImageIndex; + procedure SetImageIndex(const Value: TImageIndex); + function GetImages: TBaseImageList; + procedure SetImages(const Value: TBaseImageList); + /// Should be called when you change an instance or reference to instance of TBaseImageList or the + /// ImageIndex property + procedure ImagesChanged; + /// Zero based index of an image. The default is -1 + /// If non-existing index is specified, an image is not drawn and no exception is raised + property ImageIndex: TImageIndex read GetImageIndex write SetImageIndex; + /// The list of images. Can be nil + property Images: TBaseImageList read GetImages write SetImages; + end; + + TCustomActionList = class(TContainedActionList) + private + FImageLink: TImageLink; + procedure SetImages(const Value: TBaseImageList); + function GetImages: TBaseImageList; + protected + /// Should be called when you change an instance or reference to instance of TBaseImageList or the + /// ImageIndex property + procedure ImagesChanged; virtual; + public + destructor Destroy; override; + function DialogKey(const Key: Word; const Shift: TShiftState): Boolean; virtual; + /// The list of images. Can be nil + property Images: TBaseImageList read GetImages write SetImages; + end; + + TActionList = class(TCustomActionList) + published + property Name; + property Images; + property State; + property OnChange; + property OnExecute; + property OnStateChange; + property OnUpdate; + end; + + TActionLink = class(TContainedActionLink) + private + [Weak] FClient: TObject; + FIsViewActionClient: Boolean; + [Weak] FImages: TBaseImageList; + FGlyph: IGlyph; + FCaption: ICaption; + FChecked: IIsChecked; + FGroupName: IGroupName; + procedure UpdateImages(const AImageListLinked: Boolean); + protected + procedure AssignClient(AClient: TObject); override; + procedure SetAction(Value: TBasicAction); override; + function IsCaptionLinked: Boolean; override; + function IsCheckedLinked: Boolean; override; + function IsEnabledLinked: Boolean; override; + function IsGroupIndexLinked: Boolean; override; + function IsOnExecuteLinked: Boolean; override; + function IsShortCutLinked: Boolean; override; + function IsVisibleLinked: Boolean; override; + function IsImageIndexLinked: Boolean; override; + procedure SetCaption(const Value: string); override; + procedure SetChecked(Value: Boolean); override; + procedure SetGroupIndex(Value: Integer); override; + procedure SetImageIndex(Value: Integer); override; + procedure Change; override; + /// Reference to IGlyph interface of Client. Nil if Client is undefined or + /// does not support this interface + property Glyph: IGlyph read FGlyph; + public + function IsHelpContextLinked: Boolean; override; + function IsViewActionClient: Boolean; + property Client: TObject read FClient; + /// The list of images. Can be nil + property Images: TBaseImageList read FImages; + property CaptionLinked: Boolean read IsCaptionLinked; + /// Same as IsHintLinked + property HintLinked: Boolean read IsHintLinked; + property CheckedLinked: Boolean read IsCheckedLinked; + property EnabledLinked: Boolean read IsEnabledLinked; + property GroupIndexLinked: Boolean read IsGroupIndexLinked; + property ShortCutLinked: Boolean read IsShortCutLinked; + property VisibleLinked: Boolean read IsVisibleLinked; + property OnExecuteLinked: Boolean read IsOnExecuteLinked; + end; + + TActionLinkClass = class of TActionLink; + + TShortCutList = class(TCustomShortCutList) + public + function Add(const S: string): Integer; override; + end; + + TCustomAction = class(TContainedAction) + private + FShortCutPressed: Boolean; + [Weak] FTarget: TComponent; + FUnsupportedArchitectures: TArchitectures; + FUnsupportedPlatforms: TPlatforms; + FOldVisible: Boolean; + FOldEnabled: Boolean; + FSupported: Boolean; + FCustomText: string; + FSupportedChecked: Boolean; + FHideIfUnsupportedInterface: Boolean; + function GetText: string; inline; + procedure SetText(const Value: string); inline; + function GetCustomActionList: TCustomActionList; + procedure SetCustomActionList(const Value: TCustomActionList); + procedure ReaderCaptionProc(Reader: TReader); + procedure WriterCaptionProc(Writer: TWriter); + procedure ReaderImageIndexProc(Reader: TReader); + procedure WriterImageIndexProc(Writer: TWriter); + procedure SetUnsupportedArchitectures(const Value: TArchitectures); + procedure SetUnsupportedPlatforms(const Value: TPlatforms); + procedure SetCustomText(const Value: string); + procedure SetHideIfUnsupportedInterface(const Value: Boolean); + protected + procedure UpdateSupported; + function IsSupportedInterface: Boolean; virtual; + function CreateShortCutList: TCustomShortCutList; override; + procedure DefineProperties(Filer: TFiler); override; + procedure SetTarget(const Value: TComponent); virtual; + procedure SetEnabled(Value: Boolean); override; + procedure SetVisible(Value: Boolean); override; + procedure Loaded; override; + procedure CustomTextChanged; virtual; + property CustomText: string read FCustomText write SetCustomText; + public + constructor Create(AOwner: TComponent); override; + function Execute: Boolean; override; + function Update: Boolean; override; + function IsDialogKey(const Key: Word; const Shift: TShiftState): Boolean; + property Text: string read GetText write SetText; + property Caption stored false; + property ActionList: TCustomActionList read GetCustomActionList write SetCustomActionList; + property HideIfUnsupportedInterface: Boolean read FHideIfUnsupportedInterface write SetHideIfUnsupportedInterface; + property ShortCutPressed: Boolean read FShortCutPressed write FShortCutPressed; + property Target: TComponent read FTarget write SetTarget; + property UnsupportedArchitectures: TArchitectures read FUnsupportedArchitectures write SetUnsupportedArchitectures + default []; + property UnsupportedPlatforms: TPlatforms read FUnsupportedPlatforms write SetUnsupportedPlatforms default []; + property Supported: Boolean read FSupported; + end; + +{ TCustomViewAction } + + TOnCreateComponent = procedure (Sender: TObject; var NewComponent: TComponent) of object; + TOnBeforeShow = procedure (Sender: TObject; var CanShow: Boolean) of object; + + TCustomViewAction = class(TCustomAction) + private + [Weak] FComponent: TComponent; + FOnCreateComponent: TonCreateComponent; + FOnAfterShow: TNotifyEvent; + FOnBeforeShow: TOnBeforeShow; + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure DoCreateComponent(var NewComponent: TComponent); virtual; + procedure DoBeforeShow(var CanShow: Boolean); virtual; + procedure DoAfterShow; virtual; + function ComponentText: string; virtual; + procedure ComponentChanged; virtual; + procedure SetComponent(const Value: TComponent); virtual; + property OnCreateComponent: TOnCreateComponent read FOnCreateComponent write FonCreateComponent; + property OnBeforeShow: TOnBeforeShow read FOnBeforeShow write FOnBeforeShow; + property OnAfterShow: TNotifyEvent read FOnAfterShow write FOnAfterShow; + public + function HandlesTarget(Target: TObject): Boolean; override; + property Component: TComponent read FComponent write SetComponent; + end; + + /// TAction is the base class for FireMonkey action objects. TAction + /// and descendant classes implement actions to be used with controls, menu + /// items, and tool buttons. The published properties and events of TAction + /// actions can be managed in the Object Inspector at design time. + TAction = class(TCustomAction) + public + constructor Create(AOwner: TComponent); override; + published + property AutoCheck; + property Text; + property Checked; + property Enabled; + property GroupIndex; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property ImageIndex; + property ShortCut default 0; + property SecondaryShortCuts; + property Visible; + property UnsupportedArchitectures; + property UnsupportedPlatforms; + property OnExecute; + property OnUpdate; + property OnHint; + end; + +function TextToShortCut(const AText: string): Integer; + +//== UNIT END: FMX.ActnList +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Presentation.Messages (from FMX.Presentation.Messages.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + +{ TMessageSender } + + /// ID of message + TMessageID = Word; + + /// Record type that represents a message with value for TMessageSender. + TDispatchMessageWithValue = record + MsgID: TMessageID; + Value: T; + public + constructor Create(const AMessageID: TMessageID; const AValue: T); + end; + + /// Class to allow sending message notifications to a TObject Receiver. + TMessageSender = class(TPersistent) + private + FReceiver: TObject; + FNeedFreeReceiver: Boolean; + FCanNotify: Integer; + procedure SetReceiver(const Value: TObject); + protected + /// Creates and returns the Receiver object of the message. By default returns nil. + function CreateReceiver: TObject; virtual; + /// Frees the Receiver, if receiver was created by CreateReceiver. + procedure FreeReceiver; virtual; + public + constructor Create; overload; virtual; + destructor Destroy; override; + /// Returns whether TMessageSender has a Receiver or not. + function HasReceiver: Boolean; + { Sending Messages } + /// Sends a message to an object. + procedure SendMessage(const AMessageID: TMessageID); overload; + /// Sends a message with value to an object. + procedure SendMessage(const AMessageID: TMessageID; const AValue: T); overload; + /// Sends a message with value to an object and allows to get result from Receiver. + procedure SendMessageWithResult(const AMessageID: TMessageID; var AValue: T); + { Notifications } + /// Disables TMessageSender from sending messages. + procedure DisableNotify; virtual; + /// Enables TMessageSender to send messages. Use CanNotify to check whether TMessageSender can send + /// messages. + /// The model reads quantity of calls of DisableNotify. So all calls of DisableNotify and + /// EnableNotifyshall be pairs. + procedure EnableNotify; virtual; + /// Returns whether TMessageSender can send messages. + function CanNotify: Boolean; virtual; + public + /// Returns the object that receives the message. + property Receiver: TObject read FReceiver write SetReceiver; + end; + + IMessageSendingCompatible = interface + ['{7777134E-CEC9-40F6-9AAA-CE4D6F55001A}'] + /// Return link to TMessageSender object + function GetMessageSender: TMessageSender; + /// Link to TMessageSender object that can be used to send messages + property MessageSender: TMessageSender read GetMessageSender; + end; + + /// Interface allows access to TMessageSender object + IMessageSender = interface(IMessageSendingCompatible) + ['{64DD751B-91F5-4767-994F-2787E21ABEF2}'] + end deprecated 'Use IMessageSendingCompatible'; + +//== UNIT END: FMX.Presentation.Messages +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Consts (from FMX.Consts.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + +const + StyleDescriptionName = 'Description'; // do not localize + SMainItemStyle = 'menubaritemstyle'; // do not localize + SSeparatorStyle = 'menuseparatorstyle'; // do not localize + + SMenuBarDisplayName = 'Menu Bar'; // do not localize + SMenuAppDisplayName = 'Menu Application'; // do not localize + + SBMPImageExtension = '.bmp'; // do not localize + SJPGImageExtension = '.jpg'; // do not localize + SJPEGImageExtension = '.jpeg'; // do not localize + SJP2ImageExtension = '.jp2'; + SPNGImageExtension = '.png'; // do not localize + SGIFImageExtension = '.gif'; // do not localize + STIFImageExtension = '.tif'; // do not localize + STIFFImageExtension = '.tiff'; // do not localize + SICOImageExtension = '.ico'; // do not localize + SHDPImageExtension = '.hdp'; // do not localize + SWMPImageExtension = '.wmp'; // do not localize + STGAImageExtension = '.tga'; // do not localize + SICNSImageExtension = '.icns'; // do not localize + + // Keys for TPlatformServices.GlobalFlags + GlobalDisableStylusGestures: string = 'GlobalDisableStylusGestures'; // do not localize + EnableGlassFPSWorkaround: string = 'EnableGlassFPSWorkaround'; // do not localize + + FormUseDefaultPosition: Integer = -1; // same as CW_USEDEFAULT = DWORD($80000000) + CommandQShortCut = 4177; + +resourcestring + + { Error Strings } + SInvalidPrinterOp = 'Operation not supported on selected printer'; + SInvalidPrinter = 'Selected printer is not valid'; + SPrinterIndexError = 'Printer index out of range'; + SDeviceOnPort = '%s on %s'; + SNoDefaultPrinter = 'There is no default printer currently selected'; + SNotPrinting = 'Printer is not currently printing'; + SPrinting = 'Printing in progress'; + SInvalidPrinterSettings = 'Invalid printing job settings'; + SInvalidPageFormat = 'Invalid page format settings'; + SCantStartPrintJob = 'Cannot start the printing job'; + SCantEndPrintJob = 'Cannot end the printing job'; + SCantPrintNewPage = 'Cannot add the page for printing'; + SCantSetNumCopies = 'Cannot change the number of document copies'; + StrCannotFocus = 'Cannot focus this control'; + SResultCanNotBeNil = 'The function ''%s'' must not return nil value'; + SKeyAcceleratorConflict = 'There was an accelerator key conflict'; + + SInvalidStyleForPlatform = 'The style you have chosen is not available for your currently selected target platform. You can select a custom style or remove the stylebook to allow FireMonkey to automatically load the native style at run time'; + SCannotLoadStyleFromStream = 'Cannot load style from stream'; + SCannotLoadStyleFromRes = 'Cannot load style from resource'; + SCannotLoadStyleFromFile = 'Cannot load style from file %s'; + SCannotChangeInLiveBinding = 'Cannot change this property when using LiveBindings'; + + SInvalidPrinterClass = 'Invalid printer class: %s'; + SPromptArrayTooShort = 'Length of value array must be >= length of prompt array'; + SPromptArrayEmpty = 'Prompt array must not be empty'; + SUnsupportedInputQuery = 'Unsupported InputQuery fields'; + SInvalidColorString = 'Invalid Color string'; + + SInvalidFmxHandle = 'Invalid FMX Handle: %s%.*x'; + SInvalidFmxHandleClass = 'Invalid handle. [%s] should be instance of [%s]'; + SDelayRelease = 'At the moment, you cannot change the window handle'; + SMediaGlobalError = 'Cannot create media control'; + SMediaFileNotSupported = 'Unsupported media file %s%'; + SMediaCannotUseAutofocus = 'Camera cannot work with autofocus. Error="%s"'; + SUnsupportedPlatformService = 'Unsupported platform service: %s'; + SServiceAlreadyRegistered = 'Service %s already registered'; + SUnsupportedOSVersion = 'Unsupported OS version: %s'; + SUnsupportedMultiInstance = 'An instance of "%s" already exists. Multiple instances are not supported'; + SNotInstance = 'Instance of "%s" not created'; + SFlasherNotRegistered = 'Class of flashing control is not registered'; + SUnsupportedInterface = 'Class %0:s does not support interface %1:s'; + SNullException = 'Handled null exception'; + SCannotGetDeviceIDForTestAds = 'Unable to obtain device ID. Use SetTestModeDeviceID.'; + SCannotCreateTimer = 'Cannot create timer: systemErrorCode=%d'; + + SErrorShortCut = 'An unknown combination of keys %s'; + SEUseHeirs = 'You can use only the inheritors of class "%s"'; + + SUnavailableMenuId = 'Cannot create menu ID. All IDs have already been assigned'; + + SInvalidGestureID = 'Invalid gesture ID (%d)'; + SInvalidStreamFormat = 'Invalid stream format'; + SDuplicateGestureName = 'Duplicate gesture name: %s'; + SDuplicateRecordedGestureName = 'A recorded gesture named %s already exists'; + SControlNotFound = 'Control not found'; + SRegisteredGestureNotFound = 'The following registered gestures were not found:' + sLinebreak + sLinebreak + '%s'; + SErrorLoadingFile = 'Error loading previously saved settings file: %s' + sLinebreak + 'Would you like to delete it?'; + STooManyRegisteredGestures = 'Too many registered gestures'; + SDuplicateRegisteredGestureName = 'A registered gesture named %s already exists'; + SUnableToSaveSettings = 'Unable to save settings'; + SInvalidGestureName = 'Invalid gesture name (%s)'; + SOutOfRange = 'Value must be between %d and %d'; + + SAddIStylusAsyncPluginError = 'Unable to add IStylusAsyncPlugin: %s'; + SAddIStylusSyncPluginError = 'Unable to add IStylusSyncPlugin: %s'; + SRemoveIStylusAsyncPluginError = 'Unable to remove IStylusAsyncPlugin: %s'; + SRemoveIStylusSyncPluginError = 'Unable to remove IStylusSyncPlugin: %s'; + SStylusHandleError = 'Unable to get or set window handle: %s'; + SStylusEnableError = 'Unable to enable or disable IRealTimeStylus: %s'; + SEnableRecognizerError = 'Unable to enable or disable IGestureRecognizer: %s'; + SInitialGesturePointError = 'Unable to retrieve initial gesture point'; + SSetStylusGestureError = 'Unable to set stylus gestures: %s'; + StrESingleMainMenu = 'The main menu can be only a single instance'; + SMainMenuSupportsOnlyTMenuItems = 'A main menu only supports TMenuItem children'; + + SNoImplementation = 'No %s implementation found'; + SNotImplementedOnPlatform = '%s not implemented on this platform'; + {$IFDEF ANDROID} + SInputQueryAndroidOverloads = 'On Android platform, only overloads with TInputCloseBoxProc or TInputCloseBoxEvent ' + + 'are supported'; + {$ENDIF} + + SBitmapSizeNotEqual = 'Bitmap size must be equal in copy operation'; + SBitmapCannotChangeCanvasQuality = 'Cannot change bitmap canvas quality, when canvas is already being used.'; + + SBlockingDialogs = 'Blocking dialogs'; + + SCannotCreateScrollContent = 'Cannot create %s, because |CreateScrollContent| must return not nil object'; + SContentCannotBeNil = 'Presentation received nil Content from TPresentedControl. Content cannot be nil.'; + + SPointInTextLayoutError = 'Point not in layout'; + SCaretLineIncorrect = 'TCaretPosition.Line has incorrect value'; + SCaretPosIncorrect = 'TCaretPosition.Pos has incorrect value'; + + SInvalidSceneUpdatingPairCall = 'Invalid IScene.DisableUpdating/IScene.EnableUpdating call pair'; + + SNoPlatformStyle = 'No platform styles found'; // happens when there are no platform styles at all + SInvalidPlatformStyle = 'No platform style found for the current platform'; // happens when there are platform styles, just not the right ones + SNoIDeviceBehaviorBehavior = 'Required IDeviceBehavior is not registered'; + SStyleResourceDoesNotExist = 'Style resource does not exist'; + + SDialogMustBeRunInUIThread = 'Messages must be shown in the main UI thread.'; + SObjectNonMainThreadUsage = '''%s'' is used on a not main thread'; + + { Dialog Strings } + SMsgDlgWarning = 'Warning'; + SMsgDlgError = 'Error'; + SMsgDlgInformation = 'Information'; + SMsgDlgConfirm = 'Confirm'; + SMsgDlgYes = 'Yes'; + SMsgDlgNo = 'No'; + SMsgDlgOK = 'OK'; + SMsgDlgCancel = 'Cancel'; + SMsgDlgHelp = 'Help'; + SMsgDlgHelpNone = 'No help available'; + SMsgDlgHelpHelp = 'Help'; + SMsgDlgAbort = 'Abort'; + SMsgDlgRetry = 'Retry'; + SMsgDlgIgnore = 'Ignore'; + SMsgDlgAll = 'All'; + SMsgDlgNoToAll = 'No to All'; + SMsgDlgYesToAll = 'Yes to &All'; + SMsgDlgClose = 'Close'; + + SWindowsVistaRequired = '%s requires Windows Vista or later'; + + SUsername = '&Username'; + SPassword = '&Password'; + SDomain = '&Domain'; + SLogin = 'Login'; + SHostRequiresAuthentication = '%s requires authentication'; + + {$IF DEFINED(MACOS) and not DEFINED(IOS)} + SAlertCreatedReleasedInconsistency = 'Platform AlertCreated/AlertReleased inconsistency'; + {$ENDIF} + + { Menus } + SMenuAppQuit = 'Quit %s'; + SMenuCloseWindow = 'Close Window'; + SMenuAppHide = 'Hide %s'; + SMenuAppHideOthers = 'Hide Others'; + SMenuServices = 'Services'; + SMenuShowAll = 'Show All'; + SMenuWindow = 'Window'; + SAppDesign = ''; + SAppDefault = 'application'; + SGotoTab = 'Go to %s'; + SGotoNilTab = 'Go to '; + SMediaPlayerStart = 'Play'; + SMediaPlayerPause = 'Pause'; + SMediaPlayerStop = 'Stop'; + SMediaPlayerVolume = '%3.0F %%'; + + SMsgGooglePlayServicesNeedUpdating = 'Google Play Services needs to be updated. Please go to Play Store to update ' + + ' Google Play Services then, restart the application'; +const + SChrHorizontalEllipsis = Chr($2026); +{$IFDEF MACOS} + SmkcBkSp = Chr($232B); // (NSBackspaceCharacter); + SmkcTab = Chr($21E5); // (NSTabCharacter); + SmkcEsc = Chr($238B); + SmkcEnter = Chr($21A9); // (NSCarriageReturnCharacter); + SmkcPgUp = Chr($21DE); // (NSPageUpFunctionKey); + SmkcPgDn = Chr($21DF); // (NSPageDownFunctionKey); + SmkcEnd = Chr($2198); // (NSEndFunctionKey); + SmkcDel = Chr($2326); // (NSDeleteCharacter); + SmkcHome = Chr($2196); // (NSHomeFunctionKey); + SmkcLeft = Chr($2190); // (NSLeftArrowFunctionKey); + SmkcUp = Chr($2191); // (NSUpArrowFunctionKey); + SmkcRight = Chr($2192); // (NSRightArrowFunctionKey); + SmkcDown = Chr($2193); // (NSDownArrowFunctionKey); + SmkcNumLock = Chr($2327); + SmkcPara = Chr($00A7); + SmkcShift = Chr($21E7); + SmkcCtrl = Chr($2303); + SmkcAlt = Chr($2325); + SmkcCmd = Chr($2318); + // Specific keys for OSX + SmkcBacktab= Chr($21E4); + SmkcIbLeft= Chr($21E0); + SmkcIbUp= Chr($21E1); + SmkcIbRight= Chr($21E2); + SmkcIbDown= Chr($21E3); + SmkcIbEnter= Chr($2305); + SmkcIbHelp= Chr($225F); +{$ELSE} + SmkcBkSp = 'BkSp'; + SmkcTab = 'Tab'; + SmkcEsc = 'Esc'; + SmkcEnter = 'Enter'; + SmkcPgUp = 'PgUp'; + SmkcPgDn = 'PgDn'; + SmkcEnd = 'End'; + SmkcDel = 'Del'; + SmkcHome = 'Home'; + SmkcLeft = 'Left'; + SmkcUp = 'Up'; + SmkcRight = 'Right'; + SmkcDown = 'Down'; + SmkcNumLock = 'Num Lock'; + SmkcPara = 'Paragraph'; + SmkcShift = 'Shift+'; + SmkcCtrl = 'Ctrl+'; + SmkcAlt = 'Alt+'; + SmkcCmd = 'Cmd+'; + + SmkcLWin = 'Left Win'; + SmkcRWin = 'Right Win'; + SmkcApps = 'Application'; + SmkcClear = 'Clear'; + SmkcScroll = 'Scroll Lock'; + SmkcCancel = 'Break'; + SmkcLShift = 'Left Shift'; + SmkcRShift = 'Right Shift'; + SmkcLControl = 'Left Ctrl'; + SmkcRControl = 'Right Ctrl'; + SmkcLMenu = 'Left Alt'; + SmkcRMenu = 'Right Alt'; + SmkcCapital = 'Caps Lock'; +{$ENDIF} + SmkcOem102 = 'Oem \'; + SmkcSpace = 'Space'; + SmkcNext = 'Next'; + SmkcBack = 'Back'; + SmkcIns = 'Ins'; + SmkcPause = 'Pause'; + SmkcCamera = 'Camera'; + SmkcBrowserBack= 'BrowserBack'; + SmkcHardwareBack= 'HardwareBack'; + SmkcNum = 'Num %s'; + +resourcestring + SEditUndo = 'Undo'; + SEditRedo = 'Redo'; + SEditCopy = 'Copy'; + SEditCut = 'Cut'; + SEditPaste = 'Paste'; + SEditDelete = 'Delete'; + SEditSelectAll = 'Select All'; + + SAseLexerTokenError = 'ERROR at line %d. %s expected but token %s found.'; + SAseLexerCharError = 'ERROR at line %d. ''%s'' expected but char ''%s'' found.'; + SAseLexerFileCorruption = 'File is corrupt.'; + + SAseParserWrongMaterialsNumError = 'Wrong materials number'; + SAseParserWrongVertexNumError = 'Wrong vertex number'; + SAseParserWrongNormalNumError = 'Wrong normal number'; + SAseParserWrongTexCoordNumError = 'Wrong texture coord number'; + SAseParserWrongVertexIdxError = 'Wrong vertex index'; + SAseParserWrongFacesNumError = 'Wrong faces number'; + SAseParserWrongFacesIdxError = 'Wrong faces index'; + SAseParserWrongTriangleMeshNumError = 'Wrong triangle mesh number'; + SAseParserWrongTriangleMeshIdxError = 'Wrong triangle mesh index'; + SAseParserWrongTexCoordIdxError = 'Wrong texture coord index'; + SAseParserUnexpectedKyWordError = 'Unexpected key word'; + + SIndexDataNotFoundError = 'Index data not found. File is corrupt.'; + SEffectIdNotFoundError = 'Effect id %s not found. File is corrupt.'; + SMeshIdNotFoundError = 'Mesh id %s not found. File is corrupt.'; + SControllerIdNotFoundError = 'Controller id %s not found. File is corrupt.'; + + SCannotCreateCircularDependence = 'Cannot create a circular dependency between components'; + SPropertyOutOfRange = '%s property out of range'; + + SPrinterDPIChangeError = 'Active printer DPI cannot be changed while printing'; + SPrinterSettingsReadError = 'Error occurred while reading printer settings: %s'; + SPrinterSettingsWriteError = 'Error occurred while writing printer settings: %s'; + + SVAllFiles = 'All Files'; + SVBitmaps = 'Bitmaps'; + SVIcons = 'Icons'; + SVTIFFImages = 'TIFF Images'; + SVJPGImages = 'JPEG Images'; + SVPNGImages = 'PNG Images'; + SVGIFImages = 'GIF Images'; + SVJP2Images = 'Jpeg 2000 Images'; + SVTGAImages = 'TGA Images'; + SWMPImages = 'WMP Images'; + + SVAviFiles = 'AVI Files'; + SVWMVFiles = 'WMV Files'; + SVMP4Files = 'Mpeg4 Files'; + SVMOVFiles = 'QuickTime Files'; + SVM4VFiles = 'M4V Files'; + SVMPGFiles = 'Mpeg Files'; + + SVWMAFiles = 'Windows Media Audio Files'; + SVMP3Files = 'Mpeg Layer 3 Files'; + SVWAVFiles = 'WAV Files'; + SVCAFFiles = 'Apple Core Audio Format Files'; + SV3GPFiles = '3GP Audio Files'; + SVM4AFiles = 'M4A Files'; + + SAllFilesExt = '.*'; + SDefault = 'All Files'; + + StrEChangeFixed = 'The "%s" cannot be modified (Fixed = True)'; + StrEDupScale = 'Duplicate scale value %s'; + StrOther = 'Other scale'; + StrScale1 = 'Normal'; + StrScale2 = 'Hi Res'; + + SCodecFileExtensionCannotEmpty = 'Cannot register bitmap codec. Codec file extension cannot be empty.'; + SCodecClassCannotBeNil = 'Cannot register bitmap codec. Codec class cannot be nil.'; + SCodecAlreadyExists = 'Cannot register bitmap codec. Codec for specified file extension "%s" has already existed.'; + + SAnimatedCodecAlreadyExists = 'Cannot register animated codec. An animated codec for the specified file extension "%s" already exists.'; + SAnimatedCodecFramesSizeNotEqual = 'Cannot add a frame to the animated codec. The size of the frames must be equal.'; + + SFilterAlreadyExists = 'Cannot register filter. A filter with the same name "%s" already exists.'; + + { Media } + + SNoFlashError = 'Flash does not exist on this device'; + SNoTorchError = 'Flash does not exist on this device'; + + { Pickers } + SPickerCancel = 'Cancel'; + SPickerDone = 'Done'; + SEditorDone = 'Done'; + SListPickerIsNotFound = 'This version of Android does not have an implementation of list pickers'; + SDateTimePickerIsNotFound = 'This version of Android does not have an implementation of Date/Time pickers'; + + { Notification Center } + SNotificationCancel = 'Cancel'; + SNotificationCenterTitleIsNotSupported = 'NotificationCenter: Title is not supported in iOS'; + SNotificationCenterActionIsNotSupported = 'NotificationCenter: Action is not supported in Android'; + + { Media Library } + STakePhotoFromCamera = 'Take Photo'; + STakePhotoFromLibarary = 'Photo Library'; + SOpenStandartServices = 'Open to'; + SSavedPhotoAlbum = 'Saved Photos'; + SImageSaved = 'Image saved'; + SCannotConvertBitmapToNative = 'Cannot convert FMX bitmap to its native counterpart'; + + { Canvas helpers / 2D and 3D engine / GPU } + SBitmapIncorrectSize = 'Incorrect size of bitmap parameter(s).'; + SBitmapLoadingFailed = 'Loading bitmap failed.'; + SBitmapLoadingFailedNamed = 'Loading bitmap failed (%s).'; + SBitmapSizeTooBig = 'Bitmap size too big.'; + SInvalidCanvasParameter = 'Invalid call of GetParameter.'; + SThumbnailLoadingFailed = 'Loading thumbnail failed.'; + SThumbnailLoadingFailedNamed = 'Loading thumbnail failed (%s).'; + SBitmapSavingFailed = 'Saving bitmap failed.'; + SBitmapSavingFailedNamed = 'Saving bitmap failed (%s).'; + SBitmapFormatUnsupported = 'The specified bitmap format is not supported.'; + SRetrieveSurfaceDescription = 'Could not retrieve surface description.'; + SRetrieveSurfaceContents = 'Could not retrieve surface contents.'; + SAcquireBitmapAccess = 'Failed acquiring access to bitmap.'; + SVideoCaptureFault = 'Failure during video feed capture.'; + SNoCaptureDeviceManager = 'No CaptureDeviceManager implementation found'; + SAudioCaptureUnauthorized = 'Unauthorized to record audio'; + SVideoCaptureUnauthorized = 'Unauthorized to record video'; + SInvalidCallingConditions = 'Invalid calling conditions for ''%s''.'; + SInvalidRenderingConditions = 'Invalid rendering conditions for ''%s''.'; + STextureSizeTooSmall = 'Cannot create texture for ''%s'' because the size is too small.'; + SCannotAcquireBitmapAccess = 'Cannot acquire bitmap access for ''%s''.'; + SCannotFindSuitablePixelFormat = 'Cannot find a suitable pixel format for ''%s''.'; + SCannotFindSuitableShader = 'Cannot find a suitable shader for ''%s''.'; + SCannotDetermineDirect3DLevel = 'Cannot determine Direct3D support level.'; + SCannotCreateDirect3D = 'Cannot create Direct3D object for ''%s''.'; + SCannotCreateD2DFactory = 'Cannot create Direct2D Factory object for ''%s''.'; + SCannotCreateDWriteFactory = 'Cannot create DirectWrite Factory object for ''%s''.'; + SCannotCreateWICImagingFactory = 'Cannot create WIC Imaging Factory object for ''%s''.'; + SCannotCreateRenderTarget = 'Cannot create rendering target for ''%s''.'; + SCannotCreateD3DDevice = 'Cannot create Direct3D device for ''%s''.'; + SCannotAcquireDXGIFactory = 'Cannot acquire DXGI factory from Direct3D device for ''%s''.'; + SCannotResizeBuffers = 'Cannot resize buffers for ''%s''.'; + SCannotAssociateWindowHandle = 'Cannot associate the window handle for ''%s''.'; + SCannotRetrieveDisplayMode = 'Cannot retrieve display mode for ''%s''.'; + SCannotRetrieveBufferDesc = 'Cannot retrieve buffer description for ''%s''.'; + SCannotCreateSamplerState = 'Cannot create sampler state for ''%s''.'; + SCannotRetrieveSurface = 'Cannot retrieve surface for ''%s''.'; + SCannotCreateTexture = 'Cannot create texture for ''%s''.'; + SCannotUploadTexture = 'Cannot upload pixel data to texture for ''%s''.'; + SCannotActivateTexture = 'Cannot activate the texture for ''%s''.'; + SCannotAcquireTextureAccess = 'Cannot acquire texture access for ''%s''.'; + SCannotCopyTextureResource = 'Cannot copy texture resource ''%s''.'; + SCannotCreateRenderTargetView = 'Cannot create render target view for ''%s''.'; + SCannotActivateFrameBuffers = 'Cannot activate frame buffers for ''%s''.'; + SCannotCreateRenderBuffers = 'Cannot create render buffers for ''%s''.'; + SCannotRetrieveRenderBuffers = 'Cannot retrieve device render buffers for ''%s''.'; + SCannotActivateRenderBuffers = 'Cannot activate render buffers for ''%s''.'; + SCannotBeginRenderingScene = 'Cannot begin rendering scene for ''%s''.'; + SCannotSyncDeviceBuffers = 'Cannot synchronize device buffers for ''%s''.'; + SCannotUploadDeviceBuffers = 'Cannot upload device buffers for ''%s''.'; + SCannotCreateDepthStencil = 'Cannot create a depth/stencil buffer for ''%s''.'; + SCannotRetrieveDepthStencil = 'Cannot retrieve device depth/stencil buffer for ''%s''.'; + SCannotActivateDepthStencil = 'Cannot activate depth/stencil buffer for ''%s''.'; + SCannotCreateSwapChain = 'Cannot create a swap chain for ''%s''.'; + SCannotResizeSwapChain = 'Cannot resize swap chain for ''%s''.'; + SCannotActivateSwapChain = 'Cannot activate swap chain for ''%s''.'; + SCannotCreateVertexShader = 'Cannot create vertex shader for ''%s''.'; + SCannotCreatePixelShader = 'Cannot create pixel shader for ''%s''.'; + SCannotCreateVertexLayout = 'Cannot create vertex layout for ''%s''.'; + SCannotCreateVertexDeclaration = 'Cannot create vertex declaration for ''%s''.'; + SCannotCreateVertexBuffer = 'Cannot create vertex buffer for ''%s''.'; + SCannotCreateIndexBuffer = 'Cannot create index buffer for ''%s''.'; + SCannotCreateShader = 'Cannot create shader for ''%s''.'; + SCannotFindShaderVariable = 'Cannot find shader variable ''%s''.'; + SCannotActivateShaderProgram = 'Cannot activate shader program for ''%s''.'; + SCannotCreateMetalContext = 'Cannot create Metal context for ''%s''.'; + SCannotCreateOpenGLContext = 'Cannot create OpenGL context for ''%s''.'; + SCannotCreateOpenGLContextWithCode = 'Cannot create OpenGL context for ''%s''. Error code: %d.'; + SCannotCreatePBufferSurfaceWithCode = 'Cannot create EGL PBuffer Surface. Error code: %d.'; + SCannotUpdateOpenGLContext = 'Cannot update OpenGL context for ''%s''.'; + SOpenGLErrorFlag = '[OpenGL] Checking the value of the OpenGL error stack returned an error : code=(%d, "%s")'; + SOpenGLCannotCreateDummyContext = '[OpenGL] cannot create dummy context for loading extensions list.'; + SCannotDrawMeshObject = 'Cannot draw mesh object for ''%s''.'; + SErrorInContextMethod = 'Error in context: method=''%s''.'; + SFeatureNotSupported = 'This feature is not supported in ''%s''.'; + SErrorCompressingStream = 'Error compressing stream.'; + SErrorDecompressingStream = 'Error decompressing stream.'; + SErrorUnpackingShaderCode = 'Error unpacking shader code.'; + SCannotPaintOnCanvasWithoutBeginScene = 'It is not possible to perform rendering. BeginScene was not invoked.'; + SCannotRunDirectShowFilterGraph = 'One or more DirectShow filters failed to run'; + SCannotCreateDirectShowCaptureFilter = 'Cannot create the DirectShow capture filter'; + + SCannotAddFixedSize = 'Cannot add columns or rows when ExpandStyle is TExpandStyle.FixedSize'; + SInvalidSpan = '''%d'' is not a valid span'; + SInvalidRowIndex = 'Row index, %d, out of bounds'; + SInvalidColumnIndex = 'Column index, %d, out of bounds'; + SInvalidControlItem = 'ControlItem.Control cannot be set to owning GridPanel'; + SCannotDeleteColumn = 'Cannot delete a column that contains controls'; + SCannotDeleteDefColumn = 'You cannot delete a column by default'; + SCannotDeleteRow = 'Cannot delete a row that contains controls'; + SCellMember = 'Member'; + SCellSizeType = 'Size Type'; + SCellValue = 'Value'; + SCellAutoSize = 'Auto'; + SCellPercentSize = 'Percent'; + SCellAbsoluteSize = 'Absolute'; + SCellWeightSize = 'Weight'; + SCellColumn = 'Column%d'; + SCellRow = 'Row%d'; + + SDateTimeMax = 'Date exceeds maximum of "%s"'; + SDateTimeMin = 'Date is less than minimum of "%s"'; + + SDateTimePickerShowModeNotSupported = 'DateTime picker does not support DateTime on current platform'; + + SMediaLibraryOpenImageWith = 'Send image using:'; + SMediaLibraryOpenTextWith = 'Send text using:'; + SMediaLibraryOpenFilesWith = 'Send files using:'; + SMediaLibraryOpenTextAndImageWith = 'Send text/image using:'; + SMediaLibraryOpenTextAndFilesWith = 'Send text/files using:'; + + SNativePresentation = 'Native %s'; + + { In-App Purchase } + SIAPNotSetup = 'In-App Purchase component is not set up'; + SIAPNoLicenseKey = 'In-App Purchase component has no license key'; + SIAPPayloadVerificationFailed = 'Transaction payload verification failed'; + SIAPAlreadyPurchased = 'Item has already been purchased'; + SIAPNotAlreadyPurchased = 'Cannot consume an item you have not purchased'; + SIAPSetupProblem = 'Problem setting up in-app billing'; + SIAPIllegalArguments = 'Argument problem in IAP API'; + SITunesConnectionError = 'Cannot connect to iTunes Store'; + SProductsRequestInProgress = 'Products request already in progress'; + SIAPProductNotInInventory = 'Product ID %s is not valid'; + + { Advertising } + SAdFailedToLoadError = 'Ad failed to load: %d'; + + { TMultiView } + SCannotCreatePresentation = 'You cannot create Presentation without MultiView'; + SDrawer = 'Drawer'; + SOverlapDrawer = 'Overlap Drawer'; + SDockedPanel = 'Docked Panel'; + SPopover = 'Popover'; + SNavigationPane = 'Navigation Pane'; + SObjectCannotBeChild = '"%0:s" of "%1:s" cannot be a child control of "%1:s" or the "%1:s" itself'; + + { Presentations } + SWrongModelClassType = 'Model is not valid class. Expected [%s], but received [%s]'; + SWrongParameter = '[%] parameter cannot be nil'; + SControlWithoutPresentation = '[%s] without Presentation'; + SControlClassIsNil = 'AControlClass cannot be nil. Factory cannot generate presentation name.'; + SPresentationProxyCreateError = 'Cannot create presentation proxy with nil model or PresentedControl. ' + + 'Use overloaded version of constructor with parameters and pass correct values.'; + SPresentationProxyClassNotFound = 'Presentation Proxy class for presentation name [%s] is not found'; + SPresentationProxyClassIsNil = 'APresentationProxyClass is nil. Factory cannot register presentation with a nil presentation proxy class.'; + SPresentationProxyNameIsEmpty = 'APresentationName is empty. Factory cannot register presentation with an empty presentation name'; + SPresentationAlreadyRegistered = 'Presentation Proxy class [%s] for this presentation name [%s] has already been registered.'; + SPresentationTitleInDesignTime = '%s (%s)'; + SProxyIsNotRegisteredWarning = 'A descendant of TStyledPresentationProxy has not been registered for class %s.' + sLineBreak + + 'Maybe it is necessary to add the %s module to the uses section'; + { TScrollBox } + SScrollBoxOwnerWrong = '|AOwner| should be an instance of TCustomPresentedScrollBox'; + SScrollBoxAniCalculations = 'Could not create styled presentation because CreateAniCalculations returned nil.'; + + { Data Model } + SDataModelKeyEmpty = 'Key cannot be empty. Data model cannot set or get data by key with an empty name.'; + + { Analytics } + SInvalidActivityTrackingAppID = 'Invalid Application ID'; + SAppAnalyticsDefaultPrivacyMessage = 'Privacy Notice:' + sLineBreak + sLineBreak + + 'This application anonymously tracks your usage and sends it to us for analysis. We use this analysis to make ' + + 'the software work better for you.' + sLineBreak + sLineBreak + + 'This tracking is completely anonymous. No personally identifiable information is tracked, and nothing about ' + + 'your usage can be tracked back to you.' + sLineBreak + sLineBreak + + 'Please click Yes to help us to improve this software. Thank you.'; + SCustomAnalyticsCategoryMissing = 'AppAnalytics custom event error: category cannot be empty.'; + + { Clipboard } + SFormatAlreadyRegistered = 'Custom clipboard format with name "%s" is already registered'; + SFormatWasNotRegistered = 'Custom clipboard format with name "%s" is not registered'; + SDoesnotSupportCustomData = '%s does not support custom data'; + + { Helpers } + + SCannotConvertDelphiArrayToJStringArray = 'Cannot convert Delphi Source array to Java JString array. [%d] is unsupported type'; + + { Address Book } + + // Permission + SCannotPerformOperation = 'Cannot perform operation. You have to request permission by using AddressBook.RequestPermission'; + SCannotPerformOperationRejectedAccess = 'Cannot perform operation. User rejected access to AddressBook'; + SRequiredPermissionsAreAbsent = 'Required permission(s) [%s] have not been granted.'; + SPermissionCannotChangeDataInAddressBook = 'Writing permission [WRITE_CONTACTS] has not been granted. You will not be able to make changes with AddressBook'; + SPermissionCannotGetDataFromAddressBook = 'Reading permission [READ_CONTACTS] has not been granted. You will not be able to get data from AddressBook'; + SPermissionCannotGetAccounts = 'Cannot read sources, because your application doesn''t have [GET_ACCOUNTS] permission'; + SUserRejectedAddressBookPermission = 'User rejected permission'; + SUserRejectedCaptureDevicePermission = 'User rejected permission'; + SPermissionsRequestHasBeenCancelled = 'Permissions request has been cancelled'; + // Common + SCannotSaveAddressBookChanges = 'Cannot save changes in AddressBook. %s'; + SFieldTypeIsNotSupportedOnCurrentPlatform = 'Specified type of field [%s] is not supported on current platform'; + SCannotSaveFieldValue = 'Cannot save [%s]. %s'; + SCannotGetDisplayName = 'Cannot get display name. %s'; + SCannotExtractContactID = 'Cannot extract ID of new contact'; + SCannotCheckExistingDataRecord = 'Cannot check existing data record. %s'; + SCannotExtractAddresses = 'Cannot extract Addresses. %s'; + SCannotExtractMessagingServices = 'Cannot fetch messaging service info. %s'; + SCannotExtractDates = 'Cannot fetch dates. %s'; + SCannotExtractMultipleStringValue = 'Cannot extract multiple string values. %s'; + SCannotExtractStringValue = 'Cannot extract string value. %s'; + SSocialProfilesAreNotSupported = 'Social Profiles are not supported on this platform.'; + SCannotConvertTBitmapToJBitmap = 'Cannot save Contact Photo. TBitmap cannot be converted into JBitmap.'; + SCannotBeginNewProcessing = 'Cannot begin new processing until previous has not finished'; + // Sources + SCannotFetchAllSourcesNilArg = 'Cannot fetch sources. [%s] cannot be nil.'; + SCannotCreateSource = 'Cannot create contact, use AddressBook.Sources for getting all available sources on your device.'; + SCannotCreateSourceNilArg = 'Cannot create instance of source. [%s] cannot be nil.'; + SCannotGetSourceNameSourceRefRefNil = 'Cannot get source name. [SourceRef] is nil'; + SCannotGetSourceTypeSourceRefRefNil = 'Cannot get source type. [SourceRef] is nil'; + // Contacts + SCannotFetchContacts = 'Cannot fetch contacts. %s'; + SCannotFetchAllContactsWrongClassArg = 'Cannot fetch contacts. [%s] should be instance of [%s] class.'; + SCannotFetchAllContactNilArg = 'Cannot fetch contacts. [%s] cannot be nil.'; + SCannotFetchAllGroupsFromContact = 'Cannot fetch groups of contact. %s'; + SCannotCreateContact = 'Cannot create contact.'; + SCannotCreateContactNilArg = 'Cannot create instance of contact. [%s] cannot be nil.'; + SCannotCreateContactWrongClassArg = 'Cannot create instance of contact. [%s] should be instance of [%s] class.'; + SCannotCreateContactUseFactoryMethod = 'Cannot create contact, use AddressBook.CreateContact instead.'; + SCannotSaveContact = 'Cannot save contact. %s'; + SCannotSaveContactNilArg = 'Cannot save contact. [%s] cannot be nil.'; + SCannotSaveContactWrongClassArg = 'Cannot save contact. [%s] should be instance of [%s] class.'; + SCannotSaveNotModifiedContact = 'Cannot save contact, when contact is not modified'; + SCannotRemoveContact = 'Cannot remove contact. %s'; + SCannotRemoveContactNilArg = 'Cannot remove contact. [%s] cannot be nil.'; + SCannotRemoveContactWrongClassArg = 'Cannot remove contact. [%s] should be instance of [%s] class.'; + // Groups + SCannotFetchGroups = 'Cannot fetch groups. %s'; + SCannotFetchAllGroupsWrongClassArg = 'Cannot fetch groups. [%s] should be instance of [%s] class.'; + SCannotFetchAllGroupsNilArg = 'Cannot fetch groups. [%s] cannot be nil.'; + SCannotCreateGroup = 'Cannot create instance of group.'; + SCannotCreateGroupNilArg = 'Cannot create instance of group. [%s] cannot be nil'; + SCannotCreateGroupWrongClassArg = 'Cannot create instance of group. [%s] should be instance of [%s] class.'; + SCannotCreateGroupUseFactoryMethod = 'Cannot create group, use AddressBook.CreateGroup instead.'; + SCannotSaveGroup = 'Cannot save group. %s'; + SCannotSaveGroupNilArg = 'Cannot save group. [%s] cannot be nil.'; + SCannotSaveGroupWrongClassArg = 'Cannot save group. [%s] should be instance of [%s] class.'; + SCannotRemoveGroup = 'Cannot remove group. %s'; + SCannotRemoveGroupNilArg = 'Cannot remove group. [%s] cannot be nil.'; + SCannotRemoveGroupWrongClassArg = 'Cannot remove group. [%s] should be instance of [%s] class.'; + SCannotGetGroupNameGroupRefNil = 'Cannot get group name. GroupRef is nil'; + SCannotSetGroupName = 'Cannot set group name. %s'; + SCannotSetGroupNameGroupRefNil = 'Cannot set group name. GroupRef is nil'; + // Contacts in Group + SCannotAddContactIntoGroup = 'Cannot add contact to group. %s'; + SCannotAddContactIntoGroupNilArg = 'Cannot add contact to group. [%s] cannot be nil.'; + SCannotAddContactIntoGroupWrongClassArg = 'Cannot add contact to group. [%s] should be instance of [%s] class.'; + SCannotAddContactIntoGroupContactIsNotInAddressBook = 'Cannot add contact to group. Contact is not yet in an AddressBook.'; + SCannotAddContactIntoGroupGroupIsNotInAddressBook = 'Cannot add contact to group. Group is not yet in an AddressBook.'; + SCannotRemoveContactFromGroup = 'Cannot remove contact from group. %s'; + SCannotRemoveContactFromGroupNilArg = 'Cannot remove contact from group. [%s] cannot be nil.'; + SCannotRemoveContactFromGroupWrongClassArg = 'Cannot remove contact from group. [%s] should be instance of [%s] class.'; + SCannotFetchContactInGroup = 'Cannot fetch contacts in group with ID = [%d]. %s'; + SCannotFetchContactsInGroupNilArg = 'Cannot retrieve list of contacts. [%s] cannot be nil.'; + + { Address fields kinds } + + SFirstName = 'First Name'; + SLastName = 'Last Name'; + SMiddleName = 'Middle Name'; + SPrefix = 'Prefix'; + SSuffix = 'Suffix'; + SNickName = 'NickName'; + SFirstNamePhonetic = 'First Name Phonetic'; + SLastNamePhonetic = 'Last Name Phonetic'; + SMiddleNamePhonetic = 'Middle Name Phonetic'; + SOrganization = 'Organization'; + SJobTitle = 'Job Title'; + SDepartment = 'Department'; + SPhoto = 'Photo'; + SPhotoThumbnail = 'Photo Thumbnail'; + SNote = 'Note'; + SURLs = 'URLs'; + SEMails = 'Emails'; + SAddresses = 'Addresses'; + SPhones = 'Phones'; + SDates = 'Dates'; + SRelatedNames = 'Related Names'; + SMessagingServices = 'Messaging Services'; + SBirthday = 'Birthday'; + SCreationDate = 'Creation Date'; + SModificationDate = 'Modification Date'; + SSocialProfiles = 'Social Profiles'; + SUnknowType = 'Unknown type value'; + + { Sources } + + SSourceLocal = 'Local source'; + SSourceExchange = 'Exchange '; + SSourceExchangeGAL = 'Exchange Global Address List'; + SSourceMobileMe = 'MobileMe'; + SSourceLDAP = 'LDAP'; + SSourceCardDAV = 'CardDAV'; + SSourceCardDAVSearch = 'Searchable CardDAV'; + + { Label types } + + SAddressBookHomeLabel = 'Home'; + SAddressBookWorkLabel = 'Work'; + SAddressBookOtherLabel = 'Other'; + + { Phones types } + + SPhoneMain = 'Main'; + SPhoneHome = 'Home'; + SPhoneMobile = 'Mobile'; + SPhoneWork = 'Work'; + SPhoneFaxWork = 'Work fax'; + SPhoneFaxHome = 'Home fax'; + SPhoneFaxOther = 'Other fax'; + SPhonePager = 'Pager'; + SPhoneOther = 'Other'; + SPhoneCallback = 'Callback'; + SPhoneCar = 'Car'; + SPhoneCompanyMain = 'Company main'; + SPhoneISDN = 'ISDN'; + SPhoneRadio = 'Radio'; + SPhoneTelex = 'Telex'; + SPhoneTTYTDD = 'TTY TDD'; + SPhoneWorkMobile = 'Work mobile'; + SPhoneWorkPager = 'Work pager'; + SPhoneAssistant = 'Assistant'; + SPhoneIPhone = 'iPhone'; + + { Dates types } + + SDateAnniversary = 'Anniversary'; + SDateBirthday = 'Birthday'; + SDateOther = 'Other'; + + { EMails types } + + SEmailsMobile = 'Mobile'; + + { Urls } + + SURLHomePage = 'Homepage'; + SURLBlog = 'Blog'; + SURLProfile = 'Profile'; + SURLFTP = 'FTP'; + + { Related names } + + SRelationAssistant = 'Assistant'; + SRelationBrother = 'Brother'; + SRelationChild = 'Child'; + SRelationDomesticPartner = 'Domestic Partner'; + SRelationFather = 'Father'; + SRelationFriend = 'Friend'; + SRelationManager = 'Manager'; + SRelationMother = 'Mother'; + SRelationParent = 'Parent'; + SRelationPartner = 'Partner'; + SRelationReferredBy = 'RefferedBy'; + SRelationRelative = 'Relative'; + SRelationSister = 'Sister'; + SRelationSpouse = 'Spouse'; + + { IM Protocol names } + + SProtocolAIM = 'AIM'; + SProtocolMSN = 'MSN'; + SProtocolYahoo = 'Yahoo'; + SProtocolSkype = 'Skype'; + SProtocolQQ = 'QQ'; + SProtocolGoogleTalk = 'Google Talk'; + SProtocolICQ = 'ICQ'; + SProtocolJabber = 'Jabber'; + SProtocolNetMeeting = 'Net meeting'; + SProtocolFacebook = 'Facebook'; + SProtocolGaduGadu = 'Gadu Gadu'; + + { Social profile } + + SSocialProfileTwitter = 'Twitter'; + SSocialProfileGameCenter = 'Game Center'; + SSocialProfileSinaWeibo = 'Sina Weibo'; + SSocialProfileFacebook = 'Facebook'; + SSocialProfileMySpace = 'MySpace'; + SSocialProfileLinkedIn = 'LinkedIn'; + SSocialProfileFlickr = 'Flickr'; + + { TListView } + SUseItemsPropertyToSetAdapter = 'Use Items property to set TAppearanceListView adapter'; + + { Control/Object Helpers } + SCannotFindParentBySpecifiedCriteria = 'Cannot find parent by specified criteria'; + + { Firebase } + SFireBaseInstanceIdIsNotAvailable = 'FirebaseInstanceId service is not available'; + + { WebBrowser } + SEdgeBrowserEngineUnavailable = 'Edge browser engine is unavailable'; + SEdgeBrowserEngineCreateFailed = 'Failed to create instance of Edge browser engine'; + + { TFontManager } + SCannotFindFontResource = 'Font resource wasn''t found: ResourceName="%s"'; + SCannotFindFontFile = 'Font file wasn''t found: FileName="%s"'; + + { Biometric Auth } + SBiometricNotImplemented = 'Biometric support is not implemented for this platform'; + SBiometricPromptCancelTextDefault = 'Cancel'; + SBiometricPromptTitleTextDefault = 'Authenticate'; + SBiometricErrorKeyNameEmpty = 'Keyname cannot be empty'; + SBiometricErrorCannotAuthenticate = 'Unable to perform authentication'; + SBiometricErrorSystemError = 'A system error occurred: %s'; + SBiometricErrorNotAvailable = 'Biometrics not available'; + SBiometricEnterPINToRestore = 'Enter PIN to restore biometry'; + SBiometricErrorAuthenticationDenied = 'Authentication denied'; + SBiometricErrorTooManyAttempts = 'Too many attempts to authenticate'; + SBiometricErrorSystemErrorInvalidContext = 'Invalid context'; + SBiometricErrorSystemErrorCancelledBySystem = 'Cancelled by system'; + +//== UNIT END: FMX.Consts +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Types (from FMX.Types.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +const +{$HPPEMIT '#define FireMonkeyVersion 290'} + FireMonkeyVersion = 290; +{$EXTERNALSYM FireMonkeyVersion} + +{ Global Settings } + +var + GlobalUseHWEffects: Boolean = True deprecated; + // On low-end hardware or mobile bitmap effects are slowly + GlobalDisableFocusEffect: Boolean = False; + // Allow using Direct3D for UI and 3D rendering + GlobalUseDX: Boolean = True; + // Force using legacy DX9 feature level in Direct3D + GlobalUseDXInDX9Mode: Boolean = False; + // Give higher priority to Direct3D WARP device instead of hardware layer + GlobalUseDXSoftware: Boolean = False; + // Allow using Direct2D for UI rendering + GlobalUseDirect2D: Boolean = True; + // Use ClearType rendering in GDI+ renderer + GlobalUseGDIPlusClearType: Boolean = True; + /// The number of decimal digits for the rounding floating point + /// values. + DigitRoundSize: TRoundToRange = -3; + // Use GPU Canvas + GlobalUseGPUCanvas: Boolean = False; + /// Allow using Metal for UI rendering + GlobalUseMetal: Boolean = False; + /// If this value is YES, draw loop is paused and updates are event-driven (Metal only) + GlobalEventDrivenDisplayUpdates: Boolean = True; + /// The rate at which the draw loop update its contents (Metal only) + GlobalPreferredFramesPerSecond: Integer = 60; + /// Allow using Vulkan for UI rendering + GlobalUseVulkan: Boolean = {$IFDEF ANDROID}True{$ELSE}False{$ENDIF}; + + GlobalUseDX10: Boolean = True deprecated 'Use GlobalUseDX.'; + GlobalUseDX10Software: Boolean = True deprecated 'Use GlobalUseDXSoftware.'; + +type + TVKAutoShowMode = (DefinedBySystem, Never, Always); + +var + VKAutoShowMode: TVKAutoShowMode = TVKAutoShowMode.DefinedBySystem; + +type + TOSPlatform = (Windows, OSX, iOS, Android, Linux); + + TPointArray = array [0..0] of TPointF; + + TLongByteArray = array [0..MaxInt - 1] of Byte; + PLongByteArray = ^TLongByteArray; + + + TCorner = (TopLeft, TopRight, BottomLeft, BottomRight); + + TCorners = set of TCorner; + + TCornerType = (Round, Bevel, InnerRound, InnerLine); + + { Four courners describing arbitrary 2D rectangle } + PCornersF = ^TCornersF; + TCornersF = array [0 .. 3] of TPointF; + + TSide = (Top, Left, Bottom, Right); + + TSides = set of TSide; + + TTextAlign = (Center, Leading, Trailing); + + TTextAlignHelper = record helper for TTextAlign + public + /// This method converts TTextAlign value to THorzRectAlign + function AsHorzRectAlign: THorzRectAlign; inline; + /// This method converts TTextAlign value to TVertRectAlign + function AsVertRectAlign: TVertRectAlign; inline; + end; + + TVertRectAlignHelper = record helper for TVertRectAlign + public + /// This method converts TVertRectAlign value to TTextAlign + function AsTextAlign: TTextAlign; inline; + end; + + THorzRectAlignHelper = record helper for THorzRectAlign + public + /// This method converts THorzRectAlign value to TTextAlign + function AsTextAlign: TTextAlign; inline; + end; + + TTextTrimming = (None, Character, Word); + /// A type that text controls use to specify whether to consider the + /// ampersand (&) as a special character + TPrefixStyle = (HidePrefix, NoPrefix); + + TStyledSetting = (Family, Size, Style, FontColor, Other); + + TStyledSettings = set of TStyledSetting; + + TMenuItemChange = (Enabled, Visible, Text, Shortcut, Checked, Bitmap); + TMenuItemChanges = set of TMenuItemChange; + + TScreenOrientation = (Portrait, Landscape, InvertedPortrait, InvertedLandscape); + TScreenOrientations = set of TScreenOrientation; + + TPixelFormat = (None, RGB, RGBA, BGR, BGRA, RGBA16, BGR_565, BGRA4, BGR4, BGR5_A1, BGR5, BGR10_A2, RGB10_A2, L, LA, + LA4, L16, A, R16F, RG16F, RGBA16F, R32F, RG32F, RGBA32F); + + TPixelFormatList = TList; + +const + PixelFormatBytes: array[TPixelFormat] of Integer = ({ None } 0, { RGB } 4, { RGBA } 4, { BGR } 4, { BGRA } 4, + { RGBA16 } 8, { BGR_565 } 2, { BGRA4 } 2, { BGR4 } 2, { BGR5_A1 } 2, { BGR5 } 2, { BGR10_A2 } 4, { RGB10_A2 } 4, + { L } 1, { LA } 2, { LA4 } 1, { L16 } 2, { A } 1, { R16F } 2, { RG16F } 4, { RGBA16F } 8, { R32F } 4, { RG32F } 8, + { RGBA32F } 16); + + NullRect: TRectF = (Left: 0; Top: 0; Right: 0; Bottom: 0); + + AllCorners: TCorners = [TCorner.TopLeft, TCorner.TopRight, + TCorner.BottomLeft, TCorner.BottomRight]; + + AllSides: TSides = [TSide.Top, TSide.Left, TSide.Bottom, TSide.Right]; + + ClosePolygon: TPointF = (X: $FFFF; Y: $FFFF) deprecated 'Non-closed polygons are not supported.'; + + /// A special polygon point marker typically used for converting paths to polygons and vice-versa, + /// usually indicating path closure. For the rendering methods, this marker has no meaning and the actual + /// interpretation may be platform-dependent. + PolygonPointBreak: TPointF = (X: $FFFFFF; Y: $FFFFFF); + + AllStyledSettings: TStyledSettings = [TStyledSetting.Family, + TStyledSetting.Size, + TStyledSetting.Style, + TStyledSetting.FontColor, + TStyledSetting.Other]; + DefaultStyledSettings: TStyledSettings = [TStyledSetting.Family, + TStyledSetting.Size, + TStyledSetting.Style, + TStyledSetting.FontColor]; + + InvalidSize : TSizeF = (cx: -1; cy: -1); + + AlignmentToTTextAlign: array [TAlignment] of TTextAlign = + (TTextAlign.Leading, TTextAlign.Trailing, TTextAlign.Center); + +type + TGestureID = rgiFirst .. igiLast; + + TInteractiveGestureFlag = (gfBegin, gfInertia, gfEnd); + TInteractiveGestureFlags = set of TInteractiveGestureFlag; + + TGestureEventInfo = record + GestureID: TGestureID; + Location: TPointF; + Flags: TInteractiveGestureFlags; + Angle: Double; + InertiaVector: TPointF; + Distance: Integer; + TapLocation: TPointF; + end; + + TGestureEvent = procedure(Sender: TObject; const EventInfo: TGestureEventInfo; + var Handled: Boolean) of object; + + TTouchAction = (None, Up, Down, Move, Cancel); + TTouchActions = set of TTouchAction; + + TTouch = record + Id: NativeInt; + Location: TPointF; + Action: TTouchAction; + end; + TTouches = array of TTouch; + +type + TFormStyle = (Normal, Popup, StayOnTop); + TAlignLayout = (None, Top, Left, Right, Bottom, MostTop, MostBottom, MostLeft, MostRight, Client, Contents, Center, VertCenter, HorzCenter, Horizontal, Vertical, Scale, Fit, FitLeft, FitRight); + + TImeMode = (imDontCare, // All IMEs + imDisable, // All IMEs + imClose, // Chinese and Japanese only + imOpen, // Chinese and Japanese only + imSAlpha, // Japanese and Korea + imAlpha, // Japanese and Korea + imHira, // Japanese only + imSKata, // Japanese only + imKata, // Japanese only + imChineseClose, // Chinese IME only + imOnHalf, // Chinese IME only + imSHanguel, // Korean IME only + imHanguel // Korean IME only + ); + + TDragOperation = (None, Move, Copy, Link); + + TDragObject = record + Source: TObject; + Files: array of string; + Data: TValue; + end; + + TFmxHandle = THandle; + TFlasherInterval = -1..1000; + +const + cIdNoTimer: TFmxHandle = TFmxHandle(-1); + +type + TCanActionExecEvent = procedure(Sender: TCustomAction; var CanExec: Boolean) of object; + + TFmxObject = class; + TFmxObjectClass = class of TFmxObject; + TBounds = class; + TLineMetricInfo = class; + TTouchManager = class; + TCustomPopupMenu = class; + + TWindowHandle = class + protected + /// Returns window scale factor. + function GetScale: Single; virtual; + public + /// Returns True if Scale is integer value. + function IsScaleInteger: Boolean; + /// Window scale factor. + property Scale: Single read GetScale; + end; + + IFreeNotification = interface + ['{FEB50EAF-A3B9-4b37-8EDB-1EF9EE2F22D4}'] + procedure FreeNotification(AObject: TObject); + end; + + IFreeNotificationBehavior = interface + ['{83F052C5-8696-4AFA-88F5-DCDFEF005480}'] + procedure AddFreeNotify(const AObject: IFreeNotification); + procedure RemoveFreeNotify(const AObject: IFreeNotification); + end; + + TCustomCaret = class; + + ICaret = interface + ['{F4EFFFB8-E83C-421D-B123-C370FB7BCCC7}'] + function GetObject: TCustomCaret; + procedure ShowCaret; + procedure HideCaret; + end; + + IFlasher = interface + ['{1A9163B4-47FD-45D6-A54F-70158CB01777}'] + function GetColor: TAlphaColor; + function GetPos: TPointF; + function GetSize: TSizeF; + function GetVisible: Boolean; + function GetOpacity: Single; + function GetInterval: TFlasherInterval; + function GetCaret: TCustomCaret; + procedure SetCaret(const Value: TCustomCaret); + + property Color: TAlphaColor read GetColor; + property Pos: TPointF read GetPos; + property Size: TSizeF read GetSize; + property Visible: boolean read GetVisible; + property Opacity: Single read GetOpacity; + property Interval: TFlasherInterval read GetInterval; + property Caret: TCustomCaret read GetCaret write SetCaret; + procedure UpdateState; + end; + + IContainerObject = interface + ['{DE635E60-CB00-4741-92BB-3B8F1F29A67C}'] + function GetContainerWidth: Single; + function GetContainerHeight: Single; + property ContainerWidth: single read GetContainerWidth; + property ContainerHeight: single read GetContainerHeight; + end; + + IOriginalContainerSize = interface + ['{E76F6097-AF5D-49a1-9C7B-5127D6068059}'] + function GetOriginalContainerSize: TPointF; + property OriginalContainerSize: TPointF read GetOriginalContainerSize; + end; + + IObjectState = interface + ['{0402E1A6-1F75-4D28-BFEA-8092803B00EE}'] + function SaveState: Boolean; + function RestoreState: Boolean; + end; + + /// + /// The interface is designed to notify the container component of any changes among the child components. + /// + IContentObserver = interface + ['{F75361BC-73E2-4DC1-9BA0-C5FC711E34D2}'] + procedure Changed(const AChild: TFmxObject); + end; + + IContent = interface + ['{96E89B94-2AD6-4AD3-A07C-92E66B2E6BC8}'] + function GetParent: TFmxObject; + function GetObject: TFmxObject; + function GetChildrenCount: Integer; + property Parent: TFmxObject read GetParent; + property ChildrenCount: Integer read GetChildrenCount; + procedure Changed; + end; + + IFMXCursorService = interface(IInterface) + ['{5D359E54-2543-414E-8268-A53292E4FDB4}'] + procedure SetCursor(const ACursor: TCursor); + function GetCursor: TCursor; + end; + + IFMXMouseService = interface(IInterface) + ['{2370205F-CF27-4DF6-9B1F-5EBC27271D5A}'] + function GetMousePos: TPointF; + end; + + ITabStopController = interface; + + IControl = interface(IFreeNotificationBehavior) + ['{7318D022-D048-49DE-BF55-C5C36A2AD1AC}'] + function GetObject: TFmxObject; + procedure SetFocus; + function GetIsFocused: Boolean; + function GetCanFocus: Boolean; + function GetCanParentFocus: Boolean; + function GetEnabled: Boolean; + function GetAbsoluteEnabled: Boolean; + function GetPopupMenu: TCustomPopupMenu; + function EnterChildren(AObject: IControl): Boolean; + function ExitChildren(AObject: IControl): Boolean; + procedure DoEnter; + procedure DoExit; + procedure DoActivate; + procedure DoDeactivate; + procedure DoMouseEnter; + procedure DoMouseLeave; + function ShowContextMenu(const ScreenPosition: TPointF): Boolean; + function ScreenToLocal(const AScreenPoint: TPointF): TPointF; + function LocalToScreen(const ALocalPoint: TPointF): TPointF; + function ObjectAtPoint(AScreenPoint: TPointF): IControl; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); + procedure MouseMove(Shift: TShiftState; X, Y: Single); + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); + procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); + procedure MouseClick(Button: TMouseButton; Shift: TShiftState; X, Y: Single); + procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); + procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); + procedure Tap(const Point: TPointF); + procedure DialogKey(var Key: Word; Shift: TShiftState); + procedure AfterDialogKey(var Key: Word; Shift: TShiftState); + function FindTarget(P: TPointF; const Data: TDragObject): IControl; + procedure DragEnter(const Data: TDragObject; const Point: TPointF); + procedure DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); + procedure DragDrop(const Data: TDragObject; const Point: TPointF); + procedure DragLeave; + procedure DragEnd; + function CheckForAllowFocus: Boolean; + procedure Repaint; + function GetDragMode: TDragMode; + procedure SetDragMode(const ADragMode: TDragMode); + procedure BeginAutoDrag; + function GetParent: TFmxObject; + function GetLocked: Boolean; + function GetVisible: Boolean; + procedure SetVisible(const Value: Boolean); + function GetHitTest: Boolean; + function GetCursor: TCursor; + function GetInheritedCursor: TCursor; + function GetDesignInteractive: Boolean; + function GetAcceptsControls: Boolean; + procedure SetAcceptsControls(const Value: Boolean); + procedure BeginUpdate; + procedure EndUpdate; + function GetTabStopController: ITabStopController; + function GetTabStop: Boolean; + procedure SetTabStop(const TabStop: Boolean); + /// This method returns true if the control has an available hint to display. + function HasHint: Boolean; + /// If HasHint is true, this method is invoked in order to know if the control has an available + /// string to swho as hint. + function GetHintString: string; + /// If HasHint is true, this method is invoked in order to know if the control has a custom hint + /// object to manage the hint display. This usually returns an instance of THint to allow the form to manage + /// it. + function GetHintObject: TObject; + { access } + property AbsoluteEnabled: Boolean read GetAbsoluteEnabled; + property Cursor: TCursor read GetCursor; + property InheritedCursor: TCursor read GetInheritedCursor; + property DragMode: TDragMode read GetDragMode write SetDragMode; + property DesignInteractive: Boolean read GetDesignInteractive; + property Enabled: Boolean read GetEnabled; + property Parent: TFmxObject read GetParent; + property Locked: Boolean read GetLocked; + property HitTest: Boolean read GetHitTest; + property PopupMenu: TCustomPopupMenu read GetPopupMenu; + property Visible: Boolean read GetVisible write SetVisible; + property AcceptsControls: Boolean read GetAcceptsControls write SetAcceptsControls; + property IsFocused: Boolean read GetIsFocused; + property TabStop: Boolean read GetTabStop write SetTabStop; + end; + + IFlipContainer = interface + ['{F3850EDC-75F1-4122-AF7D-02A69346376C}'] + procedure FlipChildren(const AAllLevels: Boolean); + end; + + /// This interface is used to acces to property ReadOnly of all classes which supports this property + /// + IReadOnly = interface + ['{495B8B0C-D7C8-4835-AA5F-580939D21444}'] + function GetReadOnly: Boolean; + procedure SetReadOnly(const Value: Boolean); + /// The property to which we have access + property ReadOnly: Boolean read GetReadOnly write SetReadOnly; + end; + + IRoot = interface + ['{7F7BB7B0-5932-49dd-9D35-712B2BA5D8EF}'] + procedure AddObject(const AObject: TFmxObject); + procedure InsertObject(Index: Integer; const AObject: TFmxObject); + procedure RemoveObject(const AObject: TFmxObject); overload; + procedure RemoveObject(Index: Integer); overload; + procedure BeginInternalDrag(const Source: TObject; const ABitmap: TObject); + function GetActiveControl: IControl; + procedure SetActiveControl(const AControl: IControl); + function GetCaptured: IControl; + procedure SetCaptured(const Value: IControl); + function GetFocused: IControl; + procedure SetFocused(const Value: IControl); + function NewFocusedControl(const Value: IControl): IControl; + function GetHovered: IControl; + procedure SetHovered(const Value: IControl); + function GetObject: TFmxObject; + function GetBiDiMode: TBiDiMode; + { access } + property Captured: IControl read GetCaptured write SetCaptured; + property Focused: IControl read GetFocused write SetFocused; + property Hovered: IControl read GetHovered write SetHovered; + property BiDiMode: TBiDiMode read GetBiDiMode; + end; + + IAlignRoot = interface + ['{86DF30A6-0394-4a0e-8722-1F2CDB242CE8}'] + procedure Realign; + procedure ChildrenAlignChanged; + end; + + INativeControl = interface + ['{3E6F1A17-BAE3-456C-8551-5F6EA92EEE32}'] + function GetHandle: TFmxHandle; + procedure SetHandle(const Value: TFmxHandle); + function GetHandleSupported: boolean; + property HandleSupported: boolean read GetHandleSupported; + property Handle: TFmxHandle read GetHandle write SetHandle; + end; + + IPaintControl = interface + ['{47959F99-CCA5-4ACF-BB8D-357F126E9C78}'] + procedure PaintRects(const UpdateRects: array of TRectF); + procedure SetContextHandle(const AContextHandle: THandle); + function GetContextHandle: THandle; + property ContextHandle: THandle read GetContextHandle write SetContextHandle; + end; + + TVirtualKeyboardType = (Default, NumbersAndPunctuation, NumberPad, PhonePad, Alphabet, URL, NamePhonePad, + EmailAddress, DecimalNumberPad); + + TVirtualKeyboardState = (AutoShow, Visible, Error, Transient); + + TVirtualKeyboardStates = set of TVirtualKeyboardState; + + TReturnKeyType = (Default, Done, Go, Next, Search, Send); + + IVirtualKeyboardControl = interface + ['{41127080-97FC-4C30-A880-AB6CD351A6C4}'] + procedure SetKeyboardType(Value: TVirtualKeyboardType); + function GetKeyboardType: TVirtualKeyboardType; + property KeyboardType: TVirtualKeyboardType read GetKeyboardType write SetKeyboardType; + // + procedure SetReturnKeyType(Value: TReturnKeyType); + function GetReturnKeyType: TReturnKeyType; + property ReturnKeyType: TReturnKeyType read GetReturnKeyType write SetReturnKeyType; + // + function IsPassword: Boolean; + end; + + TAdjustType = (None, FixedSize, FixedWidth, FixedHeight); + + IAlignableObject = interface + ['{420D3E98-4433-4cbe-9767-0B494DF08354}'] + function GetAlign: TAlignLayout; + procedure SetAlign(const Value: TAlignLayout); + function GetAnchors: TAnchors; + procedure SetAnchors(const Value: TAnchors); + function GetMargins: TBounds; + procedure SetBounds(X, Y, AWidth, AHeight: Single); + function GetPadding: TBounds; + function GetWidth: single; + function GetHeight: single; + function GetLeft: single; + function GetTop: single; + function GetAllowAlign: Boolean; + + function GetAnchorRules: TPointF; + function GetAnchorOrigin: TPointF; + function GetOriginalParentSize: TPointF; + function GetAnchorMove : Boolean; + procedure SetAnchorMove(Value : Boolean); + + function GetAdjustType: TAdjustType; + function GetAdjustSizeValue: TSizeF; + { access } + property Align: TAlignLayout read GetAlign write SetAlign; + property AllowAlign: Boolean read GetAllowAlign; + property Anchors: TAnchors read GetAnchors write SetAnchors; + property Margins: TBounds read GetMargins; + property Padding: TBounds read GetPadding; + property Left: single read GetLeft; + property Height: single read GetHeight; + property Width: single read GetWidth; + property Top: single read GetTop; + + property AnchorRules: TPointF read GetAnchorRules; + property AnchorOrigin: TPointF read GetAnchorOrigin; + property OriginalParentSize: TPointF read GetOriginalParentSize; + property AnchorMove : Boolean read GetAnchorMove write SetAnchorMove; + + property AdjustType: TAdjustType read GetAdjustType; + property AdjustSizeValue: TSizeF read GetAdjustSizeValue; + end; + + IItemsContainer = interface + ['{100B2F87-5DCB-4699-B751-B4439588E82A}'] + function GetItemsCount: Integer; + function GetItem(const AIndex: Integer): TFmxObject; + function GetObject: TFmxObject; + end; + + ITabList = interface + ['{80C67BA2-3064-4d90-A8E1-B00028CA670E}'] + procedure Add(const TabStop: IControl); + procedure Remove(const TabStop: IControl); + procedure Update(const TabStop: IControl; const NewValue: TTabOrder); + function GetTabOrder(const TabStop: IControl): TTabOrder; + function GetCount: Integer; + function GetItem(const Index: Integer): IControl; + function FindNextTabStop(const Current: IControl; const MoveForward: Boolean; const Climb: Boolean): IControl; + property Count: Integer read GetCount; + end; + + ITabStopController = interface + ['{E7D2E0C5-EA3B-40bd-B728-5E4BB264EFC1}'] + function GetTabList: ITabList; + property TabList: ITabList read GetTabList; + end; + + TTangentPair = record + I: Single; + Ip1: Single; + end; + + TSpline = class(TObject) + private + FTangentsX, FTangentsY: array of TTangentPair; + FValuesX, FValuesY: array of Single; + public + constructor Create(const Polygon: TPolygon); + destructor Destroy; override; + procedure SplineXY(const t: Single; var X, Y: Single); + end; + + TDragEnterEvent = procedure(Sender: TObject; const Data: TDragObject; const Point: TPointF) of object; + TDragOverEvent = procedure(Sender: TObject; const Data: TDragObject; const Point: TPointF; + var Operation: TDragOperation) of object; + TDragDropEvent = procedure(Sender: TObject; const Data: TDragObject; const Point: TPointF) of object; + TCanFocusEvent = procedure(Sender: TObject; var ACanFocus: Boolean) of object; + + PDeviceDisplayMetrics = ^TDeviceDisplayMetrics; + TDeviceDisplayMetrics = record + PhysicalScreenSize: TSize; + LogicalScreenSize: TSize; + /// When available, complete screen area in pixels, including status bars and button bars. Can be + /// the same as PhysicalScreenSize. + RawScreenSize: TSize; + AspectRatio: Single; + PixelsPerInch: Integer; + ScreenScale: Single; + FontScale: Single; + + constructor Create(const APhysicalScreenSize, ALogicalScreenSize: TSize; const AAspectRatio: Single; + const APixelsPerInch: Integer; const AScreenScale, AFontScale: Single); + + class operator Equal(const Left, Right: TDeviceDisplayMetrics): Boolean; + class operator NotEqual(const Left, Right: TDeviceDisplayMetrics): Boolean; inline; + + class function Default: TDeviceDisplayMetrics; static; + end; + +{ TBounds } + + TBounds = class(TPersistent) + private + FRight: Single; + FBottom: Single; + FTop: Single; + FLeft: Single; + FOnChange: TNotifyEvent; + FDefaultValue: TRectF; + function GetRect: TRectF; + procedure SetRect(const Value: TRectF); + procedure SetBottom(const Value: Single); + procedure SetLeft(const Value: Single); + procedure SetRight(const Value: Single); + procedure SetTop(const Value: Single); + function IsBottomStored: Boolean; + function IsLeftStored: Boolean; + function IsRightStored: Boolean; + function IsTopStored: Boolean; + procedure ReadLeftInt(Reader: TReader); + procedure ReadBottomInt(Reader: TReader); + procedure ReadRightInt(Reader: TReader); + procedure ReadTopInt(Reader: TReader); + procedure ReadRectInt(Reader: TReader); + procedure ReadRect(Reader: TReader); + protected + procedure DefineProperties(Filer: TFiler); override; + procedure DoChange; virtual; + public + constructor Create(const ADefaultValue: TRectF); virtual; + procedure Assign(Source: TPersistent); override; + function Equals(Obj: TObject): Boolean; override; + function PaddingRect(const R: TRectF): TRectF; + function MarginRect(const R: TRectF): TRectF; + function Width: Single; + function Height: Single; + property Rect: TRectF read GetRect write SetRect; + property DefaultValue: TRectF read FDefaultValue write FDefaultValue; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + function Empty: Boolean; + function MarginEmpty: Boolean; + function ToString: string; override; + published + property Left: Single read FLeft write SetLeft stored IsLeftStored nodefault; + property Top: Single read FTop write SetTop stored IsTopStored nodefault; + property Right: Single read FRight write SetRight stored IsRightStored nodefault; + property Bottom: Single read FBottom write SetBottom stored IsBottomStored nodefault; + end; + +{ TPosition } + + TPosition = class(TPersistent) + private + FOnChange: TNotifyEvent; + FY: Single; + FX: Single; + FDefaultValue: TPointF; + FStoreAsInt: Boolean; + procedure SetPoint(const Value: TPointF); + procedure SetX(const Value: Single); + procedure SetY(const Value: Single); + function GetPoint: TPointF; + function IsXStored: Boolean; + function IsYStored: Boolean; + procedure ReadXInt(Reader: TReader); + procedure WriteXInt(Writer: TWriter); + procedure ReadYInt(Reader: TReader); + procedure WriteYInt(Writer: TWriter); + protected + procedure DefineProperties(Filer: TFiler); override; + procedure ReadPoint(Reader: TReader); + procedure WritePoint(Writer: TWriter); + procedure DoChange; virtual; + public + constructor Create(const ADefaultValue: TPointF); virtual; + procedure Assign(Source: TPersistent); override; + procedure SetPointNoChange(const P: TPointF); + function Empty: Boolean; + procedure Reflect(const Normal: TPointF); + property Point: TPointF read GetPoint write SetPoint; + property StoreAsInt: Boolean read FStoreAsInt write FStoreAsInt; + property DefaultValue: TPointF read FDefaultValue write FDefaultValue; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + published + property X: Single read FX write SetX stored IsXStored nodefault; + property Y: Single read FY write SetY stored IsYStored nodefault; + end; + + TControlSize = class(TPersistent) + private + FUsePlatformDefault: Boolean; + FSize: TSizeF; + FDefaultValue: TSizeF; + FOnChange: TNotifyEvent; + procedure SetWidth(const AValue: Single); + procedure SetHeight(const AValue: Single); + function GetWidth: Single; + function GetHeight: Single; + function StoreWidthHeight: Boolean; + procedure SetUsePlatformDefault(const Value: Boolean); + function GetSize: TSizeF; + procedure SetSize(const Value: TSizeF); + protected + procedure DoChange; virtual; + public + constructor Create(const ASize: TSizeF); + procedure Assign(Source: TPersistent); override; + procedure SetPlatformDefaultWithoutNotification(const Value: Boolean); inline; + procedure SetSizeWithoutNotification(const Value: TSizeF); + property DefaultValue: TSizeF read FDefaultValue write FDefaultValue; + property Size: TSizeF read GetSize write SetSize; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + published + property Width: Single read GetWidth write SetWidth stored StoreWidthHeight nodefault; + property Height: Single read GetHeight write SetHeight stored StoreWidthHeight nodefault; + property PlatformDefault: Boolean read FUsePlatformDefault write SetUsePlatformDefault default True; + end; + + IRotatedControl = interface + ['{9EACF441-30E1-467D-88DA-CC8B2977758F}'] + function GetRotationAngle: Single; + function GetRotationCenter: TPosition; + function GetScale: TPosition; + procedure SetRotationAngle(const Value: Single); + procedure SetRotationCenter(const Value: TPosition); + procedure SetScale(const Value: TPosition); + property RotationAngle: Single read GetRotationAngle write SetRotationAngle; + property RotationCenter: TPosition read GetRotationCenter write SetRotationCenter; + property Scale: TPosition read GetScale write SetScale; + end; + + TCaretDisplayChanged = procedure (Sender: TCustomCaret; const VirtualKeyboardState: TVirtualKeyboardStates) of object; + + TCaretClass = class of TCustomCaret; + + TCustomCaret = class (TPersistent) + private + [Weak]FOwner: TFMXObject; + FIControl: IControl; + FVisible: Boolean; + FDisplayed: Boolean; + FTemporarilyHidden: Boolean; + FChanged: Boolean; + FUpdateCount: Integer; + FOnDisplayChanged: TCaretDisplayChanged; + FColor: TAlphaColor; + FDefaultColor: TAlphaColor; + FPos: TPointF; + FSize: TSizeF; + FInterval: TFlasherInterval; + FReadOnly: Boolean; + procedure SetColor(const Value: TAlphaColor); + procedure SetPos(const Value: TPointF); + procedure SetSize(const Value: TSizeF); + procedure SetTemporarilyHidden(const Value: boolean); + procedure SetVisible(const Value: Boolean); + procedure SetInterval(const Value: TFlasherInterval); + procedure SetReadOnly(const Value: boolean); + procedure StartTimer; + function GetWidth: Word; + procedure SetWidth(const Value: Word); + function GetFlasher: IFlasher; + procedure SetDefaultColor(const Value: TAlphaColor); + protected + function GetOwner: TPersistent; override; + procedure DoDisplayChanged(const VirtualKeyboardState: TVirtualKeyboardStates); virtual; + procedure DoUpdateFlasher; virtual; + public + constructor Create(const AOwner: TFMXObject); virtual; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + /// + /// hide the caret + /// + procedure Hide; virtual; + /// + /// if possible (CanShow = True and Visible = True), the caret show. + /// + procedure Show; virtual; + /// + /// This method is performed after changing the Displayed + /// + property Pos: TPointF read FPos write SetPos; + property Size: TSizeF read FSize write SetSize; + property Color: TAlphaColor read FColor write SetColor default TAlphaColorRec.Null; + property DefaultColor: TAlphaColor read FDefaultColor write SetDefaultColor; + property Interval: TFlasherInterval read FInterval write SetInterval default 0; + property Owner: TFMXObject read FOwner; + property Control: IControl read FIControl; + procedure BeginUpdate; + procedure EndUpdate; + class function FlasherName: string; virtual; abstract; + property UpdateCount: Integer read FUpdateCount; + /// + /// The update of the "Flasher", if UpdateCount = 0. + /// + procedure UpdateFlasher; + /// + /// This property controls the visibility of a caret, for the control in which the input focus. + /// + property Visible: Boolean read FVisible write SetVisible; + /// + /// The function returns true, if the control is visible, enabled, + /// has the input focus and it in an active form + /// + function CanShow: Boolean; virtual; + /// + /// This property is set to True, after the successful execution of + /// method Show, and is set to False after method Hide + /// + property Displayed: Boolean read FDisplayed; + /// + /// If this property is 'true', the blinking control is invisible + /// and does not take values of Visible, Displayed. + /// When you change the properties, methods DoShow, DoHide, DoDisplayChanged not met. + /// + property TemporarilyHidden: boolean read FTemporarilyHidden write SetTemporarilyHidden; + /// + /// Blinking visual component is displayed. + /// Usually this line, having a thickness of one or two pixels. + /// + property Flasher: IFlasher read GetFlasher; + property ReadOnly: boolean read FReadOnly write SetReadOnly; + property Width: Word read GetWidth write SetWidth default 0; + + property OnDisplayChanged: TCaretDisplayChanged read FOnDisplayChanged write FOnDisplayChanged; + end; + +{ TTransform } + + TTransform = class(TPersistent) + private + FMatrix: TMatrix; + FRotationAngle: Single; + FPosition: TPosition; + FScale: TPosition; + FSkew: TPosition; + FRotationCenter: TPosition; + FOnChanged: TNotifyEvent; + procedure SetRotationAngle(const Value: Single); + procedure SetScale(const Value: TPosition); + procedure SetPosition(const Value: TPosition); + protected + procedure MatrixChanged(Sender: TObject); + property Skew: TPosition read FSkew write FSkew; + public + constructor Create; virtual; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + property Matrix: TMatrix read FMatrix; + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; + published + property Position: TPosition read FPosition write SetPosition; + property Scale: TPosition read FScale write SetScale; + property RotationAngle: Single read FRotationAngle write SetRotationAngle; + property RotationCenter: TPosition read FRotationCenter write FRotationCenter; + end; + + TTrigger = type string; + + TAnimationType = (&In, Out, InOut); + + TInterpolationType = (Linear, Quadratic, Cubic, Quartic, Quintic, Sinusoidal, Exponential, Circular, Elastic, Back, Bounce); + + TMouseEvent = procedure(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single) of object; + TMouseMoveEvent = procedure(Sender: TObject; Shift: TShiftState; X, Y: Single) of object; + TMouseWheelEvent = procedure(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean) of object; + TKeyEvent = procedure(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState) of object; + TProcessTickEvent = procedure(Sender: TObject; time, deltaTime: Single) of object; + TVirtualKeyboardEvent = procedure(Sender: TObject; KeyboardVisible: Boolean; const Bounds : TRect) of object; + TTapEvent = procedure(Sender: TObject; const Point: TPointF) of object; + TTouchEvent = procedure(Sender: TObject; const Touches: TTouches; const Action: TTouchAction) of object; + + TFmxObjectSortCompare = reference to function (Left, Right: TFmxObject): Integer; + + TFmxObjectList = TList; + + TFmxChildrenList = class(TEnumerable) + strict private + [weak] FChildren: TFmxObjectList; + protected + function DoGetEnumerator: TEnumerator; override; + function GetChildCount: Integer; virtual; + function GetChild(AIndex: Integer): TFmxObject; virtual; + public + constructor Create(const AChildren: TFmxObjectList); + destructor Destroy; override; + property Count: Integer read GetChildCount; + function IndexOf(const Obj: TFmxObject): Integer; virtual; + property Items[Index: Integer]: TFmxObject read GetChild; default; + end; + +{ TFmxObject } + + TEnumProcResult = (Continue, Discard, Stop); + + /// Index for getting fast access to nested objects by StyleName. + TStyleIndexer = class + private + [Weak] FStyle: TFmxObject; + FIndex: TDictionary; + procedure Rebuild; + public + constructor Create(const AStyle: TFmxObject); + destructor Destroy; override; + + /// Marks index for lazy update. + procedure NeedRebuild; + /// Updates index, if it's required only. + procedure RebuildIfNeeded; + /// Finds style object by specified StyleLookup value and returns object in AObject. + function FindStyleObject(const AStyleLookup: string; var AObject: TFmxObject): Boolean; + /// Clears index. + procedure Clear; + end; + + TFmxObject = class(TComponent, IFreeNotification, IActionClient) + public type + /// Determines the current state of the object + /// CallingFreeNotify - state is set before sending notifications in BeforeDestruction method. + /// See also IFreeNotification + /// CallingRelease - state is set in Release method + /// + TObjectState = set of (CallingFreeNotify, CallingRelease) deprecated 'Support to this state will be removed'; + strict private + FChildren: TFmxObjectList; + FChildrenList: TFmxChildrenList; + FStyleIndexer: TStyleIndexer; + private + FStored: Boolean; + [Weak] FTagObject: TObject; + FTagFloat: Single; + FTagString: string; + FNotifyList: TList; + FIndex: Integer; + FActionClient: Boolean; + FActionLink: TActionLink; + FRoot: IRoot; + procedure SetStyleName(const Value: string); + procedure SetStored(const Value: Boolean); + function GetChildrenCount: Integer; inline; + function GetIndexOfChild(const Child: TFmxObject): Integer; + procedure SetIndexOfChild(const Child: TFmxObject; NewIndex: Integer); + procedure SetIndex(NewIndex: Integer); + { IActionClient } + function IActionClient.GetRoot = GetActionRoot; + function GetActionRoot: TComponent; + function GetActionClient: Boolean; inline; + procedure SetActionClient(const Value: boolean); + function GetAction: TBasicAction; + procedure SetAction(const Value: TBasicAction); + function GetIndex: Integer; + + class constructor Create; + class destructor Destroy; + protected + FStyleName: string; + [Weak] FParent: TFmxObject; + function CreateChildrenList(const Children: TFmxObjectList): TFmxChildrenList; virtual; + procedure ResetChildrenIndicesSpan(const First, Last: Integer); + procedure ResetChildrenIndices; + function GetBackIndex: Integer; virtual; + procedure DefineProperties(Filer: TFiler); override; + procedure IgnoreBindingName(Reader: TReader); + { RTL } + procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; + procedure SetParentComponent(Value: TComponent); override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + { Actions } + function GetActionLinkClass: TActionLinkClass; virtual; + procedure InitiateAction; virtual; + procedure DoActionChange(Sender: TObject); virtual; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); virtual; + procedure DoActionClientChanged; virtual; + property ActionLink: TActionLink read FActionLink; + property Action: TBasicAction read GetAction write SetAction; + property StyleIndexer: TStyleIndexer read FStyleIndexer; + public + function GetParentComponent: TComponent; override; + function HasParent: Boolean; override; + protected + procedure AddToResourcePool; virtual; + procedure RemoveFromResourcePool; virtual; + { parent } + procedure SetParent(const Value: TFmxObject); virtual; + procedure DoRootChanging(const NewRoot: IRoot); virtual; + procedure DoRootChanged; virtual; + procedure ParentChanged; virtual; + procedure ChangeOrder; virtual; + procedure ChangeChildren; virtual; + { children } + procedure DoAddObject(const AObject: TFmxObject); virtual; + procedure DoInsertObject(Index: Integer; const AObject: TFmxObject); virtual; + procedure DoRemoveObject(const AObject: TFmxObject); virtual; + procedure DoDeleteChildren; virtual; + function SearchInto: Boolean; virtual; + { IFreeNotification } + procedure FreeNotification(AObject: TObject); virtual; + { design } + function SupportsPlatformService(const AServiceGUID: TGUID; out AService): Boolean; virtual; + { Data } + function GetData: TValue; virtual; + procedure SetData(const Value: TValue); virtual; + procedure IgnoreIntegerValue(Reader: TReader); + procedure IgnoreFloatValue(Reader: TReader); + procedure IgnoreBooleanValue(Reader: TReader); + procedure IgnoreIdentValue(Reader: TReader); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure BeforeDestruction; override; + procedure Release; virtual; + function Released: Boolean; deprecated 'Support for this method will be removed'; + /// Describes the current state of this instance. Indicates that a component needs to avoid certain + /// actions. See also TComponent.ComponentState + function ObjectState: TObjectState; deprecated 'Support for this funcionality will be removed'; + procedure SetRoot(ARoot: IRoot); + { design } + procedure SetDesign(Value: Boolean; SetChildren: Boolean = True); + { clone } + function Clone(const AOwner: TComponent): TFmxObject; + { childs } + procedure AddObject(const AObject: TFmxObject); + procedure InsertObject(Index: Integer; const AObject: TFmxObject); + procedure RemoveObject(const AObject: TFmxObject); overload; + procedure RemoveObject(Index: Integer); overload; + function ContainsObject(AObject: TFmxObject): Boolean; virtual; + procedure Exchange(const AObject1, AObject2: TFmxObject); virtual; + procedure DeleteChildren; + function IsChild(AObject: TFmxObject): Boolean; virtual; + procedure BringChildToFront(const Child: TFmxObject); + procedure SendChildToBack(const Child: TFmxObject); + procedure BringToFront; virtual; + procedure SendToBack; virtual; + procedure AddObjectsToList(const AList: TFmxObjectList); + procedure Sort(Compare: TFmxObjectSortCompare); virtual; + /// Loops through the children of this object, and runs the specified procedure once per object as the first parameter in each call. + procedure EnumObjects(const Proc: TFunc); + { animation property } + procedure AnimateFloat(const APropertyName: string; const NewValue: Single; Duration: Single = 0.2; + AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear); + deprecated 'Use FMX.Ani.TAnimator instead'; + procedure AnimateFloatDelay(const APropertyName: string; const NewValue: Single; Duration: Single = 0.2; + Delay: Single = 0.0; AType: TAnimationType = TAnimationType.In; + AInterpolation: TInterpolationType = TInterpolationType.Linear); + deprecated 'Use FMX.Ani.TAnimator instead'; + procedure AnimateFloatWait(const APropertyName: string; const NewValue: Single; Duration: Single = 0.2; + AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear); + deprecated 'Use FMX.Ani.TAnimator instead'; + procedure AnimateInt(const APropertyName: string; const NewValue: Integer; Duration: Single = 0.2; + AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear); + deprecated 'Use FMX.Ani.TAnimator instead'; + procedure AnimateIntWait(const APropertyName: string; const NewValue: Integer; Duration: Single = 0.2; + AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear); + deprecated 'Use FMX.Ani.TAnimator instead'; + procedure AnimateColor(const APropertyName: string; NewValue: TAlphaColor; Duration: Single = 0.2; + AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear); + deprecated 'Use FMX.Ani.TAnimator instead'; + procedure StopPropertyAnimation(const APropertyName: string); + { notify } + procedure AddFreeNotify(const AObject: IFreeNotification); + procedure RemoveFreeNotify(const AObject: IFreeNotification); + { resource } + function FindStyleResource(const AStyleLookup: string; const AClone: Boolean = False): TFmxObject; overload; virtual; + { } + property Root: IRoot read FRoot; + property Stored: Boolean read FStored write SetStored; + { tags } + property TagObject: TObject read FTagObject write FTagObject; + property TagFloat: Single read FTagFloat write FTagFloat; + property TagString: string read FTagString write FTagString; + { children } + property ChildrenCount: Integer read GetChildrenCount; + property Children: TFmxChildrenList read FChildrenList; + property Data: TValue read GetData write SetData; + property Parent: TFmxObject read FParent write SetParent; + property Index: Integer read GetIndex write SetIndex; + property ActionClient: boolean read GetActionClient; + published + property StyleName: string read FStyleName write SetStyleName; + end; + + TTabList = class(TAggregatedObject, ITabList) + strict private + FTabList: TList; + procedure CreateTabList; + function ParentIsRoot: Boolean; + protected + function IsAddable(const TabStop: IControl): Boolean; virtual; + public + constructor Create(const TabStopController: ITabStopController); + destructor Destroy; override; + procedure Clear; + procedure Add(const TabStop: IControl); virtual; + procedure Remove(const TabStop: IControl); virtual; + procedure Update(const TabStop: IControl; const NewValue: TTabOrder); + function IndexOf(const TabStop: IControl): Integer; virtual; + function GetCount: Integer; virtual; + function GetItem(const Index: Integer): IControl; virtual; + function GetTabOrder(const TabStop: IControl): TTabOrder; + function FindNextTabStop(const ACurrent: IControl; const AMoveForward: Boolean; const AClimb: Boolean): IControl; + end; + TTabListClass = class of TTabList; + +{ TCustomPopupMenu } + + TCustomPopupMenu = class(TFmxObject) + private + [Weak] FPopupComponent: TComponent; + FOnPopup: TNotifyEvent; + protected + procedure DoPopup; virtual; + property OnPopup: TNotifyEvent read FOnPopup write FOnPopup; + public + procedure Popup(X, Y: Single); virtual; abstract; + property PopupComponent: TComponent read FPopupComponent write FPopupComponent; + end; + + TStandardGesture = ( + sgLeft = sgiLeft, + sgRight = sgiRight, + sgUp = sgiUp, + sgDown = sgiDown, + sgUpLeft = sgiUpLeft, + sgUpRight = sgiUpRight, + sgDownLeft = sgiDownLeft, + sgDownRight = sgiDownRight, + sgLeftUp = sgiLeftUp, + sgLeftDown = sgiLeftDown, + sgRightUp = sgiRightUp, + sgRightDown = sgiRightDown, + sgUpDown = sgiUpDown, + sgDownUp = sgiDownUp, + sgLeftRight = sgiLeftRight, + sgRightLeft = sgiRightLeft, + sgUpLeftLong = sgiUpLeftLong, + sgUpRightLong = sgiUpRightLong, + sgDownLeftLong = sgiDownLeftLong, + sgDownRightLong = sgiDownRightLong, + sgScratchout = sgiScratchout, + sgTriangle = sgiTriangle, + sgSquare = sgiSquare, + sgCheck = sgiCheck, + sgCurlicue = sgiCurlicue, + sgDoubleCurlicue = sgiDoubleCurlicue, + sgCircle = sgiCircle, + sgDoubleCircle = sgiDoubleCircle, + sgSemiCircleLeft = sgiSemiCircleLeft, + sgSemiCircleRight = sgiSemiCircleRight, + sgChevronUp = sgiChevronUp, + sgChevronDown = sgiChevronDown, + sgChevronLeft = sgiChevronLeft, + sgChevronRight = sgiChevronRight + ); + + TStandardGestures = set of TStandardGesture; + + TInteractiveGesture = (Zoom, Pan, Rotate, TwoFingerTap, PressAndTap, LongTap, DoubleTap); + TInteractiveGestures = set of TInteractiveGesture; + + TCustomGestureManager = class; + TCustomGestureCollection = class; + TCustomGestureCollectionItem = class; + + TGestureType = (Standard, Recorded, Registered, None); + TGestureTypes = set of TGestureType; + + TGestureOption = (UniDirectional, Skew, Endpoint, Rotate); + TGestureOptions = set of TGestureOption; + + TGestureArray = array of TCustomGestureCollectionItem; + TGesturePointArray = array of TPointF; + + TCustomGestureCollectionItem = class(TCollectionItem) + strict protected + function GetAction: TCustomAction; virtual; abstract; + function GetDeviation: Integer; virtual; abstract; + function GetErrorMargin: Integer; virtual; abstract; + function GetGestureID: TGestureID; virtual; abstract; + function GetGestureType: TGestureType; virtual; abstract; + function GetName: string; virtual; abstract; + function GetOptions: TGestureOptions; virtual; abstract; + function GetPoints: TGesturePointArray; virtual; abstract; + procedure SetAction(const Value: TCustomAction); virtual; abstract; + procedure SetDeviation(const Value: Integer); virtual; abstract; + procedure SetErrorMargin(const Value: Integer); virtual; abstract; + procedure SetGestureID(const Value: TGestureID); virtual; abstract; + procedure SetName(const Value: string); virtual; abstract; + procedure SetOptions(const Value: TGestureOptions); virtual; abstract; + procedure SetPoints(const Value: TGesturePointArray); virtual; abstract; + public + property Deviation: Integer read GetDeviation write SetDeviation default 20; + property ErrorMargin: Integer read GetErrorMargin write SetErrorMargin default 20; + property GestureID: TGestureID read GetGestureID write SetGestureID; + property GestureType: TGestureType read GetGestureType; + property Name: string read GetName write SetName; + property Points: TGesturePointArray read GetPoints write SetPoints; + property Action: TCustomAction read GetAction write SetAction; + property Options: TGestureOptions read GetOptions write SetOptions default [TGestureOption.UniDirectional, TGestureOption.Rotate]; + end; + + TCustomGestureCollection = class(TCollection) + protected + function GetGestureManager: TCustomGestureManager; virtual; abstract; + function GetItem(Index: Integer): TCustomGestureCollectionItem; + procedure SetItem(Index: Integer; const Value: TCustomGestureCollectionItem); + public + function AddGesture: TCustomGestureCollectionItem; virtual; abstract; + function FindGesture(AGestureID: TGestureID): TCustomGestureCollectionItem; overload; virtual; abstract; + function FindGesture(const AName: string): TCustomGestureCollectionItem; overload; virtual; abstract; + function GetUniqueGestureID: TGestureID; virtual; abstract; + procedure RemoveGesture(AGestureID: TGestureID); virtual; abstract; + property GestureManager: TCustomGestureManager read GetGestureManager; + property Items[Index: Integer]: TCustomGestureCollectionItem read GetItem write SetItem; default; + end; + + TCustomGestureEngine = class + public type + TGestureEngineFlag = (MouseEvents, TouchEvents); + TGestureEngineFlags = set of TGestureEngineFlag; + protected + function GetActive: Boolean; virtual; abstract; + function GetFlags: TGestureEngineFlags; virtual; abstract; + procedure SetActive(const Value: Boolean); virtual; abstract; + public + constructor Create(const AControl: TComponent); virtual; abstract; + procedure BroadcastGesture(const AControl: TComponent; EventInfo: TGestureEventInfo); virtual; abstract; + property Active: Boolean read GetActive write SetActive; + property Flags: TGestureEngineFlags read GetFlags; + end; + + TCustomGestureManager = class(TComponent) + protected + function GetGestureList(AControl: TComponent): TGestureArray; virtual; abstract; + function GetStandardGestures(AControl: TComponent): TStandardGestures; virtual; abstract; + procedure SetStandardGestures(AControl: TComponent; AStandardGestures: TStandardGestures); virtual; abstract; + public + function AddRecordedGesture(const Item: TCustomGestureCollectionItem): TGestureID; overload; virtual; abstract; + function FindCustomGesture(AGestureID: TGestureID): TCustomGestureCollectionItem; overload; virtual; abstract; + function FindCustomGesture(const AName: string): TCustomGestureCollectionItem; overload; virtual; abstract; + function FindGesture(const AControl: TComponent; AGestureID: TGestureID): TCustomGestureCollectionItem; overload; virtual; abstract; + function FindGesture(const AControl: TComponent; const AName: string): TCustomGestureCollectionItem; overload; virtual; abstract; + procedure RemoveActionNotification(Action: TCustomAction; Item: TCustomGestureCollectionItem); virtual; + procedure RegisterControl(const AControl: TComponent); virtual; abstract; + procedure RemoveRecordedGesture(AGestureID: TGestureID); overload; virtual; abstract; + procedure RemoveRecordedGesture(const AGesture: TCustomGestureCollectionItem); overload; virtual; abstract; + function SelectGesture(const AControl: TComponent; AGestureID: TGestureID): Boolean; overload; virtual; abstract; + function SelectGesture(const AControl: TComponent; const AName: string): Boolean; overload; virtual; abstract; + procedure UnregisterControl(const AControl: TComponent); virtual; abstract; + procedure UnselectGesture(const AControl: TComponent; AGestureID: TGestureID); virtual; abstract; + property GestureList[AControl: TComponent]: TGestureArray read GetGestureList; + property StandardGestures[AControl: TComponent]: TStandardGestures read GetStandardGestures write SetStandardGestures; + end; + + TCustomTouchManager = class(TPersistent) + private + type + TObjectWrapper = class(TObject) + [Weak] FObject : TComponent; + constructor Create(const AObject: TComponent); + end; + private + [Weak] FControl: TComponent; + FGestureEngine: TCustomGestureEngine; + FGestureManager: TCustomGestureManager; + FInteractiveGestures: TInteractiveGestures; + FDefaultInteractiveGestures: TInteractiveGestures; + FStandardGestures: TStandardGestures; + function GetStandardGestures: TStandardGestures; + function IsInteractiveGesturesStored: Boolean; + procedure SetInteractiveGestures(const Value: TInteractiveGestures); + procedure SetGestureEngine(const Value: TCustomGestureEngine); + procedure SetGestureManager(const Value: TCustomGestureManager); + procedure SetStandardGestures(const Value: TStandardGestures); + function GetGestureList: TGestureArray; + protected + procedure AssignTo(Dest: TPersistent); override; + function IsDefault: Boolean; + public + constructor Create(AControl: TComponent); + destructor Destroy; override; + procedure ChangeNotification(const AControl: TComponent); + function FindGesture(AGestureID: TGestureID): TCustomGestureCollectionItem; overload; + function FindGesture(const AName: string): TCustomGestureCollectionItem; overload; + procedure RemoveChangeNotification(const AControl: TComponent); + function SelectGesture(AGestureID: TGestureID): Boolean; overload; + function SelectGesture(const AName: string): Boolean; overload; + procedure UnselectGesture(AGestureID: TGestureID); inline; + property GestureEngine: TCustomGestureEngine read FGestureEngine write SetGestureEngine; + property GestureList: TGestureArray read GetGestureList; + property GestureManager: TCustomGestureManager read FGestureManager write SetGestureManager; + property InteractiveGestures: TInteractiveGestures + read FInteractiveGestures write SetInteractiveGestures stored IsInteractiveGesturesStored; + property DefaultInteractiveGestures: TInteractiveGestures + read FDefaultInteractiveGestures write FDefaultInteractiveGestures; + property StandardGestures: TStandardGestures read GetStandardGestures write SetStandardGestures; + end; + + TTouchManager = class(TCustomTouchManager) + published + property GestureManager; + property InteractiveGestures; + end; + + IGestureControl = interface + ['{A263006D-3472-40F8-A917-F2221B48A459}'] + procedure BroadcastGesture(EventInfo: TGestureEventInfo); + procedure CMGesture(var EventInfo: TGestureEventInfo); + function TouchManager: TTouchManager; + function GetFirstControlWithGesture(AGesture: TInteractiveGesture): TComponent; + function GetFirstControlWithGestureEngine: TComponent; + function GetListOfInteractiveGestures: TInteractiveGestures; + procedure Tap(const Point: TPointF); + end; + + IMultiTouch = interface + ['{A263006D-3472-40F8-A917-F2221B48ABDD}'] + procedure MultiTouch(const Touches: TTouches; const Action: TTouchAction); + end; + + ISizeGrip = interface + ['{181729B7-53B2-45ea-97C7-91E1F3CBAABE}'] + end; + +{ TLang } + + TLang = class(TFmxObject) + private + FLang: string; + FResources: TStrings; + FOriginal: TStrings; + FAutoSelect: Boolean; + FFileName: string; + FStoreInForm: Boolean; + procedure SetLang(const Value: string); + function GetLangStr(const Index: string): TStrings; + protected + { vcl } + procedure DefineProperties(Filer: TFiler); override; + procedure ReadResources(Stream: TStream); + procedure WriteResources(Stream: TStream); + procedure Loaded; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AddLang(const AName: string); + procedure LoadFromFile(const AFileName: string); + procedure SaveToFile(const AFileName: string); + property Original: TStrings read FOriginal; + property Resources: TStrings read FResources; + property LangStr[const Index: string]: TStrings read GetLangStr; + published + property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True; + property FileName: string read FFileName write FFileName; + property StoreInForm: Boolean read FStoreInForm write FStoreInForm default True; + property Lang: string read FLang write SetLang; + end; + +{ TTimer } + + TTimerProc = procedure of object; + + IFMXTimerService = interface(IInterface) + ['{856E938B-FF7B-4E13-85D4-3414A6A9FF2F}'] + function CreateTimer(Interval: Integer; TimerFunc: TTimerProc): TFmxHandle; + function DestroyTimer(Timer: TFmxHandle): Boolean; + function GetTick: Double; + end; + + TTimer = class(TFmxObject) + private + FInterval: Cardinal; + FTimerHandle: TFmxHandle; + FOnTimer: TNotifyEvent; + FEnabled: Boolean; + FPlatformTimer: IFMXTimerService; + procedure Timer; + protected + procedure SetEnabled(Value: Boolean); virtual; + procedure SetInterval(Value: Cardinal); virtual; + procedure SetOnTimer(Value: TNotifyEvent); virtual; + procedure DoOnTimer; virtual; + procedure UpdateTimer; virtual; + procedure KillTimer; virtual; + procedure Loaded; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Enabled: Boolean read FEnabled write SetEnabled default True; + property Interval: Cardinal read FInterval write SetInterval default 1000; + property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer; + end; + +{ TLineInfo } + + PLineMetric = ^TLineMetric; + TLineMetric = record + Index: Integer; + Len: Integer; + end; + + TLineMetricInfo = class + protected + FLineMetrics: array of TLineMetric; + function GetCount: Integer; virtual; + function GetMetrics(Index: Integer): PLineMetric; virtual; + procedure SetCount(const Value: Integer); virtual; + public + constructor Create; + destructor Destroy; override; + procedure Clear; virtual; + property Count: Integer read GetCount write SetCount; + property Metrics[ind: Integer]: PLineMetric read GetMetrics; + end; + +{ TGuillotineBinPack } + + TFreeChoiceHeuristic = (BestAreaFit, BestShortSideFit, BestLongSideFit, WorstAreaFit, WorstShortSideFit, + WorstLongSideFit); + + TSplitMethodHeuristic = (ShorterLeftoverAxis, LongerLeftoverAxis, MinimizeArea, MaximizeArea, ShorterAxis, + LongerAxis); + + TGuillotineBinPack = class + private + FSize: TPoint; + FUsedRectangles: TList; + FFreeRectangles: TList; + FSupportsRectangleInversion: Boolean; + FUsedRectangleArea: Integer; + + function ScoreByHeuristic(const NodeSize: TPoint; const FreeRect: TRect; + const Heuristic: TFreeChoiceHeuristic): Integer; + + procedure FindPositionForNewNode(const NodeSize: TPoint; const Heuristic: TFreeChoiceHeuristic; + out NodeIndex: Integer; out NodeRect: TRect); + + procedure SplitFreeRectAlongAxis(const FreeRect, PlacedRect: TRect; const SplitHorizontal: Boolean); + procedure SplitFreeRectByHeuristic(const FreeRect, PlacedRect: TRect; const AMethod: TSplitMethodHeuristic); + + function GetOccupancy: Single; + public + constructor Create; overload; + constructor Create(const ASize: TPoint); overload; + destructor Destroy; override; + + procedure Init(const ASize: TPoint); + procedure MergeFreeList; + + function Insert(const NodeSize: TPoint; const Merge: Boolean = True; + const FreeChoice: TFreeChoiceHeuristic = TFreeChoiceHeuristic.BestAreaFit; + const SplitMethod: TSplitMethodHeuristic = TSplitMethodHeuristic.MinimizeArea): TRect; + + property Size: TPoint read FSize; + property Occupancy: Single read GetOccupancy; + property SupportsRectangleInversion: Boolean read FSupportsRectangleInversion write FSupportsRectangleInversion; + end; + + EGraphicsException = class(Exception); + ECannotDetermineDirect3DLevel = class(EGraphicsException); + ECannotCreateD3DDevice = class(EGraphicsException); + ECannotCreateD2DFactory = class(EGraphicsException); + ECannotCreateDWriteFactory = class(EGraphicsException); + ECannotCreateWICImagingFactory = class(EGraphicsException); + ECannotCreateRenderTarget = class(EGraphicsException); + ECannotCreateTexture = class(EGraphicsException); + ECannotCreateSwapChain = class(EGraphicsException); + ERetrieveSurfaceContents = class(EGraphicsException); + ECannotCreateRenderTargetView = class(EGraphicsException); + ECannotResizeBuffers = class(EGraphicsException); + EBitmapSizeTooBig = class(Exception); + EBitmapLoadingFailed = class(Exception); + EThumbnailLoadingFailed = class(Exception); + EBitmapSavingFailed = class(Exception); + EBitmapFormatUnsupported = class(Exception); + EBitmapIncorrectSize = class(Exception); + ERetrieveSurfaceDescription = class(Exception); + EAcquireBitmapAccess = class(Exception); + EVideoCaptureFault = class(Exception); + EInvalidCallingConditions = class(Exception); + EInvalidRenderingConditions = class(Exception); + ETextureSizeTooSmall = class(Exception); + ECannotAcquireBitmapAccess = class(Exception); + ECannotFindSuitablePixelFormat = class(Exception); + ECannotFindShader = class(Exception); + ECannotCreateDirect3D = class(Exception); + ECannotAcquireDXGIFactory = class(Exception); + ECannotAssociateWindowHandle = class(Exception); + ECannotRetrieveDisplayMode = class(Exception); + ECannotRetrieveBufferDesc = class(Exception); + ECannotCreateSamplerState = class(Exception); + ECannotRetrieveSurface = class(Exception); + ECannotUploadTexture = class(Exception); + ECannotActivateTexture = class(Exception); + ECannotAcquireTextureAccess = class(Exception); + ECannotCopyTextureResource = class(Exception); + ECannotActivateFrameBuffers = class(Exception); + ECannotCreateRenderBuffers = class(Exception); + ECannotRetrieveRenderBuffers = class(Exception); + ECannotActivateRenderBuffers = class(Exception); + ECannotBeginRenderingScene = class(Exception); + ECannotSyncDeviceBuffers = class(Exception); + ECannotUploadDeviceBuffers = class(Exception); + ECannotCreateDepthStencil = class(Exception); + ECannotRetrieveDepthStencil = class(Exception); + ECannotActivateDepthStencil = class(Exception); + ECannotResizeSwapChain = class(Exception); + ECannotActivateSwapChain = class(Exception); + ECannotCreateVertexShader = class(Exception); + ECannotCreatePixelShader = class(Exception); + ECannotCreateVertexLayout = class(Exception); + ECannotCreateVertexDeclaration = class(Exception); + ECannotCreateVertexBuffer = class(Exception); + ECannotCreateIndexBuffer = class(Exception); + EShaderCompilationError = class(Exception); + EProgramCompilationError = class(Exception); + ECannotFindShaderVariable = class(Exception); + ECannotActivateShaderProgram = class(Exception); + ECannotCreateOpenGLContext = class(Exception); + ECannotUpdateOpenGLContext = class(Exception); + ECannotDrawMeshObject = class(Exception); + EFeatureNotSupported = class(Exception); + EErrorCompressingStream = class(Exception); + EErrorDecompressingStream = class(Exception); + EErrorUnpackingShaderCode = class(Exception); + + ///Provider a persistent object for the designer. A different TPersistent can be routed into the + /// designer using this interface. This can be used to expose properties of non-controls in the + /// Object Inspector. + IPersistentProvider = interface + ['{B0B03758-A2F5-49B9-9A39-C2C2405B2EAD}'] + ///Return the provided persistent + function GetPersistent: TPersistent; + end; + + ///Shim is a representative of a visual non-control object in the Designer. The shim needs to implement + /// this interface in order to let the Designer know about its bounding rectangles. + /// + IPersistentShim = interface + ['{B6F815C7-BFD1-489D-A661-0CD4639EC920}'] + ///Return bounding rectangle of shim. + function GetBoundsRect: TRect; + end; + + ///Extension of TPersistent directly exposed to the Designer. + IDesignablePersistent = interface + ['{4A731994-9060-4F3C-92D7-C123B04601D4}'] + ///GetDesignParent should return a TPersistent known to the designer, e.g. its parent TControl. + function GetDesignParent: TPersistent; + ///Bounding rectangle representing this TPersistent in the designer + function GetBoundsRect: TRect; + /// + /// Bind this persistent with its shim, thus enabling GetBoundsRect without using the host. + /// Example: TItemAppearanceProperties as IDesignablePersistent are bound to the TListItemShim + /// Their counterpart FmxReg.TListViewObjectsProperties are bound to the same TListItemShim + /// + procedure Bind(AShim: IPersistentShim); + /// + /// Unbind this persistent. The implementation would normally clear its reference to IPersistentShim. + /// + procedure Unbind; + ///True if this TPersistent is currently in Design mode and wants the Designer to create + ///IItem for itself. + function BeingDesigned: Boolean; + end; + + ///Interface for TPersistent to receive bounding rectangle changes from the Designer. + IMovablePersistent = interface + ['{A86F9221-09E9-40A7-AF0E-5C3EB859C297}'] + /// Set bounds rectangle. + procedure SetBoundsRect(const AValue: TRect); + end; + + ///Interface that allows binding a TPersistent with a TreeView Sprig in StructureView + ISpriggedPersistent = interface + ['{0F1D325A-8082-4DEA-8ABF-56A359A218A4}'] + /// Set link to a TreeView sprig specified by APersistent. nil to break the link. + procedure SetSprig(const APersistent: TPersistent); + /// Get link to a TreeView sprig. Returns nil if link does not exist. + function GetSprig: TPersistent; + end; + + +{ Pixel Formats } + +function PixelToFloat4(Input: Pointer; InputFormat: TPixelFormat): TAlphaColorF; +procedure Float4ToPixel(const Input: TAlphaColorF; Output: Pointer; OutputFormat: TPixelFormat); + +function PixelToAlphaColor(Input: Pointer; InputFormat: TPixelFormat): TAlphaColor; +procedure AlphaColorToPixel(Input: TAlphaColor; Output: Pointer; OutputFormat: TPixelFormat); + +procedure ScanlineToAlphaColor(Input: Pointer; Output: PAlphaColor; PixelCount: Integer; InputFormat: TPixelFormat); +procedure AlphaColorToScanline(Input: PAlphaColor; Output: Pointer; PixelCount: Integer; OutputFormat: TPixelFormat); +procedure ChangePixelFormat(const AInput: Pointer; const AOutput: Pointer; const APixelCount: Integer; + const AInputFormat, AOutputFormat: TPixelFormat); + +function PixelFormatToString(Format: TPixelFormat): string; +function FindClosestPixelFormat(Format: TPixelFormat; const FormatList: TPixelFormatList): TPixelFormat; + +{ Resources } + +type + TCustomFindStyleResource = function(const AStyleLookup: string; const Clone: Boolean = False): TFmxObject of object; + +procedure AddCustomFindStyleResource(const ACustomProc: TCustomFindStyleResource); +procedure RemoveCustomFindStyleResource(const ACustomProc: TCustomFindStyleResource); + +procedure AddResource(const AObject: TFmxObject); +procedure RemoveResource(const AObject: TFmxObject); +function FindStyleResource(const AStyleLookup: string; const Clone: Boolean = False): TFmxObject; + +{ Lang } + +procedure LoadLangFromFile(const AFileName: string); +procedure LoadLangFromStrings(const AStr: TStrings); +procedure ResetLang; + +{ Align } + +procedure ArrangeControl(const Control: IAlignableObject; AAlign: TAlignLayout; const AParentWidth, AParentHeight: Single; + const ALastWidth, ALastHeight: Single; var R: TRectF); + +procedure AlignObjects(const AParent: TFmxObject; APadding: TBounds; AParentWidth, AParentHeight: Single; + var ALastWidth, ALastHeight: Single; var ADisableAlign: Boolean); + +procedure RecalcAnchorRules(const Parent : TFmxObject; Anchors : TAnchors; const BoundsRect : TRectF; + var AOriginalParentSize:TPointF; var AAnchorOrigin:TPointF; var AAnchorRules:TPointF); +procedure RecalcControlOriginalParentSize(const Parent: TFmxObject; ComponentState : TComponentState; + const Anchoring: Boolean; var AOriginalParentSize : TPointF); + +type + TCustomTranslateProc = function(const AText: string): string; + +var + CustomTranslateProc: TCustomTranslateProc; + +{ This function use to collect string which can be translated. Just place this function at Application start. } + +procedure CollectLangStart; +procedure CollectLangFinish; +{ This function return Strings with collected text } +function CollectLangStrings: TStrings; + +function Translate(const AText: string): string; +function TranslateText(const AText: string): string; + +{ Four 2D corners describing arbitrary rectangle. } + +function CornersF(Left, Top, Width, Height: Single): TCornersF; overload; +function CornersF(const Pt1, Pt2, Pt3, Pt4: TPointF): TCornersF; overload; +function CornersF(const Rect: TRect): TCornersF; overload; +function CornersF(const Rect: TRectF): TCornersF; overload; + +{ Helper functions } + +function IsHandleValid(Hnd: TFmxHandle): Boolean; + +procedure RegisterFmxClasses(const RegClasses: array of TPersistentClass); overload; +procedure RegisterFmxClasses(const RegClasses: array of TPersistentClass; + const GroupClasses: array of TPersistentClass); overload; + +var + AnchorAlign: array [TAlignLayout] of TAnchors = ( + { TAlignLayout.None } + [TAnchorKind.akLeft, + TAnchorKind.akTop], + + { TAlignLayout.Top } + [TAnchorKind.akLeft, + TAnchorKind.akTop, + TAnchorKind.akRight], + + { TAlignLayout.Left } + [TAnchorKind.akLeft, + TAnchorKind.akTop, + TAnchorKind.akBottom], + + { TAlignLayout.Right } + [TAnchorKind.akRight, + TAnchorKind.akTop, + TAnchorKind.akBottom], + + { TAlignLayout.Bottom } + [TAnchorKind.akLeft, + TAnchorKind.akRight, + TAnchorKind.akBottom], + + { TAlignLayout.MostTop } + [TAnchorKind.akLeft, + TAnchorKind.akTop, + TAnchorKind.akRight], + + { TAlignLayout.MostBottom } + [TAnchorKind.akLeft, + TAnchorKind.akRight, + TAnchorKind.akBottom], + + { TAlignLayout.MostLeft } + [TAnchorKind.akLeft, + TAnchorKind.akTop, + TAnchorKind.akBottom], + + { TAlignLayout.MostRight } + [TAnchorKind.akRight, + TAnchorKind.akTop, + TAnchorKind.akBottom], + + { TAlignLayout.Client } + [TAnchorKind.akLeft, + TAnchorKind.akTop, + TAnchorKind.akRight, + TAnchorKind.akBottom], + + { TAlignLayout.Contents } + [TAnchorKind.akLeft, + TAnchorKind.akTop, + TAnchorKind.akRight, + TAnchorKind.akBottom], + + { TAlignLayout.Center } + [], + + { TAlignLayout.VertCenter } + [TAnchorKind.akLeft, + TAnchorKind.akRight], + + { TAlignLayout.HorzCenter } + [TAnchorKind.akTop, + TAnchorKind.akBottom], + + { vaHorizintal } + [TAnchorKind.akLeft, + TAnchorKind.akRight], + + { TAlignLayout.Vertical } + [TAnchorKind.akTop, + TAnchorKind.akBottom], + + { TAlignLayout.Scale } + [TAnchorKind.akLeft, + TAnchorKind.akTop, + TAnchorKind.akRight, + TAnchorKind.akBottom], + + { TAlignLayout.Fit } + [TAnchorKind.akLeft, + TAnchorKind.akTop, + TAnchorKind.akRight, + TAnchorKind.akBottom], + + { TAlignLayout.FitLeft } + [TAnchorKind.akLeft, + TAnchorKind.akTop, + TAnchorKind.akRight, + TAnchorKind.akBottom], + + { TAlignLayout.FitRight } + [TAnchorKind.akLeft, + TAnchorKind.akTop, + TAnchorKind.akRight, + TAnchorKind.akBottom] + ); + +{ Debugging } +type + /// Provides static methods for debug messages. + Log = class abstract + strict private + class var FLogger: IInterface; + class function GetLogger: IInterface; static; + protected + /// Referece to the logger service. + class property Logger: IInterface read GetLogger; + public type + /// A conversion function used to convert array elements in ArrayToString + TToStringFunc = reference to function(const AObject: TObject): string; + /// A timestamp of specific point in procedure execution. TLogMarks are used by Log.Trace. + /// See Trace and TLogToken. + TLogMark = record + /// A short message + Msg: string; + /// Timestamp + Time: TDateTime; + end; + /// A token received in Trace callback. Token can be used to mark specific points in time during + /// procedure execution. Use Mark(Message) to mark specific moment in time. Marks will be printed + /// in sequence with their elapsed times in Trace output. + TLogToken = class + private + FMarks: TList; + function GetMarkAt(const Index: Integer): TLogMark; + function GetCount: Integer; + protected + constructor Create; + public + /// Mark time during timed execution of a procedure. + procedure Mark(const Msg: string); + /// Get a mark at Index. + property MarkAt[const Index: Integer]: TLogMark read GetMarkAt; + /// Count of accumulated Marks. + property Count: Integer read GetCount; + end; + public + /// Log a debug message. Same arguments as Format. + class procedure d(const Fmt: string; const Args: array of const); overload; + /// Log a simple debug message. + class procedure d(const Msg: string); overload; inline; + /// Log a debug message with Tag, object data of Instance, Method that invokes the logger and message Msg. + /// + class procedure d(const Tag: string; const Instance: TObject; const Method, Msg: string); overload; inline; + /// Log a debug message with Tag, object data of Instance and a message Msg + class procedure d(const Tag: string; const Instance: TObject; const Msg: string); overload; inline; + /// Log a time stamp with message Msg + class procedure TimeStamp(const Msg: string); overload; + /// Perform a timed execution of Func and print execution times, return function result. + /// Proc receives a parameter TLogToken which can be used to mark specific points where timestamps should be taken + /// in addition to complete procedure time. + class function Trace(const Tag: string; const Func: TFunc; + const Threshold: Integer = -1): TResult; overload; + /// A convenience variant of Trace<TResult> when token is not needed. + class function Trace(const Tag: string; const Func: TFunc; const Threshold: Integer = -1): TResult; overload; + /// A convenience variant of Trace<TResult> for procedures. + class procedure Trace(const Tag: string; const Proc: TProc; const Threshold: Integer = -1); overload; + /// A convenience variant of Trace<TResult> for procedures when token is not needed. + class procedure Trace(const Tag: string; const Proc: TProc; const Threshold: Integer = -1); overload; + /// Get a basic string representation of an object, consisting of ClassName and its pointer + class function ObjToString(const Instance: TObject): string; + /// Get a string representation of array using MakeStr function to convert individual elements. + class function ArrayToString(const AArray: TEnumerable; const MakeStr: TToStringFunc): string; overload; + /// Get a string representation of array using TObject.ToString to convert individual elements. + class function ArrayToString(const AArray: TEnumerable): string; overload; + /// Dump complete TFmxObject with all its children. + class procedure DumpFmxObject(const AObject: TFmxObject; const Nest: Integer = 0); + end; + +/// Removes the ampersand '&' characters of the Text string. +function DelAmp(const AText: string): string; + + +type + TEnumerableFilter = class(TEnumerable) + private + FBaseEnum: TEnumerable; + FSelfDestruct: Boolean; + FPredicate: TPredicate; + protected + function DoGetEnumerator: TEnumerator; override; + public + constructor Create(const FullEnum: TEnumerable; SelfDestruct: Boolean = False; const Pred: TPredicate = nil); + class function Filter(const Src: TEnumerable; const Predicate: TPredicate = nil): TEnumerableFilter; + + type + TFilterEnumerator = class(TEnumerator) + private + FCleanup: TEnumerableFilter; + FRawEnumerator: TEnumerator; + FCurrent: T; + FPredicate: TPredicate; + function GetCurrent: T; + protected + function DoGetCurrent: T; override; + function DoMoveNext: Boolean; override; + public + constructor Create(const Enumerable: TEnumerable; const Cleanup: TEnumerableFilter; + const Pred: TPredicate); + destructor Destroy; override; + property Current: T read GetCurrent; + function MoveNext: Boolean; + end; + end; + + TIdleMessage = class(System.Messaging.TMessage) + end; + + /// Information about display. + TDisplay = record + /// The unique id of display. + Id: NativeUInt; + /// Index is the same as MonitorNum. Added for the sake of brevity. + Index: Integer; + /// Is this the main display in the system? + Primary: Boolean; + /// Screen size (dp) without taking into account the taskbar and other decorative elements. + /// The Windows platform doesn't allow to determinate logical position of screen definitely. + Bounds: TRectF; + /// Screen size (px) without taking into account the taskbar and other decorative elements. + PhysicalBounds: TRect; + /// Screen size (dp) minus the taskbar, and other decorative items. + Workarea: TRectF; + /// Screen size (px) minus the taskbar, and other decorative items. + PhysicalWorkarea: TRect; + /// Display scale. + Scale: Single; + /// It is the same as Bounds. + function BoundsRect: TRectF; + /// It is the same as Workarea. + function WorkareaRect: TRectF; + + constructor Create(const AIndex: Integer; const APrimary: Boolean; const ABounds, AWorkArea: TRectF); + end; + +/// Registers the flasher class for the TCustomCaret object specified +/// in the CaretClass parameter. +procedure RegisterFlasherClass(const FlasherClass: TFmxObjectClass; const CaretClass: TCaretClass); +/// Returns the class of a flasher registered for the TCustomCaret +/// object specified in the CaretClass parameter. +function FlasherClass(const CaretClass: TCaretClass): TFmxObjectClass; +/// Returns the flasher object registered for the TCustomCaret object +/// specified in the CaretClass parameter. +function Flasher(const CaretClass: TCaretClass): TFmxObject; +/// Checks whether a flasher is registered for the TCustomCaret object +/// specified in the CaretClass parameter. +function AssignedFlasher(const CaretClass: TCaretClass): boolean; + +type + TShowVirtualKeyboard = procedure (const Displayed: boolean; + const Caret: TCustomCaret; + var VirtualKeyboardState: TVirtualKeyboardStates); + +procedure RegisterShowVKProc(const ShowVirtualKeyboard: TShowVirtualKeyboard); + +var + SharedContext: TRttiContext; + ClonePropertiesCache: TDictionary>; + +type + TKeyKind = (Usual, Functional, Unknown); + +//== UNIT END: FMX.Types +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Controls.Model (from FMX.Controls.Model.pas) +//================================================================================================== + + +const + MM_BASE = $1600; + MM_GETDATA = MM_BASE + 1; + MM_DATA_CHANGED = MM_BASE + 2; + MM_USER = $1700; + +type + +{ TDataModel } + + /// Key-value pair where the key is a string and the value is an instance of TValue. Used for sending data + // to presentation layer. + TDataRecord = TPair; + + /// Class that contains a dictionary of key-value pairs and may be used as model by an instance of + /// TPresentedControl with supporting a sending a notification via messaging. + TDataModel = class(TMessageSender) + public type + TDataSource = TDictionary; + private + [Weak] FOwner: TComponent; + FDataSource: TDataSource; + function GetData(const Index: string): TValue; + procedure SetData(const Index: string; const Value: TValue); + procedure RemoveData(const Index: string); + protected + { IInterface } + function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall; + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + public + /// Allows to specify Owner + /// Invokes default constructor without params. + constructor Create(const AOwner: TComponent); overload; virtual; + /// Destroys existed DataSource + destructor Destroy; override; + public + /// Component that is responsible for destroying this data model once the data model is no longer + /// necessary. + property Owner: TComponent read FOwner; + /// Value on the data model for the specified key.Use it for sending any kind of data to + /// presentation layer without creating custom model class. + /// Automatically sends notifcation message with id MM_DATA_CHANGED to receiver with information + /// about key and value through using TDataRecord.When we request value from model, Model + /// sends request about it to presentation layer. If layer doesn't specify value (nil value), model gets value + /// from DataSourceIf value is nil, model will remove this key-value pair from DataSource + property Data[const Key: string]: TValue read GetData write SetData; + /// Dictionary of key-value pairs that are the data that the data model contains. Can be nil, if Model + /// doesn't have any datas. + property DataSource: TDataSource read FDataSource; + end; + + /// Class reference of TDataModel. + TDataModelClass = class of TDataModel; + +//== UNIT END: FMX.Controls.Model +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.AcceleratorKey (from FMX.AcceleratorKey.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + /// This is an interface that descendant classes must implement to in order to be a accelerator key + /// receiver. + IAcceleratorKeyReceiver = interface + ['{1C679082-65F2-4C54-A2C4-CD4C00E2C465}'] + /// True if the objects can trigger the action, False otherwise. + /// Even if an object can trigger an action because it is registered as an accelerator key receiver, it is + /// possible that the object may not want to react with the accelerator key event. For example, a submenu that is + /// hidden, or a tab page that is hidden. + function CanTriggerAcceleratorKey: Boolean; + /// This method is invoked to allow the object to do everything it wants as a response to accelerator key + /// The default behaviour is to focus the control. + procedure TriggerAcceleratorKey; + /// Returns the character key which serves as the keyboard accelerator for this receiver. + function GetAcceleratorChar: Char; + /// Returns the index of the accelerator character within the text string of the receiver. This information + /// is typically used to highlight the accelerator character. + function GetAcceleratorCharIndex: Integer; + end; + + /// Platform service to provide support for accelerator keys for quick keyboard access to controls. + IFMXAcceleratorKeyRegistryService = interface + ['{0D06B7CC-FAF2-45F8-B7AA-D4B84FD384B7}'] + /// This method registers an object as a Receiver of accelerator keys for a given root container (typically + /// a form). If the object is already added, this procedure has no effect. + procedure RegisterReceiver(const ARoot: IRoot; const AReceiver: IAcceleratorKeyReceiver); + /// Removes the object from the database for a particular root container (typically a form). If the object + /// is not in the database, it has no effect. + procedure UnregisterReceiver(const ARoot: IRoot; const AReceiver: IAcceleratorKeyReceiver); + /// Removes the entire registry of accelerator keys for a given root container (form). + procedure RemoveRegistry(const ARoot: IRoot); + /// Emits the accelerator key to the given root container (typically a form). If the root container has a + /// control which can receive the accelerator key, then the accelerator action is triggered. + function EmitAcceleratorKey(const ARoot: IRoot; const AChar: Char): Boolean; + /// This method unregisters the receiver from the old root, and registers the receiver into the new root. + /// To be registered or unregistered, any root must support the IAcceleratorKeyRegistry interface. + procedure ChangeReceiverRoot(const AReceiver: IAcceleratorKeyReceiver; const AOldRoot, ANewRoot: IRoot); + /// Processes the AText parameter string to identify any embedded accelerator key markers (the ampersand + /// symbol). If found, Key and KeyIndex will be returned with the accelerator character and the + /// position at which is was found. If no accelerator key is indicated in the text string, Key will be a null + /// character and KeyIndex will be -1. + procedure ExtractAcceleratorKey(const AText: string; out Key: Char; out KeyIndex: Integer); + end; + +//== UNIT END: FMX.AcceleratorKey +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Styles (from FMX.Styles.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + TStyleSignature = array [0..12] of Byte; + +const + // Sign is "FMX_STYLE 2.0" + FireMonkeyStyleSign: TStyleSignature = + (Byte('F'), Byte('M'), Byte('X'), Byte('_'), + Byte('S'), Byte('T'), Byte('Y'), Byte('L'), Byte('E'), Byte(' '), + Byte('2'), Byte('.'), Byte('0')); + // Sign is "FMX_STYLE 2.5" + FireMonkey25StyleSign: TStyleSignature = + (Byte('F'), Byte('M'), Byte('X'), Byte('_'), + Byte('S'), Byte('T'), Byte('Y'), Byte('L'), Byte('E'), Byte(' '), + Byte('2'), Byte('.'), Byte('5')); + +type + EStyleException = class(Exception); + + TStyleFormat = (Indexed, Binary, Text); + + TStyleDescription = class(TFmxObject) + private type + TProperty = (Author, AuthorEMail, PlatformTarget, MobilePlatform, Title, Version); + private const + /// List of published properties used in streaming + Properties: array [TProperty] of string = ('Author', 'AuthorEMail', 'PlatformTarget', 'MobilePlatform', 'Title', + 'Version'); + public const + /// Target's names that used in style file + PlatformTargets: array [TOSPlatform] of string = ('[WINDOWS]', '[MACOS]', '[IOS7]', '[ANDROID]', '[LINUX]'); + /// Platform's names that used at framework + PlatformNames: array [TOSPlatform] of string = ('Windows', 'OSX', 'iOS', 'Android', 'Linux'); + private + FAuthor: string; + FVersion: string; + FTitle: string; + FAuthorEMail: string; + FPlatformTarget: string; + FMobilePlatform: Boolean; + FAuthorURL: string; + class function TryLoadFromStream(const Stream: TStream; var StyleDescription: TStyleDescription): Boolean; + protected + procedure DefineProperties(Filer: TFiler); override; + public + function Equals(Obj: TObject): Boolean; override; + /// Allows to check style for fitting for specified Platform + function SupportsPlatform(const APlatform: TOSPlatform): Boolean; + published + property Author: string read FAuthor write FAuthor; + property AuthorEMail: string read FAuthorEMail write FAuthorEMail; + property AuthorURL: string read FAuthorURL write FAuthorURL; + property PlatformTarget: string read FPlatformTarget write FPlatformTarget; + property MobilePlatform: Boolean read FMobilePlatform write FMobilePlatform; + property Title: string read FTitle write FTitle; + property Version: string read FVersion write FVersion; + end; + + TStyleTag = class(TFmxObject) + published + property Tag; + property TagFloat; + property TagString; + end; + + IBinaryStyleContainer = interface + ['{76589FDB-7430-4F7A-A993-44AB1664BCFD}'] + procedure ClearContainer; + procedure AddBinaryFromStream(const Name: string; const SourceStream: TStream; const Size: Int64); + /// Force to load all style's objects from binary stream. + procedure UnpackAllBinaries; + end; + + TSupportedPlatformHook = function (const PlatformTarget: string): Boolean; + + TStyleStreaming = class + private type + TIndexItem = record + Name: string; + Size: Int64; + end; + private class var + FDefaultContainerClass: TFmxObjectClass; + FSupportedPlatformHook: TSupportedPlatformHook; + private + class function ReadHeader(const AStream: TStream): TArray; + class function LoadFromIndexedStream(const AStream: TStream): TFmxObject; + class procedure SaveToIndexedStream(const Style: TFmxObject; const AStream: TStream); static; + class function IsSupportedPlatformTarget(const PlatformTarget: string): Boolean; static; + class function SameStyleDecription(const Style1, Style2: TFmxObject): Boolean; static; + class function SameObject(const Obj1, Obj2: TFmxObject): Boolean; static; + class function CompareSign(const Sign1, Sign2: TStyleSignature): Boolean; + class function TryLoadStyleDescriptionFromIndexedStream(const Stream: TStream; + var Description: TStyleDescription): Boolean; static; + public + class function DefaultIsSupportedPlatformTarget(const PlatformTarget: string): Boolean; static; + + class procedure SaveToStream(const Style: TFmxObject; const AStream: TStream; + const Format: TStyleFormat = TStyleFormat.Indexed); + + /// Try to parse styel file and read style description. Description object should be destroyed by caller. + class function TryLoadStyleDescription(const Stream: TStream; var Description: TStyleDescription): Boolean; + + class function LoadFromFile(const FileName: string): TFmxObject; + class function LoadFromStream(const AStream: TStream): TFmxObject; + class function LoadFromResource(Instance: HINST; const ResourceName: string; ResourceType: PChar): TFmxObject; + + class function CanLoadFromFile(const FileName: string): Boolean; + class function CanLoadFromStream(const AStream: TStream): Boolean; + class function CanLoadFromResource(const ResourceName: string; ResourceType: PChar): Boolean; overload; + class function CanLoadFromResource(Instance: HINST; const ResourceName: string; ResourceType: PChar): Boolean; overload; + + class function SameStyle(const Style1, Style2: TFmxObject): Boolean; static; + + class procedure SetDefaultContainerClass(const AClass: TFmxObjectClass); + class procedure SetSupportedPlatformHook(const AHook: TSupportedPlatformHook); + end; + + /// This procedure return correct resource name if more than one is registered for platform. + TPlatformStyleSelectionProc = function (const APlatform: TOSPlatform): string; + /// Anonymous method that EnumStyleResources calls in order to + /// enumerate all the registered style resources. + TStyleResourceEnumProc = reference to procedure (const AResourceName: string; const APlatform: TOSPlatform); + + TStyleManager = class sealed + strict private type + TStyleManagerNotification = class(TFmxObject) + protected + procedure FreeNotification(AObject: TObject); override; + end; + strict private + class var FStyleManagerNotification: TStyleManagerNotification; + class var FPlatformResources: TDictionary; + class var FSelections: TDictionary; + class var FStyleResources: TDictionary; + class function FindDefaultStyleResource(const OSPlatform: TOSPlatform): string; static; + class function StyleResourceForContext(const Context: TFmxObject): string; static; + class function StyleManagerNotification: TStyleManagerNotification; + public + class procedure RemoveStyleFromGlobalPool(const Style: TFmxObject); static; + class procedure UpdateScenes; static; + + /// Enumarate all registered style resources. + class procedure EnumStyleResources(Proc: TStyleResourceEnumProc); + /// Return if exits in cache or load style from resource. + class function GetStyleResource(const ResourceName: string): TFmxObject; + + /// Register style resource for specified platform. + class procedure RegisterPlatformStyleResource(const APlatform: TOSPlatform; const ResourceName: string); + /// Register selection procedure for specified platform. + class procedure RegisterPlatformStyleSelection(const APlatform: TOSPlatform; const ASelection: TPlatformStyleSelectionProc); + + class function ActiveStyle(const Context: TFmxObject): TFmxObject; static; + /// Returns active style for IScene. + class function ActiveStyleForScene(const AScene: IInterface): TFmxObject; static; + + class procedure SetStyle(const Style: TFmxObject); overload; + class procedure SetStyle(const Context: TFmxObject; const Style: TFmxObject); overload; + class function SetStyleFromFile(const FileName: string): Boolean; overload; + class function SetStyleFromFile(const Context: TFmxObject; const FileName: string): Boolean; overload; + /// Loads from resource and sets the style specified by name as the active style, without raising an exception. + class function TrySetStyleFromResource(const ResourceName: string): Boolean; + + class procedure UnInitialize; + + { Style description } + + /// Searches TStyleDescription object among all the heirs. + class function FindStyleDescriptor(const AObject: TFmxObject): TStyleDescription; + // Searches TStyleDescription in a current style of specified control AObject. + class function GetStyleDescriptionForControl(const AObject: TFmxObject): TStyleDescription; + end; + +//== UNIT END: FMX.Styles +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.VirtualKeyboard (from FMX.VirtualKeyboard.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + IFMXVirtualKeyboardService = interface(IInterface) + ['{BB6F6668-C582-42E4-A766-863C1B9139D2}'] + function ShowVirtualKeyboard(const AControl: TFmxObject): Boolean; + function HideVirtualKeyboard: Boolean; + procedure SetTransientState(Value: Boolean); + /// + /// Returns the current state of the virtual keyboard (onscreen keyboard). + /// + function GetVirtualKeyboardState: TVirtualKeyboardStates; + property VirtualKeyboardState: TVirtualKeyboardStates read GetVirtualKeyboardState; + end; + + TVirtualKeyboardToolButton = class; + +{ Additional toolbar above virtual keyboard in iOS } + IFMXVirtualKeyboardToolbarService = interface(IInterface) + ['{CE7795C2-4399-4094-BF58-2E69CEA71D57}'] + procedure SetToolbarEnabled(const Value: Boolean); + function IsToolbarEnabled: Boolean; + procedure SetHideKeyboardButtonVisibility(const Value: Boolean); + function IsHideKeyboardButtonVisible: Boolean; + // + function AddButton(const Title: string; ExecuteEvent: TNotifyEvent): TVirtualKeyboardToolButton; + procedure DeleteButton(const Index: Integer); + function ButtonsCount: Integer; + function GetButtonByIndex(const Index: Integer): TVirtualKeyboardToolButton; + procedure ClearButtons; + end; + + TVirtualKeyboardToolButton = class + private + FTitle: string; + FOnExecute: TNotifyEvent; + procedure SetTitle(const Value: string); + protected + procedure DoChanged; virtual; abstract; + public + procedure DoExecute; + // + property Title: string read FTitle write SetTitle; + property OnExecute: TNotifyEvent read FOnExecute write FOnExecute; + end; + +//== UNIT END: FMX.VirtualKeyboard +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.InertialMovement (from FMX.InertialMovement.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +const + DefaultStorageTime = 0.15; + DefaultIntervalOfAni = 10; + DecelerationRateNormal = 1.95; + DecelerationRateFast = 9.5; + DefaultElasticity = 100; + DefaultMinVelocity = 10; + DefaultMaxVelocity = 5000; + DefaultDeadZone = 8; + +type + +{$REGION 'TPointD'} + TPointD = record + X: Double; + Y: Double; + public + constructor Create(const P: TPointD); overload; + constructor Create(const P: TPointF); overload; + constructor Create(const P: TPoint); overload; + constructor Create(const X, Y: Double); overload; + procedure SetLocation(const P: TPointD); + class operator Equal(const Lhs, Rhs: TPointD): Boolean; + class operator NotEqual(const Lhs, Rhs: TPointD): Boolean; overload; + class operator Add(const Lhs, Rhs: TPointD): TPointD; + class operator Subtract(const Lhs, Rhs: TPointD): TPointD; + class operator Implicit(const APointF: TPointF): TPointD; + function Distance(const P2: TPointD): Double; + function Abs: Double; + procedure Offset(const DX, DY: Double); + end; + +{$ENDREGION} + +{$REGION 'TRectD'} + + TRectD = record + Left, Top, Right, Bottom: Double; + private + function GetHeight: Double; + function GetWidth: Double; + procedure SetHeight(const Value: Double); + procedure SetWidth(const Value: Double); + function GetTopLeft: TPointD; + procedure SetTopLeft(const P: TPointD); + function GetBottomRight: TPointD; + procedure SetBottomRight(const P: TPointD); + public + constructor Create(const Origin: TPointD); overload; + // empty rect at given origin + constructor Create(const Left, Top, Right, Bottom: Double); overload; + // at x, y with width and height + // operator overloads + class operator Equal(const Lhs, Rhs: TRectD): Boolean; + class operator NotEqual(const Lhs, Rhs: TRectD): Boolean; + class function Empty: TRectD; inline; static; + // changing the width is always relative to Left; + property Width: Double read GetWidth write SetWidth; + // changing the Height is always relative to Top + property Height: Double read GetHeight write SetHeight; + procedure Inflate(const DX, DY: Double); + procedure Offset(const DX, DY: Double); + property TopLeft: TPointD read GetTopLeft write SetTopLeft; + property BottomRight: TPointD read GetBottomRight write SetBottomRight; + end; +{$ENDREGION} + +{$REGION 'Types and methods for working with the smooth movement'} + + TAniCalculations = class(TPersistent) + public type + TTargetType = (Achieved, Max, Min, Other); + TTarget = record + TargetType: TTargetType; + Point: TPointD; + end; + private type + TPointTime = record + Point: TPointD; + Time: TDateTime; + end; + private + FEnabled: Boolean; + FInTimerProc: Boolean; + FTouchTracking: TTouchTracking; + FTimerHandle: TFmxHandle; + FInterval: Word; + FCurrentVelocity: TPointD; + FUpVelocity: TPointD; + FUpPosition: TPointD; + FUpDownTime: TDateTime; + FLastTimeCalc: TDateTime; + [Weak] FOwner: TPersistent; + FPlatformTimer: IFMXTimerService; + FPointTime: TList; + + FTargets: array of TTarget; + FMinTarget: TTarget; + FMaxTarget: TTarget; + FTarget: TTarget; + FLastTarget: TTarget; + FCancelTargetX: Boolean; + FCancelTargetY: Boolean; + + FOnStart: TNotifyEvent; + FOnTimer: TNotifyEvent; + FOnStop: TNotifyEvent; + FDown: Boolean; + FAnimation: Boolean; + FViewportPosition: TPointD; + FLowChanged: Boolean; + FLastTimeChanged: TDateTime; + FDownPoint: TPointD; + FDownPosition: TPointD; + FUpdateTimerCount: Integer; + FElasticity: Double; + FDecelerationRate: Double; + FStorageTime: Double; + FInDoStart: Boolean; + FInDoStop: Boolean; + FMoved: Boolean; + FStarted: Boolean; + FBoundsAnimation: Boolean; + FAutoShowing: Boolean; + FOpacity: Single; + FShown: Boolean; + FMouseTarget: TTarget; + FAveraging: Boolean; + FMinVelocity: Integer; + FMaxVelocity: Integer; + FDeadZone: Integer; + FUpdateCount: Integer; + FElasticityFactor: TPoint; + procedure StartTimer; + procedure StopTimer; + procedure TimerProc; + procedure Clear(T: TDateTime = 0); + procedure UpdateTimer; + procedure SetInterval(const Value: Word); + procedure SetEnabled(const Value: Boolean); + procedure SetTouchTracking(const Value: TTouchTracking); + procedure InternalCalc(DeltaTime: Double); + procedure SetAnimation(const Value: Boolean); + procedure SetDown(const Value: Boolean); + function FindTarget(var Target: TTarget): Boolean; + function GetTargetCount: Integer; + function DecelerationRateStored: Boolean; + function ElasticityStored: Boolean; + function StorageTimeStored: Boolean; + procedure CalcVelocity(const Time: TDateTime = 0); + procedure InternalStart; + procedure InternalTerminated; + procedure SetBoundsAnimation(const Value: Boolean); + procedure UpdateViewportPositionByBounds; + procedure SetAutoShowing(const Value: Boolean); + procedure SetShown(const Value: Boolean); + function GetViewportPositionF: TPointF; + procedure SetViewportPositionF(const Value: TPointF); + procedure SetMouseTarget(Value: TTarget); + function GetInternalTouchTracking: TTouchTracking; + function GetPositions(const Index: Integer): TPointD; + function GetPositionCount: Integer; + function GetPositionTimes(const Index: Integer): TDateTime; + function PosToView(const APosition: TPointD): TPointD; + procedure SetViewportPosition(const Value: TPointD); + function GetOpacity: Single; + function GetLowVelocity: Boolean; + function AddPointTime(const X, Y: Double; + const Time: TDateTime = 0): TPointTime; + procedure InternalChanged; + procedure UpdateTarget; + function DoStopScrolling(CurrentTime: TDateTime = 0): Boolean; + protected + function IsSmall(const P: TPointD; + const Epsilon: Double): Boolean; overload; + function IsSmall(const P: TPointD): Boolean; overload; + function GetOwner: TPersistent; override; + procedure DoStart; virtual; + procedure DoChanged; virtual; + procedure DoStop; virtual; + procedure DoCalc(const DeltaTime: Double; + var NewPoint, NewVelocity: TPointD; + var Done: Boolean); virtual; + property Enabled: Boolean read FEnabled write SetEnabled; + property Shown: Boolean read FShown write SetShown; + property MouseTarget: TTarget read FMouseTarget write SetMouseTarget; + property InternalTouchTracking: TTouchTracking read GetInternalTouchTracking; + property Positions[const index: Integer]: TPointD read GetPositions; + property PositionTimes[const index: Integer]: TDateTime read GetPositionTimes; + property PositionCount: Integer read GetPositionCount; + property UpVelocity: TPointD read FUpVelocity; + property UpPosition: TPointD read FUpPosition; + property UpDownTime: TDateTime read FUpDownTime; + property MinTarget: TTarget read FMinTarget; + property MaxTarget: TTarget read FMaxTarget; + property Target: TTarget read FTarget; + property MinVelocity: Integer read FMinVelocity write FMinVelocity default DefaultMinVelocity; + property MaxVelocity: Integer read FMaxVelocity write FMaxVelocity default DefaultMaxVelocity; + property DeadZone: Integer read FDeadZone write FDeadZone default DefaultDeadZone; + property CancelTargetX: Boolean read FCancelTargetX; + property CancelTargetY: Boolean read FCancelTargetY; + public + constructor Create(AOwner: TPersistent); virtual; + destructor Destroy; override; + procedure AfterConstruction; override; + procedure Assign(Source: TPersistent); override; + + procedure MouseDown(X, Y: Double); + procedure MouseMove(X, Y: Double); + procedure MouseLeave; + procedure MouseUp(X, Y: Double); + procedure MouseWheel(X, Y: Double); + + property Animation: Boolean read FAnimation + write SetAnimation default False; + + property AutoShowing: Boolean read FAutoShowing + write SetAutoShowing default False; + + property Averaging: Boolean read FAveraging + write FAveraging default False; + + property BoundsAnimation: Boolean read FBoundsAnimation + write SetBoundsAnimation default True; + + property Interval: Word read FInterval + write SetInterval default DefaultIntervalOfAni; + + property TouchTracking: TTouchTracking read FTouchTracking + write SetTouchTracking + default [ttVertical, ttHorizontal]; + property TargetCount: Integer read GetTargetCount; + procedure SetTargets(const ATargets: array of TTarget); + procedure GetTargets(var ATargets: array of TTarget); + procedure UpdatePosImmediately(const Force: Boolean = False); + + property DecelerationRate: Double read FDecelerationRate + write FDecelerationRate + stored DecelerationRateStored nodefault; + property Elasticity: Double read FElasticity + write FElasticity + stored ElasticityStored nodefault; + property StorageTime: Double read FStorageTime + write FStorageTime + stored StorageTimeStored nodefault; + property CurrentVelocity: TPointD read FCurrentVelocity; + property ViewportPosition: TPointD read FViewportPosition + write SetViewportPosition; + property ViewportPositionF: TPointF read GetViewportPositionF + write SetViewportPositionF; + property LastTimeCalc: TDateTime read FLastTimeCalc; + property Down: Boolean read FDown write SetDown; + property Opacity: Single read GetOpacity; + property InTimerProc: Boolean read FInTimerProc; + property Moved: Boolean read FMoved; + property LowVelocity: Boolean read GetLowVelocity; + procedure BeginUpdate; + procedure EndUpdate; + property UpdateCount: Integer read FUpdateCount; + + property OnStart: TNotifyEvent read FOnStart write FOnStart; + property OnChanged: TNotifyEvent read FOnTimer write FOnTimer; + property OnStop: TNotifyEvent read FOnStop write FOnStop; + end; +{$ENDREGION} + +//== UNIT END: FMX.InertialMovement +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Surfaces (from FMX.Surfaces.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + TBitmapSurface = class(TPersistent) + private + FBits: Pointer; + FPitch: Integer; + FWidth: Integer; + FHeight: Integer; + FPixelFormat: TPixelFormat; + FBytesPerPixel: Integer; + + function GetScanline(const Index: Integer): Pointer; + function GetPixel(const X, Y: Integer): TAlphaColor; + procedure SetPixel(const X, Y: Integer; const Value: TAlphaColor); + + class procedure SwapColors(var Color1, Color2: TAlphaColor); overload; static; inline; + procedure SwapColors(const X1, Y1, X2, Y2: Integer); overload; inline; + function GetRect: TRect; + protected + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create; + destructor Destroy; override; + + function GetPixelAddr(const X, Y: Integer): Pointer; + procedure Clear(const Color: TAlphaColor); + procedure SetSize(const AWidth, AHeight: Integer; const APixelFormat: TPixelFormat = TPixelFormat.None); + procedure StretchFrom(const Source: TBitmapSurface; const NewWidth, NewHeight: Integer; + APixelFormat: TPixelFormat = TPixelFormat.None); + procedure Mirror; + procedure Flip; + /// Rotates bitmap on 90 degress by clockwise + procedure Rotate90; + /// Rotates bitmap on 180 degress by clockwise + procedure Rotate180; + /// Rotates bitmap on 270 degress by clockwise + procedure Rotate270; + + property Bits: Pointer read FBits; + property Pitch: Integer read FPitch; + property Width: Integer read FWidth; + property Height: Integer read FHeight; + property Rect: TRect read GetRect; + property PixelFormat: TPixelFormat read FPixelFormat; + property BytesPerPixel: Integer read FBytesPerPixel; + property Scanline[const Index: Integer]: Pointer read GetScanline; + property Pixels[const X, Y: Integer]: TAlphaColor read GetPixel write SetPixel; + end; + + TMipmapSurface = class(TBitmapSurface) + private type + TMipmapSurfaces = TObjectList; + private + FChildMipmaps: TMipmapSurfaces; + + function GetMipCount: Integer; + function GetMip(const MipIndex: Integer): TMipmapSurface; + protected + procedure StretchHalfFrom(const Source: TMipmapSurface); + public + constructor Create; + destructor Destroy; override; + + procedure GenerateMips; + procedure ClearMips; + + property MipCount: Integer read GetMipCount; + property Mip[const MipIndex: Integer]: TMipmapSurface read GetMip; + end; + +//== UNIT END: FMX.Surfaces +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Graphics (from FMX.Graphics.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + TCanvas = class; + TCanvasClass = class of TCanvas; + TBitmap = class; + TBitmapImage = class; + TTextSettings = class; + +{ TGradientPoint } + + TGradientPoint = class(TCollectionItem) + private + FColor: TAlphaColor; + FOffset: Single; + procedure SetColor(const Value: TAlphaColor); + procedure SetOffset(const Value: Single); + public + procedure Assign(Source: TPersistent); override; + property IntColor: TAlphaColor read FColor write FColor; + published + property Color: TAlphaColor read FColor write SetColor; + property Offset: Single read FOffset write SetOffset nodefault; + end; + +{ TGradientPoints } + + TGradientPoints = class(TCollection) + private + function GetPoint(Index: Integer): TGradientPoint; + protected + procedure Update(Item: TCollectionItem); override; + public + property Points[Index: Integer]: TGradientPoint read GetPoint; default; + end; + +{ TGradient } + + TGradientStyle = (Linear, Radial); + + TGradient = class(TPersistent) + private + FPoints: TGradientPoints; + FOnChanged: TNotifyEvent; + FStartPosition: TPosition; + FStopPosition: TPosition; + FStyle: TGradientStyle; + FRadialTransform: TTransform; + procedure SetStartPosition(const Value: TPosition); + procedure SetStopPosition(const Value: TPosition); + procedure PositionChanged(Sender: TObject); + procedure SetColor(const Value: TAlphaColor); + procedure SetColor1(const Value: TAlphaColor); + function IsLinearStored: Boolean; + procedure SetStyle(const Value: TGradientStyle); + function IsRadialStored: Boolean; + procedure SetRadialTransform(const Value: TTransform); + procedure SetPoints(const Value: TGradientPoints); + public + constructor Create; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + procedure Change; + procedure ApplyOpacity(const AOpacity: Single); + function InterpolateColor(Offset: Single): TAlphaColor; overload; + function InterpolateColor(X, Y: Single): TAlphaColor; overload; + function Equal(const AGradient: TGradient): Boolean; + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; + { fast access } + property Color: TAlphaColor write SetColor; + property Color1: TAlphaColor write SetColor1; + published + property Points: TGradientPoints read FPoints write SetPoints; + property Style: TGradientStyle read FStyle write SetStyle default TGradientStyle.Linear; + { linear } + property StartPosition: TPosition read FStartPosition write SetStartPosition stored IsLinearStored; + property StopPosition: TPosition read FStopPosition write SetStopPosition stored IsLinearStored; + { radial } + property RadialTransform: TTransform read FRadialTransform write SetRadialTransform stored IsRadialStored; + end; + +{ TBrushResource } + + TBrush = class; + TBrushObject = class; + + TBrushResource = class(TInterfacedPersistent, IFreeNotification) + private + FStyleResource: TBrushObject; + FStyleLookup: string; + FOnChanged: TNotifyEvent; + function GetBrush: TBrush; + procedure SetStyleResource(const Value: TBrushObject); + function GetStyleLookup: string; + procedure SetStyleLookup(const Value: string); + { IFreeNotification } + procedure FreeNotification(AObject: TObject); + public + destructor Destroy; override; + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; + procedure Assign(Source: TPersistent); override; + property Brush: TBrush read GetBrush; + published + property StyleResource: TBrushObject read FStyleResource write SetStyleResource stored False; + property StyleLookup: string read GetStyleLookup write SetStyleLookup; + end; + +{ TBrushBitmap } + + TWrapMode = (Tile, TileOriginal, TileStretch); + + TBrushBitmap = class(TInterfacedPersistent) + private + FOnChanged: TNotifyEvent; + FBitmap: TBitmap; + FWrapMode: TWrapMode; + procedure SetWrapMode(const Value: TWrapMode); + procedure SetBitmap(const Value: TBitmap); + function GetBitmapImage: TBitmapImage; + protected + procedure DoChanged; virtual; + public + constructor Create; + destructor Destroy; override; + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; + procedure Assign(Source: TPersistent); override; + published + property Bitmap: TBitmap read FBitmap write SetBitmap; + /// Image to be used by the brush. + property Image: TBitmapImage read GetBitmapImage; + property WrapMode: TWrapMode read FWrapMode write SetWrapMode; + end; + +{ TBrush } + + TBrushKind = (None, Solid, Gradient, Bitmap, Resource); + + TBrush = class(TPersistent) + private + FColor: TAlphaColor; + FKind: TBrushKind; + FOnChanged: TNotifyEvent; + FGradient: TGradient; + FDefaultKind: TBrushKind; + FDefaultColor: TAlphaColor; + FResource: TBrushResource; + FBitmap: TBrushBitmap; + FOnGradientChanged: TNotifyEvent; + procedure SetColor(const Value: TAlphaColor); + procedure SetKind(const Value: TBrushKind); + procedure SetGradient(const Value: TGradient); + function IsColorStored: Boolean; + function IsGradientStored: Boolean; + function GetColor: TAlphaColor; + function IsKindStored: Boolean; + procedure SetResource(const Value: TBrushResource); + function IsResourceStored: Boolean; + function IsBitmapStored: Boolean; + protected + procedure GradientChanged(Sender: TObject); + procedure ResourceChanged(Sender: TObject); + procedure BitmapChanged(Sender: TObject); + public + constructor Create(const ADefaultKind: TBrushKind; const ADefaultColor: TAlphaColor); + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; + property OnGradientChanged: TNotifyEvent read FOnGradientChanged write FOnGradientChanged; + property DefaultColor: TAlphaColor read FDefaultColor write FDefaultColor; + property DefaultKind: TBrushKind read FDefaultKind write FDefaultKind; + published + property Color: TAlphaColor read GetColor write SetColor stored IsColorStored; + property Bitmap: TBrushBitmap read FBitmap write FBitmap stored IsBitmapStored; + property Kind: TBrushKind read FKind write SetKind stored IsKindStored; + property Gradient: TGradient read FGradient write SetGradient stored IsGradientStored; + property Resource: TBrushResource read FResource write SetResource stored IsResourceStored; + end; + + TStrokeCap = (Flat, Round); + + TStrokeJoin = (Miter, Round, Bevel); + + TStrokeDash = (Solid, Dash, Dot, DashDot, DashDotDot, Custom); + + TDashArray = TArray; + + TStrokeBrush = class(TBrush) + public type + TDashData = record + DashArray: TDashArray; + DashOffset: Single; + constructor Create(const ADashArray: TDashArray; ADashOffset: Single); + end; + + TDashDevice = (Screen, Printer); + TStdDashes = array [TDashDevice, TStrokeDash] of TDashData; + private class var + FStdDash: TStdDashes; + FStdDashCreated: Boolean; + private + FJoin: TStrokeJoin; + FThickness: Single; + FCap: TStrokeCap; + FDash: TStrokeDash; + FDashArray: TDashArray; + FDashOffset: Single; + function IsThicknessStored: Boolean; + procedure SetCap(const Value: TStrokeCap); + procedure SetDash(const Value: TStrokeDash); + procedure SetJoin(const Value: TStrokeJoin); + procedure SetThickness(const Value: Single); + function GetDashArray: TDashArray; + class function GetStdDash(const Device: TDashDevice; const Dash: TStrokeDash): TDashData; static; + procedure ReadCustomDash(AStream: TStream); + procedure WriteCustomDash(AStream: TStream); + protected + procedure DefineProperties(Filer: TFiler); override; + public + constructor Create(const ADefaultKind: TBrushKind; const ADefaultColor: TAlphaColor); reintroduce; + procedure Assign(Source: TPersistent); override; + procedure SetCustomDash(const Dash: array of Single; Offset: Single); + property DashArray: TDashArray read GetDashArray; + property DashOffset: Single read FDashOffset; + class property StdDash[const Device: TDashDevice; const Dash: TStrokeDash]: TDashData read GetStdDash; + published + property Thickness: Single read FThickness write SetThickness stored IsThicknessStored nodefault; + property Cap: TStrokeCap read FCap write SetCap default TStrokeCap.Flat; + property Dash: TStrokeDash read FDash write SetDash default TStrokeDash.Solid; + property Join: TStrokeJoin read FJoin write SetJoin default TStrokeJoin.Miter; + end; + + IFMXSystemFontService = interface(IInterface) + ['{62017F22-ADF1-44D9-A21D-796D8C7F3CF0}'] + function GetDefaultFontFamilyName: string; + function GetDefaultFontSize: Single; + end; + +{ TFont } + + TFontClass = class of TFont; + + TFontWeight = (Thin, UltraLight, Light, SemiLight, Regular, Medium, Semibold, Bold, UltraBold, Black, UltraBlack); + + /// + /// Font weight type helper + /// + TFontWeightHelper = record helper for TFontWeight + /// + /// Checks wherever current weight value is TFontWeight.Regular + /// + function IsRegular: Boolean; + end; + + TFontSlant = (Regular, Italic, Oblique); + + /// + /// Font slant type helper + /// + TFontSlantHelper = record helper for TFontSlant + /// + /// Checks wherever current slant value is TFontSlant.Regular + /// + function IsRegular: Boolean; + end; + + TFontStretch = (UltraCondensed, ExtraCondensed, Condensed, SemiCondensed, Regular, SemiExpanded, Expanded, + ExtraExpanded, UltraExpanded); + + /// + /// Font stretch type helper + /// + TFontStretchHelper = record helper for TFontStretch + /// + /// Checks wherever current stretch value is TFontStretch.Regular + /// + function IsRegular: Boolean; + end; + + /// + /// Extended font style based on TFontStyles. Support multi-weight and multi-stretch fonts + /// + TFontStyleExt = record + /// + /// Set of regular TFontStyle. May contains any TFontStyle value but TFont will process only + /// fsOutline and fsStrikeOut values + /// + SimpleStyle: TFontStyles; + /// + /// Default font weight value + /// + Weight: TFontWeight; + /// + /// Default font slant value + /// + Slant: TFontSlant; + /// + /// Default font stretch value + /// + Stretch: TFontStretch; + + /// + /// Common extended font style constructor. + /// Initialy new style is initializing using AOtherStyles values. After that AWeight, ASlant + /// and AStretch values are applying + /// + /// + /// Basicaly bsBold or fsItalic values in AOtherStyles are ignoring. Because after creating result from the set of + /// TFontStyle values system will set styles from AWeight, ASlant and AStretch which + /// will replace style values. + /// + class function Create(const AWeight: TFontWeight = TFontWeight.Regular; + const AStant: TFontSlant = TFontSlant.Regular; const AStretch: TFontStretch = TFontStretch.Regular; + const AOtherStyles: TFontStyles = []): TFontStyleExt; overload; static; inline; + /// Constructor that allows to create extended style from the regular TFontStyles + class function Create(const AStyle: TFontStyles): TFontStyleExt; overload; static; inline; + /// Default style with regular parameters without any decorations + class function Default: TFontStyleExt; static; inline; + // Operators + /// Overriding equality check operator + class operator Equal(const A, B: TFontStyleExt): Boolean; + /// Overriding inequality check operator + class operator NotEqual(const A, B: TFontStyleExt): Boolean; + /// Overriding implicit conversion to TFontStyles + class operator Implicit(const AStyle: TFontStyleExt): TFontStyles; + /// Overriding addition operator with both extended styles + class operator Add(const A, B: TFontStyleExt): TFontStyleExt; + /// Overriding addition operator with single font style item + class operator Add(const A: TFontStyleExt; const B: TFontStyle): TFontStyleExt; + /// Overriding addition operator with set of font styles + class operator Add(const A: TFontStyleExt; const B: TFontStyles): TFontStyleExt; + /// Overriding subtraction operator with single font style item + class operator Subtract(const A: TFontStyleExt; const B: TFontStyle): TFontStyleExt; + /// Overriding subtraction operator with set of font styles + class operator Subtract(const A: TFontStyleExt; const B: TFontStyles): TFontStyleExt; + /// Overriding check whether TFontStyle contains in TFontStyleExt + class operator In(const A: TFontStyle; const B: TFontStyleExt): Boolean; + /// Overriding Multiply set of TFontStyle to the TFontStyleExt + class operator Multiply(const A: TFontStyles; const B: TFontStyleExt): TFontStyles; + + /// + /// Overriding Multiply set of TFontStyle to the TFontStyleExt + /// + function IsRegular: Boolean; + end; + + TFont = class(TPersistent) + private const + DefaultFontSize: Single = 12.0; + DefaultFontFamily = 'Tahoma'; + MaxFontSize: Single = 512.0; + public + class var FontService: IFMXSystemFontService; + private + FSize: Single; + FFamily: TFontName; + FStyleExt: TFontStyleExt; + FUpdating: Boolean; + FChanged: Boolean; + FOnChanged: TNotifyEvent; + procedure SetFamily(const Value: TFontName); + procedure SetSize(const Value: Single); + function GetStyle: TFontStyles; + procedure SetStyle(const Value: TFontStyles); + procedure SetStyleExt(const Value: TFontStyleExt); + procedure ReadStyleExt(AStream: TStream); + procedure WriteStyleExt(AStream: TStream); + protected + procedure DefineProperties(Filer: TFiler); override; + function DefaultFamily: string; virtual; + function DefaultSize: Single; virtual; + procedure DoChanged; virtual; + public + constructor Create; + procedure AfterConstruction; override; + procedure Change; + procedure Assign(Source: TPersistent); override; + procedure SetSettings(const AFamily: string; const ASize: Single; const AStyle: TFontStyleExt); + function Equals(Obj: TObject): Boolean; override; + function IsFamilyStored: Boolean; + function IsSizeStored: Boolean; + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; + /// + /// Refrects current font style, including underline and strikeout + /// + property StyleExt: TFontStyleExt read FStyleExt write SetStyleExt; + published + property Family: TFontName read FFamily write SetFamily stored IsFamilyStored; + property Size: Single read FSize write SetSize stored IsSizeStored nodefault; + property Style: TFontStyles read GetStyle write SetStyle stored False; + end; + +{ TBitmapCodec } + + TBitmapCodecSaveParams = record + // encode quality 0..100 + Quality: Integer; + end; + PBitmapCodecSaveParams = ^TBitmapCodecSaveParams; + + TCustomBitmapCodec = class abstract + public + class function GetImageSize(const AFileName: string): TPointF; virtual; abstract; + class function IsValid(const AStream: TStream): Boolean; virtual; abstract; + function LoadFromFile(const AFileName: string; const ABitmap: TBitmapSurface; + const AMaxSizeLimit: Cardinal = 0): Boolean; virtual; abstract; + function LoadThumbnailFromFile(const AFileName: string; const AFitWidth, AFitHeight: Single; + const UseEmbedded: Boolean; const ABitmap: TBitmapSurface): Boolean; virtual; abstract; + function LoadFromStream(const AStream: TStream; const ABitmap: TBitmapSurface; + const AMaxSizeLimit: Cardinal = 0): Boolean; virtual; abstract; + function SaveToFile(const AFileName: string; const ABitmap: TBitmapSurface; const ASaveParams: PBitmapCodecSaveParams = nil): Boolean; virtual; abstract; + function SaveToStream(const AStream: TStream; const ABitmap: TBitmapSurface; const AExtension: string; + const ASaveParams: PBitmapCodecSaveParams = nil): Boolean; virtual; abstract; + end; + TCustomBitmapCodecClass = class of TCustomBitmapCodec; + +{ TBitmapCodecManager } + + EBitmapCodecManagerException = class(Exception); + + TBitmapCodecManager = class sealed + private type + TCodecDescriptor = record + Extension: string; + Description: string; + CodecClass: TCustomBitmapCodecClass; + CanSave: Boolean; + function ToFilterString: string; + end; + strict private + class var FCodecsDescriptors: TList; + class function SameExtension(const ALeft, ARight: string): Boolean; + class function FindCodecClass(const AFileExtension: string; var ACodecClass: TCustomBitmapCodecClass): Boolean; + class function FindWritableCodecClass(const AFileExtension: string; var ACodecClass: TCustomBitmapCodecClass): Boolean; + class function GuessCodecClass(const AFileExtension: string): TCustomBitmapCodecClass; + class function GetCodecsDescriptors: TList; static; + class property CodecsDescriptors: TList read GetCodecsDescriptors; + public + // Reserved for internal use only - do not call directly! + class procedure UnInitialize; + + { Registration and Unregistration } + + /// Register a bitmap codec class with a specified file extension and description. + /// If codec with specified AFileExtension was already registered or AFileExtension is empty + /// or ACodecClass is nil will raise EBitmapCodecManagerException. + class procedure RegisterBitmapCodecClass(const AFileExtension, ADescription: string; const ACanSave: Boolean; + const ACodecClass: TCustomBitmapCodecClass); + /// Unregisters codec with specified file extension AFileExtension. + class procedure UnregisterBitmapCodecClass(const AFileExtension: string); + + { Helpers } + + /// Returns list of supported image file extensions separated by ';'. + class function GetFileTypes: string; + /// Returns filter presentation of supported image types for TXXXDialog components. + class function GetFilterString: string; + /// Returns true, if codec with specified file extension was registered. + class function CodecExists(const AFileName: string): Boolean; overload; + /// Returns image size for specified file by AFileName. + class function GetImageSize(const AFileName: string): TPointF; + + { Loading } + + /// Loads image from file by AFileName to Bitmap surface ABitmap. If image successfully + /// loaded, it returns true, otherwise - false. + /// If ABitmap is nil, it will raise EBitmapCodecManagerException. + class function LoadFromFile(const AFileName: string; const ABitmap: TBitmapSurface; + const AMaxSizeLimit: Cardinal = 0): Boolean; + /// Loads image thumbnail with specified size AFitWidth and AFitHeight by file name + /// AFileName. If image successfully loaded, it returns true, otherwise - false. + /// If ABitmap is nil, it will raise EBitmapCodecManagerException. + class function LoadThumbnailFromFile(const AFileName: string; const AFitWidth, AFitHeight: Single; + const AUseEmbedded: Boolean; const ABitmap: TBitmapSurface): Boolean; + /// Loads image from the stream AStream. If image successfully loaded, it returns true, + /// otherwise - false. + /// If ABitmap or AStream is nil, it will raise EBitmapCodecManagerException. + class function LoadFromStream(const AStream: TStream; const ABitmap: TBitmapSurface; + const AMaxSizeLimit: Cardinal = 0): Boolean; + + { Saving } + + /// Saves bitmap ABitmap to the stream AStream with using codec with specified extension + /// AExtension. Optionally, you can specify save options. For example, the quality. If image successfully + /// saved to the stream, it returns true, otherwise - false. + /// If ABitmap or AStream is nil, it will raise EBitmapCodecManagerException. + class function SaveToStream(const AStream: TStream; const ABitmap: TBitmapSurface; const AExtension: string; + const ASaveParams: PBitmapCodecSaveParams = nil): Boolean; overload; + /// Saves bitmap ABitmap to the file AFileName . It uses codec extracted by FileName + /// extension. Optionally, you can specify save options. For example, the quality. If image successfully saved to + /// the file, it returns true, otherwise - false. + /// If ABitmap is nil, it will raise EBitmapCodecManagerException. + class function SaveToFile(const AFileName: string; const ABitmap: TBitmapSurface; + const ASaveParams: PBitmapCodecSaveParams = nil): Boolean; + end; + +{ TImageTypeChecker } + + /// Helper class for BitmapCodec. + TImageTypeChecker = class + private type + TImageData = record + DataType: string; + Length: Integer; + Header: array [0..3] of Byte; + end; + public + /// Analyzes the header to guess the image format of he given file. + class function GetType(const AFileName: string): string; overload; + /// Analyzes the header to guess the image format of he given stream. + class function GetType(const AData: TStream): string; overload; + end; + +{ TCustomAnimatedCodec } + + EAnimatedCodecException = class(Exception); + + TBitmapFrame = record + Bitmap: TBitmap; + Duration: Integer; + end; + + TAnimatedCapability = (Encode, Decode); + + TAnimatedCapabilities = set of TAnimatedCapability; + + TCustomAnimatedCodec = class abstract + private + FExtension: string; + FFrames: TList; + procedure FramesNotify(Sender: TObject; const Item: TBitmapFrame; Action: TCollectionNotification); + function GetBitmap(const AMilliseconds: Integer): TBitmap; + function GetCount: Integer; + function GetFrame(const AIndex: Integer): TBitmapFrame; + protected + constructor Create(const AExtension: string); virtual; + function GetDuration: Integer; virtual; + property Extension: string read FExtension; + public + destructor Destroy; override; + /// Add frame. + /// Frame's bitmap to be added. + /// Frame duration in milliseconds. + /// If the added frame does not have the same dimensions as the existing frames, an EAnimatedCodecException will be raised. + procedure AddFrame(const ABitmap: TBitmap; const ADuration: Integer); + /// Load animation from a file. + /// Source file name. + /// True if the file loads successfully, and false otherwise. + function LoadFromFile(const AFileName: string): Boolean; virtual; + /// Load animation from a stream. + /// Source stream. + /// True if the stream loads successfully, and false otherwise. + function LoadFromStream(const AStream: TStream): Boolean; virtual; abstract; + /// Renders a frame at a specified time in milliseconds on the Canvas. + /// Destination canvas. + /// The time in milliseconds of the frame to be rendered. + /// Source width. + /// Source height. + /// Destination bounds. + /// Opacity level of the rendered output. + /// This function is expected to render the frame successfully, regardless of the decoder (e.g. vector-based animations that do not return a list of frames). + /// True if successfully rendered, false otherwise. + function Render(const ACanvas: TCanvas; const AMilliseconds: Integer; const AWidth, AHeight: Integer; const ADestRect: TRectF; const AOpacity: Single = 1): Boolean; virtual; + /// Reset the frame list. + procedure Reset; + /// Save animation to a file. + /// Destination file name. + /// Percentage of quality (range: 0-100) + /// The higher the selected quality, the lower the compression, resulting in a larger output size. + /// True if the file is saved successfully, and false otherwise. + function SaveToFile(const AFileName: string; const AQuality: Integer = 80): Boolean; virtual; + /// Save animation to a stream. + /// Destination stream. + /// Quality of the output animation, ranging from 0 (poor quality) to 100 (excellent quality). + /// True if the stream is saved successfully, and false otherwise. + function SaveToStream(const AStream: TStream; const AQuality: Integer = 80): Boolean; virtual; abstract; + /// Get bitmap at a time. + property Bitmaps[const AMilliseconds: Integer]: TBitmap read GetBitmap; default; + /// Total number of frames. + /// Some decoders (e.g. vector-based animations) may not return any frames. + property Count: Integer read GetCount; + /// Total animation duration in milliseconds. + property Duration: Integer read GetDuration; + /// Get frame at an index. + property Frames[const AIndex: Integer]: TBitmapFrame read GetFrame; + end; + TCustomAnimatedCodecClass = class of TCustomAnimatedCodec; + +{ TAnimatedCodecManager } + + EAnimatedCodecManagerException = class(Exception); + + TAnimatedCodecManager = class sealed + private type + TCodecDescriptor = record + Extension: string; + Description: string; + Capabilities: TAnimatedCapabilities; + CodecClass: TCustomAnimatedCodecClass; + end; + strict private + class var FCodecsDescriptors: TList; + class destructor Destroy; + class function IndexOfExtension(const AExtension: string): Integer; + class function NormalizeExtension(const AExtension: string): string; inline; + public + /// Creates an animated codec. + /// The file extension for which the codec will be used. + /// Animated codec if the extension is supported, or nil otherwise. + class function CreateAnimatedCodec(const AExtension: string): TCustomAnimatedCodec; + /// Returns the list of extensions (e.g. ".gif;.webp"). + /// The required capability to return the list of extensions. + /// List of extensions + class function GetFileTypes(const ACapability: TAnimatedCapability): string; + /// Returns the filter string for use in dialog components (e.g. TSaveDialog, TOpenDialog). + /// The required capability to return the filter string. + /// Filter string. + class function GetFilterString(const ACapability: TAnimatedCapability): string; + /// Checks if a capability is supported. + /// Extension used for verification + /// Capability to be checked. + /// The wildcard "*" can be used to indicate all extensions. + /// True if the capability is supported, and false otherwise. + class function HasCapability(const AExtension: string; const ACapability: TAnimatedCapability): Boolean; + /// Register an animated codec class. + /// Extension to be registered. + /// Description of the file whose extension will be registered. + /// The capability of the codec class to be registered. + /// Animated codec class to be registered. + /// If the extension has already been registered, an EAnimatedCodecManagerException will be raised. + class procedure RegisterAnimatedCodecClass(const AExtension, ADescription: string; ACapabilities: TAnimatedCapabilities; ACodecClass: TCustomAnimatedCodecClass); + /// Unregister an animated codec class. + /// Extension to be unregistered. + class procedure UnregisterAnimatedCodecClass(const AExtension: string); + end; + +{ TBitmap } + + IBitmapObject = interface(IFreeNotificationBehavior) + ['{5C17D001-47C1-462F-856D-8358B7B2C842}'] + function GetBitmap: TBitmap; + property Bitmap: TBitmap read GetBitmap; + end; + + TBitmapData = record + private + FPixelFormat: TPixelFormat; + FWidth: Integer; + FHeight: Integer; + function GetBytesPerPixel: Integer; + function GetBytesPerLine: Integer; + public + Data: Pointer; + Pitch: Integer; + constructor Create(const AWidth, AHeight: Integer; const APixelFormat: TPixelFormat); + function GetPixel(const X, Y: Integer): TAlphaColor; + procedure SetPixel(const X, Y: Integer; const AColor: TAlphaColor); + procedure Copy(const Source: TBitmapData); + // Access to scanline in PixelFormat + function GetScanline(const I: Integer): Pointer; + function GetPixelAddr(const I, J: Integer): Pointer; + property PixelFormat: TPixelFormat read FPixelFormat; + property BytesPerPixel: Integer read GetBytesPerPixel; + property BytesPerLine: Integer read GetBytesPerLine; + property Width: Integer read FWidth; + property Height: Integer read FHeight; + end; + + TMapAccess = (Read, Write, ReadWrite); + + TBitmapImage = class + private + FRefCount: Integer; + FHandle: THandle; + FCanvasClass: TCanvasClass; + FWidth: Integer; + FHeight: Integer; + FBitmapScale: Single; + FPixelFormat: TPixelFormat; + procedure CreateHandle; + procedure FreeHandle; + function GetCanvasClass: TCanvasClass; + public + constructor Create; + procedure IncreaseRefCount; inline; + procedure DecreaseRefCount; + property RefCount: Integer read FRefCount; + property CanvasClass: TCanvasClass read GetCanvasClass; + property Handle: THandle read FHandle; + property BitmapScale: Single read FBitmapScale; + property PixelFormat: TPixelFormat read FPixelFormat; + property Height: Integer read FHeight; + property Width: Integer read FWidth; + end; + + TCanvasQuality = (SystemDefault, HighPerformance, HighQuality); + + TBitmap = class(TInterfacedPersistent, IStreamPersist) + private + FImage: TBitmapImage; + FCanvas: TCanvas; + FMapped: Boolean; + FMapAccess: TMapAccess; + FCanvasQuality: TCanvasQuality; + FOnChange: TNotifyEvent; + function GetBytesPerLine: Integer; + function GetBytesPerPixel: Integer; + function GetCanvas: TCanvas; + function GetPixelFormat: TPixelFormat; + function GetImage: TBitmapImage; + function GetHeight: Integer; + function GetWidth: Integer; + function GetBitmapScale: Single; + function GetHandle: THandle; + procedure SetWidth(const Value: Integer); + procedure SetHeight(const Value: Integer); + procedure SetBitmapScale(const Scale: Single); + procedure ReadBitmap(Stream: TStream); + procedure WriteBitmap(Stream: TStream); + function GetCanvasClass: TCanvasClass; + function GetBounds: TRect; + function GetSize: TSize; + function GetBoundsF: TRectF; + procedure SetCanvasQuality(const Value: TCanvasQuality); + protected + procedure CreateNewReference; + procedure CopyToNewReference; + procedure DestroyResources; virtual; + procedure BitmapChanged; virtual; + procedure AssignFromSurface(const Source: TBitmapSurface); + procedure DoChange; virtual; + protected + procedure AssignTo(Dest: TPersistent); override; + procedure DefineProperties(Filer: TFiler); override; + procedure ReadStyleLookup(Reader: TReader); virtual; + public + constructor Create; overload; virtual; + constructor Create(const AWidth, AHeight: Integer); overload; virtual; + constructor CreateFromStream(const AStream: TStream); virtual; + constructor CreateFromFile(const AFileName: string); virtual; + constructor CreateFromBitmapAndMask(const Bitmap, Mask: TBitmap); + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + function EqualsBitmap(const Bitmap: TBitmap): Boolean; + procedure SetSize(const ASize: TSize); overload; + procedure SetSize(const AWidth, AHeight: Integer); overload; + procedure CopyFromBitmap(const Source: TBitmap); overload; + procedure CopyFromBitmap(const Source: TBitmap; SrcRect: TRect; DestX, DestY: Integer); overload; + + function IsEmpty: Boolean; + function HandleAllocated: Boolean; + procedure FreeHandle; + + procedure Clear(const AColor: TAlphaColor); virtual; + procedure ClearRect(const ARect: TRectF; const AColor: TAlphaColor = 0); + procedure Rotate(const Angle: Single); + procedure Resize(const AWidth, AHeight: Integer); + procedure FlipHorizontal; + procedure FlipVertical; + procedure InvertAlpha; + procedure ReplaceOpaqueColor(const Color: TAlphaColor); + + function CreateMask: PByteArray; + procedure ApplyMask(const Mask: PByteArray; const DstX: Integer = 0; const DstY: Integer = 0); + + function CreateThumbnail(const AWidth, AHeight: Integer): TBitmap; + + function Map(const Access: TMapAccess; var Data: TBitmapData): Boolean; + procedure Unmap(var Data: TBitmapData); + + procedure LoadFromFile(const AFileName: string); + procedure LoadThumbnailFromFile(const AFileName: string; const AFitWidth, AFitHeight: Single; + const UseEmbedded: Boolean = True); + procedure SaveToFile(const AFileName: string; const SaveParams: PBitmapCodecSaveParams = nil); + procedure LoadFromStream(Stream: TStream); + procedure SaveToStream(Stream: TStream); + + property Canvas: TCanvas read GetCanvas; + property CanvasClass: TCanvasClass read GetCanvasClass; + property CanvasQuality: TCanvasQuality read FCanvasQuality write SetCanvasQuality; + property Image: TBitmapImage read GetImage; + property Handle: THandle read GetHandle; + property PixelFormat: TPixelFormat read GetPixelFormat; + property BytesPerPixel: Integer read GetBytesPerPixel; + property BytesPerLine: Integer read GetBytesPerLine; + /// Helper property that returns bitmap bounds in TRect + property Bounds: TRect read GetBounds; + /// Helper property that returns bitmap bounds in TRectF + property BoundsF: TRectF read GetBoundsF; + property BitmapScale: Single read GetBitmapScale write SetBitmapScale; + property Width: Integer read GetWidth write SetWidth; + property Height: Integer read GetHeight write SetHeight; + /// Helper property that returns dimention of bitmap as TSize + property Size: TSize read GetSize write SetSize; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + +{ TPathData } + + TPathData = class; + + IPathObject = interface(IFreeNotificationBehavior) + ['{8C014863-4F69-48F2-9CF7-E336BFD3F06B}'] + function GetPath: TPathData; + property Path: TPathData read GetPath; + end; + + TPathPointKind = (MoveTo, LineTo, CurveTo, Close); + + TPathPoint = packed record + Kind: TPathPointKind; + Point: TPointF; + class function Create(const AKind: TPathPointKind; const APoint: TPointF): TPathPoint; static; inline; + class operator Equal(const APoint1, APoint2: TPathPoint): Boolean; + class operator NotEqual(const APoint1, APoint2: TPathPoint): Boolean; + end; + + TPathObject = class; + + TBoundsMode = (LegacyBounds, ShapeBounds); + + TPathData = class(TInterfacedPersistent, IFreeNotification) + private const + MinFlatness = 0.05; + public const + DefaultFlatness = 0.25; + private + FOnChanged: TNotifyEvent; + FStyleResource: TObject; + FStyleLookup: string; + FStartPoint: TPointF; + FPathData: TList; + FRecalcBounds: Boolean; + FBoundsMode: TBoundsMode; + FBounds: TRectF; + function GetPathString: string; + procedure SetPathString(const Value: string); + procedure AddArcSvgPart(const Center, Radius: TPointF; StartAngle, SweepAngle: Single); + procedure AddArcSvg(const P1, Radius: TPointF; Angle: Single; const LargeFlag, SweepFlag: Boolean; const P2: TPointF); + function GetStyleLookup: string; + procedure SetStyleLookup(const Value: string); + procedure SetBoundsMode(Value: TBoundsMode); + function GetPath: TPathData; + function GetCount: Integer; inline; + function GetPoint(AIndex: Integer): TPathPoint; inline; + protected + { rtl } + procedure DefineProperties(Filer: TFiler); override; + procedure ReadPath(Stream: TStream); + procedure WritePath(Stream: TStream); + { IFreeNotification } + procedure FreeNotification(AObject: TObject); + procedure DoChanged(NeedRecalcBounds: Boolean = True); virtual; + public + constructor Create; virtual; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + function EqualsPath(const Path: TPathData): Boolean; + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; + { creation } + function LastPoint: TPointF; + procedure MoveTo(const P: TPointF); + procedure MoveToRel(const P: TPointF); + procedure LineTo(const P: TPointF); + procedure LineToRel(const P: TPointF); + procedure HLineTo(const X: Single); + procedure HLineToRel(const X: Single); + procedure VLineTo(const Y: Single); + procedure VLineToRel(const Y: Single); + procedure CurveTo(const ControlPoint1, ControlPoint2, EndPoint: TPointF); + procedure CurveToRel(const ControlPoint1, ControlPoint2, EndPoint: TPointF); + procedure SmoothCurveTo(const ControlPoint2, EndPoint: TPointF); + procedure SmoothCurveToRel(const ControlPoint2, EndPoint: TPointF); + procedure QuadCurveTo(const ControlPoint, EndPoint: TPointF); + procedure ClosePath; + { shapes } + procedure AddEllipse(const ARect: TRectF); + procedure AddRectangle(const ARect: TRectF; const XRadius, YRadius: Single; const ACorners: TCorners; + const ACornerType: TCornerType = TCornerType.Round); + procedure AddArc(const Center, Radius: TPointF; StartAngle, SweepAngle: Single); + { modification } + procedure AddPath(APath: TPathData); + procedure Clear; + procedure Flatten(const Flatness: Single = DefaultFlatness); + procedure Scale(const ScaleX, ScaleY: Single); overload; + procedure Scale(const AScale: TPointF); overload; inline; + procedure Translate(const DX, DY: Single); overload; + procedure Translate(const Delta: TPointF); overload; inline; + procedure FitToRect(const ARect: TRectF); + procedure ApplyMatrix(const M: TMatrix); + { params } + function GetBounds: TRectF; + { convert } + function FlattenToPolygon(var Polygon: TPolygon; const Flatness: Single = DefaultFlatness): TPointF; + function IsEmpty: Boolean; + { access } + property Count: Integer read GetCount; + property Points[AIndex: Integer]: TPathPoint read GetPoint; default; + { resoruces } + property ResourcePath: TPathData read GetPath; + published + property Data: string read GetPathString write SetPathString stored False; + { This property allow to link path with PathObject by name. } + property StyleLookup: string read GetStyleLookup write SetStyleLookup; + property BoundsMode: TBoundsMode read FBoundsMode write SetBoundsMode default TBoundsMode.LegacyBounds; + end; + +{ TCanvasSaveState } + + TCanvasSaveState = class(TPersistent) + protected + FAssigned: Boolean; + FFill: TBrush; + FStroke: TStrokeBrush; + FDash: TDashArray; + FDashOffset: Single; + FFont: TFont; + FMatrix: TMatrix; + FOffset: TPointF; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + property Assigned: Boolean read FAssigned; + end; + + TRegion = array of TRectF; + TRegionArray = array of TRegion; + +{ TCanvas } + + ECanvasException = class(Exception); + + TFillTextFlag = (RightToLeft); + TFillTextFlags = set of TFillTextFlag; + + TAbstractPrinter = class(TPersistent); + + PClipRects = ^TClipRects; + TClipRects = array of TRectF; + + ICanvasObject = interface + ['{61166E3B-9BC3-41E3-9D9A-5C6AB6460950}'] + function GetCanvas: TCanvas; + property Canvas: TCanvas read GetCanvas; + end; + + IModulateCanvas = interface + ['{B7CFFA1B-FBCF-4B36-AA32-93856F621F28}'] + function GetModulateColor: TAlphaColor; + procedure SetModulateColor(const AColor: TAlphaColor); + property ModulateColor: TAlphaColor read GetModulateColor write SetModulateColor; + end; + + TCanvasStyle = (NeedGPUSurface, SupportClipRects, SupportModulation, DisableGlobalLock); + TCanvasStyles = set of TCanvasStyle; + + TCanvasAttribute = (MaxBitmapSize); + + TCanvas = class abstract(TInterfacedPersistent) + public const + MaxAllowedBitmapSize = $FFFF; + DefaultScale = 1; + protected + class var FLock: TObject; + private + FBeginSceneCount: Integer; + FFill: TBrush; + FStroke: TStrokeBrush; + FParent: TWindowHandle; + [Weak] FBitmap: TBitmap; + FScale: Single; + FQuality: TCanvasQuality; + FMatrix: TMatrix; + procedure SetFill(const Value: TBrush); + protected type + TMatrixMeaning = (Unknown, Identity, Translate); + + TCustomMetaBrush = class + private + FValid: Boolean; + public + property Valid: Boolean read FValid write FValid; + end; + + TMetaBrush = class(TCustomMetaBrush) + private + FKind: TBrushKind; + FColor: TAlphaColor; + FOpacity: Single; + FGradient: TGradient; + FRect: TRectF; + [Weak] FBitmapImage: TBitmapImage; + FWrapMode: TWrapMode; + function GetGradient: TGradient; + public + destructor Destroy; override; + property Kind: TBrushKind read FKind write FKind; + property Color: TAlphaColor read FColor write FColor; + property Opacity: Single read FOpacity write FOpacity; + property Rect: TRectF read FRect write FRect; + property WrapMode: TWrapMode read FWrapMode write FWrapMode; + property Gradient: TGradient read GetGradient; + property Image: TBitmapImage read FBitmapImage write FBitmapImage; + end; + + TMetaStrokeBrush = class(TCustomMetaBrush) + private + FCap: TStrokeCap; + FDash: TStrokeDash; + FJoin: TStrokeJoin; + FDashArray: TDashArray; + FDashOffset: Single; + public + property Cap: TStrokeCap read FCap write FCap; + property Dash: TStrokeDash read FDash write FDash; + property Join: TStrokeJoin read FJoin write FJoin; + property DashArray: TDashArray read FDashArray write FDashArray; + property DashOffset: Single read FDashOffset write FDashOffset; + end; + private + FMatrixMeaning: TMatrixMeaning; + FMatrixTranslate: TPointF; + FBlending: Boolean; + /// Indicates offset of drawing area + FOffset: TPointF; + procedure SetBlending(const Value: Boolean); + class constructor Create; + class destructor Destroy; + type + TCanvasSaveStateList = TObjectList; + protected + FClippingChangeCount: Integer; + FSavingStateCount: Integer; + FWidth, FHeight: Integer; + FFont: TFont; + FCanvasSaveData: TCanvasSaveStateList; + FPrinter: TAbstractPrinter; + procedure FontChanged(Sender: TObject); virtual; + { Window } + function CreateSaveState: TCanvasSaveState; virtual; + procedure Initialize; + procedure UnInitialize; + function GetCanvasScale: Single; virtual; + { scene } + function DoBeginScene(AClipRects: PClipRects = nil; AContextHandle: THandle = 0): Boolean; virtual; + procedure DoEndScene; virtual; + /// Checks if we are in BeginScene/EndScene process and raises exception, if we are not. + procedure RaiseIfBeginSceneCountZero; + procedure DoFlush; virtual; + { constructors } + constructor CreateFromWindow(const AParent: TWindowHandle; const AWidth, AHeight: Integer; + const AQuality: TCanvasQuality = TCanvasQuality.SystemDefault); virtual; + constructor CreateFromBitmap(const ABitmap: TBitmap; const AQuality: TCanvasQuality = TCanvasQuality.SystemDefault); virtual; + constructor CreateFromPrinter(const APrinter: TAbstractPrinter); virtual; + { bitmap } + class function DoInitializeBitmap(const Width, Height: Integer; const Scale: Single; var PixelFormat: TPixelFormat): THandle; virtual; abstract; + class procedure DoFinalizeBitmap(var Bitmap: THandle); virtual; abstract; + class function DoMapBitmap(const Bitmap: THandle; const Access: TMapAccess; var Data: TBitmapData): Boolean; virtual; abstract; + class procedure DoUnmapBitmap(const Bitmap: THandle; var Data: TBitmapData); virtual; abstract; + class procedure DoCopyBitmap(const Source, Dest: TBitmap); virtual; + { states } + procedure DoBlendingChanged; virtual; + { drawing } + /// Apply a new matrix transformations to the canvas. + procedure DoSetMatrix(const M: TMatrix); virtual; + procedure DoFillRect(const ARect: TRectF; const AOpacity: Single; const ABrush: TBrush); virtual; abstract; + procedure DoFillRoundRect(const ARect: TRectF; const XRadius, YRadius: Single; const ACorners: TCorners; + const AOpacity: Single; const ABrush: TBrush; const ACornerType: TCornerType = TCornerType.Round); virtual; + procedure DoFillPath(const APath: TPathData; const AOpacity: Single; const ABrush: TBrush); virtual; abstract; + procedure DoFillEllipse(const ARect: TRectF; const AOpacity: Single; const ABrush: TBrush); virtual; abstract; + function DoFillPolygon(const Points: TPolygon; const AOpacity: Single; const ABrush: TBrush): Boolean; virtual; + procedure DoDrawBitmap(const ABitmap: TBitmap; const SrcRect, DstRect: TRectF; const AOpacity: Single; const HighSpeed: Boolean); virtual; abstract; + procedure DoDrawLine(const APt1, APt2: TPointF; const AOpacity: Single; const ABrush: TStrokeBrush); virtual; abstract; + procedure DoDrawRect(const ARect: TRectF; const AOpacity: Single; const ABrush: TStrokeBrush); virtual; abstract; + function DoDrawPolygon(const Points: TPolygon; const AOpacity: Single; const ABrush: TStrokeBrush): Boolean; virtual; + procedure DoDrawPath(const APath: TPathData; const AOpacity: Single; const ABrush: TStrokeBrush); virtual; abstract; + procedure DoDrawEllipse(const ARect: TRectF; const AOpacity: Single; const ABrush: TStrokeBrush); virtual; abstract; + { Clipping } + procedure DoIntersectClipRect(const ARect: TRectF); virtual; + procedure DoExcludeClipRect(const ARect: TRectF); virtual; + { Clearing } + procedure DoClear(const Color: TAlphaColor); virtual; + procedure DoClearRect(const ARect: TRectF; const AColor: TAlphaColor = 0); virtual; + property Parent: TWindowHandle read FParent; + protected + function TransformPoint(const P: TPointF): TPointF; inline; + function TransformRect(const Rect: TRectF): TRectF; inline; + property MatrixMeaning: TMatrixMeaning read FMatrixMeaning; + property MatrixTranslate: TPointF read FMatrixTranslate; + public + destructor Destroy; override; + { lock } + class procedure Lock; + class procedure Unlock; + { caps } + class function GetCanvasStyle: TCanvasStyles; virtual; + class function GetAttribute(const Value: TCanvasAttribute): Integer; virtual; + { scene } + procedure SetSize(const AWidth, AHeight: Integer); virtual; + function BeginScene(AClipRects: PClipRects = nil; AContextHandle: THandle = 0): Boolean; + procedure EndScene; + property BeginSceneCount: Integer read FBeginSceneCount; + procedure Flush; + { buffer } + /// Clear whole canvas using Color. + procedure Clear(const AColor: TAlphaColor); virtual; + /// Clear rectangular area of canvas using Color. + procedure ClearRect(const ARect: TRectF; const AColor: TAlphaColor = 0); virtual; + /// Return True if Scale is integer value. + function IsScaleInteger: Boolean; + { matrix } + procedure SetMatrix(const M: TMatrix); + procedure MultiplyMatrix(const M: TMatrix); + { state } + function SaveState: TCanvasSaveState; + procedure RestoreState(const State: TCanvasSaveState); + { bitmap } + class function InitializeBitmap(const Width, Height: Integer; const Scale: Single; var PixelFormat: TPixelFormat): THandle; + class procedure FinalizeBitmap(var Bitmap: THandle); + class function MapBitmap(const Bitmap: THandle; const Access: TMapAccess; var Data: TBitmapData): Boolean; + class procedure UnmapBitmap(const Bitmap: THandle; var Data: TBitmapData); + class procedure CopyBitmap(const Source, Dest: TBitmap); + { aligning } + function AlignToPixel(const Value: TPointF): TPointF; overload; inline; + function AlignToPixel(const Rect: TRectF): TRectF; overload; inline; + function AlignToPixelVertically(const Value: Single): Single; inline; + function AlignToPixelHorizontally(const Value: Single): Single; inline; + { clipping } + /// Set current clipping area using intersection of current area and rectangle. + procedure IntersectClipRect(const ARect: TRectF); virtual; + /// Exclude rectangular area from current clipping area. + procedure ExcludeClipRect(const ARect: TRectF); virtual; + { drawing } + procedure FillArc(const Center, Radius: TPointF; StartAngle, SweepAngle: Single; const AOpacity: Single); overload; + procedure FillArc(const Center, Radius: TPointF; StartAngle, SweepAngle: Single; + const AOpacity: Single; const ABrush: TBrush); overload; + procedure FillRect(const ARect: TRectF; const XRadius, YRadius: Single; const ACorners: TCorners; + const AOpacity: Single; const ACornerType: TCornerType = TCornerType.Round); overload; + procedure FillRect(const ARect: TRectF; const XRadius, YRadius: Single; const ACorners: TCorners; + const AOpacity: Single; const ABrush: TBrush; const ACornerType: TCornerType = TCornerType.Round); overload; + procedure FillRect(const ARect: TRectF; const AOpacity: Single); overload; + procedure FillRect(const ARect: TRectF; const AOpacity: Single; const ABrush: TBrush); overload; + procedure FillPath(const APath: TPathData; const AOpacity: Single); overload; + procedure FillPath(const APath: TPathData; const AOpacity: Single; const ABrush: TBrush); overload; + procedure FillEllipse(const ARect: TRectF; const AOpacity: Single); overload; + procedure FillEllipse(const ARect: TRectF; const AOpacity: Single; const ABrush: TBrush); overload; + procedure DrawBitmap(const ABitmap: TBitmap; const SrcRect, DstRect: TRectF; const AOpacity: Single; + const HighSpeed: Boolean = False); + procedure DrawLine(const APt1, APt2: TPointF; const AOpacity: Single); overload; + procedure DrawLine(const APt1, APt2: TPointF; const AOpacity: Single; const ABrush: TStrokeBrush); overload; + procedure DrawRect(const ARect: TRectF; const XRadius, YRadius: Single; const ACorners: TCorners; + const AOpacity: Single; const ACornerType: TCornerType = TCornerType.Round); overload; + procedure DrawRect(const ARect: TRectF; const XRadius, YRadius: Single; const ACorners: TCorners; + const AOpacity: Single; const ABrush: TStrokeBrush; const ACornerType: TCornerType = TCornerType.Round); overload; + procedure DrawRect(const ARect: TRectF; const AOpacity: Single); overload; + procedure DrawRect(const ARect: TRectF; const AOpacity: Single; const ABrush: TStrokeBrush); overload; + procedure DrawPath(const APath: TPathData; const AOpacity: Single); overload; + procedure DrawPath(const APath: TPathData; const AOpacity: Single; const ABrush: TStrokeBrush); overload; + procedure DrawEllipse(const ARect: TRectF; const AOpacity: Single); overload; + procedure DrawEllipse(const ARect: TRectF; const AOpacity: Single; const ABrush: TStrokeBrush); overload; + procedure DrawArc(const Center, Radius: TPointF; StartAngle, SweepAngle: Single; const AOpacity: Single); overload; + procedure DrawArc(const Center, Radius: TPointF; StartAngle, SweepAngle: Single; const AOpacity: Single; const ABrush: TStrokeBrush); overload; + { mesauring } + function PtInPath(const APoint: TPointF; const APath: TPathData): Boolean; virtual; abstract; + { helpers } + procedure DrawRectSides(const ARect: TRectF; const XRadius, YRadius: Single; const ACorners: TCorners; + const AOpacity: Single; const ASides: TSides; const ACornerType: TCornerType = TCornerType.Round); overload; + procedure DrawRectSides(const ARect: TRectF; const XRadius, YRadius: Single; const ACorners: TCorners; + const AOpacity: Single; const ASides: TSides; const ABrush: TStrokeBrush; const ACornerType: TCornerType = TCornerType.Round); overload; + procedure DrawDashRect(const ARect: TRectF; const XRadius, YRadius: Single; const ACorners: TCorners; + const AOpacity: Single; const AColor: TAlphaColor); + { linear polygon } + procedure FillPolygon(const Points: TPolygon; const AOpacity: Single); virtual; + procedure DrawPolygon(const Points: TPolygon; const AOpacity: Single); virtual; + { text } + function LoadFontFromStream(const AStream: TStream): Boolean; virtual; + { deprecated, use TTextLayout } + procedure FillText(const ARect: TRectF; const AText: string; const WordWrap: Boolean; const AOpacity: Single; + const Flags: TFillTextFlags; const ATextAlign: TTextAlign; const AVTextAlign: TTextAlign = TTextAlign.Center); virtual; + procedure MeasureText(var ARect: TRectF; const AText: string; const WordWrap: Boolean; const Flags: TFillTextFlags; + const ATextAlign: TTextAlign; const AVTextAlign: TTextAlign = TTextAlign.Center); virtual; + procedure MeasureLines(const ALines: TLineMetricInfo; const ARect: TRectF; const AText: string; const WordWrap: Boolean; const Flags: TFillTextFlags; + const ATextAlign: TTextAlign; const AVTextAlign: TTextAlign = TTextAlign.Center); virtual; + function TextToPath(Path: TPathData; const ARect: TRectF; const AText: string; const WordWrap: Boolean; + const ATextAlign: TTextAlign; const AVTextAlign: TTextAlign = TTextAlign.Center): Boolean; virtual; + function TextWidth(const AText: string): Single; + function TextHeight(const AText: string): Single; + { properties } + property Blending: Boolean read FBlending write SetBlending; + property Quality: TCanvasQuality read FQuality; + property Stroke: TStrokeBrush read FStroke; + property Fill: TBrush read FFill write SetFill; + property Font: TFont read FFont; + property Matrix: TMatrix read FMatrix; + property Width: Integer read FWidth; + property Height: Integer read FHeight; + property Bitmap: TBitmap read FBitmap; + property Scale: Single read FScale; + /// Allows to offset drawing area + property Offset: TPointF read FOffset write FOffset; + { statistics } + property ClippingChangeCount: Integer read FClippingChangeCount; + property SavingStateCount: Integer read FSavingStateCount; + end; + + ECanvasManagerException = class(Exception); + + TCanvasDestroyMessage = class(TMessage); + + TCanvasManager = class sealed + private type + TCanvasClassRec = record + CanvasClass: TCanvasClass; + Default: Boolean; + PrinterCanvas: Boolean; + end; + strict private + class var FCanvasList: TList; + class var FDefaultCanvasClass: TCanvasClass; + class var FDefaultPrinterCanvasClass: TCanvasClass; + class var FMeasureBitmap: TBitmap; + class var FEnableSoftwareCanvas: Boolean; + private + class function GetDefaultCanvas: TCanvasClass; static; + class function GetMeasureCanvas: TCanvas; static; + class function GetDefaultPrinterCanvas: TCanvasClass; static; + public + // Reserved for internal use only - do not call directly! + class procedure UnInitialize; + // Register a rendering Canvas class + class procedure RegisterCanvas(const CanvasClass: TCanvasClass; const ADefault: Boolean; const APrinterCanvas: Boolean); + // Return default Canvas + class property DefaultCanvas: TCanvasClass read GetDefaultCanvas; + // Return default Canvas + class property DefaultPrinterCanvas: TCanvasClass read GetDefaultPrinterCanvas; + // Return canvas instance used for text measuring for example + class property MeasureCanvas: TCanvas read GetMeasureCanvas; + // Creation helper + class function CreateFromWindow(const AParent: TWindowHandle; const AWidth, AHeight: Integer; + const AQuality: TCanvasQuality = TCanvasQuality.SystemDefault): TCanvas; + class function CreateFromBitmap(const ABitmap: TBitmap; + const AQuality: TCanvasQuality = TCanvasQuality.SystemDefault): TCanvas; + class function CreateFromPrinter(const APrinter: TAbstractPrinter): TCanvas; + class procedure RecreateFromPrinter(const Canvas: TCanvas; const APrinter: TAbstractPrinter); + class procedure EnableSoftwareCanvas(const Enable: Boolean); + end; + + TPrinterCanvas = class(TCanvas); + TPrinterCanvasClass = class of TPrinterCanvas; + +{ TBrushObject } + + IBrushObject = interface(IFreeNotificationBehavior) + ['{BB870DB6-0228-4165-9906-CF75BFF8C7CA}'] + function GetBrush: TBrush; + property Brush: TBrush read GetBrush; + end; + + TBrushObject = class(TFmxObject, IBrushObject) + private + FBrush: TBrush; + { IBrushObject } + function GetBrush: TBrush; + protected + procedure SetName(const NewName: TComponentName); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function TryGetSolidColor(out AColor: TAlphaColor): Boolean; + published + property Brush: TBrush read FBrush write FBrush; + end; + +{ TFontObject } + + IFontObject = interface(IFreeNotificationBehavior) + ['{F87FBCFE-CE5F-430C-8F46-B20B2E395C1B}'] + function GetFont: TFont; + property Font: TFont read GetFont; + end; + + TFontObject = class(TFmxObject, IFontObject) + private + FFont: TFont; + { IFontObject } + function GetFont: TFont; + protected + procedure SetName(const NewName: TComponentName); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Font: TFont read FFont write FFont; + end; + +{ TPathObject } + + TPathObject = class(TFmxObject, IPathObject) + private + FPath: TPathData; + { IPathObject } + function GetPath: TPathData; + protected + procedure SetName(const NewName: TComponentName); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Path: TPathData read FPath write FPath; + end; + +{ TBitmapObject } + + TBitmapObject = class(TFmxObject, IBitmapObject) + private + FBitmap: TBitmap; + { IBitmapObject } + function GetBitmap: TBitmap; + protected + procedure SetName(const NewName: TComponentName); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Bitmap: TBitmap read FBitmap write FBitmap; + end; + +{ TColorObject } + + TColorObject = class(TFmxObject) + private + FColor: TAlphaColor; + protected + procedure SetName(const NewName: TComponentName); override; + published + property Color: TAlphaColor read FColor write FColor; + end; + + TFontColorForStateClass = class of TFontColorForState; + + TFontColorForState = class(TPersistent) + public type + TIndex = (Normal, Hot, Pressed, Focused, Active); + private + [Weak] FOwner: TTextSettings; + FColor: array [TIndex] of TAlphaColor; + FUpdateCount: Integer; + FChanged: Boolean; + function GetColor(const Index: TIndex): TAlphaColor; + procedure SetColor(const Index: TIndex; const Value: TAlphaColor); + protected + function GetOwner: TPersistent; override; + function GetCurrentColor(const Index: TIndex): TAlphaColor; virtual; + procedure DoChanged; virtual; + public + constructor Create(const AOwner: TTextSettings); virtual; + procedure AfterConstruction; override; + procedure BeginUpdate; + procedure EndUpdate; + procedure Change; + property Owner: TTextSettings read FOwner; + procedure Assign(Source: TPersistent); override; + function Equals(Obj: TObject): Boolean; override; + property CurrentColor[const Index: TIndex]: TAlphaColor read GetCurrentColor; + property Color[const Index: TIndex]: TAlphaColor read GetColor write SetColor; default; + property Normal: TAlphaColor index TIndex.Normal read GetColor write SetColor default TAlphaColorRec.Null; + property Hot: TAlphaColor index TIndex.Hot read GetColor write SetColor default TAlphaColorRec.Null; + property Pressed: TAlphaColor index TIndex.Pressed read GetColor write SetColor default TAlphaColorRec.Null; + property Focused: TAlphaColor index TIndex.Focused read GetColor write SetColor default TAlphaColorRec.Null; + property Active: TAlphaColor index TIndex.Active read GetColor write SetColor default TAlphaColorRec.Null; + end; + + TTextSettingsClass = class of TTextSettings; + + /// + /// This class combines some of properties that relate to the text + /// + TTextSettings = class(TPersistent) + private + [Weak] FOwner: TPersistent; + FFont: TFont; + FUpdateCount: Integer; + FHorzAlign: TTextAlign; + FVertAlign: TTextAlign; + FWordWrap: Boolean; + FFontColor: TAlphaColor; + FIsChanged: Boolean; + FIsAdjustChanged: Boolean; + FOnChanged: TNotifyEvent; + FTrimming: TTextTrimming; + FFontColorForState: TFontColorForState; + procedure SetFontColor(const Value: TAlphaColor); + procedure SetHorzAlign(const Value: TTextAlign); + procedure SetVertAlign(const Value: TTextAlign); + procedure SetWordWrap(const Value: Boolean); + procedure SetTrimming(const Value: TTextTrimming); + procedure SetFontColorForState(const Value: TFontColorForState); + function StoreFontColorForState: Boolean; + function CreateFontColorForState: TFontColorForState; + protected + procedure DoChanged; virtual; + procedure SetFont(const Value: TFont); virtual; + function GetOwner: TPersistent; override; + function GetTextColorsClass: TFontColorForStateClass; virtual; + procedure DoAssign(const Source: TTextSettings); virtual; + procedure DoAssignNotStyled(const TextSettings: TTextSettings; const StyledSettings: TStyledSettings); virtual; + public + constructor Create(const AOwner: TPersistent); virtual; + destructor Destroy; override; + procedure AfterConstruction; override; + procedure Assign(Source: TPersistent); override; + procedure AssignNotStyled(const TextSettings: TTextSettings; const StyledSettings: TStyledSettings); + function Equals(Obj: TObject): Boolean; override; + procedure Change; + procedure BeginUpdate; + procedure EndUpdate; + procedure UpdateStyledSettings(const OldTextSettings, DefaultTextSettings: TTextSettings; + var StyledSettings: TStyledSettings); virtual; + property UpdateCount: Integer read FUpdateCount; + property IsChanged: Boolean read FIsChanged write FIsChanged; + property IsAdjustChanged: Boolean read FIsAdjustChanged write FIsAdjustChanged; + property Font: TFont read FFont write SetFont; + property FontColor: TAlphaColor read FFontColor write SetFontColor default TAlphaColorRec.Black; + property FontColorForState: TFontColorForState read FFontColorForState write SetFontColorForState + stored StoreFontColorForState; + property HorzAlign: TTextAlign read FHorzAlign write SetHorzAlign default TTextAlign.Leading; + property VertAlign: TTextAlign read FVertAlign write SetVertAlign default TTextAlign.Center; + property WordWrap: Boolean read FWordWrap write SetWordWrap default False; + property Trimming: TTextTrimming read FTrimming write SetTrimming default TTextTrimming.None; + property Owner: TPersistent read FOwner; + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; + end; + + ITextSettings = interface + ['{FD99635D-D8DB-4E26-B36F-97D3AABBCCB3}'] + function GetDefaultTextSettings: TTextSettings; + function GetTextSettings: TTextSettings; + procedure SetTextSettings(const Value: TTextSettings); + function GetResultingTextSettings: TTextSettings; + function GetStyledSettings: TStyledSettings; + procedure SetStyledSettings(const Value: TStyledSettings); + + property DefaultTextSettings: TTextSettings read GetDefaultTextSettings; + property TextSettings: TTextSettings read GetTextSettings write SetTextSettings; + property ResultingTextSettings: TTextSettings read GetResultingTextSettings; + property StyledSettings: TStyledSettings read GetStyledSettings write SetStyledSettings; + end; + +//== UNIT END: FMX.Graphics +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Ani (from FMX.Ani.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + + TAnimation = class; + + ITriggerAnimation = interface + ['{8A291102-742F-45CB-9159-4E1D283AAF20}'] + procedure StartTriggerAnimation(const AInstance: TFmxObject; const APropertyName: string); + procedure StartTriggerAnimationWait(const AInstance: TFmxObject; const APropertyName: string); + end; + + /// Helpers class for quick using animation. Don't use synchronous animation on the Android. + /// Android uses asynchronous animation model. + TAnimator = class + private type + IAnimationDestroyer = interface + ['{3597F657-95E3-4E21-992D-C834EE541F1D}'] + procedure RegisterAnimation(const AAnimation: TAnimation); + end; + TAnimationDestroyer = class(TInterfacedObject, IFreeNotification, IAnimationDestroyer) + private + FAnimations: TList; + procedure DoAniFinished(Sender: TObject); + { IFreeNotification } + procedure FreeNotification(AObject: TObject); + public + constructor Create; + destructor Destroy; override; + procedure RegisterAnimation(const AAnimation: TAnimation); + end; + private class var + FDestroyer: IAnimationDestroyer; + private + class procedure CreateDestroyer; + class procedure Uninitialize; + public + { animations } + class procedure StartAnimation(const Target: TFmxObject; const AName: string); + class procedure StopAnimation(const Target: TFmxObject; const AName: string); + class procedure StartTriggerAnimation(const Target: TFmxObject; const AInstance: TFmxObject; const APropertyName: string); + class procedure StartTriggerAnimationWait(const Target: TFmxObject; const AInstance: TFmxObject; const APropertyName: string); + class procedure StopTriggerAnimation(const Target: TFmxObject; const AInstance: TFmxObject; const APropertyName: string); + { default } + class procedure DefaultStartTriggerAnimation(const Target, AInstance: TFmxObject; const APropertyName: string); static; + class procedure DefaultStartTriggerAnimationWait(const Target: TFmxObject; const AInstance: TFmxObject; const APropertyName: string); + { animation property } + /// Asynchronously animates float type property and don't wait finishing of animation. + class procedure AnimateFloat(const Target: TFmxObject; const APropertyName: string; const NewValue: Single; Duration: Single = 0.2; + AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear); + /// Asynchronously animates float type property with start delay and don't wait finishing of animation. + class procedure AnimateFloatDelay(const Target: TFmxObject; const APropertyName: string; const NewValue: Single; Duration: Single = 0.2; + Delay: Single = 0.0; AType: TAnimationType = TAnimationType.In; + AInterpolation: TInterpolationType = TInterpolationType.Linear); + /// Synchronously animates float type property and wait finishing of animation. + /// Don't use it on the Android. See detains in comment TAnimator. + class procedure AnimateFloatWait(const Target: TFmxObject; const APropertyName: string; const NewValue: Single; Duration: Single = 0.2; + AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear); + /// Asynchronously animates integer type property and don't wait finishing of animation. + class procedure AnimateInt(const Target: TFmxObject; const APropertyName: string; const NewValue: Integer; Duration: Single = 0.2; + AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear); + /// Synchronously animates integer type property and wait finishing of animation. + /// Don't use it on the Android. See detains in comment TAnimator. + class procedure AnimateIntWait(const Target: TFmxObject; const APropertyName: string; const NewValue: Integer; Duration: Single = 0.2; + AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear); + /// Asynchronously animates color type property and don't wait finishing of animation. + class procedure AnimateColor(const Target: TFmxObject; const APropertyName: string; NewValue: TAlphaColor; Duration: Single = 0.2; + AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear); + /// Stops all current animations of specified property of Target object. + class procedure StopPropertyAnimation(const Target: TFmxObject; const APropertyName: string); + end; + +{ TAnimation } + + /// Trigger responsible for starting the animation. + TAnimationTrigger = class + public type + TTriggerInfo = record + Name: string; + Value: Boolean; + Prop: TRttiProperty; + end; + private + FTrigger: TTrigger; + FNames: TDictionary; + FRttiInfo: TList; + FTargetClass: TClass; + procedure SetTrigger(const ATrigger: TTrigger); + procedure ParseTriggerNames(const ATrigger: TTrigger); + { Rtti info } + procedure CollectRttiInfo(const ATarget: TObject); + procedure ClearRttiInfo; + public + destructor Destroy; override; + /// Whether the trigger condition contains the specified property? + function HasProperty(const APropertyName: string): Boolean; + /// Is trigger condition is true for specified object ATarget.? + function CanExecute(const ATarget: TObject): Boolean; + + /// Condition for starting animation. Contains list of pairs PropertyName and boolean value separated + /// by semicolons + property Trigger: TTrigger read FTrigger write SetTrigger; + end; + + TAnimation = class(TFmxObject) + public const + DefaultAniFrameRate = 60; + public class var + AniFrameRate: Integer; + private type + TTriggerType = (Normal, Inverse); + private class var + FAniThread: TTimer; + private + FTickCount: Integer; + FDuration: Single; + FDelay: Single; + FDelayTime: Single; + FTime: Single; + FInverse: Boolean; + FSavedInverse: Boolean; + FLoop: Boolean; + FPause: Boolean; + FRunning: Boolean; + FOnFinish: TNotifyEvent; + FOnProcess: TNotifyEvent; + FInterpolation: TInterpolationType; + FAnimationType: TAnimationType; + FEnabled: Boolean; + FAutoReverse: Boolean; + { Triggers } + FTriggers: array [TTriggerType] of TAnimationTrigger; + procedure SetEnabled(const Value: Boolean); + procedure SetTrigger(const Index: TTriggerType; const Value: TTrigger); + function GetTrigger(const Index: TTriggerType): TTrigger; + class procedure Uninitialize; + protected + ///Return normalized CurrentTime value between 0..1 + function GetNormalizedTime: Single; + procedure FirstFrame; virtual; + procedure ProcessAnimation; virtual; abstract; + procedure DoProcess; virtual; + procedure DoFinish; virtual; + procedure Loaded; override; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Start; virtual; + procedure Stop; virtual; + procedure StopAtCurrent; virtual; + /// Tries to start animation by property name APropertyName. Checks specified properties values + /// of AInstance in trigger. + /// If AInstance is not specified, then animation will not start. + procedure StartTrigger(const AInstance: TFmxObject; const APropertyName: string); + /// Stops current animation, if specified property APropertyName is in one of triggers. + procedure StopTrigger(const AInstance: TFmxObject; const APropertyName: string); + procedure ProcessTick(const ATime, ADeltaTime: Single); + property Running: Boolean read FRunning; + property Pause: Boolean read FPause write FPause; + property AnimationType: TAnimationType read FAnimationType write FAnimationType default TAnimationType.In; + property AutoReverse: Boolean read FAutoReverse write FAutoReverse default False; + property Enabled: Boolean read FEnabled write SetEnabled default False; + property Delay: Single read FDelay write FDelay; + property Duration: Single read FDuration write FDuration nodefault; + property Interpolation: TInterpolationType read FInterpolation write FInterpolation default TInterpolationType.Linear; + property Inverse: Boolean read FInverse write FInverse default False; + ///Normalized CurrentTime value between 0..1 + property NormalizedTime: Single read GetNormalizedTime; + property Loop: Boolean read FLoop write FLoop default False; + property Trigger: TTrigger index TTriggerType.Normal read GetTrigger write SetTrigger; + property TriggerInverse: TTrigger index TTriggerType.Inverse read GetTrigger write SetTrigger; + property CurrentTime: Single read FTime; + property OnProcess: TNotifyEvent read FOnProcess write FOnProcess; + property OnFinish: TNotifyEvent read FOnFinish write FOnFinish; + class property AniThread: TTimer read FAniThread; + end; + +{ TCustomPropertyAnimation } + + TCustomPropertyAnimation = class(TAnimation) + private + protected + FInstance: TObject; + FRttiProperty: TRttiProperty; + FPath, FPropertyName: string; + procedure SetPropertyName(const AValue: string); + function FindProperty: Boolean; + procedure ParentChanged; override; + procedure AssignTo(Dest: TPersistent); override; + public + property PropertyName: string read FPropertyName write SetPropertyName; + procedure Start; override; + procedure Stop; override; + end; + +{ TFloatAnimation } + + TFloatAnimation = class(TCustomPropertyAnimation) + private + FStartFloat: Single; + FStopFloat: Single; + FStartFromCurrent: Boolean; + protected + procedure ProcessAnimation; override; + procedure FirstFrame; override; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TComponent); override; + published + property AnimationType default TAnimationType.In; + property AutoReverse default False; + property Enabled default False; + property Delay; + property Duration nodefault; + property Interpolation default TInterpolationType.Linear; + property Inverse default False; + property Loop default False; + property OnProcess; + property OnFinish; + property PropertyName; + property StartValue: Single read FStartFloat write FStartFloat stored True nodefault; + property StartFromCurrent: Boolean read FStartFromCurrent write FStartFromCurrent default False; + property StopValue: Single read FStopFloat write FStopFloat stored True nodefault; + property Trigger; + property TriggerInverse; + end; + +{ TIntAnimation } + + TIntAnimation = class(TCustomPropertyAnimation) + private + FStartValue: Integer; + FStopValue: Integer; + FStartFromCurrent: Boolean; + protected + procedure ProcessAnimation; override; + procedure FirstFrame; override; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TComponent); override; + published + property AnimationType default TAnimationType.In; + property AutoReverse default False; + property Enabled default False; + property Delay; + property Duration nodefault; + property Interpolation default TInterpolationType.Linear; + property Inverse default False; + property Loop default False; + property OnProcess; + property OnFinish; + property PropertyName; + property StartValue: Integer read FStartValue write FStartValue stored True nodefault; + property StartFromCurrent: Boolean read FStartFromCurrent write FStartFromCurrent default False; + property StopValue: Integer read FStopValue write FStopValue stored True nodefault; + property Trigger; + property TriggerInverse; + end; + +{ TColorAnimation } + + TColorAnimation = class(TCustomPropertyAnimation) + private + FStartColor: TAlphaColor; + FStopColor: TAlphaColor; + FStartFromCurrent: Boolean; + protected + procedure ProcessAnimation; override; + procedure FirstFrame; override; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TComponent); override; + published + property AnimationType default TAnimationType.In; + property AutoReverse default False; + property Enabled default False; + property Delay; + property Duration nodefault; + property Interpolation default TInterpolationType.Linear; + property Inverse default False; + property Loop default False; + property OnProcess; + property OnFinish; + property PropertyName; + property StartValue: TAlphaColor read FStartColor write FStartColor; + property StartFromCurrent: Boolean read FStartFromCurrent write FStartFromCurrent default False; + property StopValue: TAlphaColor read FStopColor write FStopColor; + property Trigger; + property TriggerInverse; + end; + +{ TGradientAnimation } + + TGradientAnimation = class(TCustomPropertyAnimation) + private + FStartGradient: TGradient; + FStopGradient: TGradient; + FStartFromCurrent: Boolean; + procedure SetStartGradient(const Value: TGradient); + procedure SetStopGradient(const Value: TGradient); + protected + procedure ProcessAnimation; override; + procedure FirstFrame; override; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property AnimationType default TAnimationType.In; + property AutoReverse default False; + property Enabled default False; + property Delay; + property Duration nodefault; + property Interpolation default TInterpolationType.Linear; + property Inverse default False; + property Loop default False; + property OnProcess; + property OnFinish; + property PropertyName; + property StartValue: TGradient read FStartGradient write SetStartGradient; + property StartFromCurrent: Boolean read FStartFromCurrent write FStartFromCurrent default False; + property StopValue: TGradient read FStopGradient write SetStopGradient; + property Trigger; + property TriggerInverse; + end; + +{ TRectAnimation } + + TRectAnimation = class(TCustomPropertyAnimation) + private + FStartRect: TBounds; + FCurrent: TBounds; + FStopRect: TBounds; + FStartFromCurrent: Boolean; + procedure SetStartRect(const Value: TBounds); + procedure SetStopRect(const Value: TBounds); + protected + procedure ProcessAnimation; override; + procedure FirstFrame; override; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property AnimationType default TAnimationType.In; + property AutoReverse default False; + property Enabled default False; + property Delay; + property Duration nodefault; + property Interpolation default TInterpolationType.Linear; + property Inverse default False; + property Loop default False; + property OnProcess; + property OnFinish; + property PropertyName; + property StartValue: TBounds read FStartRect write SetStartRect; + property StartFromCurrent: Boolean read FStartFromCurrent write FStartFromCurrent default False; + property StopValue: TBounds read FStopRect write SetStopRect; + property Trigger; + property TriggerInverse; + end; + +{ TBitmapAnimation } + + TBitmapAnimation = class(TCustomPropertyAnimation) + private + FStartBitmap: TBitmap; + FStopBitmap: TBitmap; + procedure SetStartBitmap(Value: TBitmap); + procedure SetStopBitmap(Value: TBitmap); + protected + procedure ProcessAnimation; override; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property AnimationType default TAnimationType.In; + property AutoReverse default False; + property Enabled default False; + property Delay; + property Duration nodefault; + property Interpolation default TInterpolationType.Linear; + property Inverse default False; + property Loop default False; + property OnProcess; + property OnFinish; + property PropertyName; + property StartValue: TBitmap read FStartBitmap write SetStartBitmap; + property StopValue: TBitmap read FStopBitmap write SetStopBitmap; + property Trigger; + property TriggerInverse; + end; + +{ TBitmapListAnimation } + + TBitmapListAnimation = class(TCustomPropertyAnimation) + private type + TAnimationBitmap = class(TBitmap) + private + [Weak] FAnimation: TBitmapListAnimation; + protected + procedure ReadStyleLookup(Reader: TReader); override; + end; + private + FAnimationCount: Integer; + FAnimationBitmap: TBitmap; + FLastAnimationStep: Integer; + FAnimationRowCount: Integer; + FAnimationLookup: string; + procedure SetAnimationBitmap(Value: TBitmap); + procedure SetAnimationRowCount(const Value: Integer); + procedure SetAnimationLookup(const Value: string); + procedure RefreshBitmap(const WorkBitmap: TBitmap = nil); + protected + procedure ProcessAnimation; override; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property AnimationBitmap: TBitmap read FAnimationBitmap write SetAnimationBitmap; + property AnimationLookup: string read FAnimationLookup write SetAnimationLookup; + property AnimationCount: Integer read FAnimationCount write FAnimationCount; + property AnimationRowCount: Integer read FAnimationRowCount write SetAnimationRowCount default 1; + property AnimationType default TAnimationType.In; + property AutoReverse default False; + property Enabled default False; + property Delay; + property Duration nodefault; + property Interpolation default TInterpolationType.Linear; + property Inverse default False; + property Loop default False; + property OnProcess; + property OnFinish; + property PropertyName; + property Trigger; + property TriggerInverse; + end; + +{ Key Animations } + +{ TKey } + + TKey = class(TCollectionItem) + private + FKey: Single; + procedure SetKey(const Value: Single); + public + procedure Assign(Source: TPersistent); override; + published + property Key: Single read FKey write SetKey; + end; + +{ TKeys } + + TKeys = class(TCollection) + public + function FindKeys(const Time: Single; var Key1, Key2: TKey): Boolean; + end; + +{ TColorKey } + + TColorKey = class(TKey) + private + FValue: TAlphaColor; + public + procedure Assign(Source: TPersistent); override; + published + property Value: TAlphaColor read FValue write FValue; + end; + +{ TColorKeyAnimation } + + TColorKeyAnimation = class(TCustomPropertyAnimation) + private + FKeys: TKeys; + FStartFromCurrent: Boolean; + procedure SetKeys(const Value: TKeys); + protected + procedure ProcessAnimation; override; + procedure FirstFrame; override; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property AnimationType default TAnimationType.In; + property AutoReverse default False; + property Enabled default False; + property Delay; + property Duration nodefault; + property Interpolation default TInterpolationType.Linear; + property Inverse default False; + property Keys: TKeys read FKeys write SetKeys; + property Loop default False; + property OnProcess; + property OnFinish; + property PropertyName; + property StartFromCurrent: Boolean read FStartFromCurrent write FStartFromCurrent; + property Trigger; + property TriggerInverse; + end; + +{ TFloatKey } + + TFloatKey = class(TKey) + private + FValue: Single; + published + property Value: Single read FValue write FValue; + end; + +{ TFloatKeyAnimation } + + TFloatKeyAnimation = class(TCustomPropertyAnimation) + private + FKeys: TKeys; + FStartFromCurrent: Boolean; + procedure SetKeys(const Value: TKeys); + protected + procedure ProcessAnimation; override; + procedure FirstFrame; override; + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property AnimationType default TAnimationType.In; + property AutoReverse default False; + property Enabled default False; + property Delay; + property Duration nodefault; + property Interpolation default TInterpolationType.Linear; + property Inverse default False; + property Keys: TKeys read FKeys write SetKeys; + property Loop default False; + property OnProcess; + property OnFinish; + property PropertyName; + property StartFromCurrent: Boolean read FStartFromCurrent write FStartFromCurrent; + property Trigger; + property TriggerInverse; + end; + +function InterpolateLinear(t, B, C, D: Single): Single; +function InterpolateSine(t, B, C, D: Single; AType: TAnimationType): Single; +function InterpolateQuint(t, B, C, D: Single; AType: TAnimationType): Single; +function InterpolateQuart(t, B, C, D: Single; AType: TAnimationType): Single; +function InterpolateQuad(t, B, C, D: Single; AType: TAnimationType): Single; +function InterpolateExpo(t, B, C, D: Single; AType: TAnimationType): Single; +function InterpolateElastic(t, B, C, D, A, P: Single; AType: TAnimationType): Single; +function InterpolateCubic(t, B, C, D: Single; AType: TAnimationType): Single; +function InterpolateCirc(t, B, C, D: Single; AType: TAnimationType): Single; +function InterpolateBounce(t, B, C, D: Single; AType: TAnimationType): Single; +function InterpolateBack(t, B, C, D, S: Single; AType: TAnimationType): Single; + +//== UNIT END: FMX.Ani +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.MultiResBitmap (from FMX.MultiResBitmap.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + TCustomMultiResBitmap = class; + TCustomBitmapItem = class; + + EMultiResBitmap = class(EComponentError) + end; + + TBitmapOfItem = class(TBitmap) + private + [Weak] FBitmapItem: TCustomBitmapItem; + FIsChanged: Boolean; + protected + procedure DoChange; override; + public + property BitmapItem: TCustomBitmapItem read FBitmapItem; + property IsChanged: Boolean read FIsChanged write FIsChanged; + end; + + TCustomBitmapItem = class(TCollectionItem) + public const + ScaleRange = -3; + ScaleMax = 100; + ScaleDefault = 1; + private + FFixed: Boolean; + FDormant: Boolean; + FDormantChanging: Boolean; + FBitmap: TBitmapOfItem; + FStream: TMemoryStream; + [Weak] FMultiResBitmap: TCustomMultiResBitmap; + FScale: Single; + FFileName: string; + FWidth: Word; + FHeight: Word; + function GetFixed: Boolean; + procedure SetScale(const Value: Single); + procedure SetBitmap(const Value: TBitmapOfItem); + function GetBitmap: TBitmapOfItem; + procedure ReadFileName(Reader: TReader); + procedure WriteFileName(Writer: TWriter); + function GetComponent: TComponent; + procedure SetDormant(const Value: Boolean); + procedure ReadBitmap(Stream: TStream); + procedure WriteBitmap(Stream: TStream); + function GetIsEmpty: Boolean; + procedure ReadHeight(Reader: TReader); + procedure ReadWidth(Reader: TReader); + procedure WriteHeight(Writer: TWriter); + procedure WriteWidth(Writer: TWriter); + protected + procedure SetCollection(Value: TCollection); override; + procedure DefineProperties(Filer: TFiler); override; + function ScaleStored: Boolean; virtual; + procedure SetFixed(const Value: Boolean); + function GetDisplayName: string; override; + procedure SetIndex(Value: Integer); override; + function BitmapStored: Boolean; virtual; + public + constructor Create(Collection: TCollection); override; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + function Equals(Obj: TObject): Boolean; override; + procedure Clear; + property MultiResBitmap: TCustomMultiResBitmap read FMultiResBitmap; + property Fixed: Boolean read GetFixed; + property Component: TComponent read GetComponent; + class function ScaleOfBitmap(const SourceSize, DestinationSize: TSize): Double; + class function RectOfBitmap(const SourceSize, DestinationSize: TSize): TRect; + function CreateBitmap(const AFileName: string = ''): TBitmap; virtual; + property Scale: Single read FScale write SetScale stored ScaleStored nodefault; + property Bitmap: TBitmapOfItem read GetBitmap write SetBitmap stored False; + property FileName: string read FFileName write FFileName stored False; + property Dormant: Boolean read FDormant write SetDormant; + property IsEmpty: Boolean read GetIsEmpty; + property Width: Word read FWidth stored False; + property Height: Word read FHeight stored False; + end; + + TCustomBitmapItemClass = class of TCustomBitmapItem; + TFixedBitmapItemClass = class of TFixedBitmapItem; + + TSizeKind = (Custom, Default, Source); + + TCustomMultiResBitmap = class(TOwnedCollection) + private + FFixed: Boolean; + FWidth: Word; + FHeight: Word; + FSizeKind: TSizeKind; + FTransparentColor: TColor; + function GetFixed: Boolean; + procedure ReadWidth(Reader: TReader); + procedure WriteWidth(Writer: TWriter); + procedure ReadHeight(Reader: TReader); + procedure WriteHeight(Writer: TWriter); + function GetItem(Index: Integer): TCustomBitmapItem; + procedure SetItem(Index: Integer; const Value: TCustomBitmapItem); + function GetComponent: TComponent; + procedure ReadLoadSize(Reader: TReader); + procedure WriteLoadSize(Writer: TWriter); + procedure ReadColor(Reader: TReader); + procedure WriteColor(Writer: TWriter); + function GetBitmaps(Scale: Single): TBitmapOfItem; + procedure SetBitmaps(Scale: Single; const Value: TBitmapOfItem); + protected + procedure SetFixed(const Value: Boolean); + function GetDefaultSize: TSize; virtual; + procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override; + procedure DefineProperties(Filer: TFiler); override; + public + constructor Create(AOwner: TPersistent; ItemClass: TCustomBitmapItemClass); + function ScaleArray(IncludeEmpty: Boolean): TArray; + function ItemByScale(const AScale: Single; const ExactMatch: Boolean; + const IncludeEmpty: Boolean): TCustomBitmapItem; + procedure LoadItemFromStream(Stream: TStream; Scale: Single); + procedure LoadFromStream(S: TStream); virtual; + procedure SaveToStream(S: TStream); virtual; + function Equals(Obj: TObject): Boolean; override; + procedure Assign(Source: TPersistent); override; + /// Returns the default value of + /// SizeKind property + function GetDefaultSizeKind: TSizeKind; virtual; + function Add: TCustomBitmapItem; + /// Load file adding or replacing a single image + /// Scale to which the file being loaded corresponds. If the image in this scale does not + /// exist, a new item in the collection is created. Otherwise, the existing image is replaced. + /// The name of the file + /// New or updated item in the collection + /// When loading, SizeKind, Width, Height, TransparentColor properties are used + function AddOrSet(const Scale: Single; const FileName: string): TCustomBitmapItem; + function Insert(Index: Integer): TCustomBitmapItem; + property Items[Index: Integer]: TCustomBitmapItem read GetItem write SetItem; default; + property Bitmaps[Scale: Single]: TBitmapOfItem read GetBitmaps write SetBitmaps; + property Component: TComponent read GetComponent; + property Fixed: Boolean read GetFixed; + property DefaultSize: TSize read GetDefaultSize; + property SizeKind: TSizeKind read FSizeKind write FSizeKind stored False; + property Width: Word read FWidth write FWidth stored False; + property Height: Word read FHeight write FHeight stored False; + property TransparentColor: TColor read FTransparentColor write FTransparentColor stored False; + end; + + TFixedBitmapItem = class(TCustomBitmapItem) + private + protected + function GetDisplayName: string; override; + public + constructor Create(Collection: TCollection); override; + published + property Scale; + property Bitmap; + end; + + TFixedMultiResBitmap = class(TCustomMultiResBitmap) + private + procedure CreateItem(Scale: Single); + procedure CreateItems; + function GetItem(Index: Integer): TFixedBitmapItem; + procedure SetItem(Index: Integer; const Value: TFixedBitmapItem); + procedure UpdateFixed; + public + constructor Create(AOwner: TPersistent; ItemClass: TFixedBitmapItemClass); overload; + constructor Create(AOwner: TPersistent); overload; + procedure EndUpdate; override; + function Add: TFixedBitmapItem; + function Insert(Index: Integer): TFixedBitmapItem; + property Items[Index: Integer]: TFixedBitmapItem read GetItem write SetItem; default; + end; + + TScaleName = record + Scale: Single; + Name: string; + end; + + TScaleList = TList; + + TScaleNameComparer = class(TInterfacedObject, IComparer) + function Compare(const Left, Right: TScaleName): Integer; + end; + + IMultiResBitmapObject = interface(IBitmapObject) + ['{D64BEB1F-D3C5-4C83-BE1C-DBBA319C0EA5}'] + function GetMultiResBitmap: TCustomMultiResBitmap; + property MultiResBitmap: TCustomMultiResBitmap read GetMultiResBitmap; + end; + +function ScaleList: TScaleList; +function RegisterScaleName(Scale: Single; Name: string): Boolean; + +//== UNIT END: FMX.MultiResBitmap +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Types3D (from FMX.Types3D.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +{ Points and rects } + +type + /// Record type for the information of an axis aligned box in + /// 3D. + TBoundingBox = record + private + function GetWidth: Single; + procedure SetWidth(const Value: Single); + function GetHeight: Single; + procedure SetHeight(const Value: Single); + function GetDepth: Single; + procedure SetDepth(const Value: Single); + //returns the center point of the box; + function GetCenterPoint: TPoint3D; + public + /// Constructor with a simple vertex. + constructor Create(const AnOrigin: TPoint3D); overload; + /// Constructor with a vertex and the dimensions of the box. + constructor Create(const AnOrigin: TPoint3D; const Width, Height, Depth: Single); overload; + /// Constructor with the corners values. + constructor Create(const Left, Top, Near, Right, Bottom, Far: Single); overload; + /// Constructor with two corners. See Normalize function. + constructor Create(const APoint1, APoint2: TPoint3D; NormalizeBox: Boolean = False); overload; + /// Constructor with a reference box. See Normalize function. + constructor Create(const ABox: TBoundingBox; NormalizeBox: Boolean = False); overload; + /// Constructor with a point cloud. + constructor Create(const Points: TArray); overload; + /// Constructor with a point cloud. + constructor Create(const Points: PPoint3D; const PointCount: Integer); overload; + + /// Equality operator taking account a default epsilon. + class operator Equal(const LeftBox, RightBox: TBoundingBox): Boolean; + /// Not equality operator taking account a default epsilon. + class operator NotEqual(const LeftBox, RightBox: TBoundingBox): Boolean; + + /// Union of two boxes. + class operator Add(const LeftBox, RightBox: TBoundingBox): TBoundingBox; + + /// Intersects two boxes. + class operator Multiply(const LeftBox, RightBox: TBoundingBox): TBoundingBox; + + /// Returns true if the box is invalid. + class function Empty: TBoundingBox; inline; static; + + /// This function returns the scale value that can be used to scale this box to fit into the desired area. + function FitIntoScale(const ADesignatedArea: TBoundingBox): Single; + /// This function returns a new box which is the original box scaled by a single value to fit into + /// the desired area. A ARatio value is used to return the scale value used to perform this operation. + function FitInto(const ADesignatedArea: TBoundingBox; out ARatio: Single): TBoundingBox; overload; + /// This function returns a new box which is the original box scaled by a single value to fit into + /// the desired area. + function FitInto(const ADesignatedArea: TBoundingBox): TBoundingBox; overload; + + /// Makes sure TopLeftNear is above and to the left of BottomRightFar. + function Normalize: TBoundingBox; + + /// Returns true if left = right or top = bottom or near = far. + function IsEmpty(const Epsilon: Single = TEpsilon.Vector): Boolean; + + /// Returns true if the point is inside the box. + function Contains(const APoint: TPoint3D): Boolean; overload; + + /// Returns true if the box encloses ABox completely. + function Contains(const ABox: TBoundingBox): Boolean; overload; + + /// Returns true if any part of the box covers ABox. + function IntersectsWith(const ABox: TBoundingBox): Boolean; + + /// Computes an intersection with the incoming box and returns that intersection. + function Intersect(const DestBox: TBoundingBox): TBoundingBox; + + /// Returns the minimum box (with lowest volume) envolving this box and DestBox. + function Union(const DestBox: TBoundingBox): TBoundingBox; overload; + + /// Offsets the box origin relative to current position. + function Offset(const DX, DY, DZ: Single): TBoundingBox; overload; + /// Offsets the box origin relative to current position. + function Offset(const APoint: TPoint3D): TBoundingBox; overload; + + /// Inflate the box by DX, DY and DZ. + function Inflate(const DX, DY, DZ: Single): TBoundingBox; overload; + /// Inflate in all directions. + function Inflate(const DL, DT, DN, DR, DB, DF: Single): TBoundingBox; overload; + + /// Returns the size of the box in a TPoint record. + function GetSize: TPoint3D; + + /// The same as the equality operator, taking account a given epsilon. + function EqualsTo(const ABox: TBoundingBox; const Epsilon: Single = 0): Boolean; + + /// When the Width value is changed, the Right value is modified, leaving the Left value + /// unchanged. + property Width: Single read GetWidth write SetWidth; + /// When the Height value is changed, the Bottom value is modified, leaving the Top value + /// unchanged. + property Height: Single read GetHeight write SetHeight; + /// When the Depth value is changed, the Far value is modified, leaving the Near value unchanged. + property Depth: Single read GetDepth write SetDepth; + + /// Returns the center of the box. + property CenterPoint: TPoint3D read GetCenterPoint; + + /// Case to couple the fields in the box. + case Integer of + /// Minimum and maximum corners by separated values. + 0: (Left, Top, Near, Right, Bottom, Far: Single;); + /// Minimum and maximum corners. + 1: (TopLeftNear, BottomRightFar: TPoint3D); + /// Minimum and maximum corners. + 2: (MinCorner, MaxCorner: TPoint3D); + end; + + TBox = TBoundingBox deprecated 'Use TBoundingBox'; + TMatrix3DDynArray = array of TMatrix3D; + TPoint3DDynArray = array of TPoint3D; + TPointFDynArray = array of TPointF; + +const + NullVector3D: TVector3D = (X: 0; Y: 0; Z: 0; W: 1); + NullPoint3D: TPoint3D = (X: 0; Y: 0; Z: 0); + + MaxLightCount = 256; + +type + TContext3D = class; + TVertexBuffer = class; + TIndexBuffer = class; + TContextShader = class; + TMaterial = class; + +{ TVertexBuffer } + + TVertexFormat = (Vertex, Normal, Color0, Color1, Color2, Color3, ColorF0, ColorF1, ColorF2, ColorF3, TexCoord0, TexCoord1, TexCoord2, TexCoord3, BiNormal, Tangent); + TVertexFormats = set of TVertexFormat; + + TVertexElement = record + Format: TVertexFormat; + Offset: Integer; + end; + TVertexDeclaration = array of TVertexElement; + + TVertexBuffer = class(TPersistent) + private + FBuffer: Pointer; + FFormat: TVertexFormats; + FLength: Integer; + FSize: Integer; + FVertexSize: Integer; + FTexCoord0: Integer; + FTexCoord1: Integer; + FTexCoord2: Integer; + FTexCoord3: Integer; + FColor0: Integer; + FColor1: Integer; + FColor2: Integer; + FColor3: Integer; + FColorF0: Integer; + FColorF1: Integer; + FColorF2: Integer; + FColorF3: Integer; + FNormal: Integer; + FBiNormal: Integer; + FTangent: Integer; + FSaveLength: Integer; + function GetVertices(AIndex: Integer): TPoint3D; inline; + function GetTexCoord0(AIndex: Integer): TPointF; inline; + function GetColor0(AIndex: Integer): TAlphaColor; inline; + function GetNormals(AIndex: Integer): TPoint3D; inline; + function GetNormalsPtr(AIndex: Integer): PPoint3D; inline; + function GetColor1(AIndex: Integer): TAlphaColor; inline; + function GetTexCoord1(AIndex: Integer): TPointF; inline; + function GetTexCoord2(AIndex: Integer): TPointF; inline; + function GetTexCoord3(AIndex: Integer): TPointF; inline; + function GetVerticesPtr(AIndex: Integer): PPoint3D; inline; + function GetItemPtr(AIndex: Integer): Pointer; inline; + procedure SetVertices(AIndex: Integer; const Value: TPoint3D); inline; + procedure SetColor0(AIndex: Integer; const Value: TAlphaColor); inline; + procedure SetNormals(AIndex: Integer; const Value: TPoint3D); inline; + procedure SetColor1(AIndex: Integer; const Value: TAlphaColor); inline; + procedure SetTexCoord0(AIndex: Integer; const Value: TPointF); inline; + procedure SetTexCoord1(AIndex: Integer; const Value: TPointF); inline; + procedure SetTexCoord2(AIndex: Integer; const Value: TPointF); inline; + procedure SetTexCoord3(AIndex: Integer; const Value: TPointF); inline; + procedure SetLength(const Value: Integer); + function GetColor2(AIndex: Integer): TAlphaColor; + function GetColor3(AIndex: Integer): TAlphaColor; + procedure SetColor2(AIndex: Integer; const Value: TAlphaColor); + procedure SetColor3(AIndex: Integer; const Value: TAlphaColor); + function GetBiNormals(AIndex: Integer): TPoint3D; + procedure SetBiNormals(AIndex: Integer; const Value: TPoint3D); + function GetTangents(AIndex: Integer): TPoint3D; + procedure SetTangents(AIndex: Integer; const Value: TPoint3D); + function GetBiNormalsPtr(AIndex: Integer): PPoint3D; + function GetTangentsPtr(AIndex: Integer): PPoint3D; + procedure SetFormat(Value: TVertexFormats); + protected + public + procedure Assign(Source: TPersistent); override; + constructor Create(const AFormat: TVertexFormats; const ALength: Integer); virtual; + destructor Destroy; override; + procedure BeginDraw(const ALength: Integer); + procedure EndDraw; + function GetVertexDeclarations: TVertexDeclaration; + property Buffer: Pointer read FBuffer; + property Size: Integer read FSize; + property VertexSize: Integer read FVertexSize; + property Length: Integer read FLength write SetLength; + property Format: TVertexFormats read FFormat; + { items access } + property ItemPtr[AIndex: Integer]: Pointer read GetItemPtr; + property Vertices[AIndex: Integer]: TPoint3D read GetVertices write SetVertices; + property VerticesPtr[AIndex: Integer]: PPoint3D read GetVerticesPtr; + property Normals[AIndex: Integer]: TPoint3D read GetNormals write SetNormals; + property NormalsPtr[AIndex: Integer]: PPoint3D read GetNormalsPtr; + property BiNormals[AIndex: Integer]: TPoint3D read GetBiNormals write SetBiNormals; + property BiNormalsPtr[AIndex: Integer]: PPoint3D read GetBiNormalsPtr; + property Tangents[AIndex: Integer]: TPoint3D read GetTangents write SetTangents; + property TangentsPtr[AIndex: Integer]: PPoint3D read GetTangentsPtr; + property Color0[AIndex: Integer]: TAlphaColor read GetColor0 write SetColor0; + property Color1[AIndex: Integer]: TAlphaColor read GetColor1 write SetColor1; + property Color2[AIndex: Integer]: TAlphaColor read GetColor2 write SetColor2; + property Color3[AIndex: Integer]: TAlphaColor read GetColor3 write SetColor3; + property TexCoord0[AIndex: Integer]: TPointF read GetTexCoord0 write SetTexCoord0; + property TexCoord1[AIndex: Integer]: TPointF read GetTexCoord1 write SetTexCoord1; + property TexCoord2[AIndex: Integer]: TPointF read GetTexCoord2 write SetTexCoord2; + property TexCoord3[AIndex: Integer]: TPointF read GetTexCoord3 write SetTexCoord3; + end; + +{ TIndexBuffer } + + TIndexFormat = (UInt16, UInt32); + + TIndexBuffer = class(TPersistent) + private + FBuffer: Pointer; + FLength: Integer; + FIndexSize: Integer; + FSize: Integer; + FSaveLength: Integer; + FFormat: TIndexFormat; + function GetIndices(AIndex: Integer): Integer; inline; + procedure SetIndices(AIndex: Integer; const Value: Integer); inline; + procedure SetLength(const Value: Integer); + procedure SetFormat(const Value: TIndexFormat); + protected + public + procedure Assign(Source: TPersistent); override; + constructor Create(const ALength: Integer; const AFormat: TIndexFormat = TIndexFormat.UInt16); virtual; + destructor Destroy; override; + procedure BeginDraw(const ALength: Integer); + procedure EndDraw; + property Buffer: Pointer read FBuffer; + property Format: TIndexFormat read FFormat write SetFormat; + property IndexSize: Integer read FIndexSize; + property Size: Integer read FSize; + property Length: Integer read FLength write SetLength; + { items access } + property Indices[AIndex: Integer]: Integer read GetIndices write SetIndices; default; + end; + +{ TMeshData } + + TMeshVertex = packed record + x, y, z: single; + nx, ny, nz: single; + tu, tv: single; + end; + + TMeshData = class(TPersistent) + public + type + TCalculateNormalMethod = (Default, Fastest, Slowest); + private + type + TVertexSmoothNormalInfo = record + VertexId: Integer; + ScaledRoundedX, ScaledRoundedY, ScaledRoundedZ: Integer; + end; + private + FVertexBuffer: TVertexBuffer; + FIndexBuffer: TIndexBuffer; + FOnChanged: TNotifyEvent; + FFaceNormals: TPoint3DDynArray; + FBoundingBox: TBoundingBox; + FBoundingBoxUpdateNeeded: Boolean; + function GetNormals: string; + function GetPoint3Ds: string; + function GetTexCoordinates: string; + procedure SetNormals(const Value: string); + procedure SetPoint3Ds(const Value: string); + procedure SetTexCoordinates(const Value: string); + function GetTriangleIndices: string; + procedure SetTriangleIndices(const Value: string); + protected + procedure DefineProperties(Filer: TFiler); override; + procedure ReadMesh(Stream: TStream); + procedure WriteMesh(Stream: TStream); + public + constructor Create; virtual; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + procedure AssignFromMeshVertex(const Vertices: array of TMeshVertex; const Indices: array of Word); overload; + procedure AssignFromMeshVertex(const Vertices: array of TMeshVertex; const Indices: array of Cardinal); overload; + procedure ChangeFormat(const ANewFormat: TVertexFormats); + procedure Clear; + procedure CalcFaceNormals(const PropagateFaceNormalsToVertices: Boolean = True); + procedure CalcSmoothNormals(const Method: TCalculateNormalMethod = TCalculateNormalMethod.Default; const WeldEpsilon: Single = 0.001); + procedure CalcTangentBinormals; + /// Returns the bounding box of the mesh. + function GetBoundingBox: TBoundingBox; + /// This function flags the mesh to inform it that it should recalculate its new bounding box because some change could be performed. + procedure BoundingBoxNeedsUpdate; + function RayCastIntersect(const Width, Height, Depth: Single; const RayPos, RayDir: TPoint3D; + var Intersection: TPoint3D): Boolean; overload; + function RayCastIntersect(const RayPos, RayDir: TPoint3D; var Intersection: TPoint3D): Boolean; overload; + procedure Render(const AContext: TContext3D; const AMaterial: TMaterial; const AOpacity: Single); + property FaceNormals: TPoint3DDynArray read FFaceNormals; + property IndexBuffer: TIndexBuffer read FIndexBuffer; + property VertexBuffer: TVertexBuffer read FVertexBuffer; + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; + published + property Normals: string read GetNormals write SetNormals stored False; + property Points: string read GetPoint3Ds write SetPoint3Ds stored False; + property TexCoordinates: string read GetTexCoordinates write SetTexCoordinates stored False; + property TriangleIndices: string read GetTriangleIndices write SetTriangleIndices stored False; + end; + +{ Shaders } + + TContextShaderKind = (VertexShader, PixelShader); + + TContextShaderVariableKind = (Float, Float2, Float3, Vector, Matrix, Texture); + + TContextShaderVariable = record + Name: string; + Kind: TContextShaderVariableKind; + Index: Integer; + Size: Integer; + // filled at run-time + ShaderKind: TContextShaderKind; + TextureUnit: Integer; + constructor Create(const Name: string; const Kind: TContextShaderVariableKind; const Index, Size: Integer); + end; + + TContextShaderArch = (Undefined, DX9, DX10, DX11_level_9, DX11, Metal, GLSL, Mac, IOS, Android, SKSL); + + TContextShaderCode = array of Byte; + TContextShaderVariables = array of TContextShaderVariable; + + TContextShaderSource = record + Arch: TContextShaderArch; + Code: TContextShaderCode; + Variables: TContextShaderVariables; + constructor Create(const Arch: TContextShaderArch; const ACode: array of Byte; + const AVariables: array of TContextShaderVariable); + function IsDefined: Boolean; + function FindVariable(const AName: string; out AShaderVariable: TContextShaderVariable): Boolean; + end; + + TContextShaderHandle = type THandle; + + TContextShader = class sealed + private + FOriginalSource: string; + FSources: array of TContextShaderSource; + FHandle: TContextShaderHandle; + FKind: TContextShaderKind; + FName: string; + FRefCount: Integer; + FContextLostId: TMessageSubscriptionId; + procedure ContextLostHandler(const Sender : TObject; const Msg : TMessage); + public + constructor Create; + destructor Destroy; override; + class function BuildKey(const Name: string; const Kind: TContextShaderKind; + const Sources: array of TContextShaderSource): string; + function GetSourceByArch(Arch: TContextShaderArch): TContextShaderSource; + procedure LoadFromData(const Name: string; const Kind: TContextShaderKind; + const OriginalSource: string; const Sources: array of TContextShaderSource); + procedure LoadFromFile(const FileName: string); + procedure LoadFromStream(const AStream: TStream); + procedure SaveToFile(const FileName: string); + procedure SaveToStream(const AStream: TStream); + property Kind: TContextShaderKind read FKind; + property Name: string read FName; + property OriginalSource: string read FOriginalSource; + property Handle: TContextShaderHandle read FHandle write FHandle; + end; + + TShaderManager = class sealed + strict private + class var FShaderList: TObjectDictionary; + class function GetShader(const Key: string): TContextShader; static; + private + public + // Reserved for internal use only - do not call directly! + class procedure UnInitialize; + // Register shader + class function RegisterShader(const Shader: TContextShader): TContextShader; + // Create shader from Data and Register, return already registered if exists + class function RegisterShaderFromData(const Name: string; const Kind: TContextShaderKind; + const OriginalSource: string; const Sources: array of TContextShaderSource): TContextShader; + // Create shader from file and Register, return already registered if exists + class function RegisterShaderFromFile(const FileName: string): TContextShader; + // Unregister shader + class procedure UnregisterShader(const Shader: TContextShader); + end; + +{ Texture } + + ITextureAccess = interface + ['{3A41B87B-99E6-4DF7-BA7D-CAC558AD0D90}'] + procedure SetHandle(const AHandle: THandle); + procedure SetTextureScale(const Scale: Single); + property Handle: THandle write SetHandle; + property TextureScale: Single write SetTextureScale; + end; + + TTextureHandle = THandle; + + TTextureFilter = (Nearest, Linear); + + TTextureStyle = (MipMaps, Dynamic, RenderTarget, Volatile); + + TTextureStyles = set of TTextureStyle; + + TTexture = class(TInterfacedPersistent, ITextureAccess) + private + FWidth: Integer; + FHeight: Integer; + FPixelFormat: TPixelFormat; + FHandle: TTextureHandle; + FStyle: TTextureStyles; + FMagFilter: TTextureFilter; + FMinFilter: TTextureFilter; + FTextureScale: Single; + FRequireInitializeAfterLost: Boolean; + FBits: Pointer; + FContextLostId: TMessageSubscriptionId; + FContextResetId: TMessageSubscriptionId; + procedure ContextLostHandler(const Sender : TObject; const Msg : TMessage); + procedure ContextResetHandler(const Sender : TObject; const Msg : TMessage); + procedure SetPixelFormat(const Value: TPixelFormat); + procedure SetStyle(const Value: TTextureStyles); + function GetBytesPerPixel: Integer; + procedure SetMagFilter(const Value: TTextureFilter); + procedure SetMinFilter(const Value: TTextureFilter); + procedure SetHeight(const Value: Integer); + procedure SetWidth(const Value: Integer); + { ITextureAccess } + procedure SetHandle(const AHandle: THandle); + procedure SetTextureScale(const Scale: Single); + protected + public + constructor Create; virtual; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + procedure SetSize(const AWidth, AHeight: Integer); + function IsEmpty: Boolean; + { hardware } + procedure Initialize; + procedure Finalize; + { access } + procedure LoadFromStream(const Stream: TStream); + procedure UpdateTexture(const Bits: Pointer; const Pitch: Integer); + { properties } + property BytesPerPixel: Integer read GetBytesPerPixel; + property MinFilter: TTextureFilter read FMinFilter write SetMinFilter; + property MagFilter: TTextureFilter read FMagFilter write SetMagFilter; + property PixelFormat: TPixelFormat read FPixelFormat write SetPixelFormat; + property TextureScale: Single read FTextureScale; // hi resolution mode + property Style: TTextureStyles read FStyle write SetStyle; + property Width: Integer read FWidth write SetWidth; + property Height: Integer read FHeight write SetHeight; + property Handle: TTextureHandle read FHandle; + end; + + TTextureBitmap = class(TBitmap) + private + FTexture: TTexture; + function GetTexture: TTexture; + protected + procedure DestroyResources; override; + procedure BitmapChanged; override; + public + property Texture: TTexture read GetTexture; + end; + +{ Materials } + + TMaterial = class abstract + public type + TProperty = (ModelViewProjection, ModelView, ModelViewInverseTranspose); + private + FOnChange: TNotifyEvent; + FModified: Boolean; + FNotifyList: TList; + protected + procedure DoInitialize; virtual; abstract; + procedure DoApply(const Context: TContext3D); virtual; + procedure DoReset(const Context: TContext3D); virtual; + procedure DoChange; virtual; + class function DoGetMaterialProperty(const Prop: TMaterial.TProperty): string; virtual; + public + constructor Create; virtual; + destructor Destroy; override; + class function GetMaterialProperty(const Prop: TProperty): string; + procedure Apply(const Context: TContext3D); + procedure Reset(const Context: TContext3D); + { FreeNotify } + procedure AddFreeNotify(const AObject: IFreeNotification); + procedure RemoveFreeNotify(const AObject: IFreeNotification); + { Proeprties } + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property Modified: Boolean read FModified; + end; + TMaterialClass = class of TMaterial; + +{ Lights } + + TLightType = (Directional, Point, Spot); + + TLightDescription = record + Enabled: Boolean; + Color: TAlphaColor; + LightType: TLightType; + SpotCutOff: Single; + SpotExponent: Single; + Position: TPoint3D; + Direction: TPoint3D; + constructor Create(AEnabled: Boolean; AColor: TAlphaColor; ALightType: TLightType; ASpotCutOff: Single; + ASpotExponent: Single; APosition: TPoint3D; ADirection: TPoint3D); + end; + + TLightDescriptionList = TList; + +{ Context's Messages } + + /// This message is sent when before TContextLostMessage message in order to save data. + TContextBeforeLosingMessage = class(TMessage) + end; + + /// Message that indicates that the rendering context has been + /// lost. + TContextLostMessage = class(TMessage) + end; + + /// Message that indicates that a rendering context has been + /// created. + TContextResetMessage = class(TMessage) + end; + + /// Message that indicates that the rendering context has been + /// removed. + TContextRemovedMessage = class(TMessage) + end; + +{ Context } + + TProjection = (Camera, Screen); + + TMultisample = (None, TwoSamples, FourSamples); + + TClearTarget = (Color, Depth, Stencil); + + TClearTargets = set of TClearTarget; + + TStencilOp = (Keep, Zero, Replace, Increase, Decrease, Invert); + + TStencilFunc = (Never, Less, Lequal, Greater, Gequal, Equal, NotEqual, Always); + + TContextState = ( + // 2D screen matrix + cs2DScene, + // 3D camera matrix + cs3DScene, + // Depth + csZTestOn, csZTestOff, + csZWriteOn, csZWriteOff, + // Alpha Blending + csAlphaBlendOn, csAlphaBlendOff, + // Stencil + csStencilOn, csStencilOff, + // Color + csColorWriteOn, csColorWriteOff, + // Scissor + csScissorOn, csScissorOff, + // Faces + csFrontFace, csBackFace, csAllFace + ); + + TPrimitivesKind = (Points, Lines, Triangles); + + IContextObject = interface + ['{A78019E4-F09A-4F8D-AC43-E8D51FE3AD69}'] + function GetContext: TContext3D; + property Context: TContext3D read GetContext; + end; + + EContext3DException = class(Exception); + + TContextStyle = (RenderTargetFlipped, Fragile); + TContextStyles = set of TContextStyle; + + TContext3D = class abstract(TInterfacedPersistent, IFreeNotification) + public type + TIndexBufferSupport = (Unknown, Int16, Int32); + protected const + DefaultMaxLightCount = 8; + DefaultTextureUnitCount = 8; + DefaultScale = 1; + MaxInt16Vertices = 65536; + MaxInt16Indices = 65536; + private type + TStatesArray = array [TContextState] of Boolean; + TContextStates = record + States: TStatesArray; + Matrix: TMatrix3D; + Context: TContext3D; + ScissorRect: TRect; + end; + private class var + FContextCount: Integer; + FSaveStates: TList; + FGlobalBeginSceneCount: Integer; + FChangeStateCount: Integer; + FChangeShaderCount: Integer; + FFPS, FRenderTime, FBeginTime, FEndTime: Double; + FTimerService: IFMXTimerService; + FFrameCount: Integer; + FCurrentContext: TContext3D; + FCurrentStates: TStatesArray; + FCurrentVertexShader: TContextShader; + FCurrentPixelShader: TContextShader; + FCurrentOpacity: Single; + FCurrentMaterial: TMaterial; + FCurrentMaterialClass: TMaterialClass; + FCurrentFormat: TVertexFormats; + FCurrentScissorRect: TRect; + private + FBeginSceneCount: Integer; + FRecalcScreenMatrix, FRecalcProjectionMatrix: Boolean; + FScreenMatrix, FProjectionMatrix: TMatrix3D; + FInvScreenMatrix, FInvProjectionMatrix: TMatrix3D; + FCenterOffset: TPosition; + FParent: TWindowHandle; + FWidth, FHeight: Integer; + FScale: Single; + FTexture: TTexture; + FLights: TLightDescriptionList; + { style } + FMultisample: TMultisample; + FDepthStencil: Boolean; + { camera } + FCurrentMatrix: TMatrix3D; + FCurrentCameraMatrix: TMatrix3D; + FCurrentCameraInvMatrix: TMatrix3D; + FCurrentAngleOfView: Single; + { materials } + FDefaultMaterial: TMaterial; + { renderto } + FRenderToMatrix: TMatrix3D; + function GetCurrentState(AIndex: TContextState): Boolean; + function GetProjectionMatrix: TMatrix3D; + function GetScreenMatrix: TMatrix3D; + procedure ApplyMaterial(const Material: TMaterial); + procedure ResetMaterial(const Material: TMaterial); + function GetCurrentModelViewProjectionMatrix: TMatrix3D; + procedure DrawPrimitivesMultiBatch(const AKind: TPrimitivesKind; const Vertices, Indices: Pointer; + const VertexDeclaration: TVertexDeclaration; const VertexSize, VertexCount, IndexSize, IndexCount: Integer); + protected + procedure AssignTo(Dest: TPersistent); override; + { buffer } + procedure DoFreeBuffer; virtual; abstract; + procedure DoResize; virtual; abstract; + procedure DoCreateBuffer; virtual; abstract; + procedure DoCopyToBitmap(const Dest: TBitmap; const ARect: TRect); virtual; + procedure DoCopyToBits(const Bits: Pointer; const Pitch: Integer; const ARect: TRect); virtual; abstract; + { rendering } + /// Used to initialize Scale property + function GetContextScale: Single; virtual; + function DoBeginScene: Boolean; virtual; + procedure DoEndScene; virtual; + procedure DoClear(const ATarget: TClearTargets; const AColor: TAlphaColor; const ADepth: single; const AStencil: Cardinal); virtual; abstract; + { states } + procedure DoSetContextState(AState: TContextState); virtual; abstract; + procedure DoSetStencilOp(const Fail, ZFail, ZPass: TStencilOp); virtual; abstract; + procedure DoSetStencilFunc(const Func: TStencilfunc; Ref, Mask: Cardinal); virtual; abstract; + { scissor } + procedure DoSetScissorRect(const ScissorRect: TRect); virtual; abstract; + { drawing } + /// Provides a mechanism to draw the specified batch of primitives on currently selected hardware-accelerated + /// layer. This method may support only a limited number of vertices and/or primitives. It may be called multiple + /// times by DoDrawPrimitives to render larger buffers. + procedure DoDrawPrimitivesBatch(const AKind: TPrimitivesKind; const Vertices, Indices: Pointer; + const VertexDeclaration: TVertexDeclaration; const VertexSize, VertexCount, IndexSize, + IndexCount: Integer); virtual; abstract; + /// This either provides a mechanism to draw the specified primitives (without any limitations) either + /// directly in hardware or by dividing the buffers in batches and then calling DoDrawPrimitivesBatch to render + /// each individual batch. + procedure DoDrawPrimitives(const AKind: TPrimitivesKind; const Vertices, Indices: Pointer; + const VertexDeclaration: TVertexDeclaration; const VertexSize, VertexCount, IndexSize, + IndexCount: Integer); virtual; + { texture } + class procedure DoInitializeTexture(const Texture: TTexture); virtual; abstract; + class procedure DoFinalizeTexture(const Texture: TTexture); virtual; abstract; + class procedure DoUpdateTexture(const Texture: TTexture; const Bits: Pointer; const Pitch: Integer); virtual; abstract; + { bitmap } + class function DoBitmapToTexture(const Bitmap: TBitmap): TTexture; virtual; + { shaders } + class procedure DoInitializeShader(const Shader: TContextShader); virtual; abstract; + class procedure DoFinalizeShader(const Shader: TContextShader); virtual; abstract; + procedure DoSetShaders(const VertexShader, PixelShader: TContextShader); virtual; abstract; + procedure DoSetShaderVariable(const Name: string; const Data: array of TVector3D); overload; virtual; abstract; + procedure DoSetShaderVariable(const Name: string; const Texture: TTexture); overload; virtual; abstract; + procedure DoSetShaderVariable(const Name: string; const Matrix: TMatrix3D); overload; virtual; abstract; + { IFreeNotification } + procedure FreeNotification(AObject: TObject); virtual; + { constructors } + constructor CreateFromWindow(const AParent: TWindowHandle; const AWidth, AHeight: Integer; + const AMultisample: TMultisample; const ADepthStencil: Boolean); virtual; + constructor CreateFromTexture(const ATexture: TTexture; const AMultisample: TMultisample; + const ADepthStencil: Boolean); virtual; + procedure InitContext; virtual; + /// Returns supported limit in index buffers on currently selected hardware-accelerated layer. + function GetIndexBufferSupport: TIndexBufferSupport; virtual; + public + destructor Destroy; override; + procedure SetSize(const AWidth, AHeight: Integer); + procedure SetMultisample(const Multisample: TMultisample); + procedure SetStateFromContext(const AContext: TContext3D); + class procedure ResetStates; static; + property BeginSceneCount: Integer read FBeginSceneCount; + class property GlobalBeginSceneCount: Integer read FGlobalBeginSceneCount; + { render to } + procedure SetRenderToMatrix(const Matrix: TMatrix3D); + { buffer } + procedure FreeBuffer; + procedure Resize; + procedure CreateBuffer; + procedure CopyToBitmap(const Dest: TBitmap; const ARect: TRect); + procedure CopyToBits(const Bits: Pointer; const Pitch: Integer; const ARect: TRect); + { rendering } + function BeginScene: Boolean; + procedure EndScene; + procedure Clear(const AColor: TAlphaColor); overload; + procedure Clear(const ATarget: TClearTargets; const AColor: TAlphaColor; const ADepth: single; const AStencil: Cardinal); overload; + { matrix } + procedure SetMatrix(const M: TMatrix3D); + procedure SetCameraMatrix(const M: TMatrix3D); + procedure SetCameraAngleOfView(const Angle: Single); + { states } + procedure PushContextStates; + procedure PopContextStates; + procedure SetContextState(const State: TContextState); + procedure SetStencilOp(const Fail, ZFail, ZPass: TStencilOp); + procedure SetStencilFunc(const Func: TStencilfunc; Ref, Mask: Cardinal); + procedure SetScissorRect(const ScissorRect: TRect); + { drawing } + procedure DrawTriangles(const Vertices: TVertexBuffer; const Indices: TIndexBuffer; + const Material: TMaterial; const Opacity: Single); + procedure DrawLines(const Vertices: TVertexBuffer; const Indices: TIndexBuffer; const Material: TMaterial; const Opacity: Single); + procedure DrawPoints(const Vertices: TVertexBuffer; const Indices: TIndexBuffer; const Material: TMaterial; const Opacity: Single); + procedure DrawPrimitives(const AKind: TPrimitivesKind; const Vertices, Indices: Pointer; + const VertexDeclaration: TVertexDeclaration; const VertexSize, VertexCount, IndexSize, IndexCount: Integer; + const Material: TMaterial; const Opacity: Single); + procedure FillRect(const TopLeft, BottomRight: TPoint3D; const Opacity: Single; const Color: TAlphaColor); + procedure FillCube(const Center, Size: TPoint3D; const Opacity: Single; const Color: TAlphaColor); + procedure DrawLine(const StartPoint, EndPoint: TPoint3D; const Opacity: Single; const Color: TAlphaColor); + procedure DrawRect(const TopLeft, BottomRight: TPoint3D; const Opacity: Single; const Color: TAlphaColor); + procedure DrawCube(const Center, Size: TPoint3D; const Opacity: Single; const Color: TAlphaColor); + procedure FillPolygon(const Center, Size: TPoint3D; const Rect: TRectF; const Points: TPolygon; + const Material: TMaterial; const Opacity: Single; Front: Boolean = True; Back: Boolean = True; + Left: Boolean = True); + { textures } + class procedure InitializeTexture(const Texture: TTexture); + class procedure FinalizeTexture(const Texture: TTexture); + class procedure UpdateTexture(const Texture: TTexture; const Bits: Pointer; const Pitch: Integer); + { bitmap } + class function BitmapToTexture(const Bitmap: TBitmap): TTexture; + { shaders } + class procedure InitializeShader(const Shader: TContextShader); + class procedure FinalizeShader(const Shader: TContextShader); + procedure SetShaders(const VertexShader, PixelShader: TContextShader); + procedure SetShaderVariable(const Name: string; const Data: array of TVector3D); overload; + procedure SetShaderVariable(const Name: string; const Texture: TTexture); overload; + procedure SetShaderVariable(const Name: string; const Matrix: TMatrix3D); overload; + procedure SetShaderVariable(const Name: string; const Color: TAlphaColor); overload; + { pick } + procedure Pick(X, Y: Single; const AProj: TProjection; var RayPos, RayDir: TVector3D); + function WorldToScreen(const AProj: TProjection; const P: TPoint3D): TPoint3D; + { states } + property CurrentModelViewProjectionMatrix: TMatrix3D read GetCurrentModelViewProjectionMatrix; + property CurrentMatrix: TMatrix3D read FCurrentMatrix; + property CurrentCameraMatrix: TMatrix3D read FCurrentCameraMatrix; + property CurrentCameraInvMatrix: TMatrix3D read FCurrentCameraInvMatrix; + property CurrentProjectionMatrix: TMatrix3D read GetProjectionMatrix; + property CurrentScreenMatrix: TMatrix3D read GetScreenMatrix; + property CurrentStates[AIndex: TContextState]: Boolean read GetCurrentState; + class property CurrentContext: TContext3D read FCurrentContext; + class property CurrentOpacity: Single read FCurrentOpacity; + class property CurrentVertexShader: TContextShader read FCurrentVertexShader; + class property CurrentPixelShader: TContextShader read FCurrentPixelShader; + class property CurrentScissorRect: TRect read FCurrentScissorRect; + { lights } + property Lights: TLightDescriptionList read FLights; + { caps } + class function Style: TContextStyles; virtual; + class function MaxLightCount: Integer; virtual; + class function MaxTextureSize: Integer; virtual; abstract; + class function TextureUnitCount: Integer; virtual; + class function PixelFormat: TPixelFormat; virtual; abstract; + class function PixelToPixelPolygonOffset: TPointF; virtual; + { statistic } + class property FPS: Double read FFPS; + class property ChangeStateCount: Integer read FChangeStateCount; + class property ChangeShaderCount: Integer read FChangeStateCount; + { materials } + property DefaultMaterial: TMaterial read FDefaultMaterial; + { properties } + property CenterOffset: TPosition read FCenterOffset; + property Height: Integer read FHeight; + property Width: Integer read FWidth; + /// Scale factor of context depends on real resolution of context. It gets from Texture.TextureScale or TWindowHandle.Scale. + property Scale: Single read FScale; + property Texture: TTexture read FTexture; + property DepthStencil: Boolean read FDepthStencil; + property Multisample: TMultisample read FMultisample; + /// Indicates supported limit in index buffers on currently selected hardware-accelerated layer. + property IndexBufferSupport: TIndexBufferSupport read GetIndexBufferSupport; + { Is this a valid/active context? } + class function Valid: Boolean; virtual; abstract; + { Window handle } + property Parent: TWindowHandle read FParent; + end; + + TContextClass = class of TContext3D; + + EContextManagerException = class(Exception); + + TContextManager = class sealed + private type + TContextClassRec = record + ContextClass: TContextClass; + Default: Boolean; + end; + strict private + class var FContextList: TList; + class var FDefaultContextClass: TContextClass; + private + class function GetDefaultContextClass: TContextClass; static; + class function GetContextCount: Integer; static; + public + // Reserved for internal use only - do not call directly! + class procedure UnInitialize; + // Register a rendering Canvas class + class procedure RegisterContext(const ContextClass: TContextClass; const ADefault: Boolean); + class property ContextCount: Integer read GetContextCount; + // Return default context class + class property DefaultContextClass: TContextClass read GetDefaultContextClass; + // Helper for shaders + class procedure InitializeShader(const Shader: TContextShader); + class procedure FinalizeShader(const Shader: TContextShader); + // Creation + class function CreateFromWindow(const AParent: TWindowHandle; const AWidth, AHeight: Integer; + const AMultisample: TMultisample; const ADepthStencil: Boolean): TContext3D; + class function CreateFromTexture(const ATexture: TTexture; const AMultisample: TMultisample; + const ADepthStencil: Boolean): TContext3D; + end; + +{ TPosition3D } + + TPosition3D = class(TPersistent) + private + FOnChange: TNotifyEvent; + FY: Single; + FX: Single; + FZ: Single; + FDefaultValue: TPoint3D; + FOnChangeY: TNotifyEvent; + FOnChangeX: TNotifyEvent; + FOnChangeZ: TNotifyEvent; + procedure SetPoint3D(const Value: TPoint3D); + procedure SetX(const Value: Single); + procedure SetY(const Value: Single); + procedure SetZ(const Value: Single); + function GetPoint3D: TPoint3D; + function GetVector: TVector3D; + procedure SetVector(const Value: TVector3D); + function IsXStored: Boolean; + function IsYStored: Boolean; + function IsZStored: Boolean; + protected + procedure DefineProperties(Filer: TFiler); override; + procedure ReadPoint(Reader: TReader); + procedure WritePoint(Writer: TWriter); + public + constructor Create(const ADefaultValue: TPoint3D); virtual; + procedure Assign(Source: TPersistent); override; + procedure SetPoint3DNoChange(const P: TPoint3D); + procedure SetVectorNoChange(const P: TVector3D); + function Empty: Boolean; + property Point: TPoint3D read GetPoint3D write SetPoint3D; + property Vector: TVector3D read GetVector write SetVector; + property DefaultValue: TPoint3D read FDefaultValue write FDefaultValue; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnChangeX: TNotifyEvent read FOnChangeX write FOnChangeX; + property OnChangeY: TNotifyEvent read FOnChangeY write FOnChangeY; + property OnChangeZ: TNotifyEvent read FOnChangeZ write FOnChangeZ; + published + property X: Single read FX write SetX stored IsXStored nodefault; + property Y: Single read FY write SetY stored IsYStored nodefault; + property Z: Single read FZ write SetZ stored IsZStored nodefault; + end; + +{ Utils } +function VertexSize(const AFormat: TVertexFormats): Integer; +function GetVertexOffset(const APosition: TVertexFormat; const AFormat: TVertexFormats): Integer; + +{ Intersection } + +function RayCastPlaneIntersect(const RayPos, RayDir, PlanePoint, PlaneNormal: TPoint3D; + var Intersection: TPoint3D): Boolean; + +function RayCastSphereIntersect(const RayPos, RayDir, SphereCenter: TPoint3D; const SphereRadius: Single; + var IntersectionNear, IntersectionFar: TPoint3D): Integer; + +function RayCastEllipsoidIntersect(const RayPos, RayDir, EllipsoidCenter: TPoint3D; const XRadius, YRadius, + ZRadius: Single; var IntersectionNear, IntersectionFar: TPoint3D): Integer; + +function RayCastCuboidIntersect(const RayPos, RayDir, CuboidCenter: TPoint3D; const Width, Height, Depth: Single; + var IntersectionNear, IntersectionFar: TPoint3D): Integer; + +function RayCastTriangleIntersect(const RayPos, RayDir: TPoint3D; const Vertex1, Vertex2, Vertex3: TPoint3D; + var Intersection: TPoint3D): Boolean; + +function WideGetToken(var Pos: Integer; const S: string; const Separators: string; const Stop: string = ''): string; + +//== UNIT END: FMX.Types3D +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.TextLayout (from FMX.TextLayout.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + TTextRange = record + Pos: Integer; + Length: Integer; + constructor Create(APos, ALength: Integer); + function InRange(const AIndex: Integer): Boolean; + end; + + TTextAttribute = record + public + Font: TFont; + Color: TAlphaColor; + + + constructor Create(const AFont: TFont; const AColor : TAlphaColor); overload; + constructor Create(const AExisting: TTextAttribute; const ANewFont: TFont); overload; + constructor Create(const AExisting: TTextAttribute; const ANewColor: TAlphaColor); overload; + end; + + TTextAttributedRange = class + public + Range: TTextRange; + Attribute: TTextAttribute; + + constructor Create(const ARange: TTextRange; const AAttribute : TTextAttribute); + destructor Destroy; override; + end; + + TTextLayout = class abstract + public const + ///Maximum size for TTextLayout + MaxLayoutSize: TPointF = (X: $FFFF; Y: $FFFF); + private + FAttributes: TList; + FFont: TFont; + FColor: TAlphaColor; + FText: string; + FWordWrap : Boolean; + FHorizontalAlign: TTextAlign; + FVerticalAlign: TTextAlign; + FPadding: TBounds; + FNeedUpdate: Boolean; + FMaxSize: TPointF; + FTopLeft: TPointF; + FUpdating: Integer; + FOpacity: Single; + FTrimming: TTextTrimming; + FRightToLeft: Boolean; + [weak] FCanvas: TCanvas; + FMessageId: TMessageSubscriptionId; + procedure SetMaxSize(const Value: TPointF); + procedure AttributesChanged(Sender: TObject; const Item: TTextAttributedRange; Action: TCollectionNotification); + procedure ChangedHandler(Sender: TObject); + function GetAttribute(const Index: Integer): TTextAttributedRange; + function GetAttributesCount: Integer; + procedure SetHorizontalAlign(const Value: TTextAlign); + procedure SetFont(const Value: TFont); + procedure SetPadding(const Value: TBounds); + procedure SetText(const Value: string); + procedure SetWordWrap(const Value: Boolean); + function GetHeight: Single; + function GetWidth: Single; + function GetSize: TSizeF; + procedure NeedUpdate; + procedure SetVerticalAlign(const Value: TTextAlign); + procedure SetTrimming(const Value: TTextTrimming); + procedure SetRightToLeft(const Value: Boolean); + procedure SetCanvas(const Value: TCanvas); + procedure SetColor(const Value: TAlphaColor); + { Handler } + procedure CanvasDestroyListener(const Sender : TObject; const M : TMessage); + protected + procedure DoRenderLayout; virtual; abstract; + procedure DoDrawLayout(const ACanvas: TCanvas); virtual; abstract; + procedure DoColorChanaged; virtual; + function GetTextHeight: Single; virtual; abstract; + function GetTextWidth: Single; virtual; abstract; + function GetTextRect: TRectF; virtual; abstract; + //Get character position from it's coordinates + function DoPositionAtPoint(const APoint: TPointF): Integer; virtual; abstract; + //Get region for text range + function DoRegionForRange(const ARange: TTextRange): TRegion; virtual; abstract; + ///Setting internal flag that informs that layout properties were changed + ///and layout should be recalculated + procedure SetNeedUpdate; + public + constructor Create(const ACanvas: TCanvas = nil); virtual; + destructor Destroy; override; + + //Attributes + procedure AddAttribute(const ARange: TTextRange; const AAttribute : TTextAttribute); overload; + procedure AddAttribute(const AAttributeRange: TTextAttributedRange); overload; + procedure DeleteAttribute(const AIndex: Integer); + procedure DeleteAttributeRange(const AFromIndex, AToIndex: Integer); + procedure ClearAttributes; + + //Render layout with desired opacity + procedure RenderLayout(const ACanvas: TCanvas); + + //Convert layout to TPathData + procedure ConvertToPath(const APath: TPathData); virtual; abstract; + //Get character position from it's coordinates + function PositionAtPoint(const APoint: TPointF; const RoundToWord: Boolean = False): Integer; + //Get region for text range + function RegionForRange(const ARange: TTextRange; const RoundToWord: Boolean = False): TRegion; + + //Restrict frequently updates + procedure BeginUpdate; + procedure EndUpdate; + + property LayoutCanvas: TCanvas read FCanvas write SetCanvas; + + /// + /// List of layout attributes + /// + property Attributes[const Index: Integer]: TTextAttributedRange read GetAttribute; + /// + /// Count of layout attributes + /// + property AttributesCount: Integer read GetAttributesCount; + /// + /// Layout text + /// + property Text: string read FText write SetText; + property Padding: TBounds read FPadding write SetPadding; + property WordWrap: Boolean read FWordWrap write SetWordWrap; + property HorizontalAlign: TTextAlign read FHorizontalAlign write SetHorizontalAlign; + property VerticalAlign: TTextAlign read FVerticalAlign write SetVerticalAlign; + property Color: TAlphaColor read FColor write SetColor default TAlphaColorRec.Black; + property Font: TFont read FFont write SetFont; + property Opacity: Single read FOpacity write FOpacity; + /// + /// Text trimmin options + /// + property Trimming: TTextTrimming read FTrimming write SetTrimming; + /// + /// Layout size limits + /// + property RightToLeft: Boolean read FRightToLeft write SetRightToLeft; + /// Returns calculated layout size. + property Size: TSizeF read GetSize; + property MaxSize: TPointF read FMaxSize write SetMaxSize; + /// + /// Coordinates of top-left layout corner. + /// + /// + /// Use this property to change layout position on canvas, which by + /// default is (0;0) + /// + property TopLeft: TPointF read FTopLeft write FTopLeft; + //Real size of layout + property Height: Single read GetHeight; + property Width: Single read GetWidth; + //Text size only + property TextHeight: Single read GetTextHeight; + property TextWidth: Single read GetTextWidth; + property TextRect: TRectF read GetTextRect; + end; + + /// Class for exceptions related to the FMX.TextLayout + /// unit. + ETextLayoutException = class(Exception); + + TTextLayoutClass = class of TTextLayout; + + ETextLayoutManagerException = class(Exception); + + TTextLayoutManager = class sealed + private type + TTextLayoutRecord = record + LayoutClass: TTextLayoutClass; + CanvasClass: TCanvasClass; + end; + strict private + class var FLayoutList: TList; + class var FDefaultLayoutClass: TTextLayoutClass; + private + class function GetDefaultLayout: TTextLayoutClass; static; + public + // Reserved for internal use only - do not call directly! + class procedure UnInitialize; + // Register a rendering Text Layout class + class procedure RegisterTextLayout(const LayoutClass: TTextLayoutClass; const CanvasClass: TCanvasClass); + // Return default Text Layout + class property DefaultTextLayout: TTextLayoutClass read GetDefaultLayout; + // Return Text Layout by type of Canvas + class function TextLayoutByCanvas(const ACanvasClass: TClass): TTextLayoutClass; + // Class static method for C++ access + class function TextLayoutForClass(C: TTextLayoutClass): TTextLayout; static; + end; + +function IsPointInRect(const APoint: TPointF; const ARect: TRectF): Boolean; + +//== UNIT END: FMX.TextLayout +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Filter (from FMX.Filter.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type +{ IFilterCacheLayer } + + IFilterCacheLayer = interface + ['{49EEF76F-3BD6-4688-994F-DC1B55002DEA}'] + /// Force refresh cache on next use. + procedure SetNeedUpdate; + end; + +{ TBitmapCacheLayer } + + IBitmapCacheLayer = interface(IFilterCacheLayer) + ['{C321CAF5-994B-4B64-9E99-8903B7B6A67D}'] + /// Attempts to initiate the draw cache update, rendering the cache image on the target. + /// True when cache modification is required and False when the current cache could be drawn to the target without updating. + function BeginUpdate(const ATarget: TCanvas; const ADestRect: TRectF; const AOpacity: Single; + const AHighSpeed: Boolean; out ACacheCanvas: TCanvas): Boolean; + /// Concludes the cache update rendering the result onto the target. + /// Allows to change the generated cache image before storing it. + procedure EndUpdate(const AGeneratedBitmap: TProc = nil); + end; + + TBitmapCacheLayer = class(TInterfacedObject, IBitmapCacheLayer) + private + FBitmap: TBitmap; + FNeedUpdate: Boolean; + FSavedDestRect: TRectF; + FSavedHighSpeed: Boolean; + FSavedOpacity: Single; + FSavedTarget: TCanvas; + public + destructor Destroy; override; + /// Attempts to initiate the draw cache update, rendering the cache image on the target. + /// True when cache modification is required and False when the current cache could be drawn to the target without updating. + function BeginUpdate(const ATarget: TCanvas; const ADestRect: TRectF; const AOpacity: Single; + const AHighSpeed: Boolean; out ACacheCanvas: TCanvas): Boolean; + /// Concludes the cache update rendering the result onto the target. + /// Allows to change the generated cache image before storing it. + procedure EndUpdate(const AGeneratedBitmap: TProc = nil); + /// Force refresh cache on next use. + procedure SetNeedUpdate; + end; + +{ TFilter } + + TFilterClass = class of TFilter; + TFilterContext = class; + TFilterContextClass = class of TFilterContext; + TFilterValueType = (Float, Point, Color, Bitmap); + TFilterImageType = (Undefined, Bitmap, Texture); + + PFilterValueRec = ^TFilterValueRec; + TFilterValueRec = record + Name: string; + Desc: string; + ValueType: TFilterValueType; + Value: TValue; + Min, Max, Default: TValue; + Bitmap: TBitmap; + constructor Create(const AName, ADesc: string; AType: TFilterValueType; const ADefault, AMin, AMax: TValue); overload; + constructor Create(const AName, ADesc: string; AType: TFilterValueType); overload; + constructor Create(const AName, ADesc: string; ADefault: TAlphaColor); overload; + constructor Create(const AName, ADesc: string; ADefault, AMin, AMax: Single); overload; + constructor Create(const AName, ADesc: string; const ADefault, AMin, AMax: TPointF); overload; + end; + + TFilterValueRecArray = array of TFilterValueRec; + + TFilterRec = record + Name: string; + Desc: string; + Values: TFilterValueRecArray; + constructor Create(const AName, ADesc: string; const AValues: TFilterValueRecArray); overload; + end; + + TFilter = class(TPersistent) + private class var + FDefaultVertexShader: TContextShader; + FProcessingFilter: TFilter; + private + FCacheLayer: IFilterCacheLayer; + FFilterContext: TFilterContext; + FInputFilter: TFilter; + FInputLayerSize: TSize; + FInputSize: TSize; + FKeepCurrentContext: Boolean; + FModified: Boolean; + FNotifierList: TList; + FOutputSize: TSize; + FRecalcInputSize: Boolean; + FRecalcOutputSize: Boolean; + FRootInputFilter: TFilter; + FValues: TFilterValueRecArray; + procedure AddChangeNotifier(const ATargetFilter: TFilter); + function GetBestFilterContext(const AOutputType: TFilterImageType; const AOutputCanvasClass: TCanvasClass): TFilterContextClass; + function GetFilterValue(const AName: string): TValue; + function GetFilterValuesAsBitmap(const AName: string): TBitmap; + function GetFilterValuesAsColor(const AName: string): TAlphaColor; + function GetFilterValuesAsFloat(const AName: string): Single; + function GetFilterValuesAsPoint(const AName: string): TPointF; + function GetFilterValuesAsTexture(const AName: string): TTexture; + function GetOutputSize: TSize; + procedure RemoveChangeNotifier(const ATargetFilter: TFilter); + procedure SetFilterContextClass(const AContextClass: TFilterContextClass); + procedure SetFilterValue(const AName: string; const AValue: TValue); + procedure SetFilterValuesAsBitmap(const AName: string; const AValue: TBitmap); + procedure SetFilterValuesAsColor(const AName: string; const AValue: TAlphaColor); + procedure SetFilterValuesAsFloat(const AName: string; const AValue: Single); + procedure SetFilterValuesAsPoint(const AName: string; const AValue: TPointF); + procedure SetFilterValuesAsTexture(const AName: string; const AValue: TTexture); + procedure SetInputAsFilter(const AValue: TFilter); + procedure SetInputLayerSize(const AValue: TSize); + function GetInputSize: TSize; + property KeepCurrentContext: Boolean read FKeepCurrentContext write FKeepCurrentContext; + property RootInputFilter: TFilter read FRootInputFilter; + property Values[const Name: string]: TValue read GetFilterValue write SetFilterValue; default; + protected + FAntiAliasing: Boolean; + FNeedInternalSecondTex: string; + FPass: Integer; + FPassCount: Integer; + FShaders: array of TContextShader; + FVertexShader: TContextShader; + procedure CalcSize(var W, H: Integer); virtual; + procedure Changed; + procedure FilterDestroying(const AFilter: TFilter); + procedure InputChanged; + procedure LoadShaders; virtual; + procedure LoadTextures; virtual; + public + constructor Create; virtual; + destructor Destroy; override; + procedure Apply; virtual; + procedure ApplyWithoutCopyToOutput; + /// Attempt to initiate a layer to apply the filter directly to the canvas drawings from that point on, until the EndLayer is called. + function BeginLayer(const ATarget: TCanvas; const ADestRect: TRectF; const AOpacity: Single; + const AHighSpeed: Boolean; var ACacheLayer: IFilterCacheLayer; out ACacheCanvas: TCanvas): Boolean; + /// End the drawings in the direct filter layer, merging the result into the original canvas. + procedure EndLayer; + function CalcOutputSize(const AInputSize: TSize): TSize; + class function FilterAttr: TFilterRec; virtual; + { Class static method for C++ access } + class function FilterAttrForClass(C: TFilterClass): TFilterRec; static; + property FilterContext: TFilterContext read FFilterContext; + property InputFilter: TFilter read FInputFilter write SetInputAsFilter; + property InputSize: TSize read GetInputSize; + property OutputSize: TSize read GetOutputSize; + property ValuesAsBitmap[const Name: string]: TBitmap read GetFilterValuesAsBitmap write SetFilterValuesAsBitmap; + property ValuesAsColor[const Name: string]: TAlphaColor read GetFilterValuesAsColor write SetFilterValuesAsColor; + property ValuesAsFloat[const Name: string]: Single read GetFilterValuesAsFloat write SetFilterValuesAsFloat; + property ValuesAsPoint[const Name: string]: TPointF read GetFilterValuesAsPoint write SetFilterValuesAsPoint; + property ValuesAsTexture[const Name: string]: TTexture read GetFilterValuesAsTexture write SetFilterValuesAsTexture; + end; + +{ TFilterManager } + + TFilterManager = class sealed + private type + TFilterCategoryDict = TDictionary; + TFilterClassDict = TDictionary; + TFilterContextClassDict = TDictionary; + private class var + FDefaultFilterContextClass: TFilterContextClass; + FFilterList: TFilterClassDict; + FFilterCategoryList: TFilterCategoryDict; + FFilterContextDic: TFilterContextClassDict; + class function GetBestFilterContext(AVertexShader: TContextShader; const AShaders: array of TContextShader; AShadersCount: Integer; + AInputCanvasClass, AOutputCanvasClass: TCanvasClass; AInputValue, AOutputValue: TFilterImageType): TFilterContextClass; + public + /// Write the filter categories in a list + class procedure FillCategory(AList: TStrings); + /// Write the filters of a category in a list + class procedure FillFiltersInCategory(const ACategory: string; AList: TStrings); + /// Get a new filter instance by the filter name + class function FilterByName(const AName: string): TFilter; + /// Get the filter class by it's name + class function FilterClassByName(const AName: string): TFilterClass; + /// Register new filter class. + class procedure RegisterFilter(const ACategory: string; AFilter: TFilterClass); + /// Register new filter context for a specific canvas. + class procedure RegisterFilterContextForCanvas(const AContextClass: TFilterContextClass; const ACanvasClass: TCanvasClass); + /// Reserved for internal use only - do not call directly! + class procedure UnInitialize; + /// Unregister a filter class. + class procedure UnregisterFilter(AFilter: TFilterClass); + class function FilterContext: TFilterContext; static; deprecated 'use TFilter.FilterContext instead'; + class function FilterTexture: TTexture; static; deprecated 'use TFilter.ValuesAsTexture[''Output''] instead'; + end; + +{ TFilterContext } + + TFilterContext = class abstract + private + FFilter: TFilter; + FNoCopyForOutput: Boolean; + protected + procedure Apply(var APass: Integer; const AAntiAliasing: Boolean; APassCount: Integer; const ASecondImageResourceName: string); virtual; abstract; + function BeginLayer(const ATarget: TCanvas; const ADestRect: TRectF; const AOpacity: Single; + const AHighSpeed: Boolean; var ACacheLayer: IFilterCacheLayer; out ACacheCanvas: TCanvas): Boolean; virtual; + procedure Changed(const AValue: TFilterValueRec); virtual; abstract; + procedure EnableBitmapOutput; virtual; + procedure EndLayer(const ACacheLayer: IFilterCacheLayer); virtual; + procedure LoadShaders; virtual; + procedure LoadTextures; virtual; + function OutputAsBitmap: TBitmap; virtual; abstract; + function OutputAsTexture: TTexture; virtual; abstract; + procedure SetRootInputLayerSize(const ASize: TSize); + class function SupportsShaders(AVertexShader: TContextShader; const AShaders: array of TContextShader; AShadersCount: Integer): Boolean; virtual; + property Filter: TFilter read FFilter; + property NoCopyForOutput: Boolean read FNoCopyForOutput write FNoCopyForOutput; + public + constructor Create(const AFilter: TFilter; const AValue: TFilterValueRecArray); virtual; + class function Style: TContextStyles; virtual; + /// Reserved for internal use only - do not call directly! + class procedure UnInitialize; virtual; abstract; + procedure CopyToBitmap(const ADest: TBitmap; const ARect: TRect); virtual; abstract; + procedure SetInputToShaderVariable(const AName: string); virtual; abstract; + procedure SetShaders(const AVertexShader, APixelShader: TContextShader); virtual; abstract; + procedure SetShaderVariable(const AName: string; const AData: array of TVector3D); overload; virtual; abstract; + procedure SetShaderVariable(const AName: string; const ATexture: TTexture); overload; virtual; abstract; + procedure SetShaderVariable(const AName: string; const AMatrix: TMatrix3D); overload; virtual; abstract; + procedure SetShaderVariable(const AName: string; const AColor: TAlphaColor); overload; virtual; abstract; + end; + + EFilterException = class(Exception); + EFilterManagerException = class(Exception); + +//== UNIT END: FMX.Filter +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Text (from FMX.Text.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + + { TCaretPosition } + + /// Record describes platform independant position in multiline text + /// + /// Better use this type of position instead of absolute integer position. Absolute integer position includes + /// length of the LineBreak. It's value depends on platform (e.g. on Windows LineBreak.Length=2, + /// on OSX LineBreak.Length=1). + /// TCaretPosition is better in cases if you want to store current caret position in your application accross + /// multiple platforms. + /// + TCaretPosition = record + /// Text line number value + Line: Integer; + /// Caret position in line defined by Line value + Pos: Integer; + public + /// Create new TCaretPosition with devined values of Line and Pos + class function Create(const ALine, APos: Integer): TCaretPosition; static; inline; + + /// Overriding equality check operator + class operator Equal(const A, B: TCaretPosition): Boolean; + /// Overriding inequality check operator + class operator NotEqual(const A, B: TCaretPosition): Boolean; + /// Overriding compare operator: Less Or Equal + class operator LessThanOrEqual(const A, B: TCaretPosition): Boolean; + /// Overriding compare operator: Less Than + class operator LessThan(const A, B: TCaretPosition): Boolean; + /// Overriding compare operator: Greater Or Equal + class operator GreaterThanOrEqual(const A, B: TCaretPosition): Boolean; + /// Overriding compare operator: Greater Than + class operator GreaterThan(const A, B: TCaretPosition): Boolean; + /// Overriding implicit conversion to TPoint + class operator Implicit(const APosition: TCaretPosition): TPoint; + /// Overriding implicit conversion to TCaretPosition + class operator Implicit(const APoint: TPoint): TCaretPosition; + + /// Returns zero caret position value (0; 0) + class function Zero: TCaretPosition; inline; static; + /// Resturn invalid caret position value (-1; -1) + class function Invalid: TCaretPosition; inline; static; + + /// Increment line number value + procedure IncrementLine; + /// Decrement line number value + procedure DecrementLine; + /// Check wherever current caret position has zero value (0; 0) + function IsZero: Boolean; + /// + /// Checks wherever current caret position has invalid value (either Line or Pos has -1 value) + /// + function IsInvalid: Boolean; + function ToString: string; + end; + +{ TTextService } + + TMarkedTextAttribute = (Input, TargetConverted, Converted, TargetNotConverted, InputError); + + TTextService = class(TNoRefCountObject) + private + FOwner: IControl; + FMultiLine: Boolean; + FMaxLength: Integer; + FCharCase: TEditCharCase; + FFilterChar: string; + FImeMode: TImeMode; + FMarkedTextPosition: TCaretPosition; + procedure SetMarkedTextPosition(const Value: TCaretPosition); + protected + + FCaretPosition: TPoint; + + FText: string; + function GetText: string; virtual; + procedure SetText(const Value: string); virtual; + function GetCaretPosition: TPoint; virtual; + procedure SetCaretPosition(const Value: TPoint); virtual; + procedure SetMaxLength(const Value: Integer); virtual; + procedure SetCharCase(const Value: TEditCharCase); virtual; + procedure SetFilterChar(const Value: string); virtual; + procedure ImeModeChanged; virtual; + procedure TextChanged; virtual; + procedure MarkedTextPositionChanged; virtual; + procedure CaretPositionChanged; virtual; + function GetMarketTextAttributes: TArray; virtual; + public + constructor Create(const AOwner: IControl; const ASupportMultiLine: Boolean); virtual; + destructor Destroy; override; + { Text support } + procedure InternalSetMarkedText(const AMarkedText: string); virtual; abstract; + function InternalGetMarkedText: string; virtual; abstract; + /// Returns Text with inserted IME MarkedText. + function CombinedText: string; virtual; + function TargetClausePosition: TPoint; virtual; abstract; + function HasMarkedText: Boolean; virtual; abstract; + { Enter/Exit } + procedure EnterControl(const FormHandle: TWindowHandle); virtual; abstract; + procedure ExitControl(const FormHandle: TWindowHandle); virtual; abstract; + { Drawing Lines } + procedure DrawSingleLine(const Canvas: TCanvas; + const ARect: TRectF; const FirstVisibleChar: Integer; const Font: TFont; + const AOpacity: Single; const Flags: TFillTextFlags; const ATextAlign: TTextAlign; + const AVTextAlign: TTextAlign = TTextAlign.Center; + const AWordWrap: Boolean = False); overload; virtual; abstract; + procedure DrawSingleLine(const Canvas: TCanvas; const S: string; + const ARect: TRectF; const Font: TFont; + const AOpacity: Single; const Flags: TFillTextFlags; const ATextAlign: TTextAlign; + const AVTextAlign: TTextAlign = TTextAlign.Center; + const AWordWrap: Boolean = False); overload; virtual; abstract; + + /// Refreshes position of IME related UI controls. + procedure RefreshImePosition; virtual; + { IME Mode } + function GetImeMode: TImeMode; + procedure SetImeMode(const Value: TImeMode); + { Selection } + procedure BeginSelection; virtual; + procedure EndSelection; virtual; + public + property CaretPosition: TPoint read GetCaretPosition write SetCaretPosition; + /// Original text without IME marked text. + property Text: string read GetText write SetText; + property ImeMode: TImeMode read GetImeMode write SetImeMode default TImeMode.imDontCare; + /// Defines the maximum text of the text that could inputed via text service + property MaxLength: Integer read FMaxLength write SetMaxLength; + /// Defines wherever input control allows to input several lines on text or just a single one. + property Multiline: Boolean read FMultiLine; + /// Defines input character case + property CharCase: TEditCharCase read FCharCase write SetCharCase; + /// Defines input filter + property FilterChar: string read FFilterChar write SetFilterChar; + /// Holds a reference to the text input control in UI + property Owner: IControl read FOwner; + /// Returns the IME text that user is entering. + property MarkedText: string read InternalGetMarkedText; + /// Specifies position of IME marked text. + property MarkedTextPosition: TCaretPosition read FMarkedTextPosition write SetMarkedTextPosition; + /// Returns text attributes for each character in MarkedText. + property MarketTextAttributes: TArray read GetMarketTextAttributes; + end; + + TTextServiceClass = class of TTextService; + + IIMEComposingTextDecoration = interface + ['{13D7F323-B51B-46B5-8455-9BB9ACBACF61}'] + function GetRange: TTextRange; + function GetText: string; + end; + +{ TTextWordWrapping } + + ///Manage text line counting and line retrieving for a given width in a canvas. + TTextWordWrapping = class + public + /// + /// Fills ALinesFound with the text that fits on a certain Width (AMaxWidth). Also fills the real maximum + /// with found. + /// + class procedure GetLines(const AText: string; const ACanvas: TCanvas; const AMaxWidth: Integer; + var ALinesFound: TStringList; var AResWidth: Integer); + /// + /// Computes the number of lines needed to draw the text supplied for a certain Width (AMaxWidth). Also + /// fills the real maximum with found. + /// + class function ComputeLineCount(const AText: string; const ACanvas: TCanvas; const AMaxWidth: Integer; + var AResWidth: Integer): Integer; + end; + +{ ITextInput } + + ITextInput = interface + ['{56D79E74-58D6-4c1e-B832-F133D669B952}'] + function GetTextService: TTextService; + { IME } + /// Returns position + function GetTargetClausePointF: TPointF; + procedure StartIMEInput; + procedure EndIMEInput; + /// Platform using this method to notify control that either text or caret position was changed + procedure IMEStateUpdated; + { Selection } + function GetSelection: string; + /// Returns selection rect in local cooridnate system of text-input control. + function GetSelectionRect: TRectF; + function GetSelectionBounds: TRect; + function GetSelectionPointSize: TSizeF; + { Text } + function HasText: Boolean; + end; + +{ ITextSelection } + + ITextSelection = interface + ['{5BC4EB77-92BE-4CA7-8BC8-FF06846D12CE}'] + procedure SetSelection(const AStart: TCaretPosition; const ALength: Integer); + end; + +{ ITextLinesSource } + + /// Interface for accessing text lines. + ITextLinesSource = interface + ['{21E863AD-6411-4B68-A985-4D36D899DA97}'] + { Lines accessing } + + /// Returns line by index. + function GetLine(const ALineIndex: Integer): string; + /// Returns lines break separator. + function GetLineBreak: string; + /// Returns lines count. + function GetCount: Integer; + /// Returns concatted lines. + function GetText: string; + /// Returns line by index. + property Lines[const AIndex: Integer]: string read GetLine; default; + /// Line break separator. + property LineBreak: string read GetLineBreak; + /// Lines count. + property Count: Integer read GetCount; + /// Returns concatted lines. + property Text: string read GetText; + + { Position conversion } + + /// + /// Convert absolute platform-dependent position in text to platform independent value in format + /// (line_number, position_in_line) + /// + function TextPosToPos(const APos: Integer): TCaretPosition; + /// Convert platform-independent position to absolute platform-dependent position + function PosToTextPos(const APostion: TCaretPosition): Integer; + end; + + /// + /// Proxy source of text lines. Allows to modify the lines from the source ITextLinesSource taking into + /// account the current IME text. It's used to implement the IME text for the display mode + /// FMX.Text.Text Editor.TIMEDisplayMode=InlineText + /// + TIMETextLineSourceProxy = class(TNoRefCountObject, ITextLinesSource) + private + FOriginalLinesSource: ITextLinesSource; + FMarkedTextPosition: TCaretPosition; + FMarkedText: string; + FNeedEmbedIMEText: Boolean; + procedure SetMarkedTextPosition(const Value: TCaretPosition); + procedure SetMarkedText(const Value: string); + procedure SetNeedEmbedIMEText(const Value: Boolean); + public + constructor Create(const AOriginalLinseSource: ITextLinesSource); + + function CanEmbedIMEText: Boolean; virtual; + function GetOriginalLine(const ALineIndex: Integer): string; + function GetOriginalCount: Integer; + + { ITextLinesSource } + function GetLine(const ALineIndex: Integer): string; + function GetLineBreak: string; + function GetCount: Integer; + function GetText: string; + function TextPosToPos(const APos: Integer): TCaretPosition; + function PosToTextPos(const APostion: TCaretPosition): Integer; + public + /// The position where the IME text MarkedText should be inserted. + property MarkedTextPosition: TCaretPosition read FMarkedTextPosition write SetMarkedTextPosition; + /// The text inserted by the IME at the specified MarkedTextPosition position. + property MarkedText: string read FMarkedText write SetMarkedText; + /// + /// Is it necessary to embed the specified IME text MarkedText in the specified position + /// MarkedTextPosition? + /// + property NeedEmbedIMEText: Boolean read FNeedEmbedIMEText write SetNeedEmbedIMEText; + { ITextLinesSource } + property Lines[const AIndex: Integer]: string read GetLine; default; + property LineBreak: string read GetLineBreak; + property Count: Integer read GetCount; + property Text: string read GetText; + end; + + TInsertOption = (Selected, MoveCaret, CanUndo, UndoPairedWithPrev, Typed); + TInsertOptions = set of TInsertOption; + + TDeleteOption = (MoveCaret, CanUndo, Selected); + TDeleteOptions = set of TDeleteOption; + +{ ITextSpellCheck } + + ITextSpellCheck = interface + ['{30AA8C32-5ADA-456C-AAC5-B9F0309AE3A8}'] + { common } + function IsSpellCheckEnabled: Boolean; + function IsCurrentWordWrong: Boolean; + function GetListOfPrepositions: TArray; + { Spell check } + procedure HighlightSpell; + procedure HideHighlightSpell; + end; + +{ ITextActions } + + { Standard actions for operation with the text. Objects which want to get + support of actions in a shortcut menu shall implement this interface } + ITextActions = interface + ['{9DB49126-36DB-4193-AE96-C0BD27090DCD}'] + procedure DeleteSelection; + procedure CopyToClipboard; + procedure CutToClipboard; + procedure PasteFromClipboard; + procedure SelectAll; + procedure SelectWord; + procedure ResetSelection; + procedure GoToTextEnd; + procedure GoToTextBegin; + procedure Replace(const AStartPos: Integer; const ALength: Integer; const AStr: string); + end; + +{ ITextSpellCheckActions } + + ITextSpellCheckActions = interface + ['{82A33171-C825-4B7F-B0C4-A56DDD4FF85C}'] + procedure Spell(const AWord: string); + end; + + { Search of boundaries of the word in the text since |Index| + Returns an index of the left |BeginPos| and right |EndPos| boundary of the found word + |Text| - Source text + |Index| - Index of carriage position + |BeginPos| - Index of carriage position + |EndPos| - Index of carriage position + Position of the carriage begins with 0. 0 specifies position of the carriage to the first character } + function FindWordBound(const AText: string; const AIndex: Integer; out ABeginPos, AEndPos: Integer): Boolean; + function GetLexemeBegin(const AText: string; const AIndex: Integer): Integer; + function GetLexemeEnd(const AText: string; const AIndex: Integer): Integer; + function GetNextLexemeBegin(const AText: string; const AIndex: Integer): Integer; + function GetPrevLexemeBegin(const AText: string; const AIndex: Integer): Integer; + function TruncateText(const Text: string; const MaxLength: Integer): string; + /// Removes from the source string Input all characters that are not in the Filter string. + function FilterText(const Input: string; const Filter: string): string; + +type + TNumValueType = (Integer, Float); + + TValidateTextEvent = procedure(Sender: TObject; var Text: string) of object; + + function FilterCharByValueType(const AValueType: TNumValueType): string; + function TryTextToValue(AText: string; var AValue: Single; DefaultValue: Single): Boolean; overload; + function TryTextToValue(AText: string; var AValue: Double; DefaultValue: Double): Boolean; overload; + +//== UNIT END: FMX.Text +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Effects (from FMX.Effects.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + +{ ITriggerEffect } + + ITriggerEffect = interface + ['{945DC18B-7801-43F8-997D-F19607399AE9}'] + procedure ApplyTriggerEffect(const AInstance: TFmxObject; const ATrigger: string); + end; + + TEffectAnimator = class + public + class procedure ApplyTriggerEffect(const Target: TFmxObject; const AInstance: TFmxObject; const ATrigger: string); + class procedure DefaultApplyTriggerEffect(const Target: TFmxObject; const AInstance: TFmxObject; const ATrigger: string); + end; + +{ TEffect } + + IEffectContainer = interface + ['{FFC591A9-A520-45F2-BD49-17F76E7B057C}'] + procedure NeedUpdateEffects; + procedure BeforeEffectEnabledChanged(const Enabled: Boolean); + procedure EffectEnabledChanged(const Enabled: Boolean); + end; + + TEffectStyle = (AfterPaint, DisablePaint, DisablePaintToBitmap); + TEffectStyles = set of TEffectStyle; + + TEffect = class(TFmxObject) + private + FCacheLayer: IFilterCacheLayer; + FEnabled: Boolean; + FTrigger: TTrigger; + procedure SetEnabled(const Value: Boolean); + protected + FEffectStyle: TEffectStyles; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + /// Initiate a drawing layer with the effect applied, creating a reusable cache. + /// True when cache modification is required and False when the current cache could be drawn to the target without updating. + function BeginLayer(const ATarget: TCanvas; const ADestRect: TRectF; const AOpacity: Single; + const AHighSpeed: Boolean; var ACacheLayer: IFilterCacheLayer; out ACacheCanvas: TCanvas): Boolean; virtual; + /// Concludes the layer update rendering the result onto the target. + procedure EndLayer; virtual; + function GetRect(const ARect: TRectF): TRectF; virtual; + function GetOffset: TPointF; virtual; + procedure ProcessEffect(const Canvas: TCanvas; const Visual: TBitmap; const Data: Single); virtual; + procedure ApplyTrigger(AInstance: TFmxObject; const ATrigger: string); virtual; + procedure UpdateParentEffects; + property EffectStyle: TEffectStyles read FEffectStyle; + property Trigger: TTrigger read FTrigger write FTrigger; + property Enabled: Boolean read FEnabled write SetEnabled default True; + end; + +{ TFilterEffect } + + TFilterEffect = class(TEffect) + private + FFilter: TFilter; + protected + function CreateFilter: TFilter; virtual; abstract; + property Filter: TFilter read FFilter; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function BeginLayer(const ATarget: TCanvas; const ADestRect: TRectF; const AOpacity: Single; + const AHighSpeed: Boolean; var ACacheLayer: IFilterCacheLayer; out ACacheCanvas: TCanvas): Boolean; override; + procedure EndLayer; override; + procedure ProcessEffect(const Canvas: TCanvas; const Visual: TBitmap; const Data: Single); override; + procedure ProcessTexture(const Visual: TTexture; const Context: TContext3D); virtual; + end; + +{ TBlurEffect } + + TBlurEffect = class(TFilterEffect) + private + FSoftness: Single; + procedure SetSoftness(const Value: Single); + protected + function CreateFilter: TFilter; override; + public + constructor Create(AOwner: TComponent); override; + function GetRect(const ARect: TRectF): TRectF; override; + function GetOffset: TPointF; override; + published + property Softness: Single read FSoftness write SetSoftness nodefault; + property Trigger; + property Enabled; + end; + +{ TShadowEffect } + + TShadowEffect = class(TFilterEffect) + private + FDistance: Single; + FSoftness: Single; + FShadowColor: TAlphaColor; + FOpacity: Single; + FDirection: Single; + procedure SetDistance(const Value: Single); + procedure SetSoftness(const Value: Single); + procedure SetShadowColor(const Value: TAlphaColor); + procedure SetOpacity(const Value: Single); + function GetShadowColor: TAlphaColor; + procedure SetDirection(const Value: Single); + protected + function CreateFilter: TFilter; override; + public + constructor Create(AOwner: TComponent); override; + function GetRect(const ARect: TRectF): TRectF; override; + function GetOffset: TPointF; override; + published + property Distance: Single read FDistance write SetDistance; + property Direction: Single read FDirection write SetDirection; + property Softness: Single read FSoftness write SetSoftness nodefault; + property Opacity: Single read FOpacity write SetOpacity nodefault; + property ShadowColor: TAlphaColor read GetShadowColor write SetShadowColor; + property Trigger; + property Enabled; + end; + +{ TGlowEffect } + + TGlowEffect = class(TFilterEffect) + private + FGlowColor: TAlphaColor; + FSoftness: Single; + FOpacity: Single; + procedure SetSoftness(const Value: Single); + function GetGlowColor: TAlphaColor; + procedure SetGlowColor(const Value: TAlphaColor); + procedure SetOpacity(const Value: Single); + protected + function CreateFilter: TFilter; override; + public + constructor Create(AOwner: TComponent); override; + function GetRect(const ARect: TRectF): TRectF; override; + function GetOffset: TPointF; override; + published + property Softness: Single read FSoftness write SetSoftness nodefault; + property GlowColor: TAlphaColor read GetGlowColor write SetGlowColor; + property Opacity: Single read FOpacity write SetOpacity nodefault; + property Trigger; + property Enabled; + end; + +{ TInnerGlowEffect } + + TInnerGlowEffect = class(TFilterEffect) + private + FGlowColor: TAlphaColor; + FSoftness: Single; + FOpacity: Single; + procedure SetSoftness(const Value: Single); + function GetGlowColor: TAlphaColor; + procedure SetGlowColor(const Value: TAlphaColor); + procedure SetOpacity(const Value: Single); + protected + function CreateFilter: TFilter; override; + public + constructor Create(AOwner: TComponent); override; + function GetRect(const ARect: TRectF): TRectF; override; + function GetOffset: TPointF; override; + published + property Softness: Single read FSoftness write SetSoftness nodefault; + property GlowColor: TAlphaColor read GetGlowColor write SetGlowColor; + property Opacity: Single read FOpacity write SetOpacity nodefault; + property Trigger; + property Enabled; + end; + +{ TReflectionEffect } + + TReflectionEffect = class(TFilterEffect) + private + FOffset: Integer; + FOpacity: Single; + FLength: Single; + procedure SetOpacity(const Value: Single); + procedure SetOffset(const Value: Integer); + procedure SetLength(const Value: Single); + protected + function CreateFilter: TFilter; override; + public + constructor Create(AOwner: TComponent); override; + function GetRect(const ARect: TRectF): TRectF; override; + function GetOffset: TPointF; override; + published + property Opacity: Single read FOpacity write SetOpacity nodefault; + property Offset: Integer read FOffset write SetOffset; + property Length: Single read FLength write SetLength; + property Trigger; + property Enabled; + end; + +{ TBevelEffect } + + TBevelEffect = class(TEffect) + private + FDirection: Single; + FSize: Integer; + procedure SetDirection(const Value: Single); + procedure SetSize(const Value: Integer); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function GetRect(const ARect: TRectF): TRectF; override; + function GetOffset: TPointF; override; + procedure ProcessEffect(const Canvas: TCanvas; const Visual: TBitmap; const Data: Single); override; + published + property Direction: Single read FDirection write SetDirection; + property Size: Integer read FSize write SetSize; + property Trigger; + property Enabled; + end; + +{ TRasterEffect } + + TRasterEffect = class(TEffect) + public + constructor Create(AOwner: TComponent); override; + published + property Trigger; + property Enabled; + end; + +procedure Blur(const Canvas: TCanvas; const Bitmap: TBitmap; + const Radius: Integer; UseAlpha: Boolean = True); + +//== UNIT END: FMX.Effects +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Text.UndoManager (from FMX.Text.UndoManager.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + /// Information about fragment of the text that was inserted. + TFragmentInserted = record + /// Position in text where text was inserted. + StartPos: Integer; + /// Fragment of text that was inserted. + Fragment: string; + /// + /// Defines that change was made right after the previous and was made in the similar way + /// (e.g. text editing (delete and insert) via keyabord). + /// + PairedWithPrev: Boolean; + /// Was text inserted via typing from keyboard or not. + Typed: Boolean; + public + /// Create new information about inserted text with defined values. + constructor Create(const AStartPos: Integer; const AFragment: string; const APairedWithPrev, ATyped: Boolean); + end; + + /// Information about fragment of the text that was removed. + TFragmentDeleted = record + /// Position in text from which text was deleted. + StartPos: Integer; + /// Fragment of text that was deleted. + Fragment: string; + /// Was removed text select or not. + Selected: Boolean; + /// Was caret moved after text was removed or not. + CaretMoved: Boolean; + public + /// Create new information about removed text with defined values. + constructor Create(const AStartPos: Integer; const AFragment: string; const ASelected, ACaretMoved: Boolean); + end; + + { TUndoManager } + + TActionType = (Delete, Insert); + + ///Record that describes text-editing operation. + TEditAction = record + ///Type of change that was made (text added or removed). + ActionType: TActionType; + ///Defines that change was made right after the previous and was made in the similar way + ///(e.g. text editing (delete and insert) via keyabord). + PairedWithPrev: Boolean; + ///Position in text from which text was deleted or into which text was inserted. + StartPosition: Integer; + ///Fragmen of text that was inserted/deleted. + Fragment: string; + ///Was text inserted via typing from keyboard or not. + Typed: Boolean; + ///Was removed text select or not. + WasSelected: Boolean; + ///Was caret moved after text was removed or not. + CaretMoved: Boolean; + end; + + TUndoEvent = procedure (Sender: TObject; const AActionType: TActionType; const AEditInfo: TEditAction; + const AOptions: TInsertOptions) of object; + + TRedoEvent = procedure (Sender: TObject; const AActionType: TActionType; const AEditInfo: TEditAction; + const AOptions: TDeleteOptions) of object; + + /// + /// The manager is responsible for tracking and canceling editable operations. The user of this class must notify the manager + /// about the operations being edited through the methods FragmentInserted and FragmentDeleted. The class saves these operations + /// and allows you to cancel them. To undo an action, the user calls the Undo method and the manager notifies the client about + /// the operation parameters via the OnUndo event. The same is for Redo operation. + /// + TUndoManager = class + private + FActions: TList; + FCurrentActionIndex: Integer; + FOnUndo: TUndoEvent; + FOnRedo: TRedoEvent; + function GetCurrentAction: TEditAction; + protected + procedure DoUndo(const AActionType: TActionType; const AEditInfo: TEditAction; const AOptions: TInsertOptions); virtual; + procedure DoRedo(const AActionType: TActionType; const AEditInfo: TEditAction; const AOptions: TDeleteOptions); virtual; + procedure AddAction(const AAction: TEditAction); + procedure RemoveTailActions; + property CurrentAction: TEditAction read GetCurrentAction; + public + constructor Create; + destructor Destroy; override; + + { Notifications about text changes } + + ///New fragment of text was inserted. + procedure FragmentInserted(const AStartPos: Integer; const AFragment: string; const APairedWithPrev, ATyped: Boolean); + ///Some text fragment was removed. + procedure FragmentDeleted(const AStartPos: Integer; const AFragment: string; const ASelected, ACaretMoved: Boolean); + + { Undo operations } + + ///Revert last change. + function Undo: Boolean; + /// Does the manager have undo fragments? + function CanUndo: Boolean; + + { Redo operations } + + /// Apply next change. + function Redo: Boolean; + /// Does the manager have redo fragments? + function CanRedo: Boolean; + public + /// The event is being invoked with undo action parameters, when client initiate undo operation. + property OnUndo: TUndoEvent read FOnUndo write FOnUndo; + /// The event is being invoked with redo action parameters, when client initiate redo operation. + property OnRedo: TRedoEvent read FOnRedo write FOnRedo; + end; + + TEditActionStack = TUndoManager deprecated 'Use TUndoManager instead'; + +//== UNIT END: FMX.Text.UndoManager +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Controls (from FMX.Controls.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + TControl = class; + TStyledControl = class; + TStyleBook = class; + + IStyleBookOwner = interface + ['{BA1AE6C6-FCF7-43E2-92AA-2869FF203309}'] + function GetStyleBook: TStyleBook; + procedure SetStyleBook(const Value: TStyleBook); + property StyleBook: TStyleBook read GetStyleBook write SetStyleBook; + end; + + IScene = interface(IStyleBookOwner) + ['{16DB110E-DA7D-4e75-BC2D-999FA12E45F5}'] + procedure AddUpdateRect(const R: TRectF); + function GetUpdateRectsCount: Integer; + function GetUpdateRect(const Index: Integer): TRectF; + function GetObject: TFmxObject; + function GetCanvas: TCanvas; + function GetSceneScale: Single; + /// Converts a point from the scene coordinate system to the screen coordinate system. + function LocalToScreen(const AScenePoint: TPointF): TPointF; + /// Converts a point from the screen coordinate system to the scene coordinate system. + function ScreenToLocal(const AScreenPoint: TPointF): TPointF; + procedure ChangeScrollingState(const AControl: TControl; const AActive: Boolean); + /// Disable Scene's updating + procedure DisableUpdating; + /// Enable Scene's updating + procedure EnableUpdating; + property Canvas: TCanvas read GetCanvas; + end; + + /// Exception raised when the process for Disabling Updating and + /// Enabling Upating is not correct. + EInvalidSceneUpdatingPairCall = class(Exception); + + { IDesignerControl: Control implementing this is part of the designer } + IDesignerControl = interface + ['{C57A701D-E4B5-4711-BFA4-716E2164A929}'] + end; + + /// Controls that can respond to hint-related events must implement + /// this interface. + IHintReceiver = interface + ['{533671CF-86C5-489E-B32A-724AF8464DCE}'] + /// This method is called when a hint is triggered. + procedure TriggerOnHint; + end; + + /// A class needs to implement this interface in order to be able to + /// register IHintReceiver instances. + IHintRegistry = interface + ['{8F3B3C46-450B-4A8C-800F-FD47538244C3}'] + /// Triggers the TriggerOnHint method of all the objects that are registered in this registry. + procedure TriggerHints; + /// Registers a new receiver. + procedure RegisterHintReceiver(const AReceiver: IHintReceiver); + /// Unregisters a receiver. + procedure UnregisterHintReceiver(const AReceiver: IHintReceiver); + end; + + /// The base class for an object that can manage a hint. + THint = class + public type + THintClass = class of THint; + private class var + FClassRegistry: TArray; + protected + /// Field to store the hint. + FHint: string; + /// Field to store the status (enabled or not) of the hint. + FEnabled: Boolean; + /// Method that updates the state of enabled. + procedure SetEnabled(const Value: Boolean); virtual; + public + /// Constructor. A constructor needs the native handle of the view that holds the hint. To give an example, + /// in MS Windows is the HWND of the native window. + constructor Create(const AHandle: TWindowHandle); virtual; + /// Sets the full hint string. + procedure SetHint(const AString: string); virtual; + /// Gets the full hint string. + function GetHint: string; + /// The hint can follows the following pattern: 'A short Text| A Long text'. It means, the hint can hold + /// two texts separated by the '|' character. This method returns the short text of the hint. + function GetShortText: string; + /// Returns the long text of the hint. + function GetLongText: string; + /// If the specific implementation supports it, this metods places the hint in the given position. + procedure SetPosition(const X, Y: Single); virtual; abstract; + /// Register a class to create hint instances. When a new THint instance is needed, the registered classes are invoked + /// to create the needed instance. + class procedure RegisterClass(const AClass: THintClass); + /// Returns an instance created by the first available registered class. This method can return nil if there are no classes + /// registered or none of the registered classes can create a THint instance. + class function CreateNewInstance(const AHandle: TWindowHandle): THint; + /// Returns True if there are some THint class registered. + class function ContainsRegistredHintClasses: Boolean; + + /// If this property is true, the hint can be displayed, if it is False, the hint won't be displayed. + property Enabled: Boolean read FEnabled write SetEnabled; + end; + +{ TCustomControlAction } + TCustomControlAction = class(TCustomAction) + private + [weak]FPopupMenu: TCustomPopupMenu; + procedure SetPopupMenu(const Value: TCustomPopupMenu); + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + public + constructor Create(AOwner: TComponent); override; + property PopupMenu: TCustomPopupMenu read FPopupMenu write SetPopupMenu; + end; + +{ TControlAction } + + TControlAction = class(TCustomControlAction) + published + property AutoCheck; + property Text; + property Checked; + property Enabled; + property GroupIndex; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property ImageIndex; + property ShortCut; + property SecondaryShortCuts; + property Visible; + property UnsupportedArchitectures; + property UnsupportedPlatforms; + property OnExecute; + property OnHint; + property OnUpdate; + property PopupMenu; + end; + +{ TControlActionLink } + /// Links an action to a client (generic control). + TControlActionLink = class(FMX.ActnList.TActionLink) + private + function GetClient: TControl; + protected + procedure AssignClient(AClient: TObject); override; + function IsEnabledLinked: Boolean; override; + function IsHelpLinked: Boolean; override; + function IsHintLinked: Boolean; override; + function IsVisibleLinked: Boolean; override; + function IsOnExecuteLinked: Boolean; override; + function IsPopupMenuLinked: boolean; virtual; + /// This method is invoked to allow a link to customize a Hint that is going to be displayed. + function DoShowHint(var HintStr: string): Boolean; virtual; + /// This method sets the string of the hint. + procedure SetHint(const Value: string); override; + procedure SetEnabled(Value: Boolean); override; + procedure SetHelpContext(Value: THelpContext); override; + procedure SetHelpKeyword(const Value: string); override; + procedure SetHelpType(Value: THelpType); override; + procedure SetVisible(Value: Boolean); override; + procedure SetOnExecute(Value: TNotifyEvent); override; + procedure SetPopupMenu(const Value: TCustomPopupMenu); virtual; + procedure SetShortCut(Value: System.Classes.TShortCut); override; + public + property Client: TControl read GetClient; + end; + + TCaret = class (TCustomCaret) + private const + FMXFlasher = 'FMXFlasher'; + public + class function FlasherName: string; override; + published + property Color; + property Interval; + property Width; + end; + +{ TControl } + + TEnumControlsResult = TEnumProcResult; + + TEnumControlsRef = reference to procedure(const AControl: TControl; var Done: boolean); + + TControlList = TList; + + TOnPaintEvent = procedure(Sender: TObject; Canvas: TCanvas; const ARect: TRectF) of object; + + TCustomSceneAddRectEvent = procedure (Sender: TControl; ARect: TRectF) of object; + + TPaintStage = (All, Background, Text); + + TControlType = (Styled, Platform); + + /// Helper for TControlType. + TControlTypeHelper = record helper for TControlType + public + /// Returns string presentation of value of this type + function ToString: string; + end; + + /// + /// The marker for TControl component, which supports native control implementation. Use this interface to mark + /// the component that can use the native OS implementation. The FMX platform implementation may use it for + /// the better manipulation of focus management. + /// + IControlTypeSupportable = interface + ['{0B538F5C-98AC-4F86-AAF1-9979B2F40B90}'] + procedure SetControlType(const AControlType: TControlType); + function GetControlType: TControlType; + property ControlType: TControlType read GetControlType write SetControlType; + end; + + TControl = class(TFmxObject, IControl, IContainerObject, IAlignRoot, IRotatedControl, IAlignableObject, + IEffectContainer, IGestureControl, ITabStopController, ITriggerAnimation, ITriggerEffect, IFlipContainer) + private type + TDelayedEvent = (Resize, Resized); + private const + InitialControlsCapacity = 10; + public const + DefaultTouchTargetExpansion = 6; + DefaultDisabledOpacity = 0.6; + DesignBorderColor = $A0909090; + private class var + FPaintStage: TPaintStage; + strict private + FOnMouseUp: TMouseEvent; + FOnMouseDown: TMouseEvent; + FOnMouseMove: TMouseMoveEvent; + FOnMouseWheel: TMouseWheelEvent; + FOnClick: TNotifyEvent; + FOnDblClick: TNotifyEvent; + FHitTest: Boolean; + FClipChildren: Boolean; + FAutoCapture: Boolean; + FPadding: TBounds; + FMargins: TBounds; + FTempCanvas: TCanvas; + FRotationAngle: Single; + FPosition: TPosition; + FScale: TPosition; + FSkew: TPosition; + FRotationCenter: TPosition; + FCanFocus: Boolean; + FOnCanFocus: TCanFocusEvent; + FOnEnter: TNotifyEvent; + FOnExit: TNotifyEvent; + FClipParent: Boolean; + FOnMouseLeave: TNotifyEvent; + FOnMouseEnter: TNotifyEvent; + FOnPaint: TOnPaintEvent; + FOnPainting: TOnPaintEvent; + FCursor: TCursor; + FInheritedCursor: TCursor; + FDragMode: TDragMode; + FEnableDragHighlight: Boolean; + FOnDragEnter: TDragEnterEvent; + FOnDragDrop: TDragDropEvent; + FOnDragLeave: TNotifyEvent; + FOnDragOver: TDragOverEvent; + FOnDragEnd: TNotifyEvent; + FIsDragOver: Boolean; + FOnKeyDown: TKeyEvent; + FOnKeyUp: TKeyEvent; + FOnTap: TTapEvent; + FHint: string; + FActionHint: string; + FShowHint: Boolean; + FPopupMenu: TCustomPopupMenu; + FRecalcEnabled, FEnabled, FAbsoluteEnabled: Boolean; + FTabList: TTabList; + FOnResize: TNotifyEvent; + FOnResized: TNotifyEvent; + FDisableEffect: Boolean; + FAcceptsControls: Boolean; + FControls: TControlList; + FEnableExecuteAction: Boolean; + FCanParentFocus: Boolean; + FMinClipHeight: Single; + FMinClipWidth: Single; + FSmallSizeControl: Boolean; + FTouchTargetExpansion: TBounds; + FOnDeactivate: TNotifyEvent; + FOnActivate: TNotifyEvent; + FSimpleTransform: Boolean; + FFixedSize: TSize; + FEffects: TList; + FDisabledOpacity: Single; + [Weak] FParentControl: TControl; + FParentContent: IContent; + FParentContentObserver: IContentObserver; + FUpdateRect: TRectF; + FTabStop: Boolean; + FDisableDisappear: Integer; + FAnchorMove: Boolean; + FApplyingEffect: Boolean; + FExitingOrEntering: Boolean; + FDelayedEvents: set of TDelayedEvent; + FTabOrder: TTabOrder; + procedure AddToEffectsList(const AEffect: TEffect); + procedure RemoveFromEffectsList(const AEffect: TEffect); + class var FEmptyControlList: TControlList; + function GetInvertAbsoluteMatrix: TMatrix; + procedure SetPosition(const Value: TPosition); + procedure SetHitTest(const Value: Boolean); + procedure SetClipChildren(const Value: Boolean); + function GetCanvas: TCanvas; inline; + procedure SetLocked(const Value: Boolean); + procedure SetTempCanvas(const Value: TCanvas); + procedure SetOpacity(const Value: Single); + function IsOpacityStored: Boolean; + procedure SetCursor(const Value: TCursor); + procedure RefreshInheritedCursor; + procedure RefreshInheritedCursorForChildren; + function GetAbsoluteWidth: Single; + function GetAbsoluteHeight: Single; + function IsAnchorsStored: Boolean; + function GetEnabled: Boolean; + function GetCursor: TCursor; + function GetInheritedCursor: TCursor; + function GetAbsoluteHasEffect: Boolean; + function GetAbsoluteHasDisablePaintEffect: Boolean; + function GetAbsoluteHasAfterPaintEffect: Boolean; + procedure PaddingChangedHandler(Sender: TObject); overload; + procedure MarginsChanged(Sender: TObject); + procedure MatrixChanged(Sender: TObject); + procedure SizeChanged(Sender: TObject); + function GetControlsCount: Integer; + function OnClickStored: Boolean; + function IsPopupMenuStored: Boolean; + procedure RequestAlign; + procedure SetMinClipHeight(const Value: Single); + procedure SetMinClipWidth(const Value: Single); + function UpdateSmallSizeControl: Boolean; + class constructor Create; + class destructor Destroy; + procedure SetOnClick(const Value: TNotifyEvent); + function GetIsFocused: Boolean; + procedure SetPadding(const Value: TBounds); + procedure SetMargins(const Value: TBounds); + procedure SetTouchTargetExpansion(const Value: TBounds); + procedure InternalSizeChanged; + procedure ReadFixedWidth(Reader: TReader); + procedure WriteFixedWidth(Writer: TWriter); + procedure ReadFixedHeight(Reader: TReader); + procedure WriteFixedHeight(Writer: TWriter); + procedure ReadDesignVisible(Reader: TReader); + procedure ReadHint(Reader: TReader); + procedure ReadShowHint(Reader: TReader); + function DisabledOpacityStored: Boolean; + procedure SetDisabledOpacity(const Value: Single); + function GetAxisAlignedRect: TRectF; + { IRotatedControl } + function GetRotationAngle: Single; + function GetRotationCenter: TPosition; + function GetScale: TPosition; + procedure SetRotationAngle(const Value: Single); + procedure SetRotationCenter(const Value: TPosition); + procedure SetScale(const Value: TPosition); + function GetTabOrder: TTabOrder; + procedure SetTabOrder(const Value: TTabOrder); + function GetTabStop: Boolean; + procedure SetTabStop(const TabStop: Boolean); + procedure SetDisableDisappear(const Value: Boolean); + function GetDisableDisappear: Boolean; + procedure UpdateParentProperties; + procedure EnumRenderableControls(const AConsumer: TProc); + private + FInflated: Boolean; + FOnApplyStyle: TNotifyEvent; + FOnFreeStyle: TNotifyEvent; + FAlign: TAlignLayout; + FAnchors: TAnchors; + FDisableFocusEffect: Boolean; + FTouchManager: TTouchManager; + FOnGesture: TGestureEvent; + FVisible: Boolean; + FPressed: Boolean; + FPressedPosition: TPointF; + FDoubleClick: Boolean; + FParentShowHint: Boolean; + FCustomSceneAddRect: TCustomSceneAddRectEvent; + procedure CreateTouchManagerIfRequired; + function GetTouchManager: TTouchManager; + procedure SetTouchManager(const Value: TTouchManager); + function IsShowHintStored: Boolean; + procedure SetParentShowHint(const Value: Boolean); + procedure SetShowHint(const Value: Boolean); + function GetAbsoluteClipRect: TRectF; + function HintStored: Boolean; + strict protected + procedure RepaintJointArea(const DestControl: TFmxObject); + protected + FScene: IScene; + FLastHeight: Single; + FLastWidth: Single; + FSize: TControlSize; + FLocalMatrix: TMatrix; + FAbsoluteMatrix: TMatrix; + FInvAbsoluteMatrix: TMatrix; + FEffectCache: IFilterCacheLayer; + FLocked: Boolean; + FOpacity, FAbsoluteOpacity: Single; + FInPaintTo: Boolean; + FInPaintToAbsMatrix, FInPaintToInvMatrix: TMatrix; + FAbsoluteHasEffect: Boolean; + FAbsoluteHasDisablePaintEffect: Boolean; + FAbsoluteHasAfterPaintEffect: Boolean; + FUpdating: Integer; + FNeedAlign: Boolean; + FDisablePaint: Boolean; + FDisableAlign: Boolean; + FRecalcOpacity: Boolean; + FRecalcUpdateRect: Boolean; + FRecalcAbsolute: Boolean; + FRecalcHasEffect: Boolean; + FHasClipParent: TControl; + FRecalcHasClipParent: Boolean; + FDesignInteractive: Boolean; + FDesignSelectionMarks: Boolean; + FIsMouseOver: Boolean; + FIsFocused: Boolean; + { added for aligment using a relation between align and anchors} + FAnchorRules: TPointF; + FAnchorOrigin: TPointF; + FOriginalParentSize: TPointF; + FLeft: Single; + FTop: Single; + FExplicitLeft: Single; + FExplicitTop: Single; + FExplicitWidth: Single; + FExplicitHeight: Single; + procedure DoAbsoluteChanged; virtual; + function CheckHitTest(const AHitTest: Boolean): Boolean; virtual; + procedure SetInPaintTo(Value: Boolean); + procedure EndUpdateNoChanges; + /// This method sets the hint string for this control. + procedure SetHint(const AHint: string); virtual; + { } + procedure SetEnabled(const Value: Boolean); virtual; + procedure Loaded; override; + procedure Updated; override; + procedure DefineProperties(Filer: TFiler); override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure ParentChanged; override; + procedure ParentContentChanged; virtual; + procedure ChangeOrder; override; + procedure ChangeChildren; override; + procedure SetVisible(const Value: Boolean); virtual; + function DoSetWidth(var Value: Single; NewValue: Single; var LastValue: Single): Boolean; virtual; deprecated 'Use DoSetSize'; + function DoSetHeight(var Value: Single; NewValue: Single; var LastValue: Single): Boolean; virtual; deprecated 'Use DoSetSize'; + function DoSetSize(const ASize: TControlSize; const NewPlatformDefault: Boolean; ANewWidth, ANewHeight: Single; + var ALastWidth, ALastHeight: Single): Boolean; virtual; + procedure HandleSizeChanged; virtual; + { matrix } + procedure DoMatrixChanged(Sender: TObject); virtual; + procedure SetHeight(const Value: Single); virtual; + procedure SetWidth(const Value: Single); virtual; + procedure SetSize(const AValue: TControlSize); overload; virtual; + procedure SetSize(const AWidth, AHeight: Single; const APlatformDefault: Boolean = False); overload; virtual; + function GetAbsoluteRect: TRectF; virtual; + function GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean; virtual; + function GetAbsoluteScale: TPointF; virtual; + function GetParentedRect: TRectF; virtual; deprecated 'Use GetBoundsRect'; + function GetClipRect: TRectF; virtual; + function GetEffectsRect: TRectF; virtual; + function GetAbsoluteEnabled: Boolean; virtual; + function GetChildrenRect: TRectF; virtual; + function GetLocalRect: TRectF; virtual; + function GetBoundsRect: TRectF; virtual; + procedure SetBoundsRect(const Value: TRectF); virtual; + function IsHeightStored: Boolean; virtual; deprecated 'Use IsSizeStored'; + function IsWidthStored: Boolean; virtual; deprecated 'Use IsSizeStored'; + function IsPositionStored: Boolean; virtual; + function IsSizeStored: Boolean; virtual; + procedure SetPopupMenu(const Value: TCustomPopupMenu); + { optimizations } + procedure RecalculateAbsoluteMatrices; virtual; + function GetAbsoluteMatrix: TMatrix; virtual; + function GetHasClipParent: TControl; + function GetUpdateRect: TRectF; + function DoGetUpdateRect: TRectF; virtual; + { opacity } + function GetAbsoluteOpacity: Single; virtual; + { events } + procedure BeginAutoDrag; virtual; + procedure Capture; + procedure ReleaseCapture; + property EnableExecuteAction: boolean read FEnableExecuteAction write FEnableExecuteAction; + procedure Click; virtual; + procedure DblClick; virtual; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); virtual; + procedure MouseMove(Shift: TShiftState; X, Y: Single); virtual; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); virtual; + procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); virtual; + procedure MouseClick(Button: TMouseButton; Shift: TShiftState; X, Y: Single); virtual; + procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); virtual; + procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); virtual; + procedure DialogKey(var Key: Word; Shift: TShiftState); virtual; + procedure AfterDialogKey(var Key: Word; Shift: TShiftState); virtual; + function ShowContextMenu(const ScreenPosition: TPointF): Boolean; virtual; + procedure DragEnter(const Data: TDragObject; const Point: TPointF); virtual; + procedure DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); virtual; + procedure DragDrop(const Data: TDragObject; const Point: TPointF); virtual; + procedure DragLeave; virtual; + procedure DragEnd; virtual; + function GetDefaultTouchTargetExpansion: TRectF; virtual; + function GetCanFocus: Boolean; virtual; + function GetCanParentFocus: Boolean; virtual; + function EnterChildren(AObject: IControl): Boolean; virtual; + function ExitChildren(AObject: IControl): Boolean; virtual; + function GetParentedVisible: Boolean; virtual; + { IEffectContainer } + procedure NeedUpdateEffects; + procedure BeforeEffectEnabledChanged(const Enabled: Boolean); + procedure EffectEnabledChanged(const Enabled: Boolean); + { IAlignRoot } + procedure Realign; + procedure ChildrenAlignChanged; + { IAlignableObject } + function GetAlign: TAlignLayout; + procedure SetAlign(const Value: TAlignLayout); virtual; + function GetAnchors: TAnchors; + procedure SetAnchors(const Value: TAnchors); virtual; + function GetMargins: TBounds; + function GetPadding: TBounds; + function GetWidth: Single; virtual; + function GetHeight: Single; virtual; + function GetLeft: Single; virtual; + function GetTop: Single; virtual; + function GetAllowAlign: Boolean; + function GetAnchorRules : TPointF; + function GetAnchorOrigin : TPointF; + function GetOriginalParentSize : TPointF; + function GetAnchorMove : Boolean; + procedure SetAnchorMove(Value : Boolean); + function GetAdjustSizeValue: TSizeF; virtual; + function GetAdjustType: TAdjustType; virtual; + { IContainerObject } + function GetContainerWidth: Single; + function GetContainerHeight: Single; + { IControl } + function IControl.GetObject = GetObject; + function GetObject: TFmxObject; + function GetParent: TFmxObject; + function GetVisible: Boolean; virtual; + function GetDesignInteractive: Boolean; + function GetPopupMenu: TCustomPopupMenu; + procedure DoEnter; virtual; + procedure DoExit; virtual; + procedure DoActivate; virtual; + procedure DoDeactivate; virtual; + procedure DoMouseEnter; virtual; + procedure DoMouseLeave; virtual; + function CheckForAllowFocus: Boolean; + function GetDragMode: TDragMode; virtual; + procedure SetDragMode(const ADragMode: TDragMode); virtual; + function GetLocked: Boolean; + function GetHitTest: Boolean; + function GetAcceptsControls: Boolean; + procedure SetAcceptsControls(const Value: boolean); + function FindTarget(P: TPointF; const Data: TDragObject): IControl; virtual; + function ObjectAtPoint(AScreenPoint: TPointF): IControl; virtual; + /// Implementation of IControl.HasHint. See IControl for details. + function HasHint: Boolean; virtual; + /// Implementation of IControl.GetHintString. See IControl for details. + function GetHintString: string; virtual; + /// Implementation of IControl.GetHintObject. See IControl for details. + function GetHintObject: TObject; virtual; + /// This method returns true if the control can show hint according ParentShowHint, + /// ShowHint and settings of parent control values. + function CanShowHint: Boolean; virtual; + { IGestureControl } + procedure BroadcastGesture(EventInfo: TGestureEventInfo); + procedure CMGesture(var EventInfo: TGestureEventInfo); virtual; + function TouchManager: TTouchManager; + function GetFirstControlWithGesture(AGesture: TInteractiveGesture): TComponent; virtual; + function GetFirstControlWithGestureEngine: TComponent; + function GetListOfInteractiveGestures: TInteractiveGestures; + procedure Tap(const Point:TPointF); virtual; + { optimization } + function GetFirstVisibleObjectIndex: Integer; virtual; + function GetLastVisibleObjectIndex: Integer; virtual; + function GetDefaultSize: TSizeF; virtual; + { bi-di } + function FillTextFlags: TFillTextFlags; virtual; + { paint internal } + procedure ApplyEffect; virtual; + procedure PaintInternal; + procedure DrawDragHighlight; virtual; + function SupportsPaintStage(const Stage: TPaintStage): Boolean; virtual; + { paint } + function CanRepaint: Boolean; virtual; + procedure RepaintRect(const Rect: TRectF); + procedure PaintChildren; virtual; + procedure Painting; virtual; + procedure Paint; virtual; + procedure DoPaint; virtual; + procedure AfterPaint; virtual; + procedure DrawDesignBorder(const VertColor: TAlphaColor = DesignBorderColor; + const HorzColor: TAlphaColor = DesignBorderColor); + { align } + procedure DoRealign; virtual; + procedure DoBeginUpdate; virtual; + procedure DoEndUpdate; virtual; + function CanFlipChild(const AChild: TFmxObject): Boolean; virtual; + procedure DoFlipChildren; virtual; + { changes } + procedure Move; virtual; + procedure Resize; virtual; + procedure DoResized; virtual; + procedure Disappear; virtual; + procedure Show; virtual; + procedure Hide; virtual; + procedure AncestorVisibleChanged(const Visible: Boolean); virtual; + /// Notification about changed parent of ancestor + procedure AncestorParentChanged; virtual; + procedure ClipChildrenChanged; virtual; + procedure HitTestChanged; virtual; + /// Notification about changed padding + procedure PaddingChanged; overload; virtual; + property MinClipWidth: Single read FMinClipWidth write SetMinClipWidth; + property MinClipHeight: Single read FMinClipHeight write SetMinClipHeight; + property SmallSizeControl: Boolean read FSmallSizeControl; + { children } + procedure DoAddObject(const AObject: TFmxObject); override; + procedure DoInsertObject(Index: Integer; const AObject: TFmxObject); override; + procedure DoRemoveObject(const AObject: TFmxObject); override; + procedure DoDeleteChildren; override; + { props } + class property PaintStage: TPaintStage read FPaintStage write FPaintStage; + property TempCanvas: TCanvas read FTempCanvas write SetTempCanvas; + { added for aligment using a relation between align and anchors} + procedure SetLeft(const Value: Single); + procedure SetTop(const Value: Single); + procedure UpdateExplicitBounds; + procedure UpdateAnchorRules(const Anchoring: Boolean = False); + property Left: Single read FLeft write SetLeft; + property Top: Single read FTop write SetTop; + property ExplicitLeft: Single read FExplicitLeft; + property ExplicitTop: Single read FExplicitTop; + property ExplicitWidth: Single read FExplicitWidth; + property ExplicitHeight: Single read FExplicitHeight; + function GetActionLinkClass: TActionLinkClass; override; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + function EnabledStored: Boolean; virtual; + function VisibleStored: Boolean; virtual; + /// This method is called after change field FEnabled in SetEnabled before all other + /// actions + procedure EnabledChanged; virtual; + /// This method is called after change field FVisible in SetVisible before all other + /// actions + procedure VisibleChanged; virtual; + /// Returns True if the control rect is empty. + function IsControlRectEmpty: Boolean; virtual; + function GetControls: TControlList; + procedure DoGesture(const EventInfo: TGestureEventInfo; var Handled: Boolean); virtual; + function GetTabStopController: ITabStopController; virtual; + function GetTabListClass: TTabListClass; virtual; + property DoubleClick: Boolean read FDoubleClick; + { IRotatedControl } + property RotationAngle: Single read GetRotationAngle write SetRotationAngle; + property RotationCenter: TPosition read GetRotationCenter write SetRotationCenter; + property Scale: TPosition read GetScale write SetScale; + property DisabledOpacity: Single read FDisabledOpacity write SetDisabledOpacity stored DisabledOpacityStored nodefault; + property ParentContent: IContent read FParentContent; + property ParentContentObserver: IContentObserver read FParentContentObserver; + /// If the control has ShowHint to false, this property is used to see if a hint can be displayed. + property ParentShowHint: Boolean read FParentShowHint write SetParentShowHint default True; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SetNewScene(AScene: IScene); virtual; + procedure SetBounds(X, Y, AWidth, AHeight: Single); virtual; + {$REGION 'Converting Between Coordinate Systems'} + /// Converts Point in absolute coordinate system to local coordinate system of control. + function AbsoluteToLocal(const APoint: TPointF): TPointF; overload; virtual; + /// Converts ARect in absolute coordinate system to local coordinate system of control. + function AbsoluteToLocal(const ARect: TRectF): TRectF; overload; + /// Converts Point in local coordinate system of control to absolute coordinate system. + function LocalToAbsolute(const APoint: TPointF): TPointF; overload; virtual; + /// Converts ARect in local coordinate system of control to absolute coordinate system. + function LocalToAbsolute(const ARect: TRectF): TRectF; overload; + /// Converts a point from the screen coordinate system to the scene coordinate system. + function ScreenToLocal(const AScreenPoint: TPointF): TPointF; virtual; + /// Converts a point from the scene coordinate system to the screen coordinate system. + function LocalToScreen(const ALocalPoint: TPointF): TPointF; virtual; + /// Converts a point from the coordinate system of a given AControl to that of the control. + function ConvertLocalPointFrom(const AControl: TControl; const AControlLocalPoint: TPointF): TPointF; + /// Converts a point from the control's coordinate system to that of the specified control AControl. + function ConvertLocalPointTo(const AControl: TControl; const ALocalPoint: TPointF): TPointF; + function AbsoluteToLocalVector(Vector: TVector): TVector; virtual; + function LocalToAbsoluteVector(Vector: TVector): TVector; virtual; + {$ENDREGION} + { hit test } + function PointInObject(X, Y: Single): Boolean; virtual; + function PointInObjectLocal(X, Y: Single): Boolean; virtual; + { drag and drop } + function MakeScreenshot: TBitmap; + { align } + procedure BeginUpdate; virtual; + function IsUpdating: Boolean; virtual; + procedure EndUpdate; virtual; + { IFlipContainer } + procedure FlipChildren(const AAllLevels: Boolean); + { optimizations } + procedure RecalcAbsoluteNow; + procedure RecalcUpdateRect; virtual; + procedure RecalcOpacity; virtual; + procedure RecalcAbsolute; virtual; + procedure RecalcEnabled; virtual; + procedure RecalcHasEffect; virtual; + procedure RecalcHasClipParent; virtual; + procedure PrepareForPaint; virtual; + procedure RecalcSize; virtual; + { effects } + procedure UpdateEffects; + { ITriggerEffect } + procedure ApplyTriggerEffect(const AInstance: TFmxObject; const ATrigger: string); virtual; + { ITriggerAnimation } + procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string); virtual; + procedure StartTriggerAnimationWait(const AInstance: TFmxObject; const ATrigger: string); virtual; + { Focus } + procedure SetFocus; + procedure ResetFocus; + /// Paints current hierarchy of controls on the specified ACanvas in area ARect. ARect + /// uses logical coordinate system. + procedure PaintTo(const ACanvas: TCanvas; const ARect: TRectF; const AParent: TFmxObject = nil); + procedure Repaint; + procedure InvalidateRect(ARect: TRectF); + procedure Lock; + property AbsoluteMatrix: TMatrix read GetAbsoluteMatrix; + property AbsoluteOpacity: Single read GetAbsoluteOpacity; + property AbsoluteWidth: Single read GetAbsoluteWidth; + property AbsoluteHeight: Single read GetAbsoluteHeight; + property AbsoluteScale: TPointF read GetAbsoluteScale; + property AbsoluteEnabled: Boolean read GetAbsoluteEnabled; + property AbsoluteRect: TRectF read GetAbsoluteRect; + /// The absolute rectangle of control after clipping by all its parent controls + property AbsoluteClipRect: TRectF read GetAbsoluteClipRect; + property AxisAlignedRect: TRectF read GetAxisAlignedRect; + /// Flag property indicates when control in applying effect state. + property ApplyingEffect: Boolean read FApplyingEffect; + property HasEffect: Boolean read GetAbsoluteHasEffect; + property HasDisablePaintEffect: Boolean read GetAbsoluteHasDisablePaintEffect; + property HasAfterPaintEffect: Boolean read GetAbsoluteHasAfterPaintEffect; + property HasClipParent: TControl read GetHasClipParent; + property ChildrenRect: TRectF read GetChildrenRect; + property DefaultSize: TSizeF read GetDefaultSize; + property FixedSize: TSize read FFixedSize write FFixedSize; + property InvertAbsoluteMatrix: TMatrix read GetInvertAbsoluteMatrix; + property InPaintTo: Boolean read FInPaintTo; + property LocalRect: TRectF read GetLocalRect; + property Pressed: Boolean read FPressed write FPressed; + ///Point when MouseDown is called + property PressedPosition: TPointF read FPressedPosition write FPressedPosition; + property UpdateRect: TRectF read GetUpdateRect; + property BoundsRect: TRectF read GetBoundsRect write SetBoundsRect; + {$WARN SYMBOL_DEPRECATED OFF} + property ParentedRect: TRectF read GetParentedRect; + {$WARN SYMBOL_DEPRECATED DEFAULT} + property ParentedVisible: Boolean read GetParentedVisible; + property ClipRect: TRectF read GetClipRect; + property Canvas: TCanvas read GetCanvas; + property Controls: TControlList read GetControls; + property ControlsCount: Integer read GetControlsCount; + property ParentControl: TControl read FParentControl; + property Scene: IScene read FScene; + property AutoCapture: Boolean read FAutoCapture write FAutoCapture default False; + property CanFocus: Boolean read FCanFocus write FCanFocus default False; + property CanParentFocus: Boolean read FCanParentFocus write FCanParentFocus default False; + property DisableFocusEffect: Boolean read FDisableFocusEffect write FDisableFocusEffect default False; + property IsInflated: Boolean read FInflated; + procedure EnumControls(const Proc: TFunc); overload; + function EnumControls(Proc: TEnumControlsRef; const VisibleOnly: Boolean = True): Boolean; overload; + deprecated 'Use another version of EnumControls'; + { ITabStopController } + function GetTabList: ITabList; virtual; + function ShowInDesigner: Boolean; virtual; + /// False if the control should be ignored in ObjectAtPoint, normally same as Visible. + /// TFrame overrides it to allow itself to be painted in design time regardless of its Visible value. + function ShouldTestMouseHits: Boolean; virtual; + { triggers } + property IsMouseOver: Boolean read FIsMouseOver; + property IsDragOver: Boolean read FIsDragOver; + property IsFocused: Boolean read GetIsFocused; + property IsVisible: Boolean read FVisible; + property Align: TAlignLayout read FAlign write SetAlign default TAlignLayout.None; + property Anchors: TAnchors read FAnchors write SetAnchors stored IsAnchorsStored nodefault; + property Cursor: TCursor read GetCursor write SetCursor default crDefault; + property InheritedCursor: TCursor read GetInheritedCursor default crDefault; + property DragMode: TDragMode read GetDragMode write SetDragMode default TDragMode.dmManual; + property EnableDragHighlight: Boolean read FEnableDragHighlight write FEnableDragHighlight default True; + property Enabled: Boolean read FEnabled write SetEnabled stored EnabledStored default True; + property Position: TPosition read FPosition write SetPosition stored IsPositionStored; + property Locked: Boolean read FLocked write SetLocked default False; + property Width: Single read GetWidth write SetWidth stored False nodefault; + property Height: Single read GetHeight write SetHeight stored False nodefault; + property Size: TControlSize read FSize write SetSize stored IsSizeStored nodefault; + property Padding: TBounds read GetPadding write SetPadding; + property Margins: TBounds read GetMargins write SetMargins; + property Opacity: Single read FOpacity write SetOpacity stored IsOpacityStored nodefault; + property ClipChildren: Boolean read FClipChildren write SetClipChildren default False; + property ClipParent: Boolean read FClipParent write FClipParent default False; + property HitTest: Boolean read FHitTest write SetHitTest default True; + property PopupMenu: TCustomPopupMenu read FPopupMenu write SetPopupMenu stored IsPopupMenuStored; + property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1; + property Visible: Boolean read FVisible write SetVisible stored VisibleStored default True; + property CustomSceneAddRect: TCustomSceneAddRectEvent read FCustomSceneAddRect write FCustomSceneAddRect; + property OnDragEnter: TDragEnterEvent read FOnDragEnter write FOnDragEnter; + property OnDragLeave: TNotifyEvent read FOnDragLeave write FOnDragLeave; + property OnDragOver: TDragOverEvent read FOnDragOver write FOnDragOver; + property OnDragDrop: TDragDropEvent read FOnDragDrop write FOnDragDrop; + property OnDragEnd: TNotifyEvent read FOnDragEnd write FOnDragEnd; + property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown; + property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp; + property OnClick: TNotifyEvent read FOnClick write SetOnClick stored OnClickStored; + property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick; + property OnCanFocus: TCanFocusEvent read FOnCanFocus write FOnCanFocus; + property OnEnter: TNotifyEvent read FOnEnter write FOnEnter; + property OnExit: TNotifyEvent read FOnExit write FOnExit; + property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown; + property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove; + property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp; + property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel; + property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter; + property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave; + property OnPainting: TOnPaintEvent read FOnPainting write FOnPainting; + property OnPaint: TOnPaintEvent read FOnPaint write FOnPaint; + property OnResize: TNotifyEvent read FOnResize write FOnResize; + property OnResized: TNotifyEvent read FOnResized write FOnResized; + property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; + property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate; + property OnApplyStyleLookup: TNotifyEvent read FOnApplyStyle write FOnApplyStyle; + property OnFreeStyle: TNotifyEvent read FOnFreeStyle write FOnFreeStyle; + property TouchTargetExpansion: TBounds read FTouchTargetExpansion write SetTouchTargetExpansion; + property TabStop: Boolean read GetTabStop write SetTabStop default True; + property DisableDisappear: Boolean read GetDisableDisappear write SetDisableDisappear; + /// If this property is true, the control will display its hint. + property ShowHint: Boolean read FShowHint write SetShowHint stored IsShowHintStored; + /// Hint string to display if the mouse hovers the control. + property Hint: string read FHint write SetHint stored HintStored; + published + property Touch: TTouchManager read GetTouchManager write SetTouchManager; + property OnGesture: TGestureEvent read FOnGesture write FOnGesture; + property OnTap: TTapEvent read FOnTap write FOnTap; + end; + + IDrawableObject = interface + ['{C86EEAD8-69BF-4FDF-9FEE-A2F65E0EB3F0}'] + procedure DrawToCanvas(const Canvas: TCanvas; const ARect: TRectF; const AOpacity: Single = 1.0); + end; + + ITintedObject = interface + ['{42D829B7-6D86-41CC-86D5-F92C1FCAB060}'] + function GetCanBeTinted: Boolean; + procedure SetTintColor(const ATintColor: TAlphaColor); + property CanBeTinted: Boolean read GetCanBeTinted; + property TintColor: TAlphaColor write SetTintColor; + end; + + TOrientation = (Horizontal, Vertical); + /// Determines the current state of the style + /// Unapplied - The style was successfully freed, or was not applied yet + /// Freeing - At the moment the style is being freed + /// See FreeStyle + /// Applying - At the moment the style is being applied + /// See ApplyStyle + /// Error - an exception was raised during applying or freeing the style + /// Applied - The style was successfully applied + /// + TStyleState = (Unapplied, Freeing, Applying, Error, Applied); + +{ TStyledControl } + + TStyledControl = class(TControl) + public const + StyleSuffix = 'style'; + strict private class var + FLoadableStyle: TFmxObject; + strict private + FStylesData: TDictionary; + FResourceLink: TFmxObject; + FAdjustType: TAdjustType; + FAdjustSizeValue: TSizeF; + FStyleLookup: string; + FIsNeedStyleLookup: Boolean; + FAutoTranslate: Boolean; + FHelpType: THelpType; + FHelpKeyword: string; + FHelpContext: THelpContext; + FStyleState: TStyleState; + function GetStyleData(const Index: string): TValue; + procedure SetStyleData(const Index: string; const Value: TValue); + procedure SetStyleLookup(const Value: string); + procedure ScaleChangedHandler(const Sender: TObject; const Msg: System.Messaging.TMessage); + procedure StyleChangedHandler(const Sender: TObject; const Msg : TMessage); + private + procedure InternalApplyStyle(const StyleObject: TFmxObject); + procedure InternalFreeStyle; + protected + function SearchInto: Boolean; override; + function GetBackIndex: Integer; override; + function IsHelpContextStored: Boolean; + procedure SetHelpContext(const Value: THelpContext); + procedure SetHelpKeyword(const Value: string); + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + function DoSetSize(const ASize: TControlSize; const NewPlatformDefault: Boolean; ANewWidth, ANewHeight: Single; + var ALastWidth, ALastHeight: Single): Boolean; override; + procedure DoApplyStyleLookup; virtual; + procedure DoFreeStyle; virtual; + { Styles Data } + procedure StyleDataChanged(const Index: string; const Value: TValue); virtual; + function RequestStyleData(const Index: string): TValue; virtual; + { control } + procedure Painting; override; + procedure ApplyStyle; virtual; + procedure FreeStyle; virtual; + function CanFlipChild(const AChild: TFmxObject): Boolean; override; + /// Return Context for behavior manager. + function GetStyleContext: TFmxObject; virtual; + function GetDefaultStyleLookupName: string; virtual; + /// Getter for ParentClassStyleLookupName property. Return default StyleLookup name for parent class. + /// Used when style is loading. + function GetParentClassStyleLookupName: string; virtual; + procedure DoEnter; override; + procedure Disappear; override; + procedure AdjustSize; virtual; + procedure AdjustFixedSize(const ReferenceControl: TControl); virtual; + /// Select fixed size adjust type based on FixedSize in ResourceLink + function ChooseAdjustType(const FixedSize: TSize): TAdjustType; virtual; + procedure DoStyleChanged; virtual; + procedure StyleLookupChanged; virtual; + procedure RecycleResourceLink; + procedure KillResourceLink; + procedure DoDeleteChildren; override; + /// Generate style lookup name based on AClassName string. + function GenerateStyleName(const AClassName: string): string; + function GetStyleObject: TFmxObject; overload; virtual; + function GetStyleObject(const Clone: Boolean): TFmxObject; overload; virtual; + procedure SetAdjustSizeValue(const Value: TSizeF); virtual; + procedure SetAdjustType(const Value: TAdjustType); virtual; + /// Gets style resource for this control as TFmxObject + function GetResourceLink: TFmxObject; virtual; + /// Gets style resource for this control as TControl + function GetResourceControl: TControl; + property IsNeedStyleLookup: Boolean read FIsNeedStyleLookup; + property ResourceLink: TFmxObject read GetResourceLink; + property ResourceControl: TControl read GetResourceControl; + { IAlignableObject } + function GetAdjustSizeValue: TSizeF; override; + function GetAdjustType: TAdjustType; override; + public + constructor Create(AOwner: TComponent); overload; override; + procedure BeforeDestruction; override; + destructor Destroy; override; + property AdjustType: TAdjustType read GetAdjustType; + property AdjustSizeValue: TSizeF read GetAdjustSizeValue; + /// This property allows you to define the current state of style. It is changed when calling virtual + /// methods FreeStyle, + /// ApplyStyle, + /// DoApplyStyleLookup + /// + property StyleState: TStyleState read FStyleState; + procedure RecalcSize; override; + function FindStyleResource(const AStyleLookup: string; const Clone: Boolean = False): TFmxObject; overload; override; + /// Try find resource of specified type T by name AStyleLookup. If resource is not of type T or + /// is not found, it returns false and doesn't change value of AResource param + function FindStyleResource(const AStyleLookup: string; var AResource: T): Boolean; overload; + /// Try find resource of specified type T by name AStyleLookup and makes a copy of original resource. + /// If resource is not of type T, it returns nil + function FindAndCloneStyleResource(const AStyleLookup: string; var AResource: T): Boolean; + procedure SetNewScene(AScene: IScene); override; + procedure ApplyStyleLookup; virtual; + procedure NeedStyleLookup; virtual; + procedure Inflate; virtual; + procedure PrepareForPaint; override; + procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string); override; + procedure StartTriggerAnimationWait(const AInstance: TFmxObject; const ATrigger: string); override; + property AutoTranslate: Boolean read FAutoTranslate write FAutoTranslate; + property DefaultStyleLookupName: string read GetDefaultStyleLookupName; + /// Return default StyleLookup name for parent class + property ParentClassStyleLookupName: string read GetParentClassStyleLookupName; + property HelpType: THelpType read FHelpType write FHelpType default htContext; + property HelpKeyword: string read FHelpKeyword write SetHelpKeyword stored IsHelpContextStored; + property HelpContext: THelpContext read FHelpContext write SetHelpContext stored IsHelpContextStored default 0; + property StylesData[const Index: string]: TValue read GetStyleData write SetStyleData; + property StyleLookup: string read FStyleLookup write SetStyleLookup; + /// Style that currently used to load style object + class property LoadableStyle: TFmxObject read FLoadableStyle write FLoadableStyle; + /// Lookup style object in scene StyleBook, active style and global pool. + class function LookupStyleObject(const Instance: TFmxObject; const Context: TFmxObject; const Scene: IScene; + const StyleLookup, DefaultStyleLookup, ParentClassStyleLookup: string; const Clone: Boolean; + const UseGlobalPool: Boolean = True): TFmxObject; + end; + + TStyleChangedMessage = class(TMessage) + private + FScene: IScene; + public + constructor Create(const StyleBook: TStyleBook; const Scene: IScene); overload; + /// Scene where the style has been changed, nil if the change is global + property Scene: IScene read FScene; + end; + + TBeforeStyleChangingMessage = class(TMessage) + end; + +{ TStyleContainer } + + TStyleContainer = class(TControl, IBinaryStyleContainer) + private + FBinaryDict: TDictionary; + function CreateStyleResource(const AStyleLookup: string): TFmxObject; + { IBinaryStyleContainer } + procedure ClearContainer; + procedure UnpackAllBinaries; + procedure AddBinaryFromStream(const Name: string; const SourceStream: TStream; const Size: Int64); + procedure AddObjectFromStream(const Name: string; const SourceStream: TStream; const Size: Int64); + function LoadStyleResource(const AStream: TStream): TFmxObject; + protected + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function FindStyleResource(const AStyleLookup: string; const Clone: Boolean = False): TFmxObject; override; + end; + +{ TStyleBook } + + /// Represents an item in an instance of TStyleCollection that holds + /// a style for a platform. + TStyleCollectionItem = class(TCollectionItem) + public const + DefaultItem = 'Default'; + private + [Weak] FStyleBook: TStyleBook; + FBinary: TMemoryStream; + FStyle: TFmxObject; + FPlatform: string; + FUnsupportedPlatform: Boolean; + FNeedLoadFromBinary: Boolean; + procedure SetPlatform(const Value: string); + procedure SetResource(const Value: string); + function GetResource: string; + function GetStyle: TFmxObject; + procedure ReadResources(Stream: TStream); + procedure WriteResources(Stream: TStream); + function StyleStored: Boolean; + function GetIsEmpty: Boolean; + protected + procedure DefineProperties(Filer: TFiler); override; + function GetDisplayName: string; override; + public + constructor Create(Collection: TCollection); override; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + /// Reload style from binary stream + procedure LoadFromBinary; + /// Save style to binary stream + procedure SaveToBinary; + /// Clear style and binary stream + procedure Clear; + /// Return true is style is empty + property IsEmpty: Boolean read GetIsEmpty; + /// Load style from stream + procedure LoadFromStream(const Stream: TStream); + /// Load style from file + procedure LoadFromFile(const FileName: string); + /// Save style to stream + procedure SaveToStream(const Stream: TStream; const Format: TStyleFormat = TStyleFormat.Indexed); + /// Link to owner StyleBook + property StyleBook: TStyleBook read FStyleBook; + /// Style that stored on this item + property Style: TFmxObject read GetStyle; + /// If style can not be load on current platform tihs property is True and Style is empty + property UnsupportedPlatform: Boolean read FUnsupportedPlatform; + published + /// Name used to idenity style in collection + property Platform: string read FPlatform write SetPlatform; + /// Design-time only property used to show Style Designer + property Resource: string read GetResource write SetResource stored False; + end; + + /// Collection of items that store styles for different + /// platforms. + TStyleCollection = class(TOwnedCollection) + private + [Weak] FStyleBook: TStyleBook; + function GetItem(Index: Integer): TStyleCollectionItem; + procedure SetItem(Index: Integer; const Value: TStyleCollectionItem); + protected + procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override; + public + constructor Create(AOwner: TPersistent); + /// Create and add new item + function Add: TStyleCollectionItem; + /// Access property for style collection items + property Items[Index: Integer]: TStyleCollectionItem read GetItem write SetItem; default; + end; + + /// Record type that contains design-time information for the Form + /// Designer. + TStyleBookDesignInfo = record + /// ClassName of selected control + ClassName: string; + /// If True that edit custom style mode is active + CustomStyle: Boolean; + /// Default StyleLookup for selected control + DefaultStyleLookup: string; + /// Name of selected control + Name: string; + /// StyleLookup of selected control + StyleLookup: string; + /// Selected control itself + Control: TStyledControl; + /// True if StyleBook just created + JustCreated: Boolean; + end; + + TStyleBook = class(TFmxObject) + private + FStyles: TStyleCollection; + FStylesDic: TDictionary; + FCurrentItemIndex: Integer; + FFileName: string; + FDesignInfo: TStyleBookDesignInfo; + FUseStyleManager: Boolean; + FBeforeStyleChangingId: TMessageSubscriptionId; + FStyleChangedId: TMessageSubscriptionId; + FResource: TStrings; + procedure SetFileName(const Value: string); + procedure SetUseStyleManager(const Value: Boolean); + procedure SetStyles(const Value: TStyleCollection); + function GetStyle: TFmxObject; overload; + procedure SetCurrentItemIndex(const Value: Integer); + procedure BeforeStyleChangingHandler(const Sender: TObject; const Msg: TMessage); + procedure StyleChangedHandler(const Sender: TObject; const Msg: TMessage); + function GetCurrentItem: TStyleCollectionItem; + function GetUnsupportedPlatform: Boolean; + procedure RebuildDictionary; + procedure ResourceChanged(Sender: TObject); + function StyleIndexByContext(const Context: TFmxObject): Integer; + procedure CollectionChanged; + procedure ReadStrings(Reader: TReader); + protected + /// Used when looking style in global pool + function CustomFindStyleResource(const AStyleLookup: string; const Clone: Boolean): TFmxObject; virtual; + /// Choose style depends on context + procedure ChooseStyleIndex; virtual; + /// Create empty item on demand + procedure CreateDefaultItem; virtual; + procedure Loaded; override; + procedure DefineProperties(Filer: TFiler); override; + procedure ReadResources(Stream: TStream); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + /// Integration property used with Style Designer + property DesignInfo: TStyleBookDesignInfo read FDesignInfo write FDesignInfo; + /// Clear style collection + procedure Clear; + /// Get Style by Context + function GetStyle(const Context: TFmxObject): TFmxObject; overload; + /// Load style from stream + procedure LoadFromStream(const Stream: TStream); + /// Load style from file + procedure LoadFromFile(const AFileName: string); + /// Current Style + property Style: TFmxObject read GetStyle; + /// Item index of current style in style's collection + property CurrentItemIndex: Integer read FCurrentItemIndex write SetCurrentItemIndex; + /// Current style in style's collection + property CurrentItem: TStyleCollectionItem read GetCurrentItem; + property Resource: TStrings read FResource; + /// If style can not be load on current platform tihs property is True and Style is empty + property UnsupportedPlatform: Boolean read GetUnsupportedPlatform; + published + /// Used to load style from file instead of storing style in form resource + property FileName: string read FFileName write SetFileName; + /// If UseStyleManager is True component use TStyleManager to replace default style for whole application + property UseStyleManager: Boolean read FUseStyleManager write SetUseStyleManager default False; + /// Collection of styles stored in StyleBook + property Styles: TStyleCollection read FStyles write SetStyles; + end; + + TTextSettingsInfo = class (TPersistent) + public type + TBaseTextSettings = class (TTextSettings) + private + [Weak] FInfo: TTextSettingsInfo; + [Weak] FControl: TControl; + public + constructor Create(const AOwner: TPersistent); override; + property Info: TTextSettingsInfo read FInfo; + property Control: TControl read FControl; + end; + TCustomTextSettings = class (TBaseTextSettings) + public + constructor Create(const AOwner: TPersistent); override; + property WordWrap default True; + property Trimming default TTextTrimming.None; + end; + TCustomTextSettingsClass = class of TCustomTextSettings; + TTextPropLoader = class + private + FInstance: TPersistent; + FFiler: TFiler; + FITextSettings: ITextSettings; + FTextSettings: TTextSettings; + protected + procedure ReadSet(const Instance: TPersistent; const Reader: TReader; const PropertyName: string); + procedure ReadEnumeration(const Instance: TPersistent; const Reader: TReader; const PropertyName: string); + procedure ReadFontFillColor(Reader: TReader); + procedure ReadFontFamily(Reader: TReader); + procedure ReadFontFillKind(Reader: TReader); + procedure ReadFontStyle(Reader: TReader); + procedure ReadFontSize(Reader: TReader); + procedure ReadTextAlign(Reader: TReader); + procedure ReadTrimming(Reader: TReader); + procedure ReadVertTextAlign(Reader: TReader); + procedure ReadWordWrap(Reader: TReader); + public + constructor Create(const AInstance: TComponent; const AFiler: TFiler); + procedure ReadProperties; virtual; + property Instance: TPersistent read FInstance; + property Filer: TFiler read FFiler; + property TextSettings: TTextSettings read FTextSettings; + end; + private + FDefaultTextSettings: TTextSettings; + FTextSettings: TTextSettings; + FResultingTextSettings: TTextSettings; + FOldTextSettings: TTextSettings; + [Weak] FOwner: TPersistent; + FDesign: Boolean; + FStyledSettings: TStyledSettings; + procedure SetDefaultTextSettings(const Value: TTextSettings); + procedure SetStyledSettings(const Value: TStyledSettings); + procedure SetTextSettings(const Value: TTextSettings); + procedure OnDefaultChanged(Sender: TObject); + procedure OnTextChanged(Sender: TObject); + procedure OnCalculatedTextSettings(Sender: TObject); + protected + procedure RecalculateTextSettings; virtual; + procedure DoDefaultChanged; virtual; + procedure DoTextChanged; virtual; + procedure DoCalculatedTextSettings; virtual; + procedure DoStyledSettingsChanged; virtual; + public + constructor Create(AOwner: TPersistent; ATextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass); virtual; + destructor Destroy; override; + property Design: Boolean read FDesign write FDesign; + property StyledSettings: TStyledSettings read FStyledSettings write SetStyledSettings; + property DefaultTextSettings: TTextSettings read FDefaultTextSettings write SetDefaultTextSettings; + property TextSettings: TTextSettings read FTextSettings write SetTextSettings; + property ResultingTextSettings: TTextSettings read FResultingTextSettings; + property Owner: TPersistent read FOwner; + end; + +{ TTextControl } + + TTextControl = class(TStyledControl, ITextSettings, ICaption, IAcceleratorKeyReceiver) + public const + DefaultPrefixStyle = TPrefixStyle.HidePrefix; + private + FTextSettingsInfo: TTextSettingsInfo; + FTextObject: TControl; + FITextSettings: ITextSettings; + FObjectState: IObjectState; + FText: string; + FIsChanging: Boolean; + FPrefixStyle: TPrefixStyle; + FAcceleratorKey: Char; + FAcceleratorKeyIndex: Integer; + function GetFont: TFont; + function GetText: string; + function TextStored: Boolean; + procedure SetFont(const Value: TFont); + function GetTextAlign: TTextAlign; + procedure SetTextAlign(const Value: TTextAlign); + function GetVertTextAlign: TTextAlign; + procedure SetVertTextAlign(const Value: TTextAlign); + function GetWordWrap: Boolean; + procedure SetWordWrap(const Value: Boolean); + function GetFontColor: TAlphaColor; + procedure SetFontColor(const Value: TAlphaColor); + function GetTrimming: TTextTrimming; + procedure SetTrimming(const Value: TTextTrimming); + procedure SetPrefixStyle(const Value: TPrefixStyle); + { ITextSettings } + function GetDefaultTextSettings: TTextSettings; + function GetTextSettings: TTextSettings; + function GetStyledSettings: TStyledSettings; + function GetResultingTextSettings: TTextSettings; + protected + /// A TTextControl can respond to an accelerator key, so TControl.DoRootChanging is overriden to register/unregister + /// this control to/from a form when the control is added to a form, or when this control is moved from a form to another + /// one. + procedure DoRootChanging(const NewRoot: IRoot); override; + /// This function is invoked to filter the text that is going to be displayed. This function doesn't modify the string + /// stored by the control used as Text property. + function DoFilterControlText(const AText: string): string; virtual; + procedure DefineProperties(Filer: TFiler); override; + procedure ApplyStyle; override; + procedure FreeStyle; override; + procedure DoStyleChanged; override; + procedure SetText(const Value: string); virtual; + procedure SetTextInternal(const Value: string); virtual; + procedure SetName(const Value: TComponentName); override; + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + procedure Loaded; override; + function FindTextObject: TFmxObject; virtual; + procedure UpdateTextObject(const TextControl: TControl; const Str: string); + property TextObject: TControl read FTextObject; + procedure DoTextChanged; virtual; + procedure DoEndUpdate; override; + function CalcTextObjectSize(const MaxWidth: Single; var Size: TSizeF): Boolean; + { ITextSettings } + procedure SetTextSettings(const Value: TTextSettings); virtual; + procedure SetStyledSettings(const Value: TStyledSettings); virtual; + procedure DoChanged; virtual; + function StyledSettingsStored: Boolean; virtual; + function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; virtual; + { IAcceleratorKeyReceiver } + /// Implements IAcceleratorKeyReceiver.TriggerAcceleratorKey by setting focus to this control. + procedure TriggerAcceleratorKey; virtual; + /// Implements IAcceleratorKeyReceiver.CanTriggerAcceleratorKey by returning True if this control and all + /// of its parent controls are visible. + function CanTriggerAcceleratorKey: Boolean; virtual; + /// Implements IAcceleratorKeyReceiver.GetAcceleratorChar by returning the value stored in FAcceleratorKey. + function GetAcceleratorChar: Char; + /// Implements IAcceleratorKeyReceiver.GetAcceleratorCharIndex by returning the value stored in + /// FAcceleratorKeyIndex. This indicates the position within the text string of the accelerator character. + function GetAcceleratorCharIndex: Integer; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AfterConstruction; override; + function ToString: string; override; + + property Text: string read GetText write SetText stored TextStored; + + property DefaultTextSettings: TTextSettings read GetDefaultTextSettings; + property TextSettings: TTextSettings read GetTextSettings write SetTextSettings; + property StyledSettings: TStyledSettings read GetStyledSettings write SetStyledSettings stored StyledSettingsStored nodefault; + property ResultingTextSettings: TTextSettings read GetResultingTextSettings; + + procedure Change; + property Font: TFont read GetFont write SetFont; + property FontColor: TAlphaColor read GetFontColor write SetFontColor default TAlphaColorRec.Black; + property VertTextAlign: TTextAlign read GetVertTextAlign write SetVertTextAlign default TTextAlign.Center; + property TextAlign: TTextAlign read GetTextAlign write SetTextAlign default TTextAlign.Leading; + property WordWrap: Boolean read GetWordWrap write SetWordWrap default False; + property Trimming: TTextTrimming read GetTrimming write SetTrimming default TTextTrimming.None; + /// Determine the way portraying a single character "&" + property PrefixStyle: TPrefixStyle read FPrefixStyle write SetPrefixStyle default DefaultPrefixStyle; + end; + +{ TContent } + + TContent = class(TControl, IContent) + private + FParentAligning: Boolean; + protected + function GetTabStopController: ITabStopController; override; + procedure DoRealign; override; + procedure IContent.Changed = ContentChanged; + procedure ContentChanged; virtual; + public + constructor Create(AOwner: TComponent); override; + function GetTabListClass: TTabListClass; override; + published + property Align; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Visible; + property Width; + property Size; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TPopup } + + TPlacement = (Bottom, Top, Left, Right, Center, BottomCenter, TopCenter, LeftCenter, RightCenter, Absolute, Mouse, MouseCenter); + + TPopup = class(TStyledControl) + public const + DefaultUseParentScale = True; + private + [Weak] FSaveParent: TFmxObject; + FSaveScale: TPointF; + FPopupForm: TFmxObject; + FIsOpen: Boolean; + FStaysOpen: Boolean; + FPlacement: TPlacement; + [Weak] FPlacementTarget: TControl; + FPlacementRectangle: TBounds; + FHorizontalOffset: Single; + FVerticalOffset: Single; + FDragWithParent: Boolean; + FHideWhenPlacementTargetInvisible: Boolean; + FClosingAnimation: Boolean; + FStyleBook: TStyleBook; + FModalResult: TModalResult; + FModal: Boolean; + FBorderWidth: Single; + FAniDuration: Single; + FPopupFormSize: TSizeF; + FPreferedDisplayIndex: Integer; + FUseParentScale: Boolean; + FOnClosePopup: TNotifyEvent; + FOnPopup: TNotifyEvent; + FOnAniTimer: TNotifyEvent; + procedure SetIsOpen(const Value: Boolean); + procedure SetPlacementRectangle(const Value: TBounds); + procedure SetModalResult(const Value: TModalResult); + procedure SetPlacementTarget(const Value: TControl); + procedure SetStyleBook(const Value: TStyleBook); + procedure SetPlacement(const Value: TPlacement); + procedure SetDragWithParent(const Value: Boolean); + procedure SetHideWhenPlacementTargetInvisible(const Value: Boolean); + procedure SetBorderWidth(const Value: Single); + procedure BeforeShowProc(Sender: TObject); + procedure BeforeCloseProc(Sender: TObject); + procedure CloseProc(Sender: TObject; var Action: TCloseAction); + procedure SetAniDuration(const Value: Single); + procedure ReadLeft(Reader: TReader); + procedure ReadTop(Reader: TReader); + procedure SetPopupFormSize(const Value: TSizeF); + procedure UpdatePopupSize; + procedure SetOnAniTimer(const Value: TNotifyEvent); + procedure SetUseParentScale(const Value: Boolean); + protected + procedure ApplyStyle; override; + procedure Paint; override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure DefineProperties(Filer: TFiler); override; + procedure DialogKey(var Key: Word; Shift: TShiftState); override; + procedure DoClosePopup; virtual; + procedure DoPopup; virtual; + procedure RecalculateAbsoluteMatrices; override; + procedure ClosePopup; virtual; + function CreatePopupForm: TFmxObject; virtual; + property PopupForm: TFmxObject read FPopupForm; + function VisibleStored: Boolean; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Popup(const AShowModal: Boolean = False); virtual; + function PopupModal: TModalResult; virtual; + function HasPopupForm: Boolean; + procedure BringToFront; override; + property AniDuration: Single read FAniDuration write SetAniDuration; + property BorderWidth : Single read FBorderWidth write SetBorderWidth; + property ModalResult: TModalResult read FModalResult write SetModalResult; + property IsOpen: Boolean read FIsOpen write SetIsOpen; + property ClosingAnimation: Boolean read FClosingAnimation; + property PopupFormSize: TSizeF read FPopupFormSize write SetPopupFormSize; + property PreferedDisplayIndex: Integer read FPreferedDisplayIndex write FPreferedDisplayIndex; + /// This event is called periodically (for the AniDuration time) after emergence and before the + /// disappearance of the pop-up + property OnAniTimer: TNotifyEvent read FOnAniTimer write SetOnAniTimer; + published + property Align; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property DragWithParent: Boolean read FDragWithParent write SetDragWithParent default False; + /// True - if popup form have to be closed, if PlacementTarget is not visible on the screen. + /// It works only, when PlacementTarget is specified. + property HideWhenPlacementTargetInvisible: Boolean read FHideWhenPlacementTargetInvisible write SetHideWhenPlacementTargetInvisible default True; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property HitTest default True; + property HorizontalOffset: Single read FHorizontalOffset write FHorizontalOffset; + /// + /// Whether to take into account the scaling factor of the parent when displaying the pop-up or not? + /// + property UseParentScale: Boolean read FUseParentScale write SetUseParentScale default DefaultUseParentScale; + property Padding; + property Opacity; + property Margins; + property Placement: TPlacement read FPlacement write SetPlacement default TPlacement.Bottom; + property PlacementRectangle: TBounds read FPlacementRectangle write SetPlacementRectangle; + property PlacementTarget: TControl read FPlacementTarget write SetPlacementTarget; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleBook: TStyleBook read FStyleBook write SetStyleBook; + property StyleLookup; + property TabOrder; + property VerticalOffset: Single read FVerticalOffset write FVerticalOffset; + property Visible stored VisibleStored; + property Width; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + property OnClosePopup: TNotifyEvent read FOnClosePopup write FOnClosePopup; + property OnPopup: TNotifyEvent read FOnPopup write FOnPopup; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TPathAnimation } + + TPathAnimation = class(TAnimation) + private + FPath: TPathData; + FPolygon: TPolygon; + FObj: TControl; + FStart: TPointF; + FRotate: Boolean; + FSpline: TSpline; + procedure SetPath(const Value: TPathData); + function EnabledStored: Boolean; + protected + procedure ProcessAnimation; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Start; override; + published + property AnimationType default TAnimationType.In; + property AutoReverse default False; + property Enabled stored EnabledStored; + property Delay; + property Duration nodefault; + property Interpolation default TInterpolationType.Linear; + property Inverse default False; + property Loop default False; + property OnProcess; + property OnFinish; + property Path: TPathData read FPath write SetPath; + property Rotate: Boolean read FRotate write FRotate default False; + property Trigger; + property TriggerInverse; + end; + + IInflatableContent = interface + function GetInflatableItems: TList; + procedure NotifyInflated; + end; + + TContentInflater = class(TInterfacedObject, IInterface) + strict private + FInflatable: IInflatableContent; + FBusy: Boolean; + procedure ReceiveIdleMessage(const Sender : TObject; const M : System.Messaging.TMessage); + public + constructor Create(const Inflatable: IInflatableContent); + destructor Destroy; override; + procedure Inflate(Total: Boolean); + end; + + TControlsFilter = class(TEnumerableFilter) + end; + + ISearchResponder = interface + ['{C73631F4-5AD7-48b9-92D2-CC808B911B5E}'] + procedure SetFilterPredicate(const Predicate: TPredicate); + end; + + IListBoxHeaderTrait = interface + ['{C7BDF195-C1E2-48f9-9376-1382C60A6BCC}'] + end; + +procedure CloseAllPopups; +function IsPopup(const Wnd: TFmxObject): Boolean; +function CanClosePopup(const Wnd: TFmxObject): Boolean; +procedure PopupBringToFront; +procedure ClosePopup(const AIndex: Integer); overload; +procedure ClosePopup(Wnd: TFmxObject); overload; + +function GetPopup(const AIndex: Integer): TFmxObject; +function GetPopupCount: Integer; + +procedure FreeControls; + +type + TPropertyApplyProc = reference to procedure(Instance: TObject; Prop: TRttiProperty); + +function FindProperty(var O: TObject; Path: string; const Apply: TPropertyApplyProc): Boolean; + +//== UNIT END: FMX.Controls +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Memo.Types (from FMX.Memo.Types.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + TInsertOption = FMX.Text.TInsertOption deprecated 'use FMX.Text.TInsertOption instead'; + TInsertOptions = FMX.Text.TInsertOptions deprecated 'use FMX.Text.TInsertOptions instead'; + + TDeleteOption = FMX.Text.TDeleteOption deprecated 'use FMX.Text.TDeleteOption instead'; + TDeleteOptions = FMX.Text.TDeleteOptions deprecated 'use FMX.Text.TDeleteOptions instead'; + + TActionType = FMX.Text.UndoManager.TActionType deprecated 'use FMX.Text.UndoManager.TActionType instead'; + TFragmentInserted = FMX.Text.UndoManager.TFragmentInserted deprecated 'use FMX.Text.UndoManager.TFragmentInserted instead'; + TFragmentDeleted = FMX.Text.UndoManager.TFragmentDeleted deprecated 'use FMX.Text.UndoManager.TFragmentDeleted instead'; + + TSelectionPointType = (Left, Right); + + // Type alias for backward compatibility + TCaretPosition = FMX.Text.TCaretPosition; + +//== UNIT END: FMX.Memo.Types +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.ImgList (from FMX.ImgList.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + TMultiResBitmap = class; + TCustomSourceItem = class; + TSourceCollection = class; + TLayer = class; + TLayers = class; + TCustomDestinationItem = class; + TDestinationCollection = class; + TCustomImageList = class; + TImageListClass = class of TCustomImageList; + TSourceItemClass = class of TCustomSourceItem; + TDestinationItemClass = class of TCustomDestinationItem; + TLayerClass = class of TLayer; + + /// A bitmap item in a TMultiResBitmap multi-resolution + /// bitmap. + TBitmapItem = class(TCustomBitmapItem) + private + function GetImageList: TCustomImageList; + public + /// A reference to the list of images to whom belongs to an instance of this class + property ImageList: TCustomImageList read GetImageList; + /// EArgumentException is raised in case Collection is not TMultiResBitmap + constructor Create(Collection: TCollection); override; + published + property Bitmap; + property Scale; + end; + + /// A multi-resolution bitmap is a collection of bitmap which is used in TCustomSourceItem and + /// TImageList + TMultiResBitmap = class(TCustomMultiResBitmap) + private + [Weak] FSourceItem: TCustomSourceItem; + function GetImageList: TCustomImageList; + protected + function GetDefaultSize: TSize; override; + procedure Update(Item: TCollectionItem); override; + procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override; + public + /// EArgumentException is raised in case AOwner is not TCustomSourceItem + constructor Create(AOwner: TPersistent; ItemClass: TCustomBitmapItemClass); + function GetDefaultSizeKind: TSizeKind; override; + /// A reference to the item of collection to whom belongs to an instance of this class + property SourceItem: TCustomSourceItem read FSourceItem; + property ImageList: TCustomImageList read GetImageList; + end; + + /// The item collection (without published properties) contains the original graphical data, which can be + /// used to obtain images in the image list TCustomImageList. See TSourceCollection + /// Note that the data stored in fmx, dfm file, even if they are not used + TCustomSourceItem = class(TCollectionItem) + public const + DefaultName = 'Item 0'; // do not localize + TemporaryName = 'Tmp_' + DefaultName; // do not localize + DefaultDesktopSize = 16; + private + [Weak] FSource: TSourceCollection; + FMultiResBitmap: TMultiResBitmap; + FOldName: string; + FName: string; + procedure SetMultiResBitmap(const Value: TMultiResBitmap); + procedure SetName(const Value: string); + function UniqueName(const AName: string; const Collection: TCollection): string; + procedure CheckName(const Name: string; SourceCollection: TSourceCollection); + protected + /// This virtual method must create a instance of TMultiResBitmap. Override this method if you want to + /// create MultiResBitmap property of your own type + function CreateMultiResBitmap: TMultiResBitmap; virtual; + procedure SetCollection(Value: TCollection); override; + function GetDisplayName: string; override; + public + /// EArgumentException is raised in case Collection is not TSourceCollection + constructor Create(Collection: TCollection); override; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + /// Collection of identical images are optimized for different scales + property MultiResBitmap: TMultiResBitmap read FMultiResBitmap write SetMultiResBitmap; + /// The case-insensitive name of the item in the collection. This field cannot be empty and must be + /// unique for his collection. See also TLayer.Name + property Name: string read FName write SetName; + /// A reference to the Collection to whom belongs to an instance of this class + property Source: TSourceCollection read FSource; + end; + + /// Represents an item in a TSourceCollection collection. + TSourceItem = class (TCustomSourceItem) + published + property MultiResBitmap; + property Name; + end; + + /// The collection that contains original graphical data. See TCustomSourceItem + TSourceCollection = class(TOwnedCollection) + private + [Weak] FImageList: TCustomImageList; + function GetItem(Index: Integer): TCustomSourceItem; + procedure SetItem(Index: Integer; const Value: TCustomSourceItem); + protected + procedure Update(Item: TCollectionItem); override; + public + /// EArgumentException is raised in case AOwner is not TCustomImageList + constructor Create(AOwner: TPersistent; ItemClass: TSourceItemClass); + property ImageList: TCustomImageList read FImageList; + property Items[Index: Integer]: TCustomSourceItem read GetItem write SetItem; default; + function Add: TCustomSourceItem; + /// Adds or replaces several files into the collection + /// The name of the collection element. If specified name is not found, a new element will + /// be created. Otherwise, the found element will be changed. If empty, a new element with default + /// name will be created + /// See also TCustomMultiResBitmap.AddOrSet + /// The array that contains the scales of added pictures + /// The array that contains the file names of added pictures. Scales and + /// FileNames must have equal lengths + /// The color that will be substituted with fully transparent color. If set to + /// TColors.SysNone, no subsitution will be performed. + /// The width (in pixels) of the added image (at a scale of 1) + /// The height (in pixels) of the added image (at a scale of 1). If Width and Height + /// parameters are zero (the default), the width and the height of the image specified by FileNames[0] will be used + /// New or updated element of the collection + function AddOrSet(const SourceName: string; const Scales: array of Single; const FileNames: array of string; + const TransparentColor: TColor = TColors.SysNone; const Width: Integer = 0; + const Height: Integer = 0): TCustomSourceItem; + /// This method creates a new item in the collection and inserts before the element with the specified + /// number + function Insert(Index: Integer): TCustomSourceItem; + /// Case-insensitive search of item by name + /// if successful then the number of the found item, -1 otherwise + function IndexOf(const Name: string): Integer; + end; + + /// The item of collection TLayers, used in TImageList for obtaining graphical data from + /// TSourceCollection. See TCustomImageList.Source, TCustomImageList.Destination + TLayer = class (TCollectionItem) + private + [Weak] FLayers: TLayers; + [Weak] FMultiResBitmap: TMultiResBitmap; + FMultiResBitmapIsValid: Boolean; + FName: string; + FSourceRect: TBounds; + procedure SetName(const Value: string); + function GetImageList: TCustomImageList; + procedure SetSourceRect(const Value: TBounds); + function GetMultiResBitmap: TMultiResBitmap; + protected + procedure SetCollection(Value: TCollection); override; + function GetDisplayName: string; override; + public + constructor Create(Collection: TCollection); override; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + /// A reference to the collection to whom belongs to an instance of this class + property Layers: TLayers read FLayers; + property ImageList: TCustomImageList read GetImageList; + /// Reference to property MultiResBitmap of found item TCustomImageList.Source. The search + /// is done by property Name. Can be nil. + property MultiResBitmap: TMultiResBitmap read GetMultiResBitmap stored False; + published + /// The case-insensitive name of the item in collection Source + property Name: string read FName write SetName; + /// The coordinates of the rectangular region in the original image MultiResBitmap that will be used to + /// obtain the final image. Always specify the coordinates for the scale 1. For other scales, these coordinates will + /// be automatically recalculated. + property SourceRect: TBounds read FSourceRect write SetSourceRect; + end; + + /// The collection TLayer items, used in TImageList for obtaining graphical data from + /// TSourceCollection. See TCustomImageList.Source, TCustomImageList.Destination + TLayers = class (TOwnedCollection) + private + FDestinationItem: TCustomDestinationItem; + function GetImageList: TCustomImageList; + function GetItem(Index: Integer): TLayer; + procedure SetItem(Index: Integer; const Value: TLayer); + protected + procedure Update(Item: TCollectionItem); override; + procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override; + public + constructor Create(AOwner: TPersistent; ItemClass: TLayerClass); + /// A reference to the item to whom belongs to this collection + property DestinationItem: TCustomDestinationItem read FDestinationItem; + /// A reference to the list of images to whom belongs to this collection + property ImageList: TCustomImageList read GetImageList; + function Add: TLayer; + function Insert(Index: Integer): TLayer; + property Items[Index: Integer]: TLayer read GetItem write SetItem; default; + end; + + /// The item of collection (without published properties) which contains the data to form the final images + /// in TImageList. To obtain image, sequentially drawn regions of Source which specified in the + /// collection Layers. Also performs selection the image with the most appropriate scale for the current scene + /// and the size of the final image + TCustomDestinationItem = class (TCollectionItem) + public const + StrDestinationDisplay = '%d (%s)'; + private + FLayers: TLayers; + [Weak] FDestination: TDestinationCollection; + FIsChanged: Boolean; + procedure SetLayers(const Value: TLayers); + protected + /// This virtual method must create a collection of layers. Override this method if you want to create a + /// collection of your own type + function CreateLayers: TLayers; virtual; + procedure SetCollection(Value: TCollection); override; + function GetDisplayName: string; override; + public + constructor Create(Collection: TCollection); override; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + /// The number of not empty items in the Layers collection + function LayersCount: Integer; + /// This property evaluates to True if there have been some changes, but the notification about redrawing + /// has not yet been sent + property IsChanged: Boolean read FIsChanged; + /// The collection that contains references to Source for drawing image. Can be one or more layers + /// which will drawn sequentially + property Layers: TLayers read FLayers write SetLayers; + /// A reference to the Collection to whom belongs to this item + property Destination: TDestinationCollection read FDestination; + end; + + /// The item of collection (with published properties) which contains the data to form the final images + /// in TImageList + TDestinationItem = class (TCustomDestinationItem) + published + property Layers; + end; + + /// The collection which contains the data to form the final images in TImageList + TDestinationCollection = class (TOwnedCollection) + private + [Weak] FImageList: TCustomImageList; + function GetItem(Index: Integer): TCustomDestinationItem; + procedure SetItem(Index: Integer; const Value: TCustomDestinationItem); + protected + procedure Update(Item: TCollectionItem); override; + public + constructor Create(AOwner: TPersistent; ItemClass: TDestinationItemClass); + property ImageList: TCustomImageList read FImageList; + function Add: TCustomDestinationItem; + function Insert(Index: Integer): TCustomDestinationItem; + property Items[Index: Integer]: TCustomDestinationItem read GetItem write SetItem; default; + end; + + /// List of images. Base class that used in fire monkey without published properties + TCustomImageList = class(TBaseImageList) + private type + TItemRec = record + Item: TCustomBitmapItem; + SourceRect, ItemRect: TRectF; + end; + strict private + FTmpBitmap1: TBitmap; + FTmpBitmap2: TBitmap; + private + FSource: TSourceCollection; + FDestination: TDestinationCollection; + FChangedList: TDictionary; + FCache: TObject; + FTimerHandle: TFmxHandle; + FPlatformTimer: IFMXTimerService; + FOnChange: TNotifyEvent; + FOnChanged: TNotifyEvent; + procedure SetSource(const Value: TSourceCollection); + procedure SetDestination(const Value: TDestinationCollection); + procedure SetCacheSize(const Value: Word); + function GetCacheSize: Word; + procedure StartTimer; + procedure StopTimer; + procedure TimerProc; + function GetDormant: Boolean; + procedure SetDormant(const Value: Boolean); + function GetItemList(const Size: TSize; const Index: Integer): TList; + function InvalidateDestination(const Name: string): Boolean; + function IsIgnoreIndex: Boolean; + protected + /// Creates a Source collection. Override this method if you want to create your own collection + /// + function CreateSource: TSourceCollection; virtual; + /// Creates a Destination collection. Override this method if you want to create your own + /// collection + function CreateDestination: TDestinationCollection; virtual; + procedure DoChange; override; + /// This method called after changes and before notification of all instances of TImageLink. This method + /// is executing event handler of OnChanged + procedure DoChanged; virtual; + procedure Loaded; override; + /// This method is createing instance of TBitmap and drawing all Layers + /// The size of created Bitmap + /// The zero-based number of item in the collection Destination that used for painting + /// image + /// New instance of TBitmap. If the collection isn't contains the item with specified number or the + /// item does not contain data then it returns zero + function DoBitmap(Size: TSize; const Index: Integer): TBitmap; virtual; + /// This method is trying find a bitmap in cache. If successful then returns a bitmap otherwise nil + function FindInCache(const Size: TSize; const Index: Integer): TBitmap; + /// Adding bitmap into end of cache. If the count of images more than CacheSize, then the first + /// (the oldest) image will removed + procedure AddToCache(const Size: TSize; const Index: Integer; const Bitmap: TBitmap); + function GetCount: Integer; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure BeforeDestruction; override; + procedure Assign(Source: TPersistent); override; + /// Adds or replaces several files in the Source collection, and adds the item to the + /// Destination collection if it does not exist + /// The number of the new element of Destination or -1 if it already exists + /// See also TSourceCollection.AddOrSet + function AddOrSet(const SourceName: string; const Scales: array of Single; + const FileNames: array of string; const TransparentColor: TColor = TColors.SysNone; const Width: Integer = 0; + const Height: Integer = 0): TImageIndex; + /// Tries to find, in the Source collection, the bitmap item specified by Name + /// The name of the item. See TCustomSourceItem.Name + /// If succed, contains the found bitmap item for scale 1, otherwise is not changed + /// If succed, contains the size of the found item, otherwise is not changed + /// True if the item is found + function BitmapItemByName(const Name: string; var Item: TCustomBitmapItem; var Size: TSize): Boolean; + /// Returns the TBitmap object containing the image pointed by Index. Returns nil if the + /// Index image does not exist. + /// See also BitmapExists, ClearCache, TBitmap.Assign + /// The returned bitmap is stored by TCustomImageList in the cache. + /// Therefore, you must not store references to such bitmaps and must not destroy such bitmaps exolicitly. + /// + function Bitmap(Size: TSizeF; const Index: Integer): TBitmap; + /// Returns True if the Index element in the Source collection contains some + /// graphical data that can be used to create an image + function BitmapExists(const Index: Integer): Boolean; + /// This method trying to determine the maximum size of layer, which less than input size. If + /// TLayer.MultiResBitmap has multiple images for different scales, then the search is performed among all + /// images + /// The index of item in Destination collection. For this image it determines suitable + /// size + /// Before executing it contains the original size, after you do this the most suitable size or + /// source value + /// True in case of success, otherwise False. If False then Size does not + /// change + /// This method is called from TGlyph if the property Stretch is False + function BestSize(const Index: Integer; var Size: TSize): Boolean; overload; + function BestSize(const Index: Integer; var Size: TSizeF): Boolean; overload; + /// Draws a single picture on the specified canvas + /// The canvas on which will be painted picture + /// The rectangle in which will be inscribed picture + /// Zero based ordinal number of image + /// The transparency of the drawing pictures. By default 1 (completely not transparency) + /// + /// True if the picture was drawn + function Draw(const Canvas: TCanvas; const Rect: TRectF; const Index: Integer; const Opacity: Single = 1): Boolean; + /// Helper method for drawing some bitmap. This method used in DoBitmap + procedure DrawBitmapToCanvas(const Canvas: TCanvas; const Bitmap: TBitmap; SrcRect, DstRect: TRect; + const Fast: Boolean = False); + /// Removing bitmaps from the internal cache + /// With the default -1 value, it removes all bitmaps. Otherwise removes from cache + /// bitmaps with all sizes but only for the specified Index + procedure ClearCache(const Index: Integer = -1); + /// Performs immediate notification about the change of images if there are changes. See also + /// OnChanged, DoChanged, TImageLink, ImagesChanged + /// By default, notifications are sent shortly after the changes. If there are several changes, the count + /// of notifications isn't increased in order to reduce the number of redrawing of the controls + procedure UpdateImmediately; + /// The maximum number of images that can be stored in the cache. If the new image does not fit in the + /// cache then automatically is deleted the oldest image. If a image has changed, it is automatically removed from + /// the cache. See ClearCache + property CacheSize: Word read GetCacheSize write SetCacheSize; + /// Set property Dormant to all items of Source. See TCustomBitmapItem.Dormant + property Dormant: Boolean read GetDormant write SetDormant; + /// The collection which contains source graphical data. This data used in items of Destination for + /// produce images. See BitmapItemByName + property Source: TSourceCollection read FSource write SetSource; + /// The items of this collection contains links to sources. When you specify a certain index of images, + /// it is formed on the basis of data from this collection. See Bitmap, BitmapExists, Draw + property Destination: TDestinationCollection read FDestination write SetDestination; + /// If the component isn't in the update state, then event handler is executed immediately after any + /// change, else after the EndUpdate method. See also DoChange, Change + property OnChange: TNotifyEvent read FOnChange write FOnChange; + /// This event handler is invoked shortly after one or more changes were done and before sending the + /// notification to all of the controls that use the modified image from this image list + /// See also DoChanged, TImageLink + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; + end; + + /// FireMonkey image lists are collections of multi-resolution + /// bitmaps. + TImageList = class(TCustomImageList) + published + property Source; + property Destination; + property OnChange; + property OnChanged; + end; + + /// A TGlyphImageLink object is used to install connection between an + /// Images image list assigned to the TGlyph control and a component owning + /// this TGlyph control. + TGlyphImageLink = class(TImageLink) + private + [Weak] FOwner: TComponent; + FGlyph: IGlyph; + public + ///Default constructor. If AOwner unsupported IGlyph then raised EArgumentException. If AOwner = nil then + /// raised EArgumentNilException + ///The reference to the control with which it interacts. Can't be nil. Must supported + /// interface IGlyph + constructor Create(AOwner: TComponent); reintroduce; + procedure Change; override; + /// Control that was defined at calling constructor Create + property Owner: TComponent read FOwner; + /// Interface of Owner that was defined at calling constructor Create + property Glyph: IGlyph read FGlyph; + end; + + /// Each TGlyph control has the Images reference to a + /// TCustomImageList image list and displays the image identified by the + /// ImageIndex property. The image is scaled to fully fit into the control + /// area. TGlyph element is included in most styled controls. + TGlyph = class(TControl, IGlyph) + public const + DesignBorderColor = $A080D080; + private + FImageLink: TImageLink; + FIsChanging: Boolean; + FIsChanged: Boolean; + FAutoHide: Boolean; + FOnChanged: TNotifyEvent; + FBitmapExists: Boolean; + FStretch: Boolean; + FDisableInterpolation: Boolean; + function GetImages: TCustomImageList; + procedure SetImages(const Value: TCustomImageList); + { IGlyph } + function GetImageIndex: TImageIndex; + procedure SetImageIndex(const Value: TImageIndex); + function GetImageList: TBaseImageList; inline; + procedure SetImageList(const Value: TBaseImageList); + function IGlyph.GetImages = GetImageList; + procedure IGlyph.SetImages = SetImageList; + procedure SetAutoHide(const Value: Boolean); + procedure SetStretch(const Value: Boolean); + procedure SetDisableInterpolation(const Value: Boolean); + protected + procedure Paint; override; + procedure Loaded; override; + procedure DoEndUpdate; override; + /// This vitrual method is calling event OnChanged and method Repaint. DoChanged + /// method is called in ImagesChanged. You shouldn't call this method manually + procedure DoChanged; virtual; + /// This method is updating properties BitmapExists, and Visible in case if AutoHide + /// is true + procedure UpdateVisible; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + /// Determines whether the ImageIndex property needs to be stored in the fmx-file + /// True if the ImageIndex property needs to be stored in the fmx-file + function ImageIndexStored: Boolean; virtual; + /// Determines whether the Images property needs to be stored in the fmx-file + /// True if the Images property needs to be stored in the fmx-file + function ImagesStored: Boolean; virtual; + procedure SetVisible(const Value: Boolean); override; + function VisibleStored: Boolean; override; + function GetDefaultSize: TSizeF; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AfterConstruction; override; + /// Should be called when you change an instance or reference to instance of TBaseImageList or the + /// ImageIndex property + /// See also FMX.ActnList.IGlyph + /// This method is executed after change list of images. If TGlyph not in state Loading, Destroying, + /// Updating then this method call DoChanged, otherwise only set property IsChanged to true + procedure ImagesChanged; + /// Is True if Images is not nil and ImageIndex points to an existing picture. + /// See also UpdateVisible, TCustomImageList.BitmapExists + property BitmapExists: Boolean read FBitmapExists; + /// If there have been some changes (which needed to paint) but not executed method DoChanged yet, then + /// this property is set to True, otherwise False + property IsChanged: Boolean read FIsChanged write FIsChanged; + published + property Action; + /// If True, then: at run time Visible property depends only on BitmapExists's value; + /// at designtime Visible is always True. Otherwise, Visible's value can be set + /// programmatically + property AutoHide: Boolean read FAutoHide write SetAutoHide default True; + property DisableInterpolation: Boolean read FDisableInterpolation write SetDisableInterpolation default False; + property Enabled; + property Padding; + property Margins; + property Align; + property Anchors; + property Position; + property Width; + property Height; + property Opacity; + property Visible; + property Size; + /// Specifies whether to stretch the image shown in the glyph control + property Stretch: Boolean read FStretch write SetStretch default True; + /// Zero based index of an image. The default is -1. + /// See also FMX.ActnList.IGlyph + /// If non-existing index is specified, an image is not drawn and no exception is raised + property ImageIndex: TImageIndex read GetImageIndex write SetImageIndex stored ImageIndexStored; + /// The list of images. Can be nil. See also FMX.ActnList.IGlyph + property Images: TCustomImageList read GetImages write SetImages stored ImagesStored; + /// This event handler is called after some changes in list of images and before painting + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; + property OnPaint; + property OnPainting; + end; + +//== UNIT END: FMX.ImgList +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Forms (from FMX.Forms.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +const + // This value indicates that the auto-update action will not be performed. + ActionUpdateDelayNever: Integer = -1; + DefaultFormStyleLookup = 'backgroundstyle'; + +type + TCommonCustomForm = class; + + { Application } + + TExceptionEvent = procedure(Sender: TObject; E: Exception) of object; + TIdleEvent = procedure(Sender: TObject; var Done: Boolean) of object; + + TDeviceKind = (Desktop, iPhone, iPad); + TDeviceKinds = set of TDeviceKind; + + TFormOrientations = TScreenOrientations; + TFormOrientation = TScreenOrientation; + + TFormFactor = class(TPersistent) + private + FSize: TSize; + FOrientations: TFormOrientations; + FDevices: TDeviceKinds; + procedure SetSupportedOrientations(AOrientations: TFormOrientations); virtual; + procedure SetHeight(const Value: Integer); + procedure SetWidth(const Value: Integer); + function GetWidth: Integer; + function GetHeight: Integer; + public + constructor Create; + procedure AdjustToScreenSize; + published + property Width: Integer read GetWidth write SetWidth stored True; + property Height: Integer read GetHeight write SetHeight stored True; + property Orientations: TFormOrientations read FOrientations write SetSupportedOrientations stored True + default [TFormOrientation.Portrait, TFormOrientation.Landscape]; + property Devices: TDeviceKinds read FDevices write FDevices stored True; + end; + + TApplicationFormFactor = class(TFormFactor) + protected + procedure SetSupportedOrientations(AOrientations: TFormOrientations); override; + end; + +{$IFDEF MSWINDOWS} + /// IDesignerHook is an interface that allows component writers to + /// interact with the form designer in the IDE. + IDesignerHook = interface(IDesignerNotify) + ['{65A688CA-60DD-4038-AAFF-8F56A8B6AB69}'] + function IsDesignMsg(Sender: TFmxObject; var Message: Winapi.Messages.TMessage): Boolean; + procedure UpdateBorder; + procedure PaintGrid; + procedure DrawSelectionMarks(AControl: TFMXObject); + function IsSelected(Instance: TPersistent): Boolean; + function IsView: Boolean; + function GetHasFixedSize: Boolean; + procedure DesignerModified(Activate: Boolean = False); + procedure ValidateRename(AComponent: TComponent; const CurName, NewName: string); + function UniqueName(const BaseName: string): string; + function GetRoot: TComponent; + procedure FormFamilyChanged(const OldFormFamilyName, NewFormFamilyName, FormClassName: string); + procedure SelectComponent(Instance: TPersistent); + /// Called after the form has been completely painted, so additional painting can be performed on top on it + procedure Decorate(Context: TObject); + + property HasFixedSize: Boolean read GetHasFixedSize; + end; + + /// Deprecated, only kept for backwards compatibility + IDesignerStorage = interface + ['{ACCC9241-07E2-421B-8F4C-B70D1E4050AE}'] + function GetDesignerMobile: Boolean; + function GetDesignerWidth: Integer; + function GetDesignerHeight: Integer; + function GetDesignerDeviceName: string; + function GetDesignerOrientation: TFormOrientation; + function GetDesignerOSVersion: string; + function GetDesignerMasterStyle: Integer; + procedure SetDesignerMasterStyle(Value: Integer); + + property Mobile: Boolean read GetDesignerMobile; + property Width: Integer read GetDesignerWidth; + property Height: Integer read GetDesignerHeight; + property DeviceName: string read GetDesignerDeviceName; + property Orientation: TFormOrientation read GetDesignerOrientation; + property OSVersion: string read GetDesignerOSVersion; + property MasterStyle: Integer read GetDesignerMasterStyle write SetDesignerMasterStyle; + end; +{$ELSE} + IDesignerHook = interface + end; + IDesignerStorage = interface + end; +{$ENDIF} + + { TApplication } + + TApplicationState = (None, Running, Terminating, Terminated); + /// Notification about terminating application + TApplicationTerminatingMessage = class(System.Messaging.TMessage); + + TApplicationStateEvent = function: TApplicationState; + + TFormsCreatedMessage = class(System.Messaging.TMessage); + /// Notification about showing form + TFormBeforeShownMessage = class(System.Messaging.TMessage); + /// Notification about activating specified form + TFormActivateMessage = class(System.Messaging.TMessage); + /// Notification about deactivating specified form + TFormDeactivateMessage = class(System.Messaging.TMessage); + TFormReleasedMessage = class(System.Messaging.TMessage); + + TApplication = class(TComponent) + private type + TFormRegistryItem = class + public + InstanceClass: TComponentClass; + Instance: TComponent; + Reference: Pointer; + end; + TFormRegistryItems = TList; + TFormRegistry = TObjectDictionary; + private + FOnException: TExceptionEvent; + FTerminate: Boolean; + FOnIdle: TIdleEvent; + FDefaultTitleReceived: Boolean; + FDefaultTitle: string; + FMainForm: TCommonCustomForm; + FCreateForms: array of TFormRegistryItem; + FBiDiMode: TBiDiMode; + FTimerActionHandle: TFmxHandle; + FActionUpdateDelay: Integer; + FActionClientsList: TList; + FOnActionUpdate: TActionEvent; + FIdleDone: Boolean; + FIsRealCreateFormsCalled: Boolean; + FFormFactor: TApplicationFormFactor; + FFormRegistry: TFormRegistry; + FMainFormFamily: string; + FLastKeyPress: TDateTime; + FLastUserActive: TDateTime; + FIdleMessage: TIdleMessage; + FOnActionExecute: TActionEvent; + FApplicationStateQuery: TApplicationStateEvent; + FAnalyticsManager: TAnalyticsManager; + FHint: string; + FShowHint: Boolean; + FOnHint: TNotifyEvent; + FSharedHint: THint; + FIsControlHint: Boolean; + FHintShortCuts: Boolean; + FTimerService: IFMXTimerService; + procedure Idle; + procedure DoUpdateActions; + procedure UpdateActionTimerProc; + function GetFormRegistryItem(const FormFamily: string; const FormFactor: TFormFactor): TFormRegistryItem; + function GetDefaultTitle: string; + function GetTitle: string; + procedure SetTitle(const Value: string); + procedure SetMainForm(const Value: TCommonCustomForm); + function GetAnalyticsManager: TAnalyticsManager; + procedure SetShowHint(const AValue: Boolean); + procedure SetHint(const AHint: string); + procedure SetHintShortCuts(const Value: Boolean); + function GetTimerService: IFMXTimerService; + property TimerService: IFMXTimerService read GetTimerService; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure FormDestroyed(const AForm: TCommonCustomForm); + procedure RealCreateForms; + procedure CreateForm(const InstanceClass: TComponentClass; var Reference); + procedure CreateMainForm; + procedure RegisterFormFamily(const AFormFamily: string; const AForms: array of TComponentClass); + procedure ProcessMessages; + property LastKeyPress: TDateTime read FLastKeyPress; + property LastUserActive: TDateTime read FLastUserActive; + procedure DoIdle(var Done: Boolean); + function HandleMessage: Boolean; + procedure Run; + function Terminate: Boolean; + procedure Initialize; + /// Perform method TComponent.ExecuteAction for current active control or active form or + /// Application + /// True if the method ExecuteTarget of Action was performed + /// This method is analogous to the CM_ACTIONEXECUTE handler's in VCL + function ActionExecuteTarget(Action: TBasicAction): Boolean; + function ExecuteAction(Action: TBasicAction): Boolean; reintroduce; + function UpdateAction(Action: TBasicAction): Boolean; override; + /// Provides a mechanism for checking if application analytics has been enabled without accessing the + /// AnalyticsManager property (which will create an instance of an application manager if one does not already + /// exist). Returns True if an instance of TAnalyticsManager is assigned to the application. Returns False + /// otherwise. + function TrackActivity: Boolean; + property ActionUpdateDelay: Integer read FActionUpdateDelay write FActionUpdateDelay; + procedure HandleException(Sender: TObject); + procedure ShowException(E: Exception); + /// Cancels the display of a hint for a control. + procedure CancelHint; + /// Hides the current hint. + procedure HideHint; + /// Determines whether Help Hints are enabled or disabled for the entire application. + property ShowHint: Boolean read FShowHint write SetShowHint; + /// Occurs when the mouse pointer moves over a control or menu item that can display a Help Hint. + property OnHint: TNotifyEvent read FOnHint write FOnHint; + property BiDiMode: TBiDiMode read FBiDiMode write FBiDiMode default bdLeftToRight; + property Terminated: Boolean read FTerminate write FTerminate; + property OnIdle: TIdleEvent read FOnIdle write FOnIdle; + property MainForm: TCommonCustomForm read FMainForm write SetMainForm; + property Title: string read GetTitle write SetTitle; + property DefaultTitle: string read GetDefaultTitle; + property OnActionExecute: TActionEvent read FOnActionExecute write FOnActionExecute; + property OnActionUpdate: TActionEvent read FOnActionUpdate write FOnActionUpdate; + property OnException: TExceptionEvent read FOnException write FOnException; + property ApplicationStateQuery: TApplicationStateEvent read FApplicationStateQuery write FApplicationStateQuery; + /// Returns true if RealCreateForms was invoked; otherwise, false. + property IsRealCreateFormsCalled: Boolean read FIsRealCreateFormsCalled; + + procedure RegisterActionClient(const ActionClient: TComponent); + procedure UnregisterActionClient(const ActionClient: TComponent); + function GetActionClients: TEnumerable; + function GetDeviceForm(const FormFamily: string; const FormFactor: TFormFactor): TCommonCustomForm; overload; + function GetDeviceForm(const FormFamily: string): TCommonCustomForm; overload; + procedure OverrideScreenSize(W, H: Integer); + property FormFactor: TApplicationFormFactor read FFormFactor; + /// Returns an instance of TAnalyticsManager. An instance will be created if one does not already exist. + /// There should only be one AnalyticsManager per application. + property AnalyticsManager: TAnalyticsManager read GetAnalyticsManager; + /// Specifies the text string that appears in the Help Hint box. + property Hint: string read FHint write SetHint; + /// Enables the display of keyboard shortcuts. + property HintShortCuts: Boolean read FHintShortCuts write SetHintShortCuts; + end; + + /// Links an action object to a client (generic form). + TFormActionLink = class(FMX.ActnList.TActionLink) + private + FForm: TCommonCustomForm; + function ActionCustomViewComponent: Boolean; + protected + property Form: TCommonCustomForm read FForm; + procedure AssignClient(AClient: TObject); override; + function IsCheckedLinked: Boolean; override; + function IsEnabledLinked: Boolean; override; + function IsGroupIndexLinked: Boolean; override; + function IsHelpLinked: Boolean; override; + function IsHintLinked: Boolean; override; + function IsVisibleLinked: Boolean; override; + function IsOnExecuteLinked: Boolean; override; + procedure SetVisible(Value: Boolean); override; + end; + + { Forms } + + TCloseEvent = procedure(Sender: TObject; var Action: TCloseAction) of object; + TCloseQueryEvent = procedure(Sender: TObject; var CanClose: Boolean) of object; + + TFmxFormBorderStyle = (None, Single, Sizeable, ToolWindow, SizeToolWin); + + TFmxFormState = (Recreating, Modal, Released, InDesigner, WasNotShown, Showing, UpdateBorder, Activation, Closing, + Engaged); + + TFmxFormStates = set of TFmxFormState; + + TFormPosition = (Designed, Default, DefaultPosOnly, DefaultSizeOnly, ScreenCenter, DesktopCenter, MainFormCenter, OwnerFormCenter); + + IFMXWindowService = interface(IInterface) + ['{26C42398-9AFC-4D09-9541-9C71E769FC35}'] + function FindForm(const AHandle: TWindowHandle): TCommonCustomForm; + function CreateWindow(const AForm: TCommonCustomForm): TWindowHandle; + procedure DestroyWindow(const AForm: TCommonCustomForm); + procedure ReleaseWindow(const AForm: TCommonCustomForm); + procedure SetWindowState(const AForm: TCommonCustomForm; const AState: TWindowState); + procedure ShowWindow(const AForm: TCommonCustomForm); + procedure HideWindow(const AForm: TCommonCustomForm); + function ShowWindowModal(const AForm: TCommonCustomForm): TModalResult; + procedure InvalidateWindowRect(const AForm: TCommonCustomForm; R: TRectF); + procedure InvalidateImmediately(const AForm: TCommonCustomForm); + procedure SetWindowRect(const AForm: TCommonCustomForm; ARect: TRectF); + function GetWindowRect(const AForm: TCommonCustomForm): TRectF; + function GetClientSize(const AForm: TCommonCustomForm): TPointF; + procedure SetClientSize(const AForm: TCommonCustomForm; const ASize: TPointF); + procedure SetWindowCaption(const AForm: TCommonCustomForm; const ACaption: string); + procedure SetCapture(const AForm: TCommonCustomForm); + procedure ReleaseCapture(const AForm: TCommonCustomForm); + function ClientToScreen(const AForm: TCommonCustomForm; const AFormPoint: TPointF): TPointF; + function ScreenToClient(const AForm: TCommonCustomForm; const AScreenPoint: TPointF): TPointF; + procedure BringToFront(const AForm: TCommonCustomForm); + procedure SendToBack(const AForm: TCommonCustomForm); + procedure Activate(const AForm: TCommonCustomForm); + function GetWindowScale(const AForm: TCommonCustomForm): Single; deprecated; // Use THandle.Scale instead + function CanShowModal: Boolean; + end; + + /// A service for working with form size constraints. + IFMXWindowConstraintsService = interface + ['{030E519F-3D99-422C-9978-798EA04AF14B}'] + procedure SetConstraints(const AForm: TCommonCustomForm; const AMinWidth, AMinHeight, AMaxWidth, AMaxHeight: Single); + end; + + IFMXFullScreenWindowService = interface(IInterface) + ['{103EB4B7-E899-4684-8174-2EEEE24F1E58}'] + procedure SetFullScreen(const AForm: TCommonCustomForm; const AValue: Boolean); + function GetFullScreen(const AForm: TCommonCustomForm): Boolean; + procedure SetShowFullScreenIcon(const AForm: TCommonCustomForm; const AValue: Boolean); + end; + + TWindowBorder = class(TFmxObject) + private + [Weak] FForm: TCommonCustomForm; + protected + function GetSupported: Boolean; virtual; abstract; + procedure Resize; virtual; abstract; + procedure Activate; virtual; abstract; + procedure Deactivate; virtual; abstract; + /// Notifies when form changed style. + procedure StyleChanged; virtual; abstract; + procedure ScaleChanged; virtual; abstract; + procedure EnableChanged; virtual; + public + constructor Create(const AForm: TCommonCustomForm); reintroduce; virtual; + property Form: TCommonCustomForm read FForm; + property IsSupported: Boolean read GetSupported; + end; + + IFMXWindowBorderService = interface(IInterface) + ['{F3FC3133-CEF0-446F-B3C6-7820989DDFC6}'] + function CreateWindowBorder(const AForm: TCommonCustomForm): TWindowBorder; + end; + + TFormBorder = class(TPersistent) + private + FWindowBorder: TWindowBorder; + [Weak] FForm: TCommonCustomForm; + FStyling: Boolean; + procedure SetStyling(const Value: Boolean); + protected + function GetSupported: Boolean; + procedure Recreate; + procedure EnableChanged; + public + constructor Create(const AForm: TCommonCustomForm); + destructor Destroy; override; + procedure StyleChanged; + procedure ScaleChanged; + procedure Resize; + procedure Activate; + procedure Deactivate; + property WindowBorder: TWindowBorder read FWindowBorder; + property IsSupported: Boolean read GetSupported; + published + property Styling: Boolean read FStyling write SetStyling default True; + end; + + TVKStateChangeMessage = class(System.Messaging.TMessage) + private + FKeyboardShown: Boolean; + FBounds: TRect; + public + constructor Create(AKeyboardShown: Boolean; const Bounds: TRect); + property KeyboardVisible: Boolean read FKeyboardShown; + property KeyboardBounds: TRect read FBounds; + end; + + TScaleChangedMessage = class(System.Messaging.TMessage); + TMainCaptionChangedMessage = class(System.Messaging.TMessage); + TMainFormChangedMessage = class(System.Messaging.TMessage); + /// Notification about destoying real form + TBeforeDestroyFormHandle = class(System.Messaging.TMessage); + /// Notification about creating real form + TAfterCreateFormHandle = class(System.Messaging.TMessage); + TOrientationChangedMessage = class(System.Messaging.TMessage); + TSizeChangedMessage = class(System.Messaging.TMessage); + TSaveStateMessage = class(System.Messaging.TMessage); + /// Notification about changing focus control. + TFormChangingFocusControl = class(System.Messaging.TMessage) + public + /// Previous focused control. + [Weak] PreviousFocusedControl: IControl; + /// New control, which are going to have focus. + [Weak] NewFocusedControl: IControl; + /// Does focus changing finished? True - NewFocusedControl received focus, False - otherwise. + IsChanged: Boolean; + constructor Create(const APreviousFocusedControl: IControl; const ANewFocusedControl: IControl; const AIsChanged: Boolean); + end; + + TFormSaveState = class + strict private const + UniqueNameSeparator = '_'; + UniqueNamePrefix = 'FM'; + UniqueNameExtension = '.TMP'; + strict private + [Weak] FOwner: TCommonCustomForm; + FStream: TMemoryStream; + FName: string; + procedure UpdateFromSaveState; + function GetStream: TMemoryStream; + function GenerateUniqueName: string; + private + procedure UpdateToSaveState; + function GetStoragePath: string; + procedure SetStoragePath(const AValue: string); + protected + function GetUniqueName: string; + public + constructor Create(const AOwner: TCommonCustomForm); + destructor Destroy; override; + property Owner: TCommonCustomForm read FOwner; + property Stream: TMemoryStream read GetStream; + property Name: string read FName write FName; + property StoragePath: string read GetStoragePath write SetStoragePath; + end; + +{ TCommonCustomForm } + + TWindowStyle = (GPUSurface); + + TWindowStyles = set of TWindowStyle; + + /// Settings of system status bar + TFormSystemStatusBar = class(TPersistent) + public type + TVisibilityMode = (Visible, Invisible, VisibleAndOverlap); + public const + DefaultBackgroundColor = TAlphaColorRec.Null; + DefaultVisibility = TVisibilityMode.Visible; + private + [Weak] FForm: TCommonCustomForm; + FBackgroundColor: TAlphaColor; + FVisibility: TVisibilityMode; + procedure SetBackgroundColor(const Value: TAlphaColor); + procedure SetVisibility(const Value: TVisibilityMode); + protected + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create(const AForm: TCommonCustomForm); + published + /// Background color of system status bar + property BackgroundColor: TAlphaColor read FBackgroundColor write SetBackgroundColor default DefaultBackgroundColor; + /// Different modes of showing system status bar + property Visibility: TVisibilityMode read FVisibility write SetVisibility default DefaultVisibility; + end; + + /// Service for working with native system status bar + IFMXWindowSystemStatusBarService = interface(IInterface) + ['{06258F45-98C5-4F8F-9A77-01F2BD892A5B}'] + /// Sets background color of system status bar + procedure SetBackgroundColor(const AForm: TCommonCustomForm; const AColor: TAlphaColor); + /// Sets how system status bar will be shown. See TVisibilityMode + procedure SetVisibility(const AForm: TCommonCustomForm; const AMode: TFormSystemStatusBar.TVisibilityMode); + end; + + /// + /// The service is designed to position the form on the screen depending on the selected position mode. + /// + /// You can use the default implementation, see the class TDefaultFormPositioner. + IFMXFormPositionerService = interface + ['{7624844E-3F50-4C51-A742-BA1379EB7D5F}'] + procedure PlaceOnScreen(const AForm: TCommonCustomForm; const APosition: TFormPosition); + end; + + /// + /// The default implementation of IFMXFormPositionerService for all platforms. It uses Density-Independent + /// Pixel for calculation positions. + /// + TDefaultFormPositionerService = class(TInterfacedObject, IFMXFormPositionerService) + protected + class function FitInRect(const AValue: TRectF; const AMaxRect: TRectF): TRectF; + function GetOwnerForm(const AForm: TCommonCustomForm): TCommonCustomForm; + function GetMainForm(const AForm: TCommonCustomForm): TCommonCustomForm; + function DefineTargetPosition(const AForm: TCommonCustomForm; const APosition: TFormPosition): TFormPosition; + { Alignment } + procedure PlaceDesigned(const AForm: TCommonCustomForm); virtual; + procedure PlaceDefaultPosOnly(const AForm: TCommonCustomForm); virtual; + procedure PlaceDefaultSizeOnly(const AForm: TCommonCustomForm); virtual; + procedure PlaceScreenCenter(const AForm: TCommonCustomForm); virtual; + procedure PlaceDesktopCenter(const AForm: TCommonCustomForm); virtual; + procedure PlaceMainFormCenter(const AForm: TCommonCustomForm); virtual; + procedure PlaceOwnerFormCenter(const AForm: TCommonCustomForm); virtual; + public + class procedure PlaceByDefault(const AForm: TCommonCustomForm; const APosition: TFormPosition); + + { IFMXFormPositionerService } + procedure PlaceOnScreen(const AForm: TCommonCustomForm; const APosition: TFormPosition); + end; + + TConstraintSize = Single; + + TSizeConstraints = class(TPersistent) + private type + TDimension = (MaxHeight, MaxWidth, MinHeight, MinWidth); + private + FOwner: TComponent; + FMaxHeight: TConstraintSize; + FMaxWidth: TConstraintSize; + FMinHeight: TConstraintSize; + FMinWidth: TConstraintSize; + FOnChange: TNotifyEvent; + procedure SetConstraints(const Index: TDimension; Value: TConstraintSize); + function GetMaxSize: TSizeF; + function GetMinSize: TSizeF; + function IsValueStored(const Index: TDimension): Boolean; + protected + procedure Change; virtual; + procedure AssignTo(Dest: TPersistent); override; + function GetOwner: TPersistent; override; + public + constructor Create(const AOwner: TComponent); virtual; + property MinSize: TSizeF read GetMinSize; + property MaxSize: TSizeF read GetMaxSize; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + published + property MaxHeight: TConstraintSize index TDimension.MaxHeight read FMaxHeight write SetConstraints stored IsValueStored nodefault; + property MaxWidth: TConstraintSize index TDimension.MaxWidth read FMaxWidth write SetConstraints stored IsValueStored nodefault; + property MinHeight: TConstraintSize index TDimension.MinHeight read FMinHeight write SetConstraints stored IsValueStored nodefault; + property MinWidth: TConstraintSize index TDimension.MinWidth read FMinWidth write SetConstraints stored IsValueStored nodefault; + end; + + TConstrainedResizeEvent = procedure(Sender: TObject; var MinWidth, MinHeight, MaxWidth, MaxHeight: Single) of object; + + TCommonCustomForm = class(TFmxObject, IRoot, IContainerObject, IAlignRoot, IPaintControl, IStyleBookOwner, + IDesignerStorage, IOriginalContainerSize, ITabStopController, IGestureControl, IMultiTouch, + ICaption, IHintRegistry, IFlipContainer) + private type + THandleState = (Normal, NeedRecreate, Changed); + TBoundChange = (Location, Size); + TBoundChanges = set of TBoundChange; + private + FDesigner: IDesignerHook; + FCaption: string; + { Size and Position } + FBounds: TRectF; // dp + FBoundChanges: TBoundChanges; + FDefaultWindowRect: TRectF; // dp + FDefaultClientSize: TSizeF; // dp + FConstraints: TSizeConstraints; // dp + FPosition: TFormPosition; + FTransparency: Boolean; + FHandle: TWindowHandle; + FContextHandle: THandle; + FBorderStyle: TFmxFormBorderStyle; + FBorderIcons: TBorderIcons; + FVisible: Boolean; + FExplicitVisible: Boolean; + FModalResult: TModalResult; + FFormState: TFmxFormStates; + FBiDiMode: TBiDiMode; + FActive: Boolean; + FTarget: IControl; + FHovered, FCaptured, FFocused: IControl; + FMousePos, FDownPos, FResizeSize, FDownSize: TPointF; + FDragging, FResizing: Boolean; + FCursor: TCursor; + FWindowState: TWindowState; + FShowFullScreenIcon : Boolean; + FFullScreen : Boolean; + FPadding: TBounds; + FFormFactor : TFormFactor; + FFormFamily : string; + FOldActiveForm: TCommonCustomForm; + FChangingFocusGuard: Boolean; + FBorder: TFormBorder; + FStateChangeMessageId: TMessageSubscriptionId; + FOnClose: TCloseEvent; + FOnCloseQuery: TCloseQueryEvent; + FOnActivate: TNotifyEvent; + FOnDeactivate: TNotifyEvent; + FOnCreate: TNotifyEvent; + FOnDestroy: TNotifyEvent; + FOnResize: TNotifyEvent; + FOnConstrainedResize: TConstrainedResizeEvent; + FOnMouseDown: TMouseEvent; + FOnMouseMove: TMouseMoveEvent; + FOnMouseUp: TMouseEvent; + FOnMouseWheel: TMouseWheelEvent; + FOnKeyDown: TKeyEvent; + FOnKeyUp: TKeyEvent; + FOnShow: TNotifyEvent; + FOnHide: TNotifyEvent; + FOnFocusChanged: TNotifyEvent; + FOnVirtualKeyboardShown: TVirtualKeyboardEvent; + FOnVirtualKeyboardHidden: TVirtualKeyboardEvent; + FOnTap: TTapEvent; + FOnTouch: TTouchEvent; + [Weak] FStyleBook: TStyleBook; + FScaleChangedId: TMessageSubscriptionId; + FStyleChangedId: TMessageSubscriptionId; + FStyleBookChanged: Boolean; + FPreloadedBorderStyling: Boolean; + FOriginalContainerSize: TPointF; + [Weak] FMainMenu: TComponent; + FMainMenuNative: INativeControl; + FFormStyle: TFormStyle; + [Weak] FParentForm: TCommonCustomForm; + FHandleState: THandleState; + FGestureRecognizers: array [TInteractiveGesture] of Integer; + FResultProc: TProc; + FTabList: TTabList; + FTouchManager: TTouchManager; + FOnGesture: TGestureEvent; + FOnSaveState: TNotifyEvent; + FSaveState: TFormSaveState; + FSaveStateMessageId: TMessageSubscriptionId; + FEngageCount: Integer; + FSharedHint: THint; + FLastHinted: IControl; + FHintReceiverList: TList; + FHint: string; + FShowHint: Boolean; + FSystemStatusBar: TFormSystemStatusBar; + {$IFDEF MSWINDOWS} + FDesignerDeviceName: string; + FDesignerMasterStyle: Integer; + function GetDesignerMobile: Boolean; + function GetDesignerWidth: Integer; + function GetDesignerHeight: Integer; + function GetDesignerDeviceName: string; + function GetDesignerOrientation: TFormOrientation; + function GetDesignerOSVersion: string; + function GetDesignerMasterStyle: Integer; + procedure SetDesignerMasterStyle(Value: Integer); + {$ENDIF} + procedure ReadDesignerMobile(Reader: TReader); + procedure ReadDesignerWidth(Reader: TReader); + procedure ReadDesignerHeight(Reader: TReader); + procedure ReadDesignerDeviceName(Reader: TReader); + procedure ReadDesignerOrientation(Reader: TReader); + procedure ReadDesignerOSVersion(Reader: TReader); + procedure ReadDesignerMasterStyle(Reader: TReader); + procedure WriteDesignerMasterStyle(Writer: TWriter); + procedure SetDesigner(const ADesigner: IDesignerHook); + procedure SetLeft(const Value: Integer); + procedure SetTop(const Value: Integer); + procedure SetHeight(const Value: Integer); + function GetHeight: Integer; + procedure SetWidth(const Value: Integer); + function GetWidth: Integer; + procedure SetCaption(const Value: string); + function GetClientHeight: Integer; + function GetClientWidth: Integer; + procedure SetBorderStyle(const Value: TFmxFormBorderStyle); + procedure SetBorderIcons(const Value: TBorderIcons); + procedure SetVisible(const Value: Boolean); + procedure SetClientHeight(const Value: Integer); + procedure SetClientWidth(const Value: Integer); + procedure SetBiDiMode(const Value: TBiDiMode); + procedure SetCursor(const Value: TCursor); + procedure SetPosition(const Value: TFormPosition); + procedure SetWindowState(const Value: TWindowState); + function GetLeft: Integer; + function GetTop: Integer; + procedure ShowCaret(const Control: IControl); + procedure HideCaret(const Control: IControl); + procedure AdvanceTabFocus(const MoveForward: Boolean); + procedure SaveStateHandler(const Sender: TObject; const Msg: System.Messaging.TMessage); + function GetFullScreen: Boolean; + procedure SetFullScreen(const AValue: Boolean); + function GetShowFullScreenIcon: Boolean; + procedure SetShowFullScreenIcon(const AValue: Boolean); + procedure PreloadProperties; + procedure SetPadding(const Value: TBounds); + function GetOriginalContainerSize: TPointF; + procedure SetBorder(const Value: TFormBorder); + function FullScreenSupported: Boolean; + procedure SetFormStyle(const Value: TFormStyle); + procedure ReadTopMost(Reader: TReader); + function ParentFormOfIControl(Value: IControl): TCommonCustomForm; + function CanTransparency: Boolean; + function CanFormStyle(const NewValue: TFormStyle): TFormStyle; + procedure ReadShowActivated(Reader: TReader); + procedure DesignerUpdateBorder; + procedure ReadStaysOpen(Reader: TReader); + function SetMainMenu(Value: TComponent): Boolean; + procedure SetSystemStatusBar(const Value: TFormSystemStatusBar); + function GetVisible: Boolean; + procedure SetModalResult(Value: TModalResult); + procedure CreateTouchManagerIfRequired; + function GetTouchManager: TTouchManager; + procedure SetTouchManager(const Value: TTouchManager); + function GetSaveState: TFormSaveState; + function SharedHint: THint; + procedure ReleaseLastHinted; + procedure SetLastHinted(const AControl: IControl); + { ICaption } + procedure ICaption.SetText = SetCaption; + function GetText: string; + function ICaption.TextStored = CaptionStore; + procedure ClearFocusedControl(const IgnoreExceptions: Boolean = False); + procedure SetFocusedControl(const NewFocused: IControl); + procedure FocusedControlExited; + procedure FocusedControlEntered; + procedure TriggerFormHint; + procedure TriggerControlHint(const AControl: IControl); + procedure SetShowHint(const Value: Boolean); + { interactive gesture recognizers } + procedure RestoreGesturesRecognizer; + { Constraints } + procedure SetConstraints(const Value: TSizeConstraints); + procedure ConstraintsChanged(Sender: TObject); + protected + FActiveControl: IControl; + FUpdating: Integer; + FLastWidth, FLastHeight: single; + FDisableAlign: Boolean; + FWinService: IFMXWindowService; + FCursorService: IFMXCursorService; + FFullScreenWindowService: IFMXFullScreenWindowService; + procedure ReleaseForm; + function GetBackIndex: Integer; override; + procedure InvalidateRect(R: TRectF); + procedure Recreate; virtual; + procedure Resize; virtual; + /// + /// The method is called when form need to apply size constraints. You can overload this method to adjust + /// the constraint values. + /// + procedure ConstrainedResize(var AMinWidth, AMinHeight, AMaxWidth, AMaxHeight: Single); virtual; + procedure AdjustSize(var ASize: TSizeF); virtual; + procedure SetActive(const Value: Boolean); virtual; + procedure DefineProperties(Filer: TFiler); override; + function FindTarget(P: TPointF; const Data: TDragObject): IControl; virtual; + procedure SetFormFamily(const Value: string); + procedure UpdateStyleBook; virtual; + procedure SetStyleBookWithoutUpdate(const StyleBook: TStyleBook); + procedure ShowInDesigner; + procedure DoFlipChildren; virtual; + function CanFlipChild(const AChild: TFmxObject): Boolean; virtual; + { IInterface } + function QueryInterface(const IID: TGUID; out Obj): HResult; override; + { IAlignRoot } + procedure Realign; virtual; + procedure ChildrenAlignChanged; + { Preload } + procedure AddPreloadPropertyNames(const PropertyNames: TList); virtual; + procedure SetPreloadProperties(const PropertyStore: TDictionary); virtual; + { Handle } + procedure CreateHandle; virtual; + procedure DestroyHandle; virtual; + procedure ResizeHandle; virtual; + { IRoot } + function GetObject: TFmxObject; + function GetActiveControl: IControl; + procedure SetActiveControl(const AControl: IControl); + procedure SetCaptured(const Value: IControl); + function NewFocusedControl(const Value: IControl): IControl; + procedure SetFocused(const Value: IControl); + procedure SetHovered(const Value: IControl); + procedure SetTransparency(const Value: Boolean); virtual; + function GetCaptured: IControl; + function GetFocused: IControl; + function GetBiDiMode: TBiDiMode; + function GetHovered: IControl; + procedure BeginInternalDrag(const Source: TObject; const ABitmap: TObject); + { IStyleBookOwner } + function GetStyleBook: TStyleBook; + procedure SetStyleBook(const Value: TStyleBook); + { IPaintControl } + procedure PaintRects(const UpdateRects: array of TRectF); virtual; + function GetContextHandle: THandle; + procedure SetContextHandle(const AContextHandle: THandle); + property ContextHandle: THandle read FContextHandle; + { Border } + function CreateBorder: TFormBorder; virtual; + { TFmxObject } + procedure Loaded; override; + procedure FreeNotification(AObject: TObject); override; + procedure DoAddObject(const AObject: TFmxObject); override; + procedure DoRemoveObject(const AObject: TFmxObject); override; + procedure DoDeleteChildren; override; + procedure Updated; override; + { TComponent } + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure ValidateRename(AComponent: TComponent; const CurName, NewName: string); override; + procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; + procedure GetDeltaStreams(Proc: TGetStreamProc); override; + { IContainerObject } + function GetContainerWidth: Single; + function GetContainerHeight: Single; + procedure UpdateActions; virtual; + function GetActionLinkClass: TActionLinkClass; override; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + function CaptionStore: boolean; + procedure VirtualKeyboardChangeHandler(const Sender: TObject; const Msg: System.Messaging.TMessage); virtual; + procedure IsDialogKey(const Key: Word; const KeyChar: WideChar; const Shift: TShiftState; + var IsDialog: Boolean); virtual; + { Events } + procedure DoShow; virtual; + procedure DoHide; virtual; + procedure DoClose(var CloseAction: TCloseAction); virtual; + procedure DoScaleChanged; virtual; + procedure DoStyleChanged; virtual; + procedure DoMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); virtual; + procedure DoMouseMove(Shift: TShiftState; X, Y: Single); virtual; + procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); virtual; + procedure DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); virtual; + procedure DoFocusChanged; virtual; + procedure DoPaddingChanged; virtual; + procedure DoTap(const Point: TPointF); virtual; + procedure DoKeyDown(var AKeyCode: Word; var AKeyChar: WideChar; const AShiftState: TShiftState); virtual; + procedure DoKeyUp(var AKeyCode: Word; var AKeyChar: WideChar; const AShiftState: TShiftState); virtual; + { Window style } + function GetWindowStyle: TWindowStyles; virtual; + procedure DoParentFormChanged; virtual; + procedure DoRootChanged; override; + property MainMenu: TComponent read FMainMenu; + procedure DoGesture(const EventInfo: TGestureEventInfo; var Handled: Boolean); virtual; + { IGestureControl } + procedure BroadcastGesture(EventInfo: TGestureEventInfo); + procedure CMGesture(var EventInfo: TGestureEventInfo); virtual; + function TouchManager: TTouchManager; + function GetFirstControlWithGesture(AGesture: TInteractiveGesture): TComponent; + function GetFirstControlWithGestureEngine: TComponent; + function GetListOfInteractiveGestures: TInteractiveGestures; + procedure Tap(const Location: TPointF); virtual; + { IMultiTouch } + procedure MultiTouch(const Touches: TTouches; const Action: TTouchAction); + procedure Engage; + procedure Disengage; + /// Handler for event that happend when window's scale factor is changed, for example move window from retina to non-retina screen on OS X. + procedure ScaleChangedHandler(const Sender: TObject; const Msg: System.Messaging.TMessage); virtual; + /// Style changeing event handler + procedure StyleChangedHandler(const Sender: TObject; const Msg: System.Messaging.TMessage); virtual; + { IHintRegistry } + procedure TriggerHints; + procedure RegisterHintReceiver(const AReceiver: IHintReceiver); + procedure UnregisterHintReceiver(const AReceiver: IHintReceiver); + public + constructor Create(AOwner: TComponent); override; + constructor CreateNew(AOwner: TComponent; Dummy: NativeInt = 0); virtual; + destructor Destroy; override; + procedure InitializeNewForm; virtual; + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + { children } + function ObjectAtPoint(AScreenPoint: TPointF): IControl; virtual; + procedure CreateChildFormList(Parent: TFmxObject; var List: TList); + {$REGION 'Mouse events'} + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; AFormX, AFormY: Single); virtual; + procedure MouseMove(Shift: TShiftState; AFormX, AFormY: Single); virtual; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; AFormX, AFormY: Single; DoClick: Boolean = True); virtual; + procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); virtual; + procedure MouseLeave; virtual; + procedure MouseCapture; + procedure ReleaseCapture; + {$ENDREGION} + + {$REGION 'Keys events'} + /// + /// Starting the processing of the Key Down event. The method performs full processing and delivery of the event + /// to consumers. + /// + procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); virtual; + /// + /// Starting the processing of the Key Up event. The method performs full processing and delivery of the event + /// to consumers. + /// + procedure KeyUp(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); virtual; + /// + /// Performs accelerator keys processing. If the keys are processed, it returns True and this means that + /// no more keys will be processed by the next consumers. + /// + function DispatchAcceleratorKey(const AKey: Word; const AKeyChar: WideChar; const AShift: TShiftState): Boolean; virtual; + /// + /// Performs dialog keys processing. If the keys are processed, it returns True and this means that + /// no more keys will be processed by the next consumers. + /// + function DispatchDialogKey(const AKey: Word; const AKeyChar: WideChar; const AShift: TShiftState): Boolean; virtual; + {$ENDREGION} + + /// Force recreating form resources lie Canvas or Context. + procedure RecreateResources; virtual; + procedure HandleNeed; deprecated 'Use HandleNeeded.'; + /// Requests the form to create its handle at this moment and all associated resources with it. + /// This replaces HandleNeed method, which has been deprecated. + procedure HandleNeeded; +// function GetImeWindowRect: TRectF; virtual; + procedure Activate; + procedure Deactivate; + procedure DragEnter(const Data: TDragObject; const Point: TPointF); virtual; + procedure DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); virtual; + procedure DragDrop(const Data: TDragObject; const Point: TPointF); virtual; + procedure DragLeave; virtual; + procedure EnterMenuLoop; + { manully start } + procedure StartWindowDrag; virtual; + procedure StartWindowResize; virtual; + {interactive gesture recognizers} + procedure AddRecognizer(const Recognizer: TInteractiveGesture); + procedure RemoveRecognizer(const Recognizer: TInteractiveGesture); + function GetRecognizers: TInteractiveGestures; + { settings } + procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); overload; virtual; + procedure SetBounds(const ARect: TRect); overload; + /// Sets new form frame in DP. + procedure SetBoundsF(const ALeft, ATop, AWidth, AHeight: Single); overload; virtual; + /// Sets new form frame in DP. + procedure SetBoundsF(const ARect: TRectF); overload; + function GetBounds: TRect; virtual; + function GetBoundsF: TRectF; virtual; + function ClientToScreen(const AFormPoint: TPointF): TPointF; + function ScreenToClient(const AScreenPoint: TPointF): TPointF; + function CanShow: Boolean; virtual; + function CloseQuery: Boolean; virtual; + function ClientRect: TRectF; + procedure RecreateOsMenu; + {$WARN SYMBOL_DEPRECATED OFF} + procedure Release; override; deprecated; + {$WARN SYMBOL_DEPRECATED DEFAULT} + /// Closes the form and returns the actual TCloseAction performed. + function Close: TCloseAction; + procedure Show; + procedure Hide; + procedure BringToFront; override; + procedure SendToBack; override; + function ShowModal: TModalResult; overload; + procedure ShowModal(const ResultProc: TProc); overload; + /// Closes a modal form and returns the actual TCloseAction performed. + function CloseModal: TCloseAction; + function IsPopupForm: Boolean; overload; virtual; + class function IsPopupForm(const AForm: TCommonCustomForm): Boolean; overload; + procedure Invalidate; + procedure BeginUpdate; virtual; + procedure EndUpdate; virtual; + { ITabStopController } + function GetTabList: ITabList; + { IFlipContainer } + procedure FlipChildren(const AAllLevels: Boolean); + /// Returns true if the handle is allocated; otherwise, false. + function IsHandleAllocated: Boolean; + property Handle: TWindowHandle read FHandle; + property ParentForm: TCommonCustomForm read FParentForm; + property FormStyle: TFormStyle read FFormStyle write SetFormStyle default TFormStyle.Normal; + property ModalResult: TModalResult read FModalResult write SetModalResult; + property FormState: TFmxFormStates read FFormState; + property Designer: IDesignerHook read FDesigner write SetDesigner; + property Captured: IControl read FCaptured; + property Focused: IControl read FFocused write SetFocused; + property Hovered: IControl read FHovered; + property Active: Boolean read FActive write SetActive; + property BiDiMode: TBiDiMode read GetBiDiMode write SetBiDiMode default bdLeftToRight; + property Caption: string read FCaption write SetCaption stored CaptionStore; + property Cursor: TCursor read FCursor write SetCursor default crDefault; + property Border: TFormBorder read FBorder write SetBorder; + property BorderStyle: TFmxFormBorderStyle read FBorderStyle write SetBorderStyle + default TFmxFormBorderStyle.Sizeable; + property BorderIcons: TBorderIcons read FBorderIcons write SetBorderIcons + default [TBorderIcon.biSystemMenu, TBorderIcon.biMinimize, TBorderIcon.biMaximize]; + /// Bounds of form - position and size (dp). + property Bounds: TRect read GetBounds write SetBounds; + /// Bounds of form - position and size (dp). + property BoundsF: TRectF read GetBoundsF write SetBoundsF; + property ClientHeight: Integer read GetClientHeight write SetClientHeight; + property ClientWidth: Integer read GetClientWidth write SetClientWidth; + property OriginalContainerSize: TPointF read GetOriginalContainerSize; + property Padding: TBounds read FPadding write SetPadding; + property Position: TFormPosition read FPosition write SetPosition default TFormPosition.DefaultPosOnly; + property StyleBook: TStyleBook read FStyleBook write SetStyleBook; + /// Settings of system status bar on mobile platforms + property SystemStatusBar: TFormSystemStatusBar read FSystemStatusBar write SetSystemStatusBar; + property Transparency: Boolean read FTransparency write SetTransparency default False; + property Width: Integer read GetWidth write SetWidth stored False; + property Height: Integer read GetHeight write SetHeight stored False; + property Constraints: TSizeConstraints read FConstraints write SetConstraints; + property Visible: Boolean read GetVisible write SetVisible default False; + property WindowState: TWindowState read FWindowState write SetWindowState default TWindowState.wsNormal; + property WindowStyle: TWindowStyles read GetWindowStyle; + property FullScreen : Boolean read GetFullScreen write SetFullScreen default False; + property ShowFullScreenIcon : Boolean read GetShowFullScreenIcon write SetShowFullScreenIcon default True; + property FormFactor: TFormFactor read FFormFactor write FFormFactor; + property FormFamily : string read FFormFamily write SetFormFamily; + property SaveState: TFormSaveState read GetSaveState; + /// Determines whether Help Hints are enabled or disabled for the entire application. + property ShowHint: Boolean read FShowHint write SetShowHint default True; + property OnCreate: TNotifyEvent read FOnCreate write FOnCreate; + property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy; + property OnClose: TCloseEvent read FOnClose write FOnClose; + property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery; + property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; + property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate; + property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown; + property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp; + property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown; + property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove; + property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp; + property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel; + property OnResize: TNotifyEvent read FOnResize write FOnResize; + property OnConstrainedResize: TConstrainedResizeEvent read FOnConstrainedResize write FOnConstrainedResize; + property OnShow: TNotifyEvent read FOnShow write FOnShow; + property OnHide: TNotifyEvent read FOnHide write FOnHide; + property OnFocusChanged: TNotifyEvent read FOnFocusChanged write FOnFocusChanged; + property OnVirtualKeyboardShown: TVirtualKeyboardEvent read FOnVirtualKeyboardShown write FOnVirtualKeyboardShown; + property OnVirtualKeyboardHidden: TVirtualKeyboardEvent read FOnVirtualKeyboardHidden write FOnVirtualKeyboardHidden; + property OnSaveState: TNotifyEvent read FOnSaveState write FOnSaveState; + property Touch: TTouchManager read GetTouchManager write SetTouchManager; + property OnGesture: TGestureEvent read FOnGesture write FOnGesture; + property OnTap: TTapEvent read FOnTap write FOnTap; + property OnTouch: TTouchEvent read FOnTouch write FOnTouch; + published + // do not move this + property Left: Integer read GetLeft write SetLeft; + property Top: Integer read GetTop write SetTop; + end; + + { TCustomForm } + + TCustomForm = class(TCommonCustomForm, IScene) + private + FCanvas: TCanvas; + FTempCanvas: TCanvas; + FFill: TBrush; + FDrawing: Boolean; + FUpdateRects: array of TRectF; + FStyleLookup: string; + FNeedStyleLookup: Boolean; + FResourceLink: TFmxObject; + FOnPaint: TOnPaintEvent; + FControls: TControlList; + FQuality: TCanvasQuality; + FDisableUpdating: Integer; + procedure SetFill(const Value: TBrush); + procedure FillChanged(Sender: TObject); + { IScene } + function GetCanvas: TCanvas; + function GetUpdateRectsCount: Integer; + function GetUpdateRect(const Index: Integer): TRectF; + function GetSceneScale: Single; + function LocalToScreen(const P: TPointF): TPointF; + function ScreenToLocal(const P: TPointF): TPointF; + procedure SetStyleLookup(const Value: string); + procedure AddUpdateRect(const R: TRectF); + procedure DisableUpdating; + procedure EnableUpdating; + procedure ChangeScrollingState(const AControl: TControl; const Active: Boolean); + function IsStyleLookupStored: Boolean; + function GetActiveHDControl: TControl; + procedure SetActiveHDControl(const Value: TControl); + procedure SetQuality(const Value: TCanvasQuality); + procedure AddUpdateRects(const UpdateRects: array of TRectF); + procedure PrepareForPaint; + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure DoAddObject(const AObject: TFmxObject); override; + procedure DoRemoveObject(const AObject: TFmxObject); override; + procedure DoDeleteChildren; override; + procedure ChangeChildren; override; + procedure UpdateStyleBook; override; + { TForm } + function CanFlipChild(const AChild: TFmxObject): Boolean; override; + procedure ApplyStyleLookup; virtual; + { Preload } + procedure AddPreloadPropertyNames(const PropertyNames: TList); override; + procedure SetPreloadProperties(const PropertyStore: TDictionary); override; + { } + procedure DoPaint(const Canvas: TCanvas; const ARect: TRectF); virtual; + { resources } + function GetStyleObject: TFmxObject; + procedure PaintBackground; virtual; + { Handle } + procedure CreateHandle; override; + procedure DestroyHandle; override; + procedure ResizeHandle; override; + procedure PaintRects(const UpdateRects: array of TRectF); override; + procedure RecreateCanvas; + { inherited } + procedure RecalcControlsUpdateRect; + procedure Realign; override; + procedure DoScaleChanged; override; + procedure DoStyleChanged; override; + { Window style } + function GetWindowStyle: TWindowStyles; override; + procedure StyleChangedHandler(const Sender: TObject; const Msg: System.Messaging.TMessage); override; + property ResourceLink: TFmxObject read FResourceLink; + public + constructor Create(AOwner: TComponent); override; + constructor CreateNew(AOwner: TComponent; Dummy: NativeInt = 0); override; + destructor Destroy; override; + procedure InitializeNewForm; override; + procedure EndUpdate; override; + procedure PaintTo(const Canvas: TCanvas); + procedure RecreateResources; override; + property Action; + property Canvas: TCanvas read GetCanvas; + property Fill: TBrush read FFill write SetFill; + property Quality: TCanvasQuality read FQuality write SetQuality; + property ActiveControl: TControl read GetActiveHDControl write SetActiveHDControl; + property StyleLookup: string read FStyleLookup write SetStyleLookup stored IsStyleLookupStored; + property OnPaint: TOnPaintEvent read FOnPaint write FOnPaint; + end; + + TCustomPopupForm = class (TCustomForm) + private type + TAniState = (asNone, asShow, asClose); + private + FAutoFree: Boolean; + FPlacement: TPlacement; + FRealPlacement: TPlacement; + [Weak] FPlacementTarget: TControl; + FOffset: TPointF; + FSize: TSizeF; + FPlacementRectangle: TBounds; + FScreenPlacementRect: TRectF; + FPlacementChanged: Boolean; + FTimer: TTimer; + FAniState: TAniState; + FAniDuration: Single; + FMaxAniPosition: Single; + FAniPosition: Single; + FShowTime: TDateTime; + FCloseTime: TDateTime; + FOnAniTimer: TNotifyEvent; + FFirstShow: Boolean; + FDragWithParent: Boolean; + FHideWhenPlacementTargetInvisible: Boolean; + FBeforeClose: TNotifyEvent; + FBeforeShow: TNotifyEvent; + FScreenContentRect: TRectF; + FContentPadding: TBounds; + FContentControl: TControl; + FOnRealPlacementChanged: TNotifyEvent; + FPreferedDisplayIndex: Integer; + procedure SetOffset(const Value: TPointF); + procedure SetSize(const Value: TSizeF); + procedure SetPlacementRectangle(const Value: TBounds); + procedure SetPlacement(const Value: TPlacement); + procedure TimerProc(Sender: TObject); + procedure SetPlacementTarget(const Value: TControl); + procedure SetDragWithParent(const Value: Boolean); + procedure SetContentPadding(const Value: TBounds); + procedure SetContentControl(const Value: TControl); + procedure SetPreferedDisplayIndex(const Value: Integer); + protected + procedure DoBeforeShow; virtual; + procedure DoBeforeClose; virtual; + procedure DoClose(var CloseAction: TCloseAction); override; + procedure DoPaddingChanged; override; + procedure DoApplyPlacement; virtual; + procedure Loaded; override; + procedure Updated; override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure DoAniTimer; virtual; + procedure Realign; override; + procedure DoRealPlacementChanged; virtual; + function IsVisibleOnScreen(const AControl: TControl): Boolean; + public + constructor CreateNew(AOwner: TComponent; Dummy: NativeInt = 0); override; + constructor Create(AOwner: TComponent; AStyleBook: TStyleBook = nil; APlacementTarget: TControl = nil; + AutoFree: Boolean = True); reintroduce; + destructor Destroy; override; + procedure ApplyPlacement; + function CanShow: Boolean; override; + function CloseQuery: Boolean; override; + property AniDuration: Single read FAniDuration write FAniDuration; + property AniPosition: Single read FAniPosition; + property AutoFree: Boolean read FAutoFree; + property ContentControl: TControl read FContentControl write SetContentControl; + property ContentPadding: TBounds read FContentPadding write SetContentPadding; + /// True - if popup form have to be relocated, when parent changes his position on screen. + property DragWithParent: Boolean read FDragWithParent write SetDragWithParent; + /// True - if popup form have to be closed, if PlacementTarget is not visible on the screen. + /// It works only, when PlacementTarget is specified. + property HideWhenPlacementTargetInvisible: Boolean read FHideWhenPlacementTargetInvisible write FHideWhenPlacementTargetInvisible; + property Offset: TPointF read FOffset write SetOffset; + property Placement: TPlacement read FPlacement write SetPlacement; + property PlacementRectangle: TBounds read FPlacementRectangle write SetPlacementRectangle; + property PlacementTarget: TControl read FPlacementTarget write SetPlacementTarget; + property PreferedDisplayIndex: Integer read FPreferedDisplayIndex write SetPreferedDisplayIndex; + property RealPlacement: TPlacement read FRealPlacement; + property ScreenContentRect: TRectF read FScreenContentRect; + property ScreenPlacementRect: TRectF read FScreenPlacementRect; + property Size: TSizeF read FSize write SetSize; + property OnAniTimer: TNotifyEvent read FOnAniTimer write FOnAniTimer; + property BeforeShow: TNotifyEvent read FBeforeShow write FBeforeShow; + property BeforeClose: TNotifyEvent read FBeforeClose write FBeforeClose; + property OnRealPlacementChanged: TNotifyEvent read FOnRealPlacementChanged write FOnRealPlacementChanged; + end; + + TForm = class(TCustomForm) + published + property Action; + property ActiveControl; + property BiDiMode; + property Border; + property BorderIcons default [TBorderIcon.biSystemMenu, TBorderIcon.biMinimize, TBorderIcon.biMaximize]; + property BorderStyle default TFmxFormBorderStyle.Sizeable; + property Caption; + property ClientHeight; + property ClientWidth; + property Cursor default crDefault; + property Fill; + property Height; + property Left; + property Padding; + property Position default TFormPosition.DefaultPosOnly; + property Quality default TCanvasQuality.SystemDefault; + property SystemStatusBar; + property StyleBook; + property StyleLookup; + property Transparency default False; + property Top; + property FormStyle default TFormStyle.Normal; + property Visible; + property WindowState default TWindowState.wsNormal; + property Width; + property Constraints; + property FormFactor; + property FormFamily; + property FullScreen default False; + property ShowFullScreenIcon default False; + property ShowHint; + {events} + property OnActivate; + property OnCreate; + property OnClose; + property OnCloseQuery; + property OnDeactivate; + property OnDestroy; + property OnKeyDown; + property OnKeyUp; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnResize; + property OnConstrainedResize; + property OnPaint; + property OnShow; + property OnHide; + property OnFocusChanged; + property OnVirtualKeyboardShown; + property OnVirtualKeyboardHidden; + property Touch; + property OnGesture; + property OnSaveState; + property OnTap; + property OnTouch; + end; + + { TFrame } + + TFrame = class(TControl, IControl) + private + FInLoaded: Boolean; + protected + procedure Paint; override; + procedure Loaded; override; + procedure Resize; override; + procedure DoResized; override; + function CheckHitTest(const AHitTest: Boolean): Boolean; override; + { IControl } + function GetVisible: Boolean; override; + public + constructor Create(AOwner: TComponent); override; + procedure AfterConstruction; override; + procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; + function ShouldTestMouseHits: Boolean; override; + published + property Action; + property Align; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled default True; + property Locked default False; + property Height; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property Visible default True; + property Width; + property TabStop; + property TabOrder; + property ParentShowHint; + property ShowHint; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + + { TScreen } + + TScreen = class(TComponent) + private + FManagingDataModules: Boolean; + FForms: TList; + FDataModules: TList; + FPopupForms: TList; + FSaveForm: TCommonCustomForm; + FMouseSvc: IFMXMouseService; + FMultiDisplaySvc: IInterface; + FPopupList: TList; + FClosingPopupList: Boolean; + procedure AddDataModule(DataModule: TDataModule); + procedure AddForm(const AForm: TCommonCustomForm); + function GetForm(Index: Integer): TCommonCustomForm; + function GetFormCount: Integer; + procedure RemoveDataModule(DataModule: TDataModule); + procedure RemoveForm(const AForm: TCommonCustomForm); + function GetDataModule(Index: Integer): TDataModule; + function GetDataModuleCount: Integer; + function GetPopupForms(Index: Integer): TCommonCustomForm; + function GetPopupFormCount: Integer; + function GetActiveForm: TCommonCustomForm; + procedure SetActiveForm(const Value: TCommonCustomForm); + function GetFocusControl: IControl; + function GetFocusObject: TFmxObject; + function GetDesktopRect: TRectF; + function GetWorkAreaRect: TRectF; + function GetDisplayCount: Integer; + function GetDisplay(const Index: Integer): TDisplay; + function GetDesktopHeight: Single; + function GetDesktopLeft: Single; + function GetDesktopTop: Single; + function GetDesktopWidth: Single; + function GetWorkAreaHeight: Single; + function GetWorkAreaLeft: Single; + function GetWorkAreaTop: Single; + function GetWorkAreaWidth: Single; + function GetHeight: Single; + function GetWidth: Single; + protected + property FocusObject: TFmxObject read GetFocusObject; + procedure CloseFormList(const List: TList); + function CreatePopupList(const SaveForm: TCommonCustomForm): TList; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function IndexFormOfObject(const AObject: TFmxObject; const VisibleOnly: Boolean = True): Integer; + function NextActiveForm(const OldActiveForm: TCommonCustomForm): TCommonCustomForm; + function MousePos: TPointF; + /// The size of primary display. + function Size: TSizeF; + property Height: Single read GetHeight; + property Width: Single read GetWidth; + function MultiDisplaySupported: Boolean; + procedure UpdateDisplayInformation; + /// Tries to return a rectangular having the specified Size and positioned in the center of the desktop. + /// See also IFMXMultiDisplayService.GetDesktopCenterRect + function GetDesktopCenterRect(const Size: TSizeF): TRectF; + property DisplayCount: Integer read GetDisplayCount; + property Displays[const Index: Integer]: TDisplay read GetDisplay; + function DisplayFromPoint(const Point: TPoint): TDisplay; overload; + function DisplayFromPoint(const Point: TPointF): TDisplay; overload; + function DisplayFromRect(const Rect: TRect): TDisplay; overload; + function DisplayFromRect(const Rect: TRectF): TDisplay; overload; + function DisplayFromForm(const Form: TCommonCustomForm): TDisplay; overload; + function DisplayFromForm(const Form: TCommonCustomForm; const Point: TPoint): TDisplay; overload; + function DisplayFromForm(const Form: TCommonCustomForm; const Point: TPointF): TDisplay; overload; + property DesktopRect: TRectF read GetDesktopRect; + property DesktopTop: Single read GetDesktopTop; + property DesktopLeft: Single read GetDesktopLeft; + property DesktopHeight: Single read GetDesktopHeight; + property DesktopWidth: Single read GetDesktopWidth; + property WorkAreaRect: TRectF read GetWorkAreaRect; + property WorkAreaHeight: Single read GetWorkAreaHeight; + property WorkAreaLeft: Single read GetWorkAreaLeft; + property WorkAreaTop: Single read GetWorkAreaTop; + property WorkAreaWidth: Single read GetWorkAreaWidth; + + property FormCount: Integer read GetFormCount; + property Forms[Index: Integer]: TCommonCustomForm read GetForm; + property DataModuleCount: Integer read GetDataModuleCount; + property DataModules[Index: Integer]: TDataModule read GetDataModule; + + property PopupFormCount: Integer read GetPopupFormCount; + property PopupForms[Index: Integer]: TCommonCustomForm read GetPopupForms; + + function Contains(const AComponent: TComponent): Boolean; + function IsParent(AForm, AParent: TCommonCustomForm): Boolean; + function PrepareClosePopups(const SaveForm: TCommonCustomForm): Boolean; + function ClosePopupForms: Boolean; + + property ActiveForm: TCommonCustomForm read GetActiveForm write SetActiveForm; + property FocusControl: IControl read GetFocusControl; + function GetObjectByTarget(const Target: TObject): TFmxObject; + end; + + { IDesignerForm: Form implementing this interface is part of the designer } + IDesignerForm = interface + ['{5D785E12-F0A8-416B-AC6A-20747833CE5D}'] + end; + +var + Screen: TScreen; + Application: TApplication; + +function ApplicationState: TApplicationState; + +{$IFDEF MSWINDOWS} +procedure FinalizeForms; +{$ENDIF} + +//== UNIT END: FMX.Forms +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Controls.Presentation (from FMX.Controls.Presentation.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +const + PM_BASE = $400; + PM_INIT = PM_BASE + 1; + PM_UNLOAD = PM_BASE + 2; + PM_SET_VISIBLE = PM_BASE + 6; + PM_GET_VISIBLE = PM_BASE + 7; + PM_SET_ABSOLUTE_OPACITY = PM_BASE + 8; + PM_GET_ABSOLUTE_OPACITY = PM_BASE + 9; + PM_SET_SIZE = PM_BASE + 10; + PM_GET_SIZE = PM_BASE + 11; + PM_SET_ABSOLUTE_ENABLED = PM_BASE + 12; + PM_GET_ABSOLUTE_ENABLED = PM_BASE + 13; + PM_SET_CLIP_CHILDREN = PM_BASE + 14; + PM_GET_CLIP_CHILDREN = PM_BASE + 15; + PM_SET_STYLE_LOOKUP = PM_BASE + 16; + PM_GET_STYLE_LOOKUP = PM_BASE + 17; + PM_GET_NATIVE_OBJECT = PM_BASE + 20; + PM_GET_RECOMMEND_SIZE = PM_BASE + 22; + PM_IS_FOCUSED = PM_BASE + 25; + PM_RESET_FOCUS = PM_BASE + 26; + PM_DO_ENTER = PM_BASE + 33; + PM_DO_EXIT = PM_BASE + 34; + PM_REALIGN = PM_BASE + 28; + PM_REFRESH_PARENT = PM_BASE + 29; + PM_PARENT_CHANGED = PM_BASE + 30; + PM_ANCESSTOR_VISIBLE_CHANGED = PM_BASE + 31; + PM_KEYDOWN = PM_BASE + 32; + PM_KEYUP = PM_BASE + 35; + PM_ACTION_CLIENT_CHANGED= PM_BASE + 36; + PM_ACTION_CHANGE = PM_BASE + 37; + PM_APPLY_STYLE_LOOKUP = PM_BASE + 38; + PM_SET_STYLES_DATA = PM_BASE + 39; + PM_GET_STYLES_DATA = PM_BASE + 40; + PM_ABSOLUTE_CHANGED = PM_BASE + 41; + PM_HITTEST_CHANGED = PM_BASE + 42; + PM_GET_ADJUST_TYPE = PM_BASE + 43; + PM_GET_ADJUST_SIZE = PM_BASE + 44; + PM_SET_ADJUST_SIZE = PM_BASE + 45; + PM_NEED_STYLE_LOOKUP = PM_BASE + 46; + PM_ANCESTOR_PRESENTATION_LOADED = PM_BASE + 47; + PM_FIND_STYLE_RESOURCE = PM_BASE + 48; + PM_OBJECT_AT_POINT = PM_BASE + 49; + PM_POINT_IN_OBJECT_LOCAL = PM_BASE + 50; + PM_CHANGE_ORDER = PM_BASE + 51; + PM_START_TRIGGER_ANIMATION = PM_BASE + 52; + PM_APPLY_TRIGGER_EFFECT = PM_BASE + 53; + PM_GET_RESOURCE_LINK = PM_BASE + 54; + PM_SET_ADJUST_TYPE = PM_BASE + 55; + PM_ROOT_CHANGED = PM_BASE + 56; + PM_MOUSE_WHEEL = PM_BASE + 57; + PM_GET_FIRST_CONTROL_WITH_GESTURE = PM_BASE + 58; + PM_ANCESTOR_PRESENTATION_UNLOADING = PM_BASE + 59; + PM_DO_BEFORE_EXIT = PM_BASE + 60; + PM_PAINT_CHILDREN = PM_BASE + 61; + PM_GET_SCENE = PM_BASE + 62; + PM_USER = $1000; + +type + +{ TPresentationProxy } + + /// Information about key pressed by user. Used for sending message from TPresentedControl + /// to presentation + TKeyInfo = record + /// Scan code of the pressed keyboard key, or $0. + Key: Word; + /// Pressed character or digit, or #0. + KeyChar: System.WideChar; + /// Combination of modifier keys that were pressed when the specified key (Key, KeyChar) was pressed. + Shift: TShiftState; + end; + + /// Information about action. Is used for sending message from TPresentedControl to presentation + TActionInfo = record + /// Data of the ASender argument of TPresentedControl.ActionChange. + Sender: TBasicAction; + /// Data of the ACheckDefaults argument of TPresentedControl.ActionChange. + CheckDefaults: Boolean; + end; + + /// Information about requesting style resource from presentation. Used for sending message from + /// TPresentedControl to presentation. The |Resource| is filled by presentation + TFindStyleResourceInfo = record + /// Whether the returned style resource object should be the original style object (False) or a copy of + /// the original (True). + Clone: Boolean; + /// Name of the style resource object to return. + ResourceName: string; + /// Property to hold the returned style resource object. + Resource: TFmxObject; + end; + + /// Information about searching of control at specified point. |Control| contains instance of found + /// the control + TObjectAtPointInfo = record + /// Hit-Test Point. + Point: TPointF; + /// Returned Control if it found. + Control: IControl; + end; + + /// Information about hit-testing point in local control at specified point. + TPointInObjectLocalInfo = record + /// Hit-Test Point. + Point: TPointF; + /// Returned true, if presentation layer contains specified point. + Result: Boolean; + end; + + /// Information used for staring trigger animation or effect. + TTriggerInfo = record + /// Link to Instance object that has triggered property + Instance: TFmxObject; + /// Trigger property name + Trigger: string; + /// Hold application before trigger animation completed + Wait: Boolean; + end; + + /// Information used for transfering mouse wheel event into presentation in design time. + TMouseWheelInfo = record + /// Indicates which shift keys--SHIFT, CTRL, ALT, and CMD (only for Mac)--were down when the pressed + /// mouse button is released. + Shift: TShiftState; + /// Indicates the distance the wheel was rotated. WheelDelta is positive if the mouse was rotated upward, + /// negative if the mouse was rotated downward. + WheelDelta: Integer; + /// Indicates whether the scroll bar was already moved, depending on the WheelDelta value. If one of the + /// scrolls bars (vertical or horizontal) was already handled or it does not exist, MouseWheel tries to apply + /// the rolling on the other scroll bar, if it exists. + Handled: Boolean + end; + + /// Information used for requesting control, which supports specified gestures + TFirstControlWithGestureInfo = record + /// Interactive gestures + Gestures: TInteractiveGesture; + /// Returned control, which supports specified Gestures + Control: TComponent; + end; + + /// Raised, when presentation received a model of the wrong class + EPresentationWrongModel = class(Exception); + + /// Some composit controls like a TListBox, TScrollBox, TMenu and etc, have a + /// special content for storing and moving items. + /// When we embeds native control into native scrollbox, we calculate absolute position of native control by + /// using chain of ancestors until native scrollbox. But we don't need to use TContent in this case, because native + /// TScrollBox already considered offset of content. So for this purpose we need to use this interface. + /// We will add to control this interface for asking them About need to consider its line item in case of + /// computation of absolute coordinates for native controls. + /// + IIgnoreControlPosition = interface + ['{6C5DA960-D0E0-457B-9464-D489034510B7}'] + /// See description of IIgnoreControlPosition + function GetIgnoreControlPosition: Boolean; + end; + + /// Proxy. Mediator. Base class for linking a TPresentatedControl control with a presentation. + /// Successors of it must create presentation in FMX.Presentation.Messages.TMessageSender.CreateReceiver. + /// + TPresentationProxy = class(TMessageSender) + private + FNativeObject: IInterface; + [Weak] FControl: TControl; + [Weak] FModel: TDataModel; + public + /// Default constructor, requests native control by presentation by sending PM_GET_NATIVE_OBJECT + /// message to presentation (Receiver). + constructor Create; override; + /// Initializes proxy by control and model and create link with presentation by using + /// FMX.Presentation.Messages.TMessageSender.CreateReceiver + /// Model instance of |AControl| + /// Control, which supports using of presentation (usually TPresentedControl) + constructor Create(const AModel: TDataModel; const AControl: TControl); overload; virtual; + /// Releases presentation, if presentation was created by using + /// FMX.Presentation.Messages.TMessageSender.CreateReceiver + destructor Destroy; override; + /// Returns True if proxy has native control. Returns False otherwise. + function HasNativeObject: Boolean; + public + /// Returns presented control + property PresentedControl: TControl read FControl; + /// Returns model + property Model: TDataModel read FModel; + /// If presentation has native control, this property will contains reference on Instance of native control. + /// Proxy send request on getting native control by using PM_GET_NATIVE_OBJECT message + /// You can use it for directly access to native control by casting to required type, if presentation uses + /// native control + property NativeObject: IInterface read FNativeObject; + end; + /// Class of TPresentationProxy + TPresentationProxyClass = class of TPresentationProxy; + +{ TPresentedControl } + + /// Event type for choosing presentation name by TPresentedControl + TPresenterNameChoosingEvent = procedure (Sender: TObject; var PresenterName: string) of object; + + /// States of presentation + TPresentationState = (NotLoaded, Loading, Loaded, Unloading); + + ISceneChildrenObserver = interface + ['{FD2EF8F6-EFF5-40EF-84A1-2850C42B3554}'] + procedure ChildWasRemoved(const AChild: TFmxObject); + end; + + /// Control, which supports working with Model and Presentations. Control can has instance of + /// Model for storing data of control. TPresentedControl provide mechanism for choosing, creating, + /// loading, using and unloading presentations. For communication with presentation TPresentedControl uses + /// TPresentationProxy. + TPresentedControl = class(TStyledControl, IMessageSendingCompatible, IControlTypeSupportable, ISceneChildrenObserver) + public type + /// Defines whether the control should use styled or native presentation. This type has been deprecated, + /// and TControlType from "FMX.Controls.pas" unit should be used instead. + TControlType = FMX.Controls.TControlType deprecated 'Use TControlType declared in FMX.Controls.pas'; + private + FModel: TDataModel; + FControlType: TControlType; + FPresentationProxy: TPresentationProxy; + FState: TPresentationState; + FSceneObjects: TFmxObjectList; + FCanUseDefaultPresentation: Boolean; + FOnPresenterNameChoosing: TPresenterNameChoosingEvent; + function GetPresentation: TObject; + function GetPresentationScene: TFmxObject; + function CreateModel: TDataModel; + procedure DoPresentationNameChoosing(var APresentationName: string); + procedure RemoveStyleResource; + { IMessageSendingCompatible } + function GetMessageSender: TMessageSender; + { IControlTypeSupportable } + function GetControlType: TControlType; + procedure SetControlType(const Value: TControlType); + { ISceneChildrenObserver } + procedure ChildWasRemoved(const AChild: TFmxObject); + protected + procedure Loaded; override; + procedure PaintChildren; override; + { Notifications } + /// Notifies about changed ControlType + procedure ControlTypeChanged; virtual; + /// Notifies about changed ClipChildren + procedure ClipChildrenChanged; override; + /// Notifies about changed HitTest + procedure HitTestChanged; override; + { Styles } + function GetDefaultStyleLookupName: string; override; + procedure StyleLookupChanged; override; + procedure StyleDataChanged(const Index: string; const Value: TValue); override; + function RequestStyleData(const Index: string): TValue; override; + function GetResourceLink: TFmxObject; override; + { Controls Tree Structure } + procedure AncestorParentChanged; override; + procedure AncestorVisibleChanged(const AVisible: Boolean); override; + procedure SetVisible(const Value: Boolean); override; + function ObjectAtPoint(P: TPointF): IControl; override; + procedure ChangeOrder; override; + procedure ParentChanged; override; + { Children } + procedure DoAddObject(const AObject: TFmxObject); override; + procedure DoInsertObject(Index: Integer; const AObject: TFmxObject); override; + procedure DoRemoveObject(const AObject: TFmxObject); override; + procedure DoDeleteChildren; override; + procedure DoRootChanged; override; + { Size and Position } + function DoSetSize(const ASize: TControlSize; const NewPlatformDefault: Boolean; ANewWidth, ANewHeight: Single; + var ALastWidth: Single; var ALastHeight: Single): Boolean; override; + procedure DoAbsoluteChanged; override; + procedure DoRealign; override; + /// Defines recommended size for specified size AWishedSize + function RecommendSize(const AWishedSize: TSizeF): TSizeF; virtual; + { Keyboard } + procedure KeyDown(var AKey: Word; var AKeyChar: System.WideChar; AShift: TShiftState); override; + procedure KeyUp(var AKey: Word; var AKeyChar: Char; AShift: TShiftState); override; + { Focus } + procedure DoEnter; override; + procedure DoExit; override; + procedure AfterPaint; override; + { IGestureControl } + function GetFirstControlWithGesture(AGesture: TInteractiveGesture): TComponent; override; + { IAlignableObject } + procedure SetAdjustSizeValue(const Value: TSizeF); override; + function GetAdjustSizeValue: TSizeF; override; + function GetAdjustType: TAdjustType; override; + procedure SetAdjustType(const Value: TAdjustType); override; + { Actions } + procedure ActionChange(ASender: TBasicAction; ACheckDefaults: Boolean); override; + procedure DoActionClientChanged; override; + { Presentations } + /// Returns presentation name for current control. + /// By default presentation name is generated as "ClassName (Without prefix T)"-GetPresentationSuffix + function DefinePresentationName: string; virtual; + /// Returns presentation suffix for DefinePresentationName, which depends on ControlType value. + /// If ControlType equals Styled, return styled + /// If ControlType equals Platform, return native + function GetPresentationSuffix: string; + /// Initializes a presentation through PresentationProxy. Allows users to set custom data for + /// presentation + procedure InitPresentation(APresentation: TPresentationProxy); virtual; + /// Notify all child controls, that AControl changed presentation. + procedure AncestorPresentationLoaded(const AControl: TPresentedControl); + /// Notify all child controls, that AControl is unloading presentation. + procedure AncestorPresentationUnloading(const AControl: TPresentedControl); + { Model } + /// Tries to cast current model to type T. If specified type T is not compatible with + /// Model, return nil. + function GetModel: T; + /// Returns class of controls model. By default it is TDataModel. User can return nil. In this case + /// TPresentedControl will not have Model. + function DefineModelClass: TDataModelClass; virtual; + /// If control cannot find presentation, control will try to load default presentation 'default-' + + /// GetPresentationSuffix only if this property is true. + property CanUseDefaultPresentation: Boolean read FCanUseDefaultPresentation write FCanUseDefaultPresentation; + /// Query interface from current control. If TPresentedControl doesn't support specified interface, it will + /// query it from presentation. + function QueryInterface(const IID: TGUID; out Obj): HRESULT; override; stdcall; + /// Returns native presentation scene, which is used for rendering nested controls. Can be nil. + property PresentationScene: TFmxObject read GetPresentationScene; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function HasPresentationProxy: Boolean; + procedure RecalcEnabled; override; + procedure RecalcOpacity; override; + procedure AfterConstruction; override; + procedure BeforeDestruction; override; + procedure ApplyStyleLookup; override; + procedure NeedStyleLookup; override; + function FindStyleResource(const AStyleLookup: string; const AClone: Boolean = False): TFmxObject; override; + function PointInObjectLocal(X: Single; Y: Single): Boolean; override; + procedure ApplyTriggerEffect(const AInstance: TFmxObject; const ATrigger: string); override; + procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string); override; + procedure StartTriggerAnimationWait(const AInstance: TFmxObject; const ATrigger: string); override; + { Presentations } + /// Finds presentation proxy class from TPresentationProxyFactory, creates instance of presentation + /// proxy and attaches to itself.Also notifies all child controls about new loaded presentation. + /// If current presentation has the same class as a found new a presentation proxy class, this method + /// doesn't replace current presentation. Unloads and releases current presentation otherwise. + procedure LoadPresentation; virtual; + /// Unloads and releases current presentation proxy. + procedure UnloadPresentation; virtual; + /// Unloads existing presentation proxy and tries to load new instead. + procedure ReloadPresentation; + public + property ControlType: TControlType read GetControlType write SetControlType default TControlType.Styled; + /// Returns instance of presentation object + property Presentation: TObject read GetPresentation; + /// Returns intermediary between presentation and PresentedControl. Can be used for sending messages to + /// presentation + property PresentationProxy: TPresentationProxy read FPresentationProxy; + /// State of presentation: NotLoaded, Loading, Loaded or Unloading. + property PresentationState: TPresentationState read FState; + /// Returns instance of control's model + property Model: TDataModel read FModel; + /// Event handler allows to change presentation name. And replace default presentation name on another. It can be used for + /// replacing default FMX presentation on the user's presentation without creating custom component. + property OnPresentationNameChoosing: TPresenterNameChoosingEvent read FOnPresenterNameChoosing write FOnPresenterNameChoosing; + end; + +//== UNIT END: FMX.Controls.Presentation +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.BehaviorManager (from FMX.BehaviorManager.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + IStyleBehavior = interface + ['{665EC261-3E3C-41F1-9964-ADCB39B47662}'] + procedure GetSystemStyle(const Context: TFmxObject; var Style: TFmxObject); + end; + + IDeviceBehavior = interface + ['{820055FF-2005-4160-8751-6BCD492C117E}'] + procedure GetName(const Context: TFmxObject; var DeviceName: string); + function GetDeviceClass(const Context: TFmxObject): TDeviceInfo.TDeviceClass; + /// Returns current device, which's view is selected in IDE + function GetDevice(const Context: TFmxObject): TDeviceInfo; + function GetOSPlatform(const Context: TFmxObject): TOSPlatform; + function GetDisplayMetrics(const Context: TFmxObject): TDeviceDisplayMetrics; + end; + + IOSVersionForStyleBehavior = interface + ['{F55F7580-3E67-4916-8D16-A33AFC171888}'] + procedure GetMajorOSVersion(const Context: TFMXObject; var OSVersion: Integer); + end; + + IFontBehavior = interface + ['{25D83842-FF28-4748-90C0-7E8610141190}'] + procedure GetDefaultFontFamily(const Context: TFmxObject; var FontFamily: string); + procedure GetDefaultFontSize(const Context: TFmxObject; var FontSize: Single); + end; + + IListener = interface + ['{9D325387-E1F1-4B3F-A9FB-BAFF9CE03B8C}'] + procedure GetBehaviorService(const AServiceGUID: TGUID; + var AService: IInterface; const Context: TFmxObject); + procedure SupportsBehaviorService(const AServiceGUID: TGUID; + const Context: TFmxObject; var Found: Boolean); overload; + procedure SupportsBehaviorService(const AServiceGUID: TGUID; + var AService: IInterface; const Context: TFmxObject; var Found: Boolean); overload; + end; + + /// Used by TPresentedControl for getting overlay icon. This icon is used to point that + /// TPresentedControl uses platform presentation (ControlType = Platform) + IPresentedControlBehavior = interface + ['{B98B1B59-C1AF-4D53-8D81-1A429460A11C}'] + /// Returns overlay icon. See description of IPresentedControlBehavior + function GetOverlayIcon: TBitmap; + end; + + TBehaviorServices = class + protected type + TServicesList = TDictionary; + TListenerList = TList; + private + FServicesList: TServicesList; + FListenerList: TListenerList; + function GetServicesList: TServicesList; + function GetListenerList: TListenerList; + private + class var FCurrent: TBehaviorServices; + class destructor DestroyCurrent; + class function GetCurrent: TBehaviorServices; static; + protected + property ServicesList: TServicesList read GetServicesList; + property ListenerList: TListenerList read GetListenerList; + public + destructor Destroy; override; + procedure AddBehaviorListener(const Listener: IListener); + procedure AddBehaviorService(const AServiceGUID: TGUID; const AService: IInterface); + function GetBehaviorService(const AServiceGUID: TGUID; + const Context: TFmxObject): IInterface; + procedure RemoveBehaviorListener(const Listener: IListener); + procedure RemoveBehaviorService(const AServiceGUID: TGUID); + function SupportsBehaviorService(const AServiceGUID: TGUID; + const Context: TFmxObject): Boolean; overload; + function SupportsBehaviorService(const AServiceGUID: TGUID; + out AService; const Context: TFmxObject): Boolean; overload; + class property Current: TBehaviorServices read GetCurrent; + end; + + /// Type of Boolean value, which has third value, which is depended on target platform + TBehaviorBoolean = (True, False, PlatformDefault); + +function BehaviorServices: TBehaviorServices; inline; deprecated 'Use TBehaviorServices.Current'; + +//== UNIT END: FMX.BehaviorManager +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Dialogs (from FMX.Dialogs.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + +{ TCommonDialog } + + TCommonDialog = class(TFmxObject) + private + FHelpContext: THelpContext; + FOnClose: TNotifyEvent; + FOnShow: TNotifyEvent; + protected + procedure DoClose; dynamic; + procedure DoShow; dynamic; + function DoExecute: Boolean; virtual; abstract; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function Execute: Boolean; overload; virtual; + published + property HelpContext: THelpContext read FHelpContext write FHelpContext default 0; + property OnClose: TNotifyEvent read FOnClose write FOnClose; + property OnShow: TNotifyEvent read FOnShow write FOnShow; + end; + +{ TOpenDialog } + + [ComponentPlatformsAttribute(pfidWindows or pfidOSX or pfidLinux)] + TOpenDialog = class(TCommonDialog) + private + FHistoryList: TStrings; + FOptions: TOpenOptions; + FOptionsEx: TOpenOptionsEx; + FFilter: string; + FFilterIndex: Integer; + FInitialDir: string; + FTitle: string; + FDefaultExt: string; + FFileName: TFileName; + FFiles: TStrings; + FOnSelectionChange: TNotifyEvent; + FOnFolderChange: TNotifyEvent; + FOnTypeChange: TNotifyEvent; + FOnCanClose: TCloseQueryEvent; + function GetFileName: TFileName; + function GetFiles: TStrings; + function GetFilterIndex: Integer; + function GetInitialDir: string; + function GetTitle: string; + procedure ReadFileEditStyle(Reader: TReader); + procedure SetFileName(const Value: TFileName); + procedure SetHistoryList(const Value: TStrings); + procedure SetInitialDir(const Value: string); + procedure SetTitle(const Value: string); + protected + function DoCanClose: Boolean; dynamic; + procedure DoSelectionChange; dynamic; + procedure DoFolderChange; dynamic; + procedure DoTypeChange; dynamic; + procedure DefineProperties(Filer: TFiler); override; + function DoExecute: Boolean; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property Files: TStrings read GetFiles; + property HistoryList: TStrings read FHistoryList write SetHistoryList; + published + property DefaultExt: string read FDefaultExt write FDefaultExt; + property FileName: TFileName read GetFileName write SetFileName; + property Filter: string read FFilter write FFilter; + property FilterIndex: Integer read GetFilterIndex write FFilterIndex default 1; + property InitialDir: string read GetInitialDir write SetInitialDir; + property Options: TOpenOptions read FOptions write FOptions + default [TOpenOption.ofHideReadOnly, TOpenOption.ofEnableSizing]; + property OptionsEx: TOpenOptionsEx read FOptionsEx write FOptionsEx default []; + property Title: string read GetTitle write SetTitle; + property OnCanClose: TCloseQueryEvent read FOnCanClose write FOnCanClose; + property OnFolderChange: TNotifyEvent read FOnFolderChange write FOnFolderChange; + property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange; + property OnTypeChange: TNotifyEvent read FOnTypeChange write FOnTypeChange; + end; + +{ TSaveDialog } + + [ComponentPlatformsAttribute(pfidWindows or pfidOSX or pfidLinux)] + TSaveDialog = class(TOpenDialog) + protected + function DoExecute: Boolean; override; + end; + +const + mbYesNo = [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo]; + mbYesNoCancel = [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo, TMsgDlgBtn.mbCancel]; + mbYesAllNoAllCancel = [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbYesToAll, TMsgDlgBtn.mbNo, + TMsgDlgBtn.mbNoToAll, TMsgDlgBtn.mbCancel]; + mbOKCancel = [TMsgDlgBtn.mbOK, TMsgDlgBtn.mbCancel]; + mbAbortRetryIgnore = [TMsgDlgBtn.mbAbort, TMsgDlgBtn.mbRetry, TMsgDlgBtn.mbIgnore]; + mbAbortIgnore = [TMsgDlgBtn.mbAbort, TMsgDlgBtn.mbIgnore]; + + MsgTitles: array[TMsgDlgType] of string = (SMsgDlgWarning, SMsgDlgError, SMsgDlgInformation, SMsgDlgConfirm, ''); + ModalResults: array[TMsgDlgBtn] of Integer = (mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, + mrNoToAll, mrYesToAll, 0, mrClose); + ButtonCaptions: array[TMsgDlgBtn] of string = (SMsgDlgYes, SMsgDlgNo, SMsgDlgOK, SMsgDlgCancel, SMsgDlgAbort, + SMsgDlgRetry, SMsgDlgIgnore, SMsgDlgAll, SMsgDlgNoToAll, SMsgDlgYesToAll, SMsgDlgHelp, SMsgDlgClose); + +type + TInputCloseQueryEvent = procedure(Sender: TObject; const Values: array of string; var CanClose: Boolean) of object; + TInputCloseQueryFunc = reference to function(const Values: array of string): Boolean; + TInputCloseQueryProc = reference to procedure(const AResult: TModalResult; const AValues: array of string); + TInputCloseBoxProc = reference to procedure(const AResult: TModalResult; const AValue: string); + TInputCloseDialogProc = reference to procedure(const AResult: TModalResult); + TInputCloseDialogEvent = procedure(Sender: TObject; const AResult: TModalResult) of object; + TInputCloseQueryWithResultEvent = procedure(Sender: TObject; const AResult: TModalResult; const AValues: array of string) of object; + TInputCloseBoxEvent = procedure(Sender: TObject; const AResult: TModalResult; const AValue: string) of object; + +/// Message dialogs must be shown in the UI thread. This procedure chacks that and raises an exception if is not in the UI thread. +procedure MessageDialogCheckInUIThread; + +function MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext): Integer; overload; inline; deprecated 'Use FMX.DialogService methods'; +procedure MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const ACloseDialogProc: TInputCloseDialogProc); overload; inline; deprecated 'Use FMX.DialogService methods'; +procedure MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const ACloseDialogEvent: TInputCloseDialogEvent; const AContext: TObject = nil); overload; inline; + deprecated 'Use FMX.DialogService methods'; + +function MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const ADefaultButton: TMsgDlgBtn): Integer; overload; inline; deprecated 'Use FMX.DialogService methods'; +procedure MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const ADefaultButton: TMsgDlgBtn; + const ACloseDialogProc: TInputCloseDialogProc); overload; inline; deprecated 'Use FMX.DialogService methods'; +procedure MessageDlg(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const ADefaultButton: TMsgDlgBtn; const ACloseDialogEvent: TInputCloseDialogEvent; + const AContext: TObject = nil); overload; inline; deprecated 'Use FMX.DialogService methods'; + +function MessageDlgPos(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const AX, AY: Integer): Integer; overload; inline; deprecated 'Use FMX.DialogService methods'; +procedure MessageDlgPos(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const AX, AY: Integer; const ACloseDialogProc: TInputCloseDialogProc); overload; inline; + deprecated 'Use FMX.DialogService methods'; +procedure MessageDlgPos(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const AX, AY: Integer; const ACloseDialogEvent: TInputCloseDialogEvent; + const AContext: TObject = nil); overload; inline; deprecated 'Use FMX.DialogService methods'; + +function MessageDlgPos(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const AX, AY: Integer; const ADefaultButton: TMsgDlgBtn): Integer; overload; inline; + deprecated 'Use FMX.DialogService methods'; +procedure MessageDlgPos(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const AX, AY: Integer; const ADefaultButton: TMsgDlgBtn; + const ACloseDialogProc: TInputCloseDialogProc); overload; inline; deprecated 'Use FMX.DialogService methods'; +procedure MessageDlgPos(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const AX, AY: Integer; const ADefaultButton: TMsgDlgBtn; + const ACloseDialogEvent: TInputCloseDialogEvent; const AContext: TObject = nil); overload; inline; + deprecated 'Use FMX.DialogService methods'; + +function MessageDlgPosHelp(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const AX, AY: Integer; const AHelpFileName: string): Integer; overload; + deprecated 'Use FMX.DialogService methods'; +procedure MessageDlgPosHelp(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const AX, AY: Integer; const AHelpFileName: string; + const ACloseDialogProc: TInputCloseDialogProc); overload; deprecated 'Use FMX.DialogService methods'; +procedure MessageDlgPosHelp(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const AX, AY: Integer; const AHelpFileName: string; + const ACloseDialogEvent: TInputCloseDialogEvent; const AContext: TObject = nil); overload; + deprecated 'Use FMX.DialogService methods'; + +function MessageDlgPosHelp(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const AX, AY: Integer; const AHelpFileName: string; + const ADefaultButton: TMsgDlgBtn): Integer; overload; deprecated 'Use FMX.DialogService methods'; +procedure MessageDlgPosHelp(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const AX, AY: Integer; const AHelpFileName: string; + const ADefaultButton: TMsgDlgBtn; const ACloseDialogProc: TInputCloseDialogProc); overload; + deprecated 'Use FMX.DialogService methods'; +procedure MessageDlgPosHelp(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const AHelpContext: THelpContext; const AX, AY: Integer; const AHelpFileName: string; + const ADefaultButton: TMsgDlgBtn; const ACloseDialogEvent: TInputCloseDialogEvent; const AContext: TObject = nil); overload; + deprecated 'Use FMX.DialogService methods'; + +procedure ShowMessage(const AMessage: string); +procedure ShowMessageFmt(const AMessage: string; const AParams: array of const); +procedure ShowMessagePos(const AMessage: string; const AX, AY: Integer); deprecated 'Use FMX.DialogService methods'; + +function SelectDirectory(const Caption: string; const Root: string; + var Directory: string): Boolean; + +{ Input dialog } + +function InputBox(const ACaption, APrompt, ADefault: string): string; overload; deprecated 'Use FMX.DialogService methods'; +procedure InputBox(const ACaption, APrompt, ADefault: string; const ACloseBoxProc: TInputCloseBoxProc); overload; + deprecated 'Use FMX.DialogService methods'; +procedure InputBox(const ACaption, APrompt, ADefault: string; const ACloseBoxEvent: TInputCloseBoxEvent; + const AContext: TObject = nil); overload; deprecated 'Use FMX.DialogService methods'; + +function InputQuery(const ACaption: string; const APrompts: array of string; var AValues: array of string; + const ACloseQueryFunc: TInputCloseQueryFunc = nil): Boolean; overload; deprecated 'Use FMX.DialogService methods'; +function InputQuery(const ACaption: string; const APrompts: array of string; var AValues: array of string; + const ACloseQueryEvent: TInputCloseQueryEvent; const AContext: TObject = nil): Boolean; overload; deprecated 'Use FMX.DialogService methods'; +function InputQuery(const ACaption, APrompt: string; var Value: string): Boolean; overload; deprecated 'Use FMX.DialogService methods'; + +procedure InputQuery(const ACaption: string; const APrompts: array of string; const ADefaultValues: array of string; + const ACloseQueryProc: TInputCloseQueryProc); overload; deprecated 'Use FMX.DialogService methods'; +procedure InputQuery(const ACaption: string; const APrompts: array of string; const ADefaultValues: array of string; + const ACloseQueryEvent: TInputCloseQueryWithResultEvent; const AContext: TObject = nil); overload; + deprecated 'Use FMX.DialogService methods'; +procedure InputQuery(const ACaption, APrompt, ADefaultValue: string; const ACloseBoxProc: TInputCloseBoxProc); overload; + deprecated 'Use FMX.DialogService methods'; +procedure InputQuery(const ACaption, APrompt, ADefaultValue: string; + const ACloseQueryEvent: TInputCloseQueryWithResultEvent; const AContext: TObject = nil); overload; + deprecated 'Use FMX.DialogService methods'; + +{ Localization } + +function LocalizedButtonCaption(const AButton: TMsgDlgBtn): string; inline; +function LocalizedMessageDialogTitle(const ADialogType: TMsgDlgType): string; inline; + +//== UNIT END: FMX.Dialogs +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Platform (from FMX.Platform.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + EInvalidFmxHandle = class(Exception); + EUnsupportedPlatformService = class(Exception) + constructor Create(const Msg: string); + end; + EUnsupportedOSVersion = class(Exception); + + TPlatformServices = class + private + FServicesList: TDictionary; + FGlobalFlags: TDictionary; + class var FCurrent: TPlatformServices; + class var FCurrentReleased: Boolean; + class procedure ReleaseCurrent; + class function GetCurrent: TPlatformServices; static; + public + constructor Create; + destructor Destroy; override; + procedure AddPlatformService(const AServiceGUID: TGUID; const AService: IInterface); + procedure RemovePlatformService(const AServiceGUID: TGUID); + function GetPlatformService(const AServiceGUID: TGUID): IInterface; + function SupportsPlatformService(const AServiceGUID: TGUID): Boolean; overload; + function SupportsPlatformService(const AServiceGUID: TGUID; out AService): Boolean; overload; + property GlobalFlags: TDictionary read FGlobalFlags; + class property Current: TPlatformServices read GetCurrent; + end; + + IFMXApplicationService = interface + ['{EFBE3310-D103-4E9E-A8E1-4E45AB46D0D8}'] + procedure Run; + function HandleMessage: Boolean; + procedure WaitMessage; + function GetDefaultTitle: string; + function GetTitle: string; + procedure SetTitle(const Value: string); + /// Gets a string representing the version number of the application + function GetVersionString: string; + procedure Terminate; + function Terminating: Boolean; + function Running: Boolean; + + property DefaultTitle: string read GetDefaultTitle; + property Title: string read GetTitle write SetTitle; + /// Returns the version of the application as specified in Project/Options + property AppVersion: string read GetVersionString; + end; + + { Application events } + + TApplicationEvent = (FinishedLaunching, BecameActive, WillBecomeInactive, EnteredBackground, WillBecomeForeground, WillTerminate, LowMemory, TimeChange, OpenURL); + + TApplicationEventHelper = record helper for TApplicationEvent + const + aeFinishedLaunching = TApplicationEvent.FinishedLaunching deprecated 'Use TApplicationEvent.FinishedLaunching'; + aeBecameActive = TApplicationEvent.BecameActive deprecated 'Use TApplicationEvent.BecameActive'; + aeWillBecomeInactive = TApplicationEvent.WillBecomeInactive deprecated 'Use TApplicationEvent.WillBecomeInactive'; + aeEnteredBackground = TApplicationEvent.EnteredBackground deprecated 'Use TApplicationEvent.EnteredBackground'; + aeWillBecomeForeground = TApplicationEvent.WillBecomeForeground deprecated 'Use TApplicationEvent.WillBecomeForeground'; + aeWillTerminate = TApplicationEvent.WillTerminate deprecated 'Use TApplicationEvent.WillTerminate'; + aeLowMemory = TApplicationEvent.LowMemory deprecated 'Use TApplicationEvent.LowMemory'; + aeTimeChange = TApplicationEvent.TimeChange deprecated 'Use TApplicationEvent.TimeChange'; + aeOpenURL = TApplicationEvent.OpenURL deprecated 'Use TApplicationEvent.OpenURL'; + end; + + TApplicationEventData = record + Event: TApplicationEvent; + Context: TObject; + constructor Create(const AEvent: TApplicationEvent; AContext: TObject); + end; + TApplicationEventMessage = class (System.Messaging.TMessage) + public + constructor Create(const AData: TApplicationEventData); + end; + + TApplicationEventHandler = function (AAppEvent: TApplicationEvent; AContext: TObject): Boolean of object; + + IFMXApplicationEventService = interface(IInterface) + ['{F3AAF11A-1678-4CC6-A5BF-721A24A676FD}'] + procedure SetApplicationEventHandler(AEventHandler: TApplicationEventHandler); + end; + + { Application appearance } + + /// System theme type. + TSystemThemeKind = (Unspecified, Light, Dark); + /// System color type. + TSystemColorType = (Accent); + + /// Operation system appearance information. + TSystemAppearance = class + private + function GetSystemColor(const Index: TSystemColorType): TAlphaColor; + function GetThemeKind: TSystemThemeKind; + public + /// System accent color, usually used for emphasis controls elements. + property AccentColor: TAlphaColor index TSystemColorType.Accent read GetSystemColor; + /// System theme kind. + property ThemeKind: TSystemThemeKind read GetThemeKind; + end; + + /// Notification about changing operation system appearance. + TSystemAppearanceChangedMessage = class(TObjectMessage); + + /// Service provides information about operation system theme. + IFMXSystemAppearanceService = interface + ['{AB6A83D9-0118-4C5F-95CC-351DBB5EA943}'] + /// Returns system theme kind. + function GetSystemThemeKind: TSystemThemeKind; + /// Returns system color for specified type. + function GetSystemColor(const AType: TSystemColorType): TAlphaColor; + /// System theme kind. + property ThemeKind: TSystemThemeKind read GetSystemThemeKind; + end; + + { Application hide service } + + IFMXHideAppService = interface(IInterface) + ['{D9E49FCB-6A8B-454C-B11A-CEB3CEFAD357}'] + function GetHidden: Boolean; + procedure SetHidden(const Value: Boolean); + procedure HideOthers; + property Hidden: Boolean read GetHidden write SetHidden; + end; + + TDeviceFeature = (HasTouchScreen); + TDeviceFeatures = set of TDeviceFeature; + + IFMXDeviceService = interface(IInterface) + ['{9419B3C0-379A-4556-B5CA-36C975462326}'] + function GetModel: string; + function GetFeatures: TDeviceFeatures; + function GetDeviceClass: TDeviceInfo.TDeviceClass; + end; + + IFMXDeviceMetricsService = interface(IInterface) + ['{CCC4D351-BA3A-4884-B4F6-4F020600F15F}'] + function GetDisplayMetrics: TDeviceDisplayMetrics; + end; + + IFMXDragDropService = interface(IInterface) + ['{73133536-5868-44B6-B02D-7364F75FAD0E}'] + procedure BeginDragDrop(AForm: TCommonCustomForm; const Data: TDragObject; ABitmap: TBitmap); + end; + + IFMXClipboardService = interface(IInterface) + ['{CC9F70B3-E5AE-4E01-A6FB-E3FC54F5C54E}'] + /// + /// Gets current clipboard value + /// + function GetClipboard: TValue; + /// + /// Sets new clipboard value + /// + procedure SetClipboard(Value: TValue); + end; + + IFMXScreenService = interface(IInterface) + ['{BBA246B6-8DEF-4490-9D9C-D2CBE6251A24}'] + /// Returns logical size (dp) of primary monitor. + function GetScreenSize: TPointF; + /// Returns scale of primary monitor. + function GetScreenScale: Single; + /// Returns current screen orientation. + /// It's not applicable for desktop platforms. + function GetScreenOrientation: TScreenOrientation; + procedure SetSupportedScreenOrientations(const AOrientations: TScreenOrientations); + end; + + IFMXMultiDisplayService = interface(IInterface) + ['{133A6050-AC29-4233-9EE2-D49082C33BBF}'] + /// Returns count of displays in system. + function GetDisplayCount: Integer; + /// Returns region on main screen allocated for showing application (dp). + function GetWorkAreaRect: TRectF; + /// Returns region on main screen allocated for showing application (px). + function GetPhysicalWorkAreaRect: TRect; + /// Returns union of all displays (dp). + function GetDesktopRect: TRectF; + /// Returns union of all displays (px). + function GetPhysicalDesktopRect: TRect; + /// Returns display information by specified display index. + function GetDisplay(const Index: Integer): TDisplay; + /// Returns a rectangle having the specified Size and positioned in the center of desktop. + function GetDesktopCenterRect(const Size: TSizeF): TRectF; + /// Refreshes current information about all displays in system. + procedure UpdateDisplayInformation; + property DisplayCount: Integer read GetDisplayCount; + property WorkAreaRect: TRectF read GetWorkAreaRect; + property DesktopRect: TRectF read GetDesktopRect; + property PhysicalWorkAreaRect: TRect read GetPhysicalWorkAreaRect; + property PhysicalDesktopRect: TRect read GetPhysicalDesktopRect; + property Displays[const Index: Integer]: TDisplay read GetDisplay; + /// Returns display, which is related with specified form AHandle. + function DisplayFromWindow(const Handle: TWindowHandle): TDisplay; + /// Returns display, which is related with specified form AHandle and APoint. + /// Form can be placed on two displays at the same time (on a border of two displays), but not on iOS. + /// So APoint parameter is not supported on iOS. It works like a DisplayFromWindow. + function DisplayFromPoint(const Handle: TWindowHandle; const Point: TPoint): TDisplay; + end; + + IFMXLocaleService = interface(IInterface) + ['{311A40D4-3D5B-40CC-A201-78465760B25E}'] + function GetCurrentLangID: string; + /// Returns first day of week in current locale. + /// Result is platform depended. Each platform counts Monday by different int number. + function GetLocaleFirstDayOfWeek: string; deprecated 'Use GetFirstWeekday instead'; + /// Returns first day of week in current locale. + /// Result is platform-independent value. 1 - Monday + function GetFirstWeekday: Byte; + end; + + IFMXDialogService = interface(IInterface) + ['{CF7DCC1C-B5D6-4B24-92E7-1D09768E2D6B}'] + function DialogOpenFiles(const ADialog: TOpenDialog; var AFiles: TStrings; AType: TDialogType = TDialogType.Standard): Boolean; + function DialogPrint(var ACollate, APrintToFile: Boolean; + var AFromPage, AToPage, ACopies: Integer; AMinPage, AMaxPage: Integer; var APrintRange: TPrintRange; + AOptions: TPrintDialogOptions): Boolean; + function PageSetupGetDefaults(var AMargin, AMinMargin: TRect; var APaperSize: TPointF; + AUnits: TPageMeasureUnits; AOptions: TPageSetupDialogOptions): Boolean; + function DialogPageSetup(var AMargin, AMinMargin: TRect; var APaperSize: TPointF; + var AUnits: TPageMeasureUnits; AOptions: TPageSetupDialogOptions): Boolean; + function DialogSaveFiles(const ADialog: TOpenDialog; var AFiles: TStrings): Boolean; + function DialogPrinterSetup: Boolean; + function MessageDialog(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const ADefaultButton: TMsgDlgBtn; const AX, AY: Integer; const AHelpCtx: THelpContext; + const AHelpFileName: string): Integer; overload; deprecated 'Use FMX.DialogService methods'; + procedure MessageDialog(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const ADefaultButton: TMsgDlgBtn; const AX, AY: Integer; const AHelpCtx: THelpContext; const AHelpFileName: string; + const ACloseDialogProc: TInputCloseDialogProc); overload; deprecated 'Use FMX.DialogService methods'; + function InputQuery(const ACaption: string; const APrompts: array of string; + var AValues: array of string; const ACloseQueryFunc: TInputCloseQueryFunc = nil): Boolean; overload; + deprecated 'Use FMX.DialogService methods'; + procedure InputQuery(const ACaption: string; const APrompts, ADefaultValues: array of string; + const ACloseQueryProc: TInputCloseQueryProc); overload; deprecated 'Use FMX.DialogService methods'; + end; + + /// Interface for Synchronous message dialogs and input queries. See TDialogServiceSync for more information. + /// Android does not support this inteface. + IFMXDialogServiceSync = interface(IInterface) + ['{7E6B3966-C08E-466F-B4A0-7996A1C3BA04}'] + /// Show a simple message box with an 'Ok' button to close it. + procedure ShowMessageSync(const AMessage: string); + /// Shows custom message dialog with specified buttons on it. + function MessageDialogSync(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const ADefaultButton: TMsgDlgBtn; const AHelpCtx: THelpContext): Integer; + /// Shows an input message dialog with the specified promps and values on it. Values are modified within it. + function InputQuerySync(const ACaption: string; const APrompts: array of string; var AValues: array of string): Boolean; overload; + end; + + /// Interface for Asynchronous message dialogs and input queries. + IFMXDialogServiceAsync = interface(IInterface) + ['{BB65E682-1F27-42E1-90DE-6FA006E09EA5}'] + /// Show a simple message box with an 'Ok' button to close it. + procedure ShowMessageAsync(const AMessage: string); overload; + /// Show a simple message box with an 'Ok' button to close it. + procedure ShowMessageAsync(const AMessage: string; const ACloseDialogProc: TInputCloseDialogProc); overload; + /// Show a simple message box with an 'Ok' button to close it. + procedure ShowMessageAsync(const AMessage: string; const ACloseDialogEvent: TInputCloseDialogEvent; + const AContext: TObject = nil); overload; + + /// Shows custom message dialog with specified buttons on it. + procedure MessageDialogAsync(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const ADefaultButton: TMsgDlgBtn; const AHelpCtx: THelpContext; const ACloseDialogProc: TInputCloseDialogProc); overload; + /// Shows custom message dialog with specified buttons on it. + procedure MessageDialogAsync(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons; + const ADefaultButton: TMsgDlgBtn; const AHelpCtx: THelpContext; const ACloseDialogEvent: TInputCloseDialogEvent; + const AContext: TObject = nil); overload; + + /// Shows an input message dialog with the specified promps and values on it. Values are modified within it. + procedure InputQueryAsync(const ACaption: string; const APrompts: array of string; const ADefaultValues: array of string; + const ACloseDialogProc: TInputCloseQueryProc); overload; + /// Shows an input message dialog with the specified promps and values on it. Values are modified within it. + procedure InputQueryAsync(const ACaption: string; const APrompts: array of string; const ADefaultValues: array of string; + const ACloseQueryEvent: TInputCloseQueryWithResultEvent; const AContext: TObject = nil); overload; + end; + + IFMXLoggingService = interface(IInterface) + ['{01BFC200-0493-4b3b-9D7E-E3CDB1242795}'] + procedure Log(const AFormat: string; const AParams: array of const); + end; + + IFMXTextService = interface(IInterface) + ['{A5FECE29-9A9C-4E8A-8794-89271EC71F1A}'] + function GetTextServiceClass: TTextServiceClass; + end; + + IFMXCanvasService = interface(IInterface) + ['{476E5E53-A77A-4ADA-93E3-CA66A8956059}'] + procedure RegisterCanvasClasses; + procedure UnregisterCanvasClasses; + end; + + IFMXContextService = interface(IInterface) + ['{EB6C9074-48B9-4A99-ABF4-BFB6FCF9C385}'] + procedure RegisterContextClasses; + procedure UnregisterContextClasses; + end; + + IFMXGestureRecognizersService = interface(IInterface) + ['{5EFE3EC8-FF73-4275-A52A-43B3FCC628D8}'] + procedure AddRecognizer(const ARec: TInteractiveGesture; const AForm: TCommonCustomForm); + procedure RemoveRecognizer(const ARec: TInteractiveGesture; const AForm: TCommonCustomForm); + end; + + /// Reference to a procedure (an anonymous method) that the rendering + /// setup platform service uses to update rendering parameters. + TRenderingSetupCallback = reference to procedure(const Sender, Context: TObject; var ColorBits, DepthBits: Integer; + var Stencil: Boolean; var Multisamples: Integer); + + /// Platform service that provides a mechanism to override Direct3D + /// and OpenGL rendering parameters, which are set before the actual window is + /// created. + IFMXRenderingSetupService = interface(IInterface) + ['{CFF9D71C-5188-422F-BE5F-DC968D1BFD02}'] + /// Subscribes callback function to be invoked when Direct3D and OpenGL rendering parameters are being + /// configured. + /// Callback function to be registered. + /// User-defined context parameter, which will be passed to callback function upon + /// invocation. + procedure Subscribe(const Callback: TRenderingSetupCallback; const Context: TObject = nil); + /// Removes currently subscribed callback from registry. + procedure Unsubscribe; + /// Invokes the callback function to configure Direct3D and OpenGL rendering parameters. Before the + /// callback is invoked, parameters are set to some default values; they are also validated and corrected as needed + /// after invocation. + procedure Invoke(var ColorBits, DepthBits: Integer; var Stencil: Boolean; var Multisamples: Integer); + end; + + IFMXWindowsTouchService = interface(IInterface) + ['{216EFB8E-6275-4AE3-BC82-85BEC00C3F5B}'] + procedure HookTouchHandler(const AForm: TCommonCustomForm); + procedure UnhookTouchHandler(const AForm: TCommonCustomForm); + end; + +{ Listing service (ListBox / ListView) } + + TListingHeaderBehavior = (Sticky); + TListingHeaderBehaviors = set of TListingHeaderBehavior; + + TListingSearchFeature = (StayOnTop, AsFirstItem); + TListingSearchFeatures = set of TListingSearchFeature; + + TListingTransitionFeature = (EditMode, DeleteButtonSlide, PullToRefresh, ScrollGlow); + TListingTransitionFeatures = set of TListingTransitionFeature; + + TListingEditModeFeature = (Delete); + TListingEditModeFeatures = set of TListingEditModeFeature; + + IFMXListingService = interface(IInterface) + ['{942C2800-D66E-4094-9B77-BA88A1FBC788}'] + function GetHeaderBehaviors: TListingHeaderBehaviors; + function GetSearchFeatures: TListingSearchFeatures; + function GetTransitionFeatures: TListingTransitionFeatures; + function GetEditModeFeatures: TListingEditModeFeatures; + end; + + IFMXSaveStateService = interface + ['{34CB784A-E262-4E2C-B3B6-C3A41B722D7A}'] + function GetBlock(const ABlockName: string; const ABlockData: TStream): Boolean; + function SetBlock(const ABlockName: string; const ABlockData: TStream): Boolean; + function GetStoragePath: string; + procedure SetStoragePath(const ANewPath: string); + function GetNotifications: Boolean; + property Notifications: Boolean read GetNotifications; + end; + +{ System Information service } + + TScrollingBehaviour = (BoundsAnimation, Animation, TouchTracking, AutoShowing); + + TScrollingBehaviourHelper = record helper for TScrollingBehaviour + const + sbBoundsAnimation = TScrollingBehaviour.BoundsAnimation deprecated 'Use TScrollingBehaviour.BoundsAnimation'; + sbAnimation = TScrollingBehaviour.Animation deprecated 'Use TScrollingBehaviour.Animation'; + sbTouchTracking = TScrollingBehaviour.TouchTracking deprecated 'Use TScrollingBehaviour.TouchTracking'; + sbAutoShowing = TScrollingBehaviour.AutoShowing deprecated 'Use TScrollingBehaviour.AutoShowing'; + end; + TScrollingBehaviours = set of TScrollingBehaviour; + + IFMXSystemInformationService = interface(IInterface) + ['{2E01A60B-E297-4AC0-AA24-C5F52289EC1E}'] + { Scrolling information } + function GetScrollingBehaviour: TScrollingBehaviours; + function GetMinScrollThumbSize: Single; + { Caret information } + function GetCaretWidth: Integer; + { Menu information } + function GetMenuShowDelay: Integer; + end; + + IFMXListViewPresentationService = interface + ['{2D5DA8DF-BC91-4956-93BA-F4BCE5FB38A0}'] + function AttachPresentation(const Parent: IInterface): IInterface; + procedure DetachPresentation(const Parent: IInterface); + end; + + TComponentKind = (Button, &Label, Edit, ScrollBar, ListBoxItem, RadioButton, CheckBox, Calendar); + + TComponentKindHelper = record helper for TComponentKind + const + ckButton = TComponentKind.Button deprecated 'Use TComponentKind.Button'; + ckLabel = TComponentKind.Label deprecated 'Use TComponentKind.Label'; + ckEdit = TComponentKind.Edit deprecated 'Use TComponentKind.Edit'; + ckScrollBar = TComponentKind.ScrollBar deprecated 'Use TComponentKind.ScrollBar'; + ckListBoxItem = TComponentKind.ListBoxItem deprecated 'Use TComponentKind.ListBoxItem'; + ckRadioButton = TComponentKind.RadioButton deprecated 'Use TComponentKind.RadioButton'; + ckCheckBox = TComponentKind.CheckBox deprecated 'Use TComponentKind.CheckBox'; + end; + + { Default metrics } + + IFMXDefaultMetricsService = interface(IInterface) + ['{216841F5-C089-45F1-B350-E9B018B73441}'] + function SupportsDefaultSize(const AComponent: TComponentKind): Boolean; + function GetDefaultSize(const AComponent: TComponentKind): TSize; + end; + + { Platform-specific property defaults } + + IFMXDefaultPropertyValueService = interface(IInterface) + ['{7E8A25A0-5FCF-49FA-990C-CEDE6ABEAE50}'] + function GetDefaultPropertyValue(const AClassName: string; const APropertyName: string): TValue; + end deprecated 'Use FMX.Platform.Metrics.IFMXPlatformPropertiesService.GetValue instead'; + + TCaretBehavior = (DisableCaretInsideWords); + TCaretBehaviors = set of TCaretBehavior; + + IFMXTextEditingService = interface(IInterface) + ['{E6CF2889-1403-4853-AFF5-F69DEE8301C1}'] + function GetCaretBehaviors: TCaretBehaviors; + end deprecated 'Use FMX.Platform.Metrics.IFMXPlatformPropertiesService.GetValue(''DisableCaretInsideWords'') instead'; + + { Push notification messages } + + TPushNotificationData = record + Notification: string; + constructor Create(const ANotification: string); + end; + TPushNotificationMessageBase = class (System.Messaging.TMessage); + + TPushStartupNotificationMessage = class (TPushNotificationMessageBase); + TPushRemoteNotificationMessage = class (TPushNotificationMessageBase); + + /// Data associated to the TPushDeviceTokenMessage message type. + /// Used only for the iOS platform. + TPushDeviceTokenData = record + /// Device token. + Token: string; + /// Handle to the NSData object (from the Objective-C side) that stores the device token. + RawToken: Pointer; + constructor Create(const AToken: string; ARawToken: Pointer = nil); + end; + TPushDeviceTokenMessage = class (System.Messaging.TMessage); + + TPushFailToRegisterData = record + ErrorMessage: string; + constructor Create(const AErrorMessage: string); + end; + TPushFailToRegisterMessage = class (System.Messaging.TMessage); + +//== UNIT END: FMX.Platform +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Objects (from FMX.Objects.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + +{ TShape } + + TShape = class(TControl) + private + FFill: TBrush; + FStroke: TStrokeBrush; + procedure SetFill(const Value: TBrush); + procedure SetStroke(const Value: TStrokeBrush); + protected + procedure Painting; override; + procedure FillChanged(Sender: TObject); virtual; + procedure StrokeChanged(Sender: TObject); virtual; + function GetShapeRect: TRectF; + function DoGetUpdateRect: TRectF; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property Fill: TBrush read FFill write SetFill; + property Stroke: TStrokeBrush read FStroke write SetStroke; + property ShapeRect: TRectF read GetShapeRect; + end; + +{ TLine } + + TLineType = (Diagonal, Top, Left, Bottom, Right); + + /// Specifies the way a line is drawn. + TLineLocation = (Boundary, Inner, InnerWithin); + + TLine = class(TShape) + private + FLineType: TLineType; + FShortenLine: Boolean; + FLineLocation: TLineLocation; + procedure SetLineType(const Value: TLineType); + procedure SetShortenLine(const AValue: Boolean); + procedure SetLineLocation(const AValue: TLineLocation); + protected + function DoGetUpdateRect: TRectF; override; + function IsControlRectEmpty: Boolean; override; + public + constructor Create(AOwner: TComponent); override; + procedure Paint; override; + published + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled default True; + property Locked default False; + property Height; + property Hint; + property HitTest default True; + /// Location of th drawing line, see TLineLocation for more information. + property LineLocation: TLineLocation read FLineLocation write SetLineLocation default TLineLocation.Boundary; + property LineType: TLineType read FLineType write SetLineType; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + /// If True, the line will be shortened its thickness divided by two. + property ShortenLine: Boolean read FShortenLine write SetShortenLine default False; + property Size; + property Stroke; + property Visible default True; + property Width; + property ParentShowHint; + property ShowHint; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Mouse events} + property OnClick; + property OnDblClick; + + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TRectangle } + + TRectangle = class(TShape) + private + FYRadius: Single; + FXRadius: Single; + FCorners: TCorners; + FCornerType: TCornerType; + FSides: TSides; + function IsCornersStored: Boolean; + function IsSidesStored: Boolean; + protected + procedure SetXRadius(const Value: Single); virtual; + procedure SetYRadius(const Value: Single); virtual; + procedure SetCorners(const Value: TCorners); virtual; + procedure SetCornerType(const Value: TCornerType); virtual; + procedure SetSides(const Value: TSides); virtual; + procedure Paint; override; + public + constructor Create(AOwner: TComponent); override; + published + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property Corners: TCorners read FCorners write SetCorners + stored IsCornersStored; + property CornerType: TCornerType read FCornerType write SetCornerType + default TCornerType.Round; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled default True; + property Fill; + property Locked default False; + property Height; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Sides: TSides read FSides write SetSides stored IsSidesStored; + property Size; + property Stroke; + property Visible default True; + property XRadius: Single read FXRadius write SetXRadius; + property YRadius: Single read FYRadius write SetYRadius; + property Width; + property ParentShowHint; + property ShowHint; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Mouse events} + property OnClick; + property OnDblClick; + + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + + TCaretRectangle = class(TRectangle, IFlasher) + private + FFlashTimer: TTimer; + [weak]FCaret: TCustomCaret; + FColor: TAlphaColor; + FPos: TPointF; + FSize: TSizeF; + FInterval: TFlasherInterval; + FSystemInformation: IFMXSystemInformationService; + procedure FlashTimerProc(Sender: TObject); + function GetColor: TAlphaColor; + function GetPos: TPointF; + function GetSize: TSizeF; + { IFlasher } + function GetInterval: TFlasherInterval; + function GetCaret: TCustomCaret; + function GetOpacity: Single; + procedure SetCaret(const Value: TCustomCaret); + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + function GetVisible: Boolean; override; + function DefaultWidth: Integer; virtual; + function DefaultColor: TAlphaColor; virtual; + function UseFontColor: Boolean; virtual; + function DefaultInterval: TFlasherInterval; virtual; + function GetDefaultSize: TSizeF; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure UpdateState; + property Caret: TCustomCaret read GetCaret write SetCaret; + end; + +{ TRoundRect } + + TRoundRect = class(TShape) + private + FCorners: TCorners; + function IsCornersStored: Boolean; + protected + procedure SetCorners(const Value: TCorners); virtual; + procedure Paint; override; + public + constructor Create(AOwner: TComponent); override; + published + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property Corners: TCorners read FCorners write SetCorners stored IsCornersStored; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled default True; + property Fill; + property Locked default False; + property Height; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property Stroke; + property Visible default True; + property Width; + property ParentShowHint; + property ShowHint; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Mouse events} + property OnClick; + property OnDblClick; + + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TCalloutRectangle } + + TCalloutPosition = (Top, Left, Bottom, Right); + + TCalloutRectangle = class(TRectangle) + private + FPath: TPathData; + FFillPath: TPathData; + FCalloutWidth: Single; + FCalloutLength: Single; + FCalloutPosition: TCalloutPosition; + FCalloutOffset: Single; + procedure SetCalloutWidth(const Value: Single); + procedure SetCalloutLength(const Value: Single); + procedure SetCalloutPosition(const Value: TCalloutPosition); + procedure SetCalloutOffset(const Value: Single); + protected + procedure RebuildPaths; + { inherited } + procedure SetXRadius(const Value: Single); override; + procedure SetYRadius(const Value: Single); override; + procedure SetCorners(const Value: TCorners); override; + procedure SetCornerType(const Value: TCornerType); override; + procedure SetSides(const Value: TSides); override; + procedure Resize; override; + procedure Loaded; override; + { Building Path } + function GetCalloutRectangleRect: TRectF; + procedure AddCalloutToPath(APath: TPathData; const ARect: TRectF; const ACornerRadiuses: TSizeF); + procedure AddRoundCornerToPath(APath: TPathData; const ARect: TRectF; const ACornerSize: TSizeF; const ACorner: TCorner); + procedure AddRectCornerToPath(APath: TPathData; const ARect: TRectF; const ACornerSize: TSizeF; const ACorner: TCorner; + const ASkipEmptySide: Boolean = True); + procedure CreatePath; + procedure CreateFillPath; + { Painting } + procedure Paint; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Fill; + property CalloutWidth: Single read FCalloutWidth write SetCalloutWidth; + property CalloutLength: Single read FCalloutLength write SetCalloutLength; + property CalloutPosition: TCalloutPosition read FCalloutPosition write SetCalloutPosition + default TCalloutPosition.Top; + property CalloutOffset: Single read FCalloutOffset write SetCalloutOffset; + property Stroke; + end; + +{ TEllipse } + + TEllipse = class(TShape) + protected + procedure Paint; override; + published + function PointInObjectLocal(X, Y: Single): Boolean; override; + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled default True; + property Fill; + property Locked default False; + property Height; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property Stroke; + property Visible default True; + property Width; + property ParentShowHint; + property ShowHint; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TCircle } + + TCircle = class(TEllipse) + protected + procedure Paint; override; + end; + +{ TPie } + + TPie = class(TEllipse) + private + FStartAngle: Single; + FEndAngle: Single; + procedure SetEndAngle(const Value: Single); + procedure SetStartAngle(const Value: Single); + protected + procedure Paint; override; + public + function PointInObject(X, Y: Single): Boolean; override; + constructor Create(AOwner: TComponent); override; + published + property StartAngle: Single read FStartAngle write SetStartAngle; + property EndAngle: Single read FEndAngle write SetEndAngle; + end; + +{ TArc } + + TArc = class(TEllipse) + public const + DefaultStartAngle = 0; + DefaultEndAngle = -90; + private + FStartAngle: Single; + FEndAngle: Single; + procedure SetEndAngle(const Value: Single); + procedure SetStartAngle(const Value: Single); + protected + procedure Paint; override; + function IsStartAngleStored: Boolean; virtual; + function IsEndAngleStored: Boolean; virtual; + public + constructor Create(AOwner: TComponent); override; + published + property StartAngle: Single read FStartAngle write SetStartAngle stored IsStartAngleStored nodefault; + property EndAngle: Single read FEndAngle write SetEndAngle stored IsEndAngleStored nodefault; + end; + + TPathWrapMode = (Original, Fit, Stretch, Tile); + +{ TCustomPath } + + TCustomPath = class(TShape, IPathObject) + private + FData: TPathData; + FCurrent: TPathData; + FWrapMode: TPathWrapMode; + FNeedUpdate: Boolean; + procedure SetWrapMode(const Value: TPathWrapMode); + procedure SetPathData(const Value: TPathData); + { IPathObject } + function GetPath: TPathData; + protected + procedure StrokeChanged(Sender: TObject); override; + procedure DoChanged(Sender: TObject); + procedure Paint; override; + procedure Resize; override; + procedure Loaded; override; + procedure UpdateCurrent; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function PointInObject(X, Y: Single): Boolean; override; + property Data: TPathData read FData write SetPathData; + property WrapMode: TPathWrapMode read FWrapMode write SetWrapMode default TPathWrapMode.Stretch; + end; + +{ TPath } + + TPath = class(TCustomPath) + published + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property Data; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled default True; + property Fill; + property Locked default False; + property Height; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property Stroke; + property Visible default True; + property Width; + property WrapMode; + property ParentShowHint; + property ShowHint; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TText } + + TText = class(TControl, ITextSettings, IObjectState, ICaption) + protected type + /// Accelerator key drawing information. + TAcceleratorInfo = class + private + FBrush: TStrokeBrush; + function GetBrush: TStrokeBrush; + strict private + FKeyIndex: Integer; + FIsUnderlineValid: Boolean; + FUnderlineBeginPoint: TPointF; + FUnderlineEndPoint: TPointF; + procedure SetKeyIndex(const Value: Integer); + function ValidateUnderlinePoints(const AnOwnerControl: TControl; const ACanvas: TCanvas; + const ALayout: TTextLayout): Boolean; + public + destructor Destroy; override; + /// Method to indicate that the underline needs to be redrawn. + procedure InvalidateUnderline; + /// Draws the underline unside the character that holds the accelerator. + function DrawUnderline(const AnOwnerControl: TControl; const ACanvas: TCanvas; const ALayout: TTextLayout; + const AColor: TAlphaColor; const AnOpacity: Single): Boolean; + /// Index of the accelerator key. + property KeyIndex: Integer read FKeyIndex write SetKeyIndex; + /// True if the underline is already generated. + property IsUnderlineValid: Boolean read FIsUnderlineValid; + /// This brush is used to draw the underline down the accelerator key character. + property Brush: TStrokeBrush read GetBrush; + end; + + private + FTextSettings: TTextSettings; + FDefaultTextSettings: TTextSettings; + FStyledSettings: TStyledSettings; + FSavedTextSettings: TTextSettings; + FLayout: TTextLayout; + FAutoSize: Boolean; + FStretch: Boolean; + FIsChanging: Boolean; + FPrefixStyle: TPrefixStyle; + FAcceleratorKeyInfo: TAcceleratorInfo; + procedure SetText(const Value: string); + procedure DoSetText(const Value: string); + procedure SetFont(const Value: TFont); + procedure SetHorzTextAlign(const Value: TTextAlign); + procedure SetVertTextAlign(const Value: TTextAlign); + procedure SetWordWrap(const Value: Boolean); + procedure SetAutoSize(const Value: Boolean); + procedure SetStretch(const Value: Boolean); + procedure SetColor(const Value: TAlphaColor); + procedure SetTrimming(const Value: TTextTrimming); + procedure SetPrefixStyle(const Value: TPrefixStyle); + procedure OnFontChanged(Sender: TObject); + { ITextSettings } + function GetDefaultTextSettings: TTextSettings; + function GetTextSettings: TTextSettings; + function ITextSettings.GetResultingTextSettings = GetTextSettings; + procedure SetTextSettings(const Value: TTextSettings); + procedure SetStyledSettings(const Value: TStyledSettings); + function GetStyledSettings: TStyledSettings; + function GetColor: TAlphaColor; + function GetFont: TFont; + function GetHorzTextAlign: TTextAlign; + function GetTrimming: TTextTrimming; + function GetVertTextAlign: TTextAlign; + function GetWordWrap: Boolean; + function GetText: string; + { ICaption } + function TextStored: Boolean; + protected + procedure DefineProperties(Filer: TFiler); override; + procedure FontChanged; virtual; + function ConvertText(const Value: string): string; virtual; + function SupportsPaintStage(const Stage: TPaintStage): Boolean; override; + function GetTextSettingsClass: TTextSettingsClass; virtual; + procedure Paint; override; + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + procedure DoRealign; override; + procedure AdjustSize; + procedure Resize; override; + procedure Loaded; override; + property Layout: TTextLayout read FLayout; + procedure UpdateDefaultTextSettings; virtual; + { IObjectState } + function SaveState: Boolean; virtual; + function RestoreState: Boolean; virtual; + /// Remove the accelerator key information in the control. + procedure RemoveAcceleratorKeyInfo; + /// Accelerator key underline drawing information. + property AcceleratorKeyInfo: TAcceleratorInfo read FAcceleratorKeyInfo; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AfterConstruction; override; + procedure SetBounds(X, Y, AWidth, AHeight: Single); override; + property Font: TFont read GetFont write SetFont; + property Color: TAlphaColor read GetColor write SetColor; + property HorzTextAlign: TTextAlign read GetHorzTextAlign write SetHorzTextAlign; + property Trimming: TTextTrimming read GetTrimming write SetTrimming; + property VertTextAlign: TTextAlign read GetVertTextAlign write SetVertTextAlign; + property WordWrap: Boolean read GetWordWrap write SetWordWrap; + published + property Align; + property Anchors; + property AutoSize: Boolean read FAutoSize write SetAutoSize default False; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled default True; + property Locked default False; + property Height; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property Stretch: Boolean read FStretch write SetStretch default False; + property Text: string read GetText write SetText; + property TextSettings: TTextSettings read GetTextSettings write SetTextSettings; + /// Determine the way portraying a single character "&" + property PrefixStyle: TPrefixStyle read FPrefixStyle write SetPrefixStyle default TPrefixStyle.HidePrefix; + property Visible default True; + property Width; + property ParentShowHint; + property ShowHint; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Mouse events} + property OnClick; + property OnDblClick; + + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TImage } + + TImage = class; + + TImageMultiResBitmap = class (TFixedMultiResBitmap) + private + [Weak] FImage: TImage; + protected + procedure Update(Item: TCollectionItem); override; + function GetDefaultSize: TSize; override; + end; + + /// Specifies whether and how to resize, replicate, and position the image for rendering the control surface. + TImageWrapMode = ( + /// Display the image with its original dimensions. + Original, + /// Stretches image into the LocalRect, preserving aspect ratio. When LocalRect + /// is bigger than image, the last one will be stretched to fill LocalRect + Fit, + /// Stretch the image to fill the entire control's rectangle. + Stretch, + /// Tile (multiply) the image to cover the entire control's rectangle. + Tile, + /// Center the image to the control's rectangle. + Center, + /// Places the image inside the LocalRect. If the image is greater + /// than the LocalRect then the source rectangle is scaled with aspect ratio. + /// + Place + ); + + TImage = class(TControl, IBitmapObject, IMultiResBitmapObject) + private + FData: TValue; + FBitmapMargins: TBounds; + FWrapMode: TImageWrapMode; + FDisableInterpolation: Boolean; + FMarginWrapMode: TImageWrapMode; + FScaleChangedId: TMessageSubscriptionId; + FMultiResBitmap: TFixedMultiResBitmap; + FScreenScale: Single; + FCurrentScale: Single; + [weak] FCurrentBitmap: TBitmap; + FCurrentBitmapUpdating: Boolean; + procedure SetBitmap(const Value: TBitmap); + procedure SetWrapMode(const Value: TImageWrapMode); + procedure SetBitmapMargins(const Value: TBounds); + procedure SetMarginWrapMode(const Value: TImageWrapMode); + procedure SetDisableInterpolation(const Value: Boolean); + procedure ScaleChangedHandler(const Sender: TObject; const Msg: TMessage); + { IBitmapObject } + function GetBitmap: TBitmap; + procedure ReadBitmap(Stream: TStream); + procedure ReadHiBitmap(Stream: TStream); + procedure SetMultiResBitmap(const Value: TFixedMultiResBitmap); + procedure UpdateCurrentBitmap; + { IMultiResBitmapObject } + function GetMultiResBitmap: TCustomMultiResBitmap; + protected + procedure DoChanged; virtual; + procedure Paint; override; + procedure DrawWithMargins(const Canvas: TCanvas; const ARect: TRectF; const ABitmap: TBitmap; + const AOpacity: Single = 1.0); + /// This function tries to find the item in MultiResBitmap, which have the most suitable scale + /// (see Scene.GetSceneScale). + /// If IncludeEmpty is true then then returned item can be empty otherwise the empty items are ignored + /// + /// If successful, the item from the property MultiResBitmap otherwise nil + function ItemForCurrentScale(const IncludeEmpty: Boolean): TCustomBitmapItem; + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + function CreateMultiResBitmap: TFixedMultiResBitmap; virtual; + procedure DefineProperties(Filer: TFiler); override; + function MultiResBitmapStored: Boolean; virtual; + function CanObserve(const ID: Integer): Boolean; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure DrawBitmap(const Canvas: TCanvas; const ARect: TRectF; const ABitmap: TBitmap; const AOpacity: Single = 1.0); + property Bitmap: TBitmap read GetBitmap write SetBitmap; + published + property MultiResBitmap: TFixedMultiResBitmap read FMultiResBitmap write SetMultiResBitmap stored MultiResBitmapStored; + property Align; + property Anchors; + property BitmapMargins: TBounds read FBitmapMargins write SetBitmapMargins; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DisableInterpolation: Boolean read FDisableInterpolation write SetDisableInterpolation default False; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled default True; + property Locked default False; + property Height; + property Hint; + property HitTest default True; + property Padding; + property MarginWrapMode: TImageWrapMode read FMarginWrapMode write SetMarginWrapMode default TImageWrapMode.Stretch; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property Visible default True; + property Width; + property WrapMode: TImageWrapMode read FWrapMode write SetWrapMode default TImageWrapMode.Fit; + property ParentShowHint; + property ShowHint; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Mouse events} + property OnClick; + property OnDblClick; + + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TPaintBox } + + TPaintEvent = procedure(Sender: TObject; Canvas: TCanvas) of object; + + TPaintBox = class(TControl) + private + FOnPaint: TPaintEvent; + protected + procedure Paint; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled default True; + property Locked default False; + property Height; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property Visible default True; + property Width; + property ParentShowHint; + property ShowHint; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Mouse events} + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + property OnPainting; + property OnPaint: TPaintEvent read FOnPaint write FOnPaint; + property OnResize; + property OnResized; + end; + +{ TSelection } + + TSelection = class(TControl) + public const + DefaultColor = $FF1072C5; + public type + TGrabHandle = (None, LeftTop, RightTop, LeftBottom, RightBottom); + private + FParentBounds: Boolean; + FOnChange: TNotifyEvent; + FHideSelection: Boolean; + FMinSize: Integer; + FOnTrack: TNotifyEvent; + FProportional: Boolean; + FGripSize: Single; + FRatio: Single; + FActiveHandle: TGrabHandle; + FHotHandle: TGrabHandle; + FDownPos: TPointF; + FShowHandles: Boolean; + FColor: TAlphaColor; + procedure SetHideSelection(const Value: Boolean); + procedure SetMinSize(const Value: Integer); + procedure SetGripSize(const Value: Single); + procedure ResetInSpace(const ARotationPoint: TPointF; ASize: TPointF); + function GetProportionalSize(const ASize: TPointF): TPointF; + function GetHandleForPoint(const P: TPointF): TGrabHandle; + procedure GetTransformLeftTop(AX, AY: Single; var NewSize: TPointF; var Pivot: TPointF); + procedure GetTransformLeftBottom(AX, AY: Single; var NewSize: TPointF; var Pivot: TPointF); + procedure GetTransformRightTop(AX, AY: Single; var NewSize: TPointF; var Pivot: TPointF); + procedure GetTransformRightBottom(AX, AY: Single; var NewSize: TPointF; var Pivot: TPointF); + procedure MoveHandle(AX, AY: Single); + procedure SetShowHandles(const Value: Boolean); + procedure SetColor(const Value: TAlphaColor); + protected + function DoGetUpdateRect: TRectF; override; + procedure Paint; override; + ///Draw grip handle + procedure DrawHandle(const Canvas: TCanvas; const Handle: TGrabHandle; const Rect: TRectF); virtual; + ///Draw frame rectangle + procedure DrawFrame(const Canvas: TCanvas; const Rect: TRectF); virtual; + public + function PointInObjectLocal(X, Y: Single): Boolean; override; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure MouseMove(Shift: TShiftState; X, Y: Single); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure DoMouseLeave; override; + ///Grip handle where mouse is hovered + property HotHandle: TGrabHandle read FHotHandle; + published + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + ///Selection frame and handle's border color + property Color: TAlphaColor read FColor write SetColor default DefaultColor; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled default True; + property GripSize: Single read FGripSize write SetGripSize; + property Locked default False; + property Height; + property HideSelection: Boolean read FHideSelection write SetHideSelection; + property Hint; + property HitTest default True; + property Padding; + property MinSize: Integer read FMinSize write SetMinSize default 15; + property Opacity; + property Margins; + property ParentBounds: Boolean read FParentBounds write FParentBounds default True; + property Proportional: Boolean read FProportional write FProportional; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + ///Indicates visibility of handles + property ShowHandles: Boolean read FShowHandles write SetShowHandles; + property Visible default True; + property Width; + property ParentShowHint; + property ShowHint; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Mouse events} + property OnClick; + property OnDblClick; + + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + property OnTrack: TNotifyEvent read FOnTrack write FOnTrack; + end; + +{ TSelectionPoint } + + TOnChangeTracking = procedure (Sender: TObject; var X, Y: Single) of object; + + TSelectionPoint = class(TStyledControl) + private + FParentBounds: Boolean; + FGripSize: Single; + FGripCenter: TPosition; + FPressed: Boolean; + FStylized: Boolean; + FAutodetectPointLocation: Boolean; + FBackgroundRect: TRectF; + FOnChange: TNotifyEvent; + FOnChangeTrack: TOnChangeTracking; + procedure SetGripSize(const Value: Single); + procedure SetGripCenter(const Value: TPosition); + function GetBackgroundRectForNonStyle: TRectF; + protected + procedure Paint; override; + procedure SetHeight(const Value: Single); override; + procedure SetWidth(const Value: Single); override; + function DoGetUpdateRect: TRectF; override; + procedure DoGesture(const EventInfo: TGestureEventInfo; var Handled: Boolean); override; + procedure DoMouseEnter; override; + procedure DoMouseLeave; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure MouseMove(Shift: TShiftState; X, Y: Single); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure DoChangeTracking(var X, Y: Single); + procedure DoChange; + procedure ApplyStyle; override; + procedure FreeStyle; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function PointInObjectLocal(X, Y: Single): Boolean; override; + property BackgroundRect: TRectF read FBackgroundRect; + published + property Align; + property Anchors; + /// + /// Relevant only when control uses style. + property AutodetectPointLocation: Boolean read FAutodetectPointLocation write FAutodetectPointLocation default False; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled default True; + property GripSize: Single read FGripSize write SetGripSize; + property GripCenter: TPosition read FGripCenter write SetGripCenter; + property Locked default False; + property Height; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property ParentBounds: Boolean read FParentBounds write FParentBounds default True; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TouchTargetExpansion; + property Visible default True; + property Width; + property ParentShowHint; + property ShowHint; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Mouse events} + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + property OnTrack: TOnChangeTracking read FOnChangeTrack write FOnChangeTrack; + end; + +//== UNIT END: FMX.Objects +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.StdActns (from FMX.StdActns.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +const + DefaultMaxValue = 100.0; + +type + /// This action executes in order to trigger the OnHint event on all + /// the hint receivers in the active form. + THintAction = class(TCustomAction) + public + /// Default constructor. + constructor Create(AOwner: TComponent); override; + /// This execution causes all the hint receivers registered in the active form to be triggered. + function Execute: Boolean; override; + published + property Hint; + end; + + TSysCommonAction = class (TCustomAction) + private + FOnCanActionExec: TCanActionExecEvent; + protected + function GetDefaultText(const Template: string): string; + function CanActionExec: Boolean; virtual; + public + function Update: Boolean; override; + published + property CustomText; + property Enabled; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property ImageIndex; + property ShortCut; + property SecondaryShortCuts; + property Visible; + property UnsupportedArchitectures; + property OnCanActionExec: TCanActionExecEvent read FOnCanActionExec write FOnCanActionExec; + property OnUpdate; + property OnHint; + end; + + TFileExit = class(TSysCommonAction) + protected + function IsSupportedInterface: Boolean; override; + public + constructor Create(AOwner: TComponent); override; + function HandlesTarget(Target: TObject): Boolean; override; + procedure ExecuteTarget(Target: TObject); override; + procedure CustomTextChanged; override; + published + property ShortCut default scCommand or vkQ; + property UnsupportedPlatforms default [TOSVersion.TPlatform.pfiOS]; + end; + + TWindowClose = class(TSysCommonAction) + public + function HandlesTarget(Target: TObject): Boolean; override; + procedure ExecuteTarget(Target: TObject); override; + procedure CustomTextChanged; override; + function Update: Boolean; override; + constructor Create(AOwner: TComponent); override; + published + property ShortCut default scCommand or vkW; + property UnsupportedPlatforms; + property OnExecute; + end; + + TFileHideApp = class(TSysCommonAction) + private + FHideAppService: IFMXHideAppService; + protected + function IsSupportedInterface: Boolean; override; + public + function HandlesTarget(Target: TObject): Boolean; override; + procedure ExecuteTarget(Target: TObject); override; + procedure CustomTextChanged; override; + function Update: Boolean; override; + constructor Create(AOwner: TComponent); override; + published + property ShortCut default scCommand or vkH; + property UnsupportedPlatforms default TOSVersion.AllPlatforms - [TOSVersion.TPlatform.pfMacOS]; + property OnExecute; + end; + + TFileHideAppOthers = class(TFileHideApp) + private + public + procedure ExecuteTarget(Target: TObject); override; + procedure CustomTextChanged; override; + constructor Create(AOwner: TComponent); override; + published + property ShortCut default scAlt or scCommand or vkH; + end; + + TObjectViewAction = class (TCustomViewAction) + private + procedure SetFmxObject(const Value: TFmxObject); + function GetFmxObject: TFmxObject; + protected + procedure SetComponent(const Value: TComponent); override; + function ComponentText: string; override; + procedure DoCreateComponent(var NewComponent: TComponent); override; + public + property FmxObject: TFmxObject read GetFmxObject write SetFmxObject; + end; + + TVirtualKeyboard = class(TObjectViewAction) + private + FService: IFMXVirtualKeyboardService; + protected + public + function IsSupportedInterface: Boolean; override; + procedure ExecuteTarget(Target: TObject); override; + function Update: Boolean; override; + published + property Text; + property Enabled; + property HelpContext; + property HelpKeyword; + property HelpType; + property ImageIndex; + property ShortCut; + property SecondaryShortCuts; + property Visible; + property UnsupportedArchitectures; + property UnsupportedPlatforms; + property OnUpdate; + property FmxObject; + end; + +{ TViewAction } + + TViewAction = class (TObjectViewAction) + private + protected + procedure SetComponent(const Value: TComponent); override; + public + procedure ExecuteTarget(Target: TObject); override; + function Update: Boolean; override; + published + property Text; + property Enabled; + property HelpContext; + property HelpKeyword; + property HelpType; + property ImageIndex; + property ShortCut; + property SecondaryShortCuts; + property Visible; + property UnsupportedArchitectures; + property UnsupportedPlatforms; + property OnUpdate; + property FmxObject; + property OnCreateComponent; + property OnBeforeShow; + property OnAfterShow; + end; + + /// This class associates a floating-point number Value with methods + /// and properties used for handling Value between the values specified by Min + /// and Max. + TBaseValueRange = class (TPersistent) + private + FMax: Double; + FMin: Double; + FViewportSize: Double; + FFrequency: Double; + FValue: Double; + protected + public + property Min: Double read FMin write FMin; + property Max: Double read FMax write FMax; + property Value: Double read FValue write FValue; + property Frequency: Double read FFrequency write FFrequency; + property ViewportSize: Double read FViewportSize write FViewportSize; + procedure Assign(Source: TPersistent); override; + function Equals(Obj: TObject): Boolean; override; + function Same(Obj: TBaseValueRange): Boolean; virtual; + + end; + + TCustomValueRangeClass = class of TCustomValueRange; + + /// Extends the TBaseValueRange class providing methods and + /// properties used to control the correctness of the Value handling within + /// its Min to Max range. + TCustomValueRange = class (TBaseValueRange) + private + FInitialized: Boolean; + [Weak] FOwner: TComponent; + FOwnerAction: TCustomAction; + FNew: TBaseValueRange; + FOld: TBaseValueRange; + FTmp: TBaseValueRange; + FRelativeValue: Double; + FUpdateCount: Integer; + FChanging: Boolean; + FIsChanged: Boolean; + FBeforeChange: TNotifyEvent; + FAfterChange: TNotifyEvent; + FOnChanged: TNotifyEvent; + FTracking: Boolean; + FOnTrackingChange: TNotifyEvent; + FIncrement: Double; + FLastValue: Double; + procedure IntChanged; + function GetMax: Double; inline; + procedure SetMax(const AValue: Double); + function GetMin: Double; inline; + procedure SetMin(const AValue: Double); + function GetValue: Double; inline; + procedure SetValue(const AValue: Double); + function GetFrequency: Double; inline; + procedure SetFrequency(const AValue: Double); + function GetViewportSize: Double; inline; + procedure SetViewportSize(const AValue: Double); + procedure SetRelativeValue(const AValue: Double); + procedure SetTracking(const Value: Boolean); + procedure SetIncrement(const Value: Double); + protected + procedure DoBeforeChange; virtual; + procedure DoChanged; virtual; + procedure DoAfterChange; virtual; + procedure DoTrackingChange; virtual; + property Initialized: Boolean read FInitialized; + function GetOwner: TPersistent; override; + + function MaxStored: Boolean; virtual; + function MinStored: Boolean; virtual; + function ValueStored: Boolean; virtual; + function FrequencyStored: Boolean; virtual; + function ViewportSizeStored: Boolean; virtual; + public + constructor Create(AOwner: TComponent); virtual; + destructor Destroy; override; + procedure Assign(Source: TPersistent); override; + function GetNamePath: string; override; + /// + /// This function returns True, if all the properties (Min, Max, Value, etc.) have default values. + /// + function IsEmpty: Boolean; virtual; + /// + /// Sets default values to all properties (Min, Max, Value, etc.). + /// + procedure Clear; virtual; + /// + /// If this property is true, the event BeforeChange, AfterChange occur with any change. + /// Otherwise, they occur only after the property is accept the truth. + /// + property Tracking: Boolean read FTracking write SetTracking; + /// + /// This method is caused after property Min, Max, Value, etc. set new values. + /// If the owner is loading, or UpdateCount > 0 then events calling, else IsChanged property accepts value true. + /// + /// + /// If this parameter is set to True, then the state csLoading ignored + /// + /// + /// After loading, the owner shall check value of IsChanged property and call the Changed method + /// + procedure Changed(const IgnoreLoading: Boolean = false); + property IsChanged: Boolean read FIsChanged; + /// + /// The new values. see + /// + property New: TBaseValueRange read FNew; + property Min: Double read GetMin write SetMin stored MinStored nodefault; + property Max: Double read GetMax write SetMax stored MaxStored nodefault; + property Value: Double read GetValue write SetValue stored ValueStored nodefault; + property Frequency: Double read GetFrequency write SetFrequency stored FrequencyStored nodefault; + property ViewportSize: Double read GetViewportSize write SetViewportSize stored ViewportSizeStored nodefault; + property RelativeValue: Double read FRelativeValue write SetRelativeValue stored False nodefault; + + property LastValue: Double read FLastValue write FLastValue; + property Increment: Double read FIncrement write SetIncrement; + function Inc: Boolean; + function Dec: Boolean; + + property Owner: TComponent read FOwner; + procedure BeginUpdate; + procedure EndUpdate; + property UpdateCount: Integer read FUpdateCount; + /// + /// This property indicates that the class is in a state where is being processed change. + /// + property Changing: Boolean read FChanging; + /// + /// This event is raised before the changes take effect. + /// Value property, and others contain the old values. + /// To receive new values, see + /// + /// + /// This event occurs only if the property Tracking is set to true + /// + property BeforeChange: TNotifyEvent read FBeforeChange write FBeforeChange; + /// + /// This event is raised after the changes take effect, and before AfterChange. + /// + /// + /// This event always occurs, even if the property Tracking is set to false + /// + property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; + /// + /// This event is raised after the changes take effect. + /// Value property, and others contain the new values. + /// + /// + /// This event occurs only if the property Tracking is set to true + /// + property AfterChange: TNotifyEvent read FAfterChange write FAfterChange; + /// + /// This event is raised after the property Tracking has changed + /// + property OnTrackingChange: TNotifyEvent read FOnTrackingChange write FOnTrackingChange; + end; + + /// Extends the TCustomValueRange class declaring Value, Min, Max, + /// and some other properties to be published. + TValueRange = class (TCustomValueRange) + published + property Min; + property Max; + property Value; + property Frequency; + property ViewportSize; + property RelativeValue; + end; + + /// The base class for actions (without published properties) that + /// can be used by controls having ValueRange-type properties. + TCustomValueRangeAction = class (TCustomControlAction) + private + FValueRange: TCustomValueRange; + function GetValueRange: TCustomValueRange; + procedure SetValueRange(const Value: TCustomValueRange); + protected + function CreateValueRange: TCustomValueRange; virtual; + procedure Loaded; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property ValueRange: TCustomValueRange read GetValueRange write SetValueRange; + end; + + /// Class that can be used by controls having ValueRange-type + /// properties. + TValueRangeAction = class (TCustomValueRangeAction) + protected + function CreateValueRange: TCustomValueRange; override; + published + property AutoCheck; + property Text; + property Checked; + property Enabled; + property GroupIndex; + property HelpContext; + property HelpKeyword; + property HelpType; + property ShortCut; + property SecondaryShortCuts; + property Visible; + property UnsupportedArchitectures; + property UnsupportedPlatforms; + property OnExecute; + property OnUpdate; + property PopupMenu; + property ValueRange; + end; + + /// Class responsible for the communication between an action of type + /// TValueRangeAction and a control that implements the IValueRange + /// interface. + TValueRangeActionLink = class (TControlActionLink) + protected + function IsValueRangeLinked: Boolean; + procedure SetValueRange(const AValue: TBaseValueRange); virtual; + end; + + /// This interface declares methods for setting and getting the + /// ValueRange property. + IValueRange = interface + ['{6DFA65EF-A8BF-4D58-9655-664B50C30312}'] + function GetValueRange: TCustomValueRange; + procedure SetValueRange(const AValue: TCustomValueRange); + property ValueRange: TCustomValueRange read GetValueRange write SetValueRange; + end; + + +//== UNIT END: FMX.StdActns +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.StdCtrls (from FMX.StdCtrls.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +type + +{ TPresentedTextControl } + + /// Base class for all presented text controls such as + /// TLabel. + TPresentedTextControl = class(TPresentedControl, ITextSettings, ICaption, IAcceleratorKeyReceiver) + private + FTextSettingsInfo: TTextSettingsInfo; + FTextObject: TControl; + FITextSettings: ITextSettings; + FObjectState: IObjectState; + FText: string; + FIsChanging: Boolean; + FPrefixStyle: TPrefixStyle; + FAcceleratorKey: Char; + FAcceleratorKeyIndex: Integer; + function TextStored: Boolean; + function GetFont: TFont; + function GetText: string; + procedure SetFont(const Value: TFont); + function GetTextAlign: TTextAlign; + procedure SetTextAlign(const Value: TTextAlign); + function GetVertTextAlign: TTextAlign; + procedure SetVertTextAlign(const Value: TTextAlign); + function GetWordWrap: Boolean; + procedure SetWordWrap(const Value: Boolean); + function GetFontColor: TAlphaColor; + procedure SetFontColor(const Value: TAlphaColor); + function GetTrimming: TTextTrimming; + procedure SetTrimming(const Value: TTextTrimming); + procedure SetPrefixStyle(const Value: TPrefixStyle); + { ITextSettings } + function GetDefaultTextSettings: TTextSettings; + function GetTextSettings: TTextSettings; + function GetStyledSettings: TStyledSettings; + function GetResultingTextSettings: TTextSettings; + protected + /// Overrides the TControl.DoRootChanging to register/unregister the control in the form as a + /// IAcceleratorKeyReceiver if the control has an accelerator key. + procedure DoRootChanging(const NewRoot: IRoot); override; + /// This function is invoked to filter the text that is going to be displayed. This function doesn't modify the string + /// stored by the control used as Text property. + function DoFilterPresentedText(const AText: string): string; virtual; + procedure DefineProperties(Filer: TFiler); override; + procedure ApplyStyle; override; + procedure FreeStyle; override; + procedure DoStyleChanged; override; + procedure SetText(const Value: string); virtual; + /// Set new value to text property without calling DoTextChanged. + procedure SetTextInternal(const Value: string); virtual; + procedure SetName(const Value: TComponentName); override; + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + procedure Loaded; override; + /// Retrieves the resource object linked to the style of the current TextObject. + function FindTextObject: TFmxObject; virtual; + /// Copy text releated properties to TextObject. + procedure UpdateTextObject(const TextControl: TControl; const Str: string); + /// Link to object in style that actually displays control's data. + property TextObject: TControl read FTextObject; + /// Called when text is changed. + procedure DoTextChanged; virtual; + procedure DoEndUpdate; override; + /// Return TextObject bounds using current text alignment values. + function CalcTextObjectSize(const MaxWidth: Single; var Size: TSizeF): Boolean; + { ITextSettings } + procedure SetTextSettings(const Value: TTextSettings); virtual; + procedure SetStyledSettings(const Value: TStyledSettings); virtual; + /// Updates the representation of the text on the control. + procedure DoChanged; virtual; + /// Retrieves whether any of the default values of font properties that are stored in the StyledSettings property is changed + function StyledSettingsStored: Boolean; virtual; + /// Use to create new instance of TextSettings object + function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; virtual; + { IAcceleratorKeyReceiver } + /// Implements IAcceleratorKeyReceiver.TriggerAcceleratorKey by setting focus to this control. + procedure TriggerAcceleratorKey; virtual; + /// Implements IAcceleratorKeyReceiver.CanTriggerAcceleratorKey by returning True if this control and all + /// of its parent controls are visible. + function CanTriggerAcceleratorKey: Boolean; virtual; + /// Implements IAcceleratorKeyReceiver.GetAcceleratorChar by returning the value stored in FAcceleratorKey. + function GetAcceleratorChar: Char; + /// Implements IAcceleratorKeyReceiver.GetAcceleratorCharIndex by returning the value stored in + /// FAcceleratorKeyIndex. This indicates the position within the text string of the accelerator character. + function GetAcceleratorCharIndex: Integer; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AfterConstruction; override; + function ToString: string; override; + /// Specifies the text that will be rendered over the surface of this control + property Text: string read GetText write SetText stored TextStored; + /// Stores a TTextSettings type object keeping the default values of the text representation properties + property DefaultTextSettings: TTextSettings read GetDefaultTextSettings; + /// Stores a TTextSettings type object, which handles the text representation properties to be used for drawing the text in this control + property TextSettings: TTextSettings read GetTextSettings write SetTextSettings; + /// Defines the values of the styled text representation properties + property StyledSettings: TStyledSettings read GetStyledSettings write SetStyledSettings stored StyledSettingsStored nodefault; + /// Returns a TTextSettings object that declares the text control representation properties + property ResultingTextSettings: TTextSettings read GetResultingTextSettings; + /// Calls DoChanged when any of the styled text representation properties of the control is changed. + procedure Change; + /// Specifies the font to use when rendering the text + property Font: TFont read GetFont write SetFont; + /// Specifies the font color of the text + property FontColor: TAlphaColor read GetFontColor write SetFontColor default TAlphaColorRec.Black; + /// Specifies how the text will be displayed in terms of vertical alignment. + property VertTextAlign: TTextAlign read GetVertTextAlign write SetVertTextAlign default TTextAlign.Center; + /// Specifies how the text will be displayed in terms of horizontal alignment. + property TextAlign: TTextAlign read GetTextAlign write SetTextAlign default TTextAlign.Leading; + /// Specifies whether the text inside the control wraps when it is longer than the width of the control + property WordWrap: Boolean read GetWordWrap write SetWordWrap default False; + /// Specifies the behavior of the text, when it overflows the area for drawing the text. + property Trimming: TTextTrimming read GetTrimming write SetTrimming default TTextTrimming.None; + /// Determine the way portraying a single character "&" + property PrefixStyle: TPrefixStyle read FPrefixStyle write SetPrefixStyle default TPrefixStyle.HidePrefix; + end; + +{ TPanel } + + TPanel = class(TPresentedControl) + protected + function GetDefaultSize: TSizeF; override; + procedure DefineProperties(Filer: TFiler); override; + public + constructor Create(AOwner: TComponent); override; + published + property Action; + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TouchTargetExpansion; + property Visible; + property Width; + property TabOrder; + property TabStop; + property ParentShowHint; + property ShowHint; + property OnApplyStyleLookup; + property OnFreeStyle; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnKeyDown; + property OnKeyUp; + property OnCanFocus; + property OnEnter; + property OnExit; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TCalloutPanel } + + TCalloutPanel = class(TPanel) + public const + DefaultCalloutPosition = TCalloutPosition.Top; + DefaultCalloutWidth = 23; + DefaultCalloutLength = 11; + private + FCalloutRect: TCalloutRectangle; + FCalloutLength: Single; + FCalloutWidth: Single; + FCalloutPosition: TCalloutPosition; + FCalloutOffset: Single; + FSavedPadding: TRectF; + FUpdatingPadding: Boolean; + procedure SetCalloutLength(const Value: Single); + procedure SetCalloutPosition(const Value: TCalloutPosition); + procedure SetCalloutWidth(const Value: Single); + procedure SetCalloutOffset(const Value: Single); + protected + procedure ApplyStyle; override; + procedure FreeStyle; override; + /// Updates values: CalloutLength, CalloutWidth, CalloutPosition and + /// CalloutOffset of CalloutRect object in style + procedure UpdateCallout; + /// Updates padding based on value of CalloutLength and CalloutPosition + procedure UpdatePadding; + /// Saves current values of padding, which are not equaled to CalloutLength + procedure SavePadding; + /// Restores previous saved value of padding + procedure RestorePadding; + procedure PaddingChanged; override; + public + constructor Create(AOwner: TComponent); override; + /// Access to style object TCalloutRectangle + property CalloutRectangle: TCalloutRectangle read FCalloutRect write FCalloutRect; + published + property CalloutWidth: Single read FCalloutWidth write SetCalloutWidth; + property CalloutLength: Single read FCalloutLength write SetCalloutLength; + property CalloutPosition: TCalloutPosition read FCalloutPosition write SetCalloutPosition + default DefaultCalloutPosition; + property CalloutOffset: Single read FCalloutOffset write SetCalloutOffset; + end; + +{ TLabel } + + TLabel = class(TPresentedTextControl) + private + FAutoSize: Boolean; + FPressing: Boolean; + FIsPressed: Boolean; + FInFitSize: Boolean; + FNeedFitSize: Boolean; + [Weak] FFocusControl: TControl; + procedure SetAutoSize(const Value: Boolean); + procedure FitSize; + procedure SetFocusControl(const Value: TControl); + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure MouseMove(Shift: TShiftState; X, Y: Single); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure DefineProperties(Filer: TFiler); override; + function GetDefaultSize: TSizeF; override; + procedure Resize; override; + procedure DoChanged; override; + procedure ApplyStyle; override; + function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; override; + { IAcceleratorKeyReceiver } + /// Overrides TPresentedTextControl.TriggerAcceleratorKey + procedure TriggerAcceleratorKey; override; + public + constructor Create(AOwner: TComponent); override; + procedure SetNewScene(AScene: IScene); override; + { triggers } + property IsPressed: Boolean read FIsPressed; + property Font; + property FontColor; + property TextAlign; + property VertTextAlign; + property WordWrap; + property Trimming; + published + property Action; + property Align; + property Anchors; + property AutoSize: Boolean read FAutoSize write SetAutoSize default False; + property AutoTranslate default True; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property StyledSettings; + property Locked default False; + /// This property is used if the labbel has an accelerator key. If FocusControls supports IAcceleratorKeyReceiver + /// calls the FocusControl default trigger action. If the IAcceleratorKeyReceiver is not supported, only sets the focus to + /// FocusControl when the label catches the accelerator key. + property FocusControl: TControl read FFocusControl write SetFocusControl; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default False; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TextSettings; + property Text; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + property TabOrder; + property TabStop; + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TCustomButton } + + TCustomButton = class(TPresentedTextControl, IGlyph) + private + FPressing: Boolean; + FIsPressed: Boolean; + FModalResult: TModalResult; + FStaysPressed: Boolean; + FRepeatTimer: TTimer; + FRepeat: Boolean; + FTintColor: TAlphaColor; + FTintObject: ITintedObject; + FIconTintColor: TAlphaColor; + FIconTintObject: ITintedObject; + FIcon: TControl; + FOldIconVisible: Boolean; + FGlyph: TGlyph; + FGlyphSize: TSizeF; + FImageLink: TGlyphImageLink; + procedure SetTintColor(const Value: TAlphaColor); + function IsTintColorStored: Boolean; + function IsIconTintColorStored: Boolean; + procedure SetIconTintColor(const Value: TAlphaColor); + function GetImages: TCustomImageList; + procedure SetImages(const Value: TCustomImageList); + { IGlyph } + function GetImageIndex: TImageIndex; + procedure SetImageIndex(const Value: TImageIndex); + function GetImageList: TBaseImageList; inline; + procedure SetImageList(const Value: TBaseImageList); + function IGlyph.GetImages = GetImageList; + procedure IGlyph.SetImages = SetImageList; + function UpdateGlyphSize: Boolean; + protected + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + function IsPressedStored: Boolean; virtual; + procedure RestoreButtonState; virtual; + procedure ApplyTriggers; virtual; + procedure SetIsPressed(const Value: Boolean); virtual; + procedure SetStaysPressed(const Value: Boolean); virtual; + procedure Click; override; + procedure DblClick; override; + procedure ApplyStyle; override; + procedure FreeStyle; override; + procedure ToggleStaysPressed; virtual; + procedure DoRealign; override; + procedure DoRepeatTimer(Sender: TObject); + procedure DoRepeatDelayTimer(Sender: TObject); + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure MouseMove(Shift: TShiftState; X, Y: Single); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override; + function GetDefaultSize: TSizeF; override; + function GetDefaultTouchTargetExpansion: TRectF; override; + function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; override; + property TintColor: TAlphaColor read FTintColor write SetTintColor stored IsTintColorStored; + property TintObject: ITintedObject read FTintObject; + property IconTintColor: TAlphaColor read FIconTintColor write SetIconTintColor stored IsIconTintColorStored; + property IconTintObject: ITintedObject read FIconTintObject; + procedure ImagesChanged; virtual; + /// Determines whether the ImageIndex property needs to be stored in the fmx-file + /// True if the ImageIndex property needs to be stored in the fmx-file + function ImageIndexStored: Boolean; virtual; + { IAcceleratorKeyReceiver } + /// Overrides the TPresentedTextControl.TriggerAcceleratorKey + procedure TriggerAcceleratorKey; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SetNewScene(AScene: IScene); override; + property Action; + property StaysPressed: Boolean read FStaysPressed write SetStaysPressed stored IsPressedStored default False; + { triggers } + property IsPressed: Boolean read FIsPressed write SetIsPressed default False; + property ModalResult: TModalResult read FModalResult write FModalResult default mrNone; + property RepeatClick: Boolean read FRepeat write FRepeat default False; + /// The list of images. Can be nil. See also FMX.ActnList.IGlyph + property Images: TCustomImageList read GetImages write SetImages; + /// Zero based index of an image. The default is -1. + /// See also FMX.ActnList.IGlyph + /// If non-existing index is specified, an image is not drawn and no exception is raised + property ImageIndex: TImageIndex read GetImageIndex write SetImageIndex stored ImageIndexStored; + end; + +{ TButton } + + TButton = class(TCustomButton) + private + FDefault: Boolean; + FCancel: Boolean; + public + property TintObject; + property IconTintObject; + protected + procedure AfterDialogKey(var Key: Word; Shift: TShiftState); override; + property Font; + property TextAlign; + property Trimming; + property WordWrap; + published + property StaysPressed default False; + property Action; + property Align default TAlignLayout.None; + property Anchors; + property AutoTranslate default True; + property Cancel: Boolean read FCancel write FCancel default False; + property CanFocus default True; + property CanParentFocus; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Cursor default crDefault; + property Default: Boolean read FDefault write FDefault default False; + property DisableFocusEffect; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property StyledSettings; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property IconTintColor; + property Images; + property ImageIndex; + property IsPressed default False; + property Locked default False; + property Padding; + property ModalResult default mrNone; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RepeatClick default False; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property Text; + property TextSettings; + property TintColor; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + property OnApplyStyleLookup; + property OnFreeStyle; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnKeyDown; + property OnKeyUp; + property OnCanFocus; + property OnClick; + property OnDblClick; + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + + TSpeedButtonGroupMessage = class(TMessage); + + TSpeedButton = class(TCustomButton, IGroupName, IIsChecked) + private + FGroupName: string; + { IIsChecked } + function GetIsChecked: Boolean; + procedure SetIsChecked(const Value: Boolean); + function IsCheckedStored: Boolean; + procedure GroupMessageCall(const Sender : TObject; const M : TMessage); + { IGroupName } + function GetGroupName: string; + function GroupNameStored: Boolean; + procedure SetGroupName(const Value: string); + protected + function IsPressedStored: Boolean; override; + procedure ToggleStaysPressed; override; + procedure SetIsPressed(const Value: Boolean); override; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + procedure RestoreButtonState; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property Font; + property IconTintObject; + property TextAlign; + property TintObject; + property Trimming; + property WordWrap; + published + // do not move this line + property StaysPressed default False; + property Action; + property Align default TAlignLayout.None; + property Anchors; + property AutoTranslate default True; + property CanFocus default False; + property CanParentFocus; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property GroupName: string read GetGroupName write SetGroupName stored GroupNameStored nodefault; + property StyledSettings; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property IsPressed default False; + property IconTintColor; + property Images; + property ImageIndex; + property Locked default False; + property Padding; + property ModalResult default mrNone; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RepeatClick default False; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property ParentShowHint; + property ShowHint; + property StyleLookup; + property Text; + property TextSettings; + property TintColor; + property TouchTargetExpansion; + property Visible; + property Width; + property OnApplyStyleLookup; + property OnFreeStyle; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TCustomCornerButton } + + TCustomCornerButton = class(TCustomButton) + private + FYRadius: Single; + FXRadius: Single; + FCorners: TCorners; + FCornerType: TCornerType; + FSides: TSides; + function IsCornersStored: Boolean; + procedure SetXRadius(const Value: Single); + procedure SetYRadius(const Value: Single); + procedure SetCorners(const Value: TCorners); + procedure SetCornerType(const Value: TCornerType); + procedure SetSides(const Value: TSides); + function IsSidesStored: Boolean; + protected + procedure ApplyStyle; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + property XRadius: Single read FXRadius write SetXRadius; + property YRadius: Single read FYRadius write SetYRadius; + property Corners: TCorners read FCorners write SetCorners stored IsCornersStored; + property CornerType: TCornerType read FCornerType write SetCornerType default TCornerType.Round; + property Sides: TSides read FSides write SetSides stored IsSidesStored; + end; + +{ TCornerButton } + + TCornerButton = class(TCustomCornerButton) + public + property Font; + property TextAlign default TTextAlign.Center; + property WordWrap default False; + published + property StaysPressed default False; + property Action; + property Align; + property Anchors; + property AutoTranslate default True; + property CanFocus default True; + property CanParentFocus; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Corners; + property CornerType; + property Cursor default crDefault; + property DisableFocusEffect; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property StyledSettings; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Images; + property ImageIndex; + { triggers } + property IsPressed default False; + + property Locked default False; + property Padding; + property ModalResult default mrNone; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RepeatClick default False; + property RotationAngle; + property RotationCenter; + property Scale; + property Sides; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property Text; + property TextSettings; + property TouchTargetExpansion; + property Visible; + property Width; + property XRadius; + property YRadius; + property ParentShowHint; + property ShowHint; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TCheckBox } + + TCheckBox = class(TPresentedTextControl, IIsChecked) + private + FPressing: Boolean; + FOnChange: TNotifyEvent; + FIsPressed: Boolean; + FIsChecked: Boolean; + FIsPan: Boolean; + function GetIsChecked: Boolean; + procedure SetIsChecked(const Value: Boolean); + function IsCheckedStored: Boolean; + protected + procedure DoExit; override; + procedure ApplyStyle; override; + procedure FreeStyle; override; + function CanObserve(const ID: Integer): Boolean; override; + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + function GetDefaultSize: TSizeF; override; + function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; override; + function TryValueIsChecked(const Value: TValue; out IsChecked: Boolean): Boolean; + { IAcceleratorKeyReceiver } + /// Overrides TPresentedTextControl.TriggerAcceleratorKey. The behaviour is to check/uncheck the + /// box control. + procedure TriggerAcceleratorKey; override; + public + constructor Create(AOwner: TComponent); override; + procedure SetNewScene(AScene: IScene); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure MouseMove(Shift: TShiftState; X, Y: Single); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override; + property IsPressed: Boolean read FIsPressed default False; + property Font; + property TextAlign; + property WordWrap; + published + property Action; + property Align; + property Anchors; + property AutoTranslate default True; + property CanFocus default True; + property CanParentFocus; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Cursor default crDefault; + property DisableFocusEffect; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property StyledSettings; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property IsChecked: Boolean read GetIsChecked write SetIsChecked stored IsCheckedStored default False; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property Text; + property TextSettings; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TRadioButton } + + TRadioButtonGroupMessage = class(TMessage) + private + FGroupName: string; + public + constructor Create(const AGroupName: string); + property GroupName: string read FGroupName; + end; + + TRadioButton = class(TPresentedTextControl, IGroupName, IIsChecked) + private + FPressing: Boolean; + FOnChange: TNotifyEvent; + FIsPressed: Boolean; + FIsChecked: Boolean; + FGroupName: string; + function GetIsChecked: Boolean; + procedure SetIsChecked(const Value: Boolean); + function IsCheckedStored: Boolean; + function GetGroupName: string; + procedure SetGroupName(const Value: string); + function GroupNameStored: Boolean; + procedure GroupMessageCall(const Sender : TObject; const M : TMessage); + protected + procedure ApplyStyle; override; + procedure FreeStyle; override; + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + function GetDefaultSize: TSizeF; override; + function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; override; + { IAcceleratorKeyReceiver } + /// Overrides TPresentedTextControl.TriggerAcceleratorKey. The behavior is to check the + /// radio control. + procedure TriggerAcceleratorKey; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SetNewScene(AScene: IScene); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure MouseMove(Shift: TShiftState; X, Y: Single); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override; + property IsPressed: Boolean read FIsPressed; + property TextAlign; + property Font; + property WordWrap; + published + property Action; + property Align; + property Anchors; + property AutoTranslate default True; + property CanFocus default True; + property CanParentFocus; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Cursor default crDefault; + property DisableFocusEffect; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property StyledSettings; + property GroupName: string read GetGroupName write SetGroupName stored GroupNameStored nodefault; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + { triggers } + property IsChecked: Boolean read GetIsChecked write SetIsChecked stored IsCheckedStored default False; + + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property Text; + property TextSettings; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TGroupBox } + + TGroupBox = class(TPresentedTextControl) + protected + procedure DefineProperties(Filer: TFiler); override; + function GetDefaultSize: TSizeF; override; + function StyledSettingsStored: Boolean; override; + function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; override; + public + constructor Create(AOwner: TComponent); override; + property Font; + published + property Action; + property Align; + property Anchors; + property AutoTranslate default True; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property StyledSettings; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property Text; + property TextSettings; + property TouchTargetExpansion; + property Visible; + property Width; + property TabOrder; + property TabStop; + property ParentShowHint; + property ShowHint; + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TStatusBar } + + TStatusBar = class(TPresentedControl, IHintReceiver) + private + FShowSizeGrip: Boolean; + FOnHint: TNotifyEvent; + FAutoHint: Boolean; + procedure SetShowSizeGrip(const Value: Boolean); + protected + procedure ApplyStyle; override; + procedure DefineProperties(Filer: TFiler); override; + function GetDefaultSize: TSizeF; override; + /// Reimplementation of changing root in order the control to be unregistered from the old root + /// and registered to the new one. This is useful for the control to be registered on unregistered as a hint + /// receiver. + procedure DoRootChanging(const NewRoot: IRoot); override; + { IHintReceiver } + /// Implementation of IHintReceiver.TriggerOnHint. + procedure TriggerOnHint; + /// Method to trigger the OnHint event. + function DoHint: Boolean; virtual; + public + constructor Create(AOwner: TComponent); override; + published + property Action; + property Align default TAlignLayout.Bottom; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property ShowSizeGrip: Boolean read FShowSizeGrip write SetShowSizeGrip; + property Size; + property StyleLookup; + property TouchTargetExpansion; + property Visible; + property Width; + property TabOrder; + property TabStop; + property ParentShowHint; + property ShowHint; + /// Use this property to enable/disable the OnHint event. + property AutoHint: Boolean read FAutoHint write FAutoHint default False; + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + + /// Event to be triggered when the application catches a hint. + property OnHint: TNotifyEvent read FOnHint write FOnHint; + end; + +{ TToolBar } + + TToolBar = class(TPresentedControl) + private + FTintColor: TAlphaColor; + FTintObject: ITintedObject; + procedure SetTintColor(const Value: TAlphaColor); + function IsTintColorStored: Boolean; + protected + procedure ApplyStyle; override; + procedure FreeStyle; override; + procedure DefineProperties(Filer: TFiler); override; + function GetDefaultSize: TSizeF; override; + public + constructor Create(AOwner: TComponent); override; + property TintObject: ITintedObject read FTintObject; + published + property Action; + property Align default TAlignLayout.Top; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TintColor: TAlphaColor read FTintColor write SetTintColor stored IsTintColorStored; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + property OnApplyStyleLookup; + property OnFreeStyle; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnKeyDown; + property OnKeyUp; + property OnCanFocus; + property OnClick; + property OnDblClick; + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TSizeGrip } + + TSizeGrip = class(TStyledControl, ISizeGrip) + protected + procedure DefineProperties(Filer: TFiler); override; + public + constructor Create(AOwner: TComponent); override; + published + property Action; + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TSplitter } + + TSplitter = class(TStyledControl) + private + FPressed: Boolean; + FControl: TControl; + FDownPos: TPointF; + FMinSize: Single; + FMaxSize: Single; + FNewSize, FOldSize: Single; + FSplit: Single; + FShowGrip: Boolean; + procedure SetShowGrip(const Value: Boolean); + protected + procedure ApplyStyle; override; + procedure DefineProperties(Filer: TFiler); override; + procedure Paint; override; + procedure SetAlign(const Value: TAlignLayout); override; + function FindObject: TControl; + procedure CalcSplitSize(X, Y: Single; var NewSize, Split: Single); + procedure UpdateSize(X, Y: Single); + function DoCanResize(var NewSize: Single): Boolean; + procedure UpdateControlSize; + function GetDefaultSize: TSizeF; override; + public + constructor Create(AOwner: TComponent); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure MouseMove(Shift: TShiftState; X, Y: Single); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + published + property Action; + property Align; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property MinSize: Single read FMinSize write FMinSize; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property ShowGrip: Boolean read FShowGrip write SetShowGrip default True ; + property Size; + property StyleLookup; + property TouchTargetExpansion; + property Visible; + property Width; + property TabStop; + property ParentShowHint; + property ShowHint; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TProgressBar } + + TProgressBar = class(TPresentedControl, IValueRange) + private + FOrientation: TOrientation; + FValueRange: TValueRange; + FDefaultValueRange: TBaseValueRange; + procedure SetOrientation(const Value: TOrientation); + function GetMax: Double; + function GetMin: Double; + function GetValue: Double; + procedure SetMax(const Value: Double); + procedure SetMin(const Value: Double); + procedure SetValue(const Value: Double); + function GetValueRange: TCustomValueRange; + procedure SetValueRange(const AValue: TCustomValueRange); + function DefStored: Boolean; + procedure ChangedProc(Sender: TObject); + function MaxStored: Boolean; + function MinStored: Boolean; + function ValueStored: Boolean; + protected + function ChooseAdjustType(const FixedSize: TSize): TAdjustType; override; + procedure ApplyStyle; override; + procedure DefineProperties(Filer: TFiler); override; + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + procedure DoRealign; override; + function GetActionLinkClass: TActionLinkClass; override; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + procedure AfterChangeProc(Sender: TObject); virtual; + property DefaultValueRange: TBaseValueRange read FDefaultValueRange; + procedure Loaded; override; + function GetDefaultSize: TSizeF; override; + public + constructor Create(AOwner: TComponent); override; + procedure AfterConstruction; override; + destructor Destroy; override; + published + property Action; + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property Max: Double read GetMax write SetMax stored MaxStored nodefault; + property Min: Double read GetMin write SetMin stored MinStored nodefault; + property Opacity; + property Orientation: TOrientation read FOrientation write SetOrientation; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TouchTargetExpansion; + property Value: Double read GetValue write SetValue stored ValueStored nodefault; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TThumb } + + TCustomTrack = class; + + TThumb = class(TStyledControl) + private + [Weak] FTrack: TCustomTrack; + FDownOffset: TPointF; + FPressed: Boolean; + function PointToValue(X, Y: Single): Double; + public + constructor Create(AOwner: TComponent); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure MouseMove(Shift: TShiftState; X, Y: Single); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + function GetDefaultTouchTargetExpansion: TRectF; override; + property IsPressed: Boolean read FPressed; + published + property Action; + property Align; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + + TMouseDownAction = (&Goto, None); + +{ TCustomTrack } + + TCustomTrack = class(TPresentedControl, IValueRange) + private const + FirstInterval = 10; + SecondInterval = 500; + OtherInterval = 20; + private + FValueRange: TValueRange; + FDefaultValueRange: TBaseValueRange; + [Weak] FThumb: TThumb; + FMouseDownAction: TMouseDownAction; + FPushedValue: Double; + FPushedSign: TValueSign; + FPushedShift: TShiftState; + FPushedTimer: TTimer; + FSmallChange: Double; + function GetIsTracking: Boolean; + procedure SetMax(const Value: Double); + procedure SetMin(const Value: Double); + procedure SetValue(Value: Double); + procedure SetFrequency(const Value: Double); + procedure SetViewportSize(const Value: Double); + function GetFrequency: Double; + function GetMax: Double; + function GetMin: Double; + function GetValue: Double; + function GetViewportSize: Double; + function GetValueRange: TCustomValueRange; + procedure SetValueRange(const AValue: TCustomValueRange); + procedure SetValueRange_(const Value: TValueRange); + function DefStored: Boolean; + procedure SetNewValue(const LValue: Double); + procedure UpdateHighlight; + function FrequencyStored: Boolean; + function MaxStored: Boolean; + function MinStored: Boolean; + function ValueStored: Boolean; + function ViewportSizeStored: Boolean; + procedure ObserversValueUpdate; + function GetIncrement: Double; + function DoSmallChange(N: Integer; const TargetValue: Double): Boolean; + function MousePosToValue(const MousePos: TPointF): Single; + procedure TimerProc(Sender: TObject); + protected + FOnChange, FOnTracking: TNotifyEvent; + FIgnoreViewportSize: Boolean; + FOrientation: TOrientation; + FTracking: Boolean; + FTrack: TControl; + FTrackHighlight: TControl; + FThumbSize: Single; + FMinThumbSize: Single; + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + function CanObserve(const ID: Integer): Boolean; override; + procedure SetOrientation(const Value: TOrientation); virtual; + function GetThumbRect(Value: single): TRectF; overload; virtual; + function GetThumbRect: TRectF; overload; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure DoMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single; LValue: Single); virtual; + procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override; + procedure ApplyStyle; override; + procedure FreeStyle; override; + function ChooseAdjustType(const FixedSize: TSize): TAdjustType; override; + function GetDefaultTouchTargetExpansion: TRectF; override; + procedure DoThumbClick(Sender: TObject); virtual; + procedure DoThumbDblClick(Sender: TObject); virtual; + function GetThumbSize(var IgnoreViewportSize: Boolean): Integer; virtual; + procedure DoRealign; override; + function GetActionLinkClass: TActionLinkClass; override; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + procedure Loaded; override; + procedure DoChanged; virtual; + procedure DoTracking; virtual; + function GetDefaultSize: TSizeF; override; + function CreateValueRangeTrack : TValueRange; virtual; + property MouseDownAction: TMouseDownAction read FMouseDownAction write FMouseDownAction; + property DefaultValueRange: TBaseValueRange read FDefaultValueRange; + procedure Resize; override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AfterConstruction; override; + property ValueRange: TValueRange read FValueRange write SetValueRange_ stored ValueStored; + property IsTracking: Boolean read GetIsTracking; + property Min: Double read GetMin write SetMin stored MinStored nodefault; + property Max: Double read GetMax write SetMax stored MaxStored nodefault; + property Frequency: Double read GetFrequency write SetFrequency stored FrequencyStored nodefault; + ///Controls the number of positions this track bar's thumb moves on each pressing of the free area + property SmallChange: Double read FSmallChange write FSmallChange; + property Value: Double read GetValue write SetValue stored ValueStored nodefault; + property ViewportSize: Double read GetViewportSize write SetViewportSize stored ViewportSizeStored nodefault; + property Orientation: TOrientation read FOrientation write SetOrientation; + property Tracking: Boolean read FTracking write FTracking default True; + property Thumb: TThumb read FThumb; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnTracking: TNotifyEvent read FOnTracking write FOnTracking; + end; + +{ TTrack } + + TTrack = class(TCustomTrack) + published + property Action; + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Frequency; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property Max; + property Min; + property Opacity; + property Orientation; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Tracking; + property Value; + property ViewportSize; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + property OnChange; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TTrackBar } + + TTrackBar = class(TCustomTrack) + public + constructor Create(AOwner: TComponent); override; + published + property Action; + property Align; + property Anchors; + property CanFocus default True; + property CanParentFocus; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property ControlType; + property DisableFocusEffect; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Frequency; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property Max; + property Min; + property Orientation; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Tracking; + property Value; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + property OnChange; + property OnTracking; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TBitmapTrackBar } + + TBitmapTrackBar = class(TTrackBar) + protected + FBitmap: TBitmap; + FBackground: TShape; + procedure ApplyStyle; override; + procedure FreeStyle; override; + procedure DoRealign; override; + function GetDefaultStyleLookupName: string; override; + procedure UpdateBitmap; + procedure FillBitmap; virtual; + procedure SetOrientation(const Value: TOrientation); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + end; + +{ TSwitch } + +const + MM_VALUE_CHANGED = MM_USER + 1; + +type + + /// Data model for the TSwitch control. + TSwitchModel = class(TDataModel) + private + FValue: Boolean; + FOnSwitch: TNotifyEvent; + procedure SetValue(AValue: Boolean); + protected + /// Invokes OnSwitch event handler + procedure DoChanged; virtual; + public + /// Invokes OnSwitch event handler + procedure Change; + public + /// Property representing the boolean value of the switch. When the switch is On, the boolean value is + /// True. When the switch is Off, the boolean value is False. + property Value: Boolean read FValue write SetValue; + /// Event handler is called, when TSwitch changed IsChecked + property OnSwitch: TNotifyEvent read FOnSwitch write FOnSwitch; + end; + + /// Represents a two-way on/off switch for use in + /// applications. + TCustomSwitch = class(TPresentedControl, IIsChecked) + private type + TNeededToDo = set of (SetChecked, CallClick); + private + FNeededToDo: TNeededToDo; + function GetModel: TSwitchModel; overload; + procedure SetOnSwitch(const Value: TNotifyEvent); + function GetOnSwitch: TNotifyEvent; + { IIsChecked } + procedure SetIsChecked(const AValue: Boolean); + function GetIsChecked: Boolean; + function IsCheckedStored: Boolean; + protected + { Actions } + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + function GetActionLinkClass: TActionLinkClass; override; + { Live Binding } + function CanObserve(const ID: Integer): Boolean; override; + procedure SetData(const Value: TValue); override; + function GetData: TValue; override; + { Mouse Events } + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure Click; override; + function GetDefaultTouchTargetExpansion: TRectF; override; + function DefineModelClass: TDataModelClass; override; + /// This virtual method is performed after changing the IsChecked property. By default, it executes the + /// event handler OnSwitch + procedure DoSwitch; virtual; + function GetDefaultSize: TSizeF; override; + public + constructor Create(AOwner: TComponent); override; + /// Property to retrieve the data model of the switch control. + property Model: TSwitchModel read GetModel; + public + /// True if switch is turned on. Returns False otherwise. + property IsChecked: Boolean read GetIsChecked write SetIsChecked stored IsCheckedStored; + /// Event handler is being invoked, when switch changes value IsChecked. + property OnSwitch: TNotifyEvent read GetOnSwitch write SetOnSwitch; + end; + + TSwitch = class(TCustomSwitch) + published + property Action; + property Align; + property Anchors; + property CanFocus default True; + property CanParentFocus; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property Hint; + property HitTest default True; + property IsChecked; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + property OnApplyStyleLookup; + property OnFreeStyle; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnKeyDown; + property OnKeyUp; + property OnCanFocus; + property OnClick; + property OnDblClick; + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + property OnSwitch; + end; + +{ TScrollBar } + + TScrollBar = class(TStyledControl) + private + FValueRange: TValueRange; + FTrackChanging: Boolean; + FOnChange: TNotifyEvent; + FOrientation: TOrientation; + FTrack: TCustomTrack; + FMinButton: TCustomButton; + FMaxButton: TCustomButton; + FSmallChange: Double; + FDefaultValueRange: TBaseValueRange; + procedure SetMax(const Value: Double); + procedure SetMin(const Value: Double); + procedure SetValue(const Value: Double); + procedure SetViewportSize(const Value: Double); + function GetMax: Double; + function GetMin: Double; + function GetValue: Double; + function GetViewportSize: Double; + function GetValueRange: TValueRange; + procedure SetValueRange(const Value: TValueRange); + procedure SetOrientation(const Value: TOrientation); + function DefStored: Boolean; + procedure TrackChangedProc(Sender: TObject); + procedure FreeTrack; + function GetSmallChange: Double; + procedure SetSmallChange(const Value: Double); + function SmallChangeStored: Boolean; + function GetIncrement: Double; + procedure DoSmallChange(N: Integer); + function MaxStored: Boolean; + function MinStored: Boolean; + function ValueStored: Boolean; + function ViewportSizeStored: Boolean; + protected + procedure DoMinButtonClick(Sender: TObject); + procedure DoMaxButtonClick(Sender: TObject); + procedure ApplyStyle; override; + procedure FreeStyle; override; + function CanObserve(const ID: Integer): Boolean; override; + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override; + function GetActionLinkClass: TActionLinkClass; override; + procedure DoActionClientChanged; override; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + property Track: TCustomTrack read FTrack; + property MinButton: TCustomButton read FMinButton; + property MaxButton: TCustomButton read FMaxButton; + procedure DoChanged; virtual; + procedure DefineProperties(Filer: TFiler); override; + function GetDefaultSize: TSizeF; override; + procedure Loaded; override; + property DefaultValueRange: TBaseValueRange read FDefaultValueRange; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AfterConstruction; override; + property ValueRange: TValueRange read GetValueRange write SetValueRange; + published + property Action; + property Align; + property Anchors; + property CanFocus default False; + property CanParentFocus default False; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property Max: Double read GetMax write SetMax stored MaxStored nodefault; + property Min: Double read GetMin write SetMin stored MinStored nodefault; + property Value: Double read GetValue write SetValue stored ValueStored nodefault; + property ViewportSize: Double read GetViewportSize write SetViewportSize stored ViewportSizeStored nodefault; + property SmallChange: Double read GetSmallChange write SetSmallChange stored SmallChangeStored nodefault; + property Orientation: TOrientation read FOrientation write SetOrientation; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TSmallScrollBar } + + TSmallScrollBar = class(TScrollBar) + protected + procedure ApplyStyle; override; + function GetDefaultSize: TSizeF; override; + public + constructor Create(AOwner: TComponent); override; + end; + +{ TAniIndicator } + + TAniIndicatorStyle = (Linear, Circular); + + TAniIndicator = class(TStyledControl) + public const + DefaultEnabled = False; + private type + TRotationControl = class(TControl) + public + property RotationAngle; + end; + private + FLayout: TControl; + FAni: TAnimation; + FStyle: TAniIndicatorStyle; + FFill: TBrush; + procedure SetStyle(const Value: TAniIndicatorStyle); + protected + procedure ApplyStyle; override; + procedure FreeStyle; override; + procedure SetEnabled(const Value: Boolean); override; + procedure DefineProperties(Filer: TFiler); override; + procedure Paint; override; + function EnabledStored: Boolean; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Action; + property Align; + property Anchors; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled stored EnabledStored default DefaultEnabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property StyleLookup; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property Style: TAniIndicatorStyle read FStyle write SetStyle default TAniIndicatorStyle.Linear; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TArcDial } + + TArcDial = class(TPresentedControl, IValueRange) + private + FValueRange: TValueRange; + FValueChanged: Boolean; + FPressing: Boolean; + FOnChange: TNotifyEvent; + FSaveValue: Double; + FTracking: Boolean; + FShowValue: Boolean; + FOldValue: Double; + FDefaultValueRange: TBaseValueRange; + procedure SetValue(const Value: Double); + procedure SetShowValue(const Value: Boolean); + function DefStored: Boolean; + function GetValueRange: TCustomValueRange; + procedure SetValueRange(const AValue: TCustomValueRange); + procedure SetValueRange_(const Value: TValueRange); + function GetValue: Double; + function GetFrequency: Double; + procedure SetFrequency(const Value: Double); + function FrequencyStored: Boolean; + function ValueStored: Boolean; + protected + function Tick: TControl; + function Text: TText; + procedure ApplyStyle; override; + function CanObserve(const ID: Integer): Boolean; override; + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + procedure Loaded; override; + function GetActionLinkClass: TActionLinkClass; override; + procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override; + procedure BeforeChangeProc(Sender: TObject); + procedure ValueRangeChangeProc(Sender: TObject); + procedure AfterChangedProc(Sender: TObject); virtual; + function GetDefaultSize: TSizeF; override; + property DefaultValueRange: TBaseValueRange read FDefaultValueRange; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AfterConstruction; override; + property ValueRange: TValueRange read FValueRange write SetValueRange_; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + procedure MouseMove(Shift: TShiftState; X, Y: Single); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; + published + { props } + property Action; + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property ControlType; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property ShowValue: Boolean read FShowValue write SetShowValue default False; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Tracking: Boolean read FTracking write FTracking default True; + property Value: Double read GetValue write SetValue stored ValueStored nodefault; + property Frequency: Double read GetFrequency write SetFrequency stored FrequencyStored nodefault; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TExpanderButton } + + TExpanderButton = class(TCustomButton) + public + constructor Create(AOwner: TComponent); override; + published + property Action; + property Align; + property Anchors; + property AutoTranslate default True; + property CanFocus default False; + property CanParentFocus; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DisableFocusEffect; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Font; + property StyledSettings; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + { triggers } + property StaysPressed default False; + property IsPressed default False; + + property Locked default False; + property Padding; + property ModalResult default mrNone; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RepeatClick default False; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property Text; + property TextAlign default TTextAlign.Center; + property TouchTargetExpansion; + property Visible; + property Width; + property WordWrap default False; + property ParentShowHint; + property ShowHint; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + + TExpander = class(TTextControl) + public const + /// Default header height + cDefaultHeaderHeight = 25; + private + FShowCheck: Boolean; + FIsChecked: Boolean; + FOnCheckChange: TNotifyEvent; + FContentHeight: Integer; + FHeader: TControl; + FHeaderHeight: Integer; + FStyleHeaderHeight: Integer; + FOnExpandedChanging: TNotifyEvent; + FOnExpandedChanged: TNotifyEvent; + FChangingState: Boolean; + procedure HandleButtonClick(Sender: TObject); + procedure HandleCheckChange(Sender: TObject); + procedure SetIsChecked(const Value: Boolean); + procedure SetIsExpanded(const Value: Boolean); + procedure SetShowCheck(const Value: Boolean); + procedure UpdateControlSize(const ChangingState: Boolean); + procedure ExpandedChanging; + procedure ExpandedChanged; + protected + FIsExpanded: Boolean; + FContent: TContent; + FButton: TCustomButton; + FCheck: TCheckBox; + procedure ApplyStyle; override; + procedure FreeStyle; override; + procedure DoRealign; override; + procedure DoStyleChanged; override; + procedure DefineProperties(Filer: TFiler); override; + procedure ReadContentSize(Reader: TReader); + procedure WriteContentSize(Writer: TWriter); + procedure DoAddObject(const AObject: TFmxObject); override; + procedure UpdateContentSize; + procedure DoResized; override; + function DoSetSize(const ASize: TControlSize; const NewPlatformDefault: Boolean; ANewWidth, ANewHeight: Single; + var ALastWidth, ALastHeight: Single): Boolean; override; + function GetDefaultSize: TSizeF; override; + /// Called when expanded state is going to change + procedure DoExpandedChanging; virtual; + /// Called when expanded state just has changed + procedure DoExpandedChanged; virtual; + /// Called when checked state just has changed + procedure DoCheckedChanged; virtual; + function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; override; + procedure SetHeaderHeight(const Value: Integer); + function GetHeaderHeight: Integer; + /// Evaluate header height that will be used based on style availability and property value + function EffectiveHeaderHeight: Integer; + /// Evaluate default header height based on style availability + function DefaultHeaderHeight: Integer; + public + constructor Create(AOwner: TComponent); override; + function GetTabList: ITabList; override; + published + property Action; + property Align; + property Anchors; + property AutoTranslate default True; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property StyledSettings; + property TextSettings; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + /// Allows to customize header height. Default value is -1. + /// When the value is -1, if the style defines a header element style element height will be taken + /// for a default. If no such style element is defined, the value of + /// will be taken in + property HeaderHeight: Integer read GetHeaderHeight write SetHeaderHeight default -1; + /// True if the checkbox is used and is checked (the content is enabled). + /// See , + /// + /// + property IsChecked: Boolean read FIsChecked write SetIsChecked default True; + /// True if expanded + /// Setting this property to True will expand the control, + /// False will collapse. Before the state is changed, + /// event will be called. User can + /// abort this operation by invoking in the handler. + /// event will be invoked after the state change. + /// + property IsExpanded: Boolean read FIsExpanded write SetIsExpanded default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + /// Setting to True will show a check box that enables or disables the content + property ShowCheck: Boolean read FShowCheck write SetShowCheck; + property Size; + property StyleLookup; + property Text; + property TouchTargetExpansion; + property Visible; + property Width; + property TabOrder; + property TabStop; + property ParentShowHint; + property ShowHint; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + /// Called when checkbox state is changed + property OnCheckChange: TNotifyEvent read FOnCheckChange write FOnCheckChange; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + /// Called when checkbox state is about to change. Can be aborted by EAbort + property OnExpandedChanging: TNotifyEvent read FOnExpandedChanging write FOnExpandedChanging; + /// Called when checkbox state has changed + property OnExpandedChanged: TNotifyEvent read FOnExpandedChanged write FOnExpandedChanged; + end; + + TImageLoadedEvent = procedure (Sender: TObject; const FileName: string) of object; + + TImageControl = class(TStyledControl) + private + FImage: TImage; + FOnChange: TNotifyEvent; + FBitmap: TBitmap; + FEnableOpenDialog: Boolean; + FOnLoaded: TImageLoadedEvent; + procedure SetBitmap(const Value: TBitmap); + procedure UpdateImage; + protected + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + function CanObserve(const ID: Integer): Boolean; override; + procedure ApplyStyle; override; + procedure FreeStyle; override; + procedure Click; override; + procedure DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); override; + procedure DragDrop(const Data: TDragObject; const Point: TPointF); override; + procedure DoBitmapChanged(Sender: TObject); virtual; + procedure DoLoadFromFile(const FileName: string); virtual; + function GetDefaultSize: TSizeF; override; + property Image: TImage read FImage; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure LoadFromFile(const FileName: string); + function ShowOpenDialog: Boolean; + published + property Action; + property Align; + property Anchors; + property Bitmap: TBitmap read FBitmap write SetBitmap; + property CanFocus default True; + property CanParentFocus; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property DisableFocusEffect; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property EnableOpenDialog: Boolean read FEnableOpenDialog write FEnableOpenDialog default True; + property Enabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest default True; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnLoaded: TImageLoadedEvent read FOnLoaded write FOnLoaded; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +{ TPathLabel } + + TPathLabel = class(TStyledControl) + private + FPath: TCustomPath; + function GetWrapMode: TPathWrapMode; + procedure SetWrapMode(const Value: TPathWrapMode); + function GetPathData: TPathData; + procedure SetPathData(const Value: TPathData); + protected + procedure ApplyStyle; override; + procedure FreeStyle; override; + procedure DefineProperties(Filer: TFiler); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Action; + property Align; + property Anchors; + property ClipChildren default False; + property ClipParent default False; + property Cursor default crDefault; + property Data: TPathData read GetPathData write SetPathData; + property DragMode default TDragMode.dmManual; + property EnableDragHighlight default True; + property Enabled; + property Locked default False; + property Height; + property HelpContext; + property HelpKeyword; + property Hint; + property HitTest default False; + property Padding; + property Opacity; + property Margins; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TouchTargetExpansion; + property Visible; + property Width; + property WrapMode: TPathWrapMode read GetWrapMode write SetWrapMode + default TPathWrapMode.Stretch; + property ParentShowHint; + property ShowHint; + + {events} + property OnApplyStyleLookup; + property OnFreeStyle; + {Drag and Drop events} + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + {Keyboard events} + property OnKeyDown; + property OnKeyUp; + {Mouse events} + property OnCanFocus; + property OnClick; + property OnDblClick; + + property OnEnter; + property OnExit; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + end; + +//== UNIT END: FMX.StdCtrls +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.ScrollBox (from FMX.ScrollBox.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +const + MM_AUTOHIDE_CHANGED = MM_USER + 1; + MM_BOUNCES_CHANGED = MM_USER + 2; + MM_DISABLE_MOUSE_WHEEL_CHANGED = MM_USER + 3; + MM_ENABLED_SCROLL_CHANGED = MM_USER + 4; + MM_SCROLLBAR_VISIBLE_CHANGED = MM_USER + 5; + MM_SHOW_SIZE_GRIP_CHANGED = MM_USER + 6; + MM_SHOW_SCROLLBAR_CHANGED = MM_USER + 7; + MM_GET_VIEWPORT_POSITION = MM_USER + 8; + MM_SET_VIEWPORT_POSITION = MM_USER + 9; + MM_GET_VIEWPORT_SIZE = MM_USER + 10; + MM_SCROLL_ANIMATION_CHANGED = MM_USER + 11; + MM_SCROLL_DIRECTIONS_CHANGED = MM_USER + 12; + MM_SET_CONTENT_BOUNDS = MM_USER + 13; + MM_TOUCH_TRACKING_CHANGED = MM_USER + 14; + MM_SCROLLBOX_USER = MM_USER + 15; + + PM_SCROLL_BY = PM_USER + 1; + PM_SCROLL_IN_RECT = PM_USER + 2; + PM_SET_CONTENT = PM_USER + 3; + PM_GET_CONTENT_LAYOUT = PM_USER + 4; + PM_GET_VSCROLLBAR = PM_USER + 5; + PM_GET_HSCROLLBAR = PM_USER + 6; + PM_GET_ANICALCULATIONS = PM_USER + 7; + PM_BEGIN_PAINT_CHILDREN = PM_USER + 8; + PM_END_PAINT_CHILDREN = PM_USER + 9; + PM_USER_SCROLLBOX = PM_USER + 10; + +type + + { TScrollBox } + + TCustomPresentedScrollBox = class; + + /// Event type for notification about ScrollBox changed position of content + TPositionChangeEvent = procedure (Sender: TObject; const OldViewportPosition, NewViewportPosition: TPointF; + const ContentSizeChanged: Boolean) of object; + /// Event type for correcting content size, which was calculated automatically. + TOnCalcContentBoundsEvent = procedure (Sender: TObject; var ContentBounds: TRectF) of object; + + /// Stores the settings of scrolling behavior of ScrollBox's content. + TScrollOptions = class(TPersistent) + public const + DefaultAutoHideScrollBars = TBehaviorBoolean.PlatformDefault; + DefaultBounces = TBehaviorBoolean.PlatformDefault; + DefaultEnabledScroll = True; + DefaultShowScrollBars = True; + DefaultScrollAnimation = TBehaviorBoolean.PlatformDefault; + DefaultTouchTracking = TBehaviorBoolean.PlatformDefault; + private + FScrollBox: TCustomPresentedScrollBox; + FAutoHideScrollBars: TBehaviorBoolean; + FBounces: TBehaviorBoolean; + FEnabledScroll: Boolean; + FScrollAnimation: TBehaviorBoolean; + FTouchTracking: TBehaviorBoolean; + FOnInternalChange: TNotifyEvent; + procedure SetAutoHideScrollBars(const Value: TBehaviorBoolean); + procedure SetBounces(const Value: TBehaviorBoolean); + procedure SetEnabledScroll(const Value: Boolean); + procedure SetScrollAnimation(const Value: TBehaviorBoolean); + procedure SetTouchTracking(const Value: TBehaviorBoolean); + protected + /// Notifies abount changes properties. + procedure DoChanged; virtual; + /// Copies the data to destination TScrollContentSize. + procedure AssignTo(Dest: TPersistent); override; + /// Returns option's owner. + function GetOwner: TPersistent; override; + public + /// Constructs object, extract from AOwner TCustomScrollBox and sets internal event handler + /// OnChange + constructor Create(AOwner: TComponent; const AOnChange: TNotifyEvent); + /// Event, which is invoked, when size was changed + property OnChange: TNotifyEvent read FOnInternalChange; + published + ///Defines that scrollbars are automatically hiding when scroll is done + property AutoHideScrollBars: TBehaviorBoolean read FAutoHideScrollBars write SetAutoHideScrollBars default DefaultAutoHideScrollBars; + ///Whether it is possible to scroll of content abroad + property Bounces: TBehaviorBoolean read FBounces write SetBounces; + ///Enable or disabled scroll + property EnabledScroll: Boolean read FEnabledScroll write SetEnabledScroll; + ///Enable or disabled scrolling animation + property ScrollAnimation: TBehaviorBoolean read FScrollAnimation write SetScrollAnimation default DefaultScrollAnimation; + ///Defines that control reacts on touch events + property TouchTracking: TBehaviorBoolean read FTouchTracking write SetTouchTracking default DefaultTouchTracking; + end; + + /// Stores the size of the ScrollBox content. + TScrollContentSize = class(TPersistent) + private + [Weak] FScrollBox: TCustomPresentedScrollBox; + FWidth: Single; + FHeight: Single; + FOnInternalChange: TNotifyEvent; + procedure SetHeight(const Value: Single); + procedure SetWidth(const Value: Single); + function GetSize: TSizeF; + procedure SetSize(const Value: TSizeF); + function StoreWidthHeight: Boolean; + protected + /// Notifies abount changed size (Width, Height) + procedure DoChanged; virtual; + /// Copies the data to destination TScrollContentSize + procedure AssignTo(Dest: TPersistent); override; + /// Returns owenr of the Data + function GetOwner: TPersistent; override; + /// Sets size without checks on AutoCalculateContentSize. Ignores IsReadOnly + procedure SetSizeWithoutChecks(const Value: TSizeF); + public + /// Constructs object, extract from AOwner TCustomScrollBox and sets internal event handler + /// OnChange + constructor Create(AOwner: TComponent; const AOnChange: TNotifyEvent); + /// Checks can we set size or not. It depends on TPresentedScrollBox.AutoCalculateContentSize + function IsReadOnly: Boolean; + /// Link on Owner ScrollBox + property ScrollBox: TCustomPresentedScrollBox read FScrollBox; + /// Size of content + property Size: TSizeF read GetSize write SetSize; + /// Event, which is invoked, when size was changed + property OnChange: TNotifyEvent read FOnInternalChange; + published + /// Width of content + property Width: Single read FWidth write SetWidth stored StoreWidthHeight; + /// Height of content + property Height: Single read FHeight write SetHeight stored StoreWidthHeight; + end; + + /// Directions of content scroll + TScrollDirections = (Both, Horizontal, Vertical); + + /// Model of TScrollBox data. + TCustomScrollBoxModel = class(TDataModel) + public const + DefaultAutoHide = TBehaviorBoolean.PlatformDefault; + DefaultAutoCalculateContentSize = True; + DefaultBounces = TBehaviorBoolean.PlatformDefault; + DefaultEnabledScroll = True; + DefaultShowScrollBars = True; + DefaultScrollAnimation = TBehaviorBoolean.PlatformDefault; + DefaultScrollDirections = TScrollDirections.Both; + DefaultTouchTracking = TBehaviorBoolean.PlatformDefault; + public type + TScrollByInfo = record + Vector: TPointF; + Animated: Boolean; + end; + TInViewRectInfo = record + Rect: TRectF; + Animated: Boolean; + end; + private + FAutoHide: TBehaviorBoolean; + FAutoCalculateContentSize: Boolean; + FBounces: TBehaviorBoolean; + FContentSize: TScrollContentSize; + FDisableMouseWheel: Boolean; + FEnabledScroll: Boolean; + FScrollAnimation: TBehaviorBoolean; + FScrollDirections: TScrollDirections; + FShowScrollBars: Boolean; + FShowSizeGrip: Boolean; + FViewportPosition: TPointF; + FTouchTracking: TBehaviorBoolean; + FOnCalcContentBounds: TOnCalcContentBoundsEvent; + FOnViewportPositionChange:TPositionChangeEvent; + procedure SetAutoHide(const Value: TBehaviorBoolean); + procedure SetBounces(const Value: TBehaviorBoolean); + procedure SetContentBounds(const Value: TRectF); + function GetContentBounds: TRectF; + procedure SetContentSize(const Value: TScrollContentSize); + procedure SetDisableMouseWheel(const Value: Boolean); + procedure SetEnabledScroll(const Value: Boolean); + procedure SetScrollAnimation(const Value: TBehaviorBoolean); + procedure SetScrollDirections(const Value: TScrollDirections); + procedure SetShowScrollBars(const Value: Boolean); + procedure SetShowSizeGrip(const Value: Boolean); + procedure SetTouchTracking(const Value: TBehaviorBoolean); + function GetViewportSize: TSizeF; + procedure SetViewportPosition(const Value: TPointF); + function GetViewportPosition: TPointF; + procedure DoContentSizeChanged(Sender: TObject); + public + constructor Create(const AOwner: TComponent); override; + destructor Destroy; override; + ///Invoked, when ScrollBox changed content position or size + procedure DoViewportPositionChange(const OldViewportPosition, NewViewportPosition: TPointF; const ContentSizeChanged: Boolean); virtual; + /// Need ScrollBox updates effects, when content is scrolled? (False by default) + function IsOpaque: Boolean; + ///Returns current content bounds. If content bounds size is calculati + property ContentBounds: TRectF read GetContentBounds write SetContentBounds; + ///Defines that scrollbars are automatically hiding when scroll is done + property AutoHide: TBehaviorBoolean read FAutoHide write SetAutoHide; + ///Indicates that the size of scrolling content calculates automatically according to the size of + ///components in content. Otherwise content size defines by the value of ContentSize property + property AutoCalculateContentSize: Boolean read FAutoCalculateContentSize write FAutoCalculateContentSize; + ///Whether it is possible to scroll of content abroad + property Bounces: TBehaviorBoolean read FBounces write SetBounces; + ///Current content size + property ContentSize: TScrollContentSize read FContentSize write SetContentSize; + ///Defines that control has no reaction on MouseWheel event + property DisableMouseWheel: Boolean read FDisableMouseWheel write SetDisableMouseWheel; + ///Enable or disabled scroll + property EnabledScroll: Boolean read FEnabledScroll write SetEnabledScroll; + ///Enable or disabled scrolling animation + property ScrollAnimation: TBehaviorBoolean read FScrollAnimation write SetScrollAnimation; + ///Defines avaiable scroll directions + property ScrollDirections: TScrollDirections read FScrollDirections write SetScrollDirections; + ///Defines scrollbars visibility + property ShowScrollBars: Boolean read FShowScrollBars write SetShowScrollBars; + ///Shows small control in the right-bottom corner that represent size changin control + property ShowSizeGrip: Boolean read FShowSizeGrip write SetShowSizeGrip; + ///Defines that control reacts on touch events + property TouchTracking: TBehaviorBoolean read FTouchTracking write SetTouchTracking; + ///Position of top-left point of view port at the ScrollBox's content. It is set in local coordinates of Content + property ViewportPosition: TPointF read GetViewportPosition write SetViewportPosition; + ///Returns the size of displaing area + property ViewportSize: TSizeF read GetViewportSize; + ///Event that raises after control calculates its content size + ///Raises only when AutoCalculateContentSize is true + property OnCalcContentBounds: TOnCalcContentBoundsEvent read FOnCalcContentBounds write FOnCalcContentBounds; + ///Raises when the value of ViewportPosition was changed + property OnViewportPositionChange: TPositionChangeEvent read FOnViewportPositionChange write FOnViewportPositionChange; + end; + + /// Container for the child controls of the scroll box. + TScrollContent = class(TContent, IIgnoreControlPosition) + private + [Weak] FScrollBox: TCustomPresentedScrollBox; + FOnGetClipRect: TOnCalcContentBoundsEvent; + protected + function GetClipRect: TRectF; override; + function ObjectAtPoint(P: TPointF): IControl; override; + function DoGetUpdateRect: TRectF; override; + procedure DoAddObject(const AObject: TFmxObject); override; + procedure DoInsertObject(Index: Integer; const AObject: TFmxObject); override; + procedure DoRemoveObject(const AObject: TFmxObject); override; + procedure ContentChanged; override; + { IIgnoreControlPosition } + function GetIgnoreControlPosition: Boolean; + public + constructor Create(AOwner: TComponent); override; + function PointInObjectLocal(X, Y: Single): Boolean; override; + public + ///Link to the ScrollBox that owns currect content instance + property ScrollBox: TCustomPresentedScrollBox read FScrollBox; + /// The handler for this event should return the clip rectangle + property OnGetClipRect: TOnCalcContentBoundsEvent read FOnGetClipRect write FOnGetClipRect; + end; + + ///Component allows view large content within a smaller visible area + TCustomPresentedScrollBox = class(TPresentedControl) + private + FContent: TScrollContent; + function GetModel: TCustomScrollBoxModel; overload; + procedure SetAutoHide(const Value: TBehaviorBoolean); + function GetAutoHide: TBehaviorBoolean; + procedure SetBounces(const Value: TBehaviorBoolean); + function GetBounces: TBehaviorBoolean; + procedure SetCalculateContentSize(const Value: Boolean); + function GetCalculateContentSize: Boolean; + procedure SetContentBounds(const Value: TRectF); + function GetContentBounds: TRectF; + procedure SetContentSize(const Value: TScrollContentSize); + function GetContentSize: TScrollContentSize; + procedure SetDisableMouseWheel(const Value: Boolean); + function GetDisableMouseWheel: Boolean; + procedure SetEnabledScroll(const Value: Boolean); + function GetEnabledScroll: Boolean; + procedure SetScrollAnimation(const Value: TBehaviorBoolean); + function GetScrollAnimation: TBehaviorBoolean; + procedure SetScrollDirections(const Value: TScrollDirections); + function GetScrollDirections: TScrollDirections; + procedure SetShowScrollBars(const Value: Boolean); + function GetShowScrollBars: Boolean; + procedure SetShowSizeGrip(const Value: Boolean); + function GetShowSizeGrip: Boolean; + procedure SetTouchTracking(const Value: TBehaviorBoolean); + function GetTouchTracking: TBehaviorBoolean; + procedure SetViewportPosition(const Value: TPointF); + function GetViewportPosition: TPointF; + function GetViewportSize: TSizeF; + procedure SetOnCalcContentBounds(const Value: TOnCalcContentBoundsEvent); + function GetOnCalcContentBounds: TOnCalcContentBoundsEvent; + procedure SetOnViewportPositionChange(const Value: TPositionChangeEvent); + function GetOnViewportPositionChange: TPositionChangeEvent; + { Streaming } + procedure ReadSizeValue(AReader: TReader; var ASize: Single); + procedure ReadViewportHeight(Reader: TReader); + procedure ReadViewportWidth(Reader: TReader); + procedure WriteViewportHeight(Writer: TWriter); + procedure WriteViewportWidth(Writer: TWriter); + function GetContentLayout: TControl; + function GetHScrollBar: TScrollBar; + function GetVScrollBar: TScrollBar; + function GetAniCalculations: TAniCalculations; + protected + procedure Loaded; override; + procedure PaddingChanged; override; + { Structure } + /// Create scroll content. Successors can override it for creating custom content. It allows add custom + /// information to content. + function CreateScrollContent: TScrollContent; virtual; + /// Performs filtering of adding objects and redirects adding of object to Content, if AObject is not + /// Effect, Animation or Style Object + /// It uses IsObjectForContent for defining content's object + procedure DoAddObject(const AObject: TFmxObject); override; + /// Performs filtering of inserting objects and redirects inserting of object to Content, if AObject + /// is not Effect, Animation or Style Object + /// It uses IsObjectForContent for defining content's object + procedure DoInsertObject(Index: Integer; const AObject: TFmxObject); override; + /// Remove object from Content or Children list + procedure DoRemoveObject(const AObject: TFmxObject); override; + { Painting } + procedure PaintChildren; override; + { Content } + /// Calculates content bounds by building convex shell of all children controls of Content + /// If ScrollBox uses Horizontal or Vertical ScrollDirections mode, It restricts the content size by + /// height or width + function DoCalcContentBounds: TRectF; virtual; + /// Defines, need to add AObject to Content or not. + function IsAddToContent(const AObject: TFmxObject): Boolean; virtual; + /// Invoked, when new Object was added into Content's childrens list. + procedure ContentAddObject(const AObject: TFmxObject); virtual; + /// Invoked, when new Object was inserted into Content's childrens list. + procedure ContentInsertObject(Index: Integer; const AObject: TFmxObject); virtual; + /// Invoked before removing Object from Content's childrens list. + procedure ContentBeforeRemoveObject(AObject: TFmxObject); virtual; + /// Invoked, when Object was removed from Content's childrens list. + procedure ContentRemoveObject(const AObject: TFmxObject); virtual; + { Events } + /// Need ScrollBox updates effects, when content is scrolled? (False by default) + function IsOpaque: Boolean; virtual; + /// Defines custom readers and writers for control properties for backward compatibility + procedure DefineProperties(Filer: TFiler); override; + ///Returns instance of class that provide scrolling physics calculations + ///Exists only for style presentation. For native presentation returns nil. + property AniCalculations: TAniCalculations read GetAniCalculations; + { Design Time Only } + /// Scrolls content in design time only + procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override; + protected + /// Defines a Model class (TDataModelClass by default) of TScrollBox + function DefineModelClass: TDataModelClass; override; + /// Initializes presentation + procedure InitPresentation(APresentation: TPresentationProxy); override; + public + constructor Create(AOwner: TComponent); override; + ///Change scroll position by offset defined in ADX and ADY + procedure ScrollBy(const ADX, ADY: Single; const AAnimated: Boolean = True); + ///Change scroll position to value defined in AX and AY + procedure ScrollTo(const AX, AY: Single; const AAnimated: Boolean = True); + ///Change scroll position to the top + procedure ScrollToTop(const AAnimated: Boolean = True); + ///Change scroll position to the center of content size + procedure ScrollToCenter(const AAnimated: Boolean = True); + ///Scrolls content to rectange defined in ARect + procedure InViewRect(const ARect: TRectF; const AAnimated: Boolean = True); + /// Sorts children of Content + procedure Sort(Compare: TFmxObjectSortCompare); override; + /// Returns TabList of Content + function GetTabList: ITabList; override; + { Update Content Size } + /// Recalculates content bounds. If you use the manual calcualting of ContentBounds, you need to set + /// through ContentBounds + /// This method doesn't calculate content bounds, if we don't use mode of auto calculating + /// (AutoCalculateContentSize = False) or control is being loaded or destroyed + /// (ComponentState = csLoading or csDestroying) + procedure UpdateContentSize; + ///Force content size calculation update + procedure RealignContent; + /// Content of ScrollBox. Contains controls placed into TScrollBox + /// Doesn't contain Style object, any kinds of Animation's and effect's objects + property Content: TScrollContent read FContent; + /// Returns current content bounds + property ContentBounds: TRectF read GetContentBounds write SetContentBounds; + /// Removes all controls from content + procedure ClearContent; + /// Model of TScrollBox + property Model: TCustomScrollBoxModel read GetModel; + ///Position of view port of the ScrollBox's content. It is set in local coordinates of Content + property ViewportPosition: TPointF read GetViewportPosition write SetViewportPosition; + /// Size of view port of the ScrollBox's content. + property ViewportSize: TSizeF read GetViewportSize; + { Deprecated } + ///Returns vertical scrollbar component + ///Available only for styled presentation. For native presentation returns nil + property VScrollBar: TScrollBar read GetVScrollBar; + ///Returns horisontal scrollbar component + ///Available only for styled presentation. For native presentation returns nil + property HScrollBar: TScrollBar read GetHScrollBar; + ///Returns control from style that is a surface for content in the scrollbox + property ContentLayout: TControl read GetContentLayout; + public + ///Indicates that the size of scrolling content calculates automatically according to the size of + ///components in content. Otherwise content size defines by the value of ContentSize property + property AutoCalculateContentSize: Boolean read GetCalculateContentSize write SetCalculateContentSize default True; + ///Defines that scrollbars are automatically hiding when scroll is done + property AutoHide: TBehaviorBoolean read GetAutoHide write SetAutoHide default TBehaviorBoolean.PlatformDefault; + ///Whether it is possible to scroll of content abroad + property Bounces: TBehaviorBoolean read GetBounces write SetBounces default TBehaviorBoolean.PlatformDefault; + ///Current content size + property ContentSize: TScrollContentSize read GetContentSize write SetContentSize; + ///Defines that control has no reaction on MouseWheel event + property DisableMouseWheel: Boolean read GetDisableMouseWheel write SetDisableMouseWheel default False; + ///Enable or disabled scroll + property EnabledScroll: Boolean read GetEnabledScroll write SetEnabledScroll default True; + ///Enable or disabled scrolling animation + property ScrollAnimation: TBehaviorBoolean read GetScrollAnimation write SetScrollAnimation default TBehaviorBoolean.PlatformDefault; + ///Defines avaiable scroll directions + property ScrollDirections: TScrollDirections read GetScrollDirections write SetScrollDirections default TScrollDirections.Both; + ///Defines scrollbars visibility + property ShowScrollBars: Boolean read GetShowScrollBars write SetShowScrollBars default True; + ///Shows small control in the right-bottom corner that represent size changin control + property ShowSizeGrip: Boolean read GetShowSizeGrip write SetShowSizeGrip default False; + ///Defines that control reacts on touch events + property TouchTracking: TBehaviorBoolean read GetTouchTracking write SetTouchTracking default TBehaviorBoolean.PlatformDefault; + ///Event that raises after control calculates its content size + ///Raises only when AutoCalculateContentSize is true + property OnCalcContentBounds: TOnCalcContentBoundsEvent read GetOnCalcContentBounds write SetOnCalcContentBounds; + ///Raises when the value of ViewportPosition was changed + property OnViewportPositionChange: TPositionChangeEvent read GetOnViewportPositionChange write SetOnViewportPositionChange; + end; + + /// A base scrollbox component available at design time. + TPresentedScrollBox = class(TCustomPresentedScrollBox) + published + property AutoCalculateContentSize; + property AutoHide; + property Bounces; + property ContentSize; + property ControlType; + property DisableMouseWheel; + property EnabledScroll; + property ScrollAnimation; + property ScrollDirections; + property ShowScrollBars; + property ShowSizeGrip; + property TouchTracking; + property OnViewportPositionChange; + property OnCalcContentBounds; + { Inherited } + property Align; + property Anchors; + property ClipChildren default True; + property ClipParent; + property Cursor; + property DragMode; + property Enabled; + property EnableDragHighlight; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest; + property Locked; + property Margins; + property Opacity; + property Padding; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + { Events } + property OnApplyStyleLookup; + property OnFreeStyle; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + end; + +{ TVertScrollBox } + + /// Scrollbox with vertical scroll support only. + TCustomPresentedVertScrollBox = class(TCustomPresentedScrollBox) + protected + function GetDefaultStyleLookupName: string; override; + public + constructor Create(AOwner: TComponent); override; + end; + + /// Scrollbox without border, with vertical scroll only. + TPresentedVertScrollBox = class(TCustomPresentedVertScrollBox) + published + property AutoCalculateContentSize; + property AutoHide; + property Bounces; + property ContentSize; + property ControlType; + property DisableMouseWheel; + property EnabledScroll; + property ScrollDirections default TScrollDirections.Vertical; + property ShowScrollBars; + property ShowSizeGrip; + property OnViewportPositionChange; + property OnCalcContentBounds; + { inhertied } + property Align; + property Anchors; + property ClipChildren; + property ClipParent; + property Cursor; + property DragMode; + property Enabled; + property EnableDragHighlight; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest; + property Locked; + property Margins; + property Opacity; + property Padding; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + { Events } + property OnApplyStyleLookup; + property OnFreeStyle; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + end; + +{ THorzScrollBox } + + /// Scrollbox with horizontal scroll support only. + TCustomPresentedHorzScrollBox = class(TCustomPresentedScrollBox) + protected + function GetDefaultStyleLookupName: string; override; + public + constructor Create(AOwner: TComponent); override; + end; + + /// Scrollbox without border, with horizontal scroll only + TPresentedHorzScrollBox = class(TCustomPresentedHorzScrollBox) + published + property AutoCalculateContentSize; + property AutoHide; + property Bounces; + property ContentSize; + property ControlType; + property DisableMouseWheel; + property EnabledScroll; + property ScrollDirections default TScrollDirections.Horizontal; + property ShowScrollBars; + property ShowSizeGrip; + property OnViewportPositionChange; + property OnCalcContentBounds; + { inhertied } + property Align; + property Anchors; + property ClipChildren; + property ClipParent; + property Cursor; + property DragMode; + property Enabled; + property EnableDragHighlight; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest; + property Locked; + property Margins; + property Opacity; + property Padding; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + { Events } + property OnApplyStyleLookup; + property OnFreeStyle; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + end; + +{ TFramedScrollBox } + + /// Scrollbox without border. + TCustomPresentedFramedScrollBox = class(TCustomPresentedScrollBox) + protected + function IsOpaque: Boolean; override; + end; + + /// Desing-time scrollbox without border. + TPresentedFramedScrollBox = class(TCustomPresentedFramedScrollBox) + published + property AutoCalculateContentSize; + property AutoHide; + property Bounces; + property ContentSize; + property ControlType; + property DisableMouseWheel; + property EnabledScroll; + property ScrollDirections; + property ShowScrollBars; + property ShowSizeGrip; + property OnViewportPositionChange; + property OnCalcContentBounds; + { inhertied } + property Align; + property Anchors; + property ClipChildren; + property ClipParent; + property Cursor; + property DragMode; + property Enabled; + property EnableDragHighlight; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest; + property Locked; + property Margins; + property Opacity; + property Padding; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + { Events } + property OnApplyStyleLookup; + property OnFreeStyle; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + end; + +{ TFramedVertScrollBox } + + /// Design-time scrollbox that only supports vertical scrolling. + TCustomPresentedFramedVertScrollBox = class(TCustomPresentedVertScrollBox) + protected + function IsOpaque: Boolean; override; + function GetDefaultStyleLookupName: string; override; + end; + + /// Scrollbox with vertical scroll only. + TPresentedFramedVertScrollBox = class(TCustomPresentedFramedVertScrollBox) + published + property AutoCalculateContentSize; + property AutoHide; + property Bounces; + property ContentSize; + property ControlType; + property DisableMouseWheel; + property EnabledScroll; + property ScrollDirections default TScrollDirections.Vertical; + property ShowScrollBars; + property ShowSizeGrip; + property OnViewportPositionChange; + property OnCalcContentBounds; + { inhertied } + property Align; + property Anchors; + property ClipChildren; + property ClipParent; + property Cursor; + property DragMode; + property Enabled; + property EnableDragHighlight; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest; + property Locked; + property Margins; + property Opacity; + property Padding; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + { Events } + property OnApplyStyleLookup; + property OnFreeStyle; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + end; + +/// Normalizes the target rectangle AContentRect. +function NormalizeInViewRect(const AContentRect: TRectF; const AViewportSize: TSizeF; const AWishedViewPortRect: TRectF): TRectF; + +//== UNIT END: FMX.ScrollBox +//================================================================================================== + +//================================================================================================== +//== UNIT START: FMX.Memo (from FMX.Memo.pas) +//================================================================================================== + +{$SCOPEDENUMS ON} + + +const + MM_MEMO_CARETCHANGED = MM_SCROLLBOX_USER + 1; + MM_MEMO_READONLY_CHANGED = MM_SCROLLBOX_USER + 2; + MM_MEMO_CHECKSPELLING_CHANGED = MM_SCROLLBOX_USER + 3; + MM_MEMO_IMEMODE_CHANGED = MM_SCROLLBOX_USER + 4; + MM_MEMO_KEYBOARDTYPE_CHANGED = MM_SCROLLBOX_USER + 5; + MM_MEMO_TEXT_SETTINGS_CHANGED = MM_SCROLLBOX_USER + 6; + MM_MEMO_AUTOSELECT_CHANGED = MM_SCROLLBOX_USER + 7; + MM_MEMO_CHARCASE_CHANGED = MM_SCROLLBOX_USER + 8; + MM_MEMO_HIDESELECTIONONEXIT_CHANGED = MM_SCROLLBOX_USER + 9; + MM_MEMO_MAXLENGTH_CHANGED = MM_SCROLLBOX_USER + 10; + MM_MEMO_LINES_CHANGED = MM_SCROLLBOX_USER + 11; + MM_MEMO_TEXT_CHANGING = MM_SCROLLBOX_USER + 12; + MM_MEMO_GET_CARET_POSITION = MM_SCROLLBOX_USER + 13; + MM_MEMO_SET_CARET_POSITION = MM_SCROLLBOX_USER + 14; + MM_MEMO_SELSTART_CHANGED = MM_SCROLLBOX_USER + 15; + MM_MEMO_SELLENGTH_CHANGED = MM_SCROLLBOX_USER + 16; + MM_MEMO_DATADETECTORTYPES_CHANGED = MM_SCROLLBOX_USER + 17; + MM_MEMO_LINES_INSERT_LINE = MM_SCROLLBOX_USER + 18; + MM_MEMO_LINES_PUT_LINE = MM_SCROLLBOX_USER + 19; + MM_MEMO_LINES_DELETE_LINE = MM_SCROLLBOX_USER + 20; + MM_MEMO_LINES_EXCHANGE_LINES = MM_SCROLLBOX_USER + 21; + MM_MEMO_LINES_CLEAR = MM_SCROLLBOX_USER + 22; + MM_MEMO_UPDATE_STATE_CHANGED = MM_SCROLLBOX_USER + 23; + MM_MEMO_CAN_SET_FOCUS = MM_SCROLLBOX_USER + 31; + MM_MEMO_GET_CARET_POSITION_BY_POINT = MM_SCROLLBOX_USER + 32; + MM_MEMO_USER = MM_SCROLLBOX_USER + 33; + + PM_MEMO_GOTO_LINE_BEGIN = PM_USER_SCROLLBOX + 1; + PM_MEMO_GOTO_LINE_END = PM_USER_SCROLLBOX + 2; + PM_MEMO_GOTO_TEXT_BEGIN = PM_USER_SCROLLBOX + 3 deprecated; + PM_MEMO_GOTO_TEXT_END = PM_USER_SCROLLBOX + 4 deprecated; + PM_MEMO_UNDO_MANAGER_INSERT_TEXT = PM_USER_SCROLLBOX + 5; + PM_MEMO_UNDO_MANAGER_DELETE_TEXT = PM_USER_SCROLLBOX + 6; + PM_MEMO_UNDO_MANAGER_UNDO = PM_USER_SCROLLBOX + 7; + PM_MEMO_SELECT_TEXT = PM_USER_SCROLLBOX + 8; + PM_MEMO_USER = PM_USER_SCROLLBOX + 9; + +type + + { TMemo } + + TDataDetectorType = (PhoneNumber, Link, Address, CalendarEvent); + TDataDetectorTypes = set of TDataDetectorType; + + /// Data model for the TMemo control. + TCustomMemoModel = class(TCustomScrollBoxModel, ITextLinesSource) + public type + ///Record to notify presenter about changes in test lines. + TLineInfo = record + Index: Integer; + Text: string; + ExtraIndex: Integer; + class function Create(const Index: Integer; const Text: string): TLineInfo; overload; static; inline; + class function Create(const Index, ExtraIndex: Integer): TLineInfo; overload; static; inline; + end; + /// Data for requesting caret position by HitTest point. + TGetCaretPositionInfo = record + HitPoint: TPointF; + RoundToWord: Boolean; + CaretPosition: TCaretPosition; + end; + public const + DefaultAutoSelect = False; + DefaultCharCase = TEditCharCase.ecNormal; + DefaultHideSelectionOnExit = True; + DefaultKeyboardType = TVirtualKeyboardType.Default; + DefaultMaxLength = 0; + DefaultReadOnly = False; + DefaultSelectionColor = $802A8ADF; + private + FAutoSelect: Boolean; + FCaret: TCaret; + FChanged: Boolean; + FCharCase: TEditCharCase; + FCheckSpelling: Boolean; + FDataDetectorTypes: TDataDetectorTypes; + FHideSelectionOnExit: Boolean; + FImeMode: TImeMode; + FKeyboardType: TVirtualKeyboardType; + FLines: TStrings; + FMaxLength: Integer; + FReadOnly: Boolean; + FSelectionFill: TBrush; + FSelStart: Integer; + FSelLength: Integer; + FTextSettingsInfo: TTextSettingsInfo; + FOnChange: TNotifyEvent; + FOnChangeTracking: TNotifyEvent; + FOnValidating: TValidateTextEvent; + FOnValidate: TValidateTextEvent; + procedure SetCaret(const Value: TCaret); + procedure SetCheckSpelling(const Value: Boolean); + procedure SetReadOnly(const Value: Boolean); + procedure SetImeMode(const Value: TImeMode); + procedure SetKeyboardType(const Value: TVirtualKeyboardType); + procedure SetAutoSelect(const Value: Boolean); + procedure SetCharCase(const Value: TEditCharCase); + procedure SetHideSelectionOnExit(const Value: Boolean); + procedure SetMaxLength(const Value: Integer); + procedure SetLines(const Value: TStrings); + procedure SetSelectionFill(const Value: TBrush); + procedure SetSelLength(const Value: Integer); + procedure SetSelStart(const Value: Integer); + procedure SetTextSettingsInfo(const Value: TTextSettingsInfo); + procedure SetDataDetectorTypes(const Value: TDataDetectorTypes); + function GetCaretPosition: TCaretPosition; + procedure SetCaretPosition(const Value: TCaretPosition); + function CanSetFocus: Boolean; + { ITextLinesSource } + function GetLine(const ALineIndex: Integer): string; + function GetLineBreak: string; + function GetCount: Integer; + function GetText: string; + protected + ///Validate inputing text. Calling before OnChangeTracking + function DoValidating(const Value: string): string; virtual; + ///Validate inputed text. Calling before OnChange + function DoValidate(const Value: string): string; virtual; + ///Call OnChangeTracking event + procedure DoChangeTracking; virtual; + ///Call OnChange event + procedure DoChange; virtual; + ///Method is calling when some parameter of text settings was changed + procedure TextSettingsChanged; virtual; + ///Returns class type that represent used text settings. Could be overridden in descendants to modify + ///default behavior + function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; virtual; + public + constructor Create(const AOwner: TComponent); override; + destructor Destroy; override; + ///Does memo has selected text + function HasSelection: Boolean; + ///Returns current selected text + function SelectedText: string; + ///If there were made any changes in text OnChange will be raised + procedure Change; + ///Convert absolute platform-dependent position in text to platform independent value in format + ///(line_number, position_in_line) + function TextPosToPos(const APos: Integer): TCaretPosition; + ///Convert platform-independent position to absolute platform-dependent position + function PosToTextPos(const APostion: TCaretPosition): Integer; + ///Insert text in memo after defined position + procedure InsertAfter(const APosition: TCaretPosition; const AFragment: string; const Options: TInsertOptions); + ///Delete fragment of the text from the memo after defined position + procedure DeleteFrom(const APosition: TCaretPosition; const ALength: Integer; const Options: TDeleteOptions); + /// Replace fragment of text from the memo in the specifeid range. + procedure Replace(const APosition: TCaretPosition; const ALength: Integer; const AFragment: string); + ///Select ALength characters in memo's text starting from AStartPosition + procedure SelectText(const AStartPosition: TCaretPosition; const ALength: Integer); + + function GetNextWordBegin(const APosition: TCaretPosition): TCaretPosition; + function GetPrevWordBegin(const APosition: TCaretPosition): TCaretPosition; + function GetPositionShift(const APosition: TCaretPosition; const ADelta: Integer): TCaretPosition; + { Caret position } + procedure MoveCaretHorizontal(const ADelta: Integer); + procedure MoveCaretLeft; + procedure MoveCaretRight; + /// Returns caret position by specified hittest point. + /// Works only for TMemo.ControlType=Styled. + function GetCaretPositionByPoint(const AHitPoint: TPointF; const ARoundToWord: Boolean = False): TCaretPosition; + public + ///Select all text when control getting focus + property AutoSelect: Boolean read FAutoSelect write SetAutoSelect; + ///Contains component that represent current caret for control + property Caret: TCaret read FCaret write SetCaret; + ///Defines character case for text in component + property CharCase: TEditCharCase read FCharCase write SetCharCase; + ///Switch on/off spell checking feature + property CheckSpelling: Boolean read FCheckSpelling write SetCheckSpelling; + ///Defines the types of information that can be detected in text + ///(for native presentation on iOS only) + property DataDetectorTypes: TDataDetectorTypes read FDataDetectorTypes write SetDataDetectorTypes; + ///Do not draw selected text region when component not in focus + property HideSelectionOnExit: Boolean read FHideSelectionOnExit write SetHideSelectionOnExit default True; + ///Text is in read-only mode + property ReadOnly: Boolean read FReadOnly write SetReadOnly; + ///Default IME text input mode + property ImeMode: TImeMode read FImeMode write SetImeMode; + ///Defines visual type of on-screen-keyboard + property KeyboardType: TVirtualKeyboardType read FKeyboardType write SetKeyboardType; + ///Lines of text + property Lines: TStrings read FLines write SetLines; + ///Available maximum length of text (0 - no length limitation). + property MaxLength: Integer read FMaxLength write SetMaxLength; + ///Brush that is using to draw text selection region + property SelectionFill: TBrush read FSelectionFill write SetSelectionFill; + ///Current position of cursor in the text + property CaretPosition: TCaretPosition read GetCaretPosition write SetCaretPosition; + ///Text selection starting position + property SelStart: Integer read FSelStart write SetSelStart; + ///Length of selected text + property SelLength: Integer read FSelLength write SetSelLength; + ///Container for current text visualization attributes + property TextSettingsInfo: TTextSettingsInfo read FTextSettingsInfo write SetTextSettingsInfo; + ///Event that raises when control losing focus or user pressing ENTER key (but onlt if some changes were + ///made) + property OnChange: TNotifyEvent read FOnChange write FOnChange; + ///Event that raises on any change in text + property OnChangeTracking: TNotifyEvent read FOnChangeTracking write FOnChangeTracking; + ///Event that raises to validate any change in text (raises before OnChangeTracking event) + property OnValidating: TValidateTextEvent read FOnValidating write FOnValidating; + ///Event that raises to validate changes in text (raises before OnChange event) + property OnValidate: TValidateTextEvent read FOnValidate write FOnValidate; + end; + + /// TCustomMemo is the base class from which all FireMonkey multiline + /// text editing controls, providing text scrolling, are derived. + TCustomMemo = class(TCustomPresentedScrollBox, ITextSettings, ITextActions, IVirtualKeyboardControl, ICaret, + IReadOnly) + private + FSaveReadOnly: Boolean; + procedure ReadTextData(Reader: TReader); + procedure ReadHideSelectionData(Reader: TReader); + function GetModel: TCustomMemoModel; overload; + function GetLines: TStrings; + procedure SetLines(const Value: TStrings); + function GetCheckSpelling: Boolean; + procedure SetCheckSpelling(const Value: Boolean); + function GetAutoSelect: Boolean; + procedure SetAutoSelect(const Value: Boolean); + function GetCaret: TCaret; + procedure SetCaret(const Value: TCaret); + function GetCharCase: TEditCharCase; + procedure SetCharCase(const Value: TEditCharCase); + function GetHideSelectionOnExit: Boolean; + procedure SetHideSelectionOnExit(const Value: Boolean); + function GetMaxLength: Integer; + procedure SetMaxLength(const Value: Integer); + function GetImeMode: TImeMode; + procedure SetImeMode(const Value: TImeMode); + function GetSelLength: Integer; + procedure SetSelLength(const Value: Integer); + function GetSelStart: Integer; + procedure SetSelStart(const Value: Integer); + function GetDataDetectorTypes: TDataDetectorTypes; + procedure SetDataDetectorTypes(const Value: TDataDetectorTypes); + function GetText: string; + procedure SetText(const Value: string); + function GetOnChange: TNotifyEvent; + procedure SetOnChange(const Value: TNotifyEvent); + function GetOnChangeTracking: TNotifyEvent; + procedure SetOnChangeTracking(const Value: TNotifyEvent); + function GetOnValidate: TValidateTextEvent; + procedure SetOnValidate(const Value: TValidateTextEvent); + function GetOnValidating: TValidateTextEvent; + procedure SetOnValidating(const Value: TValidateTextEvent); + { ITextSettings } + function GetDefaultTextSettings: TTextSettings; + function GetResultingTextSettings: TTextSettings; + function GetTextSettings: TTextSettings; + procedure SetTextSettings(const Value: TTextSettings); + function GetStyledSettings: TStyledSettings; + procedure SetStyledSettings(const Value: TStyledSettings); + function StyledSettingsStored: Boolean; + { IVirtualKeyboardControl } + function GetKeyboardType: TVirtualKeyboardType; + procedure SetKeyboardType(Value: TVirtualKeyboardType); + procedure SetReturnKeyType(Value: TReturnKeyType); + function GetReturnKeyType: TReturnKeyType; + function IsPassword: Boolean; + { ICaret } + function GetObject: TCustomCaret; + procedure ShowCaret; + procedure HideCaret; + function GetCaretPosition: TCaretPosition; cdecl; + procedure SetCaretPosition(const Value: TCaretPosition); + function GetSelText: string; + function GetFont: TFont; + function GetFontColor: TAlphaColor; + function GetSelectionFill: TBrush; + function GetTextAlign: TTextAlign; + function GetWordWrap: Boolean; + procedure SetFont(const Value: TFont); + procedure SetFontColor(const Value: TAlphaColor); + procedure SetTextAlign(const Value: TTextAlign); + procedure SetWordWrap(const Value: Boolean); + procedure ObserverToggle(const AObserver: IObserver; const Value: Boolean); + { IReadOnly } + function GetReadOnly: Boolean; + procedure SetReadOnly(const Value: Boolean); + protected + procedure DefineProperties(Filer: TFiler); override; + function DefineModelClass: TDataModelClass; override; + function DefinePresentationName: string; override; + function GetData: TValue; override; + procedure SetData(const Value: TValue); override; + + procedure DoBeginUpdate; override; + procedure DoEndUpdate; override; + + function GetCanFocus: Boolean; override; + + function IsAddToContent(const AObject: TFmxObject): Boolean; override; + + { Live Binding } + ///Retruns True if the control could be handled by live binding + function CanObserve(const ID: Integer): Boolean; override; + ///Registering observer handler after binding link was creaded + procedure ObserverAdded(const ID: Integer; const Observer: IObserver); override; + public + constructor Create(AOwner: TComponent); override; + ///Delete selected text + procedure ClearSelection; deprecated 'Use DeleteSelection method instead'; + { ITextActions } + ///Removes the selected text from the memo control + procedure DeleteSelection; + ///Copies the selected text to the clipboard + procedure CopyToClipboard; + ///Cuts the selected text to the clipboard + procedure CutToClipboard; + ///Pastes the text from the clipboard to the current caret position + procedure PasteFromClipboard; + ///Select all text + procedure SelectAll; + ///Selects the word containing the insertion point + procedure SelectWord; + ///Cancel the selection if it exists + procedure ResetSelection; + ///Moves the cursor to the end of the text in the memo + procedure GoToTextEnd; + ///Moves the cursor to the beginning of the text in the memo + procedure GoToTextBegin; + ///Replaces the ALength number of characters, beginning from the AStartPos position, + ///with the the AStr string + procedure Replace(const AStartPos: Integer; const ALength: Integer; const AStr: string); + ///Moves the cursor to the end of the current line + ///When WordWrap is True the text line could be separated into several visual lines. + ///Exactly those lines are considering to find end of the visible line at the insertion point. + procedure GoToLineEnd; + ///Moves the cursor to the beginning of the current line + ///When WordWrap is True the text line could be separated into several visual lines. + ///Exactly those lines are considering to find begin of the visible line at the insertion point. + procedure GoToLineBegin; + ///Undoing the latest text change made in the memo + procedure UnDo; + + ///Converts an absolute platform-specific position in text to a platform-independent position in the + ///(line_number, position_in_line) format + function TextPosToPos(const APos: Integer): TCaretPosition; + ///Converts a platform-independent position in text to an absolute platform-specific position + function PosToTextPos(const APostion: TCaretPosition): Integer; + ///Inserts the AFragment string in the memo's text, after APosition + procedure InsertAfter(const APosition: TCaretPosition; const AFragment: string; const Options: TInsertOptions); + ///Deletes the ALength number of characters, after the APosition position, from the memo's + ///text + procedure DeleteFrom(const APosition: TCaretPosition; const ALength: Integer; const Options: TDeleteOptions); + + ///The model handling the internal data of the memo control + property Model: TCustomMemoModel read GetModel; + ///The entire text in the memo + property Text: string read GetText write SetText; + public + ///Determines whether all the text in the memo is automatically selected when the control gets + ///focus + property AutoSelect: Boolean read GetAutoSelect write SetAutoSelect; + ///Provides access to the caret attached to the memo + property Caret: TCaret read GetCaret write SetCaret; + ///Defines whether to implement the 'UPPER' or 'lower' case conversion to the memo's text + property CharCase: TEditCharCase read GetCharCase write SetCharCase; + ///Defines whether the spell checking feature of the memo component is on or off + property CheckSpelling: Boolean read GetCheckSpelling write SetCheckSpelling; + ///Defines the types of information that can be detected in the memo's text + ///(for native presentation on iOS only) + property DataDetectorTypes: TDataDetectorTypes read GetDataDetectorTypes write SetDataDetectorTypes; + ///Determines whether to cancel the visual indication of the selected text when the focus moves to another + ///control. + property HideSelectionOnExit: Boolean read GetHideSelectionOnExit write SetHideSelectionOnExit; + ///Default IME text input mode + property ImeMode: TImeMode read GetImeMode write SetImeMode; + ///Defines the type of the on-screen keyboard to be displayed + property KeyboardType: TVirtualKeyboardType read GetKeyboardType write SetKeyboardType; + ///Provides access to individual lines of the memo's text + property Lines: TStrings read GetLines write SetLines; + ///The maximum number of characters that can be entered in the memo (0 - no explicit limitation) + property MaxLength: Integer read GetMaxLength write SetMaxLength; + ///Specifies whether the user can change the memo's text + property ReadOnly: Boolean read GetReadOnly write SetReadOnly; + ///The current cursor position in the text + property CaretPosition: TCaretPosition read GetCaretPosition write SetCaretPosition; + ///The brush that is used to draw a text selection region + property SelectionFill: TBrush read GetSelectionFill; + ///Text font + property Font: TFont read GetFont write SetFont; + ///The font color of the text in this memo + property FontColor: TAlphaColor read GetFontColor write SetFontColor; + ///Horizontal text alignment + property TextAlign: TTextAlign read GetTextAlign write SetTextAlign; + ///Specifies whether to wrap the text when its length is greater than the memo width + property WordWrap: Boolean read GetWordWrap write SetWordWrap; + ///The number of the first character selected in the memo's text + property SelStart: Integer read GetSelStart write SetSelStart; + ///The number of characters selected in the memo's text + property SelLength: Integer read GetSelLength write SetSelLength; + ///The currently selected fragment in the memo's text + property SelText: string read GetSelText; + ///The text representation properties that are applied from the current style + property StyledSettings: TStyledSettings read GetStyledSettings write SetStyledSettings + stored StyledSettingsStored nodefault; + ///The container for the current text visualization properties + property TextSettings: TTextSettings read GetTextSettings write SetTextSettings; + ///Raises when the memo has lost the focus or the user has pressed ENTER (but only if some changes in the + ///text have been made) + property OnChange: TNotifyEvent read GetOnChange write SetOnChange; + ///Raises when any change has been made in the text + property OnChangeTracking: TNotifyEvent read GetOnChangeTracking write SetOnChangeTracking; + ///Raises to validate any change has been made in the text + ///(raises before the OnChangeTracking event) + property OnValidating: TValidateTextEvent read GetOnValidating write SetOnValidating; + ///Raises to validate changes have been made in the text when the memo has lost the focus or the user + ///has pressed ENTER (raises before OnChange event) + property OnValidate: TValidateTextEvent read GetOnValidate write SetOnValidate; + end; + + TMemo = class(TCustomMemo) + published + property AutoHide; + property AutoSelect default False; + property Caret; + property CharCase default TCustomMemoModel.DefaultCharCase; + property CheckSpelling default False; + property DataDetectorTypes; + property DisableMouseWheel; + property HideSelectionOnExit default True; + property ImeMode default TImeMode.imDontCare; + property KeyboardType default TVirtualKeyboardType.Default; + property Lines; + property MaxLength default 0; + property ReadOnly default False; + property ShowScrollBars default True; + property ShowSizeGrip; + property StyledSettings; + property TextSettings; + property OnChange; + property OnChangeTracking; + property OnValidating; + property OnValidate; + { inherited } + property Align; + property Anchors; + property Bounces; + property CanFocus default True; + property CanParentFocus; + property ClipChildren; + property ClipParent; + property ControlType; + property Cursor default crIBeam; + property DisableFocusEffect; + property DragMode; + property Enabled; + property EnabledScroll; + property EnableDragHighlight; + property Height; + property HelpContext; + property HelpKeyword; + property HelpType; + property Hint; + property HitTest; + property Locked; + property Margins; + property Opacity; + property Padding; + property PopupMenu; + property Position; + property RotationAngle; + property RotationCenter; + property Scale; + property Size; + property StyleLookup; + property TabOrder; + property TabStop; + property TouchTargetExpansion; + property Visible; + property Width; + property ParentShowHint; + property ShowHint; + { Events } + property OnApplyStyleLookup; + property OnFreeStyle; + property OnPainting; + property OnPaint; + property OnResize; + property OnResized; + property OnEnter; + property OnExit; + property OnKeyUp; + property OnKeyDown; + property OnDragEnter; + property OnDragLeave; + property OnDragOver; + property OnDragDrop; + property OnDragEnd; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseEnter; + property OnMouseLeave; + property OnViewportPositionChange; + property OnPresentationNameChoosing; + end; + +//== UNIT END: FMX.Memo +//================================================================================================== + diff --git a/dirs_fmx.txt b/dirs_fmx.txt new file mode 100644 index 0000000..423f6f5 --- /dev/null +++ b/dirs_fmx.txt @@ -0,0 +1 @@ +C:\Program Files (x86)\Embarcadero\Studio\23.0\source\fmx