Files
2025-10-07 13:21:25 +02:00

25463 lines
1.1 MiB
Plaintext

// 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: 07.10.2025 11:01:41
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.strutils,
system.sysutils,
system.types,
system.typinfo,
system.uiconsts,
system.uitypes,
winapi.messages;
//==================================================================================================
//== INTERFACE START: FMX.ActnList (from FMX.ActnList.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
/// <summary>Interface used by the framework to access an action in a
/// class.</summary>
IActionClient = interface
['{4CAAFEEE-73ED-4C4B-8413-8BF1C3FFD777}']
/// <summary> The root component. This is usually a form on which the control which supports this interface is placed.
/// This function is used by framework</summary>
/// <returns> Instance of component that supports IRoot interface </returns>
function GetRoot: TComponent;
/// <summary> 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 <b>InitiateAction</b>. If returns <c>False</c> then the
/// instance will be ignored</summary>
/// <returns> The value set using the method <b>SetActionClient</b> </returns>
function GetActionClient: Boolean;
/// <summary> This method sets value that the <b>GetActionClient</b> function returns </summary>
procedure SetActionClient(const Value: Boolean);
function GetAction: TBasicAction;
procedure SetAction(const Value: TBasicAction);
/// <summary> When the framework performs periodical execution of <b>InitiateAction</b>, it invokes the controls in
/// order defined by this index</summary>
function GetIndex: Integer;
/// <summary> Calls the action link's <b>Update</b> method if the instance is associated with an action link
/// </summary>
procedure InitiateAction;
/// <summary> Action associated with this instance </summary>
property Action: TBasicAction read GetAction write SetAction;
end;
/// <summary>The IIsChecked interface provides access to the IsChecked
/// property for controls that can be checked.</summary>
IIsChecked = interface
['{DE946EB7-0A6F-4458-AEB0-C911122630D0}']
function GetIsChecked: Boolean;
procedure SetIsChecked(const Value: Boolean);
/// <summary> Determines whether the <b>IsChecked</b> property needs to be stored in the fmx-file </summary>
/// <returns> <c>True</c> if <b>IsChecked</b> property needs to be stored, usually if it contains non default value
/// </returns>
function IsCheckedStored: Boolean;
/// <summary> <c>True</c> if the control is in the ON state </summary>
property IsChecked: Boolean read GetIsChecked write SetIsChecked;
end;
/// <summary>The IGroupName interface provides access to the GroupName
/// property for controls that need to provide exclusive checking inside a
/// group.</summary>
IGroupName = interface(IIsChecked)
['{F5C14792-67AB-41F2-99C1-90C7F94102EE}']
function GetGroupName: string;
procedure SetGroupName(const Value: string);
/// <summary> <c>True</c> if <b>GroupName</b> property should be stored</summary>
/// <returns> <c>True</c> if <b>GroupName</b> property needs to be stored, usually if it contains non default
/// (<c>''</c>, <c>'0'</c>, <c>'-1'</c>) value </returns>
function GroupNameStored: Boolean;
/// <summary> Name of the control group </summary>
property GroupName: string read GetGroupName write SetGroupName;
end;
/// <summary>Interface used to access the Shortcut property of some
/// classes.</summary>
IKeyShortcut = interface
['{1AE6E932-9291-4BCD-93D1-DDD2A3E09394}']
function GetShortcut: TShortcut;
procedure SetShortcut(const Value: TShortcut);
/// <summary> The combination of hot keys that the class should handle </summary>
property Shortcut: TShortcut read GetShortcut write SetShortcut;
end;
/// <summary>If an object supports the ICaption interface, when the text of
/// the object changes, the Text must also be changed.</summary>
ICaption = interface
['{3D039C9C-8888-466F-A344-E7026EEE2C07}']
function GetText: string;
procedure SetText(const Value: string);
/// <summary> If this function returns true, the text should be save in the fmx-file. </summary>
function TextStored: Boolean;
/// <summary> This property is used to changed the display text. </summary>
property Text: string read GetText write SetText;
end;
/// <summary>Declares basic methods and properties used to manage lists of
/// images.</summary>
IGlyph = interface
['{62BDCA4F-820A-4058-B57A-FE8931DB3CCC}']
function GetImageIndex: TImageIndex;
procedure SetImageIndex(const Value: TImageIndex);
function GetImages: TBaseImageList;
procedure SetImages(const Value: TBaseImageList);
///<summary> Should be called when you change an instance or reference to instance of <b>TBaseImageList</b> or the
/// <b>ImageIndex</b> property</summary>
procedure ImagesChanged;
///<summary> Zero based index of an image. The default is <c>-1</c></summary>
///<remarks> If non-existing index is specified, an image is not drawn and no exception is raised</remarks>
property ImageIndex: TImageIndex read GetImageIndex write SetImageIndex;
///<summary> The list of images. Can be <c>nil</c></summary>
property Images: TBaseImageList read GetImages write SetImages;
end;
TCustomActionList = class(TContainedActionList)
private
FImageLink: TImageLink;
procedure SetImages(const Value: TBaseImageList);
function GetImages: TBaseImageList;
protected
///<summary> Should be called when you change an instance or reference to instance of <b>TBaseImageList</b> or the
/// <b>ImageIndex</b> property</summary>
procedure ImagesChanged; virtual;
public
destructor Destroy; override;
function DialogKey(const Key: Word; const Shift: TShiftState): Boolean; virtual;
///<summary> The list of images. Can be <c>nil</c></summary>
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;
/// <summary> Reference to <b>IGlyph</b> interface of <b>Client</b>. <c>Nil</c> if <b>Client</b> is undefined or
/// does not support this interface </summary>
property Glyph: IGlyph read FGlyph;
public
function IsHelpContextLinked: Boolean; override;
function IsViewActionClient: Boolean;
property Client: TObject read FClient;
///<summary> The list of images. Can be <c>nil</c></summary>
property Images: TBaseImageList read FImages;
property CaptionLinked: Boolean read IsCaptionLinked;
/// <summary> Same as <b>IsHintLinked</b> </summary>
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;
/// <summary>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.</summary>
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;
//== INTERFACE END: FMX.ActnList
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.Presentation.Messages (from FMX.Presentation.Messages.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
{ TMessageSender }
/// <summary>ID of message</summary>
TMessageID = Word;
/// <summary>Record type that represents a message with value for <c>TMessageSender</c>.</summary>
TDispatchMessageWithValue<T> = record
MsgID: TMessageID;
Value: T;
public
constructor Create(const AMessageID: TMessageID; const AValue: T);
end;
/// <summary>Class to allow sending message notifications to a TObject <c>Receiver</c>.</summary>
TMessageSender = class(TPersistent)
private
FReceiver: TObject;
FNeedFreeReceiver: Boolean;
FCanNotify: Integer;
procedure SetReceiver(const Value: TObject);
protected
/// <summary>Creates and returns the Receiver object of the message. By default returns nil.</summary>
function CreateReceiver: TObject; virtual;
/// <summary>Frees the Receiver, if receiver was created by <c>CreateReceiver</c>.</summary>
procedure FreeReceiver; virtual;
public
constructor Create; overload; virtual;
destructor Destroy; override;
/// <summary>Returns whether <c>TMessageSender</c> has a Receiver or not.</summary>
function HasReceiver: Boolean;
{ Sending Messages }
/// <summary>Sends a message to an object.</summary>
procedure SendMessage(const AMessageID: TMessageID); overload;
/// <summary>Sends a message with value to an object.</summary>
procedure SendMessage<T>(const AMessageID: TMessageID; const AValue: T); overload;
/// <summary>Sends a message with value to an object and allows to get result from <c>Receiver</c>.</summary>
procedure SendMessageWithResult<T>(const AMessageID: TMessageID; var AValue: T);
{ Notifications }
/// <summary>Disables <c>TMessageSender</c> from sending messages.</summary>
procedure DisableNotify; virtual;
/// <summary>Enables <c>TMessageSender</c> to send messages. Use CanNotify to check whether TMessageSender can send
/// messages.</summary>
/// <remarks>The model reads quantity of calls of <c>DisableNotify</c>. So all calls of <c>DisableNotify</c> and
/// <c>EnableNotify</c>shall be pairs.</remarks>
procedure EnableNotify; virtual;
/// <summary>Returns whether <c>TMessageSender</c> can send messages.</summary>
function CanNotify: Boolean; virtual;
public
/// <summary>Returns the object that receives the message.</summary>
property Receiver: TObject read FReceiver write SetReceiver;
end;
IMessageSendingCompatible = interface
['{7777134E-CEC9-40F6-9AAA-CE4D6F55001A}']
/// <summary>Return link to TMessageSender object</summary>
function GetMessageSender: TMessageSender;
/// <summary>Link to TMessageSender object that can be used to send messages</summary>
property MessageSender: TMessageSender read GetMessageSender;
end;
/// <summary>Interface allows access to TMessageSender object</summary>
IMessageSender = interface(IMessageSendingCompatible)
['{64DD751B-91F5-4767-994F-2787E21ABEF2}']
end deprecated 'Use IMessageSendingCompatible';
//== INTERFACE END: FMX.Presentation.Messages
//==================================================================================================
//==================================================================================================
//== INTERFACE 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 = '<Application.Title>';
SAppDefault = 'application';
SGotoTab = 'Go to %s';
SGotoNilTab = 'Go to <Tab>';
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';
//== INTERFACE END: FMX.Consts
//==================================================================================================
//==================================================================================================
//== INTERFACE 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;
/// <summary>The number of decimal digits for the rounding floating point
/// values.</summary>
DigitRoundSize: TRoundToRange = -3;
// Use GPU Canvas
GlobalUseGPUCanvas: Boolean = False;
/// <summary>Allow using Metal for UI rendering</summary>
GlobalUseMetal: Boolean = False;
/// <summary>If this value is YES, draw loop is paused and updates are event-driven (Metal only)</summary>
GlobalEventDrivenDisplayUpdates: Boolean = True;
/// <summary>The rate at which the draw loop update its contents (Metal only)</summary>
GlobalPreferredFramesPerSecond: Integer = 60;
/// <summary>Allow using Vulkan for UI rendering</summary>
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
/// <summary> This method converts <b>TTextAlign</b> value to <b>THorzRectAlign</b> </summary>
function AsHorzRectAlign: THorzRectAlign; inline;
/// <summary> This method converts <b>TTextAlign</b> value to <b>TVertRectAlign</b> </summary>
function AsVertRectAlign: TVertRectAlign; inline;
end;
TVertRectAlignHelper = record helper for TVertRectAlign
public
/// <summary> This method converts <b>TVertRectAlign</b> value to <b>TTextAlign</b> </summary>
function AsTextAlign: TTextAlign; inline;
end;
THorzRectAlignHelper = record helper for THorzRectAlign
public
/// <summary> This method converts <b>THorzRectAlign</b> value to <b>TTextAlign</b> </summary>
function AsTextAlign: TTextAlign; inline;
end;
TTextTrimming = (None, Character, Word);
/// <summary>A type that text controls use to specify whether to consider the
/// ampersand (&amp;) as a special character</summary>
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<TPixelFormat>;
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.';
/// <summary>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.</summary>
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
/// <summary>Returns window scale factor.</summary>
function GetScale: Single; virtual;
public
/// <summary>Returns True if Scale is integer value.</summary>
function IsScaleInteger: Boolean;
/// <summary>Window scale factor.</summary>
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;
/// <summary>
/// The interface is designed to notify the container component of any changes among the child components.
/// </summary>
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);
/// <summary>This method returns true if the control has an available hint to display.</summary>
function HasHint: Boolean;
/// <summary>If HasHint is true, this method is invoked in order to know if the control has an available
/// string to swho as hint.</summary>
function GetHintString: string;
/// <summary>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.</summary>
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;
/// <summary> This interface is used to acces to property <b>ReadOnly</b> of all classes which supports this property
/// </summary>
IReadOnly = interface
['{495B8B0C-D7C8-4835-AA5F-580939D21444}']
function GetReadOnly: Boolean;
procedure SetReadOnly(const Value: Boolean);
/// <summary> The property to which we have access </summary>
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;
/// <summary>When available, complete screen area in pixels, including status bars and button bars. Can be
/// the same as PhysicalScreenSize.</summary>
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;
/// <summary>
/// hide the caret
/// </summary>
procedure Hide; virtual;
/// <summary>
/// if possible (CanShow = True and Visible = True), the caret show.
/// </summary>
procedure Show; virtual;
/// <summary>
/// This method is performed after changing the Displayed
/// </summary>
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;
/// <summary>
/// The update of the "Flasher", if UpdateCount = 0.
/// </summary>
procedure UpdateFlasher;
/// <summary>
/// This property controls the visibility of a caret, for the control in which the input focus.
/// </summary>
property Visible: Boolean read FVisible write SetVisible;
/// <summary>
/// The function returns true, if the control is visible, enabled,
/// has the input focus and it in an active form
/// </summary>
function CanShow: Boolean; virtual;
/// <summary>
/// This property is set to True, after the successful execution of
/// method Show, and is set to False after method Hide
/// </summary>
property Displayed: Boolean read FDisplayed;
/// <summary>
/// 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.
/// </summary>
property TemporarilyHidden: boolean read FTemporarilyHidden write SetTemporarilyHidden;
/// <summary>
/// Blinking visual component is displayed.
/// Usually this line, having a thickness of one or two pixels.
/// </summary>
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<TFmxObject>;
TFmxChildrenList = class(TEnumerable<TFmxObject>)
strict private
[weak] FChildren: TFmxObjectList;
protected
function DoGetEnumerator: TEnumerator<TFmxObject>; 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);
/// <summary>Index for getting fast access to nested objects by <c>StyleName</c>.</summary>
TStyleIndexer = class
private
[Weak] FStyle: TFmxObject;
FIndex: TDictionary<string, TFmxObject>;
procedure Rebuild;
public
constructor Create(const AStyle: TFmxObject);
destructor Destroy; override;
/// <summary>Marks index for lazy update.</summary>
procedure NeedRebuild;
/// <summary>Updates index, if it's required only.</summary>
procedure RebuildIfNeeded;
/// <summary>Finds style object by specified <c>StyleLookup</c> value and returns object in <c>AObject</c>.</summary>
function FindStyleObject(const AStyleLookup: string; var AObject: TFmxObject): Boolean;
/// <summary>Clears index.</summary>
procedure Clear;
end;
TFmxObject = class(TComponent, IFreeNotification, IActionClient)
public type
/// <summary> Determines the current state of the object
/// <para>CallingFreeNotify - state is set before sending notifications in <b>BeforeDestruction</b> method.
/// See also <b>IFreeNotification</b></para>
/// <para>CallingRelease - state is set in <b>Release</b> method</para>
/// </summary>
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<Pointer>;
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';
/// <summary> Describes the current state of this instance. Indicates that a component needs to avoid certain
/// actions. <para>See also <b>TComponent.ComponentState</b></para></summary>
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;
/// <summary>Loops through the children of this object, and runs the specified procedure once per object as the first parameter in each call.</summary>
procedure EnumObjects(const Proc: TFunc<TFmxObject, TEnumProcResult>);
{ 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<IControl>;
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<TRect>;
FFreeRectangles: TList<TRect>;
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);
///<summary>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.</summary>
IPersistentProvider = interface
['{B0B03758-A2F5-49B9-9A39-C2C2405B2EAD}']
///<summary>Return the provided persistent</summary>
function GetPersistent: TPersistent;
end;
///<summary>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.
///</summary>
IPersistentShim = interface
['{B6F815C7-BFD1-489D-A661-0CD4639EC920}']
///<summary>Return bounding rectangle of shim.</summary>
function GetBoundsRect: TRect;
end;
///<summary>Extension of TPersistent directly exposed to the Designer.</summary>
IDesignablePersistent = interface
['{4A731994-9060-4F3C-92D7-C123B04601D4}']
///<summary>GetDesignParent should return a TPersistent known to the designer, e.g. its parent TControl.</summary>
function GetDesignParent: TPersistent;
///<summary>Bounding rectangle representing this TPersistent in the designer</summary>
function GetBoundsRect: TRect;
///<summary>
/// 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
///</summary>
procedure Bind(AShim: IPersistentShim);
///<summary>
/// Unbind this persistent. The implementation would normally clear its reference to IPersistentShim.
///</summary>
procedure Unbind;
///<summary>True if this TPersistent is currently in Design mode and wants the Designer to create
///IItem for itself.</summary>
function BeingDesigned: Boolean;
end;
///<summary>Interface for TPersistent to receive bounding rectangle changes from the Designer.</summary>
IMovablePersistent = interface
['{A86F9221-09E9-40A7-AF0E-5C3EB859C297}']
/// <summary>Set bounds rectangle.</summary>
procedure SetBoundsRect(const AValue: TRect);
end;
///<summary>Interface that allows binding a TPersistent with a TreeView Sprig in StructureView</summary>
ISpriggedPersistent = interface
['{0F1D325A-8082-4DEA-8ABF-56A359A218A4}']
/// <summary>Set link to a TreeView sprig specified by APersistent. nil to break the link.</summary>
procedure SetSprig(const APersistent: TPersistent);
/// <summary>Get link to a TreeView sprig. Returns nil if link does not exist.</summary>
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
/// <summary>Provides static methods for debug messages.</summary>
Log = class abstract
strict private
class var FLogger: IInterface;
class function GetLogger: IInterface; static;
protected
/// <summary>Referece to the logger service.</summary>
class property Logger: IInterface read GetLogger;
public type
/// <summary>A conversion function used to convert array elements in ArrayToString</summary>
TToStringFunc = reference to function(const AObject: TObject): string;
/// <summary>A timestamp of specific point in procedure execution. TLogMarks are used by Log.Trace.
/// See Trace and TLogToken.</summary>
TLogMark = record
/// <summary>A short message</summary>
Msg: string;
/// <summary>Timestamp</summary>
Time: TDateTime;
end;
/// <summary>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.</summary>
TLogToken = class
private
FMarks: TList<Log.TLogMark>;
function GetMarkAt(const Index: Integer): TLogMark;
function GetCount: Integer;
protected
constructor Create;
public
/// <summary>Mark time during timed execution of a procedure.</summary>
procedure Mark(const Msg: string);
/// <summary>Get a mark at Index.</summary>
property MarkAt[const Index: Integer]: TLogMark read GetMarkAt;
/// <summary>Count of accumulated Marks.</summary>
property Count: Integer read GetCount;
end;
public
/// <summary>Log a debug message. Same arguments as Format.</summary>
class procedure d(const Fmt: string; const Args: array of const); overload;
/// <summary>Log a simple debug message.</summary>
class procedure d(const Msg: string); overload; inline;
/// <summary>Log a debug message with Tag, object data of Instance, Method that invokes the logger and message Msg.
/// </summary>
class procedure d(const Tag: string; const Instance: TObject; const Method, Msg: string); overload; inline;
/// <summary>Log a debug message with Tag, object data of Instance and a message Msg</summary>
class procedure d(const Tag: string; const Instance: TObject; const Msg: string); overload; inline;
/// <summary>Log a time stamp with message Msg</summary>
class procedure TimeStamp(const Msg: string); overload;
/// <summary>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.</summary>
class function Trace<TResult>(const Tag: string; const Func: TFunc<TLogToken, TResult>;
const Threshold: Integer = -1): TResult; overload;
/// <summary>A convenience variant of Trace&lt;TResult&gt; when token is not needed.</summary>
class function Trace<TResult>(const Tag: string; const Func: TFunc<TResult>; const Threshold: Integer = -1): TResult; overload;
/// <summary>A convenience variant of Trace&lt;TResult&gt; for procedures.</summary>
class procedure Trace(const Tag: string; const Proc: TProc<TLogToken>; const Threshold: Integer = -1); overload;
/// <summary>A convenience variant of Trace&lt;TResult&gt; for procedures when token is not needed.</summary>
class procedure Trace(const Tag: string; const Proc: TProc; const Threshold: Integer = -1); overload;
/// <summary>Get a basic string representation of an object, consisting of ClassName and its pointer</summary>
class function ObjToString(const Instance: TObject): string;
/// <summary>Get a string representation of array using MakeStr function to convert individual elements.</summary>
class function ArrayToString(const AArray: TEnumerable<TFmxObject>; const MakeStr: TToStringFunc): string; overload;
/// <summary>Get a string representation of array using TObject.ToString to convert individual elements.</summary>
class function ArrayToString(const AArray: TEnumerable<TFmxObject>): string; overload;
/// <summary>Dump complete TFmxObject with all its children.</summary>
class procedure DumpFmxObject(const AObject: TFmxObject; const Nest: Integer = 0);
end;
/// <summary>Removes the ampersand '&' characters of the Text string.</summary>
function DelAmp(const AText: string): string;
type
TEnumerableFilter<F; T: TFmxObject> = class(TEnumerable<T>)
private
FBaseEnum: TEnumerable<F>;
FSelfDestruct: Boolean;
FPredicate: TPredicate<T>;
protected
function DoGetEnumerator: TEnumerator<T>; override;
public
constructor Create(const FullEnum: TEnumerable<F>; SelfDestruct: Boolean = False; const Pred: TPredicate<T> = nil);
class function Filter(const Src: TEnumerable<F>; const Predicate: TPredicate<T> = nil): TEnumerableFilter<F,T>;
type
TFilterEnumerator = class(TEnumerator<T>)
private
FCleanup: TEnumerableFilter<F,T>;
FRawEnumerator: TEnumerator<F>;
FCurrent: T;
FPredicate: TPredicate<T>;
function GetCurrent: T;
protected
function DoGetCurrent: T; override;
function DoMoveNext: Boolean; override;
public
constructor Create(const Enumerable: TEnumerable<F>; const Cleanup: TEnumerableFilter<F,T>;
const Pred: TPredicate<T>);
destructor Destroy; override;
property Current: T read GetCurrent;
function MoveNext: Boolean;
end;
end;
TIdleMessage = class(System.Messaging.TMessage)
end;
/// <summary>Information about display.</summary>
TDisplay = record
/// <summary>The unique id of display.</summary>
Id: NativeUInt;
/// <summary>Index is the same as MonitorNum. Added for the sake of brevity.</summary>
Index: Integer;
/// <summary>Is this the main display in the system?</summary>
Primary: Boolean;
/// <summary>Screen size (dp) without taking into account the taskbar and other decorative elements.</summary>
/// <remarks>The Windows platform doesn't allow to determinate logical position of screen definitely.</remarks>
Bounds: TRectF;
/// <summary>Screen size (px) without taking into account the taskbar and other decorative elements.</summary>
PhysicalBounds: TRect;
/// <summary>Screen size (dp) minus the taskbar, and other decorative items.</summary>
Workarea: TRectF;
/// <summary>Screen size (px) minus the taskbar, and other decorative items.</summary>
PhysicalWorkarea: TRect;
/// <summary>Display scale.</summary>
Scale: Single;
/// <summary>It is the same as Bounds.</summary>
function BoundsRect: TRectF;
/// <summary>It is the same as Workarea.</summary>
function WorkareaRect: TRectF;
constructor Create(const AIndex: Integer; const APrimary: Boolean; const ABounds, AWorkArea: TRectF);
end;
/// <summary>Registers the flasher class for the TCustomCaret object specified
/// in the CaretClass parameter.</summary>
procedure RegisterFlasherClass(const FlasherClass: TFmxObjectClass; const CaretClass: TCaretClass);
/// <summary>Returns the class of a flasher registered for the TCustomCaret
/// object specified in the CaretClass parameter.</summary>
function FlasherClass(const CaretClass: TCaretClass): TFmxObjectClass;
/// <summary>Returns the flasher object registered for the TCustomCaret object
/// specified in the CaretClass parameter.</summary>
function Flasher(const CaretClass: TCaretClass): TFmxObject;
/// <summary>Checks whether a flasher is registered for the TCustomCaret object
/// specified in the CaretClass parameter.</summary>
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<string, TList<TRttiProperty>>;
type
TKeyKind = (Usual, Functional, Unknown);
//== INTERFACE END: FMX.Types
//==================================================================================================
//==================================================================================================
//== INTERFACE 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 }
/// <summary>Key-value pair where the key is a string and the value is an instance of TValue. Used for sending data
// to presentation layer.</summary>
TDataRecord = TPair<string, TValue>;
/// <summary>Class that contains a dictionary of key-value pairs and may be used as model by an instance of
/// <c>TPresentedControl</c> with supporting a sending a notification via messaging.</summary>
TDataModel = class(TMessageSender)
public type
TDataSource = TDictionary<string, TValue>;
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
/// <summary>Allows to specify <c>Owner</c></summary>
/// <remarks>Invokes default constructor without params.</remarks>
constructor Create(const AOwner: TComponent); overload; virtual;
/// <summary>Destroys existed <c>DataSource</c></summary>
destructor Destroy; override;
public
/// <summary>Component that is responsible for destroying this data model once the data model is no longer
/// necessary.</summary>
property Owner: TComponent read FOwner;
/// <summary><para>Value on the data model for the specified key.</para><para>Use it for sending any kind of data to
/// presentation layer without creating custom model class.</para></summary>
/// <remarks><para>Automatically sends notifcation message with id <c>MM_DATA_CHANGED</c> to receiver with information
/// about key and value through using <c>TDataRecord</c>.</para><para>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 DataSource</para><para>If value is nil, model will remove this key-value pair from <c>DataSource</c></para></remarks>
property Data[const Key: string]: TValue read GetData write SetData;
/// <summary>Dictionary of key-value pairs that are the data that the data model contains. Can be nil, if Model
/// doesn't have any datas.</summary>
property DataSource: TDataSource read FDataSource;
end;
/// <summary>Class reference of TDataModel.</summary>
TDataModelClass = class of TDataModel;
//== INTERFACE END: FMX.Controls.Model
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.AcceleratorKey (from FMX.AcceleratorKey.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
/// <summary>This is an interface that descendant classes must implement to in order to be a accelerator key
/// receiver.</summary>
IAcceleratorKeyReceiver = interface
['{1C679082-65F2-4C54-A2C4-CD4C00E2C465}']
/// <summary>True if the objects can trigger the action, False otherwise.</summary>
/// <remarks>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.</remarks>
function CanTriggerAcceleratorKey: Boolean;
/// <summary>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.</summary>
procedure TriggerAcceleratorKey;
/// <summary>Returns the character key which serves as the keyboard accelerator for this receiver.</summary>
function GetAcceleratorChar: Char;
/// <summary>Returns the index of the accelerator character within the text string of the receiver. This information
/// is typically used to highlight the accelerator character.</summary>
function GetAcceleratorCharIndex: Integer;
end;
/// <summary>Platform service to provide support for accelerator keys for quick keyboard access to controls.</summary>
IFMXAcceleratorKeyRegistryService = interface
['{0D06B7CC-FAF2-45F8-B7AA-D4B84FD384B7}']
/// <summary>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.</summary>
procedure RegisterReceiver(const ARoot: IRoot; const AReceiver: IAcceleratorKeyReceiver);
/// <summary>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.</summary>
procedure UnregisterReceiver(const ARoot: IRoot; const AReceiver: IAcceleratorKeyReceiver);
/// <summary>Removes the entire registry of accelerator keys for a given root container (form).</summary>
procedure RemoveRegistry(const ARoot: IRoot);
/// <summary>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.</summary>
function EmitAcceleratorKey(const ARoot: IRoot; const AChar: Char): Boolean;
/// <summary>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.</summary>
procedure ChangeReceiverRoot(const AReceiver: IAcceleratorKeyReceiver; const AOldRoot, ANewRoot: IRoot);
/// <summary>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.</summary>
procedure ExtractAcceleratorKey(const AText: string; out Key: Char; out KeyIndex: Integer);
end;
//== INTERFACE END: FMX.AcceleratorKey
//==================================================================================================
//==================================================================================================
//== INTERFACE 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
/// <summary>List of published properties used in streaming</summary>
Properties: array [TProperty] of string = ('Author', 'AuthorEMail', 'PlatformTarget', 'MobilePlatform', 'Title',
'Version');
public const
/// <summary>Target's names that used in style file</summary>
PlatformTargets: array [TOSPlatform] of string = ('[WINDOWS]', '[MACOS]', '[IOS7]', '[ANDROID]', '[LINUX]');
/// <summary>Platform's names that used at framework</summary>
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;
/// <summary>Allows to check style for fitting for specified Platform</summary>
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);
/// <summary>Force to load all style's objects from binary stream.</summary>
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<TIndexItem>;
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);
/// <summary>Try to parse styel file and read style description. Description object should be destroyed by caller.</summary>
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;
/// <summary>This procedure return correct resource name if more than one is registered for platform.</summary>
TPlatformStyleSelectionProc = function (const APlatform: TOSPlatform): string;
/// <summary>Anonymous method that EnumStyleResources calls in order to
/// enumerate all the registered style resources.</summary>
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<string, TOSPlatform>;
class var FSelections: TDictionary<TOSPlatform, TPlatformStyleSelectionProc>;
class var FStyleResources: TDictionary<string, TFmxObject>;
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;
/// <summary>Enumarate all registered style resources.</summary>
class procedure EnumStyleResources(Proc: TStyleResourceEnumProc);
/// <summary>Return if exits in cache or load style from resource.</summary>
class function GetStyleResource(const ResourceName: string): TFmxObject;
/// <summary>Register style resource for specified platform.</summary>
class procedure RegisterPlatformStyleResource(const APlatform: TOSPlatform; const ResourceName: string);
/// <summary>Register selection procedure for specified platform.</summary>
class procedure RegisterPlatformStyleSelection(const APlatform: TOSPlatform; const ASelection: TPlatformStyleSelectionProc);
class function ActiveStyle(const Context: TFmxObject): TFmxObject; static;
/// <summary>Returns active style for <c>IScene</c>.</summary>
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;
/// <summary>Loads from resource and sets the style specified by name as the active style, without raising an exception.</summary>
class function TrySetStyleFromResource(const ResourceName: string): Boolean;
class procedure UnInitialize;
{ Style description }
/// <summary>Searches <c>TStyleDescription</c> object among all the heirs.</summary>
class function FindStyleDescriptor(const AObject: TFmxObject): TStyleDescription;
// <summary>Searches <c>TStyleDescription</c> in a current style of specified control <c>AObject</c>.</summary>
class function GetStyleDescriptionForControl(const AObject: TFmxObject): TStyleDescription;
end;
//== INTERFACE END: FMX.Styles
//==================================================================================================
//==================================================================================================
//== INTERFACE 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);
/// <summary>
/// Returns the current state of the virtual keyboard (onscreen keyboard).
/// </summary>
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;
//== INTERFACE END: FMX.VirtualKeyboard
//==================================================================================================
//==================================================================================================
//== INTERFACE 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<TPointTime>;
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}
//== INTERFACE END: FMX.InertialMovement
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.Utils (from FMX.Utils.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
PAlphaColorArray = ^TAlphaColorArray;
TAlphaColorArray = array [0 .. MaxInt div 4 - 1] of TAlphaColor;
PAlphaColorRecArray = ^TAlphaColorRecArray;
TAlphaColorRecArray = array [0 .. MaxInt div 4 - 1] of TAlphaColorRec;
/// <summary>
/// A helper class that contains utilities to facilitate writing non-reentrant sections of code. It does not
/// provide thread-safety. A non-reentrable task is passed as a procedure or a function and can return a value.
/// Guard flag variable Guard is passed by reference and should be False in order for the procedure to execute.
///
/// For the cases when a non-reentrant section cannot be contained in one procedure, EnterSection/LeaveSection
/// can be used.
/// </summary>
TNonReentrantHelper = class
public
/// <summary>Execute non-reentrable procedure Proc using guard variable Guard. Return True if procedure was
/// executed</summary>
class function Execute(var Guard: Boolean; const Proc: TProc): Boolean; overload;
/// <summary>Execute non-reentrable procedure Proc&lt;A&gt; with an argument of type A. Return True if procedure
/// was executed </summary>
class function Execute<A>(var Guard: Boolean; const Proc: TProc<A>; const Arg: A): Boolean; overload;
/// <summary>Execute non-reentrable function Func:R. Return function result of type R or provided Default
/// value of type R if the code was not executed</summary>
class function Execute<R>(var Guard: Boolean; const Func: TFunc<R>; const Default: R): R; overload;
/// <summary>Execute non-reentrable function Func with an argument of type A and return type R. Return function
/// result or provided default value of type R if the code was not executed</summary>
class function Execute<A; R>(var Guard: Boolean; const Func: TFunc<A, R>; const Arg: A; const Default: R): R; overload;
/// <summary>Enter non-reentrable section of code. If the value of Guard was False, it will be changed to True
/// and the result will be True. Otherwise the value is not going to be changed and the result will be False.
/// </summary>
class function EnterSection(var Guard: Boolean): Boolean; inline;
/// <summary>Leave non-reentrable section of code. This should only be called once after EnterSection with same
/// Guard variable returned True</summary>
class procedure LeaveSection(var Guard: Boolean); inline;
end;
TFMXObjectHelper = class
public type
TFilterFunc = TFunc<TFMXObject, Boolean>;
ESearchException = class(Exception);
public
/// <summary>Finds first parent, which conforms <c>AFilter</c>. If parent is found, returns true and parent in <c>AResult</c>,
/// otherwise returns false and nil in <c>AResult</c></summary>
class function FindParent(const AObject: TFMXObject; const AFilter: TFilterFunc; var AResult: TFMXObject): Boolean;
/// <summary>Returns first parent, which conforms <c>AFilter</c>. If parent is found, returns parent,
/// otherwise raises exception <c>ESearchException</c></summary>
class function GetParent(const AObject: TFMXObject; const AFilter: TFilterFunc): TFMXObject;
/// <summary>Finds nearest parent of <c>T</c> class. If parent is found, returns true and parent in <c>AResult</c>,
/// otherwise returns false and nil in <c>AResult</c></summary>
class function FindNearestParentOfClass<T: class>(const AObject: TFMXObject; var AResult: T): Boolean;
/// <summary>Returns first parent of <c>T</c> class. If parent is found, returns parent,
/// otherwise raises exception <c>ESearchException</c></summary>
class function GetNearestParentOfClass<T: class>(const AObject: TFMXObject): T;
end;
/// <summary>
/// Calculate relative luminance of given TAlphaColor.
/// See: http://en.wikipedia.org/wiki/Luminance_(relative)
/// Return value in range [0..1]
/// 1 - Light
/// 0 - Dark
/// </summary>
function Luminance(const AColor: TAlphaColor): Single;
/// <summary>
/// Fill array of TAlphaColor Dest of size Count with TAlphaColor value Value.
/// </summary>
procedure FillAlphaColor(const Dest: PAlphaColorArray; const Count: Integer; const Value: TAlphaColor);
/// <summary>
/// Fill a TAlphaColor rectangle in bit plane Dest of Width x Height with TAlphaColor value Value.
/// Rectangle is specified by (X1,Y1)-(X2,Y2), right-bottom bounds not included.
/// </summary>
procedure FillAlphaColorRect(const Dest: PAlphaColorArray; Width, Height, X1, Y1, X2, Y2: Integer;
const Value: TAlphaColor);
/// <summary>
/// Fill Alpha in pixel array Dest of size Count. Other color components are intact.
/// </summary>
procedure FillAlpha(const Dest: PAlphaColorRecArray; const Count: Integer; const Alpha: Byte);
/// <summary>
/// Reverse order of bytes in place in array Dest of size Count.
/// </summary>
procedure ReverseBytes(const Dest: Pointer; const Count: Integer); deprecated;
/// <summary>
/// Return a string representation of R: TRectF.
/// </summary>
function RectToString(const R: TRectF): string;
/// <summary>
/// Return TRectF represented by string S.
/// </summary>
function StringToRect(S: string): TRectF;
/// <summary> Trying to bring a text string containing the number to the canonical form </summary>
function FixNumberText(const AText: string): string;
/// <summary>
/// Return a string representation of P: TPointF.
/// </summary>
function PointToString(const P: TPointF): string;
/// <summary>
/// Return TPointF represented by string S.
/// </summary>
function StringToPoint(S: string): TPointF;
/// <summary>
/// Return a Single value between Start and Stop at time moment T. When T = 0, Result = Start. When T = 1, Result = Stop.
/// </summary>
function InterpolateSingle(const Start, Stop, T: Single): Single;
/// <summary>
/// Used for rotation angles. Same as InterpolateSingle.
/// </summary>
function InterpolateRotation(const Start, Stop, T: Single): Single;
/// <summary>
/// Interpolate color value between colors Start and Stop at time moment T.
/// When T = 0, Result = Start. When T = 1, Result = Stop.
/// </summary>
function InterpolateColor(const Start, Stop: TAlphaColor; T: Single): TAlphaColor;
/// <summary>
/// Get a token from string S. Tokens are separated by one of the characters in Separators. Separators may be different
/// every time GetToken is called.
/// S is modified for subsequent calls to GetToken.
/// </summary>
function GetToken(var S: string; const Separators: string; const Stop: string = string.Empty): string; overload;
/// <summary>
/// Get a token from immutable string S, starting at position Pos. Pos is updated for subsequent calls to GetToken.
/// Tokens are separated by one of the characters in Separators. Separators may be different every time GetToken is
/// called.
/// </summary>
function GetToken(var Pos: Integer; const S: string; const Separators: string;
const Stop: string = string.Empty): string; overload;
/// <summary>
/// Return a string representation of P: TPoint3D.
/// </summary>
function Point3DToString(const P: TPoint3D): string;
/// <summary>
/// Return TPoint3D represented by string S.
/// </summary>
function StringToPoint3D(S: string): TPoint3D;
/// <summary>
/// Returns the short version of the hint specified in the Hint string
/// </summary>
function GetShortHint(const Hint: string): string;
/// <summary>
/// Returns the long version of the hint specified in the Hint string
/// </summary>
function GetLongHint(const Hint: string): string;
/// <summary>
/// Make a normalized TVector3D equivalent to given TAlphaColor.
/// </summary>
function ColorToVector3D(const AColor: TAlphaColor): TVector3D; deprecated 'Use TAlphaColorF instead.';
/// <summary>
/// Make a TAlphaColor from TVector3D. The vector should be normalized.
/// </summary>
function Vector3DToColor(const AColor: TVector3D): TAlphaColor; deprecated 'Use TAlphaColorF instead.';
///<summary> verifies that AValue is an instance of AClass or its heir.
///<para> If this is not true, then it raise the exception.</para>
///<para> If AValue=nil and CanBeNil=true nothing happens, otherwise it raises the exception</para> </summary>
///<exception>EArgumentException is raised if AValue does not satisfy the conditions</exception>
///<exception>EArgumentNilException is raised if AValue or AClass is nil</exception>
procedure ValidateInheritance(const AValue: TPersistent; const AClass: TClass; const CanBeNil: Boolean = True);
///<summary> This function returns true if the given point (APoint) is inside or is on the contour of a
///circle centered at ACenter with radius ARadius.</summary>
function IsPointInCircle(const APoint, ACenter: TPointF; const ARadius: Integer): Boolean;
///<summary> Takes into account margin of error returning a percentage of match.
/// 100% match will be margin of error of deviation from the source point.
/// 0% will be at deviation away and beyond.</summary>
function CheckPoint(const APoint, ASource: TPointF; const ADeviation, ErrorMargin: Integer): Double;
// 2D shapes
type
///<summary> This structure represents a 2D circle centered in Center with a Radius.</summary>
TCircle2D = record
///<summary> Center of the circle.</summary>
Center: TPointF;
///<summary> Radius of the circle.</summary>
Radius: Single;
///<summary> Default constructor.</summary>
constructor Create(const ACenter: TPointF; const ARadius: Single);
end;
///<summary> This structure represents a 2D line passing through one Origin and with a Direction.</summary>
TLine2D = record
///<summary> Origin of the line.</summary>
Origin: TPointF;
///<summary> Direction of the line.</summary>
Direction: TPointF;
///<summary> Default constructor.</summary>
constructor Create(const AnOrigin, ADestination: TPointF);
///<summary> Returns true if the line intersects with the circle, False otherwise.</summary>
function Intersects(const ACircle: TCircle2D): Boolean;
end;
var
///<summary>
/// used for correct string to float convertion
///</summary>
USFormatSettings: TFormatSettings;
//== INTERFACE END: FMX.Utils
//==================================================================================================
//==================================================================================================
//== INTERFACE 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;
/// <summary>Rotates bitmap on 90 degress by clockwise</summary>
procedure Rotate90;
/// <summary>Rotates bitmap on 180 degress by clockwise</summary>
procedure Rotate180;
/// <summary>Rotates bitmap on 270 degress by clockwise</summary>
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<TMipmapSurface>;
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;
//== INTERFACE END: FMX.Surfaces
//==================================================================================================
//==================================================================================================
//== INTERFACE 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;
/// <summary>Image to be used by the brush.</summary>
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<Single>;
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);
/// <summary>
/// Font weight type helper
/// </summary>
TFontWeightHelper = record helper for TFontWeight
/// <summary>
/// Checks wherever current weight value is TFontWeight.Regular
/// </summary>
function IsRegular: Boolean;
end;
TFontSlant = (Regular, Italic, Oblique);
/// <summary>
/// Font slant type helper
/// </summary>
TFontSlantHelper = record helper for TFontSlant
/// <summary>
/// Checks wherever current slant value is TFontSlant.Regular
/// </summary>
function IsRegular: Boolean;
end;
TFontStretch = (UltraCondensed, ExtraCondensed, Condensed, SemiCondensed, Regular, SemiExpanded, Expanded,
ExtraExpanded, UltraExpanded);
/// <summary>
/// Font stretch type helper
/// </summary>
TFontStretchHelper = record helper for TFontStretch
/// <summary>
/// Checks wherever current stretch value is TFontStretch.Regular
/// </summary>
function IsRegular: Boolean;
end;
/// <summary>
/// Extended font style based on TFontStyles. Support multi-weight and multi-stretch fonts
/// </summary>
TFontStyleExt = record
/// <summary>
/// Set of regular <c>TFontStyle</c>. May contains any <c>TFontStyle</c> value but TFont will process only
/// fsOutline and fsStrikeOut values
/// </summary>
SimpleStyle: TFontStyles;
/// <summary>
/// Default font weight value
/// </summary>
Weight: TFontWeight;
/// <summary>
/// Default font slant value
/// </summary>
Slant: TFontSlant;
/// <summary>
/// Default font stretch value
/// </summary>
Stretch: TFontStretch;
/// <summary>
/// Common extended font style constructor.
/// Initialy new style is initializing using <c>AOtherStyles</c> values. After that <c>AWeight</c>, <c>ASlant</c>
/// and <c>AStretch</c> values are applying
/// </summary>
/// <remarks>
/// Basicaly bsBold or fsItalic values in AOtherStyles are ignoring. Because after creating result from the set of
/// <c>TFontStyle</c> values system will set styles from <c>AWeight</c>, <c>ASlant</c> and <c>AStretch</c> which
/// will replace style values.
/// </remarks>
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;
/// <summary>Constructor that allows to create extended style from the regular <c>TFontStyles</c></summary>
class function Create(const AStyle: TFontStyles): TFontStyleExt; overload; static; inline;
/// <summary>Default style with regular parameters without any decorations</summary>
class function Default: TFontStyleExt; static; inline;
// Operators
/// <summary>Overriding equality check operator</summary>
class operator Equal(const A, B: TFontStyleExt): Boolean;
/// <summary>Overriding inequality check operator</summary>
class operator NotEqual(const A, B: TFontStyleExt): Boolean;
/// <summary>Overriding implicit conversion to TFontStyles</summary>
class operator Implicit(const AStyle: TFontStyleExt): TFontStyles;
/// <summary>Overriding addition operator with both extended styles</summary>
class operator Add(const A, B: TFontStyleExt): TFontStyleExt;
/// <summary>Overriding addition operator with single font style item</summary>
class operator Add(const A: TFontStyleExt; const B: TFontStyle): TFontStyleExt;
/// <summary>Overriding addition operator with set of font styles</summary>
class operator Add(const A: TFontStyleExt; const B: TFontStyles): TFontStyleExt;
/// <summary>Overriding subtraction operator with single font style item</summary>
class operator Subtract(const A: TFontStyleExt; const B: TFontStyle): TFontStyleExt;
/// <summary>Overriding subtraction operator with set of font styles</summary>
class operator Subtract(const A: TFontStyleExt; const B: TFontStyles): TFontStyleExt;
/// <summary>Overriding check whether TFontStyle contains in TFontStyleExt</summary>
class operator In(const A: TFontStyle; const B: TFontStyleExt): Boolean;
/// <summary>Overriding Multiply set of TFontStyle to the TFontStyleExt</summary>
class operator Multiply(const A: TFontStyles; const B: TFontStyleExt): TFontStyles;
/// <summary>
/// Overriding Multiply set of TFontStyle to the TFontStyleExt
/// </summary>
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;
/// <summary>
/// Refrects current font style, including underline and strikeout
/// </summary>
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<TCodecDescriptor>;
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<TCodecDescriptor>; static;
class property CodecsDescriptors: TList<TCodecDescriptor> read GetCodecsDescriptors;
public
// Reserved for internal use only - do not call directly!
class procedure UnInitialize;
{ Registration and Unregistration }
/// <summary>Register a bitmap codec class with a specified file extension and description.</summary>
/// <remarks>If codec with specified <c>AFileExtension</c> was already registered or <c>AFileExtension</c> is empty
/// or <c>ACodecClass</c> is nil will raise <c>EBitmapCodecManagerException</c>.</remarks>
class procedure RegisterBitmapCodecClass(const AFileExtension, ADescription: string; const ACanSave: Boolean;
const ACodecClass: TCustomBitmapCodecClass);
/// <summary>Unregisters codec with specified file extension <c>AFileExtension</c>.</summary>
class procedure UnregisterBitmapCodecClass(const AFileExtension: string);
{ Helpers }
/// <summary>Returns list of supported image file extensions separated by ';'.</summary>
class function GetFileTypes: string;
/// <summary>Returns filter presentation of supported image types for TXXXDialog components.</summary>
class function GetFilterString: string;
/// <summary>Returns true, if codec with specified file extension was registered.</summary>
class function CodecExists(const AFileName: string): Boolean; overload;
/// <summary>Returns image size for specified file by <c>AFileName</c>.</summary>
class function GetImageSize(const AFileName: string): TPointF;
{ Loading }
/// <summary>Loads image from file by <c>AFileName</c> to Bitmap surface <c>ABitmap</c>. If image successfully
/// loaded, it returns true, otherwise - false.</summary>
/// <remarks>If <c>ABitmap</c> is nil, it will raise <c>EBitmapCodecManagerException</c>.</remarks>
class function LoadFromFile(const AFileName: string; const ABitmap: TBitmapSurface;
const AMaxSizeLimit: Cardinal = 0): Boolean;
/// <summary>Loads image thumbnail with specified size <c>AFitWidth</c> and <c>AFitHeight</c> by file name
/// <c>AFileName</c>. If image successfully loaded, it returns true, otherwise - false.</summary>
/// <remarks>If <c>ABitmap</c> is nil, it will raise <c>EBitmapCodecManagerException</c>.</remarks>
class function LoadThumbnailFromFile(const AFileName: string; const AFitWidth, AFitHeight: Single;
const AUseEmbedded: Boolean; const ABitmap: TBitmapSurface): Boolean;
/// <summary>Loads image from the stream <c>AStream</c>. If image successfully loaded, it returns true,
/// otherwise - false.</summary>
/// <remarks>If <c>ABitmap</c> or <c>AStream</c> is nil, it will raise <c>EBitmapCodecManagerException</c>.</remarks>
class function LoadFromStream(const AStream: TStream; const ABitmap: TBitmapSurface;
const AMaxSizeLimit: Cardinal = 0): Boolean;
{ Saving }
/// <summary>Saves bitmap <c>ABitmap</c> to the stream <c>AStream</c> with using codec with specified extension
/// <c>AExtension</c>. Optionally, you can specify save options. For example, the quality. If image successfully
/// saved to the stream, it returns true, otherwise - false.</summary>
/// <remarks>If <c>ABitmap</c> or <c>AStream</c> is nil, it will raise <c>EBitmapCodecManagerException</c>.</remarks>
class function SaveToStream(const AStream: TStream; const ABitmap: TBitmapSurface; const AExtension: string;
const ASaveParams: PBitmapCodecSaveParams = nil): Boolean; overload;
/// <summary>Saves bitmap <c>ABitmap</c> to the file <c>AFileName</c> . It uses codec extracted by <c>FileName</c>
/// extension. Optionally, you can specify save options. For example, the quality. If image successfully saved to
/// the file, it returns true, otherwise - false.</summary>
/// <remarks>If <c>ABitmap</c> is nil, it will raise <c>EBitmapCodecManagerException</c>.</remarks>
class function SaveToFile(const AFileName: string; const ABitmap: TBitmapSurface;
const ASaveParams: PBitmapCodecSaveParams = nil): Boolean;
end;
{ TImageTypeChecker }
/// <summary>Helper class for BitmapCodec.</summary>
TImageTypeChecker = class
private type
TImageData = record
DataType: string;
Length: Integer;
Header: array [0..3] of Byte;
end;
public
/// <summary>Analyzes the header to guess the image format of he given file.</summary>
class function GetType(const AFileName: string): string; overload;
/// <summary>Analyzes the header to guess the image format of he given stream.</summary>
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<TBitmapFrame>;
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;
/// <summary>Add frame.</summary>
/// <param name="ABitmap">Frame's bitmap to be added.</param>
/// <param name="ADuration">Frame duration in milliseconds.</param>
/// <remarks>If the added frame does not have the same dimensions as the existing frames, an <c>EAnimatedCodecException</c> will be raised.</remarks>
procedure AddFrame(const ABitmap: TBitmap; const ADuration: Integer);
/// <summary>Load animation from a file.</summary>
/// <param name="AFileName">Source file name.</param>
/// <return>True if the file loads successfully, and false otherwise.</returns>
function LoadFromFile(const AFileName: string): Boolean; virtual;
/// <summary>Load animation from a stream.</summary>
/// <param name="AStream">Source stream.</param>
/// <return>True if the stream loads successfully, and false otherwise.</returns>
function LoadFromStream(const AStream: TStream): Boolean; virtual; abstract;
/// <summary>Renders a frame at a specified time in milliseconds on the Canvas.</summary>
/// <param name="ACanvas">Destination canvas.</param>
/// <param name="AMilliseconds">The time in milliseconds of the frame to be rendered.</param>
/// <param name="AWidth">Source width.</param>
/// <param name="AHeight">Source height.</param>
/// <param name="ADestRect">Destination bounds.</param>
/// <param name="AOpacity">Opacity level of the rendered output.</param>
/// <remarks>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).</remarks>
/// <return>True if successfully rendered, false otherwise.</returns>
function Render(const ACanvas: TCanvas; const AMilliseconds: Integer; const AWidth, AHeight: Integer; const ADestRect: TRectF; const AOpacity: Single = 1): Boolean; virtual;
/// <summary>Reset the frame list.</summary>
procedure Reset;
/// <summary>Save animation to a file.</summary>
/// <param name="AFileName">Destination file name.</param>
/// <param name="AQuality">Percentage of quality (range: 0-100)</param>
/// <remarks>The higher the selected quality, the lower the compression, resulting in a larger output size.</remarks>
/// <return>True if the file is saved successfully, and false otherwise.</return>
function SaveToFile(const AFileName: string; const AQuality: Integer = 80): Boolean; virtual;
/// <summary>Save animation to a stream.</summary>
/// <param name="AStream">Destination stream.</param>
/// <param name="AQuality">Quality of the output animation, ranging from 0 (poor quality) to 100 (excellent quality).</param>
/// <return>True if the stream is saved successfully, and false otherwise.</return>
function SaveToStream(const AStream: TStream; const AQuality: Integer = 80): Boolean; virtual; abstract;
/// <summary>Get bitmap at a time.</summary>
property Bitmaps[const AMilliseconds: Integer]: TBitmap read GetBitmap; default;
/// <summary>Total number of frames.</summary>
/// <remarks>Some decoders (e.g. vector-based animations) may not return any frames.</remarks>
property Count: Integer read GetCount;
/// <summary>Total animation duration in milliseconds.</summary>
property Duration: Integer read GetDuration;
/// <summary>Get frame at an index.</summary>
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<TCodecDescriptor>;
class destructor Destroy;
class function IndexOfExtension(const AExtension: string): Integer;
class function NormalizeExtension(const AExtension: string): string; inline;
public
/// <summary>Creates an animated codec.</summary>
/// <param name="AExtension">The file extension for which the codec will be used.</param>
/// <return>Animated codec if the extension is supported, or nil otherwise.</return>
class function CreateAnimatedCodec(const AExtension: string): TCustomAnimatedCodec;
/// <summary>Returns the list of extensions (e.g. ".gif;.webp").</summary>
/// <param name="ACapability">The required capability to return the list of extensions.</param>
/// <return>List of extensions</return>
class function GetFileTypes(const ACapability: TAnimatedCapability): string;
/// <summary>Returns the filter string for use in dialog components (e.g. <c>TSaveDialog</c>, <c>TOpenDialog</c>).</summary>
/// <param name="ACapability">The required capability to return the filter string.</param>
/// <return>Filter string.</return>
class function GetFilterString(const ACapability: TAnimatedCapability): string;
/// <summary>Checks if a capability is supported.</summary>
/// <param name="AExtension">Extension used for verification</param>
/// <param name="ACapability">Capability to be checked.</param>
/// <remarks>The wildcard "*" can be used to indicate all extensions.</remarks>
/// <return>True if the capability is supported, and false otherwise.</return>
class function HasCapability(const AExtension: string; const ACapability: TAnimatedCapability): Boolean;
/// <summary>Register an animated codec class.</summary>
/// <param name="AExtension">Extension to be registered.</param>
/// <param name="ADescription">Description of the file whose extension will be registered.</param>
/// <param name="ACapabilities">The capability of the codec class to be registered.</param>
/// <param name="ACodecClass">Animated codec class to be registered.</param>
/// <remarks>If the extension has already been registered, an <c>EAnimatedCodecManagerException</c> will be raised.</remarks>
class procedure RegisterAnimatedCodecClass(const AExtension, ADescription: string; ACapabilities: TAnimatedCapabilities; ACodecClass: TCustomAnimatedCodecClass);
/// <summary>Unregister an animated codec class.</summary>
/// <param name="AExtension">Extension to be unregistered.</param>
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;
/// <summary>Helper property that returns bitmap bounds in TRect</summary>
property Bounds: TRect read GetBounds;
/// <summary>Helper property that returns bitmap bounds in TRectF</summary>
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;
/// <summary>Helper property that returns dimention of bitmap as TSize</summary>
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<TPathPoint>;
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;
/// <summary>Indicates offset of drawing area</summary>
FOffset: TPointF;
procedure SetBlending(const Value: Boolean);
class constructor Create;
class destructor Destroy;
type
TCanvasSaveStateList = TObjectList<TCanvasSaveState>;
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;
/// <summary>Checks if we are in BeginScene/EndScene process and raises exception, if we are not.</summary>
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 }
/// <summary>Apply a new matrix transformations to the canvas.</summary>
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 }
/// <summary>Clear whole canvas using Color.</summary>
procedure Clear(const AColor: TAlphaColor); virtual;
/// <summary>Clear rectangular area of canvas using Color.</summary>
procedure ClearRect(const ARect: TRectF; const AColor: TAlphaColor = 0); virtual;
/// <summary>Return True if Scale is integer value.</summary>
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 }
/// <summary>Set current clipping area using intersection of current area and rectangle.</summary>
procedure IntersectClipRect(const ARect: TRectF); virtual;
/// <summary>Exclude rectangular area from current clipping area.</summary>
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;
/// <summary>Allows to offset drawing area</summary>
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<TCanvasClassRec>;
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;
/// <summary>
/// This class combines some of properties that relate to the text
/// </summary>
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;
//== INTERFACE END: FMX.Graphics
//==================================================================================================
//==================================================================================================
//== INTERFACE 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;
/// <summary>Helpers class for quick using animation. Don't use synchronous animation on the Android.
/// Android uses asynchronous animation model.</summary>
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<Pointer>;
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 }
/// <summary>Asynchronously animates float type property and don't wait finishing of animation.</summary>
class procedure AnimateFloat(const Target: TFmxObject; const APropertyName: string; const NewValue: Single; Duration: Single = 0.2;
AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear);
/// <summary>Asynchronously animates float type property with start delay and don't wait finishing of animation.</summary>
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);
/// <summary>Synchronously animates float type property and wait finishing of animation.</summary>
/// <remarks>Don't use it on the Android. See detains in comment <c>TAnimator</c>.</remarks>
class procedure AnimateFloatWait(const Target: TFmxObject; const APropertyName: string; const NewValue: Single; Duration: Single = 0.2;
AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear);
/// <summary>Asynchronously animates integer type property and don't wait finishing of animation.</summary>
class procedure AnimateInt(const Target: TFmxObject; const APropertyName: string; const NewValue: Integer; Duration: Single = 0.2;
AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear);
/// <summary>Synchronously animates integer type property and wait finishing of animation.</summary>
/// <remarks>Don't use it on the Android. See detains in comment <c>TAnimator</c>.</remarks>
class procedure AnimateIntWait(const Target: TFmxObject; const APropertyName: string; const NewValue: Integer; Duration: Single = 0.2;
AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear);
/// <summary>Asynchronously animates color type property and don't wait finishing of animation.</summary>
class procedure AnimateColor(const Target: TFmxObject; const APropertyName: string; NewValue: TAlphaColor; Duration: Single = 0.2;
AType: TAnimationType = TAnimationType.In; AInterpolation: TInterpolationType = TInterpolationType.Linear);
/// <summary>Stops all current animations of specified property of <c>Target</c> object.</summary>
class procedure StopPropertyAnimation(const Target: TFmxObject; const APropertyName: string);
end;
{ TAnimation }
/// <summary>Trigger responsible for starting the animation.</summary>
TAnimationTrigger = class
public type
TTriggerInfo = record
Name: string;
Value: Boolean;
Prop: TRttiProperty;
end;
private
FTrigger: TTrigger;
FNames: TDictionary<TTrigger, TTrigger>;
FRttiInfo: TList<TTriggerInfo>;
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;
/// <summary>Whether the trigger condition contains the specified property?</summary>
function HasProperty(const APropertyName: string): Boolean;
/// <summary>Is trigger condition is true for specified object <c>ATarget</c>.?</summary>
function CanExecute(const ATarget: TObject): Boolean;
/// <summary>Condition for starting animation. Contains list of pairs PropertyName and boolean value separated
/// by semicolons</summary>
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
///<summary>Return normalized CurrentTime value between 0..1 </summary>
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;
/// <summary>Tries to start animation by property name <c>APropertyName</c>. Checks specified properties values
/// of <c>AInstance</c> in trigger.</summary>
/// <remarks>If <c>AInstance</c> is not specified, then animation will not start.</remarks>
procedure StartTrigger(const AInstance: TFmxObject; const APropertyName: string);
/// <summary>Stops current animation, if specified property <c>APropertyName</c> is in one of triggers.</summary>
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;
///<summary>Normalized CurrentTime value between 0..1 </summary>
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;
//== INTERFACE END: FMX.Ani
//==================================================================================================
//==================================================================================================
//== INTERFACE 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<Single>;
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;
/// <summary> Returns the default value of
/// <see cref="FMX.MultiResBitmap|TCustomMultiResBitmap.SizeKind">SizeKind</see> property </summary>
function GetDefaultSizeKind: TSizeKind; virtual;
function Add: TCustomBitmapItem;
/// <summary> Load file adding or replacing a single image </summary>
/// <param name="Scale"> 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. </param>
/// <param name="FileName"> The name of the file </param>
/// <returns> New or updated item in the collection</returns>
/// <remarks> When loading, SizeKind, Width, Height, TransparentColor properties are used </remarks>
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<TScaleName>;
TScaleNameComparer = class(TInterfacedObject, IComparer<TScaleName>)
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;
//== INTERFACE END: FMX.MultiResBitmap
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.Types3D (from FMX.Types3D.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
{ Points and rects }
type
/// <summary>Record type for the information of an axis aligned box in
/// 3D.</summary>
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
/// <summary>Constructor with a simple vertex.</summary>
constructor Create(const AnOrigin: TPoint3D); overload;
/// <summary>Constructor with a vertex and the dimensions of the box.</summary>
constructor Create(const AnOrigin: TPoint3D; const Width, Height, Depth: Single); overload;
/// <summary>Constructor with the corners values.</summary>
constructor Create(const Left, Top, Near, Right, Bottom, Far: Single); overload;
/// <summary>Constructor with two corners. See Normalize function.</summary>
constructor Create(const APoint1, APoint2: TPoint3D; NormalizeBox: Boolean = False); overload;
/// <summary>Constructor with a reference box. See Normalize function.</summary>
constructor Create(const ABox: TBoundingBox; NormalizeBox: Boolean = False); overload;
/// <summary>Constructor with a point cloud.</summary>
constructor Create(const Points: TArray<TPoint3D>); overload;
/// <summary>Constructor with a point cloud.</summary>
constructor Create(const Points: PPoint3D; const PointCount: Integer); overload;
/// <summary>Equality operator taking account a default epsilon.</summary>
class operator Equal(const LeftBox, RightBox: TBoundingBox): Boolean;
/// <summary>Not equality operator taking account a default epsilon.</summary>
class operator NotEqual(const LeftBox, RightBox: TBoundingBox): Boolean;
/// <summary>Union of two boxes.</summary>
class operator Add(const LeftBox, RightBox: TBoundingBox): TBoundingBox;
/// <summary>Intersects two boxes.</summary>
class operator Multiply(const LeftBox, RightBox: TBoundingBox): TBoundingBox;
/// <summary>Returns true if the box is invalid.</summary>
class function Empty: TBoundingBox; inline; static;
/// <summary>This function returns the scale value that can be used to scale this box to fit into the desired area.</summary>
function FitIntoScale(const ADesignatedArea: TBoundingBox): Single;
/// <summary>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.</summary>
function FitInto(const ADesignatedArea: TBoundingBox; out ARatio: Single): TBoundingBox; overload;
/// <summary>This function returns a new box which is the original box scaled by a single value to fit into
/// the desired area.</summary>
function FitInto(const ADesignatedArea: TBoundingBox): TBoundingBox; overload;
/// <summary>Makes sure TopLeftNear is above and to the left of BottomRightFar.</summary>
function Normalize: TBoundingBox;
/// <summary>Returns true if left = right or top = bottom or near = far.</summary>
function IsEmpty(const Epsilon: Single = TEpsilon.Vector): Boolean;
/// <summary>Returns true if the point is inside the box.</summary>
function Contains(const APoint: TPoint3D): Boolean; overload;
/// <summary>Returns true if the box encloses ABox completely.</summary>
function Contains(const ABox: TBoundingBox): Boolean; overload;
/// <summary>Returns true if any part of the box covers ABox.</summary>
function IntersectsWith(const ABox: TBoundingBox): Boolean;
/// <summary>Computes an intersection with the incoming box and returns that intersection.</summary>
function Intersect(const DestBox: TBoundingBox): TBoundingBox;
/// <summary>Returns the minimum box (with lowest volume) envolving this box and DestBox.</summary>
function Union(const DestBox: TBoundingBox): TBoundingBox; overload;
/// <summary>Offsets the box origin relative to current position.</summary>
function Offset(const DX, DY, DZ: Single): TBoundingBox; overload;
/// <summary>Offsets the box origin relative to current position.</summary>
function Offset(const APoint: TPoint3D): TBoundingBox; overload;
/// <summary>Inflate the box by DX, DY and DZ.</summary>
function Inflate(const DX, DY, DZ: Single): TBoundingBox; overload;
/// <summary>Inflate in all directions.</summary>
function Inflate(const DL, DT, DN, DR, DB, DF: Single): TBoundingBox; overload;
/// <summary>Returns the size of the box in a TPoint record.</summary>
function GetSize: TPoint3D;
/// <summary>The same as the equality operator, taking account a given epsilon.</summary>
function EqualsTo(const ABox: TBoundingBox; const Epsilon: Single = 0): Boolean;
/// <summary>When the Width value is changed, the Right value is modified, leaving the Left value
/// unchanged.</summary>
property Width: Single read GetWidth write SetWidth;
/// <summary>When the Height value is changed, the Bottom value is modified, leaving the Top value
/// unchanged.</summary>
property Height: Single read GetHeight write SetHeight;
/// <summary>When the Depth value is changed, the Far value is modified, leaving the Near value unchanged.</summary>
property Depth: Single read GetDepth write SetDepth;
/// <summary>Returns the center of the box.</summary>
property CenterPoint: TPoint3D read GetCenterPoint;
/// <summary>Case to couple the fields in the box.</summary>
case Integer of
/// <summary>Minimum and maximum corners by separated values.</summary>
0: (Left, Top, Near, Right, Bottom, Far: Single;);
/// <summary>Minimum and maximum corners.</summary>
1: (TopLeftNear, BottomRightFar: TPoint3D);
/// <summary>Minimum and maximum corners.</summary>
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;
/// <summary>Returns the bounding box of the mesh.</summary>
function GetBoundingBox: TBoundingBox;
/// <summary>This function flags the mesh to inform it that it should recalculate its new bounding box because some change could be performed.</summary>
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<string, TContextShader>;
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<Pointer>;
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<TLightDescription>;
{ Context's Messages }
/// <summary>This message is sent when before TContextLostMessage message in order to save data.</summary>
TContextBeforeLosingMessage = class(TMessage)
end;
/// <summary>Message that indicates that the rendering context has been
/// lost.</summary>
TContextLostMessage = class(TMessage)
end;
/// <summary>Message that indicates that a rendering context has been
/// created.</summary>
TContextResetMessage = class(TMessage)
end;
/// <summary>Message that indicates that the rendering context has been
/// removed.</summary>
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<TContextStates>;
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 }
/// <summary>Used to initialize Scale property</summary>
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 }
/// <summary> 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. </summary>
procedure DoDrawPrimitivesBatch(const AKind: TPrimitivesKind; const Vertices, Indices: Pointer;
const VertexDeclaration: TVertexDeclaration; const VertexSize, VertexCount, IndexSize,
IndexCount: Integer); virtual; abstract;
/// <summary> 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. </summary>
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;
/// <summary> Returns supported limit in index buffers on currently selected hardware-accelerated layer. </summary>
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;
/// <summary>Scale factor of context depends on real resolution of context. It gets from Texture.TextureScale or TWindowHandle.Scale.</summary>
property Scale: Single read FScale;
property Texture: TTexture read FTexture;
property DepthStencil: Boolean read FDepthStencil;
property Multisample: TMultisample read FMultisample;
/// <summary> Indicates supported limit in index buffers on currently selected hardware-accelerated layer. </summary>
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<TContextClassRec>;
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;
//== INTERFACE END: FMX.Types3D
//==================================================================================================
//==================================================================================================
//== INTERFACE 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
///<summary>Maximum size for TTextLayout</summary>
MaxLayoutSize: TPointF = (X: $FFFF; Y: $FFFF);
private
FAttributes: TList<TTextAttributedRange>;
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;
///<summary>Setting internal flag that informs that layout properties were changed
///and layout should be recalculated</summary>
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;
/// <summary>
/// List of layout attributes
/// </summary>
property Attributes[const Index: Integer]: TTextAttributedRange read GetAttribute;
/// <summary>
/// Count of layout attributes
/// </summary>
property AttributesCount: Integer read GetAttributesCount;
/// <summary>
/// Layout text
/// </summary>
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;
/// <summary>
/// Text trimmin options
/// </summary>
property Trimming: TTextTrimming read FTrimming write SetTrimming;
/// <summary>
/// Layout size limits
/// </summary>
property RightToLeft: Boolean read FRightToLeft write SetRightToLeft;
/// <summary>Returns calculated layout size.</summary>
property Size: TSizeF read GetSize;
property MaxSize: TPointF read FMaxSize write SetMaxSize;
/// <summary>
/// Coordinates of top-left layout corner.
/// </summary>
/// <remarks>
/// Use this property to change layout position on canvas, which by
/// default is (0;0)
/// </remarks>
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;
/// <summary>Class for exceptions related to the FMX.TextLayout
/// unit.</summary>
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<TTextLayoutRecord>;
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;
//== INTERFACE END: FMX.TextLayout
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.Filter (from FMX.Filter.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
{ IFilterCacheLayer }
IFilterCacheLayer = interface
['{49EEF76F-3BD6-4688-994F-DC1B55002DEA}']
/// <summary>Force refresh cache on next use.</summary>
procedure SetNeedUpdate;
end;
{ TBitmapCacheLayer }
IBitmapCacheLayer = interface(IFilterCacheLayer)
['{C321CAF5-994B-4B64-9E99-8903B7B6A67D}']
/// <summary>Attempts to initiate the draw cache update, rendering the cache image on the target.</summary>
/// <returns>True when cache modification is required and False when the current cache could be drawn to the target without updating.</returns>
function BeginUpdate(const ATarget: TCanvas; const ADestRect: TRectF; const AOpacity: Single;
const AHighSpeed: Boolean; out ACacheCanvas: TCanvas): Boolean;
/// <summary>Concludes the cache update rendering the result onto the target.</summary>
/// <param name="AGeneratedBitmap">Allows to change the generated cache image before storing it.</param>
procedure EndUpdate(const AGeneratedBitmap: TProc<TBitmap> = nil);
end;
TBitmapCacheLayer = class(TInterfacedObject, IBitmapCacheLayer)
private
FBitmap: TBitmap;
FNeedUpdate: Boolean;
FSavedDestRect: TRectF;
FSavedHighSpeed: Boolean;
FSavedOpacity: Single;
FSavedTarget: TCanvas;
public
destructor Destroy; override;
/// <summary>Attempts to initiate the draw cache update, rendering the cache image on the target.</summary>
/// <returns>True when cache modification is required and False when the current cache could be drawn to the target without updating.</returns>
function BeginUpdate(const ATarget: TCanvas; const ADestRect: TRectF; const AOpacity: Single;
const AHighSpeed: Boolean; out ACacheCanvas: TCanvas): Boolean;
/// <summary>Concludes the cache update rendering the result onto the target.</summary>
/// <param name="AGeneratedBitmap">Allows to change the generated cache image before storing it.</param>
procedure EndUpdate(const AGeneratedBitmap: TProc<TBitmap> = nil);
/// <summary>Force refresh cache on next use.</summary>
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<TFilter>;
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;
/// <summary>Attempt to initiate a layer to apply the filter directly to the canvas drawings from that point on, until the EndLayer is called.</summary>
function BeginLayer(const ATarget: TCanvas; const ADestRect: TRectF; const AOpacity: Single;
const AHighSpeed: Boolean; var ACacheLayer: IFilterCacheLayer; out ACacheCanvas: TCanvas): Boolean;
/// <summary>End the drawings in the direct filter layer, merging the result into the original canvas.</summary>
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<TFilterClass, string>;
TFilterClassDict = TDictionary<string, TFilterClass>;
TFilterContextClassDict = TDictionary<TCanvasClass, TFilterContextClass>;
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
/// <summary>Write the filter categories in a list</summary>
class procedure FillCategory(AList: TStrings);
/// <summary>Write the filters of a category in a list</summary>
class procedure FillFiltersInCategory(const ACategory: string; AList: TStrings);
/// <summary>Get a new filter instance by the filter name</summary>
class function FilterByName(const AName: string): TFilter;
/// <summary>Get the filter class by it's name</summary>
class function FilterClassByName(const AName: string): TFilterClass;
/// <summary>Register new filter class.</summary>
class procedure RegisterFilter(const ACategory: string; AFilter: TFilterClass);
/// <summary>Register new filter context for a specific canvas.</summary>
class procedure RegisterFilterContextForCanvas(const AContextClass: TFilterContextClass; const ACanvasClass: TCanvasClass);
/// <summary>Reserved for internal use only - do not call directly!</summary>
class procedure UnInitialize;
/// <summary>Unregister a filter class.</summary>
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;
/// <summary>Reserved for internal use only - do not call directly!</summary>
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);
//== INTERFACE END: FMX.Filter
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.Text (from FMX.Text.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
{ TCaretPosition }
/// <summary>Record describes platform independant position in multiline text</summary>
/// <remarks>
/// 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.
/// </remarks>
TCaretPosition = record
/// <summary>Text line number value</summary>
Line: Integer;
/// <summary>Caret position in line defined by Line value</summary>
Pos: Integer;
public
/// <summary>Create new TCaretPosition with devined values of Line and Pos</summary>
class function Create(const ALine, APos: Integer): TCaretPosition; static; inline;
/// <summary>Overriding equality check operator</summary>
class operator Equal(const A, B: TCaretPosition): Boolean;
/// <summary>Overriding inequality check operator</summary>
class operator NotEqual(const A, B: TCaretPosition): Boolean;
/// <summary>Overriding compare operator: Less Or Equal</summary>
class operator LessThanOrEqual(const A, B: TCaretPosition): Boolean;
/// <summary>Overriding compare operator: Less Than</summary>
class operator LessThan(const A, B: TCaretPosition): Boolean;
/// <summary>Overriding compare operator: Greater Or Equal</summary>
class operator GreaterThanOrEqual(const A, B: TCaretPosition): Boolean;
/// <summary>Overriding compare operator: Greater Than</summary>
class operator GreaterThan(const A, B: TCaretPosition): Boolean;
/// <summary>Overriding implicit conversion to TPoint</summary>
class operator Implicit(const APosition: TCaretPosition): TPoint;
/// <summary>Overriding implicit conversion to TCaretPosition</summary>
class operator Implicit(const APoint: TPoint): TCaretPosition;
/// <summary>Returns zero caret position value (0; 0)</summary>
class function Zero: TCaretPosition; inline; static;
/// <summary>Resturn invalid caret position value (-1; -1)</summary>
class function Invalid: TCaretPosition; inline; static;
/// <summary>Increment line number value</summary>
procedure IncrementLine;
/// <summary>Decrement line number value</summary>
procedure DecrementLine;
/// <summary>Check wherever current caret position has zero value (0; 0)</summary>
function IsZero: Boolean;
/// <summary>
/// Checks wherever current caret position has invalid value (either <c>Line</c> or <c>Pos</c> has -1 value)
/// </summary>
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<TMarkedTextAttribute>; 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;
/// <summary>Returns <c>Text</c> with inserted IME <c>MarkedText</c>.</summary>
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;
/// <summary>Refreshes position of IME related UI controls.</summary>
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;
/// <summary>Original text without IME marked text.</summary>
property Text: string read GetText write SetText;
property ImeMode: TImeMode read GetImeMode write SetImeMode default TImeMode.imDontCare;
/// <summary>Defines the maximum text of the text that could inputed via text service</summary>
property MaxLength: Integer read FMaxLength write SetMaxLength;
/// <summary>Defines wherever input control allows to input several lines on text or just a single one.</summary>
property Multiline: Boolean read FMultiLine;
/// <summary>Defines input character case</summary>
property CharCase: TEditCharCase read FCharCase write SetCharCase;
/// <summary>Defines input filter</summary>
property FilterChar: string read FFilterChar write SetFilterChar;
/// <summary>Holds a reference to the text input control in UI</summary>
property Owner: IControl read FOwner;
/// <summary>Returns the IME text that user is entering.</summary>
property MarkedText: string read InternalGetMarkedText;
/// <summary>Specifies position of IME marked text.</summary>
property MarkedTextPosition: TCaretPosition read FMarkedTextPosition write SetMarkedTextPosition;
/// <summary>Returns text attributes for each character in <c>MarkedText</c>.</summary>
property MarketTextAttributes: TArray<TMarkedTextAttribute> read GetMarketTextAttributes;
end;
TTextServiceClass = class of TTextService;
IIMEComposingTextDecoration = interface
['{13D7F323-B51B-46B5-8455-9BB9ACBACF61}']
function GetRange: TTextRange;
function GetText: string;
end;
{ TTextWordWrapping }
///<summary>Manage text line counting and line retrieving for a given width in a canvas.</summary>
TTextWordWrapping = class
public
/// <summary>
/// Fills ALinesFound with the text that fits on a certain Width (AMaxWidth). Also fills the real maximum
/// with found.
/// </summary>
class procedure GetLines(const AText: string; const ACanvas: TCanvas; const AMaxWidth: Integer;
var ALinesFound: TStringList; var AResWidth: Integer);
/// <summary>
/// Computes the number of lines needed to draw the text supplied for a certain Width (AMaxWidth). Also
/// fills the real maximum with found.
/// </summary>
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 }
/// <summary>Returns position</summary>
function GetTargetClausePointF: TPointF;
procedure StartIMEInput;
procedure EndIMEInput;
/// <summary>Platform using this method to notify control that either text or caret position was changed</summary>
procedure IMEStateUpdated;
{ Selection }
function GetSelection: string;
/// <summary>Returns selection rect in local cooridnate system of text-input control.</summary>
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 }
/// <summary>Interface for accessing text lines.</summary>
ITextLinesSource = interface
['{21E863AD-6411-4B68-A985-4D36D899DA97}']
{ Lines accessing }
/// <summary>Returns line by index.</summary>
function GetLine(const ALineIndex: Integer): string;
/// <summary>Returns lines break separator.</summary>
function GetLineBreak: string;
/// <summary>Returns lines count.</summary>
function GetCount: Integer;
/// <summary>Returns concatted lines.</summary>
function GetText: string;
/// <summary>Returns line by index.</summary>
property Lines[const AIndex: Integer]: string read GetLine; default;
/// <summary>Line break separator.</summary>
property LineBreak: string read GetLineBreak;
/// <summary>Lines count.</summary>
property Count: Integer read GetCount;
/// <summary>Returns concatted lines.</summary>
property Text: string read GetText;
{ Position conversion }
/// <summary>
/// Convert absolute platform-dependent position in text to platform independent value in format
/// (line_number, position_in_line)
/// </summary>
function TextPosToPos(const APos: Integer): TCaretPosition;
/// <summary>Convert platform-independent position to absolute platform-dependent position</summary>
function PosToTextPos(const APostion: TCaretPosition): Integer;
end;
/// <summary>
/// Proxy source of text lines. Allows to modify the lines from the source <c>ITextLinesSource</c> 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
/// </summary>
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
/// <summary>The position where the IME text <c>MarkedText</c> should be inserted.</summary>
property MarkedTextPosition: TCaretPosition read FMarkedTextPosition write SetMarkedTextPosition;
/// <summary>The text inserted by the IME at the specified <c>MarkedTextPosition</c> position.</summary>
property MarkedText: string read FMarkedText write SetMarkedText;
/// <summary>
/// Is it necessary to embed the specified IME text <c>MarkedText</c> in the specified position
/// <c>MarkedTextPosition</c>?
/// </summary>
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<string>;
{ 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;
/// <summary>Removes from the source string Input all characters that are not in the Filter string.</summary>
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;
//== INTERFACE END: FMX.Text
//==================================================================================================
//==================================================================================================
//== INTERFACE 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;
/// <summary>Initiate a drawing layer with the effect applied, creating a reusable cache.</summary>
/// <returns>True when cache modification is required and False when the current cache could be drawn to the target without updating.</returns>
function BeginLayer(const ATarget: TCanvas; const ADestRect: TRectF; const AOpacity: Single;
const AHighSpeed: Boolean; var ACacheLayer: IFilterCacheLayer; out ACacheCanvas: TCanvas): Boolean; virtual;
/// <summary>Concludes the layer update rendering the result onto the target.</summary>
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);
//== INTERFACE END: FMX.Effects
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.Text.UndoManager (from FMX.Text.UndoManager.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
/// <summary>Information about fragment of the text that was inserted.</summary>
TFragmentInserted = record
/// <summary>Position in text where text was inserted.</summary>
StartPos: Integer;
/// <summary>Fragment of text that was inserted.</summary>
Fragment: string;
/// <summary>
/// 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).
/// </summary>
PairedWithPrev: Boolean;
/// <summary>Was text inserted via typing from keyboard or not.</summary>
Typed: Boolean;
public
/// <summary>Create new information about inserted text with defined values.</summary>
constructor Create(const AStartPos: Integer; const AFragment: string; const APairedWithPrev, ATyped: Boolean);
end;
/// <summary>Information about fragment of the text that was removed.</summary>
TFragmentDeleted = record
/// <summary>Position in text from which text was deleted.</summary>
StartPos: Integer;
/// <summary>Fragment of text that was deleted.</summary>
Fragment: string;
/// <summary>Was removed text select or not.</summary>
Selected: Boolean;
/// <summary>Was caret moved after text was removed or not.</summary>
CaretMoved: Boolean;
public
/// <summary>Create new information about removed text with defined values.</summary>
constructor Create(const AStartPos: Integer; const AFragment: string; const ASelected, ACaretMoved: Boolean);
end;
{ TUndoManager }
TActionType = (Delete, Insert);
///<summary>Record that describes text-editing operation.</summary>
TEditAction = record
///<summary>Type of change that was made (text added or removed).</summary>
ActionType: TActionType;
///<summary>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).</summary>
PairedWithPrev: Boolean;
///<summary>Position in text from which text was deleted or into which text was inserted.</summary>
StartPosition: Integer;
///<summary>Fragmen of text that was inserted/deleted.</summary>
Fragment: string;
///<summary>Was text inserted via typing from keyboard or not.</summary>
Typed: Boolean;
///<summary>Was removed text select or not.</summary>
WasSelected: Boolean;
///<summary>Was caret moved after text was removed or not.</summary>
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;
/// <summary>
/// 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.
/// </summary>
TUndoManager = class
private
FActions: TList<TEditAction>;
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 }
///<summary>New fragment of text was inserted.</summary>
procedure FragmentInserted(const AStartPos: Integer; const AFragment: string; const APairedWithPrev, ATyped: Boolean);
///<summary>Some text fragment was removed.</summary>
procedure FragmentDeleted(const AStartPos: Integer; const AFragment: string; const ASelected, ACaretMoved: Boolean);
{ Undo operations }
///<summary>Revert last change.</summary>
function Undo: Boolean;
/// <summary>Does the manager have undo fragments?</summary>
function CanUndo: Boolean;
{ Redo operations }
/// <summary>Apply next change.</summary>
function Redo: Boolean;
/// <summary>Does the manager have redo fragments?</summary>
function CanRedo: Boolean;
public
/// <summary>The event is being invoked with undo action parameters, when client initiate undo operation.</summary>
property OnUndo: TUndoEvent read FOnUndo write FOnUndo;
/// <summary>The event is being invoked with redo action parameters, when client initiate redo operation.</summary>
property OnRedo: TRedoEvent read FOnRedo write FOnRedo;
end;
TEditActionStack = TUndoManager deprecated 'Use TUndoManager instead';
//== INTERFACE END: FMX.Text.UndoManager
//==================================================================================================
//==================================================================================================
//== INTERFACE 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;
/// <summary>Converts a point from the scene coordinate system to the screen coordinate system.</summary>
function LocalToScreen(const AScenePoint: TPointF): TPointF;
/// <summary>Converts a point from the screen coordinate system to the scene coordinate system.</summary>
function ScreenToLocal(const AScreenPoint: TPointF): TPointF;
procedure ChangeScrollingState(const AControl: TControl; const AActive: Boolean);
/// <summary>Disable Scene's updating</summary>
procedure DisableUpdating;
/// <summary>Enable Scene's updating</summary>
procedure EnableUpdating;
property Canvas: TCanvas read GetCanvas;
end;
/// <summary>Exception raised when the process for Disabling Updating and
/// Enabling Upating is not correct.</summary>
EInvalidSceneUpdatingPairCall = class(Exception);
{ IDesignerControl: Control implementing this is part of the designer }
IDesignerControl = interface
['{C57A701D-E4B5-4711-BFA4-716E2164A929}']
end;
/// <summary>Controls that can respond to hint-related events must implement
/// this interface.</summary>
IHintReceiver = interface
['{533671CF-86C5-489E-B32A-724AF8464DCE}']
/// <summary>This method is called when a hint is triggered.</summary>
procedure TriggerOnHint;
end;
/// <summary>A class needs to implement this interface in order to be able to
/// register IHintReceiver instances.</summary>
IHintRegistry = interface
['{8F3B3C46-450B-4A8C-800F-FD47538244C3}']
/// <summary>Triggers the TriggerOnHint method of all the objects that are registered in this registry.</summary>
procedure TriggerHints;
/// <summary>Registers a new receiver.</summary>
procedure RegisterHintReceiver(const AReceiver: IHintReceiver);
/// <summary>Unregisters a receiver.</summary>
procedure UnregisterHintReceiver(const AReceiver: IHintReceiver);
end;
/// <summary>The base class for an object that can manage a hint.</summary>
THint = class
public type
THintClass = class of THint;
private class var
FClassRegistry: TArray<THintClass>;
protected
/// <summary>Field to store the hint.</summary>
FHint: string;
/// <summary>Field to store the status (enabled or not) of the hint.</summary>
FEnabled: Boolean;
/// <summary>Method that updates the state of enabled.</summary>
procedure SetEnabled(const Value: Boolean); virtual;
public
/// <summary>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.</summary>
constructor Create(const AHandle: TWindowHandle); virtual;
/// <summary>Sets the full hint string.</summary>
procedure SetHint(const AString: string); virtual;
/// <summary>Gets the full hint string.</summary>
function GetHint: string;
/// <summary>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.</summary>
function GetShortText: string;
/// <summary>Returns the long text of the hint.</summary>
function GetLongText: string;
/// <summary>If the specific implementation supports it, this metods places the hint in the given position.</summary>
procedure SetPosition(const X, Y: Single); virtual; abstract;
/// <summary>Register a class to create hint instances. When a new THint instance is needed, the registered classes are invoked
/// to create the needed instance.</summary>
class procedure RegisterClass(const AClass: THintClass);
/// <summary>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.</summary>
class function CreateNewInstance(const AHandle: TWindowHandle): THint;
/// <summary>Returns True if there are some THint class registered.</summary>
class function ContainsRegistredHintClasses: Boolean;
/// <summary>If this property is true, the hint can be displayed, if it is False, the hint won't be displayed.</summary>
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 }
/// <summary>Links an action to a client (generic control).</summary>
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;
/// <summary>This method is invoked to allow a link to customize a Hint that is going to be displayed.</summary>
function DoShowHint(var HintStr: string): Boolean; virtual;
/// <summary>This method sets the string of the hint.</summary>
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<TControl>;
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);
/// <summary>Helper for TControlType.</summary>
TControlTypeHelper = record helper for TControlType
public
/// <summary>Returns string presentation of value of this type</summary>
function ToString: string;
end;
/// <summary>
/// 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.
/// </summary>
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<TEffect>;
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<TControl>);
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;
/// <summary>This method sets the hint string for this control.</summary>
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;
/// <summary>Implementation of IControl.HasHint. See IControl for details.</summary>
function HasHint: Boolean; virtual;
/// <summary>Implementation of IControl.GetHintString. See IControl for details.</summary>
function GetHintString: string; virtual;
/// <summary>Implementation of IControl.GetHintObject. See IControl for details.</summary>
function GetHintObject: TObject; virtual;
/// <summary>This method returns true if the control can show hint according <c>ParentShowHint</c>,
/// <c>ShowHint</c> and settings of parent control values.</summary>
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;
/// <summary>Notification about changed parent of ancestor</summary>
procedure AncestorParentChanged; virtual;
procedure ClipChildrenChanged; virtual;
procedure HitTestChanged; virtual;
/// <summary>Notification about changed padding</summary>
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;
/// <summary> This method is called after change field <b>FEnabled</b> in <b>SetEnabled</b> before all other
/// actions</summary>
procedure EnabledChanged; virtual;
/// <summary> This method is called after change field <b>FVisible</b> in <b>SetVisible</b> before all other
/// actions</summary>
procedure VisibleChanged; virtual;
/// <summary>Returns True if the control rect is empty.</summary>
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;
/// <summary>If the control has ShowHint to false, this property is used to see if a hint can be displayed.</summary>
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'}
/// <summary>Converts <c>Point</c> in absolute coordinate system to local coordinate system of control.</summary>
function AbsoluteToLocal(const APoint: TPointF): TPointF; overload; virtual;
/// <summary>Converts <c>ARect</c> in absolute coordinate system to local coordinate system of control.</summary>
function AbsoluteToLocal(const ARect: TRectF): TRectF; overload;
/// <summary>Converts <c>Point</c> in local coordinate system of control to absolute coordinate system.</summary>
function LocalToAbsolute(const APoint: TPointF): TPointF; overload; virtual;
/// <summary>Converts <c>ARect</c> in local coordinate system of control to absolute coordinate system.</summary>
function LocalToAbsolute(const ARect: TRectF): TRectF; overload;
/// <summary>Converts a point from the screen coordinate system to the scene coordinate system.</summary>
function ScreenToLocal(const AScreenPoint: TPointF): TPointF; virtual;
/// <summary>Converts a point from the scene coordinate system to the screen coordinate system.</summary>
function LocalToScreen(const ALocalPoint: TPointF): TPointF; virtual;
/// <summary>Converts a point from the coordinate system of a given <c>AControl</c> to that of the control.</summary>
function ConvertLocalPointFrom(const AControl: TControl; const AControlLocalPoint: TPointF): TPointF;
/// <summary>Converts a point from the control's coordinate system to that of the specified control <c>AControl</c>.</summary>
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;
/// <summary>Paints current hierarchy of controls on the specified <c>ACanvas</c> in area <c>ARect</c>. <c>ARect</c>
/// uses logical coordinate system.</summary>
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;
/// <summary> The absolute rectangle of control after clipping by all its parent controls </summary>
property AbsoluteClipRect: TRectF read GetAbsoluteClipRect;
property AxisAlignedRect: TRectF read GetAxisAlignedRect;
/// <summary>Flag property indicates when control in applying effect state.</summary>
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;
///<summary>Point when MouseDown is called</summary>
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<TControl, TEnumControlsResult>); 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;
/// <summary>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.</summary>
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;
/// <summary>If this property is true, the control will display its hint.</summary>
property ShowHint: Boolean read FShowHint write SetShowHint stored IsShowHintStored;
/// <summary>Hint string to display if the mouse hovers the control.</summary>
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);
/// <summary> Determines the current state of the style
/// <para> Unapplied - The style was successfully freed, or was not applied yet </para>
/// <para> Freeing - At the moment the style is being freed
/// See <see cref="FMX.Controls|TStyledControl.FreeStyle">FreeStyle</see> </para>
/// <para> Applying - At the moment the style is being applied
/// See <see cref="FMX.Controls|TStyledControl.ApplyStyle">ApplyStyle</see> </para>
/// <para> Error - an exception was raised during applying or freeing the style </para>
/// <para> Applied - The style was successfully applied </para>
/// </summary>
TStyleState = (Unapplied, Freeing, Applying, Error, Applied);
{ TStyledControl }
TStyledControl = class(TControl)
public const
StyleSuffix = 'style';
strict private class var
FLoadableStyle: TFmxObject;
strict private
FStylesData: TDictionary<string, TValue>;
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;
/// <summary>Return Context for behavior manager.</summary>
function GetStyleContext: TFmxObject; virtual;
function GetDefaultStyleLookupName: string; virtual;
/// <summary>Getter for ParentClassStyleLookupName property. Return default StyleLookup name for parent class.
/// Used when style is loading.</summary>
function GetParentClassStyleLookupName: string; virtual;
procedure DoEnter; override;
procedure Disappear; override;
procedure AdjustSize; virtual;
procedure AdjustFixedSize(const ReferenceControl: TControl); virtual;
/// <summary>Select fixed size adjust type based on FixedSize in ResourceLink</summary>
function ChooseAdjustType(const FixedSize: TSize): TAdjustType; virtual;
procedure DoStyleChanged; virtual;
procedure StyleLookupChanged; virtual;
procedure RecycleResourceLink;
procedure KillResourceLink;
procedure DoDeleteChildren; override;
/// <summary>Generate style lookup name based on AClassName string.</summary>
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;
/// <summary>Gets style resource for this control as TFmxObject</summary>
function GetResourceLink: TFmxObject; virtual;
/// <summary>Gets style resource for this control as TControl</summary>
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;
/// <summary> This property allows you to define the current state of style. It is changed when calling virtual
/// methods <see cref="FMX.Controls|TStyledControl.FreeStyle">FreeStyle</see>,
/// <see cref="FMX.Controls|TStyledControl.ApplyStyle">ApplyStyle</see>,
/// <see cref="FMX.Controls|TStyledControl.DoApplyStyleLookup">DoApplyStyleLookup</see>
/// </summary>
property StyleState: TStyleState read FStyleState;
procedure RecalcSize; override;
function FindStyleResource(const AStyleLookup: string; const Clone: Boolean = False): TFmxObject; overload; override;
/// <summary>Try find resource of specified type T by name <c>AStyleLookup</c>. If resource is not of type T or
/// is not found, it returns false and doesn't change value of <c>AResource</c> param</summary>
function FindStyleResource<T: TFmxObject>(const AStyleLookup: string; var AResource: T): Boolean; overload;
/// <summary>Try find resource of specified type T by name <c>AStyleLookup</c> and makes a copy of original resource.
/// If resource is not of type T, it returns nil</summary>
function FindAndCloneStyleResource<T: TFmxObject>(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;
/// <summary>Return default StyleLookup name for parent class</summary>
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;
/// <summary>Style that currently used to load style object</summary>
class property LoadableStyle: TFmxObject read FLoadableStyle write FLoadableStyle;
/// <summary>Lookup style object in scene StyleBook, active style and global pool.</summary>
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<TStyleBook>)
private
FScene: IScene;
public
constructor Create(const StyleBook: TStyleBook; const Scene: IScene); overload;
/// <summary>Scene where the style has been changed, nil if the change is global</summary>
property Scene: IScene read FScene;
end;
TBeforeStyleChangingMessage = class(TMessage)
end;
{ TStyleContainer }
TStyleContainer = class(TControl, IBinaryStyleContainer)
private
FBinaryDict: TDictionary<string, TMemoryStream>;
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 }
/// <summary>Represents an item in an instance of TStyleCollection that holds
/// a style for a platform.</summary>
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;
/// <summary>Reload style from binary stream</summary>
procedure LoadFromBinary;
/// <summary>Save style to binary stream</summary>
procedure SaveToBinary;
/// <summary>Clear style and binary stream</summary>
procedure Clear;
/// <summary>Return true is style is empty</summary>
property IsEmpty: Boolean read GetIsEmpty;
/// <summary>Load style from stream</summary>
procedure LoadFromStream(const Stream: TStream);
/// <summary>Load style from file</summary>
procedure LoadFromFile(const FileName: string);
/// <summary>Save style to stream</summary>
procedure SaveToStream(const Stream: TStream; const Format: TStyleFormat = TStyleFormat.Indexed);
/// <summary>Link to owner StyleBook</summary>
property StyleBook: TStyleBook read FStyleBook;
/// <summary>Style that stored on this item</summary>
property Style: TFmxObject read GetStyle;
/// <summary>If style can not be load on current platform tihs property is True and Style is empty</summary>
property UnsupportedPlatform: Boolean read FUnsupportedPlatform;
published
/// <summary>Name used to idenity style in collection</summary>
property Platform: string read FPlatform write SetPlatform;
/// <summary>Design-time only property used to show Style Designer</summary>
property Resource: string read GetResource write SetResource stored False;
end;
/// <summary>Collection of items that store styles for different
/// platforms.</summary>
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);
/// <summary>Create and add new item</summary>
function Add: TStyleCollectionItem;
/// <summary>Access property for style collection items</summary>
property Items[Index: Integer]: TStyleCollectionItem read GetItem write SetItem; default;
end;
/// <summary>Record type that contains design-time information for the Form
/// Designer.</summary>
TStyleBookDesignInfo = record
/// <summary>ClassName of selected control</summary>
ClassName: string;
/// <summary>If True that edit custom style mode is active</summary>
CustomStyle: Boolean;
/// <summary>Default StyleLookup for selected control</summary>
DefaultStyleLookup: string;
/// <summary>Name of selected control</summary>
Name: string;
/// <summary>StyleLookup of selected control</summary>
StyleLookup: string;
/// <summary>Selected control itself</summary>
Control: TStyledControl;
/// <summary>True if StyleBook just created</summary>
JustCreated: Boolean;
end;
TStyleBook = class(TFmxObject)
private
FStyles: TStyleCollection;
FStylesDic: TDictionary<string, TStyleCollectionItem>;
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
/// <summary>Used when looking style in global pool</summary>
function CustomFindStyleResource(const AStyleLookup: string; const Clone: Boolean): TFmxObject; virtual;
/// <summary>Choose style depends on context</summary>
procedure ChooseStyleIndex; virtual;
/// <summary>Create empty item on demand</summary>
procedure CreateDefaultItem; virtual;
procedure Loaded; override;
procedure DefineProperties(Filer: TFiler); override;
procedure ReadResources(Stream: TStream);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
/// <summary>Integration property used with Style Designer</summary>
property DesignInfo: TStyleBookDesignInfo read FDesignInfo write FDesignInfo;
/// <summary>Clear style collection</summary>
procedure Clear;
/// <summary>Get Style by Context</summary>
function GetStyle(const Context: TFmxObject): TFmxObject; overload;
/// <summary>Load style from stream</summary>
procedure LoadFromStream(const Stream: TStream);
/// <summary>Load style from file</summary>
procedure LoadFromFile(const AFileName: string);
/// <summary>Current Style</summary>
property Style: TFmxObject read GetStyle;
/// <summary>Item index of current style in style's collection</summary>
property CurrentItemIndex: Integer read FCurrentItemIndex write SetCurrentItemIndex;
/// <summary>Current style in style's collection</summary>
property CurrentItem: TStyleCollectionItem read GetCurrentItem;
property Resource: TStrings read FResource;
/// <summary>If style can not be load on current platform tihs property is True and Style is empty</summary>
property UnsupportedPlatform: Boolean read GetUnsupportedPlatform;
published
/// <summary>Used to load style from file instead of storing style in form resource</summary>
property FileName: string read FFileName write SetFileName;
/// <summary>If UseStyleManager is True component use TStyleManager to replace default style for whole application</summary>
property UseStyleManager: Boolean read FUseStyleManager write SetUseStyleManager default False;
/// <summary>Collection of styles stored in StyleBook </summary>
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
/// <summary>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.</summary>
procedure DoRootChanging(const NewRoot: IRoot); override;
/// <summary>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.</summary>
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 }
/// <summary>Implements IAcceleratorKeyReceiver.TriggerAcceleratorKey by setting focus to this control.</summary>
procedure TriggerAcceleratorKey; virtual;
/// <summary>Implements IAcceleratorKeyReceiver.CanTriggerAcceleratorKey by returning True if this control and all
/// of its parent controls are visible.</summary>
function CanTriggerAcceleratorKey: Boolean; virtual;
/// <summary>Implements IAcceleratorKeyReceiver.GetAcceleratorChar by returning the value stored in FAcceleratorKey.</summary>
function GetAcceleratorChar: Char;
/// <summary>Implements IAcceleratorKeyReceiver.GetAcceleratorCharIndex by returning the value stored in
/// FAcceleratorKeyIndex. This indicates the position within the text string of the accelerator character.</summary>
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;
/// <summary> Determine the way portraying a single character "&amp;" </summary>
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;
///<summary> This event is called periodically (for the AniDuration time) after emergence and before the
/// disappearance of the pop-up </summary>
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;
/// <summary>True - if popup form have to be closed, if <c>PlacementTarget</c> is not visible on the screen.</summary>
/// <remarks>It works only, when <c>PlacementTarget</c> is specified.</remarks>
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;
/// <summary>
/// Whether to take into account the scaling factor of the parent when displaying the pop-up or not?
/// </summary>
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<T: TStyledControl> = interface
function GetInflatableItems: TList<T>;
procedure NotifyInflated;
end;
TContentInflater<T: TStyledControl> = class(TInterfacedObject, IInterface)
strict private
FInflatable: IInflatableContent<T>;
FBusy: Boolean;
procedure ReceiveIdleMessage(const Sender : TObject; const M : System.Messaging.TMessage);
public
constructor Create(const Inflatable: IInflatableContent<T>);
destructor Destroy; override;
procedure Inflate(Total: Boolean);
end;
TControlsFilter<T: TFmxObject> = class(TEnumerableFilter<TControl,T>)
end;
ISearchResponder = interface
['{C73631F4-5AD7-48b9-92D2-CC808B911B5E}']
procedure SetFilterPredicate(const Predicate: TPredicate<string>);
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;
//== INTERFACE END: FMX.Controls
//==================================================================================================
//==================================================================================================
//== INTERFACE 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;
//== INTERFACE END: FMX.Memo.Types
//==================================================================================================
//==================================================================================================
//== INTERFACE 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;
/// <summary>A bitmap item in a TMultiResBitmap multi-resolution
/// bitmap.</summary>
TBitmapItem = class(TCustomBitmapItem)
private
function GetImageList: TCustomImageList;
public
/// <summary> A reference to the list of images to whom belongs to an instance of this class </summary>
property ImageList: TCustomImageList read GetImageList;
/// <exception>EArgumentException is raised in case Collection is not <b>TMultiResBitmap</b></exception>
constructor Create(Collection: TCollection); override;
published
property Bitmap;
property Scale;
end;
/// <summary> A multi-resolution bitmap is a collection of bitmap which is used in <b>TCustomSourceItem</b> and
/// <b>TImageList</b></summary>
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
/// <exception>EArgumentException is raised in case AOwner is not <b>TCustomSourceItem</b></exception>
constructor Create(AOwner: TPersistent; ItemClass: TCustomBitmapItemClass);
function GetDefaultSizeKind: TSizeKind; override;
/// <summary> A reference to the item of collection to whom belongs to an instance of this class </summary>
property SourceItem: TCustomSourceItem read FSourceItem;
property ImageList: TCustomImageList read GetImageList;
end;
/// <summary> The item collection (without published properties) contains the original graphical data, which can be
/// used to obtain images in the image list <b>TCustomImageList</b>. See <b>TSourceCollection</b> </summary>
/// <remarks> Note that the data stored in fmx, dfm file, even if they are not used </remarks>
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
/// <summary> This virtual method must create a instance of TMultiResBitmap. Override this method if you want to
/// create <b>MultiResBitmap</b> property of your own type </summary>
function CreateMultiResBitmap: TMultiResBitmap; virtual;
procedure SetCollection(Value: TCollection); override;
function GetDisplayName: string; override;
public
/// <exception>EArgumentException is raised in case Collection is not <b>TSourceCollection</b></exception>
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
/// <summary> Collection of identical images are optimized for different scales </summary>
property MultiResBitmap: TMultiResBitmap read FMultiResBitmap write SetMultiResBitmap;
/// <summary> The case-insensitive name of the item in the collection. This field cannot be empty and must be
/// unique for his collection. See also <b>TLayer.Name</b> </summary>
property Name: string read FName write SetName;
/// <summary> A reference to the Collection to whom belongs to an instance of this class </summary>
property Source: TSourceCollection read FSource;
end;
/// <summary>Represents an item in a TSourceCollection collection.</summary>
TSourceItem = class (TCustomSourceItem)
published
property MultiResBitmap;
property Name;
end;
/// <summary> The collection that contains original graphical data. See <b>TCustomSourceItem</b> </summary>
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
/// <exception>EArgumentException is raised in case AOwner is not <b>TCustomImageList</b></exception>
constructor Create(AOwner: TPersistent; ItemClass: TSourceItemClass);
property ImageList: TCustomImageList read FImageList;
property Items[Index: Integer]: TCustomSourceItem read GetItem write SetItem; default;
function Add: TCustomSourceItem;
/// <summary> Adds or replaces several files into the collection </summary>
/// <param name="SourceName"> 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
/// <para> See also <b>TCustomMultiResBitmap.AddOrSet</b></para> </param>
/// <param name="Scales"> The array that contains the scales of added pictures </param>
/// <param name="FileNames"> The array that contains the file names of added pictures. <b>Scales</b> and
/// <b>FileNames</b> must have equal lengths </param>
/// <param name="TransparentColor"> The color that will be substituted with fully transparent color. If set to
/// <b>TColors.SysNone</b>, no subsitution will be performed.</param>
/// <param name="Width"> The width (in pixels) of the added image (at a scale of 1) </param>
/// <param name="Height"> 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</param>
/// <returns> New or updated element of the collection</returns>
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;
/// <summary> This method creates a new item in the collection and inserts before the element with the specified
/// number </summary>
function Insert(Index: Integer): TCustomSourceItem;
/// <summary> Case-insensitive search of item by name</summary>
/// <returns> if successful then the number of the found item, <c>-1</c> otherwise </returns>
function IndexOf(const Name: string): Integer;
end;
/// <summary> The item of collection <b>TLayers</b>, used in <b>TImageList</b> for obtaining graphical data from
/// <b>TSourceCollection</b>. See <b>TCustomImageList.Source</b>, <b>TCustomImageList.Destination</b> </summary>
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;
/// <summary> A reference to the collection to whom belongs to an instance of this class </summary>
property Layers: TLayers read FLayers;
property ImageList: TCustomImageList read GetImageList;
/// <summary> Reference to property <b>MultiResBitmap</b> of found item <b>TCustomImageList.Source</b>. The search
/// is done by property <b>Name</b>. Can be nil.</summary>
property MultiResBitmap: TMultiResBitmap read GetMultiResBitmap stored False;
published
/// <summary> The case-insensitive name of the item in collection Source </summary>
property Name: string read FName write SetName;
/// <summary> The coordinates of the rectangular region in the original image <b>MultiResBitmap</b> 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. </summary>
property SourceRect: TBounds read FSourceRect write SetSourceRect;
end;
/// <summary> The collection <b>TLayer</b> items, used in <b>TImageList</b> for obtaining graphical data from
/// <b>TSourceCollection</b>. See <b>TCustomImageList.Source</b>, <b>TCustomImageList.Destination</b> </summary>
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);
/// <summary> A reference to the item to whom belongs to this collection </summary>
property DestinationItem: TCustomDestinationItem read FDestinationItem;
/// <summary> A reference to the list of images to whom belongs to this collection </summary>
property ImageList: TCustomImageList read GetImageList;
function Add: TLayer;
function Insert(Index: Integer): TLayer;
property Items[Index: Integer]: TLayer read GetItem write SetItem; default;
end;
/// <summary> The item of collection (without published properties) which contains the data to form the final images
/// in <b>TImageList</b>. To obtain image, sequentially drawn regions of <b>Source</b> which specified in the
/// collection <b>Layers</b>. Also performs selection the image with the most appropriate scale for the current scene
/// and the size of the final image </summary>
TCustomDestinationItem = class (TCollectionItem)
public const
StrDestinationDisplay = '%d (%s)';
private
FLayers: TLayers;
[Weak] FDestination: TDestinationCollection;
FIsChanged: Boolean;
procedure SetLayers(const Value: TLayers);
protected
/// <summary> This virtual method must create a collection of layers. Override this method if you want to create a
/// collection of your own type </summary>
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;
/// <summary> The number of <i>not empty</i> items in the <b>Layers</b> collection </summary>
function LayersCount: Integer;
/// <summary> This property evaluates to True if there have been some changes, but the notification about redrawing
/// has not yet been sent </summary>
property IsChanged: Boolean read FIsChanged;
/// <summary> The collection that contains references to <b>Source</b> for drawing image. Can be one or more layers
/// which will drawn sequentially</summary>
property Layers: TLayers read FLayers write SetLayers;
/// <summary> A reference to the Collection to whom belongs to this item </summary>
property Destination: TDestinationCollection read FDestination;
end;
/// <summary> The item of collection (with published properties) which contains the data to form the final images
/// in <b>TImageList</b></summary>
TDestinationItem = class (TCustomDestinationItem)
published
property Layers;
end;
/// <summary> The collection which contains the data to form the final images in <b>TImageList</b> </summary>
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;
/// <summary> List of images. Base class that used in fire monkey without published properties </summary>
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<Integer, TCustomDestinationItem>;
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<TItemRec>;
function InvalidateDestination(const Name: string): Boolean;
function IsIgnoreIndex: Boolean;
protected
/// <summary> Creates a <b>Source</b> collection. Override this method if you want to create your own collection
/// </summary>
function CreateSource: TSourceCollection; virtual;
/// <summary> Creates a <b>Destination</b> collection. Override this method if you want to create your own
/// collection </summary>
function CreateDestination: TDestinationCollection; virtual;
procedure DoChange; override;
/// <summary> This method called after changes and before notification of all instances of TImageLink. This method
/// is executing event handler of OnChanged </summary>
procedure DoChanged; virtual;
procedure Loaded; override;
/// <summary> This method is createing instance of TBitmap and drawing all <b>Layers</b> </summary>
/// <param name="Size"> The size of created Bitmap </param>
/// <param name="Index"> The zero-based number of item in the collection <b>Destination</b> that used for painting
/// image</param>
/// <returns> 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</returns>
function DoBitmap(Size: TSize; const Index: Integer): TBitmap; virtual;
/// <summary> This method is trying find a bitmap in cache. If successful then returns a bitmap otherwise nil </summary>
function FindInCache(const Size: TSize; const Index: Integer): TBitmap;
/// <summary> Adding bitmap into end of cache. If the count of images more than CacheSize, then the first
/// (the oldest) image will removed </summary>
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;
/// <summary> Adds or replaces several files in the <b>Source</b> collection, and adds the item to the
/// <b>Destination</b> collection if it does not exist </summary>
/// <returns> The number of the new element of <b>Destination</b> or <c>-1</c> if it already exists </returns>
/// <remarks> See also <b>TSourceCollection.AddOrSet</b></remarks>
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;
/// <summary> Tries to find, in the <b>Source</b> collection, the bitmap item specified by <b>Name</b></summary>
/// <param name="Name">The name of the item. See <b>TCustomSourceItem.Name</b></param>
/// <param name="Item">If succed, contains the found bitmap item for scale 1, otherwise is not changed</param>
/// <param name="Size">If succed, contains the size of the found item, otherwise is not changed</param>
/// <returns> <c>True</c> if the item is found</returns>
function BitmapItemByName(const Name: string; var Item: TCustomBitmapItem; var Size: TSize): Boolean;
/// <summary>Returns the TBitmap object containing the image pointed by <b>Index</b>. Returns <c>nil</c> if the
/// <b>Index</b> image does not exist.
/// <para>See also BitmapExists, ClearCache, TBitmap.Assign</para>
/// <para>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. </para>
/// </summary>
function Bitmap(Size: TSizeF; const Index: Integer): TBitmap;
/// <summary> Returns <c>True</c> if the <b>Index</b> element in the <b>Source</b> collection contains some
/// graphical data that can be used to create an image </summary>
function BitmapExists(const Index: Integer): Boolean;
/// <summary> This method trying to determine the maximum size of layer, which less than input size. If
/// <b>TLayer.MultiResBitmap</b> has multiple images for different scales, then the search is performed among all
/// images </summary>
/// <param name="Index"> The index of item in <b>Destination</b> collection. For this image it determines suitable
/// size </param>
/// <param name="Size"> Before executing it contains the original size, after you do this the most suitable size or
/// source value</param>
/// <returns> <c>True</c> in case of success, otherwise <c>False</c>. If <c>False</c> then <b>Size</b> does not
/// change </returns>
/// <remarks> This method is called from TGlyph if the property <b>Stretch</b> is <c>False</c> </remarks>
function BestSize(const Index: Integer; var Size: TSize): Boolean; overload;
function BestSize(const Index: Integer; var Size: TSizeF): Boolean; overload;
/// <summary> Draws a single picture on the specified canvas </summary>
/// <param name="Canvas">The canvas on which will be painted picture</param>
/// <param name="Rect">The rectangle in which will be inscribed picture</param>
/// <param name="Index">Zero based ordinal number of image</param>
/// <param name="Opacity">The transparency of the drawing pictures. By default 1 (completely not transparency)
/// </param>
/// <returns> True if the picture was drawn </returns>
function Draw(const Canvas: TCanvas; const Rect: TRectF; const Index: Integer; const Opacity: Single = 1): Boolean;
/// <summary> Helper method for drawing some bitmap. This method used in <b>DoBitmap</b> </summary>
procedure DrawBitmapToCanvas(const Canvas: TCanvas; const Bitmap: TBitmap; SrcRect, DstRect: TRect;
const Fast: Boolean = False);
/// <summary> Removing bitmaps from the internal cache </summary>
/// <param name="Index">With the default <c>-1</c> value, it removes all bitmaps. Otherwise removes from cache
/// bitmaps with all sizes but only for the specified <b>Index</b></param>
procedure ClearCache(const Index: Integer = -1);
/// <summary> Performs immediate notification about the change of images if there are changes. <para>See also
/// <b>OnChanged</b>, <b>DoChanged</b>, <b>TImageLink</b>, <b>ImagesChanged</b></para></summary>
/// <remarks> 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 </remarks>
procedure UpdateImmediately;
/// <summary> 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 </summary>
property CacheSize: Word read GetCacheSize write SetCacheSize;
/// <summary> Set property <b>Dormant</b> to all items of <b>Source</b>. See TCustomBitmapItem.Dormant </summary>
property Dormant: Boolean read GetDormant write SetDormant;
/// <summary> The collection which contains source graphical data. This data used in items of <b>Destination</b> for
/// produce images. See BitmapItemByName </summary>
property Source: TSourceCollection read FSource write SetSource;
/// <summary> 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 </summary>
property Destination: TDestinationCollection read FDestination write SetDestination;
/// <summary> If the component isn't in the update state, then event handler is executed immediately after any
/// change, else after the <b>EndUpdate</b> method. <para>See also <b>DoChange</b>, <b>Change</b></para> </summary>
property OnChange: TNotifyEvent read FOnChange write FOnChange;
/// <summary> 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
/// <para>See also <b>DoChanged</b>, <b>TImageLink</b></para> </summary>
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
end;
/// <summary>FireMonkey image lists are collections of multi-resolution
/// bitmaps.</summary>
TImageList = class(TCustomImageList)
published
property Source;
property Destination;
property OnChange;
property OnChanged;
end;
/// <summary>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.</summary>
TGlyphImageLink = class(TImageLink)
private
[Weak] FOwner: TComponent;
FGlyph: IGlyph;
public
///<summary>Default constructor. If AOwner unsupported IGlyph then raised EArgumentException. If AOwner = nil then
/// raised EArgumentNilException</summary>
///<param name="AOwner">The reference to the control with which it interacts. Can't be nil. Must supported
/// interface IGlyph</param>
constructor Create(AOwner: TComponent); reintroduce;
procedure Change; override;
/// <summary>Control that was defined at calling constructor <b>Create</b> </summary>
property Owner: TComponent read FOwner;
/// <summary>Interface of <b>Owner</b> that was defined at calling constructor <b>Create</b> </summary>
property Glyph: IGlyph read FGlyph;
end;
/// <summary>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.</summary>
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;
/// <summary> This vitrual method is calling event <b>OnChanged</b> and method <b>Repaint</b>. <b>DoChanged</b>
/// method is called in <b>ImagesChanged</b>. You shouldn't call this method manually </summary>
procedure DoChanged; virtual;
/// <summary> This method is updating properties <b>BitmapExists</b>, and <b>Visible</b> in case if <b>AutoHide</b>
/// is true </summary>
procedure UpdateVisible;
procedure ActionChange(Sender: TBasicAction; CheckDefaults: Boolean); override;
/// <summary> Determines whether the <b>ImageIndex</b> property needs to be stored in the fmx-file</summary>
/// <returns> <c>True</c> if the <b>ImageIndex</b> property needs to be stored in the fmx-file</returns>
function ImageIndexStored: Boolean; virtual;
/// <summary> Determines whether the <b>Images</b> property needs to be stored in the fmx-file </summary>
/// <returns> <c>True</c> if the <b>Images</b> property needs to be stored in the fmx-file</returns>
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;
/// <summary> Should be called when you change an instance or reference to instance of <b>TBaseImageList</b> or the
/// <b>ImageIndex</b> property
/// <para>See also <b>FMX.ActnList.IGlyph</b></para></summary>
/// <remarks> This method is executed after change list of images. If TGlyph not in state Loading, Destroying,
/// Updating then this method call <b>DoChanged</b>, otherwise only set property <b>IsChanged</b> to true</remarks>
procedure ImagesChanged;
/// <summary> Is <c>True</c> if <b>Images</b> is not <c>nil</c> and <b>ImageIndex</b> points to an existing picture.
/// <para>See also <b>UpdateVisible</b>, <b>TCustomImageList.BitmapExists</b></para></summary>
property BitmapExists: Boolean read FBitmapExists;
/// <summary> 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</summary>
property IsChanged: Boolean read FIsChanged write FIsChanged;
published
property Action;
/// <summary> If <c>True</c>, then: at run time <b>Visible</b> property depends only on <b>BitmapExists</b>'s value;
/// at designtime <b>Visible</b> is always <c>True</c>. Otherwise, <b>Visible</b>'s value can be set
/// programmatically</summary>
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;
/// <summary> Specifies whether to stretch the image shown in the glyph control </summary>
property Stretch: Boolean read FStretch write SetStretch default True;
///<summary> Zero based index of an image. The default is <c>-1</c>.
///<para> See also <b>FMX.ActnList.IGlyph</b></para></summary>
///<remarks> If non-existing index is specified, an image is not drawn and no exception is raised</remarks>
property ImageIndex: TImageIndex read GetImageIndex write SetImageIndex stored ImageIndexStored;
///<summary> The list of images. Can be <c>nil</c>. <para>See also <b>FMX.ActnList.IGlyph</b></para></summary>
property Images: TCustomImageList read GetImages write SetImages stored ImagesStored;
/// <summary> This event handler is called after some changes in list of images and before painting </summary>
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
property OnPaint;
property OnPainting;
end;
//== INTERFACE END: FMX.ImgList
//==================================================================================================
//==================================================================================================
//== INTERFACE 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}
/// <summary>IDesignerHook is an interface that allows component writers to
/// interact with the form designer in the IDE.</summary>
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);
/// <summary>Called after the form has been completely painted, so additional painting can be performed on top on it</summary>
procedure Decorate(Context: TObject);
property HasFixedSize: Boolean read GetHasFixedSize;
end;
/// <summary>Deprecated, only kept for backwards compatibility</summary>
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);
/// <summary>Notification about terminating application</summary>
TApplicationTerminatingMessage = class(System.Messaging.TMessage);
TApplicationStateEvent = function: TApplicationState;
TFormsCreatedMessage = class(System.Messaging.TMessage);
/// <summary>Notification about showing form</summary>
TFormBeforeShownMessage = class(System.Messaging.TMessage<TCommonCustomForm>);
/// <summary>Notification about activating specified form</summary>
TFormActivateMessage = class(System.Messaging.TMessage<TCommonCustomForm>);
/// <summary>Notification about deactivating specified form</summary>
TFormDeactivateMessage = class(System.Messaging.TMessage<TCommonCustomForm>);
TFormReleasedMessage = class(System.Messaging.TMessage);
TApplication = class(TComponent)
private type
TFormRegistryItem = class
public
InstanceClass: TComponentClass;
Instance: TComponent;
Reference: Pointer;
end;
TFormRegistryItems = TList<TFormRegistryItem>;
TFormRegistry = TObjectDictionary<String,TFormRegistryItems>;
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<TComponent>;
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;
/// <summary> Perform method <b>TComponent.ExecuteAction</b> for current active control or active form or
/// <b>Application</b></summary>
/// <returns> <c>True</c> if the method <b>ExecuteTarget</b> of <b>Action</b> was performed</returns>
/// <remarks> This method is analogous to the CM_ACTIONEXECUTE handler's in VCL </remarks>
function ActionExecuteTarget(Action: TBasicAction): Boolean;
function ExecuteAction(Action: TBasicAction): Boolean; reintroduce;
function UpdateAction(Action: TBasicAction): Boolean; override;
/// <summary>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.</summary>
function TrackActivity: Boolean;
property ActionUpdateDelay: Integer read FActionUpdateDelay write FActionUpdateDelay;
procedure HandleException(Sender: TObject);
procedure ShowException(E: Exception);
/// <summary>Cancels the display of a hint for a control.</summary>
procedure CancelHint;
/// <summary>Hides the current hint.</summary>
procedure HideHint;
/// <summary>Determines whether Help Hints are enabled or disabled for the entire application.</summary>
property ShowHint: Boolean read FShowHint write SetShowHint;
/// <summary>Occurs when the mouse pointer moves over a control or menu item that can display a Help Hint.</summary>
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;
/// <summary>Returns true if RealCreateForms was invoked; otherwise, false.</summary>
property IsRealCreateFormsCalled: Boolean read FIsRealCreateFormsCalled;
procedure RegisterActionClient(const ActionClient: TComponent);
procedure UnregisterActionClient(const ActionClient: TComponent);
function GetActionClients: TEnumerable<TComponent>;
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;
/// <summary>Returns an instance of TAnalyticsManager. An instance will be created if one does not already exist.
/// There should only be one AnalyticsManager per application.</summary>
property AnalyticsManager: TAnalyticsManager read GetAnalyticsManager;
/// <summary>Specifies the text string that appears in the Help Hint box.</summary>
property Hint: string read FHint write SetHint;
/// <summary>Enables the display of keyboard shortcuts.</summary>
property HintShortCuts: Boolean read FHintShortCuts write SetHintShortCuts;
end;
/// <summary>Links an action object to a client (generic form).</summary>
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;
/// <summary>A service for working with form size constraints.</summary>
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;
/// <summary>Notifies when form changed style.</summary>
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<TCommonCustomForm>);
TMainCaptionChangedMessage = class(System.Messaging.TMessage<TCommonCustomForm>);
TMainFormChangedMessage = class(System.Messaging.TMessage<TCommonCustomForm>);
/// <summary>Notification about destoying real form</summary>
TBeforeDestroyFormHandle = class(System.Messaging.TMessage<TCommonCustomForm>);
/// <summary>Notification about creating real form</summary>
TAfterCreateFormHandle = class(System.Messaging.TMessage<TCommonCustomForm>);
TOrientationChangedMessage = class(System.Messaging.TMessage);
TSizeChangedMessage = class(System.Messaging.TMessage<TSize>);
TSaveStateMessage = class(System.Messaging.TMessage);
/// <summary>Notification about changing focus control.</summary>
TFormChangingFocusControl = class(System.Messaging.TMessage)
public
/// <summary>Previous focused control.</summary>
[Weak] PreviousFocusedControl: IControl;
/// <summary>New control, which are going to have focus.</summary>
[Weak] NewFocusedControl: IControl;
/// <summary>Does focus changing finished? True - <c>NewFocusedControl</c> received focus, False - otherwise.</summary>
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;
/// <summary>Settings of system status bar</summary>
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
/// <summary>Background color of system status bar</summary>
property BackgroundColor: TAlphaColor read FBackgroundColor write SetBackgroundColor default DefaultBackgroundColor;
/// <summary>Different modes of showing system status bar</summary>
property Visibility: TVisibilityMode read FVisibility write SetVisibility default DefaultVisibility;
end;
/// <summary>Service for working with native system status bar</summary>
IFMXWindowSystemStatusBarService = interface(IInterface)
['{06258F45-98C5-4F8F-9A77-01F2BD892A5B}']
/// <summary>Sets background color of system status bar</summary>
procedure SetBackgroundColor(const AForm: TCommonCustomForm; const AColor: TAlphaColor);
/// <summary>Sets how system status bar will be shown. See TVisibilityMode</summary>
procedure SetVisibility(const AForm: TCommonCustomForm; const AMode: TFormSystemStatusBar.TVisibilityMode);
end;
/// <summary>
/// The service is designed to position the form on the screen depending on the selected position mode.
/// </summary>
/// <remarks>You can use the default implementation, see the class <c>TDefaultFormPositioner</c>.</remarks>
IFMXFormPositionerService = interface
['{7624844E-3F50-4C51-A742-BA1379EB7D5F}']
procedure PlaceOnScreen(const AForm: TCommonCustomForm; const APosition: TFormPosition);
end;
/// <summary>
/// The default implementation of <c>IFMXFormPositionerService</c> for all platforms. It uses Density-Independent
/// Pixel for calculation positions.
/// </summary>
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<TModalResult>;
FTabList: TTabList;
FTouchManager: TTouchManager;
FOnGesture: TGestureEvent;
FOnSaveState: TNotifyEvent;
FSaveState: TFormSaveState;
FSaveStateMessageId: TMessageSubscriptionId;
FEngageCount: Integer;
FSharedHint: THint;
FLastHinted: IControl;
FHintReceiverList: TList<IHintReceiver>;
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;
/// <summary>
/// The method is called when form need to apply size constraints. You can overload this method to adjust
/// the constraint values.
/// </summary>
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<string>); virtual;
procedure SetPreloadProperties(const PropertyStore: TDictionary<string, Variant>); 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;
/// <summary>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.</summary>
procedure ScaleChangedHandler(const Sender: TObject; const Msg: System.Messaging.TMessage); virtual;
/// <summary>Style changeing event handler</summary>
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<TCommonCustomForm>);
{$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'}
/// <summary>
/// Starting the processing of the Key Down event. The method performs full processing and delivery of the event
/// to consumers.
/// </summary>
procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); virtual;
/// <summary>
/// Starting the processing of the Key Up event. The method performs full processing and delivery of the event
/// to consumers.
/// </summary>
procedure KeyUp(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); virtual;
/// <summary>
/// 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.
/// </summary>
function DispatchAcceleratorKey(const AKey: Word; const AKeyChar: WideChar; const AShift: TShiftState): Boolean; virtual;
/// <summary>
/// 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.
/// </summary>
function DispatchDialogKey(const AKey: Word; const AKeyChar: WideChar; const AShift: TShiftState): Boolean; virtual;
{$ENDREGION}
/// <summary>Force recreating form resources lie Canvas or Context.</summary>
procedure RecreateResources; virtual;
procedure HandleNeed; deprecated 'Use HandleNeeded.';
/// <summary> Requests the form to create its handle at this moment and all associated resources with it.
/// This replaces HandleNeed method, which has been deprecated. </summary>
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;
/// <summary>Sets new form frame in DP.</summary>
procedure SetBoundsF(const ALeft, ATop, AWidth, AHeight: Single); overload; virtual;
/// <summary>Sets new form frame in DP.</summary>
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}
/// <summary>Closes the form and returns the actual TCloseAction performed.</summary>
function Close: TCloseAction;
procedure Show;
procedure Hide;
procedure BringToFront; override;
procedure SendToBack; override;
function ShowModal: TModalResult; overload;
procedure ShowModal(const ResultProc: TProc<TModalResult>); overload;
/// <summary>Closes a modal form and returns the actual TCloseAction performed.</summary>
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);
/// <summary>Returns true if the handle is allocated; otherwise, false. </summary>
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];
/// <summary>Bounds of form - position and size (dp).</summary>
property Bounds: TRect read GetBounds write SetBounds;
/// <summary>Bounds of form - position and size (dp).</summary>
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;
/// <summary>Settings of system status bar on mobile platforms</summary>
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;
/// <summary>Determines whether Help Hints are enabled or disabled for the entire application.</summary>
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<string>); override;
procedure SetPreloadProperties(const PropertyStore: TDictionary<string, Variant>); 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;
/// <summary>True - if popup form have to be relocated, when parent changes his position on screen.</summary>
property DragWithParent: Boolean read FDragWithParent write SetDragWithParent;
/// <summary>True - if popup form have to be closed, if <c>PlacementTarget</c> is not visible on the screen.</summary>
/// <remarks>It works only, when <c>PlacementTarget</c> is specified.</remarks>
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<Pointer>;
FDataModules: TList<Pointer>;
FPopupForms: TList<Pointer>;
FSaveForm: TCommonCustomForm;
FMouseSvc: IFMXMouseService;
FMultiDisplaySvc: IInterface;
FPopupList: TList<TCommonCustomForm>;
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<TCommonCustomForm>);
function CreatePopupList(const SaveForm: TCommonCustomForm): TList<TCommonCustomForm>;
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;
/// <summary>The size of primary display.</summary>
function Size: TSizeF;
property Height: Single read GetHeight;
property Width: Single read GetWidth;
function MultiDisplaySupported: Boolean;
procedure UpdateDisplayInformation;
/// <summary> Tries to return a rectangular having the specified Size and positioned in the center of the desktop.
/// See also IFMXMultiDisplayService.GetDesktopCenterRect </summary>
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}
//== INTERFACE END: FMX.Forms
//==================================================================================================
//==================================================================================================
//== INTERFACE 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 }
/// <summary>Information about key pressed by user. Used for sending message from <c>TPresentedControl</c>
/// to presentation</summary>
TKeyInfo = record
/// <summary>Scan code of the pressed keyboard key, or $0.</summary>
Key: Word;
/// <summary>Pressed character or digit, or #0.</summary>
KeyChar: System.WideChar;
/// <summary>Combination of modifier keys that were pressed when the specified key (Key, KeyChar) was pressed.</summary>
Shift: TShiftState;
end;
/// <summary>Information about action. Is used for sending message from <b>TPresentedControl</b> to presentation</summary>
TActionInfo = record
/// <summary>Data of the ASender argument of TPresentedControl.ActionChange.</summary>
Sender: TBasicAction;
/// <summary>Data of the ACheckDefaults argument of TPresentedControl.ActionChange.</summary>
CheckDefaults: Boolean;
end;
/// <summary>Information about requesting style resource from presentation. Used for sending message from
/// <b>TPresentedControl</b> to presentation. The |<b>Resource</b>| is filled by presentation</summary>
TFindStyleResourceInfo = record
/// <summary>Whether the returned style resource object should be the original style object (False) or a copy of
/// the original (True).</summary>
Clone: Boolean;
/// <summary>Name of the style resource object to return.</summary>
ResourceName: string;
/// <summary>Property to hold the returned style resource object.</summary>
Resource: TFmxObject;
end;
/// <summary>Information about searching of control at specified point. |<b>Control</b>| contains instance of found
/// the control</summary>
TObjectAtPointInfo = record
/// <summary>Hit-Test Point.</summary>
Point: TPointF;
/// <summary>Returned Control if it found.</summary>
Control: IControl;
end;
/// <summary>Information about hit-testing point in local control at specified point.</summary>
TPointInObjectLocalInfo = record
/// <summary>Hit-Test Point.</summary>
Point: TPointF;
/// <summary>Returned true, if presentation layer contains specified point.</summary>
Result: Boolean;
end;
/// <summary>Information used for staring trigger animation or effect.</summary>
TTriggerInfo = record
/// <summary>Link to Instance object that has triggered property</summary>
Instance: TFmxObject;
/// <summary>Trigger property name</summary>
Trigger: string;
/// <summary>Hold application before trigger animation completed</summary>
Wait: Boolean;
end;
/// <summary>Information used for transfering mouse wheel event into presentation in design time.</summary>
TMouseWheelInfo = record
/// <summary>Indicates which shift keys--SHIFT, CTRL, ALT, and CMD (only for Mac)--were down when the pressed
/// mouse button is released.</summary>
Shift: TShiftState;
/// <summary>Indicates the distance the wheel was rotated. WheelDelta is positive if the mouse was rotated upward,
/// negative if the mouse was rotated downward.</summary>
WheelDelta: Integer;
/// <summary>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.</summary>
Handled: Boolean
end;
/// <summary>Information used for requesting control, which supports specified gestures</summary>
TFirstControlWithGestureInfo = record
/// <summary>Interactive gestures</summary>
Gestures: TInteractiveGesture;
/// <summary>Returned control, which supports specified Gestures</summary>
Control: TComponent;
end;
/// <summary>Raised, when presentation received a model of the wrong class</summary>
EPresentationWrongModel = class(Exception);
/// <summary><para>Some composit controls like a <b>TListBox</b>, <b>TScrollBox</b>, <b>TMenu</b> and etc, have a
/// special content for storing and moving items. </para>
/// <para>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 <b>TContent</b> in this case, because native
/// <b>TScrollBox</b> already considered offset of content. So for this purpose we need to use this interface.</para>
/// <para>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.</para>
/// </summary>
IIgnoreControlPosition = interface
['{6C5DA960-D0E0-457B-9464-D489034510B7}']
/// <summary>See description of <c>IIgnoreControlPosition</c></summary>
function GetIgnoreControlPosition: Boolean;
end;
/// <summary> Proxy. Mediator. Base class for linking a <b>TPresentatedControl</b> control with a presentation.
/// Successors of it must create presentation in <c>FMX.Presentation.Messages.TMessageSender.CreateReceiver</c>.
/// </summary>
TPresentationProxy = class(TMessageSender)
private
FNativeObject: IInterface;
[Weak] FControl: TControl;
[Weak] FModel: TDataModel;
public
/// <summary>Default constructor, requests native control by presentation by sending <b>PM_GET_NATIVE_OBJECT</b>
/// message to presentation (<b>Receiver</b>).</summary>
constructor Create; override;
/// <summary>Initializes proxy by control and model and create link with presentation by using
/// <c>FMX.Presentation.Messages.TMessageSender.CreateReceiver</c></summary>
/// <param name="AModel">Model instance of |<b>AControl</b>|</param>
/// <param name="AControl">Control, which supports using of presentation (usually <b>TPresentedControl</b>)</param>
constructor Create(const AModel: TDataModel; const AControl: TControl); overload; virtual;
/// <summary>Releases presentation, if presentation was created by using
/// <c>FMX.Presentation.Messages.TMessageSender.CreateReceiver</c></summary>
destructor Destroy; override;
/// <summary>Returns True if proxy has native control. Returns False otherwise.</summary>
function HasNativeObject: Boolean;
public
/// <summary>Returns presented control</summary>
property PresentedControl: TControl read FControl;
/// <summary>Returns model</summary>
property Model: TDataModel read FModel;
/// <summary>If presentation has native control, this property will contains reference on Instance of native control.
/// Proxy send request on getting native control by using <b>PM_GET_NATIVE_OBJECT</b> message</summary>
/// <remarks>You can use it for directly access to native control by casting to required type, if presentation uses
/// native control</remarks>
property NativeObject: IInterface read FNativeObject;
end;
/// <summary>Class of <b>TPresentationProxy</b></summary>
TPresentationProxyClass = class of TPresentationProxy;
{ TPresentedControl }
/// <summary>Event type for choosing presentation name by <b>TPresentedControl</b></summary>
TPresenterNameChoosingEvent = procedure (Sender: TObject; var PresenterName: string) of object;
/// <summary>States of presentation</summary>
TPresentationState = (NotLoaded, Loading, Loaded, Unloading);
ISceneChildrenObserver = interface
['{FD2EF8F6-EFF5-40EF-84A1-2850C42B3554}']
procedure ChildWasRemoved(const AChild: TFmxObject);
end;
/// <summary>Control, which supports working with <b>Model</b> and <b>Presentations</b>. Control can has instance of
/// <b>Model</b> for storing data of control. <b>TPresentedControl</b> provide mechanism for choosing, creating,
/// loading, using and unloading presentations. For communication with presentation <b>TPresentedControl</b> uses
/// <b>TPresentationProxy</b>.</summary>
TPresentedControl = class(TStyledControl, IMessageSendingCompatible, IControlTypeSupportable, ISceneChildrenObserver)
public type
/// <summary>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.</summary>
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 }
/// <summary>Notifies about changed <c>ControlType</c></summary>
procedure ControlTypeChanged; virtual;
/// <summary>Notifies about changed <c>ClipChildren</c></summary>
procedure ClipChildrenChanged; override;
/// <summary>Notifies about changed <c>HitTest</c></summary>
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;
/// <summary>Defines recommended size for specified size <c>AWishedSize</c></summary>
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 }
/// <summary>Returns presentation name for current control.</summary>
/// <remarks>By default presentation name is generated as <b>"ClassName (Without prefix T)"</b>-<c>GetPresentationSuffix</c> </remarks>
function DefinePresentationName: string; virtual;
/// <summary><para>Returns presentation suffix for <c>DefinePresentationName</c>, which depends on <c>ControlType</c> value.</para>
/// <para>If <c>ControlType</c> equals <b>Styled</b>, return <b>styled</b></para>
/// <para>If <c>ControlType</c> equals <b>Platform</b>, return <b>native</b></para></summary>
function GetPresentationSuffix: string;
/// <summary>Initializes a presentation through <c>PresentationProxy</c>. Allows users to set custom data for
/// presentation</summary>
procedure InitPresentation(APresentation: TPresentationProxy); virtual;
/// <summary>Notify all child controls, that <c>AControl</c> changed presentation.</summary>
procedure AncestorPresentationLoaded(const AControl: TPresentedControl);
/// <summary>Notify all child controls, that <c>AControl</c> is unloading presentation.</summary>
procedure AncestorPresentationUnloading(const AControl: TPresentedControl);
{ Model }
/// <summary>Tries to cast current model to type <c>T</c>. If specified type <c>T</c> is not compatible with
/// <c>Model</c>, return nil.</summary>
function GetModel<T: TDataModel>: T;
/// <summary>Returns class of controls model. By default it is <c>TDataModel</c>. User can return nil. In this case
/// <c>TPresentedControl</c> will not have Model.</summary>
function DefineModelClass: TDataModelClass; virtual;
/// <summary>If control cannot find presentation, control will try to load default presentation <c>'default-' +
/// GetPresentationSuffix</c> only if this property is true.</summary>
property CanUseDefaultPresentation: Boolean read FCanUseDefaultPresentation write FCanUseDefaultPresentation;
/// <summary>Query interface from current control. If <c>TPresentedControl</c> doesn't support specified interface, it will
/// query it from presentation.</summary>
function QueryInterface(const IID: TGUID; out Obj): HRESULT; override; stdcall;
/// <summary>Returns native presentation scene, which is used for rendering nested controls. Can be nil.</summary>
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 }
/// <summary><para>Finds presentation proxy class from <c>TPresentationProxyFactory</c>, creates instance of presentation
/// proxy and attaches to itself.</para><para>Also notifies all child controls about new loaded presentation.</para></summary>
/// <remarks>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.</remarks>
procedure LoadPresentation; virtual;
/// <summary>Unloads and releases current presentation proxy.</summary>
procedure UnloadPresentation; virtual;
/// <summary>Unloads existing presentation proxy and tries to load new instead.</summary>
procedure ReloadPresentation;
public
property ControlType: TControlType read GetControlType write SetControlType default TControlType.Styled;
/// <summary>Returns instance of presentation object</summary>
property Presentation: TObject read GetPresentation;
/// <summary>Returns intermediary between presentation and PresentedControl. Can be used for sending messages to
/// presentation</summary>
property PresentationProxy: TPresentationProxy read FPresentationProxy;
/// <summary>State of presentation: <c>NotLoaded</c>, <c>Loading</c>, <c>Loaded</c> or <c>Unloading.</c></summary>
property PresentationState: TPresentationState read FState;
/// <summary>Returns instance of control's model</summary>
property Model: TDataModel read FModel;
/// <summary>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.</summary>
property OnPresentationNameChoosing: TPresenterNameChoosingEvent read FOnPresenterNameChoosing write FOnPresenterNameChoosing;
end;
//== INTERFACE END: FMX.Controls.Presentation
//==================================================================================================
//==================================================================================================
//== INTERFACE 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;
/// <summary>Returns current device, which's view is selected in IDE</summary>
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;
/// <summary>Used by <c>TPresentedControl</c> for getting overlay icon. This icon is used to point that
/// <c>TPresentedControl</c> uses platform presentation (ControlType = Platform)</summary>
IPresentedControlBehavior = interface
['{B98B1B59-C1AF-4D53-8D81-1A429460A11C}']
/// <summary>Returns overlay icon. See description of <c>IPresentedControlBehavior</c></summary>
function GetOverlayIcon: TBitmap;
end;
TBehaviorServices = class
protected type
TServicesList = TDictionary<TGUID, IInterface>;
TListenerList = TList<IListener>;
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;
/// <summary>Type of Boolean value, which has third value, which is depended on target platform</summary>
TBehaviorBoolean = (True, False, PlatformDefault);
function BehaviorServices: TBehaviorServices; inline; deprecated 'Use TBehaviorServices.Current';
//== INTERFACE END: FMX.BehaviorManager
//==================================================================================================
//==================================================================================================
//== INTERFACE 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;
/// <summary>Message dialogs must be shown in the UI thread. This procedure chacks that and raises an exception if is not in the UI thread.</summary>
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;
//== INTERFACE END: FMX.Dialogs
//==================================================================================================
//==================================================================================================
//== INTERFACE 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<TGUID, IInterface>;
FGlobalFlags: TDictionary<string, Boolean>;
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<string, Boolean> 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);
/// <summary>Gets a string representing the version number of the application</summary>
function GetVersionString: string;
procedure Terminate;
function Terminating: Boolean;
function Running: Boolean;
property DefaultTitle: string read GetDefaultTitle;
property Title: string read GetTitle write SetTitle;
/// <summary>Returns the version of the application as specified in Project/Options</summary>
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<TApplicationEventData>)
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 }
/// <summary>System theme type.</summary>
TSystemThemeKind = (Unspecified, Light, Dark);
/// <summary>System color type.</summary>
TSystemColorType = (Accent);
/// <summary>Operation system appearance information.</summary>
TSystemAppearance = class
private
function GetSystemColor(const Index: TSystemColorType): TAlphaColor;
function GetThemeKind: TSystemThemeKind;
public
/// <summary>System accent color, usually used for emphasis controls elements.</summary>
property AccentColor: TAlphaColor index TSystemColorType.Accent read GetSystemColor;
/// <summary>System theme kind.</summary>
property ThemeKind: TSystemThemeKind read GetThemeKind;
end;
/// <summary>Notification about changing operation system appearance.</summary>
TSystemAppearanceChangedMessage = class(TObjectMessage<TSystemAppearance>);
/// <summary>Service provides information about operation system theme.</summary>
IFMXSystemAppearanceService = interface
['{AB6A83D9-0118-4C5F-95CC-351DBB5EA943}']
/// <summary>Returns system theme kind.</summary>
function GetSystemThemeKind: TSystemThemeKind;
/// <summary>Returns system color for specified type.</summary>
function GetSystemColor(const AType: TSystemColorType): TAlphaColor;
/// <summary>System theme kind.</summary>
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}']
/// <summary>
/// Gets current clipboard value
/// </summary>
function GetClipboard: TValue;
/// <summary>
/// Sets new clipboard value
/// </summary>
procedure SetClipboard(Value: TValue);
end;
IFMXScreenService = interface(IInterface)
['{BBA246B6-8DEF-4490-9D9C-D2CBE6251A24}']
/// <summary>Returns logical size (dp) of primary monitor.</summary>
function GetScreenSize: TPointF;
/// <summary>Returns scale of primary monitor.</summary>
function GetScreenScale: Single;
/// <summary>Returns current screen orientation.</summary>
/// <remarks>It's not applicable for desktop platforms.</remarks>
function GetScreenOrientation: TScreenOrientation;
procedure SetSupportedScreenOrientations(const AOrientations: TScreenOrientations);
end;
IFMXMultiDisplayService = interface(IInterface)
['{133A6050-AC29-4233-9EE2-D49082C33BBF}']
/// <summary>Returns count of displays in system.</summary>
function GetDisplayCount: Integer;
/// <summary>Returns region on main screen allocated for showing application (dp).</summary>
function GetWorkAreaRect: TRectF;
/// <summary>Returns region on main screen allocated for showing application (px).</summary>
function GetPhysicalWorkAreaRect: TRect;
/// <summary>Returns union of all displays (dp).</summary>
function GetDesktopRect: TRectF;
/// <summary>Returns union of all displays (px).</summary>
function GetPhysicalDesktopRect: TRect;
/// <summary>Returns display information by specified display index.</summary>
function GetDisplay(const Index: Integer): TDisplay;
/// <summary>Returns a rectangle having the specified Size and positioned in the center of desktop.</summary>
function GetDesktopCenterRect(const Size: TSizeF): TRectF;
/// <summary>Refreshes current information about all displays in system.</summary>
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;
/// <summary>Returns display, which is related with specified form <c>AHandle</c>.</summary>
function DisplayFromWindow(const Handle: TWindowHandle): TDisplay;
/// <summary>Returns display, which is related with specified form <c>AHandle</c> and <c>APoint</c>.</summary>
/// <remarks>Form can be placed on two displays at the same time (on a border of two displays), but not on iOS.
/// So <c>APoint</c> parameter is not supported on iOS. It works like a <c>DisplayFromWindow</c>.</remarks>
function DisplayFromPoint(const Handle: TWindowHandle; const Point: TPoint): TDisplay;
end;
IFMXLocaleService = interface(IInterface)
['{311A40D4-3D5B-40CC-A201-78465760B25E}']
function GetCurrentLangID: string;
/// <summary>Returns first day of week in current locale.</summary>
/// <remarks>Result is platform depended. Each platform counts Monday by different int number.</remarks>
function GetLocaleFirstDayOfWeek: string; deprecated 'Use GetFirstWeekday instead';
/// <summary>Returns first day of week in current locale.</summary>
/// <remarks>Result is platform-independent value. 1 - Monday</remarks>
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;
/// <summary>Interface for Synchronous message dialogs and input queries. See TDialogServiceSync for more information.</summary>
/// <remarks>Android does not support this inteface.</remarks>
IFMXDialogServiceSync = interface(IInterface)
['{7E6B3966-C08E-466F-B4A0-7996A1C3BA04}']
/// <summary>Show a simple message box with an 'Ok' button to close it.</summary>
procedure ShowMessageSync(const AMessage: string);
/// <summary>Shows custom message dialog with specified buttons on it.</summary>
function MessageDialogSync(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons;
const ADefaultButton: TMsgDlgBtn; const AHelpCtx: THelpContext): Integer;
/// <summary>Shows an input message dialog with the specified promps and values on it. Values are modified within it.</summary>
function InputQuerySync(const ACaption: string; const APrompts: array of string; var AValues: array of string): Boolean; overload;
end;
/// <summary>Interface for Asynchronous message dialogs and input queries.</summary>
IFMXDialogServiceAsync = interface(IInterface)
['{BB65E682-1F27-42E1-90DE-6FA006E09EA5}']
/// <summary>Show a simple message box with an 'Ok' button to close it.</summary>
procedure ShowMessageAsync(const AMessage: string); overload;
/// <summary>Show a simple message box with an 'Ok' button to close it.</summary>
procedure ShowMessageAsync(const AMessage: string; const ACloseDialogProc: TInputCloseDialogProc); overload;
/// <summary>Show a simple message box with an 'Ok' button to close it.</summary>
procedure ShowMessageAsync(const AMessage: string; const ACloseDialogEvent: TInputCloseDialogEvent;
const AContext: TObject = nil); overload;
/// <summary>Shows custom message dialog with specified buttons on it.</summary>
procedure MessageDialogAsync(const AMessage: string; const ADialogType: TMsgDlgType; const AButtons: TMsgDlgButtons;
const ADefaultButton: TMsgDlgBtn; const AHelpCtx: THelpContext; const ACloseDialogProc: TInputCloseDialogProc); overload;
/// <summary>Shows custom message dialog with specified buttons on it.</summary>
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;
/// <summary>Shows an input message dialog with the specified promps and values on it. Values are modified within it.</summary>
procedure InputQueryAsync(const ACaption: string; const APrompts: array of string; const ADefaultValues: array of string;
const ACloseDialogProc: TInputCloseQueryProc); overload;
/// <summary>Shows an input message dialog with the specified promps and values on it. Values are modified within it.</summary>
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;
/// <summary>Reference to a procedure (an anonymous method) that the rendering
/// setup platform service uses to update rendering parameters.</summary>
TRenderingSetupCallback = reference to procedure(const Sender, Context: TObject; var ColorBits, DepthBits: Integer;
var Stencil: Boolean; var Multisamples: Integer);
/// <summary>Platform service that provides a mechanism to override Direct3D
/// and OpenGL rendering parameters, which are set before the actual window is
/// created.</summary>
IFMXRenderingSetupService = interface(IInterface)
['{CFF9D71C-5188-422F-BE5F-DC968D1BFD02}']
/// <summary> Subscribes callback function to be invoked when Direct3D and OpenGL rendering parameters are being
/// configured. </summary>
/// <param name="Callback">Callback function to be registered.</param>
/// <param name="Context">User-defined context parameter, which will be passed to callback function upon
/// invocation.</param>
procedure Subscribe(const Callback: TRenderingSetupCallback; const Context: TObject = nil);
/// <summary> Removes currently subscribed callback from registry. </summary>
procedure Unsubscribe;
/// <summary> 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. </summary>
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<TPushNotificationData>);
TPushStartupNotificationMessage = class (TPushNotificationMessageBase);
TPushRemoteNotificationMessage = class (TPushNotificationMessageBase);
/// <summary>Data associated to the <c>TPushDeviceTokenMessage</c> message type.</summary>
/// <remarks>Used only for the iOS platform.</remarks>
TPushDeviceTokenData = record
/// <summary>Device token.</summary>
Token: string;
/// <summary>Handle to the <c>NSData</c> object (from the Objective-C side) that stores the device token.</summary>
RawToken: Pointer;
constructor Create(const AToken: string; ARawToken: Pointer = nil);
end;
TPushDeviceTokenMessage = class (System.Messaging.TMessage<TPushDeviceTokenData>);
TPushFailToRegisterData = record
ErrorMessage: string;
constructor Create(const AErrorMessage: string);
end;
TPushFailToRegisterMessage = class (System.Messaging.TMessage<TPushFailToRegisterData>);
//== INTERFACE END: FMX.Platform
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.DialogService (from FMX.DialogService.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
/// <summary>Service for managing platform differences in behaviours when showing dialogs. It has a PreferredMode that
/// can have three values:
/// Platform Sync methods for Desktop OS's (Windows and OSX) and ASync for Mobile (Android adn IOS)
/// Sync Sync methods are preferred. Used when available (All but Android)
/// Async Async methods are preferred. Used when available (All platforms)
/// </summary>
TDialogService = class
public type
TPreferredMode = (Platform, Async, Sync);
strict private
class var FPreferredMode: TPreferredMode;
class var FInSyncMode: Boolean;
class procedure SetPreferredMode(const PreferredMode: TPreferredMode); static;
public
class constructor ClassCreate;
/// <summary>Show a simple message box with an 'Ok' button to close it.</summary>
class procedure ShowMessage(const AMessage: string); overload;
class procedure ShowMessage(const AMessage: string; const ACloseDialogProc: TInputCloseDialogProc); overload;
class procedure ShowMessage(const AMessage: string; const ACloseDialogEvent: TInputCloseDialogEvent;
const AContext: TObject = nil); overload;
/// <summary>Shows custom message dialog with specified buttons on it.</summary>
class procedure MessageDialog(const AMessage: string; const ADialogType: TMsgDlgType;
const AButtons: TMsgDlgButtons; const ADefaultButton: TMsgDlgBtn; const AHelpCtx: THelpContext;
const ACloseDialogProc: TInputCloseDialogProc); overload;
class procedure MessageDialog(const AMessage: string; const ADialogType: TMsgDlgType;
const AButtons: TMsgDlgButtons; const ADefaultButton: TMsgDlgBtn; const AHelpCtx: THelpContext;
const ACloseDialogEvent: TInputCloseDialogEvent; const AContext: TObject = nil); overload;
/// <summary>Shows an input message dialog with the specified prompts and values in it.
/// Values are returned in the callback.</summary>
class procedure InputQuery(const ACaption: string; const APrompts: array of string; const AValues: array of string;
const ACloseQueryProc: TInputCloseQueryProc); overload;
/// <summary>Shows an input message dialog with the specified prompts and values in it.
/// Values are returned in the callback.</summary>
class procedure InputQuery(const ACaption: string; const APrompts: array of string; const AValues: array of string;
const ACloseQueryEvent: TInputCloseQueryWithResultEvent; const AContext: TObject = nil); overload;
/// <summary>Sets the default presentation mode for dialogs.</summary>
class property PreferredMode: TPreferredMode read FPreferredMode write SetPreferredMode;
end;
//== INTERFACE END: FMX.DialogService
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.Clipboard (from FMX.Clipboard.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
/// <summary>
/// Clipboard support service
/// </summary>
IFMXExtendedClipboardService = interface(IFMXClipboardService)
['{E96E4776-8234-49F9-B15F-301074E23F70}']
/// <summary>
/// Returns True is clipboard containter text data
/// </summary>
function HasText: Boolean;
/// <summary>
/// Gets text data from then clipboard
/// </summary>
function GetText: string;
/// <summary>
/// Sets text as a clipboard data
/// </summary>
/// <param name="Value">
/// Text data to be added to the clipboard.
/// </param>
/// <param name="IsSensitive">
/// Indicates whether or not the text contains sensitive content, such as password or credit card number.
/// Its default value is <c>False</c>.
/// </param>
/// <remarks>
/// The <c>IsSensitive</c> parameter is only relevant for Android applications that allow users to copy sensitive
/// content. Its use is recommended to prevent sensitive content from appearing in the clipboard editor overlay
/// introduced in Android 13.
/// </remarks>
procedure SetText(const Value: string; IsSensitive: Boolean = False);
/// <summary>
/// Returns True is clipboard containter image data
/// </summary>
function HasImage: Boolean;
/// <summary>
/// Gets image data from the clipboard
/// </summary>
function GetImage: TBitmapSurface;
/// <summary>
/// Sets image as a clipboard data
/// </summary>
procedure SetImage(const Value: TBitmapSurface);
/// <summary>
/// Registers custom clipboard format with <c>AFormatName</c> name
/// </summary>
/// <param name="AFormatName">
/// Specify the name for the custom format
/// </param>
/// <remarks>
/// Methods throws <c>EClipboardFormatRegisterError</c> in case format with <c>AFormatName</c> name had already
/// registered or thare was a platform error while registration
/// </remarks>
procedure RegisterCustomFormat(const AFormatName: string);
/// <summary>
/// Checks wherever custom format is registered
/// </summary>
/// <param name="AFormatName">
/// Specify the name for the custom format
/// </param>
function IsCustomFormatRegistered(const AFormatName: string): Boolean;
/// <summary>
/// Unregister custom clipboard format with <c>AFormatName</c> name
/// </summary>
/// <param name="AFormatName">
/// Specify the name for the custom format
/// </param>
/// <remarks>
/// Method throws <c>EClipboardFormatNotRegistered</c> in case format with <c>AFormatName</c> was not registered
/// </remarks>
procedure UnregisterCustomFormat(const AFormatName: string);
/// <summary>
/// Checks wherever clipboard contains custom format
/// </summary>
/// <param name="AFormatName">
/// Specify the name for the custom format
/// </param>
/// <returns>
/// Returns <c>True</c> if clipboard contains custom format
/// </returns>
/// <remarks>
/// Method throws <c>EArgumentException</c> in case <c>AFormatName</c> is empty
/// Method throws <c>EClipboardFormatNotRegistered</c> in case format with <c>AFormatName</c> was not registered
/// </remarks>
function HasCustomFormat(const AFormatName: string): Boolean;
/// <summary>
/// Get data stream for the custom clipboard format
/// </summary>
/// <param name="AFormatName">
/// Specify the name for the custom format
/// </param>
/// <param name="AStream">
/// Specify the stream that will get custom format data
/// </param>
/// <returns>
/// Returns <c>True</c> in case custom format was succesfuly written in <c>AStream</c>
/// <c>AFormatName</c> data
/// </returns>
/// <remarks>
/// Method throws <c>EArgumentException</c> in case <c>AFormatName</c> is empty
/// Method throws <c>EArgumentNilException</c> in case <c>AStream</c> is nil
/// Method throws <c>EClipboardFormatNotRegistered</c> in case format with <c>AFormatName</c> was not registered
/// </remarks>
function GetCustomFormat(const AFormatName: string; const AStream: TStream): Boolean;
/// <summary>
/// Set clipboard data with custom format specified by <c>AFormatName</c> name and data in the <c>AStream</c>
/// </summary>
/// <param name="AFormatName">
/// Specify the name for the custom format
/// </param>
/// <param name="AStream">
/// Specify the stream that contains data for the custom format
/// </param>
/// <remarks>
/// Method throws <c>EArgumentException</c> in case <c>AFormatName</c> is empty
/// Method throws <c>EArgumentNilException</c> in case <c>AStream</c> is nil
/// Method throws <c>EClipboardFormatNotRegistered</c> in case format with <c>AFormatName</c> was not registered
/// </remarks>
procedure SetCustomFormat(const AFormatName: string; const AStream: TStream);
end;
/// <summary>
/// Basic exception that can be thrown by the methods of the <c>IFMXClipboardService</c>
/// </summary>
EClipboardError = class(Exception);
/// <summary>
/// Throws when there was some error while registering custom format
/// </summary>
EClipboardFormatRegisterError = class(EClipboardError);
/// <summary>
/// Throws when trying to use custom format methods with format name that wasn't registered
/// </summary>
EClipboardFormatNotRegistered = class(EClipboardError);
//== INTERFACE END: FMX.Clipboard
//==================================================================================================
//==================================================================================================
//== INTERFACE 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);
/// <summary>Specifies the way a line is drawn.</summary>
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;
/// <summary>Location of th drawing line, see TLineLocation for more information.</summary>
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;
/// <summary>If True, the line will be shortened its thickness divided by two.</summary>
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
/// <summary>Accelerator key drawing information.</summary>
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;
/// <summary>Method to indicate that the underline needs to be redrawn.</summary>
procedure InvalidateUnderline;
/// <summary>Draws the underline unside the character that holds the accelerator.</summary>
function DrawUnderline(const AnOwnerControl: TControl; const ACanvas: TCanvas; const ALayout: TTextLayout;
const AColor: TAlphaColor; const AnOpacity: Single): Boolean;
/// <summary>Index of the accelerator key.</summary>
property KeyIndex: Integer read FKeyIndex write SetKeyIndex;
/// <summary>True if the underline is already generated.</summary>
property IsUnderlineValid: Boolean read FIsUnderlineValid;
/// <summary>This brush is used to draw the underline down the accelerator key character.</summary>
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;
/// <summary>Remove the accelerator key information in the control.</summary>
procedure RemoveAcceleratorKeyInfo;
/// <summary>Accelerator key underline drawing information.</summary>
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;
/// <summary> Determine the way portraying a single character "&amp;" </summary>
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;
/// <summary> Specifies whether and how to resize, replicate, and position the image for rendering the control surface.</summary>
TImageWrapMode = (
/// <summary> Display the image with its original dimensions. </summary>
Original,
/// <summary> Stretches image into the LocalRect, preserving aspect ratio. When LocalRect
/// is bigger than image, the last one will be stretched to fill LocalRect </summary>
Fit,
/// <summary> Stretch the image to fill the entire control's rectangle.</summary>
Stretch,
/// <summary> Tile (multiply) the image to cover the entire control's rectangle. </summary>
Tile,
/// <summary> Center the image to the control's rectangle. </summary>
Center,
/// <summary> Places the image inside the LocalRect. If the image is greater
/// than the LocalRect then the source rectangle is scaled with aspect ratio.
/// </summary>
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);
/// <summary> This function tries to find the item in <b>MultiResBitmap</b>, which have the most suitable scale
/// (see Scene.GetSceneScale).
/// If <b>IncludeEmpty</b> is true then then returned item can be empty otherwise the empty items are ignored
/// </summary>
/// <returns> If successful, the item from the property <b>MultiResBitmap</b> otherwise <c>nil</c> </returns>
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;
///<summary>Draw grip handle</summary>
procedure DrawHandle(const Canvas: TCanvas; const Handle: TGrabHandle; const Rect: TRectF); virtual;
///<summary>Draw frame rectangle</summary>
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;
///<summary>Grip handle where mouse is hovered</summary>
property HotHandle: TGrabHandle read FHotHandle;
published
property Align;
property Anchors;
property ClipChildren default False;
property ClipParent default False;
property Cursor default crDefault;
///<summary>Selection frame and handle's border color</summary>
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;
///<summary>Indicates visibility of handles</summary>
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;
/// <summary></summary>
/// <remarks>Relevant only when control uses style.</remarks>
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;
//== INTERFACE END: FMX.Objects
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.StdActns (from FMX.StdActns.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
const
DefaultMaxValue = 100.0;
type
/// <summary>This action executes in order to trigger the OnHint event on all
/// the hint receivers in the active form.</summary>
THintAction = class(TCustomAction)
public
/// <summary>Default constructor.</summary>
constructor Create(AOwner: TComponent); override;
/// <summary>This execution causes all the hint receivers registered in the active form to be triggered.</summary>
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;
/// <summary>This class associates a floating-point number Value with methods
/// and properties used for handling Value between the values specified by Min
/// and Max.</summary>
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;
/// <summary>Extends the TBaseValueRange class providing methods and
/// properties used to control the correctness of the Value handling within
/// its Min to Max range.</summary>
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;
/// <summary>
/// This function returns True, if all the properties (Min, Max, Value, etc.) have default values.
/// </summary>
function IsEmpty: Boolean; virtual;
/// <summary>
/// Sets default values to all properties (Min, Max, Value, etc.).
/// </summary>
procedure Clear; virtual;
/// <summary>
/// If this property is true, the event BeforeChange, AfterChange occur with any change.
/// Otherwise, they occur only after the property is accept the truth.
/// </summary>
property Tracking: Boolean read FTracking write SetTracking;
/// <summary>
/// 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.
/// </summary>
/// <param name="IgnoreLoading">
/// If this parameter is set to True, then the state csLoading ignored
/// </param>
/// <remarks>
/// After loading, the owner shall check value of IsChanged property and call the Changed method
/// </remarks>
procedure Changed(const IgnoreLoading: Boolean = false);
property IsChanged: Boolean read FIsChanged;
/// <summary>
/// The new values. see <see cref="BeforeChange"/>
/// </summary>
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;
/// <summary>
/// This property indicates that the class is in a state where is being processed change.
/// </summary>
property Changing: Boolean read FChanging;
/// <summary>
/// This event is raised before the changes take effect.
/// Value property, and others contain the old values.
/// To receive new values, see <see cref="New"/>
/// </summary>
/// <remarks>
/// This event occurs only if the property Tracking is set to true
/// </remarks>
property BeforeChange: TNotifyEvent read FBeforeChange write FBeforeChange;
/// <summary>
/// This event is raised after the changes take effect, and before AfterChange.
/// </summary>
/// <remarks>
/// This event always occurs, even if the property Tracking is set to false
/// </remarks>
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
/// <summary>
/// This event is raised after the changes take effect.
/// Value property, and others contain the new values.
/// </summary>
/// <remarks>
/// This event occurs only if the property Tracking is set to true
/// </remarks>
property AfterChange: TNotifyEvent read FAfterChange write FAfterChange;
/// <summary>
/// This event is raised after the property Tracking has changed
/// </summary>
property OnTrackingChange: TNotifyEvent read FOnTrackingChange write FOnTrackingChange;
end;
/// <summary>Extends the TCustomValueRange class declaring Value, Min, Max,
/// and some other properties to be published.</summary>
TValueRange = class (TCustomValueRange)
published
property Min;
property Max;
property Value;
property Frequency;
property ViewportSize;
property RelativeValue;
end;
/// <summary>The base class for actions (without published properties) that
/// can be used by controls having ValueRange-type properties.</summary>
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;
/// <summary>Class that can be used by controls having ValueRange-type
/// properties.</summary>
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;
/// <summary>Class responsible for the communication between an action of type
/// TValueRangeAction and a control that implements the IValueRange
/// interface.</summary>
TValueRangeActionLink = class (TControlActionLink)
protected
function IsValueRangeLinked: Boolean;
procedure SetValueRange(const AValue: TBaseValueRange); virtual;
end;
/// <summary>This interface declares methods for setting and getting the
/// ValueRange property.</summary>
IValueRange = interface
['{6DFA65EF-A8BF-4D58-9655-664B50C30312}']
function GetValueRange: TCustomValueRange;
procedure SetValueRange(const AValue: TCustomValueRange);
property ValueRange: TCustomValueRange read GetValueRange write SetValueRange;
end;
//== INTERFACE END: FMX.StdActns
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.Styles.Objects (from FMX.Styles.Objects.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
TStyleTrigger = (MouseOver, Pressed, Selected, Focused, Checked, Active);
{ Image Objects }
TBitmapLink = class(TCollectionItem)
private
FCapInsetsChanged: Boolean;
FCapInsets: TBounds;
FSourceRect: TBounds;
FScale: Single;
procedure SetCapInsets(const Value: TBounds);
procedure SetSourceRect(const Value: TBounds);
procedure SetScale(const Value: Single);
procedure DoCapInsetsChanged(Sender: TObject);
function IsScaleStored: Boolean;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
property CapInsetsChanged: Boolean read FCapInsetsChanged;
published
property CapInsets: TBounds read FCapInsets write SetCapInsets;
property Scale: Single read FScale write SetScale stored IsScaleStored;
property SourceRect: TBounds read FSourceRect write SetSourceRect;
end;
TCapWrapMode = (Stretch, Tile);
TBitmapLinks = class(TCollection)
public type
TPropertyLoader = class
private
FFiler: TFiler;
FInstance: TBitmapLinks;
FPropertyName: string;
procedure ReadBitmapMargin(Reader: TReader);
procedure ReadSourceRect(Reader: TReader);
procedure ReadBitmapMargin15x(Reader: TReader);
procedure ReadSourceRect15x(Reader: TReader);
procedure ReadBitmapMargin20x(Reader: TReader);
procedure ReadSourceRect20x(Reader: TReader);
procedure ReadBitmapMargin30x(Reader: TReader);
procedure ReadSourceRect30x(Reader: TReader);
function FindOrCreateBitmapLink(const Scale: Single): TBitmapLink;
procedure ReadBitmapLinkSourceRect(Reader: TReader; const Scale: Single);
procedure ReadBitmapLinkCapInsets(Reader: TReader; const Scale: Single);
public
constructor Create(const AInstance: TBitmapLinks; const AFiler: TFiler; const APropertyName: string = '');
procedure ReadSourceRects;
procedure ReadCapInsets;
property Instance: TBitmapLinks read FInstance;
property PropertyName: string read FPropertyName;
property Filer: TFiler read FFiler;
end;
private
function GetLink(AIndex: Integer): TBitmapLink;
function GetEmpty: Boolean;
public
constructor Create;
procedure AssignCapInsets(const Source: TBitmapLinks);
function LinkByScale(const AScale: Single; const ExactMatch: Boolean): TBitmapLink;
property Links[AIndex: Integer]: TBitmapLink read GetLink;
property Empty: Boolean read GetEmpty;
end;
TCustomStyleObject = class(TControl, IDrawableObject)
public type
TTintStage = (Undefined, Shadow, Mask, Shine);
private
FOpaque: Boolean;
FSource: TImage;
FSourceLookup: string;
FCapMode: TCapWrapMode;
FWrapMode: TImageWrapMode;
FTintColor: TAlphaColor;
FTintBuffer: TBitmap;
FNeedsUpdateTintBuffer: Boolean;
FTintStage: TTintStage;
procedure SetCapMode(const Value: TCapWrapMode);
procedure SetWrapMode(const Value: TImageWrapMode);
procedure ReadOpaque(Reader: TReader);
procedure WriteOpaque(Writer: TWriter);
procedure SetOpaque(const Value: Boolean);
procedure SetSource(const Value: TImage);
procedure SetSourceLookup(const Value: string);
procedure ReadMarginWrapMode(Reader: TReader);
class var
FAlignToPixels: Boolean;
protected
procedure DefineProperties(Filer: TFiler); override;
procedure Paint; override;
procedure FreeNotification(AObject: TObject); override;
procedure DoDrawToCanvas(const Canvas: TCanvas; const ARect: TRectF; const AOpacity: Single = 1.0);
function DoGetUpdateRect: TRectF; override;
protected
function GetCurrentLink: TBitmapLinks; virtual; abstract;
function GetCanBeTinted: Boolean; virtual;
procedure PrepareTintBuffer(const Canvas: TCanvas; const ATintColor: TAlphaColor);
procedure NeedsUpdateTintBuffer;
procedure SetTintColor(const ATintColor: TAlphaColor);
property CanBeTinted: Boolean read GetCanBeTinted;
property TintColor: TAlphaColor read FTintColor write SetTintColor;
property TintStage: TTintStage read FTintStage;
property TintBuffer: TBitmap read FTintBuffer;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawToCanvas(const Canvas: TCanvas; const ARect: TRectF; const AOpacity: Single = 1.0); overload; inline;
procedure DrawToCanvas(const Canvas: TCanvas; const ARect: TRectF; const ATintColor: TAlphaColor;
const AOpacity: Single = 1.0); overload;
function IsEmpty: Boolean;
property Opaque: Boolean read FOpaque write SetOpaque;
property Source: TImage read FSource write SetSource;
class function ScreenScaleToStyleScale(const ScreenScale: Single): Single;
class property AlignToPixels: Boolean read FAlignToPixels write FAlignToPixels;
published
property Align;
property Anchors;
property CapMode: TCapWrapMode read FCapMode write SetCapMode default TCapWrapMode.Stretch;
property CanParentFocus;
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 HitTest default False;
property Padding;
property Opacity;
property Margins;
property SourceLookup: string read FSourceLookup write SetSourceLookup;
property PopupMenu;
property Position;
property RotationAngle;
property RotationCenter;
property Size;
property Scale;
property WrapMode: TImageWrapMode read FWrapMode write SetWrapMode default TImageWrapMode.Stretch;
property Visible default True;
property Width;
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;
TStyleObject = class(TCustomStyleObject)
private
FSourceLink: TBitmapLinks;
procedure SetSourceLink(const Value: TBitmapLinks);
protected
function GetCurrentLink: TBitmapLinks; override;
procedure DefineProperties(Filer: TFiler); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property SourceLink: TBitmapLinks read FSourceLink write SetSourceLink;
end;
///<summary>Helpers class that incapsulated touch animation behavior, that should be attached to other style object.</summary>
TTouchAnimationAdapter = class(TPersistent)
public type
TAnimationKind = (Pressed, Unpressed);
TCustomPaint = procedure of object;
public const
DefaultUnpressingDuration = 0.3;
DefaultPressingDuration = 1;
type
TTouchAnimation = class(TAnimation)
private
[Weak] FAdapter: TTouchAnimationAdapter;
protected
procedure ProcessAnimation; override;
end;
TTouchAnimationObject = class(TCustomStyleObject)
private
[Weak] FAdapter: TTouchAnimationAdapter;
protected
function GetCurrentLink: TBitmapLinks; override;
end;
private
[Weak] FStyleObject: TCustomStyleObject;
FTouchAnimation: TTouchAnimation;
FTouchAnimationObject: TTouchAnimationObject;
FLink: TBitmapLinks;
FPressedPosition: TPointF;
FPressingDuration: Single;
FUnpressingDuration: Single;
FPadding: TBounds;
FCustomPaint: TCustomPaint;
procedure SetLink(const Value: TBitmapLinks);
function PressingDurationStored: Boolean;
function UnpressingDurationStored: Boolean;
procedure SetPadding(const Value: TBounds);
procedure ReadPaddingRect(Reader: TReader);
procedure CreateTouchAnimation;
public
constructor Create(const AStyleObject: TCustomStyleObject); virtual;
destructor Destroy; override;
///<summary>Manually start animation.</summary>
procedure StartAnimation(const Control: TControl; const Kind: TAnimationKind);
///<summary>Manually stop animation.</summary>
procedure StopAnimation;
///<summary>Draw touch animation stage.</summary>
procedure DrawTouchAnimation(const Canvas: TCanvas; const Rect: TRectF);
///<summary>Helpers that used in Owner's StartTriggerAnimation in order to activate touch animation.</summary>
procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string);
///<summary>Helpers that used in Owner's DefineProperty</summary>
procedure DefineTouchAnimationProperty(Filer: TFiler);
///<summary>Return True if touch animation is available in the style</summary>
function LinkExists: Boolean;
///<summary>Link to Owner</summary>
property TouchAnimation: TTouchAnimation read FTouchAnimation;
///<summary>Callback property called when touch animation runs.</summary>
property CustomPaint: TCustomPaint read FCustomPaint write FCustomPaint;
published
/// <summary>Part of bitmap which used to draw touch animation</summary>
property Link: TBitmapLinks read FLink write SetLink;
/// <summary>Duration of animation that started after touch is down</summary>
property PressingDuration: Single read FPressingDuration write FPressingDuration stored PressingDurationStored;
/// <summary>Duration of animation that started after touch is up</summary>
property UnpressingDuration: Single read FUnpressingDuration write FUnpressingDuration
stored UnpressingDurationStored;
/// <summary>Size of the border that decreases animation painting rectangle.</summary>
property Padding: TBounds read FPadding write SetPadding;
end;
TTintedStages = class(TPersistent)
private
[Weak] FStyleObject: TCustomStyleObject;
FShadow: TBitmapLinks;
FMask: TBitmapLinks;
FShine: TBitmapLinks;
procedure SetMask(const Value: TBitmapLinks);
procedure SetShadow(const Value: TBitmapLinks);
procedure SetShine(const Value: TBitmapLinks);
public
constructor Create(const AStyleObject: TCustomStyleObject);
destructor Destroy; override;
/// <summary>Link to owner style object</summary>
property StyleObject: TCustomStyleObject read FStyleObject;
published
property Shadow: TBitmapLinks read FShadow write SetShadow;
property Mask: TBitmapLinks read FMask write SetMask;
property Shine: TBitmapLinks read FShine write SetShine;
end;
TTintedStyleObject = class(TStyleObject, ITintedObject)
private
FTint: TTintedStages;
procedure SetTint(const Value: TTintedStages);
protected
function GetCurrentLink: TBitmapLinks; override;
procedure DefineProperties(Filer: TFiler); override;
procedure Loaded; override;
{ ITintedObject }
function GetCanBeTinted: Boolean; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Tint: TTintedStages read FTint write SetTint;
end;
/// <summary>Interface to access to touch animation adapter</summary>
ITouchAnimationObject = interface
['{75657913-BED4-45CA-A394-B27BF7B2225F}']
function GetTouchAnimation: TTouchAnimationAdapter;
/// <summary>Access property to touch animation adapter</summary>
property TouchAnimation: TTouchAnimationAdapter read GetTouchAnimation;
end;
// XE3 Compatible
TSubImage = class(TStyleObject);
TActiveStyleObject = class(TCustomStyleObject, ITouchAnimationObject)
private
FSourceLink: TBitmapLinks;
FActive: Boolean;
FActiveLink: TBitmapLinks;
FActiveAnimation: TAnimation;
FTrigger: TStyleTrigger;
FOnTriggered: TNotifyEvent;
FTouchAnimation: TTouchAnimationAdapter;
procedure SetActive(const Value: Boolean);
procedure SetActiveLink(const Value: TBitmapLinks);
procedure SetTrigger(const Value: TStyleTrigger);
procedure SetSourceLink(const Value: TBitmapLinks);
procedure Triggered(Sender: TObject);
procedure SetTouchAnimation(const Value: TTouchAnimationAdapter);
{ ITouchAnimationObject }
function GetTouchAnimation: TTouchAnimationAdapter;
protected
procedure DoTriggered; virtual;
procedure SetupAnimations; virtual;
function GetCurrentLink: TBitmapLinks; override;
procedure DefineProperties(Filer: TFiler); override;
procedure Loaded; override;
procedure Paint; override;
property OnTriggered: TNotifyEvent read FOnTriggered write FOnTriggered;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string); override;
procedure SetNewScene(AScene: IScene); override;
property Active: Boolean read FActive write SetActive;
published
property ActiveTrigger: TStyleTrigger read FTrigger write SetTrigger;
property ActiveLink: TBitmapLinks read FActiveLink write SetActiveLink;
property SourceLink: TBitmapLinks read FSourceLink write SetSourceLink;
///<summary>Used to add touch animation to the style object</summary>
property TouchAnimation: TTouchAnimationAdapter read FTouchAnimation write SetTouchAnimation;
end;
TTabStyleObject = class(TCustomStyleObject)
private type
TTransitionRec = record
Animation: TAnimation;
Event: TNotifyEvent;
end;
protected type
TLink = (Active, Source, Hot, ActiveHot, Focused, ActiveFocused);
TState = (Active, Hot, Focused);
private
FBitmapLinks: array [TLink] of TBitmapLinks;
FTransitions: array [TState] of TTransitionRec;
FActiveTrigger: TStyleTrigger;
FState: set of TState;
procedure SetActiveTrigger(const Value: TStyleTrigger);
function GetLink(Index: TLink): TBitmapLinks;
procedure SetLink(Index: TLink; const Value: TBitmapLinks);
function GetEvent(Index: TState): TNotifyEvent;
procedure SetEvent(Index: TState; const Value: TNotifyEvent);
procedure InvokeEvent(Index: TState);
procedure HotTriggered(Sender: TObject);
procedure FocusedTriggered(Sender: TObject);
procedure ActiveTriggered(Sender: TObject);
protected
procedure SetupAnimations; virtual;
function GetCurrentLink: TBitmapLinks; override;
procedure DefineProperties(Filer: TFiler); override;
procedure Loaded; override;
property OnHotTriggered: TNotifyEvent index TLink.Hot read GetEvent write SetEvent;
property OnFocusedTriggered: TNotifyEvent index TLink.Focused read GetEvent write SetEvent;
property OnActiveTriggered: TNotifyEvent index TLink.Active read GetEvent write SetEvent;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string); override;
published
property ActiveTrigger: TStyleTrigger read FActiveTrigger write SetActiveTrigger;
property ActiveLink: TBitmapLinks index TLink.Active read GetLink write SetLink;
property SourceLink: TBitmapLinks index TLink.Source read GetLink write SetLink;
property HotLink: TBitmapLinks index TLink.Hot read GetLink write SetLink;
property ActiveHotLink: TBitmapLinks index TLink.ActiveHot read GetLink write SetLink;
property FocusedLink: TBitmapLinks index TLink.Focused read GetLink write SetLink;
property ActiveFocusedLink: TBitmapLinks index TLink.ActiveFocused read GetLink write SetLink;
end;
TCheckStyleObject = class(TTabStyleObject)
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TButtonAnimation = (Normal, Hot, Pressed, Focused); // Don't change order for compatibility with TFontColorForState.TIndex
TButtonStyleObject = class(TCustomStyleObject)
private type
TTriggerAndLink = record
Animation: TAnimation;
Link: TBitmapLinks;
end;
private
FCurrent: TButtonAnimation;
FTriggerSources: array [TButtonAnimation] of TTriggerAndLink;
FOnNormalTriggered: TNotifyEvent;
FOnHotTriggered: TNotifyEvent;
FOnFocusedTriggered: TNotifyEvent;
FOnPressedTriggered: TNotifyEvent;
FTouchAnimation: TTouchAnimationAdapter;
procedure NormalTriggered(Sender: TObject);
procedure HotTriggered(Sender: TObject);
procedure PressedTriggered(Sender: TObject);
procedure FocusedTriggered(Sender: TObject);
function GetLink(Index: TButtonAnimation): TBitmapLinks;
procedure SetLink(Index: TButtonAnimation; const Value: TBitmapLinks);
procedure SetTouchAnimation(const Value: TTouchAnimationAdapter);
protected
procedure DoNormalTriggered;
procedure DoHotTriggered;
procedure DoPressedTriggered;
procedure DoFocusedTriggered;
function GetCurrentLink: TBitmapLinks; override;
procedure DefineProperties(Filer: TFiler); override;
procedure Loaded; override;
procedure Paint; override;
property OnNormalTriggered: TNotifyEvent read FOnNormalTriggered write FOnNormalTriggered;
property OnHotTriggered: TNotifyEvent read FOnHotTriggered write FOnHotTriggered;
property OnPressedTriggered: TNotifyEvent read FOnPressedTriggered write FOnPressedTriggered;
property OnFocusedTriggered: TNotifyEvent read FOnFocusedTriggered write FOnFocusedTriggered;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string); override;
published
property HotLink: TBitmapLinks index TButtonAnimation.Hot read GetLink write SetLink;
property FocusedLink: TBitmapLinks index TButtonAnimation.Focused read GetLink write SetLink;
property NormalLink: TBitmapLinks index TButtonAnimation.Normal read GetLink write SetLink;
property PressedLink: TBitmapLinks index TButtonAnimation.Pressed read GetLink write SetLink;
///<summary>Used to add touch animation to the style object</summary>
property TouchAnimation: TTouchAnimationAdapter read FTouchAnimation write SetTouchAnimation;
end;
TTintedButtonStyleObject = class(TButtonStyleObject, ITintedObject)
private
FTintSources: array [TButtonAnimation] of TTintedStages;
function GetTintStage(const Index: TButtonAnimation): TTintedStages;
procedure SetTintStage(const Index: TButtonAnimation; const Value: TTintedStages);
protected
procedure Loaded; override;
procedure DefineProperties(Filer: TFiler); override;
function GetCurrentLink: TBitmapLinks; override;
{ ITintedObject }
function GetCanBeTinted: Boolean; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property HotTint: TTintedStages index TButtonAnimation.Hot read GetTintStage write SetTintStage;
property NormalTint: TTintedStages index TButtonAnimation.Normal read GetTintStage write SetTintStage;
property FocusedTint: TTintedStages index TButtonAnimation.Focused read GetTintStage write SetTintStage;
property PressedTint: TTintedStages index TButtonAnimation.Pressed read GetTintStage write SetTintStage;
end;
TSystemButtonObject = class(TButtonStyleObject)
private
FInactive: Boolean;
FInactiveAnimation: TAnimation;
FInactiveLink: TBitmapLinks;
procedure SetInactiveLink(const Value: TBitmapLinks);
procedure InactiveTriggered(Sender: TObject);
protected
function GetCurrentLink: TBitmapLinks; override;
procedure DefineProperties(Filer: TFiler); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string); override;
published
property InactiveLink: TBitmapLinks read FInactiveLink write SetInactiveLink;
end;
TMaskedImage = class(TImage)
private
FContentObject: TCustomStyleObject;
FBuffer: TBitmap;
FNeedsUpdate: Boolean;
procedure PrepareBuffer;
function GetSourceLookup: string;
procedure SetSourceLookup(const Value: string);
procedure ReadMarginWrapMode(Reader: TReader);
procedure ReadWrapMode(Reader: TReader);
protected
function CreateContentObject: TCustomStyleObject; virtual;
procedure DefineProperties(Filer: TFiler); override;
procedure DoChanged; override;
procedure Paint; override;
procedure NeedsUpdate;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string); override;
published
property ContentObject: TCustomStyleObject read FContentObject;
property SourceLookup: string read GetSourceLookup write SetSourceLookup stored False;
end;
TActiveMaskedImage = class(TMaskedImage)
private
function GetTrigger: TStyleTrigger;
procedure SetTrigger(const Value: TStyleTrigger);
procedure DoTriggered(Sender: TObject);
protected
function CreateContentObject: TCustomStyleObject; override;
procedure DefineProperties(Filer: TFiler); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ActiveTrigger: TStyleTrigger read GetTrigger write SetTrigger stored False;
end;
{ Text Objects }
TStyleShadow = class(TPersistent)
private
FColor: TAlphaColor;
FOnChanged: TNotifyEvent;
FOffset: TPosition;
procedure SetColor(const Value: TAlphaColor);
procedure SetOffset(const Value: TPosition);
protected
procedure DoChanged; virtual;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
public
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
function Equals(Obj: TObject): Boolean; override;
published
property Color: TAlphaColor read FColor write SetColor default claNull;
property Offset: TPosition read FOffset write SetOffset;
end;
TStyleTextObject = class(TText, IDrawableObject)
private
FSavedShadow: TStyleShadow;
FShadow: TStyleShadow;
FShadowVisible: Boolean;
FCharCase: TEditCharCase;
FCurrentColor: TAlphaColor;
FCurrentShadow: TStyleShadow;
procedure SetShadow(const Value: TStyleShadow);
procedure SetShadowVisible(const Value: Boolean);
procedure SetCharCase(const Value: TEditCharCase);
function GetSavedColor: TAlphaColor;
protected
procedure Paint; override;
function ConvertText(const Value: string): string; override;
procedure ShadowChanged;
procedure FontChanged; override;
procedure UpdateDefaultTextSettings; override;
function UpdateCurrentProperties: Boolean; virtual;
function SetCurrentProperties(const AColor: TAlphaColorRec; const AShadow: TStyleShadow): Boolean;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawToCanvas(const Canvas: TCanvas; const ARect: TRectF; const AOpacity: Single = 1.0);
property SavedColor: TAlphaColor read GetSavedColor;
property SavedShadow: TStyleShadow read FSavedShadow;
property CurrentColor: TAlphaColor read FCurrentColor;
property CurrentShadow: TStyleShadow read FCurrentShadow;
published
property CharCase: TEditCharCase read FCharCase write SetCharCase default TEditCharCase.ecNormal;
property Color stored False;
property Shadow: TStyleShadow read FShadow write SetShadow;
property ShadowVisible: Boolean read FShadowVisible write SetShadowVisible;
property HitTest default False;
end;
TStyleTextAnimation = class(TAnimation)
private
FColor: TAlphaColor;
FShadow: TStyleShadow;
procedure SetShadow(const Value: TStyleShadow);
protected
procedure ProcessAnimation; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
class function CreateAnimation(const Trigger: string; const Event: TNotifyEvent): TStyleTextAnimation;
procedure AssignIfEmpty(const StyleTextObject: TStyleTextObject);
property Color: TAlphaColor read FColor write FColor;
property Shadow: TStyleShadow read FShadow write SetShadow;
end;
TActiveStyleTextObject = class(TStyleTextObject)
private
FTrigger: TStyleTrigger;
FActiveAnimation: TStyleTextAnimation;
FActive: Boolean;
FSavedActive: Boolean;
procedure SetTrigger(const Value: TStyleTrigger);
function GetActiveColor: TAlphaColor;
function GetActiveShadow: TStyleShadow;
procedure SetActiveColor(const Value: TAlphaColor);
procedure SetActiveShadow(const Value: TStyleShadow);
procedure SetActive(const Value: Boolean);
protected
procedure Triggered(Sender: TObject);
procedure SetupAnimations; virtual;
function UpdateCurrentProperties: Boolean; override;
procedure Loaded; override;
function SaveState: Boolean; override;
function RestoreState: Boolean; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string); override;
procedure SetNewScene(AScene: IScene); override;
property Active: Boolean read FActive write SetActive;
published
property ActiveTrigger: TStyleTrigger read FTrigger write SetTrigger;
property ActiveColor: TAlphaColor read GetActiveColor write SetActiveColor;
property ActiveShadow: TStyleShadow read GetActiveShadow write SetActiveShadow;
end;
TTabStyleTextObject = class(TActiveStyleTextObject)
private
FHotAnimation: TStyleTextAnimation;
FHot: Boolean;
FSavedHot: Boolean;
procedure SetHotColor(const Value: TAlphaColor);
procedure SetHotShadow(const Value: TStyleShadow);
function GetHotColor: TAlphaColor;
function GetHotShadow: TStyleShadow;
procedure SetHot(const Value: Boolean);
protected
procedure HotTriggered(Sender: TObject);
procedure SetupAnimations; override;
procedure Loaded; override;
function UpdateCurrentProperties: Boolean; override;
function SaveState: Boolean; override;
function RestoreState: Boolean; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string); override;
property Hot: Boolean read FHot write SetHot;
published
property HotColor: TAlphaColor read GetHotColor write SetHotColor default claNull;
property HotShadow: TStyleShadow read GetHotShadow write SetHotShadow;
end;
TButtonStyleTextObject = class(TStyleTextObject)
private
FTriggerSources: array [TButtonAnimation] of TStyleTextAnimation;
FButtonState: TButtonAnimation;
FSavedButtonState: TButtonAnimation;
procedure NormalTriggered(Sender: TObject);
procedure HotTriggered(Sender: TObject);
procedure PressedTriggered(Sender: TObject);
procedure FocusedTriggered(Sender: TObject);
function GetColor(Index: TButtonAnimation): TAlphaColor;
procedure SetColor(Index: TButtonAnimation; const Value: TAlphaColor);
function GetShadow(Index: TButtonAnimation): TStyleShadow;
procedure SetShadow(Index: TButtonAnimation; const Value: TStyleShadow);
procedure SetButtonState(const Value: TButtonAnimation);
procedure GetFontColors(var AColors, ADefColors: TFontColorForState);
protected
procedure Loaded; override;
procedure UpdateDefaultTextSettings; override;
function UpdateCurrentProperties: Boolean; override;
function GetTextSettingsClass: TTextSettingsClass; override;
function SaveState: Boolean; override;
function RestoreState: Boolean; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string); override;
property ButtonState: TButtonAnimation read FButtonState write SetButtonState;
published
property HotColor: TAlphaColor index TButtonAnimation.Hot read GetColor write SetColor default claNull;
property HotShadow: TStyleShadow index TButtonAnimation.Hot read GetShadow write SetShadow;
property FocusedColor: TAlphaColor index TButtonAnimation.Focused read GetColor write SetColor default claNull;
property FocusedShadow: TStyleShadow index TButtonAnimation.Focused read GetShadow write SetShadow;
property NormalColor: TAlphaColor index TButtonAnimation.Normal read GetColor write SetColor default claNull;
property NormalShadow: TStyleShadow index TButtonAnimation.Normal read GetShadow write SetShadow;
property PressedColor: TAlphaColor index TButtonAnimation.Pressed read GetColor write SetColor default claNull;
property PressedShadow: TStyleShadow index TButtonAnimation.Pressed read GetShadow write SetShadow;
end;
TActiveOpacityObject = class(TControl)
private
FTrigger: TStyleTrigger;
FActiveAnimation: TAnimation;
FActiveOpacity: Single;
FSavedOpacity: Single;
function IsActiveOpacityStored: Boolean;
procedure SetTrigger(const Value: TStyleTrigger);
procedure Triggered(Sender: TObject);
protected
procedure SetupAnimation; virtual;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure StartTriggerAnimation(const AInstance: TFmxObject; const ATrigger: string); override;
published
property ActiveTrigger: TStyleTrigger read FTrigger write SetTrigger;
property ActiveOpacity: Single read FActiveOpacity write FActiveOpacity stored IsActiveOpacityStored;
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 HitTest default False;
property Padding;
property Opacity;
property Margins;
property PopupMenu;
property Position;
property RotationAngle;
property RotationCenter;
property Scale;
property Size;
property TouchTargetExpansion;
property Visible default True;
property Width;
{ Events }
property OnPainting;
property OnPaint;
property OnResize;
property OnResized;
{ 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;
end;
//== INTERFACE END: FMX.Styles.Objects
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.StdCtrls (from FMX.StdCtrls.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
{ TPresentedTextControl }
/// <summary>Base class for all presented text controls such as
/// TLabel.</summary>
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
/// <summary>Overrides the TControl.DoRootChanging to register/unregister the control in the form as a
/// IAcceleratorKeyReceiver if the control has an accelerator key.</summary>
procedure DoRootChanging(const NewRoot: IRoot); override;
/// <summary>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.</summary>
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;
/// <summary>Set new value to text property without calling DoTextChanged.</summary>
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;
/// <summary>Retrieves the resource object linked to the style of the current TextObject.</summary>
function FindTextObject: TFmxObject; virtual;
/// <summary>Copy text releated properties to TextObject.</summary>
procedure UpdateTextObject(const TextControl: TControl; const Str: string);
/// <summary>Link to object in style that actually displays control's data.</summary>
property TextObject: TControl read FTextObject;
/// <summary>Called when text is changed.</summary>
procedure DoTextChanged; virtual;
procedure DoEndUpdate; override;
/// <summary>Return TextObject bounds using current text alignment values.</summary>
function CalcTextObjectSize(const MaxWidth: Single; var Size: TSizeF): Boolean;
{ ITextSettings }
procedure SetTextSettings(const Value: TTextSettings); virtual;
procedure SetStyledSettings(const Value: TStyledSettings); virtual;
/// <summary>Updates the representation of the text on the control.</summary>
procedure DoChanged; virtual;
/// <summary>Retrieves whether any of the default values of font properties that are stored in the StyledSettings property is changed</summary>
function StyledSettingsStored: Boolean; virtual;
/// <summary>Use to create new instance of TextSettings object</summary>
function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; virtual;
{ IAcceleratorKeyReceiver }
/// <summary>Implements IAcceleratorKeyReceiver.TriggerAcceleratorKey by setting focus to this control.</summary>
procedure TriggerAcceleratorKey; virtual;
/// <summary>Implements IAcceleratorKeyReceiver.CanTriggerAcceleratorKey by returning True if this control and all
/// of its parent controls are visible.</summary>
function CanTriggerAcceleratorKey: Boolean; virtual;
/// <summary>Implements IAcceleratorKeyReceiver.GetAcceleratorChar by returning the value stored in FAcceleratorKey.</summary>
function GetAcceleratorChar: Char;
/// <summary>Implements IAcceleratorKeyReceiver.GetAcceleratorCharIndex by returning the value stored in
/// FAcceleratorKeyIndex. This indicates the position within the text string of the accelerator character.</summary>
function GetAcceleratorCharIndex: Integer;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AfterConstruction; override;
function ToString: string; override;
/// <summary>Specifies the text that will be rendered over the surface of this control</summary>
property Text: string read GetText write SetText stored TextStored;
/// <summary>Stores a TTextSettings type object keeping the default values of the text representation properties</summary>
property DefaultTextSettings: TTextSettings read GetDefaultTextSettings;
/// <summary>Stores a TTextSettings type object, which handles the text representation properties to be used for drawing the text in this control</summary>
property TextSettings: TTextSettings read GetTextSettings write SetTextSettings;
/// <summary>Defines the values of the styled text representation properties</summary>
property StyledSettings: TStyledSettings read GetStyledSettings write SetStyledSettings stored StyledSettingsStored nodefault;
/// <summary>Returns a TTextSettings object that declares the text control representation properties</summary>
property ResultingTextSettings: TTextSettings read GetResultingTextSettings;
/// <summary>Calls DoChanged when any of the styled text representation properties of the control is changed.</summary>
procedure Change;
/// <summary>Specifies the font to use when rendering the text</summary>
property Font: TFont read GetFont write SetFont;
/// <summary>Specifies the font color of the text</summary>
property FontColor: TAlphaColor read GetFontColor write SetFontColor default TAlphaColorRec.Black;
/// <summary>Specifies how the text will be displayed in terms of vertical alignment.</summary>
property VertTextAlign: TTextAlign read GetVertTextAlign write SetVertTextAlign default TTextAlign.Center;
/// <summary>Specifies how the text will be displayed in terms of horizontal alignment.</summary>
property TextAlign: TTextAlign read GetTextAlign write SetTextAlign default TTextAlign.Leading;
/// <summary>Specifies whether the text inside the control wraps when it is longer than the width of the control</summary>
property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
/// <summary>Specifies the behavior of the text, when it overflows the area for drawing the text.</summary>
property Trimming: TTextTrimming read GetTrimming write SetTrimming default TTextTrimming.None;
/// <summary> Determine the way portraying a single character "&amp;"</summary>
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;
/// <summary>Updates values: <c>CalloutLength</c>, <c>CalloutWidth</c>, <c>CalloutPosition</c> and
/// <c>CalloutOffset</c> of <c>CalloutRect</c> object in style</summary>
procedure UpdateCallout;
/// <summary>Updates padding based on value of <c>CalloutLength</c> and <c>CalloutPosition</c></summary>
procedure UpdatePadding;
/// <summary>Saves current values of padding, which are not equaled to <c>CalloutLength</c></summary>
procedure SavePadding;
/// <summary>Restores previous saved value of padding</summary>
procedure RestorePadding;
procedure PaddingChanged; override;
public
constructor Create(AOwner: TComponent); override;
/// <summary>Access to style object <c>TCalloutRectangle</c></summary>
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 }
/// <summary>Overrides TPresentedTextControl.TriggerAcceleratorKey</summary>
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;
/// <summary>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.</summary>
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;
/// <summary> Determines whether the <b>ImageIndex</b> property needs to be stored in the fmx-file</summary>
/// <returns> <c>True</c> if the <b>ImageIndex</b> property needs to be stored in the fmx-file</returns>
function ImageIndexStored: Boolean; virtual;
{ IAcceleratorKeyReceiver }
/// <summary>Overrides the TPresentedTextControl.TriggerAcceleratorKey</summary>
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;
///<summary> The list of images. Can be <c>nil</c>. <para>See also <b>FMX.ActnList.IGlyph</b></para></summary>
property Images: TCustomImageList read GetImages write SetImages;
///<summary> Zero based index of an image. The default is <c>-1</c>.
///<para> See also <b>FMX.ActnList.IGlyph</b></para></summary>
///<remarks> If non-existing index is specified, an image is not drawn and no exception is raised</remarks>
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<string>);
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 }
/// <summary>Overrides TPresentedTextControl.TriggerAcceleratorKey. The behaviour is to check/uncheck the
/// box control.</summary>
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 }
/// <summary>Overrides TPresentedTextControl.TriggerAcceleratorKey. The behavior is to check the
/// radio control.</summary>
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;
/// <summary>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.</summary>
procedure DoRootChanging(const NewRoot: IRoot); override;
{ IHintReceiver }
/// <summary>Implementation of IHintReceiver.TriggerOnHint.</summary>
procedure TriggerOnHint;
/// <summary>Method to trigger the OnHint event.</summary>
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;
/// <summary>Use this property to enable/disable the OnHint event.</summary>
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;
/// <summary>Event to be triggered when the application catches a hint.</summary>
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;
///<summary>Controls the number of positions this track bar's thumb moves on each pressing of the free area</summary>
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
/// <summary>Data model for the TSwitch control.</summary>
TSwitchModel = class(TDataModel)
private
FValue: Boolean;
FOnSwitch: TNotifyEvent;
procedure SetValue(AValue: Boolean);
protected
/// <summary>Invokes OnSwitch event handler</summary>
procedure DoChanged; virtual;
public
/// <summary>Invokes OnSwitch event handler</summary>
procedure Change;
public
/// <summary>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.</summary>
property Value: Boolean read FValue write SetValue;
/// <summary>Event handler is called, when <c>TSwitch</c> changed <c>IsChecked</c></summary>
property OnSwitch: TNotifyEvent read FOnSwitch write FOnSwitch;
end;
/// <summary>Represents a two-way on/off switch for use in
/// applications.</summary>
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;
/// <summary>This virtual method is performed after changing the IsChecked property. By default, it executes the
/// event handler OnSwitch </summary>
procedure DoSwitch; virtual;
function GetDefaultSize: TSizeF; override;
public
constructor Create(AOwner: TComponent); override;
/// <summary>Property to retrieve the data model of the switch control.</summary>
property Model: TSwitchModel read GetModel;
public
/// <summary>True if switch is turned on. Returns False otherwise.</summary>
property IsChecked: Boolean read GetIsChecked write SetIsChecked stored IsCheckedStored;
/// <summary>Event handler is being invoked, when switch changes value <c>IsChecked</c>.</summary>
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
/// <summary>Default header height</summary>
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;
/// <summary>Called when expanded state is going to change</summary>
procedure DoExpandedChanging; virtual;
/// <summary>Called when expanded state just has changed</summary>
procedure DoExpandedChanged; virtual;
/// <summary>Called when checked state just has changed</summary>
procedure DoCheckedChanged; virtual;
function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; override;
procedure SetHeaderHeight(const Value: Integer);
function GetHeaderHeight: Integer;
/// <summary>Evaluate header height that will be used based on style availability and property value</summary>
function EffectiveHeaderHeight: Integer;
/// <summary>Evaluate default header height based on style availability</summary>
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;
/// <summary>Allows to customize header height. Default value is -1.
/// <para>When the value is -1, if the style defines a <c>header</c> element style element height will be taken
/// for a default. If no such style element is defined, the value of
/// <see cref="FMX.StdCtrls|TExpander.cDefaultHeaderHeight "/> will be taken in</para></summary>
property HeaderHeight: Integer read GetHeaderHeight write SetHeaderHeight default -1;
/// <summary>True if the checkbox is used and is checked (the content is enabled).
/// <para>See <see cref="FMX.StdCtrls|TExpander.OnCheckChange"/>,
/// <see cref="FMX.StdCtrls|TExpander.ShowCheck"/></para>
/// </summary>
property IsChecked: Boolean read FIsChecked write SetIsChecked default True;
/// <summary><c>True</c> if expanded
/// <para>Setting this property to <c>True</c> will expand the control,
/// <c>False</c> will collapse. Before the state is changed,
/// <see cref="FMX.StdCtrls|TExpander.OnExpandedChanging"/> event will be called. User can
/// abort this operation by invoking <see cref="System.SysUtils|Abort"/> in the handler.
/// <see cref="FMX.StdCtrls|TExpander.OnExpandedChanged"/> event will be invoked after the state change.
/// </para></summary>
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;
/// <summary>Setting to <c>True</c> will show a check box that enables or disables the content</summary>
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;
/// <summary>Called when checkbox state is changed</summary>
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;
/// <summary>Called when checkbox state is about to change. Can be aborted by EAbort</summary>
property OnExpandedChanging: TNotifyEvent read FOnExpandedChanging write FOnExpandedChanging;
/// <summary>Called when checkbox state has changed</summary>
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;
//== INTERFACE END: FMX.StdCtrls
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.ListView.Types (from FMX.ListView.Types.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
{$IF DEFINED(IOS) OR DEFINED(ANDROID)}
{$DEFINE LISTVIEW_TOUCH}
{$ENDIF}
{.$DEFINE PIXEL_ALIGNMENT}
{.$DEFINE DRAW_ITEM_MARGINS}
type
TListItemAlign = (Leading, Center, Trailing);
TListItemPurpose = (None, Header, Footer);
TListItemPurposes = set of TListItemPurpose;
TListItemPurposeHelper = record helper for TListItemPurpose
function ToString: string;
end;
TListItem = class;
IListViewAdapter = interface;
IListViewController = interface;
TListItemStyleResources = class;
TListItemDrawState = (Selected, Deleting, EditMode);
TListItemDrawStates = set of TListItemDrawState;
TListItemDrawable = class;
TListItemView = class;
TListItemCallbackOp = (CreateDrawables, InvalidateOwner, Click);
TListItemCallback = TProc<TListItemView, TListItemDrawable, TListItemCallbackOp>;
/// <summary>TListItem view is comprised of TListViewDrawables. These are the actual
/// view elements that are being painted in the item cells.</summary>
TListItemDrawable = class(TInterfacedPersistent)
public type
TParams = record
AbsoluteOpacity: Single;
ItemSelectedAlpha: Single;
DeletingUnwantedOpacity: Single;
EditModeTransitionAlpha: Single;
ParentAbsoluteRect: TRectF;
Images: TCustomImageList;
end;
strict private
FPlaceOffsetX: TPosition;
protected type
TStyleResource = (FontSize, FontFamily, FontStyle, TextColor, SelectedTextColor,
TextShadowColor, PressedTextColor);
TStyleResources = set of TStyleResource;
protected const
TextResources: set of TStyleResource = [TStyleResource.FontFamily,
TStyleResource.FontSize, TStyleResource.FontStyle, TStyleResource.TextColor,
TStyleResource.TextShadowColor, TStyleResource.SelectedTextColor, TStyleResource.PressedTextColor];
private
FAlign: TListItemAlign;
FVertAlign: TListItemAlign;
FVisible: Boolean;
FWidth: Single;
FHeight: Single;
FOpacity: Single;
FUpdating: Integer;
NeedRepaint: Boolean;
FOnSelect: TNotifyEvent;
FName: string;
[Weak] FTagObject: TObject;
FTagFloat: Single;
FTagString: string;
FLocalRect: TRectF;
FStyleValuesNeedUpdate: TStyleResources;
FController: IListViewController;
FCallback: TListItemCallback;
procedure SetOneDimension(const Index: Integer; const Value: Single);
procedure SetSize(const Value: TPointF);
function GetSize: TPointF;
procedure SetOpacity(const Value: Single);
procedure SetAlign(const Value: TListItemAlign);
procedure SetVertAlign(const Value: TListItemAlign);
procedure SetVisible(const Value: Boolean);
function GetData: TValue; virtual;
procedure SetData(const Value: TValue); virtual;
function GetPlaceOffset: TPosition; inline;
procedure SetInvalidateCallback(const Callback: TListItemCallback); virtual;
procedure PlaceOffsetChanged(Sender: TObject);
protected
/// <summary>Called when the <see cref='Size'>Size</see> of this drawable changes</summary>
procedure DoResize; virtual;
/// <summary>Called when the <see cref='Opacity'>Opacity</see> of this drawable changes</summary>
procedure DoOpacityChange; virtual;
/// <summary>Called when <see cref='FMX.ListView.Types.TListItem'>TListItem</see> comprising
/// this drawable is selected.</summary>
procedure DoSelect; virtual;
/// <summary>Called when <see cref='PlaceOffset'>PlaceOffset</see> changes</summary>
procedure DoPlaceOffsetChanged; virtual;
/// <summary>Called when <see cref='Align'>Align</see> or <see cref='VertAlign'>VertAlign</see> changes</summary>
procedure DoAlignChanged; virtual;
/// <summary>Finds an embedded <see cref='FMX.Controls.TControl'>TControl</see> at given <c>Point</c></summary>
function ObjectAtPoint(const Point: TPointF): TControl; virtual;
/// <summary>Handle MouseDown event. Called by
/// <see cref='FMX.ListView.Types.TListItem.MouseDown'>TListItem.MouseDown</see> </summary>
function MouseDown(const Button: TMouseButton; const Shift: TShiftState; const MousePos: TPointF): Boolean; virtual;
/// <summary>Handle MouseMove event. Called by host
/// <see cref='FMX.ListView.Types.TListItem.MouseMove'>TListItem.MouseMove</see></summary>
procedure MouseMove(const Shift: TShiftState; const MousePos: TPointF); virtual;
/// <summary>Handle MouseUp event. Called by
/// <see cref='FMX.ListView.Types.TListItem.MouseUp'>TListItem.MouseUp</see> </summary>
procedure MouseUp(const Button: TMouseButton; const Shift: TShiftState; const MousePos: TPointF); virtual;
/// <summary>Called by <see cref='UpdateValuesFromResources'>UpdateValuesFromResources</see>.
/// Updates default parameters defined by style in descendants such as font, font syle and colors.</summary>
procedure DoUpdateValuesFromResources(const Resources: TListItemStyleResources; const Purpose: TListItemPurpose); virtual;
public
constructor Create(const AOwner: TListItem); virtual;
destructor Destroy; override;
function ToString: string; override;
/// <summary>Return amount of rendering passes. See TListViewBase.DrawListItems</summary>
function GetRenderPassCount: Integer; virtual;
/// <summary>Align and calculate this drawable's local rectangle for given item's DestRect and DrawStates</summary>
procedure CalculateLocalRect(const DestRect: TRectF; const SceneScale: Single;
const DrawStates: TListItemDrawStates; const Item: TListItem); virtual;
/// <summary>Return True if Point is inside local rect</summary>
function InLocalRect(const Point: TPointF): Boolean;
/// <summary>Request repaint. When between <c>BeginUpdate</c>/<c>EndUpdate</c> the request will be held back until the
/// update cycle is finished</summary>
procedure Invalidate;
/// <summary>Render this drawable
/// <param><c>Canvas</c> destination canvas</param>
/// <param><c>DrawItemIndex</c> index within parent <c>TListView</c> of item being rendered</param>
/// <param><c>DrawStates</c> which of the item states to render: <c>Selected</c>, <c>Deleting</c>, <c>EditMode</c>;
/// see <see cref='TListItemDrawStates'>TListItemDrawStates</see></param>
/// <param><c>Resources</c> default style resources to use for rendering;
/// <see cref='TListItemStyleResources'>TListItemStyleResources</see></param>
/// <param><c>Params</c> extra rendering parameters; see
/// <see cref='TListItemDrawable.TParams'>TListItemDrawable.TParams</see></param>
/// </summary>
procedure Render(const Canvas: TCanvas; const DrawItemIndex: Integer; const DrawStates: TListItemDrawStates;
const Resources: TListItemStyleResources; const Params: TParams; const SubPassNo: Integer = 0); virtual; abstract;
/// <summary>Begin update. During update calling <see cref='InvalidateCallback'>InvalidateCallback</see>
/// will be held back until <see cref='EndUpdate'>EndUpdate</see></summary>
procedure BeginUpdate;
/// <summary>End update. If invalidation was required during the update cycle,
/// <see cref='InvalidateCallback'>InvalidateCallback</see> will be invoked</summary>
procedure EndUpdate;
/// <summary>Initializes or updates default parameters defined by style in descendants such as font, font syle
/// and colors.</summary>
procedure UpdateValuesFromResources(const Resources: TListItemStyleResources; const Purpose: TListItemPurpose);
/// <summary>Set flag that enables UpdateValuesFromResources</summary>
procedure UpdateValuesFromStyle;
/// <summary>Local width of list item inside its designated area</summary>
property Width: Single index 0 read FWidth write SetOneDimension;
/// <summary>Local height of list item inside its designated area</summary>
property Height: Single index 1 read FHeight write SetOneDimension;
/// <summary>Size of this drawable</summary>
property Size: TPointF read GetSize write SetSize;
/// <summary>Horizontal alignment of drawable inside its designated area</summary>
property Align: TListItemAlign read FAlign write SetAlign;
/// <summary>Vertical alignment of drawable inside its designated area</summary>
property VertAlign: TListItemAlign read FVertAlign write SetVertAlign;
/// <summary>Determines whether the current drawable is visible or not</summary>
property Visible: Boolean read FVisible write SetVisible;
/// <summary>The offset in logical units regarding aligned location for finer placement control</summary>
property PlaceOffset: TPosition read GetPlaceOffset;
/// <summary>Name of this drawable</summary>
property Name: string read FName write FName;
/// <summary>Drawing opacity</summary>
property Opacity: Single read FOpacity write SetOpacity;
/// <summary>LocalRect of this drawable</summary>
property LocalRect: TRectF read FLocalRect;
/// <summary>Invoked when owner TListItem is selected</summary>
property OnSelect: TNotifyEvent read FOnSelect write FOnSelect;
// <summary>Polymorphic property access</summary>
property Data: TValue read GetData write SetData;
/// <summary>User-defined object reference for this drawable</summary>
property TagObject: TObject read FTagObject write FTagObject;
/// <summary>User-defined floating-point number for this drawable</summary>
property TagFloat: Single read FTagFloat write FTagFloat;
/// <summary>User-defined string for this drawable</summary>
property TagString: string read FTagString write FTagString;
/// <summary>Callback invoked when item is being invalidated
/// <see cref='FMX.ListView.Types.TListItemCallback'>TListItemCallback</see>
/// </summary>
property InvalidateCallback: TListItemCallback write SetInvalidateCallback;
end;
/// <summary>Declared for compatibility</summary>
TListItemObject = class(TListItemDrawable)
end;
/// <summary>Represents a text drawable in ListView items</summary>
TListItemText = class(TListItemDrawable)
private const
DefaultFontFamily = 'Helvetica'; // do not localize
DefaultFontSize = 14;
ShadowOffset: TPointF = (X: 0; Y: 1);
private type
TFontSettings = record
Family: string;
Size: Single;
Style: TFontStyles;
end;
strict private
FFontX: TFont;
FFontSettings: TFontSettings;
private
FTextLayout: TTextLayout;
FText: string;
FTextAlign: TTextAlign;
FTextVertAlign: TTextAlign;
FWordWrap: Boolean;
LayoutChanged: Boolean;
FTextColor: TAlphaColor;
FSelectedTextColor: TAlphaColor;
FTrimming: TTextTrimming;
FTextShadowOffsetX: TPosition;
FTextShadowColor: TAlphaColor;
FIsDetailText: Boolean;
procedure FontChanged(Sender: TObject);
procedure TextShadowOffsetChanged(Sender: TObject);
procedure SetText(const Value: string);
procedure SetTextAlign(const Value: TTextAlign);
procedure SetTextVertAlign(const Value: TTextAlign);
procedure SetWordWrap(const Value: Boolean);
procedure SetTextColor(const Value: TAlphaColor);
procedure SetTrimming(const Value: TTextTrimming);
procedure SetSelectedTextColor(const Value: TAlphaColor);
procedure SetTextShadowColor(const Value: TAlphaColor);
procedure SetIsDetailText(const Value: Boolean);
procedure SetData(const AValue: TValue); override;
function GetData: TValue; override;
function GetShadowOffset: TPosition; inline;
function GetFont: TFont;
function FontSettingsSnapshot: TFontSettings;
protected
procedure DoResize; override;
procedure DoUpdateValuesFromResources(const Resources: TListItemStyleResources; const Purpose: TListItemPurpose); override;
public
constructor Create(const AOwner: TListItem); override;
destructor Destroy; override;
procedure CalculateLocalRect(const DestRect: TRectF; const SceneScale: Single;
const DrawStates: TListItemDrawStates; const Item: TListItem); override;
procedure Render(const Canvas: TCanvas; const DrawItemIndex: Integer; const DrawStates: TListItemDrawStates;
const Resources: TListItemStyleResources; const Params: TListItemDrawable.TParams; const SubPassNo: Integer = 0); override;
/// <summary>Font used to drawing text in this drawable</summary>
property Font: TFont read GetFont;
/// <summary>Text displayed in this drawable</summary>
property Text: string read FText write SetText;
/// <summary>Horizontal text alignment inside local item rectangle</summary>
property TextAlign: TTextAlign read FTextAlign write SetTextAlign;
/// <summary>Vertical text alignment inside local item rectangle</summary>
property TextVertAlign: TTextAlign read FTextVertAlign write SetTextVertAlign;
/// <summary>Wrap the text it does not fit in the available width</summary>
property WordWrap: Boolean read FWordWrap write SetWordWrap;
/// <summary>Text color in neutral state</summary>
property TextColor: TAlphaColor read FTextColor write SetTextColor;
/// <summary>Text color in selected state</summary>
property SelectedTextColor: TAlphaColor read FSelectedTextColor write SetSelectedTextColor;
/// <summary>Text shadow color. The text shadow will appear behind normal text only when its color is
/// set to non-zero value (default)</summary>
property TextShadowColor: TAlphaColor read FTextShadowColor write SetTextShadowColor;
/// <summary>Text shadow offset. The text shadow will appear behind normal text only when its color is
/// set to non-zero value (default)</summary>
property TextShadowOffset: TPosition read GetShadowOffset;
/// <summary>Text trimming
/// <see cref='FMX.Types.TTextTrimming'>TTextTrimming</see>
/// </summary>
property Trimming: TTextTrimming read FTrimming write SetTrimming;
/// <summary>Hints regarding the contents of this text object, which affecs visual style</summary>
property IsDetailText: Boolean read FIsDetailText write SetIsDetailText;
end;
/// <summary>An empty drawable</summary>
TListItemDummy = class(TListItemDrawable)
public
procedure Render(const Canvas: TCanvas; const DrawItemIndex: Integer; const DrawStates: TListItemDrawStates;
const Resources: TListItemStyleResources; const Params: TListItemDrawable.TParams;
const SubPassNo: Integer = 0); override;
end;
/// <summary>Image scaling modes for TListItemImage
/// <see cref='FMX.ListView.Types.TListItemImage.ScalingMode'>TListItemImage.ScalingMode</see>
/// <param><c>StretchWithAspect</c></param> stretch while preserving aspect ratio
/// <param><c>Original</c></param> keep original size and proportion
/// <param><c>Stretch</c></param> stertch to fill available area disregarding proportions
/// </summary>
TImageScalingMode = (StretchWithAspect, Original, Stretch);
/// <summary>A TListItemDrawable representing an image</summary>
TListItemImage = class(TListItemDrawable)
public type
/// <summary>Image source:
/// <para><b>None</b> no image source</para>
/// <para><b>Bitmap</b> bitmap or bitmap reference</para>
/// <para><b>ImageList</b> bitmap is specified by an index in an ImageList</para>
/// </summary>
TImageSource = (None, Bitmap, ImageList);
private
FStaticBitmap: TBitmap;
[Weak]FReferBitmap: TBitmap;
FSrcRect: TRectF;
FOwnsBitmap: Boolean;
FImageScalingMode: TImageScalingMode;
FImageIndex: TImageIndex;
FImageSource: TImageSource;
function GetBitmap: TBitmap;
procedure SetBitmap(const Value: TBitmap);
procedure SetOwnsBitmap(const Value: Boolean);
procedure SetSrcRect(const Value: TRectF);
procedure SetImageScalingMode(const Value: TImageScalingMode);
procedure SetImageIndex(const Value: TImageIndex);
function GetImageSource: TImageSource; inline;
procedure SetData(const Value: TValue); override;
public
constructor Create(const AOwner: TListItem); override;
destructor Destroy; override;
procedure CalculateLocalRect(const DestRect: TRectF; const SceneScale: Single;
const DrawStates: TListItemDrawStates; const Item: TListItem); override;
procedure Render(const Canvas: TCanvas; const DrawItemIndex: Integer; const DrawStates: TListItemDrawStates;
const Resources: TListItemStyleResources; const Params: TListItemDrawable.TParams;
const SubPassNo: Integer = 0); override;
/// <summary>Bitmap, used if <b>ImageSource</b> equals <b>TImageSource.Bitmap</b></summary>
property Bitmap: TBitmap read GetBitmap write SetBitmap;
/// <summary>Determines whether this list owns and maintains the bitmap, or whether it is a reference only.
/// It is must faster and memory efficient to have multiple references to a single bitmap rather than multiple
/// copies of the same bitmap copied across the items</summary>
property OwnsBitmap: Boolean read FOwnsBitmap write SetOwnsBitmap;
/// <summary>Fit InputRect part of Bitmap into DestinationRect according to current ScalingMode
/// <para><b>Bitmap</b> TBitmap being fit</para>
/// <para><b>InputRect</b> source rectangle</para>
/// <para><b>DestinationRect</b> destination rectangle where the bitmap is to be placed</para>
/// </summary>
procedure FitInto(const Bitmap: TBitmap; var InputRect, DestinationRect: TRectF);
/// <summary>Source rectangle in ImageSource</summary>
property SrcRect: TRectF read FSrcRect write SetSrcRect;
/// <summary>Scaling mode used for fitting the bitmap into destination rectangle</summary>
property ScalingMode: TImageScalingMode read FImageScalingMode write SetImageScalingMode
default TImageScalingMode.StretchWithAspect;
/// <summary>Indicates whether the images are obtained from TImageList or directly by using Bitmap property.</summary>
property ImageSource: TImageSource read GetImageSource;
///<summary> Zero based index of an image. The default is <c>-1</c>.
///<para> See also <b>FMX.ActnList.IGlyph</b></para></summary>
///<remarks> If non-existing index is specified, an image is not drawn and no exception is raised</remarks>
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
end;
TListItemEmbeddedControl = class;
/// <summary>IScene implementation for TListItemEmbeddedControl</summary>
TListItemControlScene = class(TFmxObject, IStyleBookOwner, IScene)
strict private
FCanvas: TCanvas;
[Weak] FContainer: TControl;
[Weak] FOwnerItem: TListItem;
FDrawing: Boolean;
FDisableUpdating: Integer;
private
FLayoutSize: TPoint;
function GetRealScene: IScene;
protected
// TFmxObject
procedure DoAddObject(const AObject: TFmxObject); override;
procedure DoRemoveObject(const AObject: TFmxObject); override;
// IStyleBookOwner
function GetStyleBook: TStyleBook;
procedure SetStyleBook(const Value: TStyleBook);
// IScene
function GetCanvas: TCanvas;
function GetSceneScale: Single;
function GetObject: TFmxObject;
procedure AddUpdateRect(const R: TRectF);
function GetUpdateRectsCount: Integer;
function GetUpdateRect(const Index: Integer): TRectF;
function LocalToScreen(const P: TPointF): TPointF;
function ScreenToLocal(const P: TPointF): TPointF;
procedure ChangeScrollingState(const AControl: TControl; const Active: Boolean);
procedure DisableUpdating;
procedure EnableUpdating;
/// <summary>Set item that contains this scene</summary>
procedure SetOwnerItem(const Item: TListItem);
/// <summary>Set container control</summary>
procedure SetContainer(const Container: TControl);
/// <summary>Get IScene of the parent control, i.e. TListView</summary>
property RealScene: IScene read GetRealScene;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
/// <summary>Repaint scene on canvas Canvas</summary>
procedure RepaintScene(const Canvas: TCanvas);
/// <summary>Container control</summary>
property Container: TControl read FContainer;
end;
/// <summary>A dummy TControl that contains a TListItemEmbeddedControl</summary>
TListItemControlContainer = class(TControl)
private
[weak]FItemOwner: TListItemEmbeddedControl;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
/// <summary>Base class for TListItem embedded controls</summary>
TListItemEmbeddedControl = class(TListItemDrawable)
private
FScene: TListItemControlScene;
FContainer: TListItemControlContainer;
protected
/// <summary>Return TControl located at given Point</summary>
function ObjectAtPoint(const Point: TPointF): TControl; override;
public
constructor Create(const AOwner: TListItem); override;
destructor Destroy; override;
procedure Render(const Canvas: TCanvas; const DrawItemIndex: Integer; const DrawStates: TListItemDrawStates;
const Resources: TListItemStyleResources; const Params: TListItemDrawable.TParams;
const SubPassNo: Integer = 0); override;
/// <summary>TListItemControlContainer of this embedded control</summary>
property Container: TListItemControlContainer read FContainer;
end;
/// <summary>Simple embedded control base class</summary>
TListItemSimpleControl = class(TListItemDrawable)
private const
DisabledOpacity = 0.6;
private
FEnabled: Boolean;
FPressed: Boolean;
FMouseOver: Boolean;
FTouchExpand: Single;
procedure SetEnabled(const Value: Boolean);
protected
/// <summary>Shall intercept clicks</summary>
function IsClickOpaque: Boolean; virtual;
function MouseDown(const Button: TMouseButton; const Shift: TShiftState; const MousePos: TPointF): Boolean;
override;
procedure MouseMove(const Shift: TShiftState; const MousePos: TPointF); override;
procedure MouseUp(const Button: TMouseButton; const Shift: TShiftState; const MousePos: TPointF); override;
/// <summary>Handle click</summary>
procedure DoClick; virtual;
/// <summary>Handle change of Enabled</summary>
procedure DoEnabledChange; virtual;
public
constructor Create(const AOwner: TListItem); override;
/// <summary>Test if point Pos belongs to local rectangle of this control</summary>
function PointInLocalRect(const Pos: TPointF): Boolean;
/// <summary>This method is called when click event is sent to the control to handle any actions associated
/// with this item</summary>
procedure Click;
/// <summary>Control state: Enabled</summary>
property Enabled: Boolean read FEnabled write SetEnabled;
/// <summary>Control state: Pressed</summary>
property Pressed: Boolean read FPressed;
/// <summary>Control state: MouseOver</summary>
property MouseOver: Boolean read FMouseOver;
/// <summary>Additional area (in logical units) around the control that is sensitive to touch</summary>
property TouchExpand: Single read FTouchExpand write FTouchExpand;
end;
/// <summary>Accessory type for <b>TListItemAccessory</b>
/// <para><c>More</c> more</para>
/// <para><c>Checkmark</c> checkmark</para>
/// <para><c>Detail</c> detail disclosure</para>
/// </summary>
TAccessoryType = (More, Checkmark, Detail);
/// <summary>List item accessory, a glyph typically displayed at the right edge of the list item</summary>
TListItemAccessory = class(TListItemDrawable)
private
FAccessoryType: TAccessoryType;
protected
/// <summary>Set accessory type: <c>More</c>, <c>Checkmark</c> or <c>Detail</c></summary>
procedure SetAccessoryType(Value: TAccessoryType);
public
constructor Create(const AOwner: TListItem); override;
procedure CalculateLocalRect(const DestRect: TRectF; const SceneScale: Single;
const DrawStates: TListItemDrawStates; const Item: TListItem); override;
procedure Render(const Canvas: TCanvas; const DrawItemIndex: Integer; const DrawStates: TListItemDrawStates;
const Resources: TListItemStyleResources; const Params: TListItemDrawable.TParams;
const SubPassNo: Integer = 0); override;
/// <summary>Accessory type, <see cref='FMX.ListView.Types.TAccessoryType'>TAccessoryType</see></summary>
property AccessoryType: TAccessoryType read FAccessoryType write SetAccessoryType;
end;
/// <summary>Glyph type for <b>TListItemGlyphButton</b>
/// <para><b>Add</b> plus button</para>
/// <para><b>Delete</b> delete button</para>
/// <para><b>Checkbox</b> selection checkbox</para>
/// </summary>
TGlyphButtonType = (Add, Delete, Checkbox);
/// <summary>Glyph button is an additional control usually used in Edit mode. It can be an Add/Plus sign,
/// a Delete button or a Checkbox</summary>
TListItemGlyphButton = class(TListItemSimpleControl)
private const
CheckedAnimationFrameRate = 60;
CheckedAnimationDuration = 0.15; // in seconds
private
FButtonType: TGlyphButtonType;
FClickOnSelect: Boolean;
FChecked: Boolean;
FTransitionEnabled: Boolean;
FTransitionAlpha: Single;
FTransitionTimer: TTimer;
FTransitionStartTicks: Double;
FTimerService: IFMXTimerService;
procedure SetButtonType(const Value: TGlyphButtonType);
procedure SetChecked(const Value: Boolean);
procedure InitCheckedTransition;
procedure ResetCheckedTransition;
procedure TransitionTimerNotify(Sender: TObject);
protected
procedure DoSelect; override;
procedure DoClick; override;
function MouseDown(const Button: TMouseButton; const Shift: TShiftState; const MousePos: TPointF): Boolean;
override;
procedure SetData(const AValue: TValue); override;
public
constructor Create(const AOwner: TListItem); override;
destructor Destroy; override;
procedure CalculateLocalRect(const DestRect: TRectF; const SceneScale: Single;
const DrawStates: TListItemDrawStates; const Item: TListItem); override;
procedure Render(const Canvas: TCanvas; const DrawItemIndex: Integer; const DrawStates: TListItemDrawStates;
const Resources: TListItemStyleResources; const Params: TListItemDrawable.TParams;
const SubPassNo: Integer = 0); override;
/// <summary>Button type, <see cref='FMX.ListView.Types.TGlyphButtonType'>TGlyphButtonType</see></summary>
property ButtonType: TGlyphButtonType read FButtonType write SetButtonType;
/// <summary>If set to True, this button will receive click events from entire list by using of selection</summary>
property ClickOnSelect: Boolean read FClickOnSelect write FClickOnSelect;
/// <summary>Determines whether checkbox is checked, has no effect for other button types</summary>
property Checked: Boolean read FChecked write SetChecked;
end;
/// <summary>Type of TListItemTextButton
/// <para><b>Normal</b> a regular button</para>
/// <para><b>Delete</b> a delete button</para>
/// </summary>
TTextButtonType = (Normal, Delete);
/// <summary>A button with text that can be clicked inside of a TListItem</summary>
TListItemTextButton = class(TListItemSimpleControl)
private
FTextDrawable: TListItemText;
FButtonType: TTextButtonType;
FTintColor: TAlphaColor;
FPressedTextColor: TAlphaColor;
FTextColor: TAlphaColor;
// getters routing to FTextDrawable
function GetFont: TFont;
function GetText: string;
procedure SetText(const Value: string);
procedure SetTextAlign(const Value: TTextAlign);
function GetTextAlign: TTextAlign;
procedure SetTextVertAlign(const Value: TTextAlign);
function GetTextVertAlign: TTextAlign;
procedure SetWordWrap(const Value: Boolean);
function GetWordWrap: Boolean;
procedure SetTextColor(const Value: TAlphaColor);
function GetTextColor: TAlphaColor;
procedure SetTrimming(const Value: TTextTrimming);
function GetTrimming: TTextTrimming;
procedure SetTextShadowColor(const Value: TAlphaColor);
function GetTextShadowColor: TAlphaColor;
// button-specific text properties
procedure SetPressedTextColor(const Value: TAlphaColor);
function GetTextShadowOffset: TPosition; inline;
procedure SetButtonType(const Value: TTextButtonType);
procedure SetTintColor(const Value: TAlphaColor);
procedure SetInvalidateCallback(const Callback: TListItemCallback); override;
protected
function IsClickOpaque: Boolean; override;
procedure DoResize; override;
procedure DoOpacityChange; override;
procedure DoPlaceOffsetChanged; override;
procedure DoAlignChanged; override;
procedure SetData(const AValue: TValue); override;
public
constructor Create(const AOwner: TListItem); override;
destructor Destroy; override;
procedure DoUpdateValuesFromResources(const Resources: TListItemStyleResources;
const Purpose: TListItemPurpose); override;
function GetRenderPassCount: Integer; override;
procedure CalculateLocalRect(const DestRect: TRectF; const SceneScale: Single;
const DrawStates: TListItemDrawStates; const Item: TListItem); override;
procedure Render(const Canvas: TCanvas; const DrawItemIndex: Integer; const DrawStates: TListItemDrawStates;
const Resources: TListItemStyleResources; const Params: TListItemDrawable.TParams;
const SubPassNo: Integer = 0); override;
/// <summary>Button type, <see cref='FMX.ListView.Types.TTextButtonType'>TTextButtonType</see></summary>
property ButtonType: TTextButtonType read FButtonType write SetButtonType;
/// <summary>Button tint color</summary>
property TintColor: TAlphaColor read FTintColor write SetTintColor;
/// <summary>Font used to draw button text</summary>
property Font: TFont read GetFont;
/// <summary>Button text</summary>
property Text: string read GetText write SetText;
/// <summary>Horizontal alignment of text within the button area</summary>
property TextAlign: TTextAlign read GetTextAlign write SetTextAlign;
/// <summary>Vertical alignment of text within the button area</summary>
property TextVertAlign: TTextAlign read GetTextVertAlign write SetTextVertAlign;
/// <summary>If true, the text that does not fit in button width will be wrapped</summary>
property WordWrap: Boolean read GetWordWrap write SetWordWrap;
/// <summary>Text color in neutral state</summary>
property TextColor: TAlphaColor read GetTextColor write SetTextColor;
/// <summary>Text color in pressed state</summary>
property PressedTextColor: TAlphaColor read FPressedTextColor write SetPressedTextColor;
/// <summary>Text shadow color</summary>
property TextShadowColor: TAlphaColor read GetTextShadowColor write SetTextShadowColor;
/// <summary>Text shadow offset</summary>
property TextShadowOffset: TPosition read GetTextShadowOffset;
/// <summary>Text trimming
/// <see cref='FMX.Types.TTextTrimming'>TTextTrimming</see>
/// </summary>
property Trimming: TTextTrimming read GetTrimming write SetTrimming;
end;
/// <summary>TListItemView is a collection of drawables that comprise the view of a TListItem</summary>
TListItemView = class
private type
TViewList = TObjectList<TListItemDrawable>;
private
FCallback: TListItemCallback;
FViewList: TListItemView.TViewList;
FInitialized: Boolean;
function GetCount: Integer;
function GetObject(const Index: Integer): TListItemDrawable;
function GetViewList: TViewList; inline;
protected
procedure Include(const AItem: TListItemDrawable);
procedure Exclude(const AItem: TListItemDrawable);
function GetInitialized: Boolean;
procedure SetInitialized(const Value: Boolean);
public
constructor Create(const AOwner: TListItem);
destructor Destroy; override;
/// <summary>Add a drawable to view</summary>
function Add(const AItem: TListItemDrawable): Integer;
/// <summary>Insert a drawable at a position indicated by Index</summary>
procedure Insert(const Index: Integer; const Value: TListItemDrawable);
/// <summary>Clear the view</summary>
procedure Clear; virtual;
/// <summary>Delete drawable at index Index</summary>
procedure Delete(Index: Integer);
/// <summary>Find <see cref='FMX.ListView.Types.TListItemDrawable'>TListItemDrawable</see>
/// specified by name AName</summary>
function FindDrawable(const AName: string): TListItemDrawable;
/// <summary>Find TListItemDrawable specified by name AName</summary>
function FindObject(const AName: string): TListItemDrawable; deprecated 'Use FindDrawable';
/// <summary>Find TListItemDrawable specified by name AName and throw an error if not found</summary>
function DrawableByName(const AName: string): TListItemDrawable;
/// <summary>Find TListItemDrawable specified by name AName and throw an error if not found</summary>
function ObjectByName(const AName: string): TListItemDrawable; deprecated 'Use DrawableByName';
/// <summary>Number of drawables in this view</summary>
property Count: Integer read GetCount;
/// <summary>TListItemDrawable by index</summary>
property Drawables[const Index: Integer]: TListItemDrawable read GetObject; default;
/// <summary>Get TViewList that contains the drawables</summary>
property ViewList: TViewList read GetViewList;
/// <summary>Used internally to notify owner about changes</summary>
property Callback: TListItemCallback write FCallback;
/// <summary>Used internally</summary>
property Initialized: Boolean read GetInitialized write SetInitialized;
end;
/// <summary>Compatibility class for TListItemView</summary>
TListItemObjects = class(TListItemView)
end;
/// <summary>TListItem is an element that comprises TListView. Each individual item contains a View,
/// which in turn is comprised of instances of TListItemDrawable</summary>
TListItem = class
public type
TListItemViewType = class of TListItemView;
TListItemNotifyEvent = procedure(const Item: TListItem) of object;
strict private
FHeaderRef: Integer;
FAdapter: IListViewAdapter;
FController: IListViewController;
private
FIndex: Integer;
FHeight: Integer;
FPurpose: TListItemPurpose;
FUpdating: Integer;
FNeedRepaint: Boolean;
FView: TListItemView;
[Weak] FTagObject: TObject;
FTag: NativeInt;
FTagFloat: Single;
FTagString: string;
function GetCount: Integer;
procedure SetHeight(const Value: Integer);
function GetController: IListViewController;
protected
/// <summary>Invoked when item height changes and heights of all items need to be recounted</summary>
procedure InvalidateHeights; virtual;
/// <summary>Setter for Purpose property</summary>
procedure SetPurpose(const AValue: TListItemPurpose); virtual;
/// <summary>Require repaint, notify the controller that the item is invalid</summary>
procedure Repaint; virtual;
/// <summary>Return class of TListItemView</summary>
function ListItemObjectsClass: TListItemViewType; virtual;
/// <summary>Getter for Index property</summary>
function GetIndex: Integer; virtual;
/// <summary>Setter for Index property</summary>
procedure SetIndex(const Value: Integer); virtual;
public
constructor Create(const AAdapter: IListViewAdapter; const AController: IListViewController = nil);
destructor Destroy; override;
function ToString: string; override;
/// <summary>Invalidate item, request repainting</summary>
procedure Invalidate;
/// <summary>Begin update. Invalidation request will not cause immediate action during update.</summary>
procedure BeginUpdate;
/// <summary>End update</summary>
procedure EndUpdate;
/// <summary>Called when the view drawables need to be created</summary>
procedure CreateObjects; virtual;
/// <summary>Called when the item is about to be painted</summary>
procedure WillBePainted; virtual;
/// <summary>Locate a control at a point, used with embedded controls</summary>
function ObjectAtPoint(const Point: TPointF): TControl;
/// <summary>Handle MouseDown event</summary>
function MouseDown(const Button: TMouseButton; const Shift: TShiftState; const MousePos: TPointF): Boolean;
/// <summary>Handle MouseMove event</summary>
procedure MouseMove(const Shift: TShiftState; const MousePos: TPointF);
/// <summary>Handle MouseUp event</summary>
procedure MouseUp(const Button: TMouseButton; const Shift: TShiftState; const MousePos: TPointF);
/// <summary>Handle selection</summary>
procedure MouseSelect;
/// <summary>True if there are items inside that react as clicked when the item is selected</summary>
function HasClickOnSelectItems: Boolean;
/// <summary>Adapter that observes this item</summary>
property Adapter: IListViewAdapter read FAdapter;
/// <summary>Number of drawables in the View, shorthand for View.Count</summary>
property Count: Integer read GetCount;
/// <summary>The view, drawables that comprise the visual of this item</summary>
property View: TListItemView read FView;
/// <summary>Height of this item</summary>
property Height: Integer read FHeight write SetHeight;
/// <summary>Reference to IListViewController</summary>
property Controller: IListViewController read GetController;
/// <summary>Which purpose item serves for: normal item (none), header or footer.
/// <see cref='FMX.ListView.Types.TListItemPurpose'>TListItemPurpose</see></summary>
property Purpose: TListItemPurpose read FPurpose write SetPurpose;
/// <summary>Reference to header of the group this item belongs to, for grouped views</summary>
property HeaderRef: Integer read FHeaderRef write FHeaderRef;
/// <summary>Index of this item in TListView.Adapter</summary>
property Index: Integer read GetIndex write SetIndex;
/// <summary>User-defined integer tag for this item</summary>
property Tag: NativeInt read FTag write FTag;
/// <summary>User-defined object reference for this item</summary>
property TagObject: TObject read FTagObject write FTagObject;
/// <summary>User-defined floating-point number for this drawable</summary>
property TagFloat: Single read FTagFloat write FTagFloat;
/// <summary>User-defined string tag for this item</summary>
property TagString: string read FTagString write FTagString;
end;
/// <summary>A container used for passing various style-defined properties used in <c>TListView</c></summary>
TListItemStyleResources = class
private
FOwnsObjects: Boolean;
public type
/// <summary>References to <c>TStyleObject</c>s used for rendering of <c>TListItemAccessory</c></summary>
TAccessoryStyleObject = record
/// <summary>Accessory <c>TStyleObject</c> in neutral state</summary>
[Weak] Normal: TStyleObject;
/// <summary>Accessory <c>TStyleObject</c> in selected state</summary>
[Weak] Selected: TStyleObject;
end;
/// <summary>Style objects used for button rendering</summary>
TButtonStyleObject = record
/// <summary>Button <c>TStyleObject</c> in neutral state</summary>
[Weak] Normal: TStyleObject;
/// <summary>Button <c>TStyleObject</c> in pressed state</summary>
[Weak] Pressed: TStyleObject;
end;
public
/// <summary>Style references used for Accessory rendering</summary>
AccessoryImages: array [TAccessoryType] of TAccessoryStyleObject;
/// <summary>Font used in header items</summary>
HeaderTextFont: TFont;
/// <summary>Color of header text</summary>
HeaderTextColor: TAlphaColor;
/// <summary>Color of header text shadow</summary>
HeaderTextShadowColor: TAlphaColor;
/// <summary>Default font for text drawables</summary>
DefaultTextFont: TFont;
/// <summary>Default color for text drawables</summary>
DefaultTextColor: TAlphaColor;
/// <summary>Default font for detail text</summary>
DetailTextFont: TFont;
/// <summary>Default color for detail text</summary>
DetailTextColor: TAlphaColor;
/// <summary>Default color for text in selected state</summary>
DefaultTextSelectedColor: TAlphaColor;
/// <summary>Style objects for Add Item <c>TListItemGlyphButton</c></summary>
ButtonAddItemStyleImage: TButtonStyleObject;
/// <summary>Style objects for Delete Item <c>TListItemGlyphButton</c></summary>
ButtonDeleteItemStyleImage: TButtonStyleObject;
/// <summary>Background image for regular <c>TListItemTextButton</c></summary>
ButtonNormalStyleImage: TButtonStyleObject;
/// <summary>Background image for delete-themed <c>TListItemTextButton</c></summary>
ButtonDeleteStyleImage: TButtonStyleObject;
/// <summary>Style objects for Checkbox <c>TListItemGlyphButton</c></summary>
ButtonCheckboxStyleImage: TButtonStyleObject;
/// <summary>Font for <c>TListItemTextButton</c></summary>
ButtonTextFont: TFont;
/// <summary>Text color for neutral state <c>TListItemTextButton</c></summary>
ButtonTextColor: TAlphaColor;
/// <summary>Text color for pressed state <c>TListItemTextButton</c></summary>
ButtonTextPressedColor: TAlphaColor;
/// <summary>Font for delete-themed <c>TListItemTextButton</c></summary>
DeleteButtonTextFont: TFont;
/// <summary>Text color for neutral state delete-themed <c>TListItemTextButton</c></summary>
DeleteButtonTextColor: TAlphaColor;
/// <summary>Text color for pressed state delete-themed <c>TListItemTextButton</c></summary>
DeleteButtonTextPressedColor: TAlphaColor;
/// <summary>Glow color that appears at the top or the bottom of screen when scrolling
/// is being stretched out</summary>
ScrollingStretchGlowColor: TAlphaColor;
/// <summary>Indicator color for drawing Pull Refresh indicator</summary>
PullRefreshIndicatorColor: TAlphaColor;
/// <summary>Stroke color for drawing Pull Refresh indicator</summary>
PullRefreshStrokeColor: TAlphaColor;
constructor Create; overload;
constructor Create(const Source: TListItemStyleResources); overload;
destructor Destroy; override;
end;
/// <summary>Interface providing access to style resources. Implemented by <c>TListViewBase</c></summary>
IListItemStyleResources = interface
['{0328C6F1-432C-4F8B-994B-7AB2543CD172}']
/// <summary>Getter for StyleResources property</summary>
function GetStyleResources: TListItemStyleResources;
/// <summary><c>TListView</c> style resources</summary>
property StyleResources: TListItemStyleResources read GetStyleResources;
/// <summary><c>True</c> if style resources should be reloaded</summary>
function StyleResourcesNeedUpdate: Boolean;
end;
/// <summary>Interface providing loose coupling between <c>TListView</c> and <c>TListItem</c>. Implemented by
/// <c>TListViewBase</c></summary>
IListViewController = interface
['{3855EF72-3B32-41BE-9068-7B109B2DD8E5}']
function GetEditModeTransitionAlpha: Single;
function GetDeleteModeTransitionAlpha: Single;
function GetImages: TCustomImageList;
/// <summary><c>True</c> if delete mode is enabled</summary>
function IsDeleteModeAllowed: Boolean;
/// <summary>Left offset of item rectangle in edit mode</summary>
function GetItemEditOffset(const Item: TListItem): Single;
/// <summary>Right cutoff of item rectangle in delete mode</summary>
function GetItemDeleteCutoff(const Item: TListItem): Single;
/// <summary>Item selection alpha</summary>
function GetItemSelectionAlpha(const Item: TListItem): Single;
/// <summary>Client area margins</summary>
function GetClientMargins: TRectF;
/// <summary>IScene of the <c>TListView</c> control</summary>
function GetScene: IScene;
/// <summary>Request <c>TListView</c> to initialize item indices; see "FMX.ListView.Appearances.TListViewItem"</summary>
procedure RequestReindexing(const Item: TListItem);
/// <summary>Notify <c>TListView</c> that item size has changed; see "TListViewItem.InvalidateHeights"</summary>
procedure ItemResized(const Item: TListItem);
/// <summary>Notify <c>TListView</c> that item requires repainting</summary>
procedure ItemInvalidated(const Item: TListItem);
/// <summary>Notify <c>TListView</c> that a control inside of an item has been clicked</summary>
procedure ControlClicked(const Item: TListItem; const Control: TListItemDrawable);
/// <summary>Notify <c>TListView</c> that a control inside of an item has been clicked</summary>
procedure CheckStateChanged(const Item: TListItem; const Control: TListItemDrawable);
/// <summary>Item alpha during edit mode transition</summary>
property EditModeTransitionAlpha: Single read GetEditModeTransitionAlpha;
/// <summary>Item alpha during delete transition</summary>
property DeleteModeTransitionAlpha: Single read GetDeleteModeTransitionAlpha;
///<summary>TImageList used when ImageSource = ImageList; can be <c>nil</c></summary>
property Images: TCustomImageList read GetImages;
end;
/// <summary>Presentation of <c>TPresentedListView</c>. The control passes messages to the
/// presentation layer by the means of this interface.</summary>
IListViewPresentation = interface
['{85C07617-2BB7-44DC-BBCB-2E3FE422B006}']
/// <summary>Called when ancestor's visible property is changed</summary>
procedure AncestorVisibleChanged(const Visible: Boolean);
/// <summary>Called when Parent is changed</summary>
procedure ParentChanged;
/// <summary>Called when position in parent list is changed</summary>
procedure OrderChanged;
/// <summary>Called when control size has changed</summary>
procedure SizeChanged;
/// <summary>Called when edit mode has changed</summary>
procedure EditModeChanged;
/// <summary>Called when visibility status has changed</summary>
procedure StatusChanged;
/// <summary>Called when item presentation requires update</summary>
procedure ItemsUpdated;
/// <summary>Item has been invalidated, presentation should reinitialize its view</summary>
procedure ItemInvalidated(const Item: TListItem);
/// <summary>Item has been selected by the control, presentation should update its selection</summary>
procedure SetItemSelected(const ItemIndex: Integer; const Value: Boolean);
/// <summary>Selected item index has been changed by the control, presentation should update selection</summary>
procedure SetItemIndex(const ItemIndex: Integer);
/// <summary>Force stop pull refresh</summary>
procedure StopPullRefresh;
end;
/// <summary>Base interface from presented control to presentation</summary>
IListViewCustomPresentationParent = interface
['{EBBE5FAA-F2B3-4606-AE32-8027DB97EC92}']
/// <summary>Get root object, normally Root.GetObject</summary>
function GetRootObject: TObject;
/// <summary>Get content frame of the presented control</summary>
function GetContentFrame: TRect;
/// <summary>Get opacity of the presented control</summary>
function GetControlOpacity: Single;
end;
/// <summary>Enumeration of internally used boolean flags</summary>
TListViewModeFlag = (Edit, Enabled, Visible, Deletion, PullRefresh, Buttons, Search, SearchOnTop, PullRefreshWait,
SwipeDelete);
/// <summary>Set of boolean flags used internally</summary>
TListViewModeFlags = set of TListViewModeFlag;
/// <summary>View options specific to native iOS presentation</summary>
TListViewNativeOption = (Grouped, Indexed, Styled);
/// <summary>View options specific to native iOS presentation.
/// <see cref='IListViewPresentationParent'>IListViewPresentationParent</see></summary>
TListViewNativeOptions = set of TListViewNativeOption;
/// <summary>Interface from presented control to presentation</summary>
IListViewPresentationParent = interface(IListViewCustomPresentationParent)
['{F5657E45-0955-4A9F-9FE6-6C5E019846E4}']
/// <summary>Obtains <c>IListViewAdapter</c></summary>
function GetAdapter: IListViewAdapter;
/// <summary>Obtains client rectangle for item with index <c>ItemIndex</c></summary>
function GetItemClientRect(const ItemIndex: Integer): TRectF;
/// <summary>Obtains item count</summary>
function GetItemCount: Integer;
/// <summary>Obtains height of item <c>ItemIndex</c></summary>
function GetItemHeight(const ItemIndex: Integer): Integer;
/// <summary>Guess item height before exact values can be calculated</summary>
function GetEstimatedItemHeight: Single;
/// <summary>Guess header height before exact values can be calculated</summary>
function GetEstimatedHeaderHeight: Single;
/// <summary>Guess footer height before exact values can be calculated</summary>
function GetEstimatedFooterHeight: Single;
/// <summary>Get main text of item <c>ItemIndex</c></summary>
function GetItemText(const ItemIndex: Integer): string;
/// <summary>Get index title for item <c>ItemIndex</c></summary>
function GetItemIndexTitle(const ItemIndex: Integer): string;
/// <summary>Query if item <c>ItemIndex</c> is selectable</summary>
function CanSelectItem(const ItemIndex: Integer): Boolean;
/// <summary>Notify control when item <c>ItemIndex</c> was selected</summary>
procedure DidSelectItem(const ItemIndex: Integer);
/// <summary>Query if item <c>ItemIndex</c> can be unselected</summary>
function CanUnselectItem(const ItemIndex: Integer): Boolean;
/// <summary>Notify control that item <c>ItemIndex</c> was unselected</summary>
procedure DidUnselectItem(const ItemIndex: Integer);
/// <summary>Notify control that an item button was clicked</summary>
procedure ItemButtonClicked(const ItemIndex: Integer);
/// <summary>Obtain presentation-specific boolean flags</summary>
function GetFlags: TListViewModeFlags;
/// <summary>Obtain native presentation-specific boolean flags</summary>
function GetOptions: TListViewNativeOptions;
/// <summary>Commit deletion of item <c>ItemIndex</c></summary>
function DeleteItem(const ItemIndex: Integer): Boolean;
/// <summary>Invoke pull refresh</summary>
procedure InvokePullRefresh;
/// <summary>Set search filter string</summary>
procedure SetSearchFilter(const Filter: string);
/// <summary>Pass scroll view position to the control</summary>
procedure SetScrollViewPos(const Value: Single);
/// <summary>Require rebuild of the list</summary>
procedure RebuildList;
/// <summary>Set boolean flag that indicates that native view is being created. It is used
/// as a guard condition to prevent TListView logic from interfering with the presentation
/// while a view is being initialized</summary>
procedure SetCreatingNativeView(const Value: Boolean);
/// <summary><c>True</c> if TListView is transparent</summary>
function GetIsTransparent: Boolean;
/// <summary>Obtain control opacity</summary>
function GetOpacity: Single;
/// <summary>Obtain background color defined by TListView style</summary>
function GetBackgroundStyleColor: TAlphaColor;
/// <summary>Request complete recreation of presentation</summary>
procedure RecreateNativePresentation;
end;
/// <summary>Used to check if there is a design presentation attached to ListView</summary>
IListViewDesignPresentationParent = interface
['{C62F3FE5-FE96-47A7-99CB-2EEBC85664FA}']
///<summary>True if design presentation is attached</summary>
function HasDesignPresentationAttached: Boolean;
end;
/// <summary>A drawable shim extension to apply bounds changes from
/// the designer.</summary>
IListViewDrawableShim = interface
['{9FB67E2A-37B9-473B-A95A-13EDD19ED91B}']
///<summary>Calculate appearance PlaceOffset, Width, Height for given rect from designer</summary>
function CalcAppearanceBounds(const AValue: TRect; const CurrentBounds: TRectF): TRectF;
end;
/// <summary>Predicate used for item filtering.
/// <see cref='IListViewFilterable'></see></summary>
TFilterPredicate = TPredicate<string>;
TListItemsList = TList<TListItem>;
/// <summary>IListViewAdapter provides interface between the data and their representation.
/// The essential part of this interface is implemented in FMX.ListView.Adapters.Base.TAbstractListViewAdapter
/// </summary>
IListViewAdapter = interface
['{6E850F76-BABD-4756-BF05-A30C66A692AD}']
/// <summary>Return number of items that this Adapter represents. See Item[Index]. </summary>
function GetCount: Integer;
/// <summary>Get TListItem by index Index</summary>
function GetItem(const Index: Integer): TListItem;
/// <summary>Get index of given TListItem</summary>
function IndexOf(const AItem: TListItem): Integer;
/// <summary>Return TEnumerator&lt;TListItem&gt;</summary>
function GetEnumerator: TEnumerator<TListItem>;
/// <summary>Height of items that do not have it explicitly defined</summary>
function GetDefaultViewHeight: Integer;
/// <summary>Subscribe to OnChanged event</summary>
procedure SetOnChanged(const Value: TNotifyEvent);
/// <summary>Subscribe to OnItemsMayChange event</summary>
procedure SetOnItemsMayChange(const Value: TNotifyEvent);
/// <summary>Subscribe to OnItemsCouldHaveChanged event</summary>
procedure SetOnItemsCouldHaveChanged(const Value: TNotifyEvent);
/// <summary>Subscribe to OnItemsInvalidate event</summary>
procedure SetOnItemsInvalidate(const Value: TNotifyEvent);
/// <summary>Subscribe to OnItemsResize event</summary>
procedure SetOnItemsResize(const Value: TNotifyEvent);
/// <summary>Subscribe to OnResetView event</summary>
procedure SetOnResetView(const Value: TNotifyEvent);
/// <summary>Notifies adapter about item's changes.</summary>
procedure Changed;
/// <summary>Sort data</summary>
procedure Sort(AComparer: IComparer<TListItem>);
/// <summary>Called by TListView every time it needs to paint. In dynamic adapters this is where
/// new TListItems should be created for data.</summary>
procedure CreateNewViews;
/// <summary>Recreate views for items that have specified purposes. May be called when item
/// views may need update, for example when host TListView is being resized</summary>
procedure ResetViews(const Purposes: TListItemPurposes);
// <summary>Called by ResetViews to invoke OnResetView event for each ListItem</summary>
procedure ResetView(const Item: TListItem);
/// <summary>Get item by Index. Items would normally be already created by CreateNewViews by the time
/// this property is accessed. Index should be in range of [0, Count)</summary>
property Item[const Index: Integer]: TListItem read GetItem; default;
/// <summary>Count of items</summary>
property Count: Integer read GetCount;
/// <summary>Invoked when items have changed</summary>
property OnChanged: TNotifyEvent write SetOnChanged;
/// <summary>Invoked before an edit operation, items or their contents may change</summary>
property OnItemsMayChange: TNotifyEvent write SetOnItemsMayChange;
/// <summary>Invoked after an edit operation, items could have been changed</summary>
property OnItemsCouldHaveChanged: TNotifyEvent write SetOnItemsCouldHaveChanged;
/// <summary>Invoked when items are invalidated and a repaint is necessary</summary>
property OnItemsInvalidate: TNotifyEvent write SetOnItemsInvalidate;
/// <summary>Item sizes were changed, notify the view that the sizes of items need recalculation</summary>
property OnItemsResize: TNotifyEvent write SetOnItemsResize;
/// <summary>View has been reset</summary>
property OnResetView: TNotifyEvent write SetOnResetView;
end;
IListViewEditor = interface;
TBeforeItemAddedNotify = procedure(Sender: IListViewEditor) of object;
TAfterItemAddedNotify = procedure(Sender: IListViewEditor; const Item: TListItem) of object;
TBeforeItemDeletedNotify = procedure(Sender: IListViewEditor; const Index: Integer) of object;
TAfterItemDeletedNotify = procedure(Sender: IListViewEditor) of object;
/// <summary>Extension of IListViewAdapter for editable content. Implemented by TAppearanceListViewItems</summary>
IListViewEditor = interface
['{19A0606B-8C8E-49B2-A6B3-A708B7B8AD46}']
/// <summary>Create a new Item and append at end</summary>
function Add: TListItem;
/// <summary>Delete Item at Index</summary>
procedure Delete(const Index: Integer);
/// <summary>Create a new Item and insert at Index</summary>
function Insert(const Index: Integer): TListItem;
/// <summary>Delete all items</summary>
procedure Clear;
/// <summary>Set OnBeforeItemAdded handler</summary>
procedure SetBeforeItemAdded(const AHandler: TBeforeItemAddedNotify);
/// <summary>Set OnAfterItemAdded handler</summary>
procedure SetAfterItemAdded(const AHandler: TAfterItemAddedNotify);
/// <summary>Set OnBeforeItemDeleted handler</summary>
procedure SetBeforeItemDeleted(const AHandler: TBeforeItemDeletedNotify);
/// <summary>Set OnAfterItemDeleted handler</summary>
procedure SetAfterItemDeleted(const AHandler: TAfterItemDeletedNotify);
/// <summary>Notification before item is added</summary>
property OnBeforeItemAdded: TBeforeItemAddedNotify write SetBeforeItemAdded;
/// <summary>Notification after item is added</summary>
property OnAfterItemAdded: TAfterItemAddedNotify write SetAfterItemAdded;
/// <summary>Notification before item is deleted</summary>
property OnBeforeItemDeleted: TBeforeItemDeletedNotify write SetBeforeItemDeleted;
/// <summary>Notification after item is deleted</summary>
property OnAfterItemDeleted: TAfterItemDeletedNotify write SetAfterItemDeleted;
end;
/// <summary>Extension of IListViewAdapter for items with checkboxes.
/// Implemented by TAppearanceListViewItems</summary>
IListViewCheckProvider = interface
['{032EB974-1C25-4B5E-BB07-01FA82554748}']
/// <summary>Index of first checked item</summary>
function FirstChecked(const Checked: Boolean = True): Integer;
/// <summary>A quick query to see if one or all of the items are in checked state.</summary>
/// <returns><para>If AChecked = True, True if at least one item is checked</para>
/// <para> If AChecked = False, True if every item is checked</para>
/// </returns>
function AnyChecked(const AChecked: Boolean = True): Boolean;
/// <summary>Change check state of all items</summary>
procedure CheckAll(const NewState: Boolean = True);
/// <summary>Get checked state for item at Index</summary>
function GetChecked(const Index: Integer): Boolean;
/// <summary>Set checked state for item at Index</summary>
procedure SetChecked(const Index: Integer; const Value: Boolean);
/// <summary>Get/set checked state of item at Index</summary>
property Checked[const Index: Integer]: Boolean read GetChecked write SetChecked; default;
end;
/// <summary>Extension of IListViewAdapter for items with text and indexes.
/// Implemented by TAppearanceListViewItems</summary>
IListViewTextProvider = interface
['{C6D52C15-423D-4B2F-AC87-7D7D47A9C7CC}']
/// <summary>Get primary text of item at Index</summary>
function GetText(const Index: Integer): string;
/// <summary>Get index title at Index</summary>
function GetIndexTitle(const Index: Integer): string;
/// <summary>Primary text of item at Index</summary>
property Text[const Index: Integer]: string read GetText;
/// <summary>Index title of item at Index</summary>
property IndexTitle[const Index: Integer]: string read GetIndexTitle;
end;
/// <summary>Extension of IListViewAdapter for items with embedded text buttons.
/// Implemented by TAppearanceListViewItems</summary>
IListViewTextButtonProvider = interface
['{42CC3926-0A23-465B-9ECE-229C60B3BA8E}']
/// <summary>Get drawable of text button for item at Index</summary>
function GetTextButtonDrawable(const Index: Integer): TListItemTextButton;
/// <summary>Drawable of text button for item at Index</summary>
property TextButtonDrawable[const Index: Integer]: TListItemTextButton read GetTextButtonDrawable;
end;
/// <summary>Extension of IListViewAdapter for items with glyph buttons.
/// Implemented by TAppearanceListViewItems</summary>
IListViewGlyphButtonProvider = interface
['{64FF4B01-E378-4F40-A9A5-E4C1A7C942D6}']
/// <summary>Get drawable of button for item at Index</summary>
function GetGlyphButtonDrawable(const Index: Integer): TListItemGlyphButton;
/// <summary>Drawable of button for item at Index</summary>
property GlyphButtonDrawable[const Index: Integer]: TListItemGlyphButton read GetGlyphButtonDrawable;
end;
/// <summary>Extension of IListViewAdapter for items with data.
/// Implemented by TAppearanceListViewItems</summary>
IListViewExtrasProvider = interface
['{0BCFB611-3763-4C49-974F-1104F6116D6E}']
/// <summary>Get indexed data DataIndex for item at Index</summary>
function GetItemData(const Index: Integer; const DataIndex: string): TValue;
/// <summary>Set indexed data DataIndex for item at Index</summary>
procedure SetItemData(const Index: Integer; const DataIndex: string; const AValue: TValue);
/// <summary>True if item at Index has indexed data DataIndex</summary>
function GetHasData(const Index: Integer; const DataIndex: string): Boolean;
/// <summary>Get tag of item at Index</summary>
function GetItemTag(const Index: Integer): NativeInt;
/// <summary>Set tag of item at Index</summary>
procedure SetItemTag(const Index: Integer; const AValue: NativeInt);
/// <summary>Indexed data DataIndex of item at Index</summary>
property Data[const Index: Integer; const DataIndex: string]: TValue read GetItemData write SetItemData;
/// <summary>Tag of item at Index</summary>
property Tag[const Index: Integer]: NativeInt read GetItemTag write SetItemTag;
/// <summary>True if item at Index has Indexed data DataIndex</summary>
property HasData[const Index: Integer; const DataIndex: string]: Boolean read GetHasData;
end;
/// <summary>Extension of IListViewAdapter items of which can be filtered by a search box.
/// Implemented by TAppearanceListViewItems</summary>
IListViewFilterable = interface
['{02F85899-8787-4378-9622-105820EB4577}']
/// <summary>Get filter predicate</summary>
function GetFilterPredicate: TFilterPredicate;
/// <summary>Set filter predicate</summary>
procedure SetFilterPredicate(const Value: TFilterPredicate);
/// <summary>Return a complete list of all items regardless of filter state</summary>
function GetUnfilteredItems: TListItemsList;
/// <summary>True if filter is applied</summary>
function GetFiltered: Boolean;
/// <summary>Notifies the adapter that all items have been deleted</summary>
procedure ItemsCleared;
/// <summary>Notifies the adapter that item at Index have been deleted</summary>
procedure ItemDeleted(const Index: Integer);
/// <summary>Notifies the adapter that item at Index have been added</summary>
procedure ItemAdded(const Index: Integer; const Item: TListItem);
/// <summary>Complete list of all items regardless of filter state</summary>
property UnfilteredItems: TListItemsList read GetUnfilteredItems;
/// <summary>True if filter is applied</summary>
property Filtered: Boolean read GetFiltered;
/// <summary>Filter predicate</summary>
property Filter: TFilterPredicate read GetFilterPredicate write SetFilterPredicate;
end;
//== INTERFACE END: FMX.ListView.Types
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.Edit (from FMX.Edit.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
const
MM_EDIT_SELSTART_CHANGED = MM_USER + 1;
MM_EDIT_SELLENGTH_CHANGED = MM_USER + 2;
MM_EDIT_READONLY_CHANGED = MM_USER + 3;
MM_EDIT_MAXLENGTH_CHANGED = MM_USER + 4;
MM_EDIT_ISPASSWORD_CHANGED = MM_USER + 5;
MM_EDIT_IMEMODE_CHANGED = MM_USER + 6;
MM_EDIT_KEYBOARDTYPE_CHANGED = MM_USER + 7;
MM_EDIT_RETURNKEYTYPE_CHANGED = MM_USER + 8;
MM_EDIT_KILLFOCUSBYRETURN_CHANGED = MM_USER + 9;
MM_EDIT_CHECKSPELLING_CHANGED = MM_USER + 10;
MM_EDIT_PROMPTTEXT_CHANGED = MM_USER + 11;
MM_EDIT_CARETPOSITION_CHANGED = MM_USER + 15;
MM_EDIT_CARETCHANGED = MM_USER + 16;
MM_EDIT_TYPING_CHANGED = MM_USER + 17;
MM_EDIT_TEXT_SETTINGS_CHANGED = MM_USER + 18;
MM_EDIT_TEXT_CHANGED = MM_USER + 19;
MM_EDIT_EDITBUTTONS_CHANGED = MM_USER + 21;
MM_EDIT_TEXT_CHANGING = MM_USER + 22;
MM_EDIT_CHARCASE_CHANGED = MM_USER + 23;
MM_EDIT_FILTERCHAR_CHANGED = MM_USER + 24;
MM_EDIT_GET_CARET_POSITION_BY_POINT = MM_USER + 25;
MM_EDIT_CAN_SET_FOCUS = MM_USER + 26;
MM_EDIT_AUTOSELECT_CHANGED = MM_USER + 27;
MM_EDIT_HIDESELECTIONONEXIT_CHANGED = MM_USER + 28;
MM_EDIT_USER = MM_USER + 29;
PM_EDIT_REALIGN_BUTTONS_CONTAINER = PM_USER + 1;
PM_EDIT_GET_TEXT_CONTENT_RECT = PM_USER + 2;
PM_EDIT_UNDO_MANAGER_INSERT_TEXT = PM_USER + 3;
PM_EDIT_UNDO_MANAGER_DELETE_TEXT = PM_USER + 4;
PM_EDIT_UNDO_MANAGER_UNDO = PM_USER + 5;
PM_EDIT_USER = PM_USER + 6;
type
{ TCustomEdit }
TCustomEditModel = class(TDataModel, ITextLinesSource)
public const
DefaultSelectionColor = $802A8ADF;
DefaultHorzAlign = TTextAlign.Leading;
DefaultFontColor = TAlphaColorRec.Black;
DefaultInputSupport = True;
DefaultCharCase = TEditCharCase.ecNormal;
DefaultAutoSelect = False;
DefaultHideSelectionOnExit = True;
public type
/// <summary>Data for requesting caret position by HitTest point.</summary>
TGetCaretPositionInfo = record
HitPoint: TPointF;
CaretPosition: Integer;
end;
private
FChanged: Boolean;
FText: string;
FSelStart: Integer;
FSelLength: Integer;
FReadOnly: Boolean;
FMaxLength: Integer;
FPassword: Boolean;
FKeyboardType : TVirtualkeyboardType;
FReturnKeyType: TReturnKeyType;
FImeMode: TImeMode;
FHideSelectionOnExit: Boolean;
FKillFocusByReturn: Boolean;
FCheckSpelling: Boolean;
FTextPrompt: string;
FCaretPosition: Integer;
FCaret: TCustomCaret;
FTyping: Boolean;
FFilterChar: string;
FInputSupport: Boolean;
FTextSettingsInfo: TTextSettingsInfo;
FSelectionFill: TBrush;
FOnChange: TNotifyEvent;
FOnChangeTracking: TNotifyEvent;
FOnTyping: TNotifyEvent;
FOnValidating: TValidateTextEvent;
FOnValidate: TValidateTextEvent;
FValidating: Boolean;
FCharCase: TEditCharCase;
FAutoSelect: Boolean;
procedure SetAutoSelect(const Value: Boolean);
procedure SetSelStart(const Value: Integer);
procedure SetSelLength(const Value: Integer);
procedure SetMaxLength(const Value: Integer);
procedure SetReadOnly(const Value: Boolean);
procedure SetPassword(const Value: Boolean);
procedure SetImeMode(const Value: TImeMode);
procedure SetKeyboardType(const Value: TVirtualKeyboardType);
procedure SetReturnKeyType(const Value: TReturnKeyType);
procedure SetKillFocusByReturn(const Value: Boolean);
procedure SetCheckSpelling(const Value: Boolean);
procedure SetTextPrompt(const Value: string);
procedure SetCaretPosition(const Value: Integer);
procedure SetCaret(const Value: TCustomCaret);
procedure SetTyping(const Value: Boolean);
/// <remarks>
/// Invokes sequence: DoFiltering -> DoTruncating -> DoValidating
/// </remarks>
procedure SetText(const Value: string);
procedure SetSelectionFill(const Value: TBrush);
procedure SetFilterChar(const Value: string);
procedure SetCharCase(const Value: TEditCharCase);
function CanSetFocus: Boolean;
procedure SetHideSelectionOnExit(const Value: Boolean);
{ ITextLinesSource }
function GetLine(const ALineIndex: Integer): string;
function GetLineBreak: string;
function GetCount: Integer;
function TextPosToPos(const APos: Integer): TCaretPosition;
function PosToTextPos(const APosition: TCaretPosition): Integer;
function GetText: string;
protected
///<summary>Initial text filtering before calling <c>DoTruncating</c></summary>
function DoFiltering(const Value: string): string; virtual;
///<summary>Maximum available text length filtering before calling <c>DoValidating</c></summary>
function DoTruncating(const Value: string): string; virtual;
///<summary>Validate inputing text. Calling before OnChangeTracking</summary>
function DoValidating(const Value: string): string; virtual;
function DoValidate(const Value: string): string; virtual;
procedure DoChangeTracking; virtual;
procedure DoChange; virtual;
procedure ResultTextSettingsChanged; virtual;
function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; virtual;
/// <summary>
/// This property indicates that the control is in validate value mode. See DoValidate, Change
/// </summary>
property Validating: Boolean read FValidating;
public
constructor Create; override;
destructor Destroy; override;
function HasSelection: Boolean;
function SelectedText: string;
procedure Change;
///<summary>Set text in model without text validation and sending notification to presenter</summary>
procedure SetTextWithoutValidation(const Value: string);
{ Editing }
///<summary>Insert text in memo after defined position</summary>
procedure InsertAfter(const APosition: Integer; const AFragment: string; const Options: TInsertOptions);
///<summary>Delete fragment of the text from the memo after defined position</summary>
procedure DeleteFrom(const APosition: Integer; const ALength: Integer; const Options: TDeleteOptions);
/// <summary>Replace fragment of text from the memo in the specifeid range.</summary>
procedure Replace(const APosition: Integer; const ALength: Integer; const AFragment: string);
function GetPositionShift(const APosition: Integer; const ADelta: Integer): Integer;
function GetNextWordBegin(const APosition: Integer): Integer;
function GetPrevWordBegin(const APosition: Integer): Integer;
{ Caret position }
procedure MoveCaretHorizontal(const ADelta: Integer);
procedure MoveCaretLeft;
procedure MoveCaretRight;
/// <summary>Returns caret position by specified hittest point.</summary>
/// <remarks>Works only for <c>TEdit.ControlType=Styled</c>.</remarks>
function GetCaretPositionByPoint(const AHitPoint: TPointF): Integer;
public
///<summary>Select all text when control getting focus</summary>
property AutoSelect: Boolean read FAutoSelect write SetAutoSelect;
property CaretPosition: Integer read FCaretPosition write SetCaretPosition;
property Caret: TCustomCaret read FCaret write SetCaret;
property CheckSpelling: Boolean read FCheckSpelling write SetCheckSpelling;
property FilterChar: string read FFilterChar write SetFilterChar;
///<summary>Do not draw selected text region when component not in focus</summary>
property HideSelectionOnExit: Boolean read FHideSelectionOnExit write SetHideSelectionOnExit default True;
///<summary>Text control is in read-only mode</summary>
property ReadOnly: Boolean read FReadOnly write SetReadOnly;
property ImeMode: TImeMode read FImeMode write SetImeMode;
property InputSupport: Boolean read FInputSupport write FInputSupport;
property KeyboardType : TVirtualkeyboardType read FKeyboardType write SetKeyboardType;
property KillFocusByReturn: Boolean read FKillFocusByReturn write SetKillFocusByReturn;
property MaxLength: Integer read FMaxLength write SetMaxLength;
property Password: Boolean read FPassword write SetPassword;
property ReturnKeyType: TReturnKeyType read FReturnKeyType write SetReturnKeyType;
property SelectionFill: TBrush read FSelectionFill write SetSelectionFill;
property SelStart: Integer read FSelStart write SetSelStart;
property SelLength: Integer read FSelLength write SetSelLength;
property Text: string read FText write SetText;
property TextSettingsInfo: TTextSettingsInfo read FTextSettingsInfo;
property TextPrompt: string read FTextPrompt write SetTextPrompt;
property Typing: Boolean read FTyping write SetTyping;
///<summary>Defines character case for text in component</summary>
property CharCase: TEditCharCase read FCharCase write SetCharCase;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChangeTracking: TNotifyEvent read FOnChangeTracking write FOnChangeTracking;
property OnTyping: TNotifyEvent read FOnTyping write FOnTyping;
property OnValidating: TValidateTextEvent read FOnValidating write FOnValidating;
property OnValidate: TValidateTextEvent read FOnValidate write FOnValidate;
end;
TCustomEdit = class;
TContentEdit = class(TContent)
private
function GetEdit: TCustomEdit;
protected
procedure DoRemoveObject(const AObject: TFmxObject); override;
procedure DoAddObject(const AObject: TFmxObject); override;
procedure DoInsertObject(Index: Integer; const AObject: TFmxObject); override;
public
constructor Create(AOwner: TComponent); override;
property Edit: TCustomEdit read GetEdit;
end;
TCustomEdit = class(TPresentedControl, ITextActions, IVirtualKeyboardControl, IItemsContainer, ITextSettings,
IReadOnly, ICaret)
private
FButtonsContent: TContentEdit;
FSavedReadOnly: Boolean;
FSavedMaxLength: Integer;
FSavedTextAlign: TTextAlign;
function GetAutoSelect: Boolean;
procedure SetAutoSelect(const Value: Boolean);
function GetOriginCaretPosition: Integer;
procedure SetSelText(const Value: string);
function GetSelText: string;
procedure SetSelLength(const Value: Integer);
function GetSelLength: Integer;
procedure SetSelStart(const Value: Integer);
function GetSelStart: Integer;
procedure SetCaretPosition(const Value: Integer);
function GetCaretPosition: Integer;
procedure SetCaret(const Value: TCustomCaret);
function GetCaret: TCustomCaret;
procedure SetPromptText(const Prompt: string);
function GetPromptText: string;
procedure SetOnChange(const Value: TNotifyEvent);
function GetOnChange: TNotifyEvent;
procedure SetOnChangeTracking(const Value: TNotifyEvent);
function GetOnChangeTracking: TNotifyEvent;
procedure SetMaxLength(const Value: Integer);
function GetMaxLength: Integer;
procedure SetPassword(const Value: Boolean);
function GetPassword: Boolean;
procedure SetOnTyping(const Value: TNotifyEvent);
function GetOnTyping: TNotifyEvent;
procedure SetKillFocusByReturn(const Value: Boolean);
function GetKillFocusByReturn: Boolean;
procedure SetCheckSpelling(const Value: Boolean);
function GetCheckSpelling: Boolean;
function GetSelectionFill: TBrush;
function GetCharCase: TEditCharCase;
procedure SetCharCase(const Value: TEditCharCase);
{ ITextSettings }
function GetDefaultTextSettings: TTextSettings;
function GetTextSettings: TTextSettings;
function GetResultingTextSettings: TTextSettings;
function GetStyledSettings: TStyledSettings;
procedure SetTextAlign(const Value: TTextAlign);
function GetTextAlign: TTextAlign;
procedure SetVertTextAlign(const Value: TTextAlign);
function GetVertTextAlign: TTextAlign;
procedure SetFont(const Value: TFont);
function GetFont: TFont;
procedure SetFontColor(const Value: TAlphaColor);
function GetFontColor: TAlphaColor;
function GetTyping: Boolean;
procedure SetTyping(const Value: Boolean);
function GetFilterChar: string;
procedure SetFilterChar(const Value: string);
function GetInputSupport: Boolean;
function GetModel: TCustomEditModel; overload;
function GetTextContentRect: TRectF;
function GetOnValidate: TValidateTextEvent;
function GetOnValidating: TValidateTextEvent;
procedure SetOnValidate(const Value: TValidateTextEvent);
procedure SetOnValidating(const Value: TValidateTextEvent);
procedure ReadReadOnly(Reader: TReader);
function GetHideSelectionOnExit: Boolean;
procedure SetHideSelectionOnExit(const Value: Boolean);
{ IReadOnly }
procedure SetReadOnly(const Value: Boolean);
function GetReadOnly: Boolean;
{ ICaret }
function ICaret.GetObject = GetCaret;
procedure ShowCaret;
procedure HideCaret;
protected
FClipboardSvc: IFMXExtendedClipboardService;
function GetData: TValue; override;
procedure SetData(const Value: TValue); override;
procedure Loaded; override;
function GetText: string; virtual;
procedure SetText(const Value: string); virtual;
procedure DoAddObject(const AObject: TFmxObject); override;
procedure DoInsertObject(Index: Integer; const AObject: TFmxObject); override;
procedure DoRemoveObject(const AObject: TFmxObject); override;
function GetImeMode: TImeMode; virtual;
procedure SetImeMode(const Value: TImeMode); virtual;
procedure SetInputSupport(const Value: Boolean); virtual;
procedure DefineProperties(Filer: TFiler); override;
function GetDefaultSize: TSizeF; override;
procedure Resize; override;
procedure RealignButtonsContainer; virtual;
function GetCanFocus: Boolean; override;
{ Live Binding }
function CanObserve(const ID: Integer): Boolean; override;
procedure ObserverAdded(const ID: Integer; const Observer: IObserver); override;
procedure ObserverToggle(const AObserver: IObserver; const Value: Boolean);
{ ITextSettings }
procedure SetTextSettings(const Value: TTextSettings); virtual;
procedure SetStyledSettings(const Value: TStyledSettings); virtual;
function StyledSettingsStored: Boolean; virtual;
{ IVirtualKeyboardControl }
procedure SetKeyboardType(Value: TVirtualKeyboardType);
function GetKeyboardType: TVirtualKeyboardType;
procedure SetReturnKeyType(Value: TReturnKeyType);
function GetReturnKeyType: TReturnKeyType;
function IVirtualKeyboardControl.IsPassword = GetPassword;
property InputSupport: Boolean read GetInputSupport write SetInputSupport;
{ IItemsContainer }
function GetItemsCount: Integer;
function GetItem(const AIndex: Integer): TFmxObject;
procedure ButtonsChanged; virtual;
protected
function DefineModelClass: TDataModelClass; override;
function DefinePresentationName: string; override;
public
property ControlType;
property Model: TCustomEditModel read GetModel;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SelectAll(const AKeepCaretPosition: Boolean); overload;
{ ITextActions }
procedure DeleteSelection;
procedure CopyToClipboard;
procedure CutToClipboard;
procedure PasteFromClipboard;
procedure SelectAll; overload;
procedure SelectWord;
procedure ResetSelection;
procedure GoToTextEnd;
procedure GoToTextBegin;
procedure Replace(const AStartPos: Integer; const ALength: Integer; const AStr: string);
function HasSelection: Boolean;
procedure Undo;
public
///<summary>Determines whether all the text in the edit is automatically selected when the control gets
///focus</summary>
property AutoSelect: Boolean read GetAutoSelect write SetAutoSelect;
property ButtonsContent: TContentEdit read FButtonsContent;
property Caret: TCustomCaret read GetCaret write SetCaret;
property CaretPosition: Integer read GetCaretPosition write SetCaretPosition;
property TextContentRect: TRectF read GetTextContentRect;
property CheckSpelling: Boolean read GetCheckSpelling write SetCheckSpelling default False;
property DefaultTextSettings: TTextSettings read GetDefaultTextSettings;
property Font: TFont read GetFont write SetFont;
property FontColor: TAlphaColor read GetFontColor write SetFontColor default TAlphaColorRec.Black;
property FilterChar: string read GetFilterChar write SetFilterChar;
property ImeMode: TImeMode read GetImeMode write SetImeMode default TImeMode.imDontCare;
property KeyboardType: TVirtualKeyboardType read GetKeyboardType write SetKeyboardType default TVirtualKeyboardType.Default;
property KillFocusByReturn: Boolean read GetKillFocusByReturn write SetKillFocusByReturn default False;
property MaxLength: Integer read GetMaxLength write SetMaxLength default 0;
///<summary>Determines whether to cancel the visual indication of the selected text when the focus moves to another
///control.</summary>
property HideSelectionOnExit: Boolean read GetHideSelectionOnExit write SetHideSelectionOnExit;
property Password: Boolean read GetPassword write SetPassword default False;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
property ReturnKeyType: TReturnKeyType read GetReturnKeyType write SetReturnKeyType default TReturnKeyType.Default;
property ResultingTextSettings: TTextSettings read GetResultingTextSettings;
property SelectionFill: TBrush read GetSelectionFill;
property SelStart: Integer read GetSelStart write SetSelStart;
property SelLength: Integer read GetSelLength write SetSelLength;
property SelText: string read GetSelText write SetSelText;
property StyledSettings: TStyledSettings read GetStyledSettings write SetStyledSettings stored StyledSettingsStored nodefault;
property Text: string read GetText write SetText;
property TextAlign: TTextAlign read GetTextAlign write SetTextAlign default TTextAlign.Leading;
property TextSettings: TTextSettings read GetTextSettings write SetTextSettings;
property TextPrompt: string read GetPromptText write SetPromptText;
property Typing: Boolean read GetTyping write SetTyping default False;
property VertTextAlign: TTextAlign read GetVertTextAlign write SetVertTextAlign default TTextAlign.Center;
///<summary>Defines whether to implement the 'UPPER' or 'lower' case conversion to the memo's text</summary>
property CharCase: TEditCharCase read GetCharCase write SetCharCase;
property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
property OnChangeTracking: TNotifyEvent read GetOnChangeTracking write SetOnChangeTracking;
property OnTyping: TNotifyEvent read GetOnTyping write SetOnTyping;
property OnValidating: TValidateTextEvent read GetOnValidating write SetOnValidating;
property OnValidate: TValidateTextEvent read GetOnValidate write SetOnValidate;
published
property Align;
property Anchors;
property StyleLookup;
property TabOrder;
property TabStop;
end;
{ TEditButton }
IEditControl = interface
['{4C7EE0A7-06EC-4515-B843-B608FB984468}']
function BoundsRect: TRectF;
function GetControl: TControl;
end;
TEditButton = class(TCustomButton, IEditControl)
protected
function GetDefaultStyleLookupName: string; override;
procedure SetName(const NewName: TComponentName); override;
function GetDefaultSize: TSizeF; override;
{ IEditControl }
function IEditControl.BoundsRect = GetBoundsRect;
function GetControl: TControl;
public
constructor Create(AOwner: TComponent); override;
function GetEdit: TCustomEdit;
published
property Action;
property Anchors;
property AutoTranslate default True;
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 Enabled default True;
property TextSettings;
property Font;
property Height;
property HelpContext;
property HelpKeyword;
property HelpType;
property Hint;
property HitTest default True;
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 StaysPressed default False;
property StyleLookup;
property TabOrder;
property Text;
property TextAlign default TTextAlign.Center;
property TouchTargetExpansion;
property Visible default True;
property Width;
property WordWrap default False;
property ParentShowHint;
property ShowHint;
{events}
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;
{ TClearEditButton }
TClearEditButton = class(TEditButton)
protected
procedure Click; override;
function GetDefaultStyleLookupName: string; override;
end;
{ TPasswordEditButton }
TPasswordEditButton = class(TEditButton)
protected
function GetDefaultStyleLookupName: string; override;
public
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Single; Y: Single); override;
end;
{ TSearchEditButton }
TSearchEditButton = class(TEditButton)
protected
function GetDefaultStyleLookupName: string; override;
end;
{ TEllipsesEditButton }
TEllipsesEditButton = class(TEditButton)
protected
function GetDefaultStyleLookupName: string; override;
end;
{ TDropDownEditButton }
TDropDownEditButton = class(TEditButton)
protected
function GetDefaultStyleLookupName: string; override;
end;
{ TSpinEditButton }
TSpinEditButton = class(TStyledControl, IEditControl)
private
FRepeatClick: Boolean;
{ Style }
FUpButton: TCustomButton;
FDownButton: TCustomButton;
{ Events }
FOnUpClick: TNotifyEvent;
FOnDownClick: TNotifyEvent;
procedure SetRepeatClick(const Value: Boolean);
protected
{ Style }
procedure ApplyStyle; override;
procedure FreeStyle; override;
function GetDefaultStyleLookupName: string; override;
function GetDefaultSize: TSizeF; override;
{ Events }
procedure DoUpButtonClick(Sender: TObject);
procedure DoDownButtonClick(Sender: TObject);
{ IEditControl }
function IEditControl.BoundsRect = GetBoundsRect;
function GetControl: TControl;
public
constructor Create(AOwner: TComponent); override;
published
property Anchors;
property AutoTranslate default True;
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 Enabled default True;
property Height;
property HelpContext;
property HelpKeyword;
property HelpType;
property Hint;
property HitTest default True;
property Locked default False;
property Padding;
property Opacity;
property Margins;
property PopupMenu;
property Position;
property RepeatClick: Boolean read FRepeatClick write SetRepeatClick default False;
property RotationAngle;
property RotationCenter;
property Scale;
property Size;
property StyleLookup;
property TabOrder;
property TouchTargetExpansion;
property Visible default True;
property Width;
property ParentShowHint;
property ShowHint;
{events}
property OnApplyStyleLookup;
property OnFreeStyle;
property OnDragEnter;
property OnDragLeave;
property OnDragOver;
property OnDragDrop;
property OnDragEnd;
property OnKeyDown;
property OnKeyUp;
property OnDownClick: TNotifyEvent read FOnDownClick write FOnDownClick;
property OnUpClick: TNotifyEvent read FOnUpClick write FOnUpClick;
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;
{ TEdit }
TEdit = class(TCustomEdit)
public
property Action;
published
property ControlType;
property OnPresentationNameChoosing;
{ inherited }
property AutoSelect default TCustomEditModel.DefaultAutoSelect;
property Cursor default crIBeam;
property CanFocus default True;
property CanParentFocus;
property DisableFocusEffect;
property KeyboardType;
property ReturnKeyType;
property Password;
property ReadOnly;
///<summary>Maxmimum length of text that can be input in the edit field.</summary>
///<remarks>On Android due to platform limitations text is truncated only after pressing ENTER key or after losing
///focus.</remarks>
property MaxLength;
property HideSelectionOnExit default TCustomEditModel.DefaultHideSelectionOnExit;
///<summary>Defines characters which can be input in the edit field. All characters not in FilterChar will be
///ignored. Empty FilterChar value means no filtering.</summary>
///<remarks>On Android due to platform limitations text is filtered only after pressing ENTER key or after control
///losing focus.</remarks>
property FilterChar;
property Text;
property TextSettings;
property ImeMode;
property Position;
property Width;
property Height;
property ClipChildren default False;
property ClipParent default False;
property DragMode default TDragMode.dmManual;
property EnableDragHighlight default True;
property Enabled default True;
property Locked default False;
property Hint;
property HitTest default True;
property HelpContext;
property HelpKeyword;
property HelpType;
property Padding;
property Opacity;
property Margins;
property PopupMenu;
property RotationAngle;
property RotationCenter;
property Scale;
property Size;
property TextPrompt;
property StyleLookup;
property StyledSettings;
property TouchTargetExpansion;
property Visible default True;
property Caret;
property KillFocusByReturn;
property CheckSpelling;
property ParentShowHint;
property ShowHint;
property CharCase default TCustomEditModel.DefaultCharCase;
{ events }
property OnChange;
property OnChangeTracking;
property OnTyping;
property OnApplyStyleLookup;
property OnFreeStyle;
property OnValidating;
property OnValidate;
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;
{ TClearingEdit }
TClearingEdit = class(TEdit)
protected
function DefinePresentationName: string; override;
function GetDefaultStyleLookupName: string; override;
public
constructor Create(AOwner: TComponent); override;
end deprecated 'Use TEdit with TClearEditButton';
//== INTERFACE END: FMX.Edit
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.Layouts (from FMX.Layouts.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
{ TLayout }
TLayout = class(TControl)
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Align;
property Anchors;
property ClipChildren;
property ClipParent;
property Cursor;
property DragMode;
property EnableDragHighlight;
property Enabled;
property Locked;
property Height;
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 TouchTargetExpansion;
property Visible;
property Width;
property ParentShowHint;
property ShowHint;
property TabOrder;
property TabStop;
{ Events }
property OnPainting;
property OnPaint;
property OnResize;
property OnResized;
{ 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;
end;
{ TScaledLayout }
TScaledLayout = class(TControl)
private
FOriginalWidth: Single;
FOriginalHeight: Single;
procedure SetOriginalWidth(const Value: Single);
procedure SetOriginalHeight(const Value: Single);
protected
procedure DoRealign; override;
function GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean; override;
procedure SetHeight(const Value: Single); override;
procedure SetWidth(const Value: Single); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Align;
property Anchors;
property ClipChildren;
property ClipParent;
property Cursor;
property DragMode;
property EnableDragHighlight;
property Enabled;
property Locked;
property Height;
property Hint;
property HitTest default False;
property Padding;
property Opacity;
property OriginalWidth: Single read FOriginalWidth write SetOriginalWidth;
property OriginalHeight: Single read FOriginalHeight write SetOriginalHeight;
property Margins;
property PopupMenu;
property Position;
property RotationAngle;
property RotationCenter;
property Scale;
property Size;
property TouchTargetExpansion;
property Visible;
property Width;
property ParentShowHint;
property ShowHint;
{ Events }
property OnPainting;
property OnPaint;
property OnResize;
property OnResized;
{ 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;
end;
TCustomScrollBox = class;
{ TScrollContent }
TScrollContent = class(TContent)
private
[Weak] FScrollBox: TCustomScrollBox;
FIsContentChanged: Boolean;
protected
function GetClipRect: TRectF; override;
function GetChildrenRect: 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 DoRealign; override;
procedure ContentChanged; override;
/// <summary> This flag is set in the method ContentChanged. Used to optimize ScrollBox </summary>
property IsContentChanged: Boolean read FIsContentChanged write FIsContentChanged;
public
constructor Create(AOwner: TComponent); override;
property ScrollBox: TCustomScrollBox read FScrollBox;
function PointInObjectLocal(X, Y: Single): Boolean; override;
end;
TScrollCalculations = class (TAniCalculations)
private
[Weak] FScrollBox: TCustomScrollBox;
protected
procedure DoChanged; override;
procedure DoStart; override;
procedure DoStop; override;
public
constructor Create(AOwner: TPersistent); override;
property ScrollBox: TCustomScrollBox read FScrollBox;
end;
{ TCustomScrollBox }
TPositionChangeEvent = procedure (Sender: TObject; const OldViewportPosition, NewViewportPosition: TPointF;
const ContentSizeChanged: Boolean) of object;
TOnCalcContentBoundsEvent = procedure (Sender: TObject; var ContentBounds: TRectF) of object;
TCustomScrollBox = class(TStyledControl)
private
const
SmallChangeFraction = 5;
DesignBorderColor: TAlphaColor = $80A070A0;
type
TScrollInfo = record
[Weak] Scroll: TScrollBar;
Align: TAlignLayout;
Margins: TRectF;
end;
var
FSystemInfoSrv: IFMXSystemInformationService;
FDisableMouseWheel: Boolean;
FAniCalculations: TScrollCalculations;
FLastViewportPosition: TPointF;
FInInternalAlign: Boolean;
FBackground: TControl;
FContent: TScrollContent;
FContentLayout: TControl;
FContentBounds: TRectF;
FCachedContentSize: TSizeF;
FCachedAutoShowing: Boolean;
FOriginalContentLayoutSize: TSizeF;
FShowScrollBars: Boolean;
FAutoHide: Boolean;
FHScrollInfo: array of TScrollInfo;
FVScrollInfo: array of TScrollInfo;
FContentMargins: TRectF;
FVDisablePaint: Boolean;
FHDisablePaint: Boolean;
FGDisablePaint: Boolean;
FSizeGripContent: TControl;
FSizeGripParent: TControl;
FSizeGrip: TControl;
FShowSizeGrip: Boolean;
FOnViewportPositionChange: TPositionChangeEvent;
FOnHScrollChange: TNotifyEvent;
FOnVScrollChange: TNotifyEvent;
FOnCalcContentBounds: TOnCalcContentBoundsEvent;
FMouseEvents: Boolean;
FContentCalculated: Boolean;
function HScrollIndex: Integer;
function VScrollIndex: Integer;
function GetHScrollAlign: TAlignLayout;
function GetVScrollAlign: TAlignLayout;
function GetHScrollMargins: TRectF;
function GetVScrollMargins: TRectF;
function GetSceneScale: Single;
procedure SetShowScrollBars(const Value: Boolean);
procedure SetShowSizeGrip(const Value: Boolean);
function GetVScrollBar: TScrollBar;
function GetHScrollBar: TScrollBar;
procedure UpdateSizeGrip;
procedure UpdateVScrollBar(const Value: Single; const ViewportSize: Single);
procedure UpdateHScrollBar(const Value: Single; const ViewportSize: Single);
procedure InternalAlign;
procedure HScrollChangeProc(Sender: TObject);
procedure VScrollChangeProc(Sender: TObject);
procedure MousePosToAni(var X, Y: Single);
procedure SetAutoHide(const Value: Boolean);
procedure SaveDisablePaint;
procedure RestoreDisablePaint;
procedure SetDisablePaint;
function GetViewportPosition: TPointF;
procedure SetViewportPosition(const Value: TPointF);
procedure StartScrolling;
procedure StopScrolling;
procedure UpdateOriginalContentLayoutSize(const Force: Boolean);
procedure ReadPartSize(Reader: TReader; var Size: Single);
procedure ReadContentLayoutHeight(Reader: TReader);
procedure ReadContentLayoutWidth(Reader: TReader);
procedure WriteContentLayoutHeight(Writer: TWriter);
procedure WriteContentLayoutWidth(Writer: TWriter);
protected
//Animation mouse events
procedure AniMouseDown(const Touch: Boolean; const X, Y: Single); virtual;
procedure AniMouseMove(const Touch: Boolean; const X, Y: Single); virtual;
procedure AniMouseUp(const Touch: Boolean; const X, Y: Single); virtual;
function GetScrollingBehaviours: TScrollingBehaviours;
procedure Loaded; override;
procedure PaddingChanged; override;
procedure DefineProperties(Filer: TFiler); override;
procedure DoAddObject(const AObject: TFmxObject); override;
procedure DoRealign; override;
function IsAddToContent(const AObject: TFmxObject): Boolean; virtual;
procedure ContentAddObject(const AObject: TFmxObject); virtual;
procedure ContentInsertObject(Index: Integer; const AObject: TFmxObject); virtual;
procedure ContentBeforeRemoveObject(AObject: TFmxObject); virtual;
procedure ContentRemoveObject(const AObject: TFmxObject); virtual;
procedure HScrollChange; virtual;
procedure VScrollChange; virtual;
procedure ViewportPositionChange(const OldViewportPosition, NewViewportPosition: TPointF;
const ContentSizeChanged: boolean); virtual;
procedure CMGesture(var EventInfo: TGestureEventInfo); override;
procedure Painting; override;
procedure AfterPaint; override;
procedure ApplyStyle; override;
procedure FreeStyle; override;
function IsOpaque: Boolean; virtual;
function ContentRect: TRectF;
function VScrollBarValue: Single;
function HScrollBarValue: Single;
function CreateScrollContent: TScrollContent; virtual;
function CreateAniCalculations: TScrollCalculations; virtual;
procedure DoUpdateAniCalculations(const AAniCalculations: TScrollCalculations); virtual;
procedure UpdateAniCalculations;
function DoCalcContentBounds: TRectF; virtual;
procedure DoRealignContent(R: TRectF); virtual;
function GetContentBounds: TRectF;
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;
procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
property ContentLayout: TControl read FContentLayout;
property Content: TScrollContent read FContent;
property HScrollAlign: TAlignLayout read GetHScrollAlign;
property VScrollAlign: TAlignLayout read GetVScrollAlign;
property HScrollMargins: TRectF read GetHScrollMargins;
property VScrollMargins: TRectF read GetVScrollMargins;
property InInternalAlign: Boolean read FInInternalAlign;
property HScrollBar: TScrollBar read GetHScrollBar;
property VScrollBar: TScrollBar read GetVScrollBar;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property AniCalculations: TScrollCalculations read FAniCalculations;
property ViewportPosition: TPointF read GetViewportPosition write SetViewportPosition;
procedure Sort(Compare: TFmxObjectSortCompare); override;
procedure Center;
procedure ScrollTo(const Dx, Dy: Single); deprecated 'use ScrollBy(const Dx, Dy: Single)';
procedure ScrollBy(const Dx, Dy: Single);
procedure InViewRect(const Rect: TRectF);
function ClientWidth: Single;
function ClientHeight: Single;
function GetTabList: ITabList; override;
property ContentBounds: TRectF read GetContentBounds;
procedure InvalidateContentSize;
procedure RealignContent;
property AutoHide: Boolean read FAutoHide write SetAutoHide default True;
property DisableMouseWheel: Boolean read FDisableMouseWheel write FDisableMouseWheel default False;
property ShowScrollBars: Boolean read FShowScrollBars write SetShowScrollBars default True;
property ShowSizeGrip: Boolean read FShowSizeGrip write SetShowSizeGrip default False;
property OnViewportPositionChange: TPositionChangeEvent read FOnViewportPositionChange write FOnViewportPositionChange;
property OnHScrollChange: TNotifyEvent read FOnHScrollChange write FOnHScrollChange;
property OnVScrollChange: TNotifyEvent read FOnVScrollChange write FOnVScrollChange;
property OnCalcContentBounds: TOnCalcContentBoundsEvent read FOnCalcContentBounds write FOnCalcContentBounds;
published
property Align;
property Anchors;
property ClipChildren;
property ClipParent;
property Cursor;
property DragMode;
property EnableDragHighlight;
property Enabled;
property Locked;
property Height;
property HelpContext;
property HelpKeyword;
property HelpType;
property Hint;
property HitTest;
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 OnPainting;
property OnPaint;
property OnResize;
property OnResized;
{ 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;
end;
{ TScrollBox }
TScrollBox = class(TCustomScrollBox)
protected
procedure Paint; override;
public
property Content;
published
property Align;
property Anchors;
property AutoHide;
property ClipChildren;
property ClipParent;
property Cursor;
property DisableMouseWheel;
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 ShowScrollBars;
property ShowSizeGrip;
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;
{ 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;
{ ScrollBox events }
property OnViewportPositionChange;
property OnHScrollChange;
property OnVScrollChange;
property OnCalcContentBounds;
end;
{ TVertScrollBox }
TVertScrollBox = class(TCustomScrollBox)
protected
function GetDefaultStyleLookupName: string; override;
function DoCalcContentBounds: TRectF; override;
procedure Paint; override;
procedure DoUpdateAniCalculations(const AAniCalculations: TScrollCalculations); override;
public
property Content;
published
property Align;
property Anchors;
property AutoHide;
property ClipChildren;
property ClipParent;
property Cursor;
property DisableMouseWheel;
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 ShowScrollBars;
property ShowSizeGrip;
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;
{ 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;
{ ScrollBox events }
property OnViewportPositionChange;
property OnVScrollChange;
property OnCalcContentBounds;
end;
{ THorzScrollBox }
THorzScrollBox = class(TCustomScrollBox)
protected
function GetDefaultStyleLookupName: string; override;
function DoCalcContentBounds: TRectF; override;
procedure Paint; override;
procedure DoUpdateAniCalculations(const AAniCalculations: TScrollCalculations); override;
public
property Content;
published
property Align;
property Anchors;
property AutoHide;
property ClipChildren;
property ClipParent;
property Cursor;
property DisableMouseWheel;
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 ShowScrollBars;
property ShowSizeGrip;
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;
{ 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;
{ ScrollBox events }
property OnViewportPositionChange;
property OnHScrollChange;
property OnCalcContentBounds;
end;
{ TFramedScrollBox }
TFramedScrollBox = class(TCustomScrollBox)
protected
function IsOpaque: Boolean; override;
public
property Content;
published
property Align;
property Anchors;
property AutoHide;
property ClipChildren;
property ClipParent;
property Cursor;
property DisableMouseWheel;
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 ShowScrollBars;
property ShowSizeGrip;
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;
{ 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;
{ ScrollBox events }
property OnViewportPositionChange;
property OnHScrollChange;
property OnVScrollChange;
property OnCalcContentBounds;
end;
{ TFramedVertScrollBox }
TFramedVertScrollBox = class(TVertScrollBox)
protected
function IsOpaque: Boolean; override;
function GetDefaultStyleLookupName: string; override;
end;
{ TGridLayout }
TGridLayout = class(TControl)
private
FItemWidth: Single;
FItemHeight: Single;
FOrientation: TOrientation;
procedure SetItemHeight(const Value: Single);
procedure SetItemWidth(const Value: Single);
procedure SetOrientation(const Value: TOrientation);
protected
procedure DoRealign; override;
procedure DoAddObject(const AObject: TFmxObject); override;
procedure DoRemoveObject(const AObject: TFmxObject); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Align;
property Anchors;
property ClipChildren;
property ClipParent;
property Cursor;
property DragMode;
property EnableDragHighlight;
property Enabled;
property Locked;
property Height;
property Hint;
property HitTest;
property ItemHeight: Single read FItemHeight write SetItemHeight;
property ItemWidth: Single read FItemWidth write SetItemWidth;
property Padding;
property Opacity;
property Orientation: TOrientation read FOrientation write SetOrientation;
property Margins;
property PopupMenu;
property Position;
property RotationAngle;
property RotationCenter;
property Scale;
property Size;
property TouchTargetExpansion;
property Visible;
property Width;
property TabOrder;
property TabStop;
property ParentShowHint;
property ShowHint;
{Drag and Drop events}
property OnDragEnter;
property OnDragLeave;
property OnDragOver;
property OnDragDrop;
property OnDragEnd;
property OnCanFocus;
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;
{ TGridPanelLayout }
TGridPanelLayout = class(TControl)
public type
TSizeStyle = (Absolute, Percent, Auto, Weight);
EGridLayoutException = class(Exception);
TCellItem = class(TCollectionItem)
private
FSizeStyle: TSizeStyle;
FValue: Double;
FSize: Single;
FAutoAdded: Boolean;
protected
procedure AssignTo(Dest: TPersistent); override;
procedure SetSizeStyle(Value: TSizeStyle);
procedure SetValue(Value: Double);
property Size: Single read FSize write FSize;
property AutoAdded: Boolean read FAutoAdded write FAutoAdded;
public
constructor Create(Collection: TCollection); override;
published
property SizeStyle: TSizeStyle read FSizeStyle write SetSizeStyle default TSizeStyle.Percent;
property Value: Double read FValue write SetValue;
end;
TRowItem = class(TCellItem);
TColumnItem = class(TCellItem);
TCellCollection = class(TOwnedCollection)
protected
function GetAttrCount: Integer; override;
function GetAttr(Index: Integer): string; override;
function GetItemAttr(Index, ItemIndex: Integer): string; override;
function GetItem(Index: Integer): TCellItem;
procedure SetItem(Index: Integer; Value: TCellItem);
procedure Update(Item: TCollectionItem); override;
public
function Owner: TGridPanelLayout;
property Items[Index: Integer]: TCellItem read GetItem write SetItem; default;
end;
TCellSpan = 1..MaxInt;
TRowCollection = class(TCellCollection)
protected
function GetItemAttr(Index, ItemIndex: Integer): string; override;
procedure Notify(Item: TCollectionItem; Action: System.Classes.TCollectionNotification); override;
public
constructor Create(AOwner: TPersistent);
function Add: TRowItem;
end;
TColumnCollection = class(TCellCollection)
protected
function GetItemAttr(Index, ItemIndex: Integer): string; override;
procedure Notify(Item: TCollectionItem; Action: System.Classes.TCollectionNotification); override;
public
constructor Create(AOwner: TPersistent);
function Add: TColumnItem;
end;
TControlItem = class(TCollectionItem)
private
[Weak] FControl: TControl;
FColumn, FRow: Integer;
FColumnSpan, FRowSpan: TCellSpan;
FPushed: Integer;
function GetGridPanelLayout: TGridPanelLayout;
function GetPushed: Boolean;
procedure SetColumn(Value: Integer);
procedure SetColumnSpan(Value: TCellSpan);
procedure SetControl(Value: TControl);
procedure SetRow(Value: Integer);
procedure SetRowSpan(Value: TCellSpan);
protected
procedure AssignTo(Dest: TPersistent); override;
procedure InternalSetLocation(AColumn, ARow: Integer; APushed: Boolean; MoveExisting: Boolean);
property GridPanelLayout: TGridPanelLayout read GetGridPanelLayout;
property Pushed: Boolean read GetPushed;
public
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure SetLocation(AColumn, ARow: Integer; APushed: Boolean = False);
published
property Column: Integer read FColumn write SetColumn;
property ColumnSpan: TCellSpan read FColumnSpan write SetColumnSpan default 1;
property Control: TControl read FControl write SetControl;
property Row: Integer read FRow write SetRow;
property RowSpan: TCellSpan read FRowSpan write SetRowSpan default 1;
end;
TControlCollection = class(TOwnedCollection)
protected
function GetControl(AColumn, ARow: Integer): TControl;
function GetControlItem(AColumn, ARow: Integer): TControlItem;
function GetItem(Index: Integer): TControlItem;
procedure SetControl(AColumn, ARow: Integer; Value: TControl);
procedure SetItem(Index: Integer; Value: TControlItem);
procedure Update(Item: TCollectionItem); override;
public
constructor Create(AOwner: TPersistent);
function Add: TControlItem;
procedure AddControl(AControl: TControl; AColumn: Integer = -1; ARow: Integer = -1);
procedure RemoveControl(AControl: TControl);
function IndexOf(AControl: TControl): Integer;
function Owner: TGridPanelLayout;
property Controls[AColumn, ARow: Integer]: TControl read GetControl write SetControl;
property ControlItems[AColumn, ARow: Integer] : TControlItem read GetControlItem;
property Items[Index: Integer]: TControlItem read GetItem write SetItem; default;
end;
TLayoutManager = class
private type
TCollectionInfo = record
FlexibleSize: Single;
WeightSum: Single;
WeightCount: Integer;
PercentageSum: Single;
PercentageCount: Integer;
end;
private
FOwner: TGridPanelLayout;
function CalculateMaxWidth(const AColumn: Integer): Single;
function CalculateMaxHeight(const ARow: Integer): Single;
function CollectColumnsInfo(const AWidth: Single): TCollectionInfo;
function CollectRowsInfo(const AHeight: Single): TCollectionInfo;
procedure NormalizePercentages(const ACollection: TCellCollection; const AInfo: TCollectionInfo; const ABaseCell: TCellItem = nil);
function ShouldNormalizePercentages(const ACollectionInfo: TCollectionInfo): Boolean;
procedure RealignItems(const ACollection: TCellCollection; const AInfo: TCollectionInfo; const ABaseCell: TCellItem = nil);
public
constructor Create(const AOwner: TGridPanelLayout);
procedure RecalcCellDimensions(const ARect: TRectF; const ABasedRow: TRowItem = nil; const ABasedColumn: TColumnItem = nil);
end;
TExpandStyle = (AddRows, AddColumns, FixedSize);
TState = (NeedRecalculateCellSizes, RecalculatingCellSizes);
TStates = set of TState;
private
FState: TStates;
FExpandStyle: TExpandStyle;
FRowCollection: TRowCollection;
FColumnCollection: TColumnCollection;
FControlCollection: TControlCollection;
FLayoutManager: TLayoutManager;
procedure SetColumnCollection(const Value: TColumnCollection);
procedure SetControlCollection(const Value: TControlCollection);
procedure SetRowCollection(const Value: TRowCollection);
function GetCellCount: Integer;
function GetCellSizes(AColumn, ARow: Integer): TPointF;
function GetCellRect(AColumn, ARow: Integer): TRectF;
function GetColumnSpanIndex(AColumn, ARow: Integer): Integer;
function GetRowSpanIndex(AColumn, ARow: Integer): Integer;
procedure NeedRecalculateCellSizes;
procedure RecalcCellDimensions(const ABasedRow: TRowItem = nil; const ABasedColumn: TColumnItem = nil); overload;
procedure RecalcCellDimensions(const ARect: TRectF; const ABasedRow: TRowItem = nil; const ABasedColumn: TColumnItem = nil); overload;
protected
procedure DoRealign; override;
procedure DoAddObject(const AObject: TFmxObject); override;
procedure DoRemoveObject(const AObject: TFmxObject); override;
procedure DoDeleteChildren; override;
function AutoAddColumn: TColumnItem;
function AutoAddRow: TRowItem;
procedure RemoveEmptyAutoAddColumns;
procedure RemoveEmptyAutoAddRows;
function CellToCellIndex(AColumn, ARow: Integer): Integer;
procedure CellIndexToCell(AIndex: Integer; var AColumn, ARow: Integer);
procedure DoPaint; override;
procedure Resize; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function IsColumnEmpty(AColumn: Integer): Boolean;
function IsRowEmpty(ARow: Integer): Boolean;
procedure UpdateControlsColumn(AColumn: Integer);
procedure UpdateControlsRow(ARow: Integer);
property ColumnSpanIndex[AColumn, ARow: Integer]: Integer read GetColumnSpanIndex;
property CellCount: Integer read GetCellCount;
property CellSize[AColumn, ARow: Integer]: TPointF read GetCellSizes;
property CellRect[AColumn, ARow: Integer]: TRectF read GetCellRect;
property RowSpanIndex[AColumn, ARow: Integer]: Integer read GetRowSpanIndex;
published
property Align;
property Anchors;
property ClipChildren;
property ClipParent;
property Cursor;
property DragMode;
property EnableDragHighlight;
property Enabled;
property Locked;
property Height;
property Hint;
property HitTest;
property Padding;
property Opacity;
property Margins;
property PopupMenu;
property Position;
property RotationAngle;
property RotationCenter;
property Scale;
property Size;
property TouchTargetExpansion;
property Visible;
property Width;
property TabOrder;
property TabStop;
property ParentShowHint;
property ShowHint;
{ Columns and rows }
property ColumnCollection: TColumnCollection read FColumnCollection write SetColumnCollection;
property ControlCollection: TControlCollection read FControlCollection write SetControlCollection;
property ExpandStyle: TExpandStyle read FExpandStyle write FExpandStyle default TExpandStyle.AddRows;
property RowCollection: TRowCollection read FRowCollection write SetRowCollection;
{Drag and Drop events}
property OnDragEnter;
property OnDragLeave;
property OnDragOver;
property OnDragDrop;
property OnDragEnd;
property OnCanFocus;
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;
TFlowJustify = (Left, Right, Center, Justify);
TFlowDirection = (LeftToRight, RightToLeft);
TFlowLayoutRules = record
Justify: TFlowJustify;
JustifyLast: TFlowJustify;
Direction: TFlowDirection;
HorizontalGap: Single;
VerticalGap: Single;
end;
TFlowLayoutBreak = class(TControl)
private
FRules: TFlowLayoutRules;
FChangesRules: Boolean;
protected
procedure SetChangesRules(AChangesRules: Boolean);
procedure Paint; override;
function VisibleStored: Boolean; override;
public
constructor Create(AOwner: TComponent); override;
published
property ChangesRules: Boolean read FChangesRules write SetChangesRules;
property Justify: TFlowJustify read FRules.Justify write FRules.Justify;
property JustifyLastLine: TFlowJustify read FRules.JustifyLast write FRules.JustifyLast;
property FlowDirection: TFlowDirection read FRules.Direction write FRules.Direction;
property HorizontalGap: Single read FRules.HorizontalGap write FRules.HorizontalGap;
property VerticalGap: Single read FRules.VerticalGap write FRules.VerticalGap;
property Visible;
end;
TFlowLayout = class(TControl, IContentObserver)
private
FRules: TFlowLayoutRules;
protected
procedure DoRealign; override;
procedure DoAddObject(const AObject: TFmxObject); override;
procedure DoRemoveObject(const AObject: TFmxObject); override;
procedure Paint; override;
procedure SetJustify(AJustify: TFlowJustify);
procedure SetJustifyLast(AJustify: TFlowJustify);
procedure SetFlowDirection(ADirection: TFlowDirection);
procedure SetHGap(AHGap: Single);
procedure SetVGap(AVGap: Single);
{ IContentObserver }
procedure IContentObserver.Changed = ContentChanged;
procedure ContentChanged(const AChild: TFmxObject); virtual;
public
constructor Create(AOwner: TComponent); override;
published
property Align;
property Anchors;
property ClipChildren;
property ClipParent;
property Cursor;
property DragMode;
property EnableDragHighlight;
property Enabled;
property Locked;
property Height;
property Hint;
property HitTest;
property Padding;
property Opacity;
property Margins;
property PopupMenu;
property Position;
property RotationAngle;
property RotationCenter;
property Scale;
property Size;
property TouchTargetExpansion;
property Visible;
property Width;
property TabOrder;
property TabStop;
property Justify : TFlowJustify read FRules.Justify write SetJustify;
property JustifyLastLine : TFlowJustify read FRules.JustifyLast write SetJustifyLast;
property FlowDirection : TFlowDirection read FRules.Direction write SetFlowDirection;
property HorizontalGap : Single read FRules.HorizontalGap write SetHGap;
property VerticalGap : Single read FRules.VerticalGap write SetVGap;
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;
//== INTERFACE END: FMX.Layouts
//==================================================================================================
//==================================================================================================
//== INTERFACE 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;
/// <summary>Event type for notification about ScrollBox changed position of content</summary>
TPositionChangeEvent = procedure (Sender: TObject; const OldViewportPosition, NewViewportPosition: TPointF;
const ContentSizeChanged: Boolean) of object;
/// <summary>Event type for correcting content size, which was calculated automatically.</summary>
TOnCalcContentBoundsEvent = procedure (Sender: TObject; var ContentBounds: TRectF) of object;
/// <summary>Stores the settings of scrolling behavior of ScrollBox's content.</summary>
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
/// <summary>Notifies abount changes properties.</summary>
procedure DoChanged; virtual;
/// <summary>Copies the data to destination <c>TScrollContentSize</c>.</summary>
procedure AssignTo(Dest: TPersistent); override;
/// <summary>Returns option's owner.</summary>
function GetOwner: TPersistent; override;
public
/// <summary>Constructs object, extract from <c>AOwner</c> TCustomScrollBox and sets internal event handler
/// <c>OnChange</c></summary>
constructor Create(AOwner: TComponent; const AOnChange: TNotifyEvent);
/// <summary>Event, which is invoked, when size was changed</summary>
property OnChange: TNotifyEvent read FOnInternalChange;
published
///<summary>Defines that scrollbars are automatically hiding when scroll is done</summary>
property AutoHideScrollBars: TBehaviorBoolean read FAutoHideScrollBars write SetAutoHideScrollBars default DefaultAutoHideScrollBars;
///<summary>Whether it is possible to scroll of content abroad</summary>
property Bounces: TBehaviorBoolean read FBounces write SetBounces;
///<summary>Enable or disabled scroll</summary>
property EnabledScroll: Boolean read FEnabledScroll write SetEnabledScroll;
///<summary>Enable or disabled scrolling animation</summary>
property ScrollAnimation: TBehaviorBoolean read FScrollAnimation write SetScrollAnimation default DefaultScrollAnimation;
///<summary>Defines that control reacts on touch events</summary>
property TouchTracking: TBehaviorBoolean read FTouchTracking write SetTouchTracking default DefaultTouchTracking;
end;
/// <summary>Stores the size of the ScrollBox content.</summary>
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
/// <summary>Notifies abount changed size (Width, Height)</summary>
procedure DoChanged; virtual;
/// <summary>Copies the data to destination <c>TScrollContentSize</c></summary>
procedure AssignTo(Dest: TPersistent); override;
/// <summary>Returns owenr of the Data</summary>
function GetOwner: TPersistent; override;
/// <summary>Sets size without checks on <c>AutoCalculateContentSize</c>. Ignores <c>IsReadOnly</c></summary>
procedure SetSizeWithoutChecks(const Value: TSizeF);
public
/// <summary>Constructs object, extract from <c>AOwner</c> TCustomScrollBox and sets internal event handler
/// <c>OnChange</c></summary>
constructor Create(AOwner: TComponent; const AOnChange: TNotifyEvent);
/// <summary>Checks can we set size or not. It depends on <c>TPresentedScrollBox.AutoCalculateContentSize</c></summary>
function IsReadOnly: Boolean;
/// <summary>Link on Owner ScrollBox</summary>
property ScrollBox: TCustomPresentedScrollBox read FScrollBox;
/// <summary>Size of content</summary>
property Size: TSizeF read GetSize write SetSize;
/// <summary>Event, which is invoked, when size was changed</summary>
property OnChange: TNotifyEvent read FOnInternalChange;
published
/// <summary>Width of content</summary>
property Width: Single read FWidth write SetWidth stored StoreWidthHeight;
/// <summary>Height of content</summary>
property Height: Single read FHeight write SetHeight stored StoreWidthHeight;
end;
/// <summary>Directions of content scroll</summary>
TScrollDirections = (Both, Horizontal, Vertical);
/// <summary>Model of TScrollBox data.</summary>
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;
///<summary>Invoked, when ScrollBox changed content position or size</summary>
procedure DoViewportPositionChange(const OldViewportPosition, NewViewportPosition: TPointF; const ContentSizeChanged: Boolean); virtual;
/// <summary>Need ScrollBox updates effects, when content is scrolled? (False by default)</summary>
function IsOpaque: Boolean;
///<summary>Returns current content bounds. If content bounds size is calculati</summary>
property ContentBounds: TRectF read GetContentBounds write SetContentBounds;
///<summary>Defines that scrollbars are automatically hiding when scroll is done</summary>
property AutoHide: TBehaviorBoolean read FAutoHide write SetAutoHide;
///<summary>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 <c>ContentSize</c> property</summary>
property AutoCalculateContentSize: Boolean read FAutoCalculateContentSize write FAutoCalculateContentSize;
///<summary>Whether it is possible to scroll of content abroad</summary>
property Bounces: TBehaviorBoolean read FBounces write SetBounces;
///<summary>Current content size</summary>
property ContentSize: TScrollContentSize read FContentSize write SetContentSize;
///<summary>Defines that control has no reaction on <c>MouseWheel</c> event</summary>
property DisableMouseWheel: Boolean read FDisableMouseWheel write SetDisableMouseWheel;
///<summary>Enable or disabled scroll</summary>
property EnabledScroll: Boolean read FEnabledScroll write SetEnabledScroll;
///<summary>Enable or disabled scrolling animation</summary>
property ScrollAnimation: TBehaviorBoolean read FScrollAnimation write SetScrollAnimation;
///<summary>Defines avaiable scroll directions</summary>
property ScrollDirections: TScrollDirections read FScrollDirections write SetScrollDirections;
///<summary>Defines scrollbars visibility</summary>
property ShowScrollBars: Boolean read FShowScrollBars write SetShowScrollBars;
///<summary>Shows small control in the right-bottom corner that represent size changin control</summary>
property ShowSizeGrip: Boolean read FShowSizeGrip write SetShowSizeGrip;
///<summary>Defines that control reacts on touch events</summary>
property TouchTracking: TBehaviorBoolean read FTouchTracking write SetTouchTracking;
///<summary>Position of top-left point of view port at the ScrollBox's content. It is set in local coordinates of <c>Content</c></summary>
property ViewportPosition: TPointF read GetViewportPosition write SetViewportPosition;
///<summary>Returns the size of displaing area</summary>
property ViewportSize: TSizeF read GetViewportSize;
///<summary>Event that raises after control calculates its content size</summary>
///<remarks>Raises only when <c>AutoCalculateContentSize</c> is true</remarks>
property OnCalcContentBounds: TOnCalcContentBoundsEvent read FOnCalcContentBounds write FOnCalcContentBounds;
///<summary>Raises when the value of ViewportPosition was changed</summary>
property OnViewportPositionChange: TPositionChangeEvent read FOnViewportPositionChange write FOnViewportPositionChange;
end;
/// <summary>Container for the child controls of the scroll box.</summary>
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
///<summary>Link to the ScrollBox that owns currect content instance</summary>
property ScrollBox: TCustomPresentedScrollBox read FScrollBox;
/// <summary> The handler for this event should return the clip rectangle </summary>
property OnGetClipRect: TOnCalcContentBoundsEvent read FOnGetClipRect write FOnGetClipRect;
end;
///<summary>Component allows view large content within a smaller visible area</summary>
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 }
/// <summary>Create scroll content. Successors can override it for creating custom content. It allows add custom
/// information to content.</summary>
function CreateScrollContent: TScrollContent; virtual;
/// <summary>Performs filtering of adding objects and redirects adding of object to <c>Content</c>, if AObject is not
/// Effect, Animation or Style Object</summary>
/// <remarks>It uses <c>IsObjectForContent</c> for defining content's object</remarks>
procedure DoAddObject(const AObject: TFmxObject); override;
/// <summary>Performs filtering of inserting objects and redirects inserting of object to <c>Content</c>, if AObject
/// is not Effect, Animation or Style Object</summary>
/// <remarks>It uses <c>IsObjectForContent</c> for defining content's object</remarks>
procedure DoInsertObject(Index: Integer; const AObject: TFmxObject); override;
/// <summary>Remove object from <c>Content</c> or <c>Children</c> list</summary>
procedure DoRemoveObject(const AObject: TFmxObject); override;
{ Painting }
procedure PaintChildren; override;
{ Content }
/// <summary>Calculates content bounds by building convex shell of all children controls of <c>Content</c></summary>
/// <remarks>If ScrollBox uses Horizontal or Vertical <c>ScrollDirections</c> mode, It restricts the content size by
/// height or width</remarks>
function DoCalcContentBounds: TRectF; virtual;
/// <summary>Defines, need to add AObject to Content or not.</summary>
function IsAddToContent(const AObject: TFmxObject): Boolean; virtual;
/// <summary>Invoked, when new Object was added into Content's childrens list.</summary>
procedure ContentAddObject(const AObject: TFmxObject); virtual;
/// <summary>Invoked, when new Object was inserted into Content's childrens list.</summary>
procedure ContentInsertObject(Index: Integer; const AObject: TFmxObject); virtual;
/// <summary>Invoked before removing Object from Content's childrens list.</summary>
procedure ContentBeforeRemoveObject(AObject: TFmxObject); virtual;
/// <summary>Invoked, when Object was removed from Content's childrens list.</summary>
procedure ContentRemoveObject(const AObject: TFmxObject); virtual;
{ Events }
/// <summary>Need ScrollBox updates effects, when content is scrolled? (False by default)</summary>
function IsOpaque: Boolean; virtual;
/// <summary>Defines custom readers and writers for control properties for backward compatibility</summary>
procedure DefineProperties(Filer: TFiler); override;
///<summary>Returns instance of class that provide scrolling physics calculations</summary>
///<remarks>Exists only for style presentation. For native presentation returns nil.</remarks>
property AniCalculations: TAniCalculations read GetAniCalculations;
{ Design Time Only }
/// <summary>Scrolls content in design time only</summary>
procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
protected
/// <summary>Defines a Model class (<c>TDataModelClass</c> by default) of <c>TScrollBox</c></summary>
function DefineModelClass: TDataModelClass; override;
/// <summary>Initializes presentation</summary>
procedure InitPresentation(APresentation: TPresentationProxy); override;
public
constructor Create(AOwner: TComponent); override;
///<summary>Change scroll position by offset defined in <c>ADX</c> and <c>ADY</c></summary>
procedure ScrollBy(const ADX, ADY: Single; const AAnimated: Boolean = True);
///<summary>Change scroll position to value defined in <c>AX</c> and <c>AY</c></summary>
procedure ScrollTo(const AX, AY: Single; const AAnimated: Boolean = True);
///<summary>Change scroll position to the top</summary>
procedure ScrollToTop(const AAnimated: Boolean = True);
///<summary>Change scroll position to the center of content size</summary>
procedure ScrollToCenter(const AAnimated: Boolean = True);
///<summary>Scrolls content to rectange defined in <c>ARect</c></summary>
procedure InViewRect(const ARect: TRectF; const AAnimated: Boolean = True);
/// <summary>Sorts children of <c>Content</c></summary>
procedure Sort(Compare: TFmxObjectSortCompare); override;
/// <summary>Returns <c>TabList</c> of <c>Content</c></summary>
function GetTabList: ITabList; override;
{ Update Content Size }
/// <summary>Recalculates content bounds. If you use the manual calcualting of <c>ContentBounds</c>, you need to set
/// through <c>ContentBounds</c></summary>
/// <remarks>This method doesn't calculate content bounds, if we don't use mode of auto calculating
/// (<c>AutoCalculateContentSize = False</c>) or control is being loaded or destroyed
/// (ComponentState = csLoading or csDestroying)</remarks>
procedure UpdateContentSize;
///<summary>Force content size calculation update</summary>
procedure RealignContent;
/// <summary>Content of ScrollBox. Contains controls placed into TScrollBox</summary>
/// <remarks>Doesn't contain Style object, any kinds of Animation's and effect's objects</remarks>
property Content: TScrollContent read FContent;
/// <summary>Returns current content bounds</summary>
property ContentBounds: TRectF read GetContentBounds write SetContentBounds;
/// <summary>Removes all controls from content</summary>
procedure ClearContent;
/// <summary>Model of TScrollBox</summary>
property Model: TCustomScrollBoxModel read GetModel;
///<summary>Position of view port of the ScrollBox's content. It is set in local coordinates of <c>Content</c></summary>
property ViewportPosition: TPointF read GetViewportPosition write SetViewportPosition;
/// <summary>Size of view port of the ScrollBox's content.</summary>
property ViewportSize: TSizeF read GetViewportSize;
{ Deprecated }
///<summary>Returns vertical scrollbar component</summary>
///<remarks>Available only for styled presentation. For native presentation returns <c>nil</c></remarks>
property VScrollBar: TScrollBar read GetVScrollBar;
///<summary>Returns horisontal scrollbar component</summary>
///<remarks>Available only for styled presentation. For native presentation returns <c>nil</c></remarks>
property HScrollBar: TScrollBar read GetHScrollBar;
///<summary>Returns control from style that is a surface for content in the scrollbox</summary>
property ContentLayout: TControl read GetContentLayout;
public
///<summary>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 <c>ContentSize</c> property</summary>
property AutoCalculateContentSize: Boolean read GetCalculateContentSize write SetCalculateContentSize default True;
///<summary>Defines that scrollbars are automatically hiding when scroll is done</summary>
property AutoHide: TBehaviorBoolean read GetAutoHide write SetAutoHide default TBehaviorBoolean.PlatformDefault;
///<summary>Whether it is possible to scroll of content abroad</summary>
property Bounces: TBehaviorBoolean read GetBounces write SetBounces default TBehaviorBoolean.PlatformDefault;
///<summary>Current content size</summary>
property ContentSize: TScrollContentSize read GetContentSize write SetContentSize;
///<summary>Defines that control has no reaction on <c>MouseWheel</c> event</summary>
property DisableMouseWheel: Boolean read GetDisableMouseWheel write SetDisableMouseWheel default False;
///<summary>Enable or disabled scroll</summary>
property EnabledScroll: Boolean read GetEnabledScroll write SetEnabledScroll default True;
///<summary>Enable or disabled scrolling animation</summary>
property ScrollAnimation: TBehaviorBoolean read GetScrollAnimation write SetScrollAnimation default TBehaviorBoolean.PlatformDefault;
///<summary>Defines avaiable scroll directions</summary>
property ScrollDirections: TScrollDirections read GetScrollDirections write SetScrollDirections default TScrollDirections.Both;
///<summary>Defines scrollbars visibility</summary>
property ShowScrollBars: Boolean read GetShowScrollBars write SetShowScrollBars default True;
///<summary>Shows small control in the right-bottom corner that represent size changin control</summary>
property ShowSizeGrip: Boolean read GetShowSizeGrip write SetShowSizeGrip default False;
///<summary>Defines that control reacts on touch events</summary>
property TouchTracking: TBehaviorBoolean read GetTouchTracking write SetTouchTracking default TBehaviorBoolean.PlatformDefault;
///<summary>Event that raises after control calculates its content size</summary>
///<remarks>Raises only when <c>AutoCalculateContentSize</c> is true</remarks>
property OnCalcContentBounds: TOnCalcContentBoundsEvent read GetOnCalcContentBounds write SetOnCalcContentBounds;
///<summary>Raises when the value of ViewportPosition was changed</summary>
property OnViewportPositionChange: TPositionChangeEvent read GetOnViewportPositionChange write SetOnViewportPositionChange;
end;
/// <summary>A base scrollbox component available at design time.</summary>
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 }
/// <summary>Scrollbox with vertical scroll support only.</summary>
TCustomPresentedVertScrollBox = class(TCustomPresentedScrollBox)
protected
function GetDefaultStyleLookupName: string; override;
public
constructor Create(AOwner: TComponent); override;
end;
/// <summary>Scrollbox without border, with vertical scroll only.</summary>
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 }
/// <summary>Scrollbox with horizontal scroll support only.</summary>
TCustomPresentedHorzScrollBox = class(TCustomPresentedScrollBox)
protected
function GetDefaultStyleLookupName: string; override;
public
constructor Create(AOwner: TComponent); override;
end;
/// <summary>Scrollbox without border, with horizontal scroll only</summary>
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 }
/// <summary>Scrollbox without border.</summary>
TCustomPresentedFramedScrollBox = class(TCustomPresentedScrollBox)
protected
function IsOpaque: Boolean; override;
end;
/// <summary>Desing-time scrollbox without border.</summary>
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 }
/// <summary>Design-time scrollbox that only supports vertical scrolling.</summary>
TCustomPresentedFramedVertScrollBox = class(TCustomPresentedVertScrollBox)
protected
function IsOpaque: Boolean; override;
function GetDefaultStyleLookupName: string; override;
end;
/// <summary>Scrollbox with vertical scroll only.</summary>
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;
/// <summary>Normalizes the target rectangle AContentRect.</summary>
function NormalizeInViewRect(const AContentRect: TRectF; const AViewportSize: TSizeF; const AWishedViewPortRect: TRectF): TRectF;
//== INTERFACE END: FMX.ScrollBox
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.ListView.Adapters.Base (from FMX.ListView.Adapters.Base.pas)
//==================================================================================================
type
TAbstractListViewAdapter = class abstract (TInterfacedPersistent)
strict private
FUpdatingCount: Integer;
FOnChanged: TNotifyEvent;
FOnItemsMayChange: TNotifyEvent;
FOnItemsCouldHaveChanged: TNotifyEvent;
FOnItemsInvalidate: TNotifyEvent;
FOnItemsResize: TNotifyEvent;
FOnResetView: TNotifyEvent;
strict protected
procedure CreateNewViews;
procedure DoCreateNewViews; virtual;
procedure ResetViews(const APurposes: TListItemPurposes);
procedure DoResetViews(const APurposes: TListItemPurposes); virtual;
procedure ResetView(const Item: TListItem);
procedure DoResetView(const Item: TListItem); virtual;
procedure DoSort(AComparer: IComparer<TListItem>); virtual;
procedure SetOnChanged(const Value: TNotifyEvent);
procedure SetOnItemsMayChange(const Value: TNotifyEvent);
procedure SetOnItemsCouldHaveChanged(const Value: TNotifyEvent);
procedure SetOnItemsInvalidate(const Value: TNotifyEvent);
procedure SetOnItemsResize(const Value: TNotifyEvent);
procedure SetOnResetView(const Value: TNotifyEvent);
/// <summary>It's invoked when updating process is finished.</summary>
procedure DoEndUpdate; virtual;
public
procedure Changed; virtual;
procedure ItemsMayChange;
procedure ItemsCouldHaveChanged;
procedure ItemsInvalidate;
procedure ItemsResize;
procedure BeginUpdate;
procedure EndUpdate;
function IsUpdating: Boolean;
procedure Sort(AComparer: IComparer<TListItem>);
property OnChanged: TNotifyEvent write SetOnChanged;
property OnItemsMayChange: TNotifyEvent write SetOnItemsMayChange;
property OnItemsCouldHaveChanged: TNotifyEvent write SetOnItemsCouldHaveChanged;
/// notify the view that repaint is necessary
property OnItemsInvalidate: TNotifyEvent write SetOnItemsInvalidate;
/// notify the view that the sizes of items need recalculation
property OnItemsResize: TNotifyEvent write SetOnItemsResize;
property OnResetView: TNotifyEvent write SetOnResetView;
end;
/// <summary>Minimal concrete implementation of IListViewAdapter</summary>
TListViewItems = class(TAbstractListViewAdapter, IListViewAdapter)
public type
TOrder = (FirstToLast, LastToFirst);
strict private
FActiveItems: TListItemsList;
FOnNotify: TCollectionNotifyEvent<TListItem>;
{ IListViewAdapter }
function GetDefaultViewHeight: Integer;
strict protected
function GetCount: Integer; virtual;
function GetItem(const Index: Integer): TListItem; virtual;
procedure ResetIndexes;
procedure ObjectsNotify(Sender: TObject; const Item: TListItem; Action: TCollectionNotification);
property ActiveItems: TListItemsList read FActiveItems write FActiveItems;
procedure DoSort(AComparer: IComparer<TListItem>); override;
public
constructor Create;
destructor Destroy; override;
/// <summary>Return index of AItem</summary>
function IndexOf(const AItem: TListItem): Integer;
/// <summary>Return TEnumerator&lt;TListItem&gt; of items in this adapter</summary>
function GetEnumerator: TEnumerator<TListItem>;
/// <summary>Access TListItem by Index</summary>
property Item[const Index: Integer]: TListItem read GetItem; default;
/// <summary>Count of items</summary>
property Count: Integer read GetCount;
/// <summary>Collection notify event, used internally</summary>
property OnNotify: TCollectionNotifyEvent<TListItem> read FOnNotify write FOnNotify;
end;
/// <summary>Implementation of IListViewAdapter and IListViewFilterable</summary>
TFilterableListViewItems = class(TListViewItems, IListViewFilterable)
strict private
FUnfilteredItems: TListItemsList;
FFilteredItems: TListItemsList;
FFilterPredicate: TFilterPredicate;
FNeedApplyFilter: Boolean;
FIsFiltering: Boolean;
procedure ItemsCleared;
procedure ItemDeleted(const Index: Integer);
procedure ItemAdded(const Index: Integer; const Item: TListItem);
{ IListViewFilterable }
function GetFilterPredicate: TFilterPredicate;
function GetUnfilteredItems: TListItemsList;
procedure SetFilterPredicate(const Value: TFilterPredicate);
function GetFiltered: Boolean;
strict protected
/// <summary>Return True if item should be shown</summary>
function DoFilterItem(const Item: TListItem): Boolean; virtual; abstract;
/// <summary>Return unfiltered items. FFilteredItems by default.</summary>
function DoGetUnfilteredItems: TListItemsList; virtual;
procedure DoEndUpdate; override;
public
constructor Create;
destructor Destroy; override;
procedure Changed; override;
/// <summary>Filters items if the adapter is not in the process of batch updating data.</summary>
procedure ApplyFilter;
/// <summary>Filter predicate</summary>
property Filter: TFilterPredicate read GetFilterPredicate write SetFilterPredicate;
/// <summary>A complete list of all items, regardless of state of Filtered</summary>
property UnfilteredItems: TListItemsList read GetUnfilteredItems;
///<summary>Filtered is True if some items are not displayed</summary>
property Filtered: Boolean read GetFiltered;
end;
//== INTERFACE END: FMX.ListView.Adapters.Base
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.SearchBox (from FMX.SearchBox.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
/// <summary>Type of event handler for filtering of string value. If value is filtered by the filter condition,
/// <c>Accept</c> should be True, Otherwise - false</summary>
TFilterEvent = procedure (Sender: TObject; const AFilter: string; const AValue: string; var Accept: Boolean) of object;
{ TSearchBox }
TSearchBoxModel = class(TCustomEditModel)
private
[Weak] FSearchResponder: ISearchResponder;
FOnFilter: TFilterEvent;
protected
procedure DoChangeTracking; override;
public
property SearchResponder: ISearchResponder read FSearchResponder write FSearchResponder;
/// <summary>Event handler for setting custom filter on text of <c>TSearchBox</c>.</summary>
property OnFilter: TFilterEvent read FOnFilter write FOnFilter;
end;
TSearchBox = class(TEdit, IListBoxHeaderTrait)
private
function GetOnFilter: TFilterEvent;
procedure SetOnFilter(const Value: TFilterEvent);
function GetModel: TSearchBoxModel; overload;
protected
function DefinePresentationName: string; override;
function DefineModelClass: TDataModelClass; override;
procedure ParentChanged; override;
public
constructor Create(AOwner: TComponent); override;
property Model: TSearchBoxModel read GetModel;
published
/// <summary>Event handler for setting custom filter on text of <c>TSearchBox</c>.</summary>
property OnFilter: TFilterEvent read GetOnFilter write SetOnFilter;
end;
//== INTERFACE END: FMX.SearchBox
//==================================================================================================
//==================================================================================================
//== INTERFACE 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;
/// <summary>Data model for the TMemo control.</summary>
TCustomMemoModel = class(TCustomScrollBoxModel, ITextLinesSource)
public type
///<summary>Record to notify presenter about changes in test lines.</summary>
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;
/// <summary>Data for requesting caret position by HitTest point.</summary>
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
///<summary>Validate inputing text. Calling before OnChangeTracking</summary>
function DoValidating(const Value: string): string; virtual;
///<summary>Validate inputed text. Calling before OnChange</summary>
function DoValidate(const Value: string): string; virtual;
///<summary>Call OnChangeTracking event</summary>
procedure DoChangeTracking; virtual;
///<summary>Call OnChange event</summary>
procedure DoChange; virtual;
///<summary>Method is calling when some parameter of text settings was changed</summary>
procedure TextSettingsChanged; virtual;
///<summary>Returns class type that represent used text settings. Could be overridden in descendants to modify
///default behavior</summary>
function GetTextSettingsClass: TTextSettingsInfo.TCustomTextSettingsClass; virtual;
public
constructor Create(const AOwner: TComponent); override;
destructor Destroy; override;
///<summary>Does memo has selected text</summary>
function HasSelection: Boolean;
///<summary>Returns current selected text</summary>
function SelectedText: string;
///<summary>If there were made any changes in text OnChange will be raised</summary>
procedure Change;
///<summary>Convert absolute platform-dependent position in text to platform independent value in format
///(line_number, position_in_line)</summary>
function TextPosToPos(const APos: Integer): TCaretPosition;
///<summary>Convert platform-independent position to absolute platform-dependent position</summary>
function PosToTextPos(const APostion: TCaretPosition): Integer;
///<summary>Insert text in memo after defined position</summary>
procedure InsertAfter(const APosition: TCaretPosition; const AFragment: string; const Options: TInsertOptions);
///<summary>Delete fragment of the text from the memo after defined position</summary>
procedure DeleteFrom(const APosition: TCaretPosition; const ALength: Integer; const Options: TDeleteOptions);
/// <summary>Replace fragment of text from the memo in the specifeid range.</summary>
procedure Replace(const APosition: TCaretPosition; const ALength: Integer; const AFragment: string);
///<summary>Select <c>ALength</c> characters in memo's text starting from <c>AStartPosition</c></summary>
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;
/// <summary>Returns caret position by specified hittest point.</summary>
/// <remarks>Works only for <c>TMemo.ControlType=Styled</c>.</remarks>
function GetCaretPositionByPoint(const AHitPoint: TPointF; const ARoundToWord: Boolean = False): TCaretPosition;
public
///<summary>Select all text when control getting focus</summary>
property AutoSelect: Boolean read FAutoSelect write SetAutoSelect;
///<summary>Contains component that represent current caret for control</summary>
property Caret: TCaret read FCaret write SetCaret;
///<summary>Defines character case for text in component</summary>
property CharCase: TEditCharCase read FCharCase write SetCharCase;
///<summary>Switch on/off spell checking feature</summary>
property CheckSpelling: Boolean read FCheckSpelling write SetCheckSpelling;
///<summary>Defines the types of information that can be detected in text
///(for native presentation on iOS only)</summary>
property DataDetectorTypes: TDataDetectorTypes read FDataDetectorTypes write SetDataDetectorTypes;
///<summary>Do not draw selected text region when component not in focus</summary>
property HideSelectionOnExit: Boolean read FHideSelectionOnExit write SetHideSelectionOnExit default True;
///<summary>Text is in read-only mode</summary>
property ReadOnly: Boolean read FReadOnly write SetReadOnly;
///<summary>Default IME text input mode</summary>
property ImeMode: TImeMode read FImeMode write SetImeMode;
///<summary>Defines visual type of on-screen-keyboard</summary>
property KeyboardType: TVirtualKeyboardType read FKeyboardType write SetKeyboardType;
///<summary>Lines of text</summary>
property Lines: TStrings read FLines write SetLines;
///<summary>Available maximum length of text (0 - no length limitation).</summary>
property MaxLength: Integer read FMaxLength write SetMaxLength;
///<summary>Brush that is using to draw text selection region</summary>
property SelectionFill: TBrush read FSelectionFill write SetSelectionFill;
///<summary>Current position of cursor in the text</summary>
property CaretPosition: TCaretPosition read GetCaretPosition write SetCaretPosition;
///<summary>Text selection starting position</summary>
property SelStart: Integer read FSelStart write SetSelStart;
///<summary>Length of selected text</summary>
property SelLength: Integer read FSelLength write SetSelLength;
///<summary>Container for current text visualization attributes</summary>
property TextSettingsInfo: TTextSettingsInfo read FTextSettingsInfo write SetTextSettingsInfo;
///<summary>Event that raises when control losing focus or user pressing ENTER key (but onlt if some changes were
///made)</summary>
property OnChange: TNotifyEvent read FOnChange write FOnChange;
///<summary>Event that raises on any change in text</summary>
property OnChangeTracking: TNotifyEvent read FOnChangeTracking write FOnChangeTracking;
///<summary>Event that raises to validate any change in text (raises before OnChangeTracking event)</summary>
property OnValidating: TValidateTextEvent read FOnValidating write FOnValidating;
///<summary>Event that raises to validate changes in text (raises before OnChange event)</summary>
property OnValidate: TValidateTextEvent read FOnValidate write FOnValidate;
end;
/// <summary>TCustomMemo is the base class from which all FireMonkey multiline
/// text editing controls, providing text scrolling, are derived.</summary>
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 }
///<summary>Retruns True if the control could be handled by live binding</summary>
function CanObserve(const ID: Integer): Boolean; override;
///<summary>Registering observer handler after binding link was creaded</summary>
procedure ObserverAdded(const ID: Integer; const Observer: IObserver); override;
public
constructor Create(AOwner: TComponent); override;
///<summary>Delete selected text</summary>
procedure ClearSelection; deprecated 'Use DeleteSelection method instead';
{ ITextActions }
///<summary>Removes the selected text from the memo control</summary>
procedure DeleteSelection;
///<summary>Copies the selected text to the clipboard</summary>
procedure CopyToClipboard;
///<summary>Cuts the selected text to the clipboard</summary>
procedure CutToClipboard;
///<summary>Pastes the text from the clipboard to the current caret position</summary>
procedure PasteFromClipboard;
///<summary>Select all text</summary>
procedure SelectAll;
///<summary>Selects the word containing the insertion point</summary>
procedure SelectWord;
///<summary>Cancel the selection if it exists</summary>
procedure ResetSelection;
///<summary>Moves the cursor to the end of the text in the memo</summary>
procedure GoToTextEnd;
///<summary>Moves the cursor to the beginning of the text in the memo</summary>
procedure GoToTextBegin;
///<summary>Replaces the <c>ALength</c> number of characters, beginning from the <c>AStartPos</c> position,
///with the the <c>AStr</c> string</summary>
procedure Replace(const AStartPos: Integer; const ALength: Integer; const AStr: string);
///<summary>Moves the cursor to the end of the current line</summary>
///<remarks>When <c>WordWrap</c> 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.</remarks>
procedure GoToLineEnd;
///<summary>Moves the cursor to the beginning of the current line</summary>
///<remarks>When <c>WordWrap</c> 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.</remarks>
procedure GoToLineBegin;
///<summary>Undoing the latest text change made in the memo</summary>
procedure UnDo;
///<summary>Converts an absolute platform-specific position in text to a platform-independent position in the
///(line_number, position_in_line) format</summary>
function TextPosToPos(const APos: Integer): TCaretPosition;
///<summary>Converts a platform-independent position in text to an absolute platform-specific position</summary>
function PosToTextPos(const APostion: TCaretPosition): Integer;
///<summary>Inserts the <c>AFragment</c> string in the memo's text, after <c>APosition</c></summary>
procedure InsertAfter(const APosition: TCaretPosition; const AFragment: string; const Options: TInsertOptions);
///<summary>Deletes the <c>ALength</c> number of characters, after the <c>APosition</c> position, from the memo's
///text</summary>
procedure DeleteFrom(const APosition: TCaretPosition; const ALength: Integer; const Options: TDeleteOptions);
///<summary>The model handling the internal data of the memo control</summary>
property Model: TCustomMemoModel read GetModel;
///<summary>The entire text in the memo</summary>
property Text: string read GetText write SetText;
public
///<summary>Determines whether all the text in the memo is automatically selected when the control gets
///focus</summary>
property AutoSelect: Boolean read GetAutoSelect write SetAutoSelect;
///<summary>Provides access to the caret attached to the memo</summary>
property Caret: TCaret read GetCaret write SetCaret;
///<summary>Defines whether to implement the 'UPPER' or 'lower' case conversion to the memo's text</summary>
property CharCase: TEditCharCase read GetCharCase write SetCharCase;
///<summary>Defines whether the spell checking feature of the memo component is on or off</summary>
property CheckSpelling: Boolean read GetCheckSpelling write SetCheckSpelling;
///<summary>Defines the types of information that can be detected in the memo's text
///(for native presentation on iOS only)</summary>
property DataDetectorTypes: TDataDetectorTypes read GetDataDetectorTypes write SetDataDetectorTypes;
///<summary>Determines whether to cancel the visual indication of the selected text when the focus moves to another
///control.</summary>
property HideSelectionOnExit: Boolean read GetHideSelectionOnExit write SetHideSelectionOnExit;
///<summary>Default IME text input mode</summary>
property ImeMode: TImeMode read GetImeMode write SetImeMode;
///<summary>Defines the type of the on-screen keyboard to be displayed</summary>
property KeyboardType: TVirtualKeyboardType read GetKeyboardType write SetKeyboardType;
///<summary>Provides access to individual lines of the memo's text</summary>
property Lines: TStrings read GetLines write SetLines;
///<summary>The maximum number of characters that can be entered in the memo (0 - no explicit limitation)</summary>
property MaxLength: Integer read GetMaxLength write SetMaxLength;
///<summary>Specifies whether the user can change the memo's text</summary>
property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
///<summary>The current cursor position in the text</summary>
property CaretPosition: TCaretPosition read GetCaretPosition write SetCaretPosition;
///<summary>The brush that is used to draw a text selection region</summary>
property SelectionFill: TBrush read GetSelectionFill;
///<summary>Text font</summary>
property Font: TFont read GetFont write SetFont;
///<summary>The font color of the text in this memo</summary>
property FontColor: TAlphaColor read GetFontColor write SetFontColor;
///<summary>Horizontal text alignment</summary>
property TextAlign: TTextAlign read GetTextAlign write SetTextAlign;
///<summary>Specifies whether to wrap the text when its length is greater than the memo width</summary>
property WordWrap: Boolean read GetWordWrap write SetWordWrap;
///<summary>The number of the first character selected in the memo's text</summary>
property SelStart: Integer read GetSelStart write SetSelStart;
///<summary>The number of characters selected in the memo's text</summary>
property SelLength: Integer read GetSelLength write SetSelLength;
///<summary>The currently selected fragment in the memo's text</summary>
property SelText: string read GetSelText;
///<summary>The text representation properties that are applied from the current style</summary>
property StyledSettings: TStyledSettings read GetStyledSettings write SetStyledSettings
stored StyledSettingsStored nodefault;
///<summary>The container for the current text visualization properties</summary>
property TextSettings: TTextSettings read GetTextSettings write SetTextSettings;
///<summary>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)</summary>
property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
///<summary>Raises when any change has been made in the text</summary>
property OnChangeTracking: TNotifyEvent read GetOnChangeTracking write SetOnChangeTracking;
///<summary>Raises to validate any change has been made in the text
///(raises before the OnChangeTracking event)</summary>
property OnValidating: TValidateTextEvent read GetOnValidating write SetOnValidating;
///<summary>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)</summary>
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;
//== INTERFACE END: FMX.Memo
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.ListView.Appearances (from FMX.ListView.Appearances.pas)
//==================================================================================================
type
TItemControlEvent = procedure(const Sender: TObject; const AItem: TListItem; const AObject: TListItemSimpleControl) of object;
TListViewItem = class;
TItemAppearanceProperties = class;
TPublishedObjects = class;
/// <summary>An extension of TListView that uses appearance-based items.
/// </summary>
IAppearanceItemOwner = interface
['{A3CAF8E2-ECD5-4989-9B03-B3E79B02DFBC}']
/// <summary>Return array of TItemAppearanceProperties specific for this ListView.
/// The array includes appearances for various item purposes and state, namely
/// Item, ItemEdit, Header and Footer.
/// </summary>
function GetAppearanceProperties: TArray<TItemAppearanceProperties>;
/// <summary>Begin control update. Uses the same semantics as TControl.BeginUpdate</summary>
procedure BeginUpdate;
/// <summary>End control update. Uses the same semantics as TControl.EndUpdate</summary>
procedure EndUpdate;
end;
/// <summary>Interface from TPublishedAppearance and TItemAppearanceProperties
/// to its owner (TAppearanceListView).</summary>
IPublishedAppearanceOwner = interface
['{990AB866-92AB-4552-BB12-223F44CFD062}']
/// <summary>Notify the owner of appearance change</summary>
procedure ItemAppearanceChange(const Sender: TItemAppearanceProperties);
/// <summary>Notify the owner of appearance view change</summary>
procedure ItemAppearanceChangeObjects(const Sender: TItemAppearanceProperties);
/// <summary>Notify the owner of appearance height change</summary>
procedure ItemAppearanceChangeHeight(const Sender: TItemAppearanceProperties);
/// <summary>Query owner if it's currently in edit mode</summary>
function IsEditMode: Boolean;
/// <summary>Get header height</summary>
function GetHeaderHeight: Integer;
/// <summary>Set header height</summary>
procedure SetHeaderHeight(const Value: Integer);
/// <summary>Get footer height</summary>
function GetFooterHeight: Integer;
/// <summary>Set footer height</summary>
procedure SetFooterHeight(const Value: Integer);
/// <summary>Get regular item height</summary>
function GetItemHeight: Integer;
/// <summary>Set regular item height</summary>
procedure SetItemHeight(const Value: Integer);
/// <summary>Get regular item edit mode height</summary>
function GetItemEditHeight: Integer;
/// <summary>Set regular item edit mode height</summary>
procedure SetItemEditHeight(const Value: Integer);
/// <summary>Get footer apperance name</summary>
function GetFooterAppearanceName: string;
/// <summary>Set footer apperance name</summary>
procedure SetFooterAppearanceName(const Value: string);
/// <summary>Get header appearance name</summary>
function GetHeaderAppearanceName: string;
/// <summary>Set header appearance name</summary>
procedure SetHeaderAppearanceName(const Value: string);
/// <summary>Get regular item appearance name</summary>
function GetItemAppearanceName: string;
/// <summary>Set regular item appearance name</summary>
procedure SetItemAppearanceName(const Value: string);
/// <summary>Get regular item appearance name in edit mode</summary>
function GetItemEditAppearanceName: string;
/// <summary>Set regular item appearance name in edit mode</summary>
procedure SetItemEditAppearanceName(const Value: string);
/// <summary>Get footer appearance properties</summary>
function GetFooterAppearanceProperties: TItemAppearanceProperties;
/// <summary>Get header appearance properties</summary>
function GetHeaderAppearanceProperties: TItemAppearanceProperties;
/// <summary>Get regular item appearance properties</summary>
function GetItemAppearanceProperties: TItemAppearanceProperties;
/// <summary>Get regular item appearance properties in edit mode</summary>
function GetItemEditAppearanceProperties: TItemAppearanceProperties;
/// <summary>Setter for ItemAppearanceObjects property</summary>
procedure SetItemAppearanceObjects(const Value: TPublishedObjects);
/// <summary>Getter for ItemAppearanceObjects property</summary>
function GetItemAppearanceObjects: TPublishedObjects;
/// <summary>Footer height</summary>
property FooterHeight: Integer read GetFooterHeight write SetFooterHeight;
/// <summary>Header height</summary>
property HeaderHeight: Integer read GetHeaderHeight write SetHeaderHeight;
/// <summary>Regular item height</summary>
property ItemHeight: Integer read GetItemHeight write SetItemHeight;
/// <summary>Regular item height in edit mode</summary>
property ItemEditHeight: Integer read GetItemEditHeight write SetItemEditHeight;
/// <summary>Footer appearance name</summary>
property FooterAppearanceName: string read GetFooterAppearanceName write SetFooterAppearanceName;
/// <summary>Header appearance name</summary>
property HeaderAppearanceName: string read GetHeaderAppearanceName write SetHeaderAppearanceName;
/// <summary>Regular item appearance name</summary>
property ItemAppearanceName: string read GetItemAppearanceName write SetItemAppearanceName;
/// <summary>Regular appearance name in edit mode</summary>
property ItemEditAppearanceName: string read GetItemEditAppearanceName write SetItemEditAppearanceName;
/// <summary>Footer appearance properties</summary>
property FooterAppearanceProperties: TItemAppearanceProperties read GetFooterAppearanceProperties;
/// <summary>Header appearance properties</summary>
property HeaderAppearanceProperties: TItemAppearanceProperties read GetHeaderAppearanceProperties;
/// <summary>Regular item appearance properties</summary>
property ItemAppearanceProperties: TItemAppearanceProperties read GetItemAppearanceProperties;
/// <summary>Regular item appearance properties in edit mode</summary>
property ItemEditAppearanceProperties: TItemAppearanceProperties read GetItemEditAppearanceProperties;
/// <summary>Access instance of TPublishedObjects used by ListView</summary>
property ItemAppearanceObjects: TPublishedObjects read GetItemAppearanceObjects write SetItemAppearanceObjects;
end;
TAppearanceNamePair = TPair<string (*Identifier*), string (*displayname*)>;
TAppearanceType = (Item, ItemEdit, Header, Footer);
TItemAppearanceObjects = class;
/// <summary>Standard appearance names</summary>
TAppearanceNames = class
public const
Empty = '';
Null = 'Null';
Custom = 'Custom';
ListHeader = 'ListHeader';
// ListItem group
ListItem = 'ListItem';
ListItemDelete = 'ListItemDelete';
ListItemShowCheck = 'ListItemShowCheck';
// ListItemRightDetail group
ListItemRightDetail = 'ListItemRightDetail';
ListItemRightDetailDelete = 'ListItemRightDetailDelete';
ListItemRightDetailShowCheck = 'ListItemRightDetailShowCheck';
// ImageListItemgec group
ImageListItem = 'ImageListItem';
ImageListItemDelete = 'ImageListItemDelete';
ImageListItemShowCheck = 'ImageListItemShowCheck';
ImageListItemBottomDetail = 'ImageListItemBottomDetail';
ImageListItemBottomDetailShowCheck = 'ImageListItemBottomDetailShowCheck';
ImageListItemBottomDetailRightButton = 'ImageListItemBottomDetailRightButton';
ImageListItemBottomDetailRightButtonShowCheck = 'ImageListItemBottomDetailRightButtonShowCheck';
// ListItemRightButton group
ImageListItemRightButton = 'ImageListItemRightButton';
ImageListItemRightButtonDelete = 'ImageListItemRightButtonDelete';
ImageListItemRightButtonShowCheck = 'ImageListItemRightButtonShowCheck';
end;
/// <summary>Extended items adapter that supports item appearances. This is the default adapter used by
/// TAppearanceListView. It implements all extensions supported by TAppearanceListView.
///</summary>
TAppearanceListViewItems = class(TFilterableListViewItems, IListViewAdapter, IListViewCheckProvider, IListViewEditor,
IListViewFilterable, IListViewTextProvider, IListViewTextButtonProvider, IListViewGlyphButtonProvider,
IListViewExtrasProvider)
strict private
[Weak] FOwnerControl: TControl;
FIsDelayedChanged: Boolean;
FNewItems: TListItemsList;
FAsFilterable: IListViewFilterable;
FPresentationParent: IListViewPresentationParent;
FListViewController: IListViewController;
{ IListViewEditor }
FBeforeItemAdded: TBeforeItemAddedNotify;
FAfterItemAdded: TAfterItemAddedNotify;
FBeforeItemDeleted: TBeforeItemDeletedNotify;
FAfterItemDeleted: TAfterItemDeletedNotify;
FCheckedCount: Integer;
{ IListViewEditor }
function EditorAdd: TListItem;
function EditorInsert(const Index: Integer): TListItem;
procedure SetBeforeItemAdded(const AHandler: TBeforeItemAddedNotify);
procedure SetAfterItemAdded(const AHandler: TAfterItemAddedNotify);
procedure SetBeforeItemDeleted(const AHandler: TBeforeItemDeletedNotify);
procedure SetAfterItemDeleted(const AHandler: TAfterItemDeletedNotify);
{ IListViewTextProvider }
function GetText(const Index: Integer): string;
function GetIndexTitle(const Index: Integer): string;
{ IListViewGlyphButtonProvider }
function GetGlyphButtonDrawable(const Index: Integer): TListItemGlyphButton;
{ IListViewTextButtonProvider }
function GetTextButtonDrawable(const Index: Integer): TListItemTextButton;
{ IListViewExtrasProvider }
function GetItemData(const Index: Integer; const DataIndex: string): TValue;
procedure SetItemData(const Index: Integer; const DataIndex: string; const AValue: TValue);
function GetHasData(const Index: Integer; const DataIndex: string): Boolean;
function GetItemTag(const Index: Integer): NativeInt;
procedure SetItemTag(const Index: Integer; const AValue: NativeInt);
strict private
function GetAppearanceItem(const Index: Integer): TListViewItem;
strict protected
/// <summary>Create drawables for newly added items.</summary>
procedure DoCreateNewViews; override;
/// <summary>Apply filter to given item</summary>
function DoFilterItem(const Item: TListItem): Boolean; override;
/// <summary>Recreate drawables for items with given purposes.</summary>
procedure DoResetViews(const APurposes: TListItemPurposes); override;
/// <summary>Clear the list of items.</summary>
procedure DoClear; virtual;
/// <summary>Add new item at index Index and return it.</summary>
function DoAddItem(const Index: Integer = -1): TListViewItem; virtual;
procedure DoEndUpdate; override;
protected
/// <summary>Owner control, <c>TAppearanceListView</c></summary>
property OwnerControl: TControl read FOwnerControl;
/// <summary>Owner control as <c>IAppearanceItemOwner</c></summary>
function AppearanceItemOwner: IAppearanceItemOwner;
public
constructor Create(const Owner: TControl);
destructor Destroy; override;
function IListViewEditor.Add = EditorAdd;
function IListViewEditor.Insert = EditorInsert;
/// <summary>Sort items using given AComparer</summary>
procedure Sort(AComparer: IComparer<TListViewItem>); overload;
{ IListViewCheckable }
/// <summary>True if there is an item such that Item.Checked = AChecked</summary>
function AnyChecked(const AChecked: Boolean = True): Boolean;
/// <summary>Index of the first item where Item.Checked = AChecked</summary>
function FirstChecked(const AChecked: Boolean = True): Integer;
/// <summary>Count items where Item.Checked = AChecked</summary>
function CheckedCount(const AChecked: Boolean = True): Integer;
/// <summary>Change check state of all items</summary>
procedure CheckAll(const AChecked: Boolean = True); overload;
/// <summary>Change check state of all items. If ACallback is not nil, it should return True
/// for items state of which should be changed. Callback argument is Item Index, return value is
/// a Boolean which enables or disables state change for given index.</summary>
procedure CheckAll(const ACallback: TFunc<Integer, Boolean>; const AChecked: Boolean = True); overload;
function GetChecked(const Index: Integer): Boolean;
procedure SetChecked(const Index: Integer; const Value: Boolean);
/// <summary>Get/set checked state of item at Index</summary>
property Checked[const Index: Integer]: Boolean read GetChecked write SetChecked;
/// <summary>Return indexes of all checked (if AChecked = True) or unchecked (AChecked = False) items.</summary>
function CheckedIndexes(const AChecked: Boolean): TArray<Integer>; overload;
/// <summary>Return indexes of all checked (if AChecked = True) or unchecked (AChecked = False) items.
/// AOrder specifies order of returned items, TListViewItems.TOrder.FirstToLast or
/// TListViewItems.TOrder.LastToFirst.</summary>
function CheckedIndexes(const AOrder: TListViewItems.TOrder; const AChecked: Boolean): TArray<Integer>; overload;
/// <summary>Obtain TEnumerator<TListViewItem> for this adapter</summary>
function GetEnumerator: TEnumerator<TListViewItem>; reintroduce;
/// <summary>Perform recounting of all items, find AItem and return its index or -1 if not found.
/// This method is called by implementation <c>IListViewController.RequestReindexing</c> in
/// <c>TListViewBase</c></summary>
function ReindexAndFindItem(const AItem: TListViewItem): Integer; // item reindexer, formerly in ListView
{ IListViewEditor }
/// <summary>Create a new TListViewItem and append it at the end of list of items</summary>
/// <returns>New item instance</returns>
function Add: TListViewItem;
/// <summary>Create a new TListViewItem and insert it before position specified by Index</summary>
/// <returns>New item instance</returns>
function Insert(const Index: Integer): TListViewItem;
/// <summary>Delete an item with index Index</summary>
procedure Delete(const Index: Integer);
/// <summary>Dispose of all items at once</summary>
procedure Clear;
/// <summary>Same as Insert(Index)</summary>
function AddItem(const Index: Integer = -1): TListViewItem;
/// <summary>Default index property. Get a TListViewItem at index.</summary>
property AppearanceItem[const Index: Integer]: TListViewItem read GetAppearanceItem; default;
/// <summary>Return this adapter as IListViewFilterable</summary>
property AsFilterable: IListViewFilterable read FAsFilterable;
end;
/// <summary>Extension of <c>TListItem</c> that supports Appearances.
/// Forms content of <c>TAppearanceListViewItems</c></summary>
TListViewItem = class(TListItem)
private type
TFlag = (HasButtonText, HasCheck);
TFlags = set of TFlag;
public type
/// <summary>Standard appearance object names</summary>
TObjectNames = class
public const
Text = 'T'; // do not localize
Detail = 'D'; // do not localize
Accessory = 'A'; // do not localize
TextButton = 'B'; // do not localize
GlyphButton = 'G'; // do not localize
Image = 'I'; // do not localize
end;
/// <summary>Standard appearance object data members</summary>
TMemberNames = class
public const
Text = 'Text'; // do not localize
Detail = 'Detail'; // do not localize
ButtonText = 'ButtonText'; // do not localize
Bitmap = 'Bitmap'; // do not localize
ImageIndex = 'ImageIndex'; // do not localize
end;
/// <summary>Extension of <c>TListItemView</c> which defines public properties for commonly used drawables</summary>
TListViewItemObjects = class(TListItemView)
strict private
FAppearance: TItemAppearanceObjects;
function GetDetailObject: TListItemText;
function GetGlyphButton: TListItemGlyphButton;
function GetImageObject: TListItemImage;
function GetTextButton: TListItemTextButton;
function GetTextObject: TListItemText;
function GetAccessoryObject: TListItemAccessory;
public
procedure Clear; override;
/// <summary>Find <c>TListItemDrawable</c> object of type <c>T</c> with the name <c>AName</c></summary>
function FindObjectT<T: TListItemDrawable>(const AName: string): T;
/// <summary>Text drawable object</summary>
property TextObject: TListItemText read GetTextObject;
/// <summary>Detail text drawable object</summary>
property DetailObject: TListItemText read GetDetailObject;
/// <summary>Image drawable object</summary>
property ImageObject: TListItemImage read GetImageObject;
/// <summary>Text button drawable object</summary>
property TextButton: TListItemTextButton read GetTextButton;
/// <summary>Glyph button drawable object</summary>
property GlyphButton: TListItemGlyphButton read GetGlyphButton;
/// <summary>Accessory drawable object</summary>
property AccessoryObject: TListItemAccessory read GetAccessoryObject;
/// <summary>Reference to <c>TItemAppearanceObjects</c> that serve as prototypes
/// for the drawables in this view</summary>
property Appearance: TItemAppearanceObjects read FAppearance write FAppearance;
end;
private type
TDirtyDrawable = (Text, Detail, Check, ButtonText, Accessory, ImageIndex, BitmapValue, BitmapRef);
TDirtyDrawables = set of TDirtyDrawable;
private
FData: TDictionary<string, TValue>;
FDataBitmaps: TDictionary<string, TBitmap>;
FFlags: TFlags;
FText: string;
FDetail: string;
FIndexTitle: string;
FButtonText: string;
FAccessory: TAccessoryType;
FBitmap: TBitmap;
FChecked: Boolean;
FImageIndex: Integer;
[Weak] FBitmapRef: TBitmap;
FCreatingObjectsGuard: Boolean;
FDirtyDrawables: TDirtyDrawables;
FPresentationParent: IListViewPresentationParent;
procedure SetText(const Value: string);
function GetBitmap: TBitmap;
procedure SetAccessory(const Value: TAccessoryType);
procedure SetDetail(const Value: string);
procedure SetButtonText(const Value: string);
procedure SetImageIndex(Value: Integer);
procedure SetBitmap(const Value: TBitmap);
procedure OnBitmapChanged(Sender: TObject);
procedure SetBitmapRef(const Value: TBitmap);
procedure CheckBitmap;
function GetChecked: Boolean;
procedure SetChecked(const Value: Boolean);
function GetViewObjects: TListViewItemObjects;
function GetData(const AIndex: string): TValue;
procedure SetData(const AIndex: string; const AValue: TValue);
function GetIndexTitle: string;
procedure SetIndexTitle(const Value: string);
procedure UpdateDrawables;
protected
function GetIndex: Integer; override;
/// <summary>True if user-specified button text is set for this item. If user text is not specified,
/// the value defined by Text Button Appearance will be used.</summary>
function GetHasButtonText: Boolean;
function GetHasData(const AIndex: string): Boolean;
function ListItemObjectsClass: TListItem.TListItemViewType; override;
procedure SetPurpose(const AValue: TListItemPurpose); override;
procedure InvalidateHeights; override;
procedure ClearData(const AIndex: string);
public
constructor Create(const Owner: TAppearanceListViewItems; PresentationParent: IListViewPresentationParent;
AController: IListViewController);
destructor Destroy; override;
procedure CreateObjects; override;
procedure WillBePainted; override;
/// <summary> Main text for the cell. </summary>
property Text: string read FText write SetText;
/// <summary> Detail (smaller) text for the cell. This may either appear below or to the right of main text,
/// depending on currently selected appearance. It may also not appear at all. </summary>
property Detail: string read FDetail write SetDetail;
/// <summary>Shortcut letter that appears on the right of the list in native iOS presentations.</summary>
property IndexTitle: string read GetIndexTitle write SetIndexTitle;
/// <summary>Accessory type. Used if the appearance defines an accessory item.</summary>
property Accessory: TAccessoryType read FAccessory write SetAccessory;
/// <summary>Bitmap to be used by default Image Appearance Item. Assigning this property will
/// create a bitmap copy stored in this item.</summary>
property Bitmap: TBitmap read GetBitmap write SetBitmap;
/// <summary>Bitmap reference to be used by default Image Appearance Item. The bitmap will not be
/// copied to the item, the original TBitmap object should be managed by the user.</summary>
property BitmapRef: TBitmap read FBitmapRef write SetBitmapRef;
/// <summary>Text to be used by default TextButton Appearance Item.</summary>
property ButtonText: string read FButtonText write SetButtonText;
///<summary>Zero based index of an image in the ImageList. The default is <c>-1</c>.
///<para> See also <b>FMX.ActnList.IGlyph</b></para></summary>
///<remarks>If non-existing index is specified, an image is not drawn and no exception is raised</remarks>
property ImageIndex: Integer read FImageIndex write SetImageIndex;
///<summary>True if this item is checked. Only valid in EditMode</summary>
property Checked: Boolean read GetChecked write SetChecked;
///<summary>An extension of TListItemView that has public references to the default set of drawables
/// used by predefined appearances</summary>
property Objects: TListViewItemObjects read GetViewObjects;
/// <summary>Set or get arbitrary data values. Once set, the values will be stored in the item.
/// Data values with AIndex matching AppearanceItem Name will be used to initialize
/// that the Drawable created by that Appearance Item. For example, Data['Text'] := MyText will initialize
/// the drawable managed by the appearance item called 'Text' using myText. </summary>
property Data[const AIndex: string]: TValue read GetData write SetData;
/// <summary>True if a value with index AIndex is stored in this item</summary>
property HasData[const AIndex: string]: Boolean read GetHasData;
end;
/// <summary>Compatibility alias</summary>
TAppearanceListViewItem = TListViewItem;
{$REGION 'Appearance object declarations'}
/// <summary>Base object appearance class. Object appearance creates a <c>TListItemDrawable</c> in a given item,
/// thus serving as a kind of view constructor for item views.
/// When <c>TAppearanceListView</c> needs to create an item view, it gets TItemAppearanceObjects (Item Appearance)
/// and invokes <c>TObjectAppearance.ResetObject(TListViewItem)</c> on each of them
/// </summary>
TObjectAppearance = class abstract (TInterfacedPersistent, IDesignablePersistent)
public type
/// <summary>Display name :-&gt; Data member</summary>
TDataMember = TPair<string, string>;
TDataMembers = TArray<TDataMember>;
private
[Weak] FOwner: TItemAppearanceObjects;
FName: string;
FDefaultValues: TObjectAppearance;
FVisible: Boolean;
FOnChange: TNotifyEvent;
FOnHeightChange: TNotifyEvent;
FInitializing: Boolean;
FDataMembers: TDataMembers;
FUsingDefaultValues: Boolean;
FShim: IPersistentShim;
procedure SetDefaultValues(const Value: TObjectAppearance);
function IgnoreChanges: Boolean;
procedure SetVisible(const Value: Boolean);
{ IDesignablePersistent }
function GetBoundsRect: TRect;
function GetDesignParent: TPersistent;
procedure BindShim(AShim: IPersistentShim);
procedure UnbindShim;
procedure IDesignablePersistent.Bind = BindShim;
procedure IDesignablePersistent.Unbind = UnbindShim;
function BeingDesigned: Boolean;
protected
/// <summary>Invoke <c>OnChange</c></summary>
procedure DoChange; virtual;
/// <summary>Invoke <c>OnHeightChange</c></summary>
procedure DoHeightChange; virtual; deprecated;
function IsActive: Boolean; virtual;
function GetHeight: Integer; virtual;
function CreateDefaultValues: TObjectAppearance; virtual;
public
constructor Create; overload; virtual;
constructor Create(AIsDefaultValues: Boolean); overload;
destructor Destroy; override;
/// <summary>Initialize self using default values</summary>
procedure RestoreDefaults; virtual;
procedure AfterConstruction; override;
/// <summary>BeginUpdate/EndUpdate delegates update cycle to the owner control</summary>
procedure BeginUpdate;
/// <summary>BeginUpdate/EndUpdate delegates update cycle to the owner control</summary>
procedure EndUpdate;
/// <summary>Create a drawable in the view after own image and initialize it with appearance properties.
/// For example, TCustomTextObjectAppearance.CreateObject creates an instance of TListItemText </summary>
procedure CreateObject(const AListViewItem: TListViewItem); virtual; abstract;
/// <summary>Find drawable that matches type and name of self in AListViewItem.View, and initialize it.</summary>
procedure ResetObject(const AListViewItem: TListViewItem); virtual; abstract;
/// <summary>Default values</summary>
property DefaultValues: TObjectAppearance read FDefaultValues write SetDefaultValues;
/// <summary>Owner appearance</summary>
property Owner: TItemAppearanceObjects read FOwner write FOwner;
/// <summary>Name of object appearance</summary>
property Name: string read FName write FName;
/// <summary>Data members</summary>
property DataMembers: TDataMembers read FDataMembers write FDataMembers;
/// <summary>Invoked on change</summary>
property OnChange: TNotifyEvent read FOnChange write FOnChange;
/// <summary>Invoked on height change</summary>
property OnHeightChange: TNotifyEvent read FOnHeightChange write FOnHeightChange;
/// <summary>Height</summary>
property Height: Integer read GetHeight;
/// <summary>Determines whether the current item is visible or not</summary>
property Visible: Boolean read FVisible write SetVisible;
end;
/// <summary>Compatibility alias</summary>
TListItemObjectClass = class of TListItemDrawable;
/// <summary>Common implementation of TObjectAppearance</summary>
TCommonObjectAppearance = class(TObjectAppearance, IMovablePersistent)
strict private
FWidth: Single;
FHeight: Single;
FAlign: TListItemAlign;
FVertAlign: TListItemAlign;
FPlaceOffset: TPosition;
FInternalPlaceOffset: TPosition;
FInternalWidth: Single;
FInternalHeight: Single;
FOpacity: Single;
procedure SetAlign(const Value: TListItemAlign);
procedure SetPlaceOffset(const Value: TPosition);
procedure SetVertAlign(const Value: TListItemAlign);
procedure SetHeight(const Value: Single);
procedure SetWidth(const Value: Single);
procedure OnPlaceOffsetChange(Sender: TObject);
procedure SetInternalPlaceOffset(const Value: TPosition);
procedure SetOpacity(const Value: Single);
procedure SetInternalWidth(const Value: Single);
procedure SetInternalHeight(const Value: Single);
private
function GetActualHeight: Single;
function GetActualPlaceOffset: TPointF;
function GetActualWidth: Single;
function GetWidthWhenVisible: Single;
function GetHeightWhenVisible: Single;
function GetSizeWhenVisible: TPointF;
protected
procedure AssignTo(ADest: TPersistent); override;
/// <summary></summary>
procedure InitDefaultValues(const ADefaults: TCommonObjectAppearance); virtual;
/// <summary>Find or create new drawable object of type T named Name in item AListViewItem
/// and initialize it by assigning self.</summary>
procedure ResetObjectT<T: TListItemDrawable>(const AListViewItem: TListViewItem);
function IsAlignStored: Boolean;
function IsVertAlignStored: Boolean;
function IsVisibleStored: Boolean;
function IsPlaceOffsetStored: Boolean;
function IsWidthStored: Boolean;
function IsHeightStored: Boolean;
function IsOpacityStored: Boolean;
{ IMovablePersistent }
procedure SetBoundsRect(const AValue: TRect);
public
constructor Create; override;
destructor Destroy; override;
/// <summary>Get actual height of the Appearance Object. The return value is:
/// If Visible = True:
/// Value of property Height if it is not zero.
/// Value of property InternalHeight otherwise.
/// If Visible = False:
/// 0
/// </summary>
property ActualHeight: Single read GetActualHeight;
/// <summary>Get actual width of the Appearance Object. The return value is:
/// If Visible = True:
/// Value of property Width if it is not zero.
/// Value of property InternalWidth otherwise.
/// If Visible = False:
/// 0
/// </summary>
property ActualWidth: Single read GetActualWidth;
/// <summary>Width of this object appearance regardless of current visibility</summary>
property WidthWhenVisible: Single read GetWidthWhenVisible;
/// <summary>Height of this object appearance regardless of current visibility</summary>
property HeightWhenVisible: Single read GetHeightWhenVisible;
/// <summary>Size of this object appearance regardless of current visibility</summary>
property SizeWhenVisible: TPointF read GetSizeWhenVisible;
/// <summary>Actual offset from the calculated position: PlaceOffset if nonzero, InternalPlaceOffset otherwise.</summary>
property ActualPlaceOffset: TPointF read GetActualPlaceOffset;
/// <summary>Internal width</summary>
property InternalWidth: Single read FInternalWidth write SetInternalWidth;
/// <summary>Internal height</summary>
property InternalHeight: Single read FInternalHeight write SetInternalHeight;
/// <summary>Internal PlaceOffset</summary>
property InternalPlaceOffset: TPosition read FInternalPlaceOffset write SetInternalPlaceOffset;
// Local width of list item inside its designated area.
property Width: Single read FWidth write SetWidth;
// Local height of list item inside its designated area.
property Height: Single read FHeight write SetHeight;
/// <summary>Horizontal alignment of Appearance Object inside its designated area.</summary>
property Align: TListItemAlign read FAlign write SetAlign;
/// <summary>Vertical alignment of Appearance Object inside its designated area.</summary>
property VertAlign: TListItemAlign read FVertAlign write SetVertAlign;
/// <summary>Offset from aligned location for placement control</summary>
property PlaceOffset: TPosition read FPlaceOffset write SetPlaceOffset;
/// <summary>Opacity of this Appearance Object</summary>
property Opacity: Single read FOpacity write SetOpacity;
end;
TTextShadowOptions = class(TPersistent)
public const
DefaultEnabled = True;
DefaultColor = TAlphaColorRec.Null;
private
[Weak] FOwner: TPersistent;
FEnabled: Boolean;
FColor: TAlphaColor;
FOnChanged: TNotifyEvent;
procedure SetColor(const Value: TAlphaColor);
procedure SetEnabled(const Value: Boolean);
protected
function GetOwner: TPersistent; override;
procedure AssignTo(Dest: TPersistent); override;
procedure Changed; virtual;
public
constructor Create(AOwner: TPersistent);
destructor Destroy; override;
function Equals(Obj: TObject): Boolean; override;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
published
property Color: TAlphaColor read FColor write SetColor default DefaultColor;
property Enabled: Boolean read FEnabled write SetEnabled default DefaultEnabled;
end;
/// <summary>Text object appearance: main item text or detail text</summary>
TCustomTextObjectAppearance = class(TCommonObjectAppearance)
private
FFont: TFont;
FFontDirty: Boolean;
FTextLayout: TTextLayout;
FTextAlign: TTextAlign;
FTextVertAlign: TTextAlign;
FWordWrap: Boolean;
FTextColor: TAlphaColor;
FTextShadow: TTextShadowOptions;
FTrimming: TTextTrimming;
FIsDetailText: Boolean;
procedure FontChanged(Sender: TObject);
procedure TextShadowChanged(Sender: TObject);
procedure SetTextAlign(const Value: TTextAlign);
procedure SetTextVertAlign(const Value: TTextAlign);
procedure SetWordWrap(const Value: Boolean);
procedure SetTextColor(const Value: TAlphaColor);
procedure SetTrimming(const Value: TTextTrimming);
procedure SetFont(const Value: TFont);
function GetDefaultValues: TCustomTextObjectAppearance;
procedure SetIsDetailText(const Value: Boolean);
procedure SetTextShadow(const Value: TTextShadowOptions);
protected
procedure AssignTo(ADest: TPersistent); override;
function CreateDefaultValues: TObjectAppearance; override;
function IsFontStored: Boolean;
function IsTextAlignStored: Boolean;
function IsTextVertAlignStored: Boolean;
function IsWordWrapStored: Boolean;
function IsDetailTextStored: Boolean;
function IsTextColorStored: Boolean;
function IsTextShadowStored: Boolean;
function IsOpacityStored: Boolean;
function IsTrimmingStored: Boolean;
public
constructor Create; override;
destructor Destroy; override;
procedure CreateObject(const AListViewItem: TListViewItem); override;
procedure ResetObject(const AListViewItem: TListViewItem); override;
/// <summary>Text font</summary>
property Font: TFont read FFont write SetFont;
/// <summary>Horizontal text alignment inside local item rectangle</summary>
property TextAlign: TTextAlign read FTextAlign write SetTextAlign;
/// <summary>Vertical text alignment inside local item rectangle</summary>
property TextVertAlign: TTextAlign read FTextVertAlign write SetTextVertAlign;
/// <summary>Word wrap</summary>
property WordWrap: Boolean read FWordWrap write SetWordWrap;
/// <summary>Text color</summary>
property TextColor: TAlphaColor read FTextColor write SetTextColor;
/// <summary>Shadow text color</summary>
property TextShadow: TTextShadowOptions read FTextShadow write SetTextShadow;
/// <summary>Text trimming</summary>
property Trimming: TTextTrimming read FTrimming write SetTrimming;
/// <summary>Is this regular or detail text</summary>
property IsDetailText: Boolean read FIsDetailText write SetIsDetailText;
/// <summary>Default appearance</summary>
property DefaultValues: TCustomTextObjectAppearance read GetDefaultValues;
end;
/// <summary>Published text object appearance</summary>
TTextObjectAppearance = class(TCustomTextObjectAppearance)
published
property Font stored IsFontStored nodefault;
property TextAlign stored IsTextAlignStored nodefault;
property TextVertAlign stored IsTextVertAlignStored nodefault;
property WordWrap stored IsWordWrapStored nodefault;
property TextShadow stored IsTextShadowStored nodefault;
property TextColor stored IsTextColorStored nodefault;
property Trimming stored IsTrimmingStored nodefault;
// Common
property Width stored IsWidthStored nodefault;
property Height stored IsHeightStored nodefault;
property Align stored IsAlignStored nodefault;
property VertAlign stored IsVertAlignStored nodefault;
property Visible stored IsVisibleStored nodefault;
property PlaceOffset stored IsPlaceOffsetStored nodefault;
property Opacity stored IsOpacityStored nodefault;
end;
/// <summary>Image object appearance, e.g. item bitmap</summary>
TCustomImageObjectAppearance = class(TCommonObjectAppearance)
strict private var
FScalingMode: TImageScalingMode;
procedure SetScalingMode(const Value: TImageScalingMode);
private
function GetDefaultValues: TCustomImageObjectAppearance;
protected
procedure AssignTo(ADest: TPersistent); override;
function CreateDefaultValues: TObjectAppearance; override;
function IsOpacityStored: Boolean;
function IsScalingModeStored: Boolean;
public
constructor Create; override;
procedure CreateObject(const AListViewItem: TListViewItem); override;
procedure ResetObject(const AListViewItem: TListViewItem); override;
property ScalingMode: TImageScalingMode read FScalingMode write SetScalingMode;
property DefaultValues: TCustomImageObjectAppearance read GetDefaultValues;
end;
/// <summary>Published image object appearance</summary>
TImageObjectAppearance = class(TCustomImageObjectAppearance)
published
property ScalingMode stored IsScalingModeStored nodefault;
// Common
property Width stored IsWidthStored nodefault;
property Height stored IsHeightStored nodefault;
property Align stored IsAlignStored nodefault;
property VertAlign stored IsVertAlignStored nodefault;
property Visible stored IsVisibleStored nodefault;
property PlaceOffset stored IsPlaceOffsetStored nodefault;
property Opacity stored IsOpacityStored nodefault;
end;
/// <summary>Accessory object appearance: more, disclosure, checkmark</summary>
TCustomAccessoryObjectAppearance = class(TCommonObjectAppearance)
strict private var
FAccessoryType: TAccessoryType;
procedure SetAccessoryType(const Value: TAccessoryType);
private
function GetDefaultValues: TCustomAccessoryObjectAppearance;
protected
procedure AssignTo(ADest: TPersistent); override;
function CreateDefaultValues: TObjectAppearance; override;
function IsAccessoryTypeStored: Boolean;
public
constructor Create; override;
procedure CreateObject(const AListViewItem: TListViewItem); override;
procedure ResetObject(const AListViewItem: TListViewItem); override;
property AccessoryType: TAccessoryType read FAccessoryType write SetAccessoryType;
property DefaultValues: TCustomAccessoryObjectAppearance read GetDefaultValues;
end;
/// <summary>Published accessory object appearance</summary>
TAccessoryObjectAppearance = class(TCustomAccessoryObjectAppearance)
published
property AccessoryType stored IsAccessoryTypeStored nodefault;
// Common
property Width stored IsWidthStored nodefault;
property Height stored IsHeightStored nodefault;
property Align stored IsAlignStored nodefault;
property VertAlign stored IsVertAlignStored nodefault;
property Visible stored IsVisibleStored nodefault;
property PlaceOffset stored IsPlaceOffsetStored nodefault;
property Opacity stored IsOpacityStored nodefault;
end;
/// <summary>Text button object appearance: text button that can be embedded in <c>TListItem</c></summary>
TCustomTextButtonObjectAppearance = class(TCommonObjectAppearance)
strict private var
FButtonType: TTextButtonType;
procedure SetButtonType(const Value: TTextButtonType);
private
FOnControlClick: TNotifyEvent;
FOnControlChange: TNotifyEvent;
FText: string;
FFont: TFont;
FTrimming: TTextTrimming;
FTextVertAlign: TTextAlign;
FTextAlign: TTextAlign;
FWordWrap: Boolean;
FTextColor: TAlphaColor;
FTintColor: TAlphaColor;
FPressedTextColor: TAlphaColor;
FTextShadowColor: TAlphaColor;
FEnabled: Boolean;
FHasButtonText: Boolean;
function GetDefaultValues: TCustomTextButtonObjectAppearance;
procedure SetText(const Value: string);
procedure SetFont(const Value: TFont);
procedure SetTextAlign(const Value: TTextAlign);
procedure SetTextVertAlign(const Value: TTextAlign);
procedure SetTrimming(const Value: TTextTrimming);
procedure SetWordWrap(const Value: Boolean);
procedure FontChanged(Sender: TObject);
procedure SetPressedTextColor(const Value: TAlphaColor);
procedure SetTextColor(const Value: TAlphaColor);
procedure SetTintColor(const Value: TAlphaColor);
procedure SetTextShadowColor(const Value: TAlphaColor);
procedure SetEnabled(const Value: Boolean);
protected
procedure AssignTo(ADest: TPersistent); override;
function CreateDefaultValues: TObjectAppearance; override;
function IsButtonTypeStored: Boolean;
function IsTextStored: Boolean;
function IsTrimmingStored: Boolean;
function IsFontStored: Boolean;
function IsTextAlignStored: Boolean;
function IsTextColorStored: Boolean;
function IsTintColorStored: Boolean;
function IsPressedTextColorStored: Boolean;
function IsTextShadowColorStored: Boolean;
function IsTextVertAlignStored: Boolean;
function IsWordWrapStored: Boolean;
function IsEnabledStored: Boolean;
procedure DoControlClick(Sender: TObject); virtual;
procedure DoControlChange(Sender: TObject); virtual;
public
constructor Create; override;
destructor Destroy; override;
procedure CreateObject(const AListViewItem: TListViewItem); override;
procedure ResetObject(const AListViewItem: TListViewItem); override;
property ButtonType: TTextButtonType read FButtonType write SetButtonType;
property Enabled: Boolean read FEnabled write SetEnabled;
property Text: string read FText write SetText;
property Trimming: TTextTrimming read FTrimming write SetTrimming;
property Font: TFont read FFont write SetFont;
property TextColor: TAlphaColor read FTextColor write SetTextColor;
property TintColor: TAlphaColor read FTintColor write SetTintColor;
property PressedTextColor: TAlphaColor read FPressedTextColor write SetPressedTextColor;
property TextShadowColor: TAlphaColor read FTextShadowColor write SetTextShadowColor;
// Horizontal text alignment inside local item rectangle.
property TextAlign: TTextAlign read FTextAlign write SetTextAlign;
// Vertical text alignment inside local item rectangle.
property TextVertAlign: TTextAlign read FTextVertAlign write SetTextVertAlign;
property WordWrap: Boolean read FWordWrap write SetWordWrap;
property DefaultValues: TCustomTextButtonObjectAppearance read GetDefaultValues;
property OnControlClick: TNotifyEvent read FOnControlClick write FOnControlClick;
property OnControlChange: TNotifyEvent read FOnControlChange write FOnControlChange;
end;
/// <summary>Text button object appearance: text button that can be embedded in <c>TListItem</c></summary>
TTextButtonObjectAppearance = class(TCustomTextButtonObjectAppearance)
published
property ButtonType stored IsButtonTypeStored nodefault;
property Trimming stored IsTrimmingStored nodefault;
property Font stored IsFontStored nodefault;
property Enabled stored IsEnabledStored nodefault;
property TextAlign stored IsTextAlignStored nodefault;
property TextVertAlign stored IsTextVertAlignStored nodefault;
property WordWrap stored IsWordWrapStored nodefault;
property TextColor stored IsTextColorStored nodefault;
property TintColor stored IsTintColorStored nodefault;
property PressedTextColor stored IsPressedTextColorStored nodefault;
property TextShadowColor stored IsTextShadowColorStored nodefault;
// Common
property Width stored IsWidthStored nodefault;
property Height stored IsHeightStored nodefault;
// property Height stored IsHeightStored nodefault; // Not adjustable
property Align stored IsAlignStored nodefault;
property VertAlign stored IsVertAlignStored nodefault;
property Visible stored IsVisibleStored nodefault;
property PlaceOffset stored IsPlaceOffsetStored nodefault;
property Opacity stored IsOpacityStored nodefault;
property Text stored IsTextStored nodefault;
end;
/// <summary>Glyph button appearance: checkmark, add, delete</summary>
TCustomGlyphButtonObjectAppearance = class(TCommonObjectAppearance)
strict private var
FButtonType: TGlyphButtonType;
FEnabled: Boolean;
procedure SetButtonType(const Value: TGlyphButtonType);
private
FOnControlClick: TNotifyEvent;
FOnControlChange: TNotifyEvent;
FClickOnSelect: Boolean;
function GetDefaultValues: TCustomGlyphButtonObjectAppearance;
procedure SetClickOnSelect(const AValue: Boolean);
procedure SetEnabled(const Value: Boolean);
protected
procedure AssignTo(ADest: TPersistent); override;
function CreateDefaultValues: TObjectAppearance; override;
function IsButtonTypeStored: Boolean;
function IsEnabledStored: Boolean;
function IsClickOnSelectStored: Boolean;
procedure DoControlClick(Sender: TObject); virtual;
procedure DoControlChange(Sender: TObject); virtual;
public
constructor Create; override;
procedure CreateObject(const AListViewItem: TListViewItem); override;
procedure ResetObject(const AListViewItem: TListViewItem); override;
property ButtonType: TGlyphButtonType read FButtonType write SetButtonType;
property Enabled: Boolean read FEnabled write SetEnabled;
property ClickOnSelect: Boolean read FClickOnSelect write SetClickOnSelect;
property DefaultValues: TCustomGlyphButtonObjectAppearance read GetDefaultValues;
property OnControlClick: TNotifyEvent read FOnControlClick write FOnControlClick;
property OnControlChange: TNotifyEvent read FOnControlChange write FOnControlChange;
end;
/// <summary>Glyph button appearance: checkmark, add, delete</summary>
TGlyphButtonObjectAppearance = class(TCustomGlyphButtonObjectAppearance)
published
property ButtonType stored IsButtonTypeStored nodefault;
property Enabled stored IsEnabledStored nodefault;
property ClickOnSelect stored IsClickOnSelectStored nodefault;
// Common
property Width stored IsWidthStored nodefault;
property Height stored IsHeightStored nodefault;
property Align stored IsAlignStored nodefault;
property VertAlign stored IsVertAlignStored nodefault;
property Visible stored IsVisibleStored nodefault;
property PlaceOffset stored IsPlaceOffsetStored nodefault;
property Opacity stored IsOpacityStored nodefault;
end;
TAppearanceObjects = class abstract (TPersistent)
public type
TControlEvent = procedure(const Sender: TObject; const AControl: TListItemSimpleControl) of object;
TCreatingObjectsEvent = procedure(const Sender: TObject; const AListViewItem: TListViewItem; var AHandled: Boolean) of object;
TCreateObjectsEvent = procedure(const Sender: TObject; const AListViewItem: TListViewItem) of object;
private const
cDefaultHeight = 44;
cDefaultHeaderHeight = 24;
strict private
[Weak] FOwnerControl: TControl;
FResources: IListItemStyleResources;
private
FOnChange: TNotifyEvent;
FOnChangeHeight: TNotifyEvent;
FOnButtonClick: TItemControlEvent;
FOnButtonChange: TItemControlEvent;
function GetHeight: Integer; virtual;
procedure SetHeight(Value: Integer); virtual;
procedure TakeOwnership(const NewOwner: TControl);
protected
procedure ItemPropertyChange(Sender: TObject);
procedure DoChange; virtual;
procedure DoChangeHeight; virtual;
procedure AssignTo(ADest: TPersistent); override;
procedure UpdateSizes(const FinalSize: TSizeF); virtual;
function DefaultHeight: Integer; virtual;
function GetPublishedObjects: TArray<TCommonObjectAppearance>; virtual;
function GetObjects: TArray<TCommonObjectAppearance>; virtual;
// For custom appearances to read/write TAppearanceListViewItem.Data
procedure SetObjectData(const AListViewItem: TListViewItem; const AIndex: string; const AValue: TValue; var AHandled: Boolean); virtual;
function StyleResourcesNeedUpdate: Boolean;
function GetStyleResources: TListItemStyleResources;
property OwnerControl: TControl read FOwnerControl;
public
constructor Create(const Owner: TControl); virtual;
/// <summary>Initialize view ("objects") of specified TListViewItem using objects of this Appearance. If
/// the view is already initialized, it will be fully updated.</summary>
procedure ResetObjects(const AListViewItem: TListViewItem; const FinalSize: TSizeF); virtual;
property Height: Integer read GetHeight write SetHeight;
procedure BeginUpdate;
procedure EndUpdate;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChangeHeight: TNotifyEvent read FOnChangeHeight write FOnChangeHeight;
property Objects: TArray<TCommonObjectAppearance> read GetObjects;
property PublishedObjects: TArray<TCommonObjectAppearance> read GetPublishedObjects;
property OnButtonClick: TItemControlEvent write FOnButtonClick;
property OnButtonChange: TItemControlEvent write FOnButtonChange;
end;
// Includes Text, Detail, etc.
TItemAppearanceObjects = class(TAppearanceObjects)
private const
cDefaultHeight = TAppearanceObjects.cDefaultHeight;
strict private
FText: TTextObjectAppearance;
FDetail: TTextObjectAppearance;
FImage: TImageObjectAppearance;
FAccessory: TAccessoryObjectAppearance;
FTextButton: TTextButtonObjectAppearance;
FGlyphButton: TGlyphButtonObjectAppearance;
FHeight: Integer;
FObjects: TArray<TCommonObjectAppearance>;
FPublishedObjects: TArray<TCommonObjectAppearance>;
procedure SetAccessoryElement(const Value: TAccessoryObjectAppearance);
procedure SetTextButtonElement(const Value: TTextButtonObjectAppearance);
procedure SetGlyphButtonElement(const Value: TGlyphButtonObjectAppearance);
procedure SetImageElement(const Value: TImageObjectAppearance);
procedure SetTextElement(const Value: TTextObjectAppearance);
procedure SetDetailElement(const Value: TTextObjectAppearance);
protected
procedure AssignTo(ADest: TPersistent); override;
function GetHeight: Integer; override;
procedure SetHeight(Value: Integer); override;
function DefaultHeight: Integer; override;
function GetPublishedObjects: TArray<TCommonObjectAppearance>; override;
procedure AddObject(const AObjectAppearance: TCommonObjectAppearance; APublished: Boolean);
/// <summary>Search Objects and PublishedObjects for an object with the same name as that of given
/// AObjectAppearance and replace them with it. If not found, append.</summary>
function UpdateObject(const AObjectAppearance: TCommonObjectAppearance; APublished: Boolean):
TCommonObjectAppearance;
/// <summary>Remove given AObjectAppearance from Objects and PublishedObjects</summary>
procedure RemoveObject(const AObjectAppearance: TCommonObjectAppearance);
function GetObjects: TArray<TCommonObjectAppearance>; override;
public
constructor Create(const Owner: TControl); overload; override;
destructor Destroy; override;
property Text: TTextObjectAppearance read FText write SetTextElement;
property Detail: TTextObjectAppearance read FDetail write SetDetailElement;
property Image: TImageObjectAppearance read FImage write SetImageElement;
property Accessory: TAccessoryObjectAppearance read FAccessory write SetAccessoryElement;
property TextButton: TTextButtonObjectAppearance read FTextButton write SetTextButtonElement;
property GlyphButton: TGlyphButtonObjectAppearance read FGlyphButton write SetGlyphButtonElement;
end;
TItemAppearanceObjectsClass = class of TItemAppearanceObjects;
{$ENDREGION}
TRegisterAppearanceOption = (Footer, Header, Item, ItemEdit, DefaultFooter, DefaultHeader, DefaultItem, DefaultItemEdit);
TRegisterAppearanceOptions = set of TRegisterAppearanceOption;
TRegisteredAppearance = record
Name: string;
Value: TItemAppearanceObjectsClass;
UnitName: string;
Options: TRegisterAppearanceOptions;
end;
///<summary>Represents properties of Item Appearance that define geometric properties of the entire ListViewItem,
/// specify AppearanceClass and AppearanceClassName that define Item Appearance Objects that comprise item's view.
/// </summary>
TItemAppearanceProperties = class(TInterfacedPersistent, IDesignablePersistent, ISpriggedPersistent)
public type
TControlEvent = TAppearanceObjects.TControlEvent;
TItemAppearanceObjectsClass = TItemAppearanceObjectsClass;
TAppearancePropertiesEvent = procedure(const Sender: TItemAppearanceProperties) of object;
public const
cDefaultHeight = TAppearanceObjects.cDefaultHeight;
strict private
FOwnerControl: TControl;
FName: string;
FAppearanceType: TAppearanceType;
FAppearanceCache: TDictionary<TItemAppearanceObjectsClass, TItemAppearanceObjects>;
FAppearance: TItemAppearanceObjects;
FAppearanceClass: TItemAppearanceObjectsClass;
FPurpose: TListItemPurpose;
FPropertiesOwner: IPublishedAppearanceOwner;
FOnChange: TNotifyEvent;
FOnDestroy: TNotifyEvent;
FSprig: TPersistent;
FShim: IPersistentShim;
procedure SetName(const Value: string);
procedure SetObjects(const Value: TItemAppearanceObjects);
procedure PropertiesChange(Sender: TObject);
procedure PropertiesChangeHeight(Sender: TObject);
function GetHeight: Integer;
procedure SetHeight(AValue: Integer);
procedure SetAppearanceClass(const Value: TItemAppearanceObjectsClass);
function GetAppearanceClassName: string;
procedure SetAppearanceClassName(const Value: string);
function GetActive: Boolean;
function PropertiesOwner: IPublishedAppearanceOwner;
{ IDesignableAppearance }
function GetBoundsRect: TRect;
function GetDesignParent: TPersistent;
procedure BindShim(AShim: IPersistentShim);
procedure UnbindShim;
procedure IDesignablePersistent.Bind = BindShim;
procedure IDesignablePersistent.Unbind = UnbindShim;
function BeingDesigned: Boolean;
procedure SetSprig(const APersistent: TPersistent);
function GetSprig: TPersistent;
protected
/// <summary>Notify PropertiesOwner of change in its Item Appearance Properties and invoke
/// FOnChange event if it is assigned.</summary>
procedure DoChange; virtual;
/// <summary>Notify PropertiesOwner of item height change</summary>
procedure DoChangeHeight; virtual;
/// <summary>Notify PropertiesOwner that the objects that comprise the appearance represented by these
/// properties have been changed</summary>
procedure DoChangeObjects; virtual;
/// <summary>True if the Height property is user modified</summary>
function IsHeightStored: Boolean;
public
constructor Create(const Owner: TControl; AType: TAppearanceType);
destructor Destroy; override;
/// <summary>Owner control for property editors. The host TListView.</summary>
property Owner: TControl read FOwnerControl;
/// <summary>Item purpose: None (regular), Header, Footer.</summary>
property Purpose: TListItemPurpose read FPurpose;
/// <summary>The class that defines objects that comprise item appearance. E.g. TListItemAppearance. See also
/// AppearanceClassName.</summary>
property AppearanceClass: TItemAppearanceObjectsClass read FAppearanceClass write SetAppearanceClass;
/// <summary>AppearanceClass name. The class with given name will be searched in TAppearancesRegistry
/// and if found, used to intialize appearance.</summary>
property AppearanceClassName: string read GetAppearanceClassName write SetAppearanceClassName;
/// <summary>Indicates that this appearance is currently active. EditMode appearance will be inactive in regular
/// mode and active when ListView is in Edit Mode. The opposite is true for regular Item Appearances.</summary>
property Active: Boolean read GetActive;
/// <summary>Display name for this Item Appearance</summary>
property Name: string read FName write SetName stored False;
/// <summary>Specifies Item Height.</summary>
property Height: Integer read GetHeight write SetHeight;
/// <summary>Appearance Item Objects that comprise this Item Appearance, e.g. 'Text', 'Image', etc</summary>
property Objects: TItemAppearanceObjects read FAppearance write SetObjects; // Objects is published name of Appearance
/// <summary>Appearance type: (Item, ItemEdit, Header, Footer)</summary>
property AppearanceType: TAppearanceType read FAppearanceType;
/// <summary>Event to be invoked when these change</summary>
property OnChange: TNotifyEvent read FOnChange write FOnChange;
/// <summary>Event to be invoked when is instance is being destroyed</summary>
property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
end;
// Does not create objects
TEmptyItemObjects = class(TItemAppearanceObjects)
private const
cDefaultHeight = TAppearanceObjects.cDefaultHeight;
private var
FHeight: Integer;
protected
procedure SetHeight(Value: Integer); override;
function GetHeight: Integer; override;
function DefaultHeight: Integer; override;
public
constructor Create(const Owner: TControl); override;
end;
// Disables all services for managing TAppearanceListViewItem.Objects, such as creating and resizing
TNullItemObjects = class(TEmptyItemObjects)
end;
// Set some defaults on Text, Detail, etc.
TCustomItemObjects = class(TItemAppearanceObjects)
public const
cDefaultHeight = TAppearanceObjects.cDefaultHeight;
cDefaultButtonHeight = 31;
cDefaultTextButtonWidth = 64;
cDefaultImageWidth = 29;
cDefaultImageHeight = 29;
cDefaultImageTextPlaceOffsetX = 10;
cDefaultGlyphPlaceOffsetX = -6;
protected
procedure UpdateSizes(const FinalSize: TSizeF); override;
procedure SetInternalSize(const AGlyphButton: TGlyphButtonObjectAppearance;
AStyleResources: TListItemStyleResources); overload;
procedure SetInternalSize(const AAccessory: TAccessoryObjectAppearance;
AStyleResources: TListItemStyleResources); overload;
function DefaultHeight: Integer; override;
public
constructor Create(const Owner: TControl); override;
property Text;
property Detail;
property Image;
property Accessory;
property TextButton;
property GlyphButton;
end;
// Base class for item object presets
TPresetItemObjects = class(TCustomItemObjects)
public type
TGroupClass = class of TPresetItemObjects;
protected
// Identify the ancestor class that supports resetobjects
function GetGroupClass: TGroupClass; virtual;
// Indicate if this is an itemedit appearance
function GetIsItemEdit: Boolean; virtual;
property IsItemEdit: Boolean read GetIsItemEdit;
property GroupClass: TGroupClass read GetGroupClass;
public
procedure ResetObjects(const AListViewItem: TListViewItem; const FinalSize: TSizeF); override;
end;
/// <summary>Represents appearance in the object inspector: appearance names for all item purposes and
/// item heights</summary>
TPublishedAppearance = class(TPersistent)
strict private
FOwnerComponent: TComponent;
FPropertiesOwner: IPublishedAppearanceOwner;
function GetFooterAppearance: string;
function GetFooterHeight: Integer;
function GetHeaderAppearance: string;
function GetHeaderHeight: Integer;
function GetItemAppearance: string;
function GetItemEditAppearance: string;
function GetItemHeight: Integer;
function GetItemEditHeight: Integer;
procedure SetFooterAppearance(const Value: string);
procedure SetFooterHeight(const Value: Integer);
procedure SetHeaderAppearance(const Value: string);
procedure SetHeaderHeight(const Value: Integer);
procedure SetItemAppearance(const Value: string);
procedure SetItemEditAppearance(const Value: string);
procedure SetItemHeight(const Value: Integer);
procedure SetItemEditHeight(const Value: Integer);
function IsFooterHeightStored: Boolean;
function IsHeaderHeightStored: Boolean;
function IsItemEditHeightStored: Boolean;
function IsItemHeightStored: Boolean;
published
constructor Create(const AOwner: TComponent);
property Owner: TComponent read FOwnerComponent;
property ItemHeight: Integer read GetItemHeight write SetItemHeight stored IsItemHeightStored nodefault;
property ItemEditHeight: Integer read GetItemEditHeight write SetItemEditHeight stored IsItemEditHeightStored nodefault;
property HeaderHeight: Integer read GetHeaderHeight write SetHeaderHeight stored IsHeaderHeightStored nodefault;
property FooterHeight: Integer read GetFooterHeight write SetFooterHeight stored IsFooterHeightStored nodefault;
property ItemAppearance: string read GetItemAppearance write SetItemAppearance stored False;
property ItemEditAppearance: string read GetItemEditAppearance write SetItemEditAppearance stored False;
property HeaderAppearance: string read GetHeaderAppearance write SetHeaderAppearance stored False;
property FooterAppearance: string read GetFooterAppearance write SetFooterAppearance stored False;
end;
/// <summary>Represents appearance items (collections of objects comprising appearances)
/// in the object inspector</summary>
TPublishedObjects = class(TPersistent)
private
FOwner: IPublishedAppearanceOwner;
function GetFooterObjects: TItemAppearanceObjects;
function GetHeaderObjects: TItemAppearanceObjects;
function GetItemEditObjects: TItemAppearanceObjects;
function GetItemObjects: TItemAppearanceObjects;
procedure SetFooterObjects(const Value: TItemAppearanceObjects);
procedure SetHeaderObjects(const Value: TItemAppearanceObjects);
procedure SetItemEditObjects(const Value: TItemAppearanceObjects);
procedure SetItemObjects(const Value: TItemAppearanceObjects);
published
constructor Create(const AOwner: IPublishedAppearanceOwner);
property ItemObjects: TItemAppearanceObjects read GetItemObjects write SetItemObjects;
property ItemEditObjects: TItemAppearanceObjects read GetItemEditObjects write SetItemEditObjects;
property HeaderObjects: TItemAppearanceObjects read GetHeaderObjects write SetHeaderObjects;
property FooterObjects: TItemAppearanceObjects read GetFooterObjects write SetFooterObjects;
end;
/// <summary>Registered appearance descriptor used in TAppearancesRegistry</summary>
TRegisterAppearanceValue = record
/// <summary>Appearance name</summary>
Name: string;
/// <summary>Appearance unit name</summary>
UnitName: string;
/// <summary>Appearance options: Footer, Header, Item, ItemEdit, DefaultFooter,
/// DefaultHeader, DefaultItem, DefaultItemEdit</summary>
Options: TRegisterAppearanceOptions;
constructor Create(const AName: string; AOptions: TRegisterAppearanceOptions; const AUnitName: string);
end;
/// <summary>Global registry of Item Appearances</summary>
TAppearancesRegistry = class
private class var
FFactories: TDictionary<TItemAppearanceObjectsClass, TRegisterAppearanceValue>;
public const
cRegisterDefault = [TRegisterAppearanceOption.DefaultFooter, TRegisterAppearanceOption.DefaultHeader,
TRegisterAppearanceOption.DefaultItem, TRegisterAppearanceOption.DefaultItemEdit];
cRegisterAll = [
TRegisterAppearanceOption.Footer, TRegisterAppearanceOption.Header, TRegisterAppearanceOption.Item,
TRegisterAppearanceOption.ItemEdit, TRegisterAppearanceOption.DefaultFooter,
TRegisterAppearanceOption.DefaultHeader, TRegisterAppearanceOption.DefaultItem,
TRegisterAppearanceOption.DefaultItemEdit];
class constructor Create;
class destructor Destroy;
/// <summary>Register appearances from an array</summary>
class procedure RegisterAppearances(AFactories: TArray<TItemAppearanceObjectsClass>; ADisplayNames: TArray<string>;
AOptions: TRegisterAppearanceOptions = [TRegisterAppearanceOption.Item]; const AUnitName: string = ''); overload;
/// <summary>Register a single appearance</summary>
class procedure RegisterAppearance(const AFactory: TItemAppearanceObjectsClass; const ADisplayName: string;
AOptions: TRegisterAppearanceOptions = [TRegisterAppearanceOption.Item]; const AUnitName: string = ''); overload;
/// <summary>Unregister an item appearance</summary>
class procedure UnregisterAppearance(const AFactory: TItemAppearanceObjectsClass); overload;
/// <summary>Unregister appearances from an array</summary>
class procedure UnregisterAppearances(AFactories: TArray<TItemAppearanceObjectsClass>); overload;
/// <summary>Get registered appearances, filtered by kind. See TRegisterAppearanceOption</summary>
class function GetRegisteredAppearances(AFilter: TRegisterAppearanceOptions = []): TArray<TRegisteredAppearance>;
/// <summary>Find TItemAppearanceObjectsClass by option.
/// See TRegisterAppearanceOption, TItemAppearanceObjectsClass </summary>
class function FindItemAppearanceObjectsClassByOption(AOption: TRegisterAppearanceOption): TItemAppearanceObjectsClass;
end;
//== INTERFACE END: FMX.ListView.Appearances
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.ListView.DynamicAppearance (from FMX.ListView.DynamicAppearance.pas)
//==================================================================================================
type
TDynamicAppearance = class;
/// <summary>
/// TAppearanceObjectItem is an item in TAppearanceObjectItemCollection with
/// AppearanceObjectName, AppearanceObjectClassName and the object itself (Appearance).
/// </summary>
TAppearanceObjectItem = class(TCollectionItem)
private const
FObjectAppearanceClassNames: array [0..4] of TClass = (TTextObjectAppearance, TImageObjectAppearance,
TTextButtonObjectAppearance, TGlyphButtonObjectAppearance, TAccessoryObjectAppearance);
private
[Weak] FOwner: TDynamicAppearance;
FAppearance: TCommonObjectAppearance;
FAppearanceClass: TClass;
FObjectName: string;
procedure SetAppearanceClass(Value: TClass);
procedure SetAppearance(Value: TCommonObjectAppearance);
function GetObjectName: string;
procedure SetObjectName(Value: string);
function GetClassName: string;
procedure SetClassName(Value: string);
public
procedure Assign(Source: TPersistent); override;
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
published
///<summary>Name of this appearance object, e.g. 'text'</summary>
property AppearanceObjectName: string read GetObjectName write SetObjectName nodefault;
///<summary>Class name of this appearance object, e.g. TTextObjectAppearance</summary>
property AppearanceClassName: string read GetClassName write SetClassName nodefault;
///<summary>Object appearance itself</summary>
property Appearance: TCommonObjectAppearance read FAppearance write SetAppearance;
end;
///<summary>Collection of Items representing Appearance Objects that comprise a dynamic appearance.</summary>
TAppearanceObjectItemCollection = class(TOwnedCollection)
private
[Weak] FDynamicAppearance: TDynamicAppearance;
protected
procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
{ Design }
function GetAttrCount: Integer; override;
function GetAttr(Index: Integer): string; override;
function GetItemAttr(Index, ItemIndex: Integer): string; override;
public
///<summary>Create new TAppearanceObjectItemCollection for specified DynamicAppearance</summary>
constructor Create(Owner: TComponent; DynamicAppearance: TDynamicAppearance); reintroduce;
procedure BeginUpdate; override;
procedure EndUpdate; override;
end;
///<summary>User-defined, designable ListView Item appearance. This class is one of the items
///that can be selected in the Object Inspector as an item appearance for Header, Item and Footer.
///
///Unlike static appearances, the objects in this one are stored in a collection. The collection can be
///filled with any combination of objects, which can then be edited in the designer to create fully
///customized item look.</summary>
TDynamicAppearance = class(TPresetItemObjects)
strict private
FObjectsCollection: TCollection;
protected
function GetGroupClass: TPresetItemObjects.TGroupClass; override;
function GetObjectsCollection: TCollection;
procedure SetObjectsCollection(Value: TCollection);
///<summary>Create new Object Apperance specified by AppearanceClass and Name and initialize Item.Appearance
///with it.</summary>
procedure CreateObjectAppearance(const AppearanceClass: TClass; const Name: string; const Item: TAppearanceObjectItem);
///<summary>Initialize DataMember for given ObjectAppearance. The expression is Data[ObjectAppearance.Name].</summary>
procedure InitDataMember(const ObjectAppearance: TCommonObjectAppearance);
///<summary>Invoked when an appearance object is modified</summary>
procedure ObjectPropertyChange(Sender: TObject);
///<summary>Invoked when an appearance object is renamed</summary>
procedure ObjectRenamed(const Sender: TCommonObjectAppearance; const OldName: string);
///<summary>Propagate change notification up. Used by ObjectRemoving, ObjectAdded.</summary>
procedure ItemAppearanceChange;
///<summary>Called when item is removed from the ObjectsCollection</summary>
procedure ObjectRemoving(const Value: TCommonObjectAppearance);
///<summary>Called when item is added to the ObjectsCollection</summary>
procedure ObjectAdded(const Value: TCommonObjectAppearance);
public
constructor Create(const Owner: TControl); override;
destructor Destroy; override;
published
///<summary>Collection of Object Appearances that comprise this Item Appearance</summary>
property ObjectsCollection: TCollection read GetObjectsCollection write SetObjectsCollection;
end;
//== INTERFACE END: FMX.ListView.DynamicAppearance
//==================================================================================================
//==================================================================================================
//== INTERFACE START: FMX.ListView (from FMX.ListView.pas)
//==================================================================================================
{$SCOPEDENUMS ON}
type
/// <summary>List view class that provides members that subclasses may use to
/// communicate with a list view adapter that contains the actual items of the
/// list view.</summary>
TAdapterListView = class(TStyledControl)
strict private
FAdapter: IListViewAdapter;
FHeightSumsNeedUpdate: Boolean;
procedure ItemsMayChange(Sender: TObject);
procedure ItemsCouldHaveChanged(Sender: TObject);
procedure ItemsChange(Sender: TObject);
procedure ItemsResize(Sender: TObject);
procedure ItemsInvalidate(Sender: TObject);
procedure ResetView(Sender: TObject);
protected
/// <summary>Called after the adapter had been set, <see cref='SetAdapter'>SetAdapter</see></summary>
procedure DoAdapterSet; virtual;
/// <summary>Set <see cref='FMX.ListView.Types.IListViewAdapter'>IListViewAdapter</see></summary>
procedure SetAdapter(Adapter: IListViewAdapter);
/// <summary>Request update of item heights</summary>
procedure InvalidateHeights;
/// <summary>Handler of <see cref='IListViewAdapter.OnChanged>IListViewAdapter.OnChanged</see></summary>
procedure DoItemsChange; virtual;
/// <summary>Handler of
/// <see cref='IListViewAdapter.OnItemsMayChange'>IListViewAdapter.OnItemsMayChange</see></summary>
procedure DoItemsMayChange; virtual;
/// <summary>Handler of
/// <see cref='IListViewAdapter.OnItemsCouldHaveChanged'>IListViewAdapter.OnItemsCouldHaveChanged</see></summary>
procedure DoItemsCouldHaveChanged; virtual;
/// <summary>Handler of <see cref='IListViewAdapter.OnItemsResize'>IListViewAdapter.OnItemsResize</see></summary>
procedure DoItemsResize; virtual;
/// <summary>Handler of
/// <see cref='IListViewAdapter.OnItemsInvalidate'>IListViewAdapter.OnItemsInvalidate</see></summary>
procedure DoItemsInvalidate; virtual;
/// <summary>Handler of
/// <see cref='IListViewAdapter.OnResetView'>IListViewAdapter.OnResetView</see></summary>
procedure DoResetView(const Sender: TListItem); virtual;
/// <summary><c>True</c> if update of item height cache is required. Set by <c>InvalidateHeights</c></summary>
property HeightSumsNeedUpdate: Boolean read FHeightSumsNeedUpdate write FHeightSumsNeedUpdate;
public
/// <summary><c>IListViewAdapter</c> providing contents of this <c>TAdapterListView</c></summary>
property Adapter: IListViewAdapter read FAdapter write SetAdapter;
end;
/// <summary>The minimal ListView that's actually a real UI control. It implements all scrolling and drawing
/// functionality. It needs a valid IListViewAdapter to provide item views;
/// see <see cref='TAdapterListView.Adapter'>TAdapterListView.Adapter</see></summary>
///
/// <remarks>
/// Implements:
/// <para><c>ISearchResponder</c> enables setting a filter predicate</para>
/// <para><c>IListItemStyleResources</c> access to style resources</para>
/// <para><c>IListViewController</c> mediator protocol between <c>TListView</c> and <c>TListItem</c></para>
/// <para><c>IGlyph</c> interface to <c>TImageList</c></para>
/// <para><c>IMessageSendingCompatible</c> TMessageSender object for FMX.Presentation compatibility</para>
/// </remarks>
TListViewBase = class(TAdapterListView, ISearchResponder, IListItemStyleResources, IListViewController, IGlyph,
IMessageSendingCompatible, IControlTypeSupportable)
private const
ChangeRepaintedIncidentDelay = 0.1; // seconds
PhysicsProcessingInterval = 8; // 8 ms for ~120 frames per second
RecurrentTimerInterval = 16; // 16 ms for ~60 frames per second
AutoTapScrollingSpeed = 8; // pixels per frame
AutoTapMaxScrollingTime = 1; // seconds
TapSelectWaitTime = 0.25; // seconds
SelectionFadeInTime = 0.125; // seconds
SelectionFadeOutTime = 0.25; // seconds
MinScrollThreshold = 10;
MinSwypeThreshold = 40;
DefaultDeleteButtonWidth = 72;
ItemSeparatorTop = 1;
ItemSeparatorBottom = 2;
EditModeSelectionAlpha = 0.25; // how bright the checked items are in editmode
EditModeAnimationDuration = 0.1; // in seconds
DeleteModeAnimationDuration = 0.15; // in seconds
DefaultDeleteButtonText = 'Delete';
PullRefreshIndicatorStrengthStart = 16;
PullRefreshIndicatorMaxSteps = 12;
DefaultLeftMargin = 10;
DefaultRightMargin = 11;
public type
/// <summary>Edit mode change event</summary>
/// <param name="Sender">event source (TListViewBase)</param>
/// <param name="AHandled">set to <c>True</c> if event was handled</param>
THandleChangeEvent = procedure(const Sender: TObject; var AHandled: Boolean) of object;
/// <summary>Generic TListItem event; used for <c>OnListItemClick</c>, <c>OnItemChange</c></summary>
/// <param name="Sender">event source (TListViewBase)</param>
/// <param name="AItem">item being acted upon</param>
TListItemEvent = procedure(const Sender: TObject; const AItem: TListItem) of object;
/// <summary>OnItemClickEx event</summary>
/// <param name="Sender">event source</param>
/// <param name="ItemIndex">index of item</param>
/// <param name="LocalClickPos">click position in item local coordinates</param>
/// <param name="ItemObject"><c>TListItemDrawable</c> that received the click</param>
TListItemClickEventEx = procedure(const Sender: TObject; ItemIndex: Integer; const LocalClickPos: TPointF;
const ItemObject: TListItemDrawable) of object;
/// <summary><c>OnUpdateItemView</c> event</summary>
TUpdateItemViewEvent = TListItemEvent;
/// <summary><c>OnUpdatingItemView</c> event</summary>
TUpdatingItemViewEvent = procedure(const Sender: TObject; const AItem: TListItem; var AHandled: Boolean) of object;
/// <summary><c>OnDeletingItem</c> event</summary>
TDeletingItemEvent = procedure(Sender: TObject; AIndex: Integer; var ACanDelete: Boolean) of object;
/// <summary><c>OnDeleteItem</c> event</summary>
TDeleteItemEvent = procedure(Sender: TObject; AIndex: Integer) of object;
/// <summary><c>OnDeleteChangeVisible</c> event</summary>
TDeleteChangeVisibilityEvent = procedure(Sender: TObject; AValue: Boolean) of object;
private type
TItemHeightSums = TList<Integer>;
TDelayedIncident = (ChangeRepainted, Invalidate, SetItemIndex, ClickEvent);
TDelayedIncidentEntry = record
Incident: TDelayedIncident;
Triggered: Boolean;
StartTime: Double;
TimeToWait: Double;
CustomData: NativeInt;
end;
TDelayedIncidents = TList<TDelayedIncidentEntry>;
TTransitionType = (None, EditMode, DeleteMode);
TInternalDragMode = (None, Drag, Swype);
TItemSelectionAlpha = record
StartTime: Double;
Alpha: Single;
StartAlpha: Single;
class function Create(const StartTime: Double; const Alpha, StartAlpha: Single): TItemSelectionAlpha; static; inline;
end;
TItemSelectionAlphas = TDictionary<Integer, TItemSelectionAlpha>;
TPullRefreshAnimation = (NotPlaying, Playing, Finished);
TStateFlag = (NeedsRebuild, NeedsScrollingLimitsUpdate, Invalid, Painting, ResettingObjects, ScrollingActive,
ScrollingMouseTouch, NeedsScrollBarDisplay);
TStateFlags = set of TStateFlag;
TEstimatedHeights = record
Item: Single;
Header: Single;
Footer: Single;
end;
private
FTimerService: IFMXTimerService;
FSystemInformationService: IFMXSystemInformationService;
FListingService: IFMXListingService;
FStateFlags: TStateFlags;
FRecurrentTimerHandle: TFmxHandle;
FDelayedIncidents: TDelayedIncidents;
FSelectionAlphas: TItemSelectionAlphas;
FItemIndex: Integer;
FAniCalc: TAniCalculations;
FScrollViewPos: Single;
FBrush: TBrush;
FStroke: TStrokeBrush;
FMouseDownAt: TPointF;
FMouseClickPrev: TPointF;
FMouseClickDelta: TPointF;
FMouseClicked: Boolean;
FMouseClickIndex: Integer;
FMouseEventIndex: Integer;
FItemSpaces: TBounds;
FMousePrevScrollPos: Single;
FClickEventItemIndex: Integer;
FClickEventMousePos: TPointF;
[Weak] FClickEventControl: TListItemDrawable;
FHeightSums: TItemHeightSums;
FMaxKnownHeight: Integer;
FSideSpace: Integer;
FScrollScale: Single;
FBackgroundStyleColor: TAlphaColor;
FSelectionStyleColor: TAlphaColor;
FItemStyleFillColor: TAlphaColor;
FItemStyleFillAltColor: TAlphaColor;
FItemStyleFrameColor: TAlphaColor;
[Weak] FSelectionStyleImage: TStyleObject;
[Weak] FHeaderStyleImage: TStyleObject;
FTouchAnimationObject: ITouchAnimationObject;
FScrollBar: TScrollBar;
FTransparent: Boolean;
FAllowSelection: Boolean;
FAlternatingColors: Boolean;
FTapSelectItemIndex: Integer;
FTapSelectNewIndexApplied: Integer;
FTapSelectStartTime: Double;
FShowSelection: Boolean;
FOnChange: TNotifyEvent;
FOnChangeRepainted: TNotifyEvent;
FOnItemsChange: TNotifyEvent;
FOnScrollViewChange: TNotifyEvent;
FOnSearchChange: TNotifyEvent;
FOnFilter: TFilterEvent;
FAutoTapScroll: Boolean;
FAutoTapTreshold: Integer;
FAutoTapDistance: Integer;
FOnListItemClick: TListItemEvent;
FOnItemClickEx: TListItemClickEventEx;
FOnItemChange: TListItemEvent;
FOnEditModeChanging: THandleChangeEvent;
FOnEditModeChange: TNotifyEvent;
FOnUpdateItemView: TUpdateItemViewEvent;
FOnUpdatingItemView: TUpdatingItemViewEvent;
FOnDeleteChange: TDeleteChangeVisibilityEvent;
FOnDeletingItem: TDeletingItemEvent;
FOnDeleteItem: TDeleteItemEvent;
FOnPullRefresh: TNotifyEvent;
FDeleteButtonText: string;
FEditMode: Boolean;
FCanSwipeDelete: Boolean;
FDeleteButtonIndex: Integer;
FPrevDeleteButtonIndex: Integer;
FStyleResources: TListItemStyleResources;
FUpdatingStyleResources: Boolean;
FDisableMouseWheel: Boolean;
FTransitionStartTime: Double;
FTransitionType: TTransitionType;
FEditModeTransitionAlpha: Single;
FDeleteModeTransitionAlpha: Single;
FDeleteLayout: TLayout;
FDeleteButton: TSpeedButton;
FDragListMode: TInternalDragMode;
FSearchEdit: TSearchBox;
FSearchVisible: Boolean;
FSearchAlwaysOnTop: Boolean;
FSelectionCrossfade: Boolean;
FPullToRefresh: Boolean;
FPullRefreshWait: Boolean;
FPullRefreshTriggered: Boolean;
FPullRefreshAnimation: TPullRefreshAnimation;
FPullRefreshAnimationStartTime: Double;
FPullRefreshAnimationStopTime: Double;
FScrollStretchStrength: Single;
FControlType: TControlType;
FNativeOptions: TListViewNativeOptions;
FImageLink: TGlyphImageLink;
FMessageSender: TMessageSender;
FItemSelectedBeforeChange: TListItem;
FEstimatedHeights: TEstimatedHeights;
function IsRunningOnDesktop: Boolean;
function HasTouchTracking: Boolean;
function HasSearchFeatures: Boolean;
function HasSearchAsItem: Boolean;
function IsDeleteModeAllowed: Boolean;
function HasStretchyScrolling: Boolean;
function HasPhysicsStretchyScrolling: Boolean;
function HasScrollingStretchGlow: Boolean;
function HasPullRefreshStroke: Boolean;
function CanDisplaySelectionForItem(const Index: Integer; const Item: TListItem = nil;
const IncludeMultiSelect: Boolean = False; const IncludeCrossFaded: Boolean = False): Boolean;
function GetDefaultSelectionAlpha: Single;
function GetItemSelectionAlpha(const Index: Integer): Single;
procedure DestroyRecurrentTimer;
procedure UpdateRecurrentTimer;
function HasRecurrentTimerEvents: Boolean;
procedure RecurrentTimerEvent;
procedure StartIncident(const Incident: TDelayedIncident; const Triggered: Boolean = True;
const TimeToWait: Single = 0; const CustomData: NativeInt = 0);
procedure ProcessIncident(const Entry: TDelayedIncidentEntry);
procedure TriggerIncidents(const Incident: TDelayedIncident; const ResetStartupTime: Boolean = True);
procedure ProcessDelayedIncidents;
procedure ProcessTransitionAnimation;
procedure ProcessTapSelectItem;
procedure ProcessSelectionAlphas;
procedure InsertItemCrossFade(const Index: Integer; const ShowAnimation: Boolean);
procedure RemoveItemCrossFade(const Index: Integer);
procedure StartPullRefreshAnimation;
procedure ProcessPullRefreshAnimation;
function GetPullRefreshStrength: Single;
function GetPullRefreshIndicatorSteps: Integer;
function GetPullRefreshIndicatorAlpha: Single;
function GetPullRefreshStrokeWidth: Single;
procedure PaintPullRefreshIndicator(const ACanvas: TCanvas; const AStrength, AOpacity: Single);
procedure PaintPullRefreshStroke(const ACanvas: TCanvas; const AStrength, AOpacity: Single);
procedure PaintScrollingStretchGlow(const ACanvas: TCanvas; const AIntensity, AOpacity: Single);
procedure UpdatePullRefreshState;
procedure UpdateScrollStretchStrength(const NewValue: Single);
procedure DeleteButtonClicked(Sender: TObject);
procedure ScrollBarChange(Sender: TObject);
procedure ItemSpacesChange(Sender: TObject);
procedure AniCalcChange(Sender: TObject);
procedure AniCalcStart(Sender: TObject);
procedure AniCalcStop(Sender: TObject);
function GetItemIndex: Integer;
procedure SetItemIndex(const Value: Integer);
procedure SetItemIndexInternal(const Value: Integer; const DisableSelection: Boolean = False;
const DisableCrossfade: Boolean = False);
function GetMaxScrollViewPos: Integer;
procedure UpdateScrollViewPos(const Value: Single);
procedure UpdateSearchEditPos;
procedure SetScrollViewPos(const Value: Single);
procedure UpdateScrollingLimits;
procedure UpdateScrollBar;
procedure GetNumberOfRenderingPasses(const StartItem, EndItem: Integer; var Passes, Subpasses: Integer);
function GetItemHeight(const Index: Integer): Integer; overload; virtual;
function GetItemRelRect(const Index: Integer; const LocRect: TRectF; const SideSpace: Integer = 0): TRectF; inline;
function GetItemGroupSeparators(const Index: Integer): Integer; inline;
function FindLocalItemObjectAtPosition(const ItemIndex: Integer; const Position: TPointF): TListItemDrawable;
function GetSeparatorLineHeight: Single;
function AlignValueToPixel(const Value: Single): Single;
procedure DrawItemsFill(const StartItem, EndItem: Integer; const LocRect: TRectF; const Opacity: Single;
const HeaderIndex: Integer = -1);
procedure DrawIndexFill(const AIndex: Integer; const LocRect: TRectF; const Opacity: Single);
procedure DrawTouchAnimation(const Index: Integer; const LocRect: TRectF; const Opacity: Single);
function GetHeaderRelRect(const StartItem, HeaderIndex: Integer; const LocRect: TRectF;
const SideSpace: Integer = 0): TRectF;
procedure DrawHeaderItem(const LocRect: TRectF; const StartItem, HeaderIndex: Integer; const Opacity: Single);
procedure DrawListItems(const AbsOpacity: Single);
procedure UpdateItemLookups;
function FindItemAbsoluteAt(const ViewAt: Integer): Integer;
function FindItemAbsoluteAtWithCheck(const ViewAt: Integer): Integer;
procedure SetSideSpace(const Value: Integer);
procedure SetTransparent(const Value: Boolean);
procedure SetAlternatingColors(const Value: Boolean);
procedure SetShowSelection(const Value: Boolean);
procedure RecreateNativePresentation; virtual;
procedure SetEditMode(const Value: Boolean);
procedure SetCanSwipeDelete(const Value: Boolean);
procedure SelectItem(const ItemIndex: Integer); virtual;
procedure UnselectItem(const ItemIndex: Integer); virtual;
function GetSelected: TListItem;
procedure SetSelected(const Value: TListItem);
procedure SetNewItemIndex(const NewIndex: Integer);
procedure SetSearchVisible(const Value: Boolean);
procedure SetSearchAlwaysOnTop(const Value: Boolean);
procedure SetOnFilter(const Value: TFilterEvent);
procedure OnSearchEditResize(Sender: TObject);
procedure OnSearchEditChange(Sender: TObject);
function DeleteButtonTextStored: Boolean;
// ISearchResponder
procedure SetFilterPredicate(const Predicate: TPredicate<string>);
// IMessageSendingCompatible
function GetMessageSender: TMessageSender;
// Custom readers
procedure ReadCanSwipeDelete(Reader: TReader);
procedure ReadIsSearchVisible(Reader: TReader);
procedure ReadIsSearchAlwaysOnTop(Reader: TReader);
procedure ReadEditModeOptions(Reader: TReader);
function GetItemCount: Integer;
{ IListViewController }
procedure RequestReindexing(const Item: TListItem);
procedure ItemResized(const Item: TListItem);
procedure ItemInvalidated(const Item: TListItem);
procedure ControlClicked(const Item: TListItem; const Control: TListItemDrawable);
procedure CheckStateChanged(const Item: TListItem; const Control: TListItemDrawable);
function GetScene: IScene;
protected
procedure DefineProperties(Filer: TFiler); override;
/// <summary><c>True</c> if in Edit Mode</summary>
function IsEditMode: Boolean; virtual;
/// <summary>Used internally by presentation hook</summary>
procedure DoSetItemIndexInternal(const Value: Integer); virtual;
/// <summary>Used internally by presentation hook</summary>
procedure DoUpdateScrollViewPos(const Value: Single); virtual;
/// <summary>Used internally by presentation hook</summary>
procedure DoSetScrollViewPos(const Value: Single); virtual;
/// <summary>Invoked when Edit Mode is being changed; if Edit Mode requires a different appearance, this
/// is where update of appearances should be initiated</summary>
procedure WillEnterEditMode(const Animated: Boolean); virtual;
/// <summary>Used internally by presentation hook</summary>
function HasButtonsInCells: Boolean; virtual;
/// <summary>Used internally by presentation hook</summary>
function HasDeletionEditMode: Boolean; virtual;
/// <summary>Used internally by presentation hook</summary>
function HasCheckboxMode: Boolean; virtual;
/// <summary>Stop edit mode transition animation</summary>
procedure ResetEditModeAnimation;
/// <summary>Initialize edit mode transition animation</summary>
procedure InitEditModeAnimation;
/// <summary>Stop delete mode transition animation</summary>
procedure ResetDeleteModeAnimation;
/// <summary>Initialize delete mode transition animation</summary>
procedure InitDeleteModeAnimation;
/// <summary>Update layout to place a Delete button</summary>
procedure UpdateDeleteButtonLayout;
/// <summary>Perform item deletion</summary>
procedure ProceedDeleteItem;
/// <summary>Invokes Pull-to-Refresh when applicable</summary>
procedure ScrollStretchChanged; virtual;
/// <summary>Scroll stretch threshold value when Pull-to-Refresh is invoked</summary>
property ScrollStretchStrength: Single read FScrollStretchStrength;
procedure SetSelectionCrossfade(const Value: Boolean);
function GetDeleteButtonText: string;
procedure SetDeleteButtonText(const Value: string);
procedure SetPullToRefresh(const Value: Boolean);
{ IControlTypeSupportable }
procedure SetControlType(const Value: TControlType);
function GetControlType: TControlType;
procedure SetNativeOptions(const Value: TListViewNativeOptions);
{ IListViewController }
function GetEditModeTransitionAlpha: Single;
function GetDeleteModeTransitionAlpha: Single;
procedure SetDeleteButtonIndex(const NewItemIndex: Integer);
function GetItemEditOffset(const Item: TListItem): Single;
function GetItemDeleteCutoff(const Item: TListItem): Single;
function GetClientMargins: TRectF;
function GetItemCurrentSelectionAlpha(const Item: TListItem): Single;
function IListViewController.GetItemSelectionAlpha = GetItemCurrentSelectionAlpha;
function GetImages: TCustomImageList;
procedure SetImages(const Value: TCustomImageList);
/// <summary>Hook for <c>IListViewController.RequestReindexing</c></summary>
procedure DoRequestReindexing(const Item: TListItem); virtual;
/// <summary>Hook for <c>IListViewController.ItemResized</c></summary>
procedure DoItemResized(const Item: TListItem); virtual;
/// <summary>Hook for <c>IListViewController.ItemInvalidated</c></summary>
procedure DoItemInvalidated(const Item: TListItem); virtual;
/// <summary>Hook for <c>IListViewController.CheckStateChanged</c></summary>
procedure DoCheckStateChanged(const Item: TListItem; const Control: TListItemDrawable); virtual;
/// <summary>Hook for <c>IListViewController.ControlClicked</c></summary>
procedure DoControlClicked(const Item: TListItem; const Control: TListItemDrawable); virtual;
{ 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;
{ IListItemStyleResources }
function GetStyleResources: TListItemStyleResources;
function StyleResourcesNeedUpdate: Boolean;
procedure SetItemSpaces(const Value: TBounds);
function GetItemClientRect(const Index: Integer): TRectF; // part of IListViewPresentationParent
function GetEstimatedItemHeight: Single; // part of IListViewPresentationParent
function GetEstimatedHeaderHeight: Single; // part of IListViewPresentationParent
function GetEstimatedFooterHeight: Single; // part of IListViewPresentationParent
/// <summary>Called when an instance or reference to instance of <b>TBaseImageList</b> or the
/// <b>ImageIndex</b> property is changed.
/// <para>See also <b>FMX.ActnList.IGlyph</b></para></summary>
procedure ImagesChanged; virtual;
procedure Paint; override;
procedure AfterPaint; override;
procedure Loaded; 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 MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override;
function ObjectAtPoint(P: TPointF): IControl; override;
procedure DoMouseLeave; override;
procedure Resize; override;
function GetDefaultStyleLookupName: string; override;
procedure ApplyStyle; override;
procedure FreeStyle; override;
procedure Invalidate;
procedure DoRealign; override;
procedure DoExit; override;
/// <summary>General state change. Starts <c>TDelayedIncident.ChangeRepainted</c> incident and
/// invokes <c>OnChange</c></summary>
procedure DoChange; virtual;
/// <summary>Handle <c>TDelayedIncident.ChangeRepainted</c> incident</summary>
procedure DoChangeRepainted; virtual;
/// <summary>Invoke <c>OnItemChange</c> handler</summary>
procedure DoListItemChange(const AListItem: TListItem); virtual;
/// <summary>Invoke <c>OnListItemClick</c> handler</summary>
procedure DoListItemClick(const AListItem: TListItem); virtual;
/// <summary>Invoke <c>OnEditModeChange</c> handler</summary>
procedure DoEditModeChange; virtual;
/// <summary>Invoke <c>OnEditModeChanging</c> handler</summary>
procedure DoEditModeChanging(var AHandled: Boolean); virtual;
/// <summary>Reset edit mode animation</summary>
procedure DoResetEditModeAnimation; virtual;
/// <summary>Update scrolling limits and animation boundaries</summary>
procedure DoUpdateScrollingLimits; virtual;
// Notifications from IListViewAdapter
procedure DoItemsMayChange; override;
procedure DoItemsCouldHaveChanged; override;
procedure DoItemsInvalidate; override;
/// <summary>This virtual method is called immediately after list of items has been changed. </summary>
procedure DoItemsChange; override;
procedure DoAdapterSet; override;
/// <summary>Deletes an item</summary>
/// <param name="ItemIndex"> index of item to be deleted</param>
/// <returns><c>True</c> if deleted succesfully</returns>
function DeleteItem(const ItemIndex: Integer): Boolean;
/// <summary>Perform actual item deletion. Called from DeleteItem: Boolean</summary>
procedure DoDeleteItem(const ItemIndex: Integer); virtual;
/// <summary>Get area available to item layout</summary>
function GetFinalItemSpaces(const ForceIncludeScrollBar: Boolean = True): TRectF; virtual;
/// <summary>Get item size</summary>
function GetFinalItemSize(const ForceIncludeScrollBar: Boolean = True): TSizeF; virtual;
function CanObserve(const ID: Integer): Boolean; override;
/// <summary>Notify observers about selection change</summary>
procedure ObserversBeforeSelection(out LAllowSelection: Boolean);
/// <summary>Return <c>True</c> if this item should handle input events</summary>
function ShouldHandleEvents: Boolean; virtual;
/// <summary>Invoke <c>OnUpdatingItemView</c> handler</summary>
procedure DoUpdatingItemView(const AListItem: TListItem; var AHandled: Boolean); virtual;
// <summary>Invoke <c>OnUpdateItemView</c> handler</summary>
procedure DoUpdateItemView(const AListItem: TListItem); virtual;
/// <summary>Get glyph button for item <c>Index</c></summary>
function GetGlyphButton(const Index: Integer): TListItemGlyphButton;
/// <summary>Invoked before item view will be updated (before calling ResetObjects)</summary>
property OnUpdatingItemView: TUpdatingItemViewEvent read FOnUpdatingItemView write FOnUpdatingItemView;
/// <summary>Invoked after item view has been updated (after calling ResetObjects)</summary>
property OnUpdateItemView: TUpdateItemViewEvent read FOnUpdateItemView write FOnUpdateItemView;
/// <summary>Invoked after EditMode has been changed</summary>
property OnEditModeChange: TNotifyEvent read FOnEditModeChange write FOnEditModeChange;
/// <summary>Invoked before changing EditMode</summary>
property OnEditModeChanging: THandleChangeEvent read FOnEditModeChanging write FOnEditModeChanging;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
class function GetDefaultMargins: TRectF;
procedure EndUpdate; override;
/// <summary>When using native presentation, re-creates the list and updates visible item content</summary>
procedure RebuildList; virtual;
/// <summary>Scrolls the view (instantly) to the desired item placing it within the view</summary>
procedure ScrollTo(const AItemIndex: Integer);
/// <summary>Index of selected item</summary>
property ItemIndex: Integer read GetItemIndex write SetItemIndex default -1;
/// <summary>Selected item</summary>
property Selected: TListItem read GetSelected write SetSelected;
/// <summary>Scroll position in dimension units</summary>
property ScrollViewPos: Single read FScrollViewPos write SetScrollViewPos;
/// <summary>Get rectangle of item, relative control</summary>
function GetItemRect(const AItemIndex: Integer): TRectF;
/// <summary>This method should be called when "pull to refresh" mode has been triggered to stop spinning wheel
/// </summary>
/// <remarks>This has only effect in native iOS control and only when PullRefreshWait property is set to True
/// </remarks>
procedure StopPullRefresh; virtual;
/// <summary>Space in logical units around the content of each list item</summary>
property ItemSpaces: TBounds read FItemSpaces write SetItemSpaces;
/// <summary>The list of images. Can be <c>nil</c>. <para>See also <b>FMX.ActnList.IGlyph</b></para></summary>
property Images: TCustomImageList read GetImages write SetImages;
/// <summary>Space in logical units on all sides around the list box encompassing the items</summary>
property SideSpace: Integer read FSideSpace write SetSideSpace default 0;
/// <summary>If the control is transparent, it will not draw its background</summary>
property Transparent: Boolean read FTransparent write SetTransparent;
/// <summary>Determines whether the items are selectable or not. If items are not selectable, user will still be
/// able to click on embedded controls</summary>
property AllowSelection: Boolean read FAllowSelection write FAllowSelection default True;
// <summary>Enabling this will switch fill colors for odd and even elements</summary>
property AlternatingColors: Boolean read FAlternatingColors write SetAlternatingColors default False;
/// <summary>Determines whether the selection is visible when selecting items.
/// It may be disabled when using list of checkboxes</summary>
property ShowSelection: Boolean read FShowSelection write SetShowSelection default True;
/// <summary>Enables swipe delete</summary>
property CanSwipeDelete: Boolean read FCanSwipeDelete write SetCanSwipeDelete default True;
/// <summary>Enable automatic scrolling to the top when tapped at the top edge</summary>
property AutoTapScroll: Boolean read FAutoTapScroll write FAutoTapScroll default False;
/// <summary>Threshold distance from the top edge at which the tap would initiate autoscroll to top</summary>
property AutoTapTreshold: Integer read FAutoTapTreshold write FAutoTapTreshold default 8;
/// <summary>Disables mouse wheel</summary>
property DisableMouseWheel: Boolean read FDisableMouseWheel write FDisableMouseWheel default False;
/// <summary>Item count</summary>
property ItemCount: Integer read GetItemCount;
/// <summary>Item click handler</summary>
property OnListItemClick: TListItemEvent read FOnListItemClick write FOnListItemClick;
/// <summary>Extended item click handler which gets click coordinates and clicked drawable</summary>
property OnItemClickEx: TListItemClickEventEx read FOnItemClickEx write FOnItemClickEx;
/// <summary>Reserved</summary>
property OnItemChange: TListItemEvent read FOnItemChange write FOnItemChange;
/// <summary>General OnChange event handler</summary>
property OnChange: TNotifyEvent read FOnChange write FOnChange;
/// <summary><c>TDelayedIncident.ChangeRepainted</c> delayed incident handler</summary>
property OnChangeRepainted: TNotifyEvent read FOnChangeRepainted write FOnChangeRepainted;
/// <summary>This event occurs after list of items has been changed. </summary>
property OnItemsChange: TNotifyEvent read FOnItemsChange write FOnItemsChange;
/// <summary>Called when ScrollViewPos has changed (manually or in code)</summary>
property OnScrollViewChange: TNotifyEvent read FOnScrollViewChange write FOnScrollViewChange;
/// <summary>Query before item deletion, see <see cref='TDeletingItemEvent'>TDeletingItemEvent</see>.
/// Application can veto deletion by returning <c>False</c> in handler Result</summary>
/// <remarks>Deletion is performed by <see cref='DoDeleteItem'>DoDeleteItem</see></remarks>
property OnDeletingItem: TDeletingItemEvent read FOnDeletingItem write FOnDeletingItem;
/// <summary>Invoked after item has been deleted</summary>
property OnDeleteItem: TDeleteItemEvent read FOnDeleteItem write FOnDeleteItem;
/// <summary>Invoked when Delete button changes visibility</summary>
property OnDeleteChangeVisible: TDeleteChangeVisibilityEvent read FOnDeleteChange write FOnDeleteChange;
/// <summary></summary>
property OnSearchChange: TNotifyEvent read FOnSearchChange write FOnSearchChange;
/// <summary>Event handler for setting custom filter on text of <c>TListView</c>.</summary>
property OnFilter: TFilterEvent read FOnFilter write SetOnFilter;
/// <summary>Invoked when pull refresh is triggered</summary>
property OnPullRefresh: TNotifyEvent read FOnPullRefresh write FOnPullRefresh;
/// <summary>Text to display in Delete button</summary>
property DeleteButtonText: string read GetDeleteButtonText write SetDeleteButtonText stored
DeleteButtonTextStored nodefault;
/// <summary>Enable/disable Edit Mode</summary>
property EditMode: Boolean read FEditMode write SetEditMode default False;
/// <summary><c>True</c> if search bar is visible</summary>
property SearchVisible: Boolean read FSearchVisible write SetSearchVisible default False;
/// <summary>Always display search bar</summary>
property SearchAlwaysOnTop: Boolean read FSearchAlwaysOnTop write SetSearchAlwaysOnTop default True;
/// <summary>Enable selection crossfade animation</summary>
property SelectionCrossfade: Boolean read FSelectionCrossfade write SetSelectionCrossfade default False;
/// <summary>Enable pull to refresh</summary>
property PullToRefresh: Boolean read FPullToRefresh write SetPullToRefresh default False;
/// <summary>When set to True, the spinning wheel does not disappear automatically and StopPullRefresh method needs
/// to be called after refresh operation is done. If this is set to False (default), then spinning wheel disappears
/// automatically shortly after triggering the effect. This option works only in native iOS control and has no
/// effect otherwise.</summary>
property PullRefreshWait: Boolean read FPullRefreshWait write FPullRefreshWait default False;
/// <summary>Control type: Styled or Native</summary>
property ControlType: TControlType read FControlType write SetControlType default TControlType.Styled;
/// <summary>Options for Native control; see <see cref='ControlType'>ControlType</see></summary>
property NativeOptions: TListViewNativeOptions read FNativeOptions write SetNativeOptions default [];
end;
/// <summary>TListView that supports native presentation</summary>
TPresentedListView = class(TListViewBase, IListViewPresentationParent, IListViewDesignPresentationParent)
strict private
FPresentation: IListViewPresentation;
FPresentationLocked: Integer;
FCreatingNativeView: Boolean;
protected
/// <summary>Lock presentation and execute <c>P</c></summary>
procedure ExecuteInterlocked(const P: TProc);
/// <summary><c>True</c> if item can be selected</summary>
function CanSelectItem(const AItemIndex: Integer): Boolean;
/// <summary><c>True</c> if item can be unselected</summary>
function CanUnselectItem(const AItemIndex: Integer): Boolean;
/// <summary>Called after item has been selected</summary>
procedure DidSelectItem(const AItemIndex: Integer);
/// <summary>Called after item has been unselected</summary>
procedure DidUnselectItem(const AItemIndex: Integer);
procedure ChangeOrder; override;
procedure ParentChanged; override;
procedure PaintChildren; override;
procedure AncestorVisibleChanged(const Visible: Boolean); override;
procedure DoSetItemIndexInternal(const Value: Integer); override;
procedure DoEditModeChange; override;
procedure DoItemsChange; override;
procedure DoItemsInvalidate; override;
procedure DoItemInvalidated(const Item: TListItem); override;
procedure DoCheckStateChanged(const AItem: TListItem; const Control: TListItemDrawable); override;
procedure DoUpdateScrollViewPos(const Value: Single); override;
procedure DoSetScrollViewPos(const Value: Single); override;
procedure DoDeleteItem(const ItemIndex: Integer); override;
procedure DoResetEditModeAnimation; override;
procedure DoUpdateScrollingLimits; override;
procedure DoAbsoluteChanged; override;
// Presentation
/// <summary>Parent control has been loaded</summary>
procedure PMAncesstorPresentationLoaded(var AMessage: TDispatchMessageWithValue<Boolean>); message PM_ANCESTOR_PRESENTATION_LOADED;
procedure RecreateNativePresentation; override;
function ShouldHandleEvents: Boolean; override;
// IPresentationParent
function GetRootObject: TObject;
function GetContentFrame: TRect;
function GetControlOpacity: Single;
// IListViewPresentationParent
function GetAdapter: IListViewAdapter;
function GetItemText(const ItemIndex: Integer): string;
function GetItemIndexTitle(const ItemIndex: Integer): string;
procedure ItemButtonClicked(const ItemIndex: Integer);
procedure InvokePullRefresh;
procedure SetSearchFilter(const Filter: string);
function GetTableViewFlags: TListViewModeFlags;
function GetTableViewOptions: TListViewNativeOptions;
function IListViewPresentationParent.GetFlags = GetTableViewFlags;
function IListViewPresentationParent.GetOptions = GetTableViewOptions;
procedure SetCreatingNativeView(const Value: Boolean);
function GetIsTransparent: Boolean;
function GetOpacity: Single;
function GetBackgroundStyleColor: TAlphaColor;
procedure DoItemsResize; override;
// IListViewDesignPresentationParent
function HasDesignPresentationAttached: Boolean;
public
destructor Destroy; override;
procedure BeforeDestruction; override;
procedure RecalcEnabled; override;
procedure Show; override;
procedure Hide; override;
procedure Resize; override;
procedure Paint; override;
procedure RebuildList; override;
procedure StopPullRefresh; override;
procedure RecalcOpacity; override;
end;
/// <summary>TAppearanceListView supports Appearances. Appearances are templates used for dynamic creation
/// of item views. Normally all items of the same purpose in the List View share the same appearance, differing
/// only in data</summary>
TAppearanceListView = class(TPresentedListView, IAppearanceItemOwner, IPublishedAppearanceOwner)
public type
/// <summary>Generic event invoked on <c>TListViewItem</c></summary>
TItemEvent = procedure(const Sender: TObject; const AItem: TListViewItem) of object;
/// <summary>See <c>DoUpdateItemView</c></summary>
TUpdateObjectsEvent = TItemEvent;
/// <summary>See <c>DoUpdatingItemView</c></summary>
TUpdatingObjectsEvent = procedure(const Sender: TObject; const AItem: TListViewItem; var AHandled: Boolean) of object;
strict private
FAppearanceViewItems: TAppearanceListViewItems;
FAppearanceProperties: TPublishedAppearance;
FItemAppearanceObjects: TPublishedObjects;
FItemAppearanceProperties: TItemAppearanceProperties;
FItemEditAppearanceProperties: TItemAppearanceProperties;
FHeaderAppearanceProperties: TItemAppearanceProperties;
FFooterAppearanceProperties: TItemAppearanceProperties;
FUpdatingAppearance: Integer;
FChangedAppearanceObjects: TListItemPurposes;
FChangedAppearanceHeights: TListItemPurposes;
// See also FItemSelectedBeforeChange
FItemSelectedBeforeEdit: TListItem;
FOnButtonClick: TItemControlEvent;
FOnButtonChange: TItemControlEvent;
FAppearanceAllowsCheckboxes: Boolean;
FAppearanceAllowsDeleteMode: Boolean;
FOnItemClick: TItemEvent;
FOnUpdatingObjects: TUpdatingObjectsEvent;
FOnUpdateObjects: TUpdateObjectsEvent;
function GetFooterAppearanceName: string;
function GetFooterAppearanceClassName: string;
function GetHeaderAppearanceName: string;
function GetHeaderAppearanceClassName: string;
function GetItemAppearanceName: string;
function GetItemEditAppearanceName: string;
function GetItemObjectsClassName: string;
function GetItemEditObjectsClassName: string;
procedure SetFooterAppearanceClassName(const Value: string);
procedure SetHeaderAppearanceClassName(const Value: string);
procedure SetItemObjectsClassName(const Value: string);
procedure SetItemEditObjectsClassName(const Value: string);
procedure SetFooterAppearanceName(const Value: string);
procedure SetHeaderAppearanceName(const Value: string);
procedure SetItemAppearanceName(const Value: string);
procedure SetItemEditAppearanceName(const Value: string);
procedure SetAppearanceProperties(const Value: TPublishedAppearance);
procedure SetItemAppearanceObjects(const Value: TPublishedObjects);
function GetItemAppearanceObjects: TPublishedObjects;
procedure AppearanceResetObjects(APurposes: TListItemPurposes);
procedure AppearanceResetHeights(APurposes: TListItemPurposes);
{ IPublishedAppearanceOwner }
function GetFooterAppearanceProperties: TItemAppearanceProperties;
function GetHeaderAppearanceProperties: TItemAppearanceProperties;
function GetItemAppearanceProperties: TItemAppearanceProperties;
function GetItemEditAppearanceProperties: TItemAppearanceProperties;
procedure EditorBeforeItemAdded(Sender: IListViewEditor);
procedure EditorAfterItemAdded(Sender: IListViewEditor; const Item: TListItem);
procedure EditorBeforeItemDeleted(Sender: IListViewEditor; const Index: Integer);
procedure EditorAfterItemDeleted(Sender: IListViewEditor);
procedure ResetViewAppearance(const AItem: TListViewItem);
protected
procedure ApplyStyle; override;
/// <summary>Handler of
/// <see cref='TAppearanceListViewItems.OnNotify'>TAppearanceListViewItems.OnNotify</see></summary>
procedure ObjectsNotify(Sender: TObject; const Item: TListItem; Action: TCollectionNotification);
/// <summary>TAppearanceListView needs adapter to be TAppearanceListViewItems or derivative.
/// If TAppearanceListView is used with a custom adapter, use <c>Items</c> property to set it
/// instead of Adapter property of the base class</summary>
procedure SetAppearanceListViewItems(const AItems: TAppearanceListViewItems);
procedure DoResetView(const Item: TListItem); override;
function HasButtonsInCells: Boolean; override;
function HasDeletionEditMode: Boolean; override;
function HasCheckboxMode: Boolean; override;
procedure SetItemHeight(const Value: Integer); virtual;
procedure SetItemEditHeight(const Value: Integer); virtual;
procedure SetHeaderHeight(const Value: Integer); virtual;
procedure SetFooterHeight(const Value: Integer); virtual;
function GetAppearanceListViewItem(const Index: Integer): TListViewItem; virtual;
/// <summary>Get height of a specific item</summary>
function GetItemHeight(const Index: Integer): Integer; overload; override;
// See respective properties
function GetItemHeight: Integer; overload; virtual;
function GetItemEditHeight: Integer; overload; virtual;
function GetHeaderHeight: Integer; overload; virtual;
function GetFooterHeight: Integer; overload; virtual;
procedure WillEnterEditMode(const Animated: Boolean); override;
procedure DoResetEditModeAnimation; override;
procedure DoAdapterSet; override;
// hooks from IListViewController
procedure DoRequestReindexing(const Item: TListItem); override;
procedure DoItemResized(const Item: TListItem); override;
procedure DoCheckStateChanged(const AItem: TListItem; const Control: TListItemDrawable); override;
procedure DoControlClicked(const Item: TListItem; const Control: TListItemDrawable); override;
/// <summary>Returns an array of 4 elements comprised by
/// <para><c>ItemEditAppearanceProperties</c></para>
/// <para><c>ItemAppearanceProperties</c></para>
/// <para><c>HeaderAppearanceProperties</c></para>
/// <para><c>FooterAppearanceProperties</c></para></summary>
function GetAppearanceProperties: TArray<TItemAppearanceProperties>;
/// <summary>Refresh items with specified purposes; all items if the set is empty;
/// see also <see cref='IListViewAdapter.ResetViews'>IListViewAdapter.ResetViews</see></summary>
procedure RefreshAppearances(const APurposes: TListItemPurposes = []);
/// <summary>Same as RefreshAppearances</summary>
procedure UpdateAppearanceStyleResources;
/// <summary>Invoked when item appearance changes; resets all item views</summary>
procedure ItemAppearanceChange(const Sender: TItemAppearanceProperties);
/// <summary>Invoked when Appearance Objects (view prototype) change</summary>
procedure ItemAppearanceChangeObjects(const Sender: TItemAppearanceProperties);
/// <summary>Invoked when appearance height is changed</summary>
procedure ItemAppearanceChangeHeight(const Sender: TItemAppearanceProperties);
/// <summary>Resets all item views when entering edit mode</summary>
procedure EditModeAppearances;
/// <summary>Reset appearance. When TAppearanceListView is created, it creates appearances
/// for Item, Edit mode Item, Header, Footer and initializes them by calling this virtual method.
/// By contract it must select <c>TItemAppearanceProperties.AppearanceClass</c> by searching in
/// appearances registry for item purpose specified during TItemAppearanceProperties creation</summary>
/// <param name="AAppearance">instance of <c>TItemAppearanceProperties</c></param>
/// <remarks>See implementation in
/// <see cref='TListView.InitializeItemAppearance'>TListView.InitializeItemAppearance</see>
/// <para>See also <see cref='TAppearancesRegistry'>TAppearancesRegistry</see></para>
/// </remarks>
procedure InitializeItemAppearance(const AAppearance: TItemAppearanceProperties); virtual;
procedure DoListItemClick(const AItem: TListItem); override;
procedure DoUpdatingItemView(const AListItem: TListItem; var AHandled: Boolean); override;
procedure DoUpdateItemView(const AListItem: TListItem); override;
// General compatibility properties
/// <summary>Item height defined by appearance </summary>
property ItemHeight: Integer read GetItemHeight write SetItemHeight;
/// <summary>Item height in edit mode defined by appearance</summary>
property ItemEditHeight: Integer read GetItemEditHeight write SetItemEditHeight;
/// <summary>Header height defined by appearance</summary>
property HeaderHeight: Integer read GetHeaderHeight write SetHeaderHeight;
/// <summary>Footer height defined by appearance</summary>
property FooterHeight: Integer read GetFooterHeight write SetFooterHeight;
// Appearance related properties
/// <summary>Item in edit mode appearance class name</summary>
/// <remarks>Must be loaded prior to other Item, header and footer properties
/// <para>Changing class name will load new appearance and reinitialize all views</para>
/// </remarks>
property ItemEditAppearanceClassName: string read GetItemEditObjectsClassName write SetItemEditObjectsClassName;
/// <summary>Item appearance class name</summary>
/// <remarks>Must be loaded prior to other Item, header and footer properties
/// <para>Changing class name will load new appearance and reinitialize all views</para>
/// </remarks>
property ItemAppearanceClassName: string read GetItemObjectsClassName write SetItemObjectsClassName;
/// <summary>Header appearance class name</summary>
/// <remarks>Must be loaded prior to other Item, header and footer properties
/// <para>Changing class name will load new appearance and reinitialize all views</para>
/// </remarks>
property HeaderAppearanceClassName: string read GetHeaderAppearanceClassName write SetHeaderAppearanceClassName;
/// <summary>Footer appearance class name</summary>
/// <remarks>Must be loaded prior to other Item, header and footer properties
/// <para>Changing class name will load new appearance and reinitialize all views</para>
/// </remarks>
property FooterAppearanceClassName: string read GetFooterAppearanceClassName write SetFooterAppearanceClassName;
/// <summary>Assign new appearance by name; this will effectively change <c>ItemAppearanceClassName</c> and reload
/// all views</summary>
property ItemAppearanceName: string read GetItemAppearanceName write SetItemAppearanceName stored False;
/// <summary>Assign new appearance by name; this will effectively change <c>ItemEditAppearanceClassName</c> and reload
/// all views</summary>
property ItemEditAppearanceName: string read GetItemEditAppearanceName write SetItemEditAppearanceName stored False;
/// <summary>Assign new appearance by name; this will effectively change <c>HeaderAppearanceClassName</c> and reload
/// all views</summary>
property HeaderAppearanceName: string read GetHeaderAppearanceName write SetHeaderAppearanceName stored False;
/// <summary>Assign new appearance by name; this will effectively change <c>FooterAppearanceClassName</c> and reload
/// all views</summary>
property FooterAppearanceName: string read GetFooterAppearanceName write SetFooterAppearanceName stored False;
// <summary><c>TPublishedAppearance</c> represents appearances in the object inspector</summary>
property ItemAppearance: TPublishedAppearance read FAppearanceProperties write SetAppearanceProperties;
/// <summary><c>TPublishedObjects</c> represents appearance items (collections of objects comprising appearances)
/// in the object inspector</summary>
property ItemAppearanceObjects: TPublishedObjects read GetItemAppearanceObjects write SetItemAppearanceObjects;
/// <summary>Invoked on check button state change</summary>
property OnButtonChange: TItemControlEvent read FOnButtonChange write FOnButtonChange;
/// <summary>Invoked on embedded button click</summary>
property OnButtonClick: TItemControlEvent read FOnButtonClick write FOnButtonClick;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure BeginUpdate; override;
procedure EndUpdate; override;
procedure Resize; override;
/// <summary>Access to the extended adapter that supports appearances and works with extended
/// items; see <see cref='TListViewItem'>TListViewItem</see></summary>
property Items: TAppearanceListViewItems read FAppearanceViewItems write SetAppearanceListViewItems;
/// <summary>Item click event handler</summary>
property OnItemClick: TItemEvent read FOnItemClick write FOnItemClick;
/// <summary>Invoked when view is being created by <c>TAppearanceListView.ResetViewAppearance</c> before
/// calling <c>ResetObjects</c>. If not Handled, the view will be recreated</summary>
/// <remarks>Call sequence:
/// <para><c>TAppearanceListView.ResetViewAppearance:</c></para>
/// <para><c>OnUpdatingObjects</c> ->
/// <c>TItemAppearanceObjects.ResetObjects</c> -> <c>OnUpdateObjects</c></para></remarks>
property OnUpdatingObjects: TUpdatingObjectsEvent read FOnUpdatingObjects write FOnUpdatingObjects;
/// <summary>Invoked when view is being created by <c>TAppearanceListView.ResetViewAppearance</c> after
/// calling <c>ResetObjects</c></summary>
/// <remarks>Call sequence:
/// <para><c>TAppearanceListView.ResetViewAppearance:</c></para>
/// <para><c>OnUpdatingObjects</c> ->
/// <c>TItemAppearanceObjects.ResetObjects</c> -> <c>OnUpdateObjects</c></para></remarks>
property OnUpdateObjects: TUpdateObjectsEvent read FOnUpdateObjects write FOnUpdateObjects;
end;
TCustomListView = class(TAppearanceListView)
end;
TListView = class(TCustomListView)
protected
procedure InitializeItemAppearance(const AAppearance: TItemAppearanceProperties); override;
public
// Hoist protected appearance properties
property ItemAppearanceName;
property ItemEditAppearanceName;
property HeaderAppearanceName;
property FooterAppearanceName;
published
// Hoist protected appearance properties
property ItemAppearanceClassName;
property ItemEditAppearanceClassName;
property HeaderAppearanceClassName;
property FooterAppearanceClassName;
property OnUpdatingObjects;
property OnUpdateObjects;
property OnEditModeChange;
property OnEditModeChanging;
property EditMode;
property Transparent default false;
property AllowSelection;
property AlternatingColors;
property ItemIndex;
property Images;
property ScrollViewPos;
property ItemSpaces;
property SideSpace;
property Align;
property Anchors;
property CanFocus default True;
property CanParentFocus;
property ClipChildren default True;
property ClipParent default False;
property Cursor default crDefault;
property DisableFocusEffect default True;
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 Margins;
property Opacity;
property Padding;
property PopupMenu;
property Position;
property RotationAngle;
property RotationCenter;
property Scale;
property Size;
property TabOrder;
property TabStop;
property Visible default True;
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 OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseEnter;
property OnMouseLeave;
property OnPainting;
property OnPaint;
property OnResize;
property OnResized;
property ItemAppearance;
property ItemAppearanceObjects;
property HelpContext;
property HelpKeyword;
property HelpType;
property StyleLookup;
property TouchTargetExpansion;
property OnClick;
property OnDblClick;
{ ListView selection events }
property CanSwipeDelete;
property OnChange;
property OnChangeRepainted;
property OnItemsChange;
property OnScrollViewChange;
property OnItemClick;
property OnItemClickEx;
property OnButtonClick;
property OnButtonChange;
property OnDeletingItem;
property OnDeleteItem;
property OnDeleteChangeVisible;
property OnSearchChange;
property OnFilter;
property OnPullRefresh;
property DeleteButtonText;
property AutoTapScroll;
property AutoTapTreshold;
property ShowSelection;
property DisableMouseWheel;
property SearchVisible;
property SearchAlwaysOnTop;
property SelectionCrossfade;
property PullToRefresh;
property PullRefreshWait;
property ControlType;
property NativeOptions;
end;
EListViewError = class(Exception);
//== INTERFACE END: FMX.ListView
//==================================================================================================