38
38
{$DEFINE HasDefaultValues}
41
Classes, SysUtils, Types, TypInfo, Math,
42
AvgLvlTree, Maps, LCLVersion, LCLStrConsts, LCLType, LCLProc, LCLIntf,
43
FileUtil, InterfaceBase, LResources, GraphType, Graphics, Menus, LMessages,
44
CustomTimer, ActnList, ClipBrd, CustApp, HelpIntfs, LCLClasses, Controls, Themes
41
Classes, SysUtils, Types, TypInfo, Math, AvgLvlTree, Maps, LCLVersion,
42
LCLStrConsts, LCLType, LCLProc, LCLIntf, FileUtil, LazUTF8, InterfaceBase,
43
LResources, GraphType, Graphics, Menus, LMessages, CustomTimer, ActnList,
44
ClipBrd, CustApp, HelpIntfs, LCLClasses, Controls, ImgList, Themes
45
45
{$ifndef wince},gettext{$endif}// remove ifdefs when gettext is fixed and a new fpc is released
66
66
poOwnerFormCenter // center form on owner form (depends on DefaultMonitor)
69
TWindowState = (wsNormal, wsMinimized, wsMaximized);
69
TWindowState = (wsNormal, wsMinimized, wsMaximized, wsFullScreen);
70
70
TCloseAction = (caNone, caHide, caFree, caMinimize);
113
113
procedure ControlUpdateScrollBars; virtual;
114
114
procedure InternalSetRange(const AValue: Integer); virtual;
115
115
procedure ScrollHandler(var Message: TLMScroll);
116
procedure SetAutoScroll(const AValue: Boolean); virtual;
117
116
procedure SetIncrement(const AValue: TScrollBarInc); virtual;
118
117
procedure SetPage(const AValue: TScrollBarInc); virtual;
119
118
procedure SetPosition(const Value: Integer); virtual;
120
119
procedure SetRange(const AValue: Integer); virtual;
121
procedure SetSize(const AValue: integer); virtual;
122
120
procedure SetSmooth(const AValue: Boolean); virtual;
123
121
procedure SetTracking(const AValue: Boolean);
124
122
procedure SetVisible(const AValue: Boolean); virtual;
138
136
function ScrollPos: Integer; virtual;
139
137
property Kind: TScrollBarKind read FKind;
140
138
function GetOtherScrollBar: TControlScrollBar;
141
property Size: integer read GetSize write SetSize stored False;
139
property Size: integer read GetSize stored False;
142
140
function ClientSize: integer; // return for vertical scrollbar the clientwidth
143
141
function ClientSizeWithBar: integer; // return for vertical scrollbar the clientwidth with the bar, even if Visible=false
144
142
function ClientSizeWithoutBar: integer; // return for vertical scrollbar the clientwidth without the bar, even if Visible=true
162
160
FIsUpdating: Boolean;
163
161
procedure SetHorzScrollBar(Value: TControlScrollBar);
164
162
procedure SetVertScrollBar(Value: TControlScrollBar);
165
function StoreScrollBars: Boolean;
167
164
class procedure WSRegisterClass; override;
168
165
procedure AlignControls(AControl: TControl; var ARect: TRect); override;
166
function AutoScrollEnabled: Boolean; virtual;
169
167
procedure CreateWnd; override;
170
168
function GetClientScrollOffset: TPoint; override;
171
169
function GetLogicalClientRect: TRect; override;// logical size of client area
184
182
destructor Destroy; override;
185
183
procedure UpdateScrollbars;
186
184
class function GetControlClassDefaultSize: TSize; override;
187
procedure ScrollBy(DeltaX, DeltaY: Integer);
185
procedure ScrollBy(DeltaX, DeltaY: Integer); override;
189
property HorzScrollBar: TControlScrollBar
190
read FHorzScrollBar write SetHorzScrollBar stored StoreScrollBars;
191
property VertScrollBar: TControlScrollBar
192
read FVertScrollBar write SetVertScrollBar stored StoreScrollBars;
187
property HorzScrollBar: TControlScrollBar read FHorzScrollBar write SetHorzScrollBar;
188
property VertScrollBar: TControlScrollBar read FVertScrollBar write SetVertScrollBar;
403
401
TDropFilesEvent = procedure (Sender: TObject; const FileNames: Array of String) of object;
404
402
THelpEvent = function(Command: Word; Data: PtrInt; var CallHelp: Boolean): Boolean of object;
405
403
TShortCutEvent = procedure (var Msg: TLMKey; var Handled: Boolean) of object;
404
TModalDialogFinished = procedure (Sender: TObject; AResult: Integer) of object;
407
407
TCustomForm = class(TScrollingWinControl)
452
453
FRestoredHeight: integer;
453
454
FShowInTaskbar: TShowInTaskbar;
454
455
FWindowState: TWindowState;
456
FDesignTimeDPI: Integer;
457
function GetClientHandle: HWND;
455
458
function GetEffectiveShowInTaskBar: TShowInTaskBar;
456
459
function GetMonitor: TMonitor;
457
460
function GetPixelsPerInch: Longint;
473
476
procedure SetFormBorderStyle(NewStyle: TFormBorderStyle);
474
477
procedure SetCancelControl(NewControl: TControl);
475
478
procedure SetDefaultControl(NewControl: TControl);
476
procedure SetDesigner(Value : TIDesigner);
477
479
procedure SetFormStyle(Value : TFormStyle);
478
480
procedure SetIcon(AValue: TIcon);
479
481
procedure SetMenu(Value: TMainMenu);
480
482
procedure SetPopupMode(const AValue: TPopupMode);
481
483
procedure SetPopupParent(const AValue: TCustomForm);
482
procedure SetPosition(Value : TPosition);
484
procedure SetPosition(Value: TPosition);
483
485
procedure SetShowInTaskbar(Value: TShowInTaskbar);
484
486
procedure SetLastFocusedControl(AControl: TWinControl);
485
487
procedure SetWindowFocus;
486
488
procedure SetWindowState(Value : TWindowState);
487
489
procedure WMActivate(var Message : TLMActivate); message LM_ACTIVATE;
488
490
procedure WMCloseQuery(var message: TLMessage); message LM_CLOSEQUERY;
489
procedure WMDeactivate(var Message : TLMActivate); message LM_DEACTIVATE;
490
491
procedure WMHelp(var Message: TLMHelp); message LM_HELP;
491
492
procedure WMShowWindow(var message: TLMShowWindow); message LM_SHOWWINDOW;
492
493
procedure WMSize(var message: TLMSize); message LM_Size;
570
571
function DoExecuteAction(ExeAction: TBasicAction): boolean;
571
572
function DoUpdateAction(TheAction: TBasicAction): boolean;
572
573
procedure UpdateActions; virtual;
576
{returns handle of MDIForm client handle (container for mdi children this
577
is not Handle of form itself !)}
578
property ClientHandle: HWND read GetClientHandle;
574
580
constructor Create(AOwner: TComponent); override;
575
581
constructor CreateNew(AOwner: TComponent; Num: Integer = 0); virtual;
594
600
procedure IntfHelp(AComponent: TComponent);
595
601
function IsShortcut(var Message: TLMKey): boolean; virtual;
596
602
procedure MakeFullyVisible(AMonitor: TMonitor = nil; UseWorkarea: Boolean = False);
597
function AutoSizeCheckParent: Boolean; override;
603
function AutoSizeDelayedHandle: Boolean; override;
598
604
procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer;
599
605
Raw: boolean = false;
600
606
WithThemeSpace: boolean = true); override;
604
610
function SetFocusedControl(Control: TWinControl): Boolean ; virtual;
605
611
procedure SetRestoredBounds(ALeft, ATop, AWidth, AHeight: integer);
607
614
function ShowModal: Integer; virtual;
608
615
procedure ShowOnTop;
609
616
function SmallIconHandle: HICON;
620
627
procedure AddHandlerCreate(OnCreateHandler: TNotifyEvent; AsFirst: Boolean=true);
621
628
procedure RemoveHandlerCreate(OnCreateHandler: TNotifyEvent);
631
function ActiveMDIChild: TCustomForm; virtual;
632
function GetMDIChildren(AIndex: Integer): TCustomForm; virtual;
633
function MDIChildCount: Integer; virtual;
624
637
procedure Dock(NewDockSite: TWinControl; ARect: TRect); override;
625
638
procedure UpdateDockCaption(Exclude: TControl); override;
641
654
property DefaultControl: TControl read FDefaultControl write SetDefaultControl;
642
655
property DefaultMonitor: TDefaultMonitor read FDefaultMonitor
643
656
write FDefaultMonitor default dmActiveForm;
644
property Designer: TIDesigner read FDesigner write SetDesigner;
657
property Designer: TIDesigner read FDesigner write FDesigner;
658
property DesignTimeDPI: Integer read FDesignTimeDPI write FDesignTimeDPI;
645
659
property FormState: TFormState read FFormState;
646
660
property FormStyle: TFormStyle read FFormStyle write SetFormStyle
647
661
default fsNormal;
648
662
property HelpFile: string read FHelpFile write FHelpFile;
649
663
property Icon: TIcon read FIcon write SetIcon stored IsIconStored;
650
664
property KeyPreview: Boolean read FKeyPreview write FKeyPreview default False;
665
property MDIChildren[I: Integer]: TCustomForm read GetMDIChildren;
651
666
property Menu : TMainMenu read FMenu write SetMenu;
652
667
property ModalResult : TModalResult read FModalResult write FModalResult;
653
668
property Monitor: TMonitor read GetMonitor;
667
682
property OnResize stored IsForm;
668
683
property OnShortcut: TShortcutEvent read FOnShortcut write FOnShortcut;
669
684
property OnShow: TNotifyEvent read FOnShow write FOnShow;
685
property OnShowModalFinished: TModalDialogFinished read FOnShowModalFinished write FOnShowModalFinished;
670
686
property OnWindowStateChange: TNotifyEvent
671
687
read FOnWindowStateChange write FOnWindowStateChange;
672
688
property ParentFont default False;
823
849
procedure SetHideInterval(Value : Integer);
825
851
class procedure WSRegisterClass; override;
852
procedure WMNCHitTest(var Message: TLMessage); message LM_NCHITTEST;
826
853
procedure DoShowWindow; override;
854
procedure UpdateRegion;
828
856
constructor Create(AOwner: TComponent); override;
829
857
destructor Destroy; override;
832
860
AData: pointer); virtual;
833
861
function CalcHintRect(MaxWidth: Integer; const AHint: String;
834
862
AData: Pointer): TRect; virtual;
863
procedure InitializeWnd; override;
835
864
procedure ReleaseHandle;
836
865
procedure Paint; override;
866
procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
837
867
class function GetControlClassDefaultSize: TSize; override;
839
869
property Alignment: TAlignment read FAlignment write FAlignment;
943
973
function GetCustomFormsZOrdered(Index: Integer): TCustomForm;
944
974
function GetDataModuleCount: Integer;
945
975
function GetDataModules(AIndex: Integer): TDataModule;
976
function GetDesktopLeft: Integer;
977
function GetDesktopTop: Integer;
946
978
function GetDesktopHeight: Integer;
947
979
function GetDesktopWidth: Integer;
980
function GetDesktopRect: TRect;
948
981
function GetFonts : TStrings;
949
982
function GetFormCount: Integer;
950
983
function GetForms(IIndex: Integer): TForm;
973
1006
procedure DoRemoveDataModule(DataModule: TDataModule);
974
1007
procedure NotifyScreenFormHandler(HandlerType: TScreenNotification;
975
1008
Form: TCustomForm);
1009
function GetWorkAreaHeight: Integer;
1010
function GetWorkAreaLeft: Integer;
1011
function GetWorkAreaRect: TRect;
1012
function GetWorkAreaTop: Integer;
1013
function GetWorkAreaWidth: Integer;
977
1015
function GetHintFont: TFont; virtual;
978
1016
function GetIconFont: TFont; virtual;
1033
1071
property CustomFormZOrderCount: Integer read GetCustomFormZOrderCount;
1034
1072
property CustomFormsZOrdered[Index: Integer]: TCustomForm
1035
1073
read GetCustomFormsZOrdered; // lower index means on top
1074
property DesktopLeft: Integer read GetDesktopLeft;
1075
property DesktopTop: Integer read GetDesktopTop;
1036
1077
property DesktopHeight: Integer read GetDesktopHeight;
1037
1078
property DesktopWidth: Integer read GetDesktopWidth;
1079
property DesktopRect: TRect read GetDesktopRect;
1038
1080
property FocusedForm: TCustomForm read FFocusedForm;
1039
1081
property FormCount: Integer read GetFormCount;
1040
1082
property Forms[Index: Integer]: TForm read GetForms;
1053
1095
property PixelsPerInch: integer read FPixelsPerInch;
1054
1096
property PrimaryMonitor: TMonitor read GetPrimaryMonitor;
1055
1097
property Width: Integer read GetWidth;
1098
property WorkAreaRect: TRect read GetWorkAreaRect;
1099
property WorkAreaHeight: Integer read GetWorkAreaHeight;
1100
property WorkAreaLeft: Integer read GetWorkAreaLeft;
1101
property WorkAreaTop: Integer read GetWorkAreaTop;
1102
property WorkAreaWidth: Integer read GetWorkAreaWidth;
1056
1103
property OnActiveControlChange: TNotifyEvent read FOnActiveControlChange
1057
1104
write FOnActiveControlChange;
1058
1105
property OnActiveFormChange: TNotifyEvent read FOnActiveFormChange
1063
1110
{ TApplication }
1065
TQueryEndSessionEvent = procedure (var Cancel : Boolean) of object;
1112
TQueryEndSessionEvent = procedure (var Cancel: Boolean) of object;
1066
1113
TExceptionEvent = procedure (Sender: TObject; E: Exception) of object;
1114
TGetHandleEvent = procedure(var Handle: HWND) of object;
1067
1115
TIdleEvent = procedure (Sender: TObject; var Done: Boolean) of object;
1068
1116
TOnUserInputEvent = procedure(Sender: TObject; Msg: Cardinal) of object;
1069
1117
TDataEvent = procedure (Data: PtrInt) of object;
1146
1195
Top, Last: PAsyncCallQueueItem;
1148
1197
TAsyncCallQueues = record
1198
CritSec: TRTLCriticalSection;
1149
1199
Cur: TAsyncCallQueue; // currently processing
1150
1200
Next: TAsyncCallQueue; // new calls added to this queue
1203
// This identifies the kind of device where the application currently runs on
1204
// Note that the same application can run in all kinds of devices if it has a
1205
// user interface flexible enough
1153
1206
TApplicationType = (
1207
atDefault, // The widgetset will attempt to auto-detect the device type
1208
atDesktop, // For common desktops and notebooks
1209
atPDA, // For smartphones and other devices with touch screen and a small screen
1210
atKeyPadDevice,// Devices without any pointing device, such as keypad feature phones or kiosk machines
1211
atTablet, // Similar to a PDA/Smartphone, but with a large screen
1212
atTV, // The device is a television
1213
atMobileEmulator// For desktop platforms. It will create a main windows of 240x320
1214
// and place all forms there to immitate a mobile platform
1160
1217
TApplicationShowGlyphs = (
1179
1236
FComponentsToRelease: TFPList;
1180
1237
FComponentsReleasing: TFPList;
1181
1238
FCreatingForm: TForm;// currently created form (CreateForm), candidate for MainForm
1239
FExtendedKeysSupport: Boolean;
1182
1240
FFindGlobalComponentEnabled: boolean;
1183
1241
FFlags: TApplicationFlags;
1195
1253
FHintWindow: THintWindow;
1197
1255
FBigIconHandle: HICON;
1256
FLayoutAdjustmentPolicy: TLayoutAdjustmentPolicy;
1257
FMainFormOnTaskBar: Boolean;
1198
1258
FModalLevel: Integer;
1259
FMoveFormFocusToChildren: Boolean;
1260
FOnGetMainFormHandle: TGetHandleEvent;
1261
FOnMessageDialogFinished: TModalDialogFinished;
1199
1262
FOnModalBegin: TNotifyEvent;
1200
1263
FOnModalEnd: TNotifyEvent;
1201
1264
FShowButtonGlyphs: TApplicationShowGlyphs;
1220
1283
FOnHint: TNotifyEvent;
1221
1284
FOnIdle: TIdleEvent;
1222
1285
FOnIdleEnd: TNotifyEvent;
1223
FOnEndSession : TNotifyEvent;
1224
FOnQueryEndSession : TQueryEndSessionEvent;
1286
FOnEndSession: TNotifyEvent;
1287
FOnQueryEndSession: TQueryEndSessionEvent;
1225
1288
FOnMinimize: TNotifyEvent;
1226
1289
FOnRestore: TNotifyEvent;
1227
1290
FOnShortcut: TShortcutEvent;
1236
1299
FBidiMode: TBiDiMode;
1237
1300
FRestoreStayOnTop: TList;
1238
1301
FTaskBarBehavior: TTaskBarBehavior;
1302
FUpdateFormatSettings: Boolean;
1239
1303
procedure DoOnIdleEnd;
1240
1304
function GetActive: boolean;
1241
1305
function GetCurrentHelpFile: string;
1242
1306
function GetExename: String;
1307
function GetMainFormHandle: HWND;
1243
1308
function GetTitle: string;
1244
1309
procedure FreeIconHandles;
1245
1310
procedure IconChanged(Sender: TObject);
1246
1311
procedure SetBidiMode(const AValue: TBiDiMode);
1247
1312
procedure SetFlags(const AValue: TApplicationFlags);
1313
procedure SetMainFormOnTaskBar(const AValue: Boolean);
1248
1314
procedure SetNavigation(const AValue: TApplicationNavigationOptions);
1249
1315
procedure SetShowButtonGlyphs(const AValue: TApplicationShowGlyphs);
1250
1316
procedure SetShowMenuGlyphs(const AValue: TApplicationShowGlyphs);
1265
1331
procedure RemoveHandler(HandlerType: TApplicationHandlerType;
1266
1332
const Handler: TMethod);
1267
1333
procedure RunLoop;
1269
procedure Deactivate(Force: Boolean = False);
1334
procedure Activate(Data: PtrInt);
1335
procedure Deactivate(Data: PtrInt);
1271
1337
function GetConsoleApplication: boolean; override;
1272
1338
procedure NotifyIdleHandler(var Done: Boolean);
1331
1397
procedure Terminate; override;
1332
1398
procedure DisableIdleHandler;
1333
1399
procedure EnableIdleHandler;
1334
procedure NotifyUserInputHandler(Msg: Cardinal);
1400
procedure NotifyUserInputHandler(Sender: TObject; Msg: Cardinal);
1335
1401
procedure NotifyKeyDownBeforeHandler(Sender: TObject;
1336
1402
var Key: Word; Shift: TShiftState);
1337
1403
procedure NotifyKeyDownHandler(Sender: TObject;
1376
1442
procedure RemoveOnHintHandler(Handler: TNotifyEvent);
1377
1443
procedure AddOnShowHintHandler(Handler: TShowHintEvent; AsFirst: Boolean=true);
1378
1444
procedure RemoveOnShowHintHandler(Handler: TShowHintEvent);
1445
procedure AddOnGetMainFormHandleHandler(Handler: TGetHandleEvent; AsFirst: Boolean = True);
1446
procedure RemoveOnGetMainFormHandleHandler(Handler: TGetHandleEvent);
1379
1447
procedure RemoveAllHandlersOfObject(AnObject: TObject); virtual;
1380
1448
procedure DoBeforeMouseMessage(CurMouseControl: TControl);
1381
1449
function IsShortcut(var Message: TLMKey): boolean;
1382
procedure IntfQueryEndSession(var Cancel : Boolean);
1450
procedure IntfQueryEndSession(var Cancel: Boolean);
1383
1451
procedure IntfEndSession;
1384
procedure IntfAppActivate;
1385
procedure IntfAppDeactivate;
1452
procedure IntfAppActivate(const Async: Boolean = False);
1453
procedure IntfAppDeactivate(const Async: Boolean = False);
1386
1454
procedure IntfAppMinimize;
1387
1455
procedure IntfAppRestore;
1388
1456
procedure IntfDropFiles(const FileNames: Array of String);
1457
procedure IntfSettingsChange;
1389
1458
procedure IntfThemeOptionChange(AThemeServices: TThemeServices; AOption: TThemeOption);
1391
1460
function IsRTLLang(ALang: String): Boolean;
1392
1461
function Direction(ALang: String): TBiDiMode;
1394
procedure DoArrowKey(AControl: TWinControl; var Key: Word;
1395
Shift: TShiftState);
1396
procedure DoEscapeKey(AControl: TWinControl; var Key: Word;
1397
Shift: TShiftState);
1398
procedure DoReturnKey(AControl: TWinControl; var Key: Word;
1399
Shift: TShiftState);
1400
procedure DoTabKey(AControl: TWinControl; var Key: Word;
1401
Shift: TShiftState);
1464
procedure DoArrowKey(AControl: TWinControl; var Key: Word; Shift: TShiftState);
1465
procedure DoTabKey(AControl: TWinControl; var Key: Word; Shift: TShiftState);
1467
procedure DoEscapeKey(AControl: TWinControl; var Key: Word; Shift: TShiftState);
1468
procedure DoReturnKey(AControl: TWinControl; var Key: Word; Shift: TShiftState);
1403
1470
property Active: boolean read GetActive;
1404
1471
property ApplicationType : TApplicationType read FApplicationType write FApplicationType;
1405
1472
property BidiMode: TBiDiMode read FBidiMode write SetBidiMode;
1406
1473
property CaptureExceptions: boolean read FCaptureExceptions
1407
1474
write SetCaptureExceptions;
1475
property ExtendedKeysSupport: Boolean read FExtendedKeysSupport write FExtendedKeysSupport; // See VK_LSHIFT in LCLType for more details
1408
1476
property FindGlobalComponentEnabled: boolean read FFindGlobalComponentEnabled
1409
1477
write FFindGlobalComponentEnabled;
1410
1478
property Flags: TApplicationFlags read FFlags write SetFlags;
1417
1485
property HintShortCuts: Boolean read FHintShortCuts write FHintShortCuts;
1418
1486
property HintShortPause: Integer read FHintShortPause write FHintShortPause;
1419
1487
property Icon: TIcon read FIcon write SetIcon;
1488
property LayoutAdjustmentPolicy: TLayoutAdjustmentPolicy read FLayoutAdjustmentPolicy write FLayoutAdjustmentPolicy;
1420
1489
property Navigation: TApplicationNavigationOptions read FNavigation write SetNavigation;
1421
1490
property MainForm: TForm read FMainForm;
1491
property MainFormHandle: HWND read GetMainFormHandle;
1492
property MainFormOnTaskBar: Boolean read FMainFormOnTaskBar write SetMainFormOnTaskBar; platform;
1422
1493
property ModalLevel: Integer read FModalLevel;
1494
property MoveFormFocusToChildren: Boolean read FMoveFormFocusToChildren write FMoveFormFocusToChildren default True;
1423
1495
property MouseControl: TControl read FMouseControl;
1424
1496
property TaskBarBehavior: TTaskBarBehavior read FTaskBarBehavior write SetTaskBarBehavior;
1497
property UpdateFormatSettings: Boolean read FUpdateFormatSettings write FUpdateFormatSettings; platform;
1425
1498
property OnActionExecute: TActionEvent read FOnActionExecute write FOnActionExecute;
1426
1499
property OnActionUpdate: TActionEvent read FOnActionUpdate write FOnActionUpdate;
1427
1500
property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
1428
1501
property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
1502
property OnGetMainFormHandle: TGetHandleEvent read FOnGetMainFormHandle write FOnGetMainFormHandle;
1429
1503
property OnIdle: TIdleEvent read FOnIdle write FOnIdle;
1430
1504
property OnIdleEnd: TNotifyEvent read FOnIdleEnd write FOnIdleEnd;
1431
1505
property OnEndSession: TNotifyEvent read FOnEndSession write FOnEndSession;
1432
1506
property OnQueryEndSession: TQueryEndSessionEvent read FOnQueryEndSession write FOnQueryEndSession;
1433
1507
property OnMinimize: TNotifyEvent read FOnMinimize write FOnMinimize;
1508
property OnMessageDialogFinished: TModalDialogFinished read FOnMessageDialogFinished write FOnMessageDialogFinished;
1434
1509
property OnModalBegin: TNotifyEvent read FOnModalBegin write FOnModalBegin;
1435
1510
property OnModalEnd: TNotifyEvent read FOnModalEnd write FOnModalEnd;
1436
1511
property OnRestore: TNotifyEvent read FOnRestore write FOnRestore;
1468
1543
FHintPause: Integer;
1469
1544
FHintShortCuts: Boolean;
1470
1545
FHintShortPause: Integer;
1546
FOnActivate: TNotifyEvent;
1547
FOnDeactivate: TNotifyEvent;
1471
1548
FOnDropFiles: TDropFilesEvent;
1549
FOnGetMainFormHandle: TGetHandleEvent;
1472
1550
FOnModalBegin: TNotifyEvent;
1473
1551
FOnModalEnd: TNotifyEvent;
1474
1552
FShowButtonGlyphs: TApplicationShowGlyphs;
1503
1581
procedure SetShowMainForm(const AValue: Boolean);
1504
1582
procedure SetTitle(const AValue : String);
1584
procedure SetOnActivate(AValue: TNotifyEvent);
1585
procedure SetOnDeactivate(AValue: TNotifyEvent);
1506
1586
procedure SetOnException(const AValue : TExceptionEvent);
1587
procedure SetOnGetMainFormHandle(const AValue: TGetHandleEvent);
1507
1588
procedure SetOnIdle(const AValue : TIdleEvent);
1508
1589
procedure SetOnIdleEnd(const AValue : TNotifyEvent);
1509
1590
procedure SetOnEndSession(const AValue : TNotifyEvent);
1536
1617
property ShowMainForm: Boolean read FShowMainForm write SetShowMainForm default True;
1537
1618
property Title: String read FTitle write SetTitle;
1620
property OnActivate: TNotifyEvent read FOnActivate write SetOnActivate;
1621
property OnDeactivate: TNotifyEvent read FOnDeactivate write SetOnDeactivate;
1539
1622
property OnException: TExceptionEvent read FOnException write SetOnException;
1623
property OnGetMainFormHandle: TGetHandleEvent read FOnGetMainFormHandle write SetOnGetMainFormHandle;
1540
1624
property OnIdle: TIdleEvent read FOnIdle write SetOnIdle;
1541
1625
property OnIdleEnd: TNotifyEvent read FOnIdleEnd write SetOnIdleEnd;
1542
property OnEndSession : TNotifyEvent read FOnEndSession write SetOnEndSession;
1543
property OnQueryEndSession : TQueryEndSessionEvent read FOnQueryEndSession write SetOnQueryEndSession;
1544
property OnMinimize : TNotifyEvent read FOnMinimize write SetOnMinimize;
1626
property OnEndSession: TNotifyEvent read FOnEndSession write SetOnEndSession;
1627
property OnQueryEndSession: TQueryEndSessionEvent read FOnQueryEndSession write SetOnQueryEndSession;
1628
property OnMinimize: TNotifyEvent read FOnMinimize write SetOnMinimize;
1545
1629
property OnModalBegin: TNotifyEvent read FOnModalBegin write SetOnModalBegin;
1546
1630
property OnModalEnd: TNotifyEvent read FOnModalEnd write SetOnModalEnd;
1547
property OnRestore : TNotifyEvent read FOnRestore write SetOnRestore;
1631
property OnRestore: TNotifyEvent read FOnRestore write SetOnRestore;
1548
1632
property OnDropFiles: TDropFilesEvent read FOnDropFiles write SetOnDropFiles;
1549
1633
property OnHelp: THelpEvent read FOnHelp write SetOnHelp;
1550
1634
property OnHint: TNotifyEvent read FOnHint write SetOnHint;
1585
1669
function KeysToShiftState(Keys: PtrUInt): TShiftState;
1586
function KeyDataToShiftState(KeyData: Longint): TShiftState;
1670
function KeyDataToShiftState(KeyData: PtrInt): TShiftState;
1587
1671
function ShiftStateToKeys(ShiftState: TShiftState): PtrUInt;
1589
1673
function WindowStateToStr(const State: TWindowState): string;
1611
1695
function FindRootDesigner(APersistent: TPersistent): TIDesigner;
1613
1697
function IsAccel(VK: word; const Str: string): Boolean;
1614
procedure NotifyApplicationUserInput(Msg: Cardinal);
1698
procedure NotifyApplicationUserInput(Target: TControl; Msg: Cardinal);
1617
1701
function GetShortHint(const Hint: string): string;
1671
1756
procedure NotifyApplicationUserInput;
1673
1758
------------------------------------------------------------------------------}
1674
procedure NotifyApplicationUserInput(Msg: Cardinal);
1759
procedure NotifyApplicationUserInput(Target: TControl; Msg: Cardinal);
1676
if Application <> nil then
1677
Application.NotifyUserInputHandler(Msg);
1761
if Assigned(Application) then
1762
Application.NotifyUserInputHandler(Target, Msg);
1725
1810
if Keys and MK_LButton <> 0 then Include(Result, ssLeft);
1726
1811
if Keys and MK_RButton <> 0 then Include(Result, ssRight);
1727
1812
if Keys and MK_MButton <> 0 then Include(Result, ssMiddle);
1729
1813
if Keys and MK_XBUTTON1 <> 0 then Include(Result, ssExtra1);
1730
1814
if Keys and MK_XBUTTON2 <> 0 then Include(Result, ssExtra2);
1732
1815
if GetKeyState(VK_MENU) < 0 then Include(Result, ssAlt);
1733
1816
if (GetKeyState(VK_LWIN) < 0) or (GetKeyState(VK_RWIN) < 0) then Include(Result, ssMeta);
1736
function KeyDataToShiftState(KeyData: Longint): TShiftState;
1819
function KeyDataToShiftState(KeyData: PtrInt): TShiftState;
1738
1821
Result := MsgKeyDataToShiftState(KeyData);
1746
1829
if ssLeft in ShiftState then Result := Result or MK_LBUTTON;
1747
1830
if ssRight in ShiftState then Result := Result or MK_RBUTTON;
1748
1831
if ssMiddle in ShiftState then Result := Result or MK_MBUTTON;
1750
1832
if ssExtra1 in ShiftState then Result := Result or MK_XBUTTON1;
1751
1833
if ssExtra2 in ShiftState then Result := Result or MK_XBUTTON2;
1755
1836
function WindowStateToStr(const State: TWindowState): string;
1794
1875
//------------------------------------------------------------------------------
1795
1876
function IsAccel(VK: word; const Str: string): Boolean;
1878
AmpersandChar = '&';
1881
ACaption, FoundChar: string;
1800
while (lPos<length(Str)) do begin
1801
if Str[lPos]<>'&' then begin
1805
if (Str[lPos]<>'&') then begin
1806
Result := UpCase(Str[lPos]) = UpCase(char(VK));
1814
1884
Result := false;
1885
position := UTF8Pos(AmpersandChar, ACaption);
1886
// if AmpersandChar is on the last position then there is nothing to underscore, ignore this character
1887
while (position > 0) and (position < UTF8Length(ACaption)) do
1889
FoundChar := UTF8Copy(ACaption, position+1, 1);
1890
// two AmpersandChar characters together are not valid hot key
1891
if FoundChar <> AmpersandChar then begin
1892
Result := UTF8UpperCase(UTF16ToUTF8(WideString(WideChar(VK)))) = UTF8UpperCase(FoundChar);
1896
UTF8Delete(ACaption, 1, position+1);
1897
position := UTF8Pos(AmpersandChar, ACaption);
1817
1902
//==============================================================================
1951
2036
//==============================================================================
2038
procedure ImageDrawEvent(AImageList: TPersistent; ACanvas: TPersistent;
2039
AX, AY, AIndex: Integer; ADrawEffect: TGraphicsDrawEffect);
2041
ImageList: TCustomImageList absolute AImageList;
2042
Canvas: TCanvas absolute ACanvas;
2044
ImageList.Draw(Canvas,AX,AY,AIndex,ADrawEffect);
1954
2048
{$INCLUDE cursors.lrs}
1955
2049
RegisterPropertyToSkip(TForm, 'OldCreateOrder', 'VCL compatibility property', '');
1957
2051
RegisterPropertyToSkip(TForm, 'Scaled', 'VCL compatibility property', '');
1958
2052
RegisterPropertyToSkip(TForm, 'TransparentColorValue', 'VCL compatibility property', '');
1959
2053
LCLProc.OwnerFormDesignerModifiedProc:=@IfOwnerIsFormThenDesignerModified;
2054
ThemesImageDrawEvent:=@ImageDrawEvent;
1960
2055
Screen:=TScreen.Create(nil);
1961
2056
Application:=TApplication.Create(nil);