forked from yangyxd/FMXUI
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathFMX.Forms.pas
8092 lines (7411 loc) · 234 KB
/
FMX.Forms.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{*******************************************************}
{ }
{ Delphi FireMonkey Platform }
{ }
{ Copyright(c) 2016 Embarcadero Technologies, Inc. }
{ All rights reserved }
{ }
{*******************************************************}
// 修复win平台无边框窗体不能showHint的问题
// by YangYxd 2017.05.12
unit FMX.Forms;
{$MINENUMSIZE 4}
{$H+}
{$IFDEF WIN32}
{$HPPEMIT '#pragma link "d3d10.lib"'}
{$HPPEMIT '#pragma link "d3d10_1.lib"'}
{$HPPEMIT '#pragma link "dxgi.lib"'}
{$ENDIF}
{$IFDEF MSWINDOWS}
{$HPPEMIT '#pragma comment(lib, "D3D11")'}
{$ENDIF}
(*$HPPEMIT '#if defined(WIN32) && defined(CreateWindow)'*)
(*$HPPEMIT ' #define __SAVE_CREATEWINDOW CreateWindow'*)
(*$HPPEMIT ' #undef CreateWindow'*)
(*$HPPEMIT '#endif'*)
(*$HPPEMIT END '#if defined(__SAVE_CREATEWINDOW)'*)
(*$HPPEMIT END ' #define CreateWindow __SAVE_CREATEWINDOW'*)
(*$HPPEMIT END ' #undef __SAVE_CREATEWINDOW'*)
(*$HPPEMIT END '#endif'*)
interface
{$SCOPEDENUMS ON}
uses
{$IFDEF MSWINDOWS}
Winapi.Messages,
{$ENDIF}
System.Classes, System.SysUtils, System.Types, System.UITypes, System.Messaging, System.Generics.Collections,
System.Analytics, FMX.Types, FMX.ActnList, FMX.Controls, FMX.Graphics;
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);
TDeviceKindHelper = record helper for TDeviceKind
const
dkDesktop = TDeviceKind.Desktop deprecated 'Use TDeviceKind.Desktop';
dkiPhone = TDeviceKind.iPhone deprecated 'Use TDeviceKind.iPhone';
dkiPad = TDeviceKind.iPad deprecated 'Use TDeviceKind.iPad';
end;
TDeviceKinds = set of TDeviceKind;
TFormOrientations = TScreenOrientations;
TFormOrientation = TScreenOrientation;
TFormOrientationHelper = record helper for TFormOrientation
const
soPortrait = TFormOrientation.Portrait deprecated 'Use TFormOrientation.Portrait';
soLandscape = TFormOrientation.Landscape deprecated 'Use TFormOrientation.Landscape';
soInvertedPortrait = TFormOrientation.InvertedPortrait deprecated 'Use TFormOrientation.InvertedPortrait';
soInvertedLandscape = TFormOrientation.InvertedLandscape deprecated 'Use TFormOrientation.InvertedLandscape';
end;
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;
TApplicationStateHelper = record helper for TApplicationState
const
asNone = TApplicationState.None deprecated 'Use TApplicationState.None';
asRunning = TApplicationState.Running deprecated 'Use TApplicationState.Running';
asTerminating = TApplicationState.Terminating deprecated 'Use TApplicationState.Terminating';
asTerminated = TApplicationState.Terminated deprecated 'Use TApplicationState.Terminated';
end;
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 = TDictionary<String,TFormRegistryItems>;
private
FOnException: TExceptionEvent;
FRunning: Boolean;
FTerminate: Boolean;
FOnIdle: TIdleEvent;
FDefaultTitleReceived: Boolean;
FDefaultTitle: string;
FMainForm: TCommonCustomForm;
FCreateForms: array of TFormRegistryItem;
FBiDiMode: TBiDiMode;
FTimerActionHandle: TFmxHandle;
FActionUpdateDelay: Integer;
FTimerActionInterval: Integer;
FActionClientsList: TList<TComponent>;
FOnActionUpdate: TActionEvent;
FIdleDone: Boolean;
FRealCreateFormsCalled: 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;
procedure Idle;
procedure SetupActionTimer;
procedure SetActionUpdateDelay(const Value: Integer);
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);
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 SetActionUpdateDelay;
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;
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);
TFmxFormBorderStyleHelper = record helper for TFmxFormBorderStyle
const
bsNone = TFmxFormBorderStyle.None deprecated 'Use TFmxFormBorderStyle.None';
bsSingle = TFmxFormBorderStyle.Single deprecated 'Use TFmxFormBorderStyle.Single';
bsSizeable = TFmxFormBorderStyle.Sizeable deprecated 'Use TFmxFormBorderStyle.Sizeable';
bsToolWindow = TFmxFormBorderStyle.ToolWindow deprecated 'Use TFmxFormBorderStyle.ToolWindow';
bsSizeToolWin = TFmxFormBorderStyle.SizeToolWin deprecated 'Use TFmxFormBorderStyle.SizeToolWin';
end;
TFmxFormState = (Recreating, Modal, Released, InDesigner, WasNotShown, Showing, UpdateBorder, Activation, Closing,
Engaged);
TFmxFormStateHelper = record helper for TFmxFormState
const
fsRecreating = TFmxFormState.Recreating deprecated 'Use TFmxFormState.Recreating';
fsModal = TFmxFormState.Modal deprecated 'Use TFmxFormState.Modal';
fsReleased = TFmxFormState.Released deprecated 'Use TFmxFormState.Released';
fsInDesigner = TFmxFormState.InDesigner deprecated 'Use TFmxFormState.InDesigner';
fsWasNotShown = TFmxFormState.WasNotShown deprecated 'Use TFmxFormState.WasNotShown';
fsShowing = TFmxFormState.Showing deprecated 'Use TFmxFormState.Showing';
fsUpdateBorder = TFmxFormState.UpdateBorder deprecated 'Use TFmxFormState.UpdateBorder';
fsActivation = TFmxFormState.Activation deprecated 'Use TFmxFormState.Activation';
end;
TFmxFormStates = set of TFmxFormState;
TFormPosition = (Designed, Default, DefaultPosOnly, DefaultSizeOnly, ScreenCenter, DesktopCenter, MainFormCenter, OwnerFormCenter);
TFormPositionHelper = record helper for TFormPosition
const
poDesigned = TFormPosition.Designed deprecated 'Use TFormPosition.Designed';
poDefault = TFormPosition.Default deprecated 'Use TFormPosition.Default';
poDefaultPosOnly = TFormPosition.DefaultPosOnly deprecated 'Use TFormPosition.DefaultPosOnly';
poDefaultSizeOnly = TFormPosition.DefaultSizeOnly deprecated 'Use TFormPosition.DefaultSizeOnly';
poScreenCenter = TFormPosition.ScreenCenter deprecated 'Use TFormPosition.ScreenCenter';
poDesktopCenter = TFormPosition.DesktopCenter deprecated 'Use TFormPosition.DesktopCenter';
poMainFormCenter = TFormPosition.MainFormCenter deprecated 'Use TFormPosition.MainFormCenter';
poOwnerFormCenter = TFormPosition.OwnerFormCenter deprecated 'Use TFormPosition.OwnerFormCenter';
end;
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 Point: TPointF): TPointF;
function ScreenToClient(const AForm: TCommonCustomForm; const Point: 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
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;
procedure StyleChanged; virtual; abstract;
procedure ScaleChanged; virtual; abstract;
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;
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);
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);
TWindowStyleHelper = record helper for TWindowStyle
const
wsGPUSurface = TWindowStyle.GPUSurface deprecated 'Use TWindowStyle.GPUSurface';
end;
TWindowStyles = set of TWindowStyle;
TCommonCustomForm = class(TFmxObject, IRoot, IContainerObject, IAlignRoot, IPaintControl, IStyleBookOwner,
IDesignerStorage, IOriginalContainerSize, ITabStopController, IGestureControl, IMultiTouch, IPurgatoryItem,
ICaption, IHintRegistry)
private type
THandleState = (Normal, NeedRecreate, Changed);
TBoundChange = (Location, Size);
TBoundChanges = set of TBoundChange;
private
FDesigner: IDesignerHook;
FCaption: string;
FLeft: Integer;
FTop: Integer;
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;
FHeight: Integer;
FWidth: Integer;
FDefaultWindowRect: TRectF;
FDefaultClientSize: TPointF;
FCursor: TCursor;
FPosition: TFormPosition;
FWindowState: TWindowState;
FShowFullScreenIcon : Boolean;
FFullScreen : Boolean;
FPadding: TBounds;
FFormFactor : TFormFactor;
FFormFamily : string;
FOldActiveForm: TCommonCustomForm;
FChangingFocusGuard: Boolean;
FBorder: TFormBorder;
FStateChangeMessageId: Integer;
FOnClose: TCloseEvent;
FOnCloseQuery: TCloseQueryEvent;
FOnActivate: TNotifyEvent;
FOnDeactivate: TNotifyEvent;
FOnCreate: TNotifyEvent;
FOnDestroy: TNotifyEvent;
FOnResize: TNotifyEvent;
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: Integer;
FStyleChangedId: Integer;
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: Integer;
FEngageCount: Integer;
FSharedHint: THint;
FLastHinted: IControl;
FHintReceiverList: TList<IHintReceiver>;
FHint: string;
FShowHint: Boolean;
FBoundChanges: TBoundChanges;
{$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);
procedure SetWidth(const Value: 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;
function GetVisible: Boolean;
procedure SetModalResult(Value: TModalResult);
function GetTouchManager: TTouchManager;
procedure SetTouchManager(const Value: TTouchManager);
function GetSaveState: TFormSaveState;
procedure ReleaseLastHinted;
procedure SetLastHinted(const AControl: IControl);
{ IPurgatoryItem }
function CanDispose: Boolean;
{ 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;
protected
FActiveControl: IControl;
FUpdating: Integer;
FLastWidth, FLastHeight: single;
FDisableAlign: Boolean;
FWinService: IFMXWindowService;
FCursorService: IFMXCursorService;
FFullScreenWindowService: IFMXFullScreenWindowService;
procedure DoRemoveObject(const AObject: TFmxObject); override;
procedure DoDeleteChildren; override;
function GetBackIndex: Integer; override;
procedure InvalidateRect(R: TRectF);
procedure Recreate; virtual;
procedure Resize; 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;
{ 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 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;
{ 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>);
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; DoClick: Boolean = True); virtual;
procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); virtual;
procedure MouseLeave; virtual;
procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); virtual;
procedure KeyUp(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); virtual;
procedure MouseCapture;
procedure ReleaseCapture;
/// <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;
function GetBounds: TRect; virtual;
function ClientToScreen(const Point: TPointF): TPointF;
function ScreenToClient(const Point: TPointF): TPointF;
function CanShow: Boolean; virtual;
function CloseQuery: Boolean; virtual;
function ClientRect: TRectF;
procedure RecreateOsMenu;
procedure Release; override;
procedure Close;
procedure Show;
procedure Hide;
procedure BringToFront; override;
procedure SendToBack; override;
function ShowModal: TModalResult; overload;
procedure ShowModal(const ResultProc: TProc<TModalResult>); overload;
procedure CloseModal;
procedure Invalidate;
procedure BeginUpdate; virtual;
procedure EndUpdate; virtual;
{ ITabStopController }
function GetTabList: ITabList;
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</summary>
property Bounds: TRect read GetBounds write SetBounds;
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;
property Transparency: Boolean read FTransparency write SetTransparency default False;
property Width: Integer read FWidth write SetWidth stored False;
property Height: Integer read FHeight write SetHeight stored False;
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 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(P: TPointF): TPointF;
function ScreenToLocal(P: TPointF): TPointF;
procedure SetStyleLookup(const Value: string);
procedure AddUpdateRect(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 }
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;
{ 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;
public
constructor Create(AOwner: TComponent); override;