// 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
//==================================================================================================