1{  $Id: controls.pp 61993 2019-10-05 12:39:01Z maxim $  }
2{
3 /***************************************************************************
4                               Controls.pp
5                             -------------------
6                             Component Library Controls
7                   Initial Revision : Sat Apr 10 22:49:32 CST 1999
8
9
10 ***************************************************************************/
11
12 *****************************************************************************
13  This file is part of the Lazarus Component Library (LCL)
14
15  See the file COPYING.modifiedLGPL.txt, included in this distribution,
16  for details about the license.
17 *****************************************************************************
18}
19unit Controls;
20
21{$mode objfpc}{$H+}
22{$I lcl_defines.inc}
23{off $DEFINE BUFFERED_WMPAINT}
24
25interface
26
27{$ifdef Trace}
28{$ASSERTIONS ON}
29{$endif}
30
31{$IFOPT C-}
32// Uncomment for local trace
33//  {$C+}
34//  {$DEFINE ASSERT_IS_ON}
35{$ENDIF}
36
37uses
38  Classes, SysUtils, TypInfo, Types, Laz_AVL_Tree,
39  // LCL
40  LCLStrConsts, LCLType, LCLProc, GraphType, Graphics, LMessages, LCLIntf,
41  InterfaceBase, ImgList, PropertyStorage, Menus, ActnList, LCLClasses,
42  LResources, LCLPlatformDef,
43  // LazUtils
44  LazMethodList, LazLoggerBase, LazUtilities, UITypes;
45
46{$I controlconsts.inc}
47
48const
49  // Used for ModalResult
50  mrNone    = UITypes.mrNone;
51  mrOK      = UITypes.mrOK;
52  mrCancel  = UITypes.mrCancel;
53  mrAbort   = UITypes.mrAbort;
54  mrRetry   = UITypes.mrRetry;
55  mrIgnore  = UITypes.mrIgnore;
56  mrYes     = UITypes.mrYes;
57  mrNo      = UITypes.mrNo;
58  mrAll     = UITypes.mrAll;
59  mrNoToAll = UITypes.mrNoToAll;
60  mrYesToAll= UITypes.mrYesToAll;
61  mrClose   = UITypes.mrClose;
62  mrLast    = UITypes.mrLast;
63
64function GetModalResultStr(ModalResult: TModalResult): ShortString;
65  deprecated 'Use the ModalResultStr array from unit UITypes directly.';
66property ModalResultStr[ModalResult: TModalResult]: shortstring read GetModalResultStr;
67
68const
69  // define aliases for Delphi compatibility
70  fsSurface = GraphType.fsSurface;
71  fsBorder = GraphType.fsBorder;
72
73  bvNone = GraphType.bvNone;
74  bvLowered = GraphType.bvLowered;
75  bvRaised = GraphType.bvRaised;
76  bvSpace = GraphType.bvSpace;
77
78  // Constant to define which key should be utilized for keyboard shortcuts like Ctrl+C (Copy),Z,X,V
79  // Mac and iOS use Meta instead of Ctrl for those shortcuts
80  ssModifier = {$if defined(darwin) or defined(macos) or defined(iphonesim)} ssMeta {$else} ssCtrl {$endif};
81
82type
83  TWinControl = class;
84  TControl = class;
85  TWinControlClass = class of TWinControl;
86  TControlClass = class of TControl;
87
88  // ToDo: move this to a message definition unit
89  TCMMouseWheel = record
90    MSg: Cardinal;
91    ShiftState: TShiftState;
92    Unused: Byte;
93    WheelDelta: SmallInt;
94    case Integer of
95    0: (
96      XPos: SmallInt;
97      YPos: SmallInt);
98    1: (
99      Pos: TSmallPoint;
100      Result: LRESULT);
101  end;
102
103  TCMHitTest = TLMNCHitTest;
104  TCMDesignHitTest = TLMMouse;
105
106  TCMControlChange = record
107    Msg: Cardinal;
108    Control: TControl;
109    Inserting: LongBool;
110    Result: LRESULT;
111  end;
112
113  TCMChanged = record
114    Msg: Cardinal;
115    Unused: Longint;
116    Child: TControl;
117    Result: Longint;
118  end;
119
120  TCMControlListChange = record
121    Msg: Cardinal;
122    Control: TControl;
123    Inserting: LongBool;
124    Result: LRESULT;
125  end;
126
127  TCMDialogChar = TLMKEY;
128  TCMDialogKey = TLMKEY;
129
130  TCMEnter = TLMEnter;
131  TCMExit = TLMExit;
132
133  TCMCancelMode = record
134    Msg: Cardinal;
135    Unused: Integer;
136    Sender: TControl;
137    Result: Longint;
138  end;
139
140  TCMChildKey = record
141    Msg: Cardinal;
142{$ifdef cpu64}
143    UnusedMsg: Cardinal;
144{$endif}
145{$IFDEF FPC_LITTLE_ENDIAN}
146    CharCode: Word; // VK_XXX constants as TLMKeyDown/Up, ascii if TLMChar
147    Unused: Word;
148{$ELSE}
149    Unused: Word;
150    CharCode: Word; // VK_XXX constants as TLMKeyDown/Up, ascii if TLMChar
151{$ENDIF}
152{$ifdef cpu64}
153    Unused2 : Longint;
154{$endif cpu64}
155    Sender: TWinControl;
156    Result: LRESULT;
157  end;
158
159  TAlign = (alNone, alTop, alBottom, alLeft, alRight, alClient, alCustom);
160  TAlignSet = set of TAlign;
161  TAnchorKind = (akTop, akLeft, akRight, akBottom);
162  TAnchors = set of TAnchorKind;
163  TAnchorSideReference = (asrTop, asrBottom, asrCenter);
164
165const
166  asrLeft = asrTop;
167  asrRight = asrBottom;
168
169type
170  TCaption = TTranslateString;
171  TCursor = -32768..32767;
172
173  TFormStyle = (fsNormal, fsMDIChild, fsMDIForm, fsStayOnTop, fsSplash, fsSystemStayOnTop);
174  TFormBorderStyle = (bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow,
175                      bsSizeToolWin);
176  TBorderStyle = bsNone..bsSingle;
177  TControlBorderStyle = TBorderStyle;
178
179  TControlRoleForForm = (
180    crffDefault,// this control is notified when user presses Return
181    crffCancel  // this control is notified when user presses Escape
182    );
183  TControlRolesForForm = set of TControlRoleForForm;
184
185  TBevelCut = TGraphicsBevelCut;
186
187  TMouseButton = (mbLeft, mbRight, mbMiddle, mbExtra1, mbExtra2);
188
189const
190  fsAllStayOnTop = [fsStayOnTop, fsSystemStayOnTop];
191  fsAllNonSystemStayOnTop = [fsStayOnTop];
192
193  // Cursor constants
194  crHigh        = TCursor(0);
195
196  crDefault     = TCursor(0);
197  crNone        = TCursor(-1);
198  crArrow       = TCursor(-2);
199  crCross       = TCursor(-3);
200  crIBeam       = TCursor(-4);
201  crSize        = TCursor(-22);
202  crSizeNESW    = TCursor(-6); // diagonal north east - south west
203  crSizeNS      = TCursor(-7);
204  crSizeNWSE    = TCursor(-8);
205  crSizeWE      = TCursor(-9);
206  crSizeNW      = TCursor(-23);
207  crSizeN       = TCursor(-24);
208  crSizeNE      = TCursor(-25);
209  crSizeW       = TCursor(-26);
210  crSizeE       = TCursor(-27);
211  crSizeSW      = TCursor(-28);
212  crSizeS       = TCursor(-29);
213  crSizeSE      = TCursor(-30);
214  crUpArrow     = TCursor(-10);
215  crHourGlass   = TCursor(-11);
216  crDrag        = TCursor(-12);
217  crNoDrop      = TCursor(-13);
218  crHSplit      = TCursor(-14);
219  crVSplit      = TCursor(-15);
220  crMultiDrag   = TCursor(-16);
221  crSQLWait     = TCursor(-17);
222  crNo          = TCursor(-18);
223  crAppStart    = TCursor(-19);
224  crHelp        = TCursor(-20);
225  crHandPoint   = TCursor(-21);
226  crSizeAll     = TCursor(-22);
227
228  crLow         = TCursor(-30);
229
230type
231  TCaptureMouseButtons = set of TMouseButton;
232
233  TWndMethod = procedure(var TheMessage: TLMessage) of Object;
234
235  TControlStyleType = (
236    csAcceptsControls,       // can have children in the designer
237    csCaptureMouse,          // auto capture mouse when clicked
238    csDesignInteractive,     // wants mouse events in design mode
239    csClickEvents,           // handles mouse events
240    csFramed,                // not implemented, has 3d frame
241    csSetCaption,            // if Name=Caption, changing the Name changes the Caption
242    csOpaque,                // the control paints its area completely
243    csDoubleClicks,          // understands mouse double clicks
244    csTripleClicks,          // understands mouse triple clicks
245    csQuadClicks,            // understands mouse quad clicks
246    csFixedWidth,            // cannot change its width
247    csFixedHeight,           // cannot change its height (for example combobox)
248    csNoDesignVisible,       // is invisible in the designer
249    csReplicatable,          // PaintTo works
250    csNoStdEvents,           // standard events such as mouse, key, and click events are ignored.
251    csDisplayDragImage,      // display images from dragimagelist during drag operation over control
252    csReflector,             // not implemented, the controls respond to size, focus and dlg messages - it can be used as ActiveX control under Windows
253    csActionClient,          // Action is set
254    csMenuEvents,            // not implemented
255    csNoFocus,               // control will not take focus when clicked with mouse.
256    csNeedsBorderPaint,      // not implemented
257    csParentBackground,      // tells WinXP to paint the theme background of parent on controls background
258    csDesignNoSmoothResize,  // when resizing control in the designer do not SetBounds while dragging
259    csDesignFixedBounds,     // can not be moved nor resized in designer
260    csHasDefaultAction,      // implements useful ExecuteDefaultAction
261    csHasCancelAction,       // implements useful ExecuteCancelAction
262    csNoDesignSelectable,    // can not be selected at design time
263    csOwnedChildrenNotSelectable, // child controls owned by this control are NOT selectable in the designer
264    csAutoSize0x0,           // if the preferred size is 0x0 then control is shrinked ot 0x0
265    csAutoSizeKeepChildLeft, // when AutoSize=true do not move children horizontally
266    csAutoSizeKeepChildTop,  // when AutoSize=true do not move children vertically
267    csRequiresKeyboardInput  // If the device has no physical keyboard then show the virtual keyboard when this control gets focus (therefore available only to TWinControl descendents)
268    );
269  TControlStyle = set of TControlStyleType;
270
271const
272  csMultiClicks = [csDoubleClicks,csTripleClicks,csQuadClicks];
273
274
275type
276  TControlStateType = (
277    csLButtonDown,
278    csClicked,
279    csPalette,
280    csReadingState,
281    csFocusing,
282    csCreating, // not used, exists for Delphi compatibility
283    csPaintCopy,
284    csCustomPaint,
285    csDestroyingHandle,
286    csDocking,
287    csVisibleSetInLoading
288  );
289  TControlState = set of TControlStateType;
290
291
292  { TControlCanvas }
293
294  TControlCanvas = class(TCanvas)
295  private
296    FControl: TControl;
297    FDeviceContext: HDC;
298    FWindowHandle: HWND;
299    procedure SetControl(AControl: TControl);
300  protected
301    procedure CreateHandle; override;
302    function GetDefaultColor(const ADefaultColorType: TDefaultColorType): TColor; override;
303  public
304    constructor Create;
305    destructor Destroy; override;
306    procedure FreeHandle;override;
307    function ControlIsPainting: boolean;
308    property Control: TControl read FControl write SetControl;
309  end;
310
311  { Hint stuff }
312
313  PHintInfo = ^THintInfo;
314  THintInfo = record
315    HintControl: TControl;
316    HintWindowClass: TWinControlClass;
317    HintPos: TPoint; // screen coordinates
318    HintMaxWidth: Integer;
319    HintColor: TColor;
320    CursorRect: TRect;
321    CursorPos: TPoint;
322    ReshowTimeout: Integer;
323    HideTimeout: Integer;
324    HintStr: string;
325    HintData: Pointer;
326  end;
327
328
329  { TDragImageList }
330
331  TImageListHelper = class helper for TCustomImageList
332  private
333    function GetResolutionForControl(AImageWidth: Integer; AControl: TControl): TScaledImageListResolution;
334  public
335    procedure DrawForControl(ACanvas: TCanvas; AX, AY, AIndex, AImageWidthAt96PPI: Integer;
336      AControl: TControl; AEnabled: Boolean = True); overload;
337    procedure DrawForControl(ACanvas: TCanvas; AX, AY, AIndex, AImageWidthAt96PPI: Integer;
338      AControl: TControl; ADrawEffect: TGraphicsDrawEffect); overload;
339
340    property ResolutionForControl[AImageWidth: Integer; AControl: TControl]: TScaledImageListResolution read GetResolutionForControl;
341  end;
342
343  TDragImageList = class;
344
345  TDragImageListResolution = class(TCustomImageListResolution)
346  private
347    FDragging: Boolean;
348    FDragHotspot: TPoint;
349    FOldCursor: TCursor;
350    FLastDragPos: TPoint;
351    FLockedWindow: HWND;// window where drag started and locked via DragLock, invalid=NoLockedWindow=High(PtrInt)
352
353    function GetImageList: TDragImageList;
354  protected
355    class procedure WSRegisterClass; override;
356
357    property ImageList: TDragImageList read GetImageList;
358  public
359    constructor Create(TheOwner: TComponent); override;
360
361    function GetHotSpot: TPoint; override;
362    function BeginDrag(Window: HWND; X, Y: Integer): Boolean;
363    function DragLock(Window: HWND; XPos, YPos: Integer): Boolean;
364    function DragMove(X, Y: Integer): Boolean;
365    procedure DragUnlock;
366    function EndDrag: Boolean;
367    procedure HideDragImage;
368    procedure ShowDragImage;
369
370    property DragHotspot: TPoint read FDragHotspot write FDragHotspot;
371    property Dragging: Boolean read FDragging;
372  end;
373
374  TDragImageList = class(TCustomImageList)
375  private
376    FDragCursor: TCursor;
377    FImageIndex: Integer;
378    procedure SetDragCursor(const AValue: TCursor);
379    function GetResolution(AImageWidth: Integer): TDragImageListResolution;
380    function GetDragging: Boolean;
381    function GetDraggingResolution: TDragImageListResolution;
382    function GetDragHotspot: TPoint;
383    procedure SetDragHotspot(const aDragHotspot: TPoint);
384  protected
385    function GetResolutionClass: TCustomImageListResolutionClass; override;
386    procedure Initialize; override;
387  public
388    function BeginDrag(Window: HWND; X, Y: Integer): Boolean;
389    function DragLock(Window: HWND; XPos, YPos: Integer): Boolean;
390    function DragMove(X, Y: Integer): Boolean;
391    procedure DragUnlock;
392    function EndDrag: Boolean;
393    procedure HideDragImage;
394    function SetDragImage(Index, HotSpotX, HotSpotY: Integer): Boolean;
395    procedure ShowDragImage;
396    property DragCursor: TCursor read FDragCursor write SetDragCursor;
397    property DragHotspot: TPoint read GetDragHotspot write SetDragHotspot;
398    property Dragging: Boolean read GetDragging;
399    property DraggingResolution: TDragImageListResolution read GetDraggingResolution;
400    property Resolution[AImageWidth: Integer]: TDragImageListResolution read GetResolution;
401  end;
402
403  TKeyEvent = procedure(Sender: TObject; var Key: Word; Shift: TShiftState) of Object;
404  TKeyPressEvent = procedure(Sender: TObject; var Key: char) of Object;
405  TUTF8KeyPressEvent = procedure(Sender: TObject; var UTF8Key: TUTF8Char) of Object;
406
407  TMouseEvent = procedure(Sender: TObject; Button: TMouseButton;
408                          Shift: TShiftState; X, Y: Integer) of Object;
409  TMouseMoveEvent = procedure(Sender: TObject; Shift: TShiftState;
410                              X, Y: Integer) of Object;
411  TMouseWheelEvent = procedure(Sender: TObject; Shift: TShiftState;
412         WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean) of Object;
413  TMouseWheelUpDownEvent = procedure(Sender: TObject;
414          Shift: TShiftState; MousePos: TPoint; var Handled: Boolean) of Object;
415
416  TGetDockCaptionEvent = procedure(Sender: TObject; AControl: TControl;
417    var ACaption: String) of Object;
418
419
420  { TDragObject }
421
422  TDragObject = class;
423
424  TDragKind = (dkDrag, dkDock);
425  TDragMode = (dmManual , dmAutomatic);
426  TDragState = (dsDragEnter, dsDragLeave, dsDragMove);
427  TDragMessage = (dmDragEnter, dmDragLeave, dmDragMove, dmDragDrop,
428                  dmDragCancel,dmFindTarget);
429
430  TDragOverEvent = procedure(Sender, Source: TObject;
431               X,Y: Integer; State: TDragState; var Accept: Boolean) of object;
432  TDragDropEvent = procedure(Sender, Source: TObject; X,Y: Integer) of object;
433  TStartDragEvent = procedure(Sender: TObject; var DragObject: TDragObject) of object;
434  TEndDragEvent = procedure(Sender, Target: TObject; X,Y: Integer) of object;
435
436  TDragObject = class
437  private
438    FAlwaysShowDragImages: Boolean;
439    FDragPos: TPoint;
440    FControl: TControl;
441    FDragTarget: TControl;
442    FDragTargetPos: TPoint;
443    FAutoFree: Boolean;
444    FAutoCreated: Boolean;
445    FDropped: Boolean;
446  protected
447    procedure EndDrag(Target: TObject; X, Y: Integer); virtual;
448    function GetDragImages: TDragImageList; virtual;
449    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; virtual;
450  public
451    constructor Create(AControl: TControl); virtual;
452    constructor AutoCreate(AControl: TControl);
453
454    procedure HideDragImage; virtual;
455    procedure ShowDragImage; virtual;
456
457    property AlwaysShowDragImages: Boolean read FAlwaysShowDragImages write FAlwaysShowDragImages;
458    property AutoCreated: Boolean read FAutoCreated;
459    property AutoFree: Boolean read FAutoFree;
460    property Control: TControl read FControl write FControl; // the dragged control
461    property DragPos: TPoint read FDragPos write FDragPos;
462    property DragTarget: TControl read FDragTarget write FDragTarget;
463    property DragTargetPos: TPoint read FDragTargetPos write FDragTargetPos;
464    property Dropped: Boolean read FDropped;
465  end;
466
467  TDragObjectClass = class of TDragObject;
468
469  { TDragObjectEx }
470
471  TDragObjectEx = class(TDragObject)
472  public
473    constructor Create(AControl: TControl); override;
474  end;
475
476
477  { TDragControlObject }
478
479  TDragControlObject = class(TDragObject)
480  protected
481    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
482    function GetDragImages: TDragImageList; override;
483  end;
484
485  { TDragControlObjectEx }
486
487  TDragControlObjectEx = class(TDragControlObject)
488  public
489    constructor Create(AControl: TControl); override;
490  end;
491
492  { TDragDockObject }
493
494  TDragDockObject = class;
495
496  TDockOrientation = (
497    doNoOrient,   // zone contains a TControl and no child zones.
498    doHorizontal, // zone's children are stacked top-to-bottom.
499    doVertical,   // zone's children are arranged left-to-right.
500    doPages       // zone's children are pages arranged left-to-right.
501    );
502  TDockDropEvent = procedure(Sender: TObject; Source: TDragDockObject;
503                             X, Y: Integer) of object;
504  TDockOverEvent = procedure(Sender: TObject; Source: TDragDockObject;
505                             X, Y: Integer; State: TDragState;
506                             var Accept: Boolean) of object;
507  TUnDockEvent = procedure(Sender: TObject; Client: TControl;
508                          NewTarget: TWinControl; var Allow: Boolean) of object;
509  TStartDockEvent = procedure(Sender: TObject;
510                              var DragObject: TDragDockObject) of object;
511  TGetSiteInfoEvent = procedure(Sender: TObject; DockClient: TControl;
512    var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean) of object;
513
514  TDrawDockImageEvent = procedure(Sender: TObject; AOldRect, ANewRect: TRect; AOperation: TDockImageOperation);
515
516var
517  OnDrawDockImage: TDrawDockImageEvent = nil;
518
519type
520  TDragDockObject = class(TDragObject)
521  private
522    FDockOffset: TPoint;
523    FDockRect: TRect;
524    FDropAlign: TAlign;
525    FDropOnControl: TControl;
526    FEraseDockRect: TRect;
527    FFloating: Boolean;
528    FIncreaseDockArea: Boolean;
529  protected
530    procedure AdjustDockRect(ARect: TRect); virtual;
531    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
532    procedure EndDrag(Target: TObject; X, Y: Integer); override;
533
534    // dock image drawing
535    procedure InitDock(APosition: TPoint); virtual;
536    procedure ShowDockImage; virtual;
537    procedure HideDockImage; virtual;
538    procedure MoveDockImage; virtual;
539    function HasOnDrawImage: boolean; virtual;
540  public
541    property DockOffset: TPoint read FDockOffset write FDockOffset;
542    property DockRect: TRect read FDockRect write FDockRect; // where to drop Control, screen coordinates
543    property DropAlign: TAlign read FDropAlign write FDropAlign; // how to align Control
544    property DropOnControl: TControl read FDropOnControl write FDropOnControl; // drop on child control of Target (Target is a parameter, not a property)
545    property Floating: Boolean read FFloating write FFloating;
546    property IncreaseDockArea: Boolean read FIncreaseDockArea;
547    property EraseDockRect: TRect read FEraseDockRect write FEraseDockRect;
548  end;
549
550  { TDragDockObjectEx }
551
552  TDragDockObjectEx = class(TDragDockObject)
553  public
554    constructor Create(AControl: TControl); override;
555  end;
556
557  { TDragManager }
558
559  TDragManager = class(TComponent)
560  private
561    FDragImmediate: Boolean;
562    FDragThreshold: Integer;
563  protected
564    //input capture
565    procedure KeyUp(var Key: Word; Shift : TShiftState); virtual;abstract;
566    procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;abstract;
567    procedure CaptureChanged(OldCaptureControl: TControl); virtual;abstract;
568    procedure MouseMove(Shift: TShiftState; X,Y: Integer); virtual;abstract;
569    procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); virtual;abstract;
570    procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); virtual;abstract;
571  public
572    constructor Create(TheOwner: TComponent); override;
573
574    function IsDragging: boolean; virtual;abstract;
575    function Dragging(AControl: TControl): boolean; virtual;abstract;
576    procedure RegisterDockSite(Site: TWinControl; DoRegister: Boolean); virtual;abstract;
577
578    procedure DragStart(AControl: TControl; AImmediate: Boolean; AThreshold: Integer; StartFromCurrentMouse:Boolean=False);virtual;abstract;
579    procedure DragMove(APosition: TPoint); virtual;abstract;
580    procedure DragStop(ADrop: Boolean); virtual;abstract;
581
582    function CanStartDragging(Site: TWinControl;  AThreshold: Integer; X,Y:Integer): boolean; virtual;abstract;
583
584    property DragImmediate: Boolean read FDragImmediate write FDragImmediate default True;
585    property DragThreshold: Integer read FDragThreshold write FDragThreshold default 5;
586  end;
587
588var
589  DragManager: TDragManager = nil;// created in initialization
590
591type
592  { TDockManager is an abstract class for managing a dock site's docked
593    controls. See TDockTree below for more info.
594    }
595  TDockManager = class(TPersistent)
596  public
597    constructor Create(ADockSite: TWinControl); virtual;
598    procedure BeginUpdate; virtual;
599    procedure EndUpdate; virtual;
600    procedure GetControlBounds(Control: TControl;
601                               out AControlBounds: TRect); virtual; abstract;
602    function GetDockEdge(ADockObject: TDragDockObject): boolean; virtual;
603    procedure InsertControl(ADockObject: TDragDockObject); virtual; overload;
604    procedure InsertControl(Control: TControl; InsertAt: TAlign;
605                            DropCtl: TControl); virtual; abstract; overload;
606    procedure LoadFromStream(Stream: TStream); virtual; abstract;
607    procedure PaintSite(DC: HDC); virtual;
608    procedure MessageHandler(Sender: TControl; var Message: TLMessage); virtual;
609    procedure PositionDockRect(ADockObject: TDragDockObject); virtual; overload;
610    procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign;
611                               var DockRect: TRect); virtual; abstract; overload;
612    procedure RemoveControl(Control: TControl); virtual; abstract;
613    procedure ResetBounds(Force: Boolean); virtual; abstract;
614    procedure SaveToStream(Stream: TStream); virtual; abstract;
615    procedure SetReplacingControl(Control: TControl); virtual;
616    function AutoFreeByControl: Boolean; virtual;
617    function IsEnabledControl(Control: TControl):Boolean; virtual;
618  end;
619
620  TDockManagerClass = class of TDockManager;
621
622  { TSizeConstraints }
623
624  TConstraintSize = 0..MaxInt;
625
626  TSizeConstraintsOption = (
627    // not yet used
628    scoAdviceWidthAsMin,
629    scoAdviceWidthAsMax,
630    scoAdviceHeightAsMin,
631    scoAdviceHeightAsMax
632    );
633  TSizeConstraintsOptions = set of TSizeConstraintsOption;
634
635  TSizeConstraints = class(TPersistent)
636  private
637    FControl: TControl;
638    FMaxHeight: TConstraintSize;
639    FMaxInterfaceHeight: integer;
640    FMaxInterfaceWidth: integer;
641    FMaxWidth: TConstraintSize;
642    FMinHeight: TConstraintSize;
643    FMinInterfaceHeight: integer;
644    FMinInterfaceWidth: integer;
645    FMinWidth: TConstraintSize;
646    FOnChange: TNotifyEvent;
647    FOptions: TSizeConstraintsOptions;
648    procedure SetOptions(const AValue: TSizeConstraintsOptions);
649  protected
650    procedure Change; virtual;
651    procedure AssignTo(Dest: TPersistent); override;
652    procedure SetMaxHeight(Value: TConstraintSize); virtual;
653    procedure SetMaxWidth(Value: TConstraintSize); virtual;
654    procedure SetMinHeight(Value: TConstraintSize); virtual;
655    procedure SetMinWidth(Value: TConstraintSize); virtual;
656  public
657    constructor Create(AControl: TControl); virtual;
658    procedure UpdateInterfaceConstraints; virtual;
659    procedure SetInterfaceConstraints(MinW, MinH, MaxW, MaxH: integer); virtual;
660    function EffectiveMinWidth: integer; virtual;
661    function EffectiveMinHeight: integer; virtual;
662    function EffectiveMaxWidth: integer; virtual;
663    function EffectiveMaxHeight: integer; virtual;
664    function MinMaxWidth(Width: integer): integer;
665    function MinMaxHeight(Height: integer): integer;
666    procedure AutoAdjustLayout(const AXProportion, AYProportion: Double);
667  public
668    property MaxInterfaceHeight: integer read FMaxInterfaceHeight;
669    property MaxInterfaceWidth: integer read FMaxInterfaceWidth;
670    property MinInterfaceHeight: integer read FMinInterfaceHeight;
671    property MinInterfaceWidth: integer read FMinInterfaceWidth;
672    property Control: TControl read FControl;
673    property Options: TSizeConstraintsOptions read FOptions write SetOptions default [];
674  published
675    property OnChange: TNotifyEvent read FOnChange write FOnChange;
676    property MaxHeight: TConstraintSize read FMaxHeight write SetMaxHeight default 0;
677    property MaxWidth: TConstraintSize read FMaxWidth write SetMaxWidth default 0;
678    property MinHeight: TConstraintSize read FMinHeight write SetMinHeight default 0;
679    property MinWidth: TConstraintSize read FMinWidth write SetMinWidth default 0;
680  end;
681
682  TConstrainedResizeEvent = procedure(Sender: TObject;
683      var MinWidth, MinHeight, MaxWidth, MaxHeight: TConstraintSize) of object;
684
685
686  { TControlBorderSpacing }
687
688  { TControlBorderSpacing defines the spacing around a control.
689    The spacing around its children and between its children is defined in
690    TWinControl.ChildSizing.
691
692    Left, Top, Right, Bottom: integer;
693        minimum space left to the autosized control.
694        For example: Control A lies left of control B.
695        A has borderspacing Right=10 and B has borderspacing Left=5.
696        Then A and B will have a minimum space of 10 between.
697
698    Around: integer;
699        same as Left, Top, Right and Bottom all at once. This will be added to
700        the effective Left, Top, Right and Bottom.
701        Example: Left=3 and Around=5 results in a minimum spacing to the left
702        of 8.
703
704    InnerBorder: integer;
705        This is added to the preferred size.
706        For example: A buttons widget returns 75x25 on GetPreferredSize.
707        CalculatePreferredSize adds 2 times the InnerBorder to the width and
708        height.
709
710    CellAlignHorizontal, CellAlignVertical: TControlCellAlign;
711        Used for example when the Parents.ChildSizing.Layout defines a table
712        layout.
713  }
714
715  TSpacingSize = Integer;
716  TControlCellAlign = (
717    ccaFill,
718    ccaLeftTop,
719    ccaRightBottom,
720    ccaCenter
721    );
722  TControlCellAligns = set of TControlCellAlign;
723
724  { TControlBorderSpacingDefault defines the default values for TControlBorderSpacing
725    so derived TControl classes can define their own default values }
726
727  TControlBorderSpacingDefault = record
728    Left: TSpacingSize;
729    Top: TSpacingSize;
730    Right: TSpacingSize;
731    Bottom: TSpacingSize;
732    Around: TSpacingSize;
733  end;
734  PControlBorderSpacingDefault = ^TControlBorderSpacingDefault;
735
736
737  { TControlBorderSpacing }
738
739  TControlBorderSpacing = class(TPersistent)
740  private
741    FAround: TSpacingSize;
742    FBottom: TSpacingSize;
743    FCellAlignHorizontal: TControlCellAlign;
744    FCellAlignVertical: TControlCellAlign;
745    FControl: TControl;
746    FInnerBorder: Integer;
747    FLeft: TSpacingSize;
748    FOnChange: TNotifyEvent;
749    FRight: TSpacingSize;
750    FTop: TSpacingSize;
751    FDefault: PControlBorderSpacingDefault;
752    function GetAroundBottom: Integer;
753    function GetAroundLeft: Integer;
754    function GetAroundRight: Integer;
755    function GetAroundTop: Integer;
756    function GetControlBottom: Integer;
757    function GetControlHeight: Integer;
758    function GetControlLeft: Integer;
759    function GetControlRight: Integer;
760    function GetControlTop: Integer;
761    function GetControlWidth: Integer;
762    function IsAroundStored: boolean;
763    function IsBottomStored: boolean;
764    function IsInnerBorderStored: boolean;
765    function IsLeftStored: boolean;
766    function IsRightStored: boolean;
767    function IsTopStored: boolean;
768    procedure SetAround(const AValue: TSpacingSize);
769    procedure SetBottom(const AValue: TSpacingSize);
770    procedure SetCellAlignHorizontal(const AValue: TControlCellAlign);
771    procedure SetCellAlignVertical(const AValue: TControlCellAlign);
772    procedure SetInnerBorder(const AValue: Integer);
773    procedure SetLeft(const AValue: TSpacingSize);
774    procedure SetRight(const AValue: TSpacingSize);
775    procedure SetSpace(Kind: TAnchorKind; const AValue: integer);
776    procedure SetTop(const AValue: TSpacingSize);
777  protected
778    procedure Change(InnerSpaceChanged: Boolean); virtual;
779  public
780    constructor Create(OwnerControl: TControl; ADefault: PControlBorderSpacingDefault = nil);
781    procedure Assign(Source: TPersistent); override;
782    procedure AssignTo(Dest: TPersistent); override;
783    function IsEqual(Spacing: TControlBorderSpacing): boolean;
784    procedure GetSpaceAround(var SpaceAround: TRect); virtual;
785    function GetSideSpace(Kind: TAnchorKind): Integer; // Around+GetSpace
786    function GetSpace(Kind: TAnchorKind): Integer; virtual;
787    procedure AutoAdjustLayout(const AXProportion, AYProportion: Double);
788  public
789    property Control: TControl read FControl;
790    property Space[Kind: TAnchorKind]: integer read GetSpace write SetSpace;
791    property AroundLeft: Integer read GetAroundLeft;
792    property AroundTop: Integer read GetAroundTop;
793    property AroundRight: Integer read GetAroundRight;
794    property AroundBottom: Integer read GetAroundBottom;
795    property ControlLeft: Integer read GetControlLeft;
796    property ControlTop: Integer read GetControlTop;
797    property ControlWidth: Integer read GetControlWidth;
798    property ControlHeight: Integer read GetControlHeight;
799    property ControlRight: Integer read GetControlRight;
800    property ControlBottom: Integer read GetControlBottom;
801  published
802    property OnChange: TNotifyEvent read FOnChange write FOnChange;
803    property Left: TSpacingSize read FLeft write SetLeft stored IsLeftStored;
804    property Top: TSpacingSize read FTop write SetTop stored IsTopStored;
805    property Right: TSpacingSize read FRight write SetRight stored IsRightStored;
806    property Bottom: TSpacingSize read FBottom write SetBottom stored IsBottomStored;
807    property Around: TSpacingSize read FAround write SetAround stored IsAroundStored;
808    property InnerBorder: Integer read FInnerBorder write SetInnerBorder stored IsInnerBorderStored default 0;
809    property CellAlignHorizontal: TControlCellAlign read FCellAlignHorizontal write SetCellAlignHorizontal default ccaFill;
810    property CellAlignVertical: TControlCellAlign read FCellAlignVertical write SetCellAlignVertical default ccaFill;
811  end;
812
813
814  { TAnchorSide
815    Class holding the reference sides of the anchors of a TControl.
816    Every TControl has four AnchorSides:
817    AnchorSide[akLeft], AnchorSide[akRight], AnchorSide[akTop] and
818    AnchorSide[akBottom].
819    Normally if Anchors contain akLeft, and the Parent is resized, the LCL
820    tries to keep the distance between the left side of the control and the
821    right side of its parent client area.
822    With AnchorSide[akLeft] you can define a different reference side. The
823    kept distance is defined by the BorderSpacing and Parent.ChildSizing.
824
825    Example1:
826       +-----+  +-----+
827       |  B  |  |  C  |
828       |     |  +-----+
829       +-----+
830
831      If you want to have the top of B the same as the top of C use
832        B.AnchorSide[akTop].Side:=asrTop;
833        B.AnchorSide[akTop].Control:=C;
834      If you want to keep a distance of 10 pixels between B and C use
835        B.BorderSpacing.Right:=10;
836        B.AnchorSide[akRight].Side:=asrLeft;
837        B.AnchorSide[akRight].Control:=C;
838
839      Do not setup in both directions, because this will create a circle, and
840      circles are not allowed.
841
842    Example2:
843            +-------+
844      +---+ |       |
845      | A | |   B   |
846      +---+ |       |
847            +-------+
848
849      Centering A relative to B:
850        A.AnchorSide[akTop].Side:=arsCenter;
851        A.AnchorSide[akTop].Control:=B;
852      Or use this. It's equivalent:
853        A.AnchorSide[akBottom].Side:=arsCenter;
854        A.AnchorSide[akBottom].Control:=B;
855    }
856  TAnchorSideChangeOperation = (ascoAdd, ascoRemove, ascoChangeSide);
857
858  { TAnchorSide }
859
860  TAnchorSide = class(TPersistent)
861  private
862    FKind: TAnchorKind;
863    FControl: TControl;
864    FOwner: TControl;
865    FSide: TAnchorSideReference;
866    function IsSideStored: boolean;
867    procedure SetControl(const AValue: TControl);
868    procedure SetSide(const AValue: TAnchorSideReference);
869  protected
870    function GetOwner: TPersistent; override;
871  public
872    constructor Create(TheOwner: TControl; TheKind: TAnchorKind);
873    destructor Destroy; override;
874    procedure GetSidePosition(out ReferenceControl: TControl;
875                out ReferenceSide: TAnchorSideReference; out Position: Integer);
876    function CheckSidePosition(NewControl: TControl; NewSide: TAnchorSideReference;
877                out ReferenceControl: TControl;
878                out ReferenceSide: TAnchorSideReference; out Position: Integer): boolean;
879    procedure Assign(Source: TPersistent); override;
880    function IsAnchoredToParent(ParentSide: TAnchorKind): boolean;
881    procedure FixCenterAnchoring;
882  public
883    property Owner: TControl read FOwner;
884    property Kind: TAnchorKind read FKind;
885  published
886    property Control: TControl read FControl write SetControl;
887    property Side: TAnchorSideReference read FSide write SetSide default asrTop;
888  end;
889
890  { TControlActionLink }
891
892  TControlActionLink = class(TActionLink)
893  protected
894    FClient: TControl;
895    procedure AssignClient(AClient: TObject); override;
896    procedure SetCaption(const Value: string); override;
897    procedure SetEnabled(Value: Boolean); override;
898    procedure SetHint(const Value: String); override;
899    procedure SetHelpContext(Value: THelpContext); override;
900    procedure SetHelpKeyword(const Value: string); override;
901    procedure SetHelpType(Value: THelpType); override;
902    procedure SetVisible(Value: Boolean); override;
903    procedure SetOnExecute(Value: TNotifyEvent); override;
904    function IsOnExecuteLinked: Boolean; override;
905    function DoShowHint(var HintStr: string): Boolean; virtual;
906  public
907    function IsCaptionLinked: Boolean; override;
908    function IsEnabledLinked: Boolean; override;
909    function IsHelpLinked: Boolean;  override;
910    function IsHintLinked: Boolean; override;
911    function IsVisibleLinked: Boolean; override;
912  end;
913
914  TControlActionLinkClass = class of TControlActionLink;
915
916
917  { TControl }
918
919  TControlAutoSizePhase = (
920    caspNone,
921    caspChangingProperties,
922    caspCreatingHandles, // create/destroy handles
923    caspComputingBounds,
924    caspRealizingBounds,
925    caspShowing          // make handles visible
926    );
927  TControlAutoSizePhases = set of TControlAutoSizePhase;
928
929  TTabOrder = -1..32767;
930
931  TControlShowHintEvent = procedure(Sender: TObject; HintInfo: PHintInfo) of object;
932  TContextPopupEvent = procedure(Sender: TObject; MousePos: TPoint;
933                                 var Handled: Boolean) of object;
934
935  TControlFlag = (
936    cfLoading, // set by TControl.ReadState, unset by TControl.Loaded when all on form finished loading
937    cfAutoSizeNeeded,
938    cfLeftLoaded,  // cfLeftLoaded is set, when 'Left' is set during loading.
939    cfTopLoaded,
940    cfWidthLoaded,
941    cfHeightLoaded,
942    cfClientWidthLoaded,
943    cfClientHeightLoaded,
944    cfBoundsRectForNewParentValid,
945    cfBaseBoundsValid,
946    cfPreferredSizeValid,
947    cfPreferredMinSizeValid,
948    cfOnChangeBoundsNeeded,
949    cfProcessingWMPaint,
950    cfKillChangeBounds,
951    cfKillInvalidatePreferredSize,
952    cfKillAdjustSize
953    );
954  TControlFlags = set of TControlFlag;
955
956  TControlHandlerType = (
957    chtOnResize,
958    chtOnChangeBounds,
959    chtOnVisibleChanging,
960    chtOnVisibleChanged,
961    chtOnEnabledChanging,
962    chtOnEnabledChanged,
963    chtOnKeyDown,
964    chtOnBeforeDestruction,
965    chtOnMouseWheel,
966    chtOnMouseWheelHorz
967    );
968
969  TLayoutAdjustmentPolicy = (
970    lapDefault,     // widgetset dependent
971    lapFixedLayout, // A fixed absolute layout in all platforms
972    lapAutoAdjustWithoutHorizontalScrolling, // Smartphone platforms use this one,
973                                             // the x axis is stretched to fill the screen and
974                                             // the y is scaled to fit the DPI
975    lapAutoAdjustForDPI // For desktops using High DPI, scale x and y to fit the DPI
976  );
977
978  TLazAccessibilityRole = (
979    larAnimation, // An object that displays an animation.
980    larButton, // A button.
981    larCell, // A cell in a table.
982    larChart, // An object that displays a graphical representation of data.
983    larCheckBox, // An object that can be checked or unchecked, or sometimes in an intermediary state
984    larClock, // A clock displaying time.
985    larColorPicker, // A control which allows selecting a color.
986    larComboBox, // A list of choices that the user can select from.
987    larDateField, // A controls which displays and possibly allows one to choose a date.
988    larGrid, // A grid control which displays cells
989    larGroup, // A control which groups others, such as a TGroupBox.
990    larIgnore, // Something to be ignored. For example a blank space between other objects.
991    larImage, // A graphic or picture or an icon.
992    larLabel, // A text label as usually placed near other widgets.
993    larListBox, // A list of items, from which the user can select one or more items.
994    larListItem, // An item in a list of items.
995    larMenuBar, // A main menu bar.
996    larMenuItem, // A item in a menu.
997    larProgressIndicator, // A control which shows a progress indication.
998    larRadioButton, // A radio button, see for example TRadioButton.
999    larResizeGrip, // A grip that the user can drag to change the size of widgets.
1000    larScrollBar, // A control to scroll another one
1001    larSpinner, // A control which allows one to increment / decrement a value.
1002    larTabControl, // A control with tabs, like TPageControl.
1003    larTextEditorMultiline, // A multi-line text editor (for example: TMemo, SynEdit)
1004    larTextEditorSingleline, // A single-line text editor (for example: TEdit)
1005    larTrackBar, // A control which allows one to drag a slider.
1006    larTreeView, // A list of items in a tree structure.
1007    larTreeItem, // An item in a tree structure.
1008    larWindow // A top level window.
1009  );
1010
1011  // The Child Accessible Objects are designed for non-TControl children
1012  // of a TCustomControl descendent, for example the items of a TTreeView
1013
1014  TLazAccessibleObject = class;
1015
1016  { TLazAccessibleObjectEnumerator }
1017
1018  TLazAccessibleObjectEnumerator = class(TAvlTreeNodeEnumerator)
1019  private
1020    function GetCurrent: TLazAccessibleObject;
1021  public
1022    property Current: TLazAccessibleObject read GetCurrent;
1023  end;
1024
1025  { TLazAccessibleObject }
1026
1027  TLazAccessibleObject = class
1028  private
1029    FHandle: PtrInt;
1030    FPosition: TPoint;
1031    FSize: TSize;
1032    // only for GetChildAccessibleObject(Index)
1033    FLastSearchNode: TAvlTreeNode;
1034    FLastSearchIndex: Integer;
1035    FLastSearchInSubcontrols: Boolean;
1036    function GetHandle: PtrInt;
1037    function GetPosition: TPoint;
1038    function GetSize: TSize;
1039    procedure SetHandle(AValue: PtrInt);
1040    procedure SetPosition(AValue: TPoint);
1041    procedure SetSize(AValue: TSize);
1042  protected
1043    FChildrenSortedForDataObject: TAvlTree; // of TLazAccessibleObject
1044    FAccessibleDescription: TCaption;
1045    FAccessibleValue: TCaption;
1046    FAccessibleRole: TLazAccessibilityRole;
1047    class procedure WSRegisterClass; virtual;//override;
1048    // provided for descendents to override and implement
1049    function GetAccessibleValue: TCaption; virtual;
1050  public
1051    OwnerControl: TControl;
1052    Parent: TLazAccessibleObject;
1053    DataObject: TObject; // Available to be used to connect to an object
1054    SecondaryHandle: PtrInt; // Available for Widgetsets to use
1055    constructor Create(AOwner: TControl); virtual;
1056    destructor Destroy; override;
1057    function HandleAllocated: Boolean;
1058    procedure InitializeHandle; virtual;
1059    procedure SetAccessibleDescription(const ADescription: TCaption);
1060    procedure SetAccessibleValue(const AValue: TCaption);
1061    procedure SetAccessibleRole(const ARole: TLazAccessibilityRole);
1062    function FindOwnerWinControl: TWinControl;
1063    function AddChildAccessibleObject: TLazAccessibleObject; virtual;
1064    procedure InsertChildAccessibleObject(AObject: TLazAccessibleObject);
1065    procedure ClearChildAccessibleObjects;
1066    procedure RemoveChildAccessibleObject(AObject: TLazAccessibleObject; AFreeObject: Boolean = True);
1067    // These search only in the child objects added manually
1068    function GetChildAccessibleObjectWithDataObject(ADataObject: TObject): TLazAccessibleObject;
1069    function GetChildAccessibleObjectsCount: Integer;
1070    function GetChildAccessibleObject(AIndex: Integer): TLazAccessibleObject;
1071    // These search in all subcontrols too
1072    function GetFirstChildAccessibleObject: TLazAccessibleObject;
1073    function GetNextChildAccessibleObject: TLazAccessibleObject;
1074    //
1075    function GetSelectedChildAccessibleObject: TLazAccessibleObject; virtual;
1076    function GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; virtual;
1077    // Primary information
1078    property AccessibleDescription: TCaption read FAccessibleDescription write SetAccessibleDescription;
1079    property AccessibleValue: TCaption read GetAccessibleValue write SetAccessibleValue;
1080    property AccessibleRole: TLazAccessibilityRole read FAccessibleRole write SetAccessibleRole;
1081    property Position: TPoint read GetPosition write SetPosition;
1082    property Size: TSize read GetSize write SetSize;
1083    property Handle: PtrInt read GetHandle write SetHandle;
1084    function GetEnumerator: TLazAccessibleObjectEnumerator;
1085  end;
1086
1087{* Note on TControl.Caption
1088 * The VCL implementation relies on the virtual Get/SetTextBuf to
1089 * exchange text between widgets and VCL. This means a lot of
1090 * (unnecessary) text copies.
1091 * The LCL uses strings for exchanging text (more efficient).
1092 * To maintain VCL compatibility, the virtual RealGet/SetText is
1093 * introduced. These functions interface with the LCLInterface. The
1094 * default Get/SetTextbuf implementation calls the RealGet/SetText.
1095 * As long as the Get/SetTextBuf isn't overridden Get/SetText
1096 * calls RealGet/SetText to avoid PChar copying.
1097 * To keep things optimal, LCL implementations should always
1098 * override RealGet/SetText. Get/SetTextBuf is only kept for
1099 * compatibility.
1100 }
1101
1102  TControl = class(TLCLComponent)
1103  private
1104    FActionLink: TControlActionLink;
1105    FAlign: TAlign;
1106    FAnchors: TAnchors;
1107    FAnchorSides: array[TAnchorKind] of TAnchorSide;
1108    FAnchoredControls: TFPList; // list of TControl anchored to this control
1109    FAutoSizingLockCount: Integer; // in/decreased by DisableAutoSizing/EnableAutoSizing
1110    {$IFDEF DebugDisableAutoSizing}
1111    FAutoSizingLockReasons: TStrings;
1112    {$ENDIF}
1113    FBaseBounds: TRect;
1114    FBaseBoundsLock: integer;
1115    FBaseParentClientSize: TSize;
1116    FBiDiMode: TBiDiMode;
1117    FBorderSpacing: TControlBorderSpacing;
1118    FBoundsRectForNewParent: TRect;
1119    FCaption: TCaption;
1120    FCaptureMouseButtons: TCaptureMouseButtons;
1121    FColor: TColor;
1122    FConstraints: TSizeConstraints;
1123    FControlFlags: TControlFlags;
1124    FControlHandlers: array[TControlHandlerType] of TMethodList;
1125    FControlStyle: TControlStyle;
1126    FDesktopFont: Boolean;
1127    FDockOrientation: TDockOrientation;
1128    FDragCursor: TCursor;
1129    FDragKind: TDragKind;
1130    FDragMode: TDragMode;
1131    FFloatingDockSiteClass: TWinControlClass;
1132    FFont: TFont;
1133    FHeight: Integer;
1134    FHelpContext: THelpContext;
1135    FHelpKeyword: String;
1136    FHelpType: THelpType;
1137    FHint: TTranslateString;
1138    FHostDockSite: TWinControl;
1139    FLastDoChangeBounds: TRect;
1140    FLastDoChangeClientSize: TPoint;
1141    FLastResizeClientHeight: integer;
1142    FLastResizeClientWidth: integer;
1143    FLastResizeHeight: integer;
1144    FLastResizeWidth: integer;
1145    FLeft: Integer;
1146    FLoadedClientSize: TSize;
1147    FLRDockWidth: Integer;
1148    FOnChangeBounds: TNotifyEvent;
1149    FOnClick: TNotifyEvent;
1150    FOnConstrainedResize: TConstrainedResizeEvent;
1151    FOnContextPopup: TContextPopupEvent;
1152    FOnDblClick: TNotifyEvent;
1153    FOnDragDrop: TDragDropEvent;
1154    FOnDragOver: TDragOverEvent;
1155    FOnEditingDone: TNotifyEvent;
1156    FOnEndDock: TEndDragEvent;
1157    FOnEndDrag: TEndDragEvent;
1158    FOnMouseDown: TMouseEvent;
1159    FOnMouseEnter: TNotifyEvent;
1160    FOnMouseLeave: TNotifyEvent;
1161    FOnMouseMove: TMouseMoveEvent;
1162    FOnMouseUp: TMouseEvent;
1163    FOnMouseWheel: TMouseWheelEvent;
1164    FOnMouseWheelDown: TMouseWheelUpDownEvent;
1165    FOnMouseWheelUp: TMouseWheelUpDownEvent;
1166    FOnMouseWheelHorz: TMouseWheelEvent;
1167    FOnMouseWheelLeft: TMouseWheelUpDownEvent;
1168    FOnMouseWheelRight: TMouseWheelUpDownEvent;
1169    FOnQuadClick: TNotifyEvent;
1170    FOnResize: TNotifyEvent;
1171    FOnShowHint: TControlShowHintEvent;
1172    FOnStartDock: TStartDockEvent;
1173    FOnStartDrag: TStartDragEvent;
1174    FOnTripleClick: TNotifyEvent;
1175    FParent: TWinControl;
1176    FParentBiDiMode: Boolean;
1177    FPopupMenu: TPopupMenu;
1178    FPreferredMinWidth: integer;// without theme space
1179    FPreferredMinHeight: integer;// without theme space
1180    FPreferredWidth: integer;// with theme space
1181    FPreferredHeight: integer;// with theme space
1182    FReadBounds: TRect;
1183    FSessionProperties: string;
1184    FSizeLock: integer;
1185    FTBDockHeight: Integer;
1186    FTop: Integer;
1187    FUndockHeight: Integer;
1188    FUndockWidth: Integer;
1189    FWidth: Integer;
1190    FWindowProc: TWndMethod;
1191    //boolean fields, keep together to save some bytes
1192    FIsControl: Boolean;
1193    FShowHint: Boolean;
1194    FParentColor: Boolean;
1195    FParentFont: Boolean;
1196    FParentShowHint: Boolean;
1197    FAutoSize: Boolean;
1198    FAutoSizingAll: boolean;
1199    FAutoSizingSelf: Boolean;
1200    FEnabled: Boolean;
1201    FMouseInClient: boolean;
1202    FVisible: Boolean;
1203    function CaptureMouseButtonsIsStored: boolean;
1204    procedure DoActionChange(Sender: TObject);
1205    function GetAccessibleDescription: TCaption;
1206    function GetAccessibleValue: TCaption;
1207    function GetAccessibleRole: TLazAccessibilityRole;
1208    function GetAutoSizingAll: Boolean;
1209    function GetAnchorSide(Kind: TAnchorKind): TAnchorSide;
1210    function GetAnchoredControls(Index: integer): TControl;
1211    function GetBoundsRect: TRect;
1212    function GetClientHeight: Integer;
1213    function GetClientWidth: Integer;
1214    function GetLRDockWidth: Integer;
1215    function GetTBDockHeight: Integer;
1216    function GetText: TCaption;
1217    function GetUndockHeight: Integer;
1218    function GetUndockWidth: Integer;
1219    function IsAnchorsStored: boolean;
1220    function IsBiDiModeStored: boolean;
1221    function IsEnabledStored: Boolean;
1222    function IsFontStored: Boolean;
1223    function IsHintStored: Boolean;
1224    function IsHelpContextStored: Boolean;
1225    function IsHelpKeyWordStored: boolean;
1226    function IsShowHintStored: Boolean;
1227    function IsVisibleStored: Boolean;
1228    procedure DoBeforeMouseMessage;
1229    procedure DoConstrainedResize(var NewLeft, NewTop, NewWidth, NewHeight: integer);
1230    procedure DoMouseDown(var Message: TLMMouse; Button: TMouseButton;
1231                          Shift: TShiftState);
1232    procedure DoMouseUp(var Message: TLMMouse; Button: TMouseButton);
1233    procedure SetAccessibleDescription(AValue: TCaption);
1234    procedure SetAccessibleValue(AValue: TCaption);
1235    procedure SetAccessibleRole(AValue: TLazAccessibilityRole);
1236    procedure SetAnchorSide(Kind: TAnchorKind; AValue: TAnchorSide);
1237    procedure SetBorderSpacing(const AValue: TControlBorderSpacing);
1238    procedure SetBoundsRect(const ARect: TRect);
1239    procedure SetBoundsRectForNewParent(const AValue: TRect);
1240    procedure SetClientHeight(Value: Integer);
1241    procedure SetClientSize(const Value: TPoint);
1242    procedure SetClientWidth(Value: Integer);
1243    procedure SetConstraints(const Value: TSizeConstraints);
1244    procedure SetDesktopFont(const AValue: Boolean);
1245    procedure SetDragCursor(const AValue: TCursor);
1246    procedure SetFont(Value: TFont);
1247    procedure SetHeight(Value: Integer);
1248    procedure SetHelpContext(const AValue: THelpContext);
1249    procedure SetHelpKeyword(const AValue: String);
1250    procedure SetHostDockSite(const AValue: TWinControl);
1251    procedure SetLeft(Value: Integer);
1252    procedure SetMouseCapture(Value: Boolean);
1253    procedure SetParentShowHint(Value: Boolean);
1254    procedure SetParentColor(Value: Boolean);
1255    procedure SetParentFont(Value: Boolean);
1256    procedure SetPopupMenu(Value: TPopupMenu);
1257    procedure SetShowHint(Value: Boolean);
1258    procedure SetText(const Value: TCaption);
1259    procedure SetTop(Value: Integer);
1260    procedure SetWidth(Value: Integer);
1261  protected
1262    FAccessibleObject: TLazAccessibleObject;
1263    FControlState: TControlState;
1264    FCursor: TCursor;
1265    class procedure WSRegisterClass; override;
1266    function GetCursor: TCursor; virtual;
1267    procedure SetCursor(Value: TCursor); virtual;
1268    procedure SetVisible(Value: Boolean); virtual;
1269    procedure DoOnParentHandleDestruction; virtual;
1270  protected
1271    // sizing/aligning
1272    procedure DoAutoSize; virtual;
1273    procedure DoAllAutoSize; virtual; // while autosize needed call DoAutoSize, used by AdjustSize and EnableAutoSizing
1274    procedure BeginAutoSizing; // set AutoSizing=true, can be used to prevent circles
1275    procedure EndAutoSizing;   // set AutoSizing=false
1276    procedure AnchorSideChanged(TheAnchorSide: TAnchorSide); virtual;
1277    procedure ForeignAnchorSideChanged(TheAnchorSide: TAnchorSide;
1278                                       Operation: TAnchorSideChangeOperation); virtual;
1279    procedure SetAlign(Value: TAlign); virtual;
1280    procedure SetAnchors(const AValue: TAnchors); virtual;
1281    procedure SetAutoSize(Value: Boolean); virtual;
1282    procedure BoundsChanged; virtual;
1283    function CreateControlBorderSpacing: TControlBorderSpacing; virtual;
1284    procedure DoConstraintsChange(Sender: TObject); virtual;
1285    procedure DoBorderSpacingChange(Sender: TObject;
1286                                    InnerSpaceChanged: Boolean); virtual;
1287    function IsBorderSpacingInnerBorderStored: Boolean; virtual;
1288    function IsCaptionStored: Boolean;
1289    procedure SendMoveSizeMessages(SizeChanged, PosChanged: boolean); virtual;
1290    procedure ConstrainedResize(var MinWidth, MinHeight,
1291                                MaxWidth, MaxHeight: TConstraintSize); virtual;
1292    procedure CalculatePreferredSize(
1293                         var PreferredWidth, PreferredHeight: integer;
1294                         WithThemeSpace: Boolean); virtual;
1295    procedure DoOnResize; virtual;// call OnResize
1296    procedure DoOnChangeBounds; virtual;// call OnChangeBounds
1297    procedure CheckOnChangeBounds;// checks for changes and calls DoOnChangeBounds
1298    procedure Resize; virtual;// checks for changes and calls DoOnResize
1299    procedure RequestAlign; virtual;// smart calling Parent.AlignControls
1300    procedure UpdateAnchorRules;
1301    procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer; KeepBase: boolean); virtual;
1302    procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); virtual;
1303    procedure ScaleConstraints(Multiplier, Divider: Integer);
1304    procedure ChangeScale(Multiplier, Divider: Integer); virtual;
1305    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; virtual;
1306    procedure SetBiDiMode(AValue: TBiDiMode); virtual;
1307    procedure SetParentBiDiMode(AValue: Boolean); virtual;
1308    function IsAParentAligning: boolean;
1309    function GetClientOrigin: TPoint; virtual;
1310    function GetClientRect: TRect; virtual;// visual size of client area
1311    function GetLogicalClientRect: TRect; virtual;// logical size of client area (e.g. in a TScrollBox the logical client area can be bigger than the visual)
1312    function GetScrolledClientRect: TRect; virtual;// visual client area scrolled
1313    function GetClientScrollOffset: TPoint; virtual;
1314    function GetControlOrigin: TPoint; virtual;
1315    function IsClientHeightStored: boolean; virtual;
1316    function IsClientWidthStored: boolean; virtual;
1317    function WidthIsAnchored: boolean;
1318    function HeightIsAnchored: boolean;
1319
1320    property AutoSizing: Boolean read FAutoSizingSelf;// see Begin/EndAutoSizing
1321    property AutoSizingAll: Boolean read GetAutoSizingAll;// set in DoAllAutoSize
1322    property AutoSizingLockCount: Integer read FAutoSizingLockCount; // in/decreased by Disable/EnableAutoSizing
1323  protected
1324    // protected messages
1325    procedure WMCancelMode(var Message: TLMessage); message LM_CANCELMODE;
1326    procedure WMContextMenu(var Message: TLMContextMenu); message LM_CONTEXTMENU;
1327
1328    procedure WMLButtonDown(var Message: TLMLButtonDown); message LM_LBUTTONDOWN;
1329    procedure WMRButtonDown(var Message: TLMRButtonDown); message LM_RBUTTONDOWN;
1330    procedure WMMButtonDown(var Message: TLMMButtonDown); message LM_MBUTTONDOWN;
1331    procedure WMXButtonDown(var Message: TLMXButtonDown); message LM_XBUTTONDOWN;
1332    procedure WMLButtonDBLCLK(var Message: TLMLButtonDblClk); message LM_LBUTTONDBLCLK;
1333    procedure WMRButtonDBLCLK(var Message: TLMRButtonDblClk); message LM_RBUTTONDBLCLK;
1334    procedure WMMButtonDBLCLK(var Message: TLMMButtonDblClk); message LM_MBUTTONDBLCLK;
1335    procedure WMXButtonDBLCLK(var Message: TLMXButtonDblClk); message LM_XBUTTONDBLCLK;
1336    procedure WMLButtonTripleCLK(var Message: TLMLButtonTripleClk); message LM_LBUTTONTRIPLECLK;
1337    procedure WMRButtonTripleCLK(var Message: TLMRButtonTripleClk); message LM_RBUTTONTRIPLECLK;
1338    procedure WMMButtonTripleCLK(var Message: TLMMButtonTripleClk); message LM_MBUTTONTRIPLECLK;
1339    procedure WMXButtonTripleCLK(var Message: TLMXButtonTripleClk); message LM_XBUTTONTRIPLECLK;
1340    procedure WMLButtonQuadCLK(var Message: TLMLButtonQuadClk); message LM_LBUTTONQUADCLK;
1341    procedure WMRButtonQuadCLK(var Message: TLMRButtonQuadClk); message LM_RBUTTONQUADCLK;
1342    procedure WMMButtonQuadCLK(var Message: TLMMButtonQuadClk); message LM_MBUTTONQUADCLK;
1343    procedure WMXButtonQuadCLK(var Message: TLMXButtonQuadClk); message LM_XBUTTONQUADCLK;
1344    procedure WMMouseMove(var Message: TLMMouseMove); message LM_MOUSEMOVE;
1345    procedure WMLButtonUp(var Message: TLMLButtonUp); message LM_LBUTTONUP;
1346    procedure WMRButtonUp(var Message: TLMRButtonUp); message LM_RBUTTONUP;
1347    procedure WMMButtonUp(var Message: TLMMButtonUp); message LM_MBUTTONUP;
1348    procedure WMXButtonUp(var Message: TLMXButtonUp); message LM_XBUTTONUP;
1349    procedure WMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL;
1350    procedure WMMouseHWheel(var Message: TLMMouseEvent); message LM_MOUSEHWHEEL;
1351    procedure WMMove(var Message: TLMMove); message LM_MOVE;
1352    procedure WMSize(var Message: TLMSize); message LM_SIZE;
1353    procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
1354    procedure CMChanged(var Message: TLMessage); message CM_CHANGED;
1355    procedure LMCaptureChanged(var Message: TLMessage); message LM_CaptureChanged;
1356    procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
1357    procedure CMSysFontChanged(var Message: TLMessage); message CM_SYSFONTCHANGED;
1358    procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED;
1359    procedure CMHitTest(var Message: TCMHittest) ; message CM_HITTEST;
1360    procedure CMMouseEnter(var Message :TLMessage); message CM_MOUSEENTER;
1361    procedure CMMouseLeave(var Message :TLMessage); message CM_MOUSELEAVE;
1362    procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW;
1363    procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED;
1364    procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
1365    procedure CMParentFontChanged(var Message: TLMessage); message CM_PARENTFONTCHANGED;
1366    procedure CMParentShowHintChanged(var Message: TLMessage); message CM_PARENTSHOWHINTCHANGED;
1367    procedure CMVisibleChanged(var Message: TLMessage); message CM_VISIBLECHANGED;
1368    procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
1369    procedure CMCursorChanged(var Message: TLMessage); message CM_CURSORCHANGED;
1370  protected
1371    // drag and drop
1372    procedure CalculateDockSizes;
1373    function CreateFloatingDockSite(const Bounds: TRect): TWinControl;
1374    function GetDockEdge(const MousePos: TPoint): TAlign; virtual;
1375    function GetDragImages: TDragImageList; virtual;
1376    function GetFloating: Boolean; virtual;
1377    function GetFloatingDockSiteClass: TWinControlClass; virtual;
1378    procedure BeforeDragStart; virtual;
1379    procedure BeginAutoDrag; virtual;
1380    procedure DoFloatMsg(ADockSource: TDragDockObject);virtual;//CM_FLOAT
1381    procedure DockTrackNoTarget(Source: TDragDockObject; X, Y: Integer); virtual;
1382    procedure DoDock(NewDockSite: TWinControl; var ARect: TRect); virtual;
1383    function DoDragMsg(ADragMessage: TDragMessage; APosition: TPoint; ADragObject: TDragObject; ATarget: TControl; ADocking: Boolean):LRESULT; virtual;//Cm_Drag
1384    procedure DoEndDock(Target: TObject; X, Y: Integer); virtual;
1385    procedure DoEndDrag(Target: TObject; X,Y: Integer); virtual;
1386    procedure DoStartDock(var DragObject: TDragObject); virtual;
1387    procedure DoStartDrag(var DragObject: TDragObject); virtual;
1388    procedure DragCanceled; virtual;
1389    procedure DragOver(Source: TObject; X,Y: Integer; State: TDragState;
1390                       var Accept: Boolean); virtual;
1391    procedure PositionDockRect(DragDockObject: TDragDockObject); virtual;
1392    procedure SetDragMode(Value: TDragMode); virtual;
1393    function GetDefaultDockCaption: String; virtual;
1394    //procedure SendDockNotification; virtual; MG: probably not needed
1395  protected
1396    // key and mouse
1397    procedure Click; virtual;
1398    procedure DblClick; virtual;
1399    procedure TripleClick; virtual;
1400    procedure QuadClick; virtual;
1401    function GetMousePosFromMessage(const MessageMousePos: TSmallPoint): TPoint;
1402    procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); virtual;
1403    procedure MouseMove(Shift: TShiftState; X,Y: Integer); virtual;
1404    procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); virtual;
1405    procedure MouseEnter; virtual;
1406    procedure MouseLeave; virtual;
1407    function  DialogChar(var Message: TLMKey): boolean; virtual;
1408    procedure UpdateMouseCursor(X, Y: integer);
1409  protected
1410    procedure Changed;
1411    function  GetPalette: HPalette; virtual;
1412    function ChildClassAllowed(ChildClass: TClass): boolean; virtual;
1413    procedure ReadState(Reader: TReader); override; // called
1414    procedure Loaded; override;
1415    procedure LoadedAll; virtual; // called when all controls were Loaded and lost their csLoading
1416    procedure DefineProperties(Filer: TFiler); override;
1417    procedure AssignTo(Dest: TPersistent); override;
1418    procedure FormEndUpdated; virtual;
1419    procedure InvalidateControl(CtrlIsVisible, CtrlIsOpaque: Boolean);
1420    procedure InvalidateControl(CtrlIsVisible, CtrlIsOpaque, IgnoreWinControls: Boolean);
1421    procedure FontChanged(Sender: TObject); virtual;
1422    procedure ParentFontChanged; virtual;
1423    function GetAction: TBasicAction; virtual;
1424    function RealGetText: TCaption; virtual;
1425    procedure RealSetText(const Value: TCaption); virtual;
1426    procedure TextChanged; virtual;
1427    function GetCachedText(var CachedText: TCaption): boolean; virtual;
1428    procedure SetAction(Value: TBasicAction); virtual;
1429    procedure SetColor(Value: TColor); virtual;
1430    procedure SetEnabled(Value: Boolean); virtual;
1431    procedure SetHint(const Value: TTranslateString); virtual;
1432    procedure SetName(const Value: TComponentName); override;
1433    procedure SetParent(NewParent: TWinControl); virtual;
1434    procedure SetParentComponent(NewParentComponent: TComponent); override;
1435    procedure WndProc(var TheMessage: TLMessage); virtual;
1436    procedure ParentFormHandleInitialized; virtual; // called by ChildHandlesCreated of parent form
1437    function GetMouseCapture: Boolean; virtual;
1438    procedure CaptureChanged; virtual;
1439    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
1440    function CanTab: Boolean; virtual;
1441    function GetDeviceContext(var WindowHandle: HWND): HDC; virtual;
1442    function GetEnabled: Boolean; virtual;
1443    function GetPopupMenu: TPopupMenu; virtual;
1444    procedure DoOnShowHint(HintInfo: PHintInfo); virtual;
1445    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; virtual;
1446    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; virtual;
1447    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; virtual;
1448    function DoMouseWheelHorz(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; virtual;
1449    function DoMouseWheelLeft(Shift: TShiftState; MousePos: TPoint): Boolean; virtual;
1450    function DoMouseWheelRight(Shift: TShiftState; MousePos: TPoint): Boolean; virtual;
1451    procedure VisibleChanging; virtual;
1452    procedure VisibleChanged; virtual;
1453    procedure EnabledChanging; virtual;
1454    procedure EnabledChanged; virtual;
1455    procedure AddHandler(HandlerType: TControlHandlerType;
1456                         const AMethod: TMethod; AsFirst: boolean = false);
1457    procedure RemoveHandler(HandlerType: TControlHandlerType;
1458                            const AMethod: TMethod);
1459    procedure DoCallNotifyHandler(HandlerType: TControlHandlerType);
1460    procedure DoCallKeyEventHandler(HandlerType: TControlHandlerType;
1461                                    var Key: Word; Shift: TShiftState);
1462    procedure DoCallMouseWheelEventHandler(HandlerType: TControlHandlerType;
1463                                           Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
1464                                           var Handled: Boolean);
1465    procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); virtual;
1466    procedure SetZOrder(TopMost: Boolean); virtual;
1467    class function GetControlClassDefaultSize: TSize; virtual;
1468    function ColorIsStored: boolean; virtual;
1469    procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
1470      const AXProportion, AYProportion: Double); virtual;
1471    procedure DoFixDesignFontPPI(const AFont: TFont; const ADesignTimePPI: Integer);
1472    procedure DoScaleFontPPI(const AFont: TFont; const AToPPI: Integer; const AProportion: Double);
1473  protected
1474    // actions
1475    function GetActionLinkClass: TControlActionLinkClass; virtual;
1476    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual;
1477  protected
1478    // optional properties (not every descendent supports them)
1479    property ActionLink: TControlActionLink read FActionLink write FActionLink;
1480    property DesktopFont: Boolean read FDesktopFont write SetDesktopFont;
1481    property DragCursor: TCursor read FDragCursor write SetDragCursor default crDrag;
1482    property DragKind: TDragKind read FDragKind write FDragKind default dkDrag;
1483    property DragMode: TDragMode read FDragMode write SetDragMode default dmManual;
1484    property MouseCapture: Boolean read GetMouseCapture write SetMouseCapture;
1485    property ParentColor: Boolean read FParentColor write SetParentColor default True;
1486    property ParentFont: Boolean  read FParentFont write SetParentFont default True;
1487    property ParentShowHint: Boolean read FParentShowHint write SetParentShowHint default True;
1488    property SessionProperties: string read FSessionProperties write FSessionProperties;
1489    property Text: TCaption read GetText write SetText;
1490    property OnConstrainedResize: TConstrainedResizeEvent read FOnConstrainedResize write FOnConstrainedResize;
1491    property OnContextPopup: TContextPopupEvent read FOnContextPopup write FOnContextPopup;
1492    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
1493    property OnTripleClick: TNotifyEvent read FOnTripleClick write FOnTripleClick;
1494    property OnQuadClick: TNotifyEvent read FOnQuadClick write FOnQuadClick;
1495    property OnDragDrop: TDragDropEvent read FOnDragDrop write FOnDragDrop;
1496    property OnDragOver: TDragOverEvent read FOnDragOver write FOnDragOver;
1497    property OnEndDock: TEndDragEvent read FOnEndDock write FOnEndDock;
1498    property OnEndDrag: TEndDragEvent read FOnEndDrag write FOnEndDrag;
1499    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
1500    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
1501    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
1502    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
1503    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
1504    property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
1505    property OnMouseWheelDown: TMouseWheelUpDownEvent read FOnMouseWheelDown write FOnMouseWheelDown;
1506    property OnMouseWheelUp: TMouseWheelUpDownEvent read FOnMouseWheelUp write FOnMouseWheelUp;
1507    property OnMouseWheelHorz: TMouseWheelEvent read FOnMouseWheelHorz write FOnMouseWheelHorz;
1508    property OnMouseWheelLeft: TMouseWheelUpDownEvent read FOnMouseWheelLeft write FOnMouseWheelLeft;
1509    property OnMouseWheelRight: TMouseWheelUpDownEvent read FOnMouseWheelRight write FOnMouseWheelRight;
1510    property OnStartDock: TStartDockEvent read FOnStartDock write FOnStartDock;
1511    property OnStartDrag: TStartDragEvent read FOnStartDrag write FOnStartDrag;
1512    property OnEditingDone: TNotifyEvent read FOnEditingDone write FOnEditingDone;
1513  public
1514    FCompStyle: Byte; // DEPRECATED. Enables (valid) use of 'IN' operator (this
1515      // is a hack for speed. It will be replaced by the use of the widgetset
1516      // classes.
1517      // So, don't use it anymore.
1518  public
1519    // drag and dock
1520    procedure DragDrop(Source: TObject; X,Y: Integer); virtual;
1521    procedure Dock(NewDockSite: TWinControl; ARect: TRect); virtual;
1522    function ManualDock(NewDockSite: TWinControl;
1523                        DropControl: TControl = nil;
1524                        ControlSide: TAlign = alNone;
1525                        KeepDockSiteSize: Boolean = true): Boolean; virtual;
1526    function ManualFloat(TheScreenRect: TRect;
1527                         KeepDockSiteSize: Boolean = true): Boolean; virtual;
1528    function ReplaceDockedControl(Control: TControl; NewDockSite: TWinControl;
1529                           DropControl: TControl; ControlSide: TAlign): Boolean;
1530    function Dragging: Boolean;
1531    // accessibility
1532    function GetAccessibleObject: TLazAccessibleObject;
1533    function CreateAccessibleObject: TLazAccessibleObject; virtual;
1534    function GetSelectedChildAccessibleObject: TLazAccessibleObject; virtual;
1535    function GetChildAccessibleObjectAtPos(APos: TPoint): TLazAccessibleObject; virtual;
1536    //scale support
1537    function ScaleDesignToForm(const ASize: Integer): Integer;
1538    function ScaleFormToDesign(const ASize: Integer): Integer;
1539    function Scale96ToForm(const ASize: Integer): Integer;
1540    function ScaleFormTo96(const ASize: Integer): Integer;
1541    function Scale96ToFont(const ASize: Integer): Integer;
1542    function ScaleFontTo96(const ASize: Integer): Integer;
1543    function ScaleScreenToFont(const ASize: Integer): Integer;
1544    function ScaleFontToScreen(const ASize: Integer): Integer;
1545    function Scale96ToScreen(const ASize: Integer): Integer;
1546    function ScaleScreenTo96(const ASize: Integer): Integer;
1547  public
1548    // size
1549    procedure AdjustSize; virtual;// smart calling DoAutoSize
1550    function AutoSizePhases: TControlAutoSizePhases; virtual;
1551    function AutoSizeDelayed: boolean; virtual;
1552    function AutoSizeDelayedReport: string; virtual;
1553    function AutoSizeDelayedHandle: Boolean; virtual;
1554    procedure AnchorToNeighbour(Side: TAnchorKind; Space: TSpacingSize;
1555                                Sibling: TControl);
1556    procedure AnchorParallel(Side: TAnchorKind; Space: TSpacingSize;
1557                             Sibling: TControl);
1558    procedure AnchorHorizontalCenterTo(Sibling: TControl);
1559    procedure AnchorVerticalCenterTo(Sibling: TControl);
1560    procedure AnchorToCompanion(Side: TAnchorKind; Space: TSpacingSize;
1561                                Sibling: TControl;
1562                                FreeCompositeSide: boolean = true);
1563    procedure AnchorSame(Side: TAnchorKind; Sibling: TControl);
1564    procedure AnchorAsAlign(TheAlign: TAlign; Space: TSpacingSize);
1565    procedure AnchorClient(Space: TSpacingSize);
1566    function AnchoredControlCount: integer;
1567    property AnchoredControls[Index: integer]: TControl read GetAnchoredControls;
1568    procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;
1569    procedure SetInitialBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;
1570    procedure SetBoundsKeepBase(aLeft, aTop, aWidth, aHeight: integer
1571            ); virtual; // if you use this, disable the LCL autosizing for this control
1572    procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer;
1573                               Raw: boolean = false;
1574                               WithThemeSpace: boolean = true); virtual;
1575    function GetCanvasScaleFactor: Double;
1576    function GetDefaultWidth: integer;
1577    function GetDefaultHeight: integer;
1578    function GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; virtual;
1579    // These two are helper routines to help obtain the background color of a control
1580    function GetColorResolvingParent: TColor;
1581    function GetRGBColorResolvingParent: TColor;
1582    //
1583    function GetSidePosition(Side: TAnchorKind): integer;
1584    procedure CNPreferredSizeChanged;
1585    procedure InvalidatePreferredSize; virtual;
1586    function GetAnchorsDependingOnParent(WithNormalAnchors: Boolean): TAnchors;
1587    procedure DisableAutoSizing{$IFDEF DebugDisableAutoSizing}(const Reason: string){$ENDIF};
1588    procedure EnableAutoSizing{$IFDEF DebugDisableAutoSizing}(const Reason: string){$ENDIF};
1589    {$IFDEF DebugDisableAutoSizing}
1590    procedure WriteAutoSizeReasons(NotIfEmpty: boolean);
1591    {$ENDIF}
1592    procedure UpdateBaseBounds(StoreBounds, StoreParentClientSize,
1593                               UseLoadedValues: boolean); virtual;
1594    property BaseBounds: TRect read FBaseBounds;
1595    property ReadBounds: TRect read FReadBounds;
1596    property BaseParentClientSize: TSize read FBaseParentClientSize;
1597    procedure WriteLayoutDebugReport(const Prefix: string); virtual;
1598  public
1599    // LCL Scaling (High-DPI)
1600    procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
1601      const AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth: Integer); virtual;
1602    procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); virtual;
1603    procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); virtual;
1604    procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); virtual;
1605  public
1606    constructor Create(TheOwner: TComponent);override;
1607    destructor Destroy; override;
1608    procedure BeforeDestruction; override;
1609    procedure EditingDone; virtual;
1610    procedure ExecuteDefaultAction; virtual;
1611    procedure ExecuteCancelAction; virtual;
1612    procedure BeginDrag(Immediate: Boolean; Threshold: Integer = -1);
1613    procedure EndDrag(Drop: Boolean);
1614    procedure BringToFront;
1615    function HasParent: Boolean; override;
1616    function GetParentComponent: TComponent; override;
1617    function IsParentOf(AControl: TControl): boolean; virtual;
1618    function GetTopParent: TControl;
1619    function FindSubComponent(AName: string): TComponent;
1620    function IsVisible: Boolean; virtual;// checks parents too
1621    function IsControlVisible: Boolean; virtual;// does not check parents
1622    function IsEnabled: Boolean; // checks parent too
1623    function IsParentColor: Boolean; // checks protected ParentColor, needed by widgetsets
1624    function IsParentFont: Boolean; // checks protected ParentFont, needed by widgetsets
1625    function FormIsUpdating: boolean; virtual;
1626    function IsProcessingPaintMsg: boolean;
1627    procedure Hide;
1628    procedure Refresh;
1629    procedure Repaint; virtual;
1630    procedure Invalidate; virtual;
1631    function CheckChildClassAllowed(ChildClass: TClass;
1632                                    ExceptionOnInvalid: boolean): boolean;
1633    procedure CheckNewParent(AParent: TWinControl); virtual;
1634    procedure SendToBack;
1635    procedure SetTempCursor(Value: TCursor); virtual;
1636    procedure UpdateRolesForForm; virtual;
1637    procedure ActiveDefaultControlChanged(NewControl: TControl); virtual;
1638    function  GetTextBuf(Buffer: PChar; BufSize: Integer): Integer; virtual;
1639    function  GetTextLen: Integer; virtual;
1640    procedure SetTextBuf(Buffer: PChar); virtual;
1641    function  Perform(Msg: Cardinal; WParam: WParam; LParam: LParam): LRESULT;
1642    function  ScreenToClient(const APoint: TPoint): TPoint; virtual;
1643    function  ClientToScreen(const APoint: TPoint): TPoint; virtual;
1644    function  ScreenToControl(const APoint: TPoint): TPoint;
1645    function  ControlToScreen(const APoint: TPoint): TPoint;
1646    function  ClientToParent(const Point: TPoint; AParent: TWinControl = nil): TPoint;
1647    function  ParentToClient(const Point: TPoint; AParent: TWinControl = nil): TPoint;
1648    function GetChildrenRect(Scrolled: boolean): TRect; virtual;
1649    procedure Show;
1650    procedure Update; virtual;
1651    function HandleObjectShouldBeVisible: boolean; virtual;
1652    function ParentDestroyingHandle: boolean;
1653    function ParentHandlesAllocated: boolean; virtual;
1654    procedure InitiateAction; virtual;
1655    procedure ShowHelp; virtual;
1656    function HasHelp: Boolean;
1657  public
1658    // Event lists
1659    procedure RemoveAllHandlersOfObject(AnObject: TObject); override;
1660    procedure AddHandlerOnResize(const OnResizeEvent: TNotifyEvent;
1661                                 AsFirst: boolean = false);
1662    procedure RemoveHandlerOnResize(const OnResizeEvent: TNotifyEvent);
1663    procedure AddHandlerOnChangeBounds(const OnChangeBoundsEvent: TNotifyEvent;
1664                                       AsFirst: boolean = false);
1665    procedure RemoveHandlerOnChangeBounds(const OnChangeBoundsEvent: TNotifyEvent);
1666    procedure AddHandlerOnVisibleChanging(const OnVisibleChangingEvent: TNotifyEvent;
1667                                          AsFirst: boolean = false);
1668    procedure RemoveHandlerOnVisibleChanging(const OnVisibleChangingEvent: TNotifyEvent);
1669    procedure AddHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent;
1670                                         AsFirst: boolean = false);
1671    procedure RemoveHandlerOnVisibleChanged(const OnVisibleChangedEvent: TNotifyEvent);
1672    procedure AddHandlerOnEnabledChanged(const OnEnabledChangedEvent: TNotifyEvent;
1673                                         AsFirst: boolean = false);
1674    procedure RemoveHandlerOnEnableChanging(const OnEnableChangingEvent: TNotifyEvent);
1675    procedure AddHandlerOnKeyDown(const OnKeyDownEvent: TKeyEvent;
1676                                  AsFirst: boolean = false);
1677    procedure RemoveHandlerOnKeyDown(const OnKeyDownEvent: TKeyEvent);
1678    procedure AddHandlerOnBeforeDestruction(const OnBeforeDestructionEvent: TNotifyEvent;
1679                                  AsFirst: boolean = false);
1680    procedure RemoveHandlerOnBeforeDestruction(const OnBeforeDestructionEvent: TNotifyEvent);
1681    procedure AddHandlerOnMouseWheel(const OnMouseWheelEvent: TMouseWheelEvent;
1682                                  AsFirst: boolean = false);
1683    procedure RemoveHandlerOnMouseWheel(const OnMouseWheelEvent: TMouseWheelEvent);
1684  public
1685    // standard properties, which should be supported by all descendants
1686    property AccessibleDescription: TCaption read GetAccessibleDescription write SetAccessibleDescription;
1687    property AccessibleValue: TCaption read GetAccessibleValue write SetAccessibleValue;
1688    property AccessibleRole: TLazAccessibilityRole read GetAccessibleRole write SetAccessibleRole;
1689    property Action: TBasicAction read GetAction write SetAction;
1690    property Align: TAlign read FAlign write SetAlign default alNone;
1691    property Anchors: TAnchors read FAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop];
1692    property AnchorSide[Kind: TAnchorKind]: TAnchorSide read GetAnchorSide;
1693    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
1694    property BorderSpacing: TControlBorderSpacing read FBorderSpacing write SetBorderSpacing;
1695    property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
1696    property BoundsRectForNewParent: TRect read FBoundsRectForNewParent write SetBoundsRectForNewParent;
1697    property Caption: TCaption read GetText write SetText stored IsCaptionStored;
1698    property CaptureMouseButtons: TCaptureMouseButtons read FCaptureMouseButtons
1699      write FCaptureMouseButtons stored CaptureMouseButtonsIsStored default [mbLeft];
1700    property ClientHeight: Integer read GetClientHeight write SetClientHeight stored  IsClientHeightStored;
1701    property ClientOrigin: TPoint read GetClientOrigin;
1702    property ClientRect: TRect read GetClientRect;
1703    property ClientWidth: Integer read GetClientWidth write SetClientWidth stored IsClientWidthStored;
1704    property Color: TColor read FColor write SetColor stored ColorIsStored default {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif};
1705    property Constraints: TSizeConstraints read FConstraints write SetConstraints;
1706    property ControlOrigin: TPoint read GetControlOrigin;
1707    property ControlState: TControlState read FControlState write FControlState;
1708    property ControlStyle: TControlStyle read FControlStyle write FControlStyle;
1709    property Enabled: Boolean read GetEnabled write SetEnabled stored IsEnabledStored default True;
1710    property Font: TFont read FFont write SetFont stored IsFontStored;
1711    property IsControl: Boolean read FIsControl write FIsControl;
1712    property MouseEntered: Boolean read FMouseInClient; deprecated 'use MouseInClient instead';// changed in 1.9, will be removed in 1.11
1713    property MouseInClient: Boolean read FMouseInClient;
1714    property OnChangeBounds: TNotifyEvent read FOnChangeBounds write FOnChangeBounds;
1715    property OnClick: TNotifyEvent read FOnClick write FOnClick;
1716    property OnResize: TNotifyEvent read FOnResize write FOnResize;
1717    property OnShowHint: TControlShowHintEvent read FOnShowHint write FOnShowHint;
1718    property Parent: TWinControl read FParent write SetParent;
1719    property PopupMenu: TPopupmenu read GetPopupmenu write SetPopupMenu;
1720    property ShowHint: Boolean read FShowHint write SetShowHint stored IsShowHintStored default False;
1721    property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default True;
1722    property WindowProc: TWndMethod read FWindowProc write FWindowProc;
1723  public
1724    // docking properties
1725    property DockOrientation: TDockOrientation read FDockOrientation write FDockOrientation;
1726    property Floating: Boolean read GetFloating;
1727    property FloatingDockSiteClass: TWinControlClass read GetFloatingDockSiteClass write FFloatingDockSiteClass;
1728    property HostDockSite: TWinControl read FHostDockSite write SetHostDockSite;
1729    property LRDockWidth: Integer read GetLRDockWidth write FLRDockWidth;
1730    property TBDockHeight: Integer read GetTBDockHeight write FTBDockHeight;
1731    property UndockHeight: Integer read GetUndockHeight write FUndockHeight;// Height used when undocked
1732    property UndockWidth: Integer read GetUndockWidth write FUndockWidth;// Width used when undocked
1733  public
1734    function UseRightToLeftAlignment: Boolean; virtual;
1735    function UseRightToLeftReading: Boolean; virtual;
1736    function UseRightToLeftScrollBar: Boolean;
1737    function IsRightToLeft: Boolean;
1738    property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored default bdLeftToRight;
1739    property ParentBiDiMode: Boolean read FParentBiDiMode write SetParentBiDiMode default True;
1740  published
1741    property AnchorSideLeft: TAnchorSide index akLeft read GetAnchorSide write SetAnchorSide;
1742    property AnchorSideTop: TAnchorSide index akTop read GetAnchorSide write SetAnchorSide;
1743    property AnchorSideRight: TAnchorSide index akRight read GetAnchorSide write SetAnchorSide;
1744    property AnchorSideBottom: TAnchorSide index akBottom read GetAnchorSide write SetAnchorSide;
1745    property Cursor: TCursor read GetCursor write SetCursor default crDefault;
1746    property Left: Integer read FLeft write SetLeft; // no default value - controls usually placed to different positions
1747    property Height: Integer read FHeight write SetHeight; // no default value - controls usually have different sizes
1748    property Hint: TTranslateString read FHint write SetHint stored IsHintStored;
1749    property Top: Integer read FTop write SetTop; // no default value - controls usually placed to different positions
1750    property Width: Integer read FWidth write SetWidth; // no default value - controls usually have different sizes
1751    property HelpType: THelpType read FHelpType write FHelpType default htContext;
1752    property HelpKeyword: String read FHelpKeyword write SetHelpKeyword stored IsHelpKeyWordStored;
1753    property HelpContext: THelpContext read FHelpContext write SetHelpContext stored IsHelpContextStored default 0;
1754  end;
1755
1756
1757  TBorderWidth = 0..MaxInt;
1758
1759  TGetChildProc = procedure(Child: TComponent) of Object;
1760
1761  { TControlChildSizing }
1762
1763  { LeftRightSpacing, TopBottomSpacing: integer;
1764        minimum space between left client border and left most children.
1765        For example: ClientLeftRight=5 means children Left position is at least 5.
1766
1767    HorizontalSpacing, VerticalSpacing: integer;
1768        minimum space between each child horizontally
1769  }
1770
1771  {   Defines how child controls are resized/aligned.
1772
1773      crsAnchorAligning
1774        Anchors and Align work like Delphi. For example if Anchors property of
1775        the control is [akLeft], it means fixed distance between left border of
1776        parent's client area. [akRight] means fixed distance between right
1777        border of the control and the right border of the parent's client area.
1778        When the parent is resized the child is moved to keep the distance.
1779        [akLeft,akRight] means fixed distance to left border and fixed distance
1780        to right border. When the parent is resized, the controls width is
1781        changed (resized) to keep the left and right distance.
1782        Same for akTop,akBottom.
1783
1784        Align=alLeft for a control means set Left leftmost, Top topmost and
1785        maximize Height. The width is kept, if akRight is not set. If akRight
1786        is set in the Anchors property, then the right distance is kept and
1787        the control's width is resized.
1788        If there several controls with Align=alLeft, they will not overlapp and
1789        be put side by side.
1790        Same for alRight, alTop, alBottom. (Always expand 3 sides).
1791
1792        Align=alClient. The control will fill the whole remaining space.
1793        Setting two children to Align=alClient does only make sense, if you set
1794        maximum Constraints.
1795
1796        Order: First all alTop children are resized, then alBottom, then alLeft,
1797        then alRight and finally alClient.
1798
1799      crsScaleChilds
1800        Scale children, keep space between them fixed.
1801        Children are resized to their normal/adviced size. If there is some space
1802        left in the client area of the parent, then the children are scaled to
1803        fill the space. You can set maximum Constraints. Then the other children
1804        are scaled more.
1805        For example: 3 child controls A, B, C with A.Width=10, B.Width=20 and
1806        C.Width=30 (total=60). If the Parent's client area has a ClientWidth of
1807        120, then the children are scaled with Factor 2.
1808        If B has a maximum constraint width of 30, then first the children will be
1809        scaled with 1.5 (A.Width=15, B.Width=30, C.Width=45). Then A and C
1810        (15+45=60 and 30 pixel space left) will be scaled by 1.5 again, to a
1811        final result of: A.Width=23, B.Width=30, C.Width=67 (23+30+67=120).
1812
1813      crsHomogenousChildResize
1814        Enlarge children equally.
1815        Children are resized to their normal/adviced size. If there is some space
1816        left in the client area of the parent, then the remaining space is
1817        distributed equally to each child.
1818        For example: 3 child controls A, B, C with A.Width=10, B.Width=20 and
1819        C.Width=30 (total=60). If the Parent's client area has a ClientWidth of
1820        120, then 60/3=20 is added to each Child.
1821        If B has a maximum constraint width of 30, then first 10 is added to
1822        all children (A.Width=20, B.Width=30, C.Width=40). Then A and C
1823        (20+40=60 and 30 pixel space left) will get 30/2=15 additional,
1824        resulting in: A.Width=35, B.Width=30, C.Width=55 (35+30+55=120).
1825
1826      crsHomogenousSpaceResize
1827        Enlarge space between children equally.
1828        Children are resized to their normal/adviced size. If there is some space
1829        left in the client area of the parent, then the space between the children
1830        is expanded.
1831        For example: 3 child controls A, B, C with A.Width=10, B.Width=20 and
1832        C.Width=30 (total=60). If the Parent's client area has a ClientWidth of
1833        120, then there will be 60/2=30 space between A and B and between
1834        B and C.
1835
1836      crsSameSize - not implemented yet
1837        Set each child to the same size (maybe one pixel difference).
1838        The client area is divided by the number of controls and each control
1839        gets the same size. The remainder is distributed to the first children.
1840  }
1841
1842  TChildControlResizeStyle = (
1843      crsAnchorAligning, // (like Delphi)
1844      crsScaleChilds, // scale children equally, keep space between children fixed
1845      crsHomogenousChildResize, // enlarge children equally (i.e. by the same amount of pixel)
1846      crsHomogenousSpaceResize // enlarge space between children equally
1847      {$IFDEF EnablecrsSameSize}
1848      ,crsSameSize  // each child gets the same size (maybe one pixel difference)
1849      {$ENDIF}
1850    );
1851
1852  TControlChildrenLayout = (
1853      cclNone,
1854      cclLeftToRightThenTopToBottom, // if BiDiMode <> bdLeftToRight then it becomes RightToLeft
1855      cclTopToBottomThenLeftToRight
1856    );
1857
1858  TControlChildSizing = class(TPersistent)
1859  private
1860    FControl: TWinControl;
1861    FControlsPerLine: integer;
1862    FEnlargeHorizontal: TChildControlResizeStyle;
1863    FEnlargeVertical: TChildControlResizeStyle;
1864    FHorizontalSpacing: integer;
1865    FLayout: TControlChildrenLayout;
1866    FLeftRightSpacing: integer;
1867    FOnChange: TNotifyEvent;
1868    FShrinkHorizontal: TChildControlResizeStyle;
1869    FShrinkVertical: TChildControlResizeStyle;
1870    FTopBottomSpacing: integer;
1871    FVerticalSpacing: integer;
1872    procedure SetControlsPerLine(const AValue: integer);
1873    procedure SetEnlargeHorizontal(const AValue: TChildControlResizeStyle);
1874    procedure SetEnlargeVertical(const AValue: TChildControlResizeStyle);
1875    procedure SetHorizontalSpacing(const AValue: integer);
1876    procedure SetLayout(const AValue: TControlChildrenLayout);
1877    procedure SetLeftRightSpacing(const AValue: integer);
1878    procedure SetShrinkHorizontal(const AValue: TChildControlResizeStyle);
1879    procedure SetShrinkVertical(const AValue: TChildControlResizeStyle);
1880    procedure SetTopBottomSpacing(const AValue: integer);
1881    procedure SetVerticalSpacing(const AValue: integer);
1882  protected
1883    procedure Change; virtual;
1884  public
1885    constructor Create(OwnerControl: TWinControl);
1886    procedure Assign(Source: TPersistent); override;
1887    procedure AssignTo(Dest: TPersistent); override;
1888    function IsEqual(Sizing: TControlChildSizing): boolean;
1889    procedure SetGridSpacing(Spacing: integer);
1890  public
1891    property Control: TWinControl read FControl;
1892    property OnChange: TNotifyEvent read FOnChange write FOnChange;
1893  published
1894    property LeftRightSpacing: integer read FLeftRightSpacing write SetLeftRightSpacing default 0;
1895    property TopBottomSpacing: integer read FTopBottomSpacing write SetTopBottomSpacing default 0;
1896    property HorizontalSpacing: integer read FHorizontalSpacing write SetHorizontalSpacing default 0;
1897    property VerticalSpacing: integer read FVerticalSpacing write SetVerticalSpacing default 0;
1898    property EnlargeHorizontal: TChildControlResizeStyle read FEnlargeHorizontal
1899                           write SetEnlargeHorizontal default crsAnchorAligning;
1900    property EnlargeVertical: TChildControlResizeStyle read FEnlargeVertical
1901                             write SetEnlargeVertical default crsAnchorAligning;
1902    property ShrinkHorizontal: TChildControlResizeStyle read FShrinkHorizontal
1903                            write SetShrinkHorizontal default crsAnchorAligning;
1904    property ShrinkVertical: TChildControlResizeStyle read FShrinkVertical
1905                              write SetShrinkVertical default crsAnchorAligning;
1906    property Layout: TControlChildrenLayout read FLayout write SetLayout default cclNone;
1907    property ControlsPerLine: integer read FControlsPerLine write SetControlsPerLine default 0;
1908  end;
1909
1910
1911  { TWinControlActionLink }
1912
1913  // Since HelpContext and HelpKeyword are properties of TControl,
1914  // this class is obsolete. In order not to break existing code,
1915  // its declaration is aliased to TControlActionLink.
1916  TWinControlActionLink = TControlActionLink;
1917  TWinControlActionLinkClass = class of TWinControlActionLink;
1918
1919
1920  { TWinControl }
1921
1922  TWinControlFlag = (
1923    wcfClientRectNeedsUpdate,
1924    wcfColorChanged,
1925    wcfFontChanged,          // Set if font was changed before handle creation
1926    wcfAllAutoSizing,        // Set inside DoAllAutosize
1927    wcfAligningControls,
1928    wcfEraseBackground,
1929    wcfCreatingHandle,       // Set while constructing the handle of this control
1930    wcfInitializing,         // Set while initializing during handle creation
1931    wcfCreatingChildHandles, // Set while constructing the handles of the children
1932    wcfRealizingBounds,      // Set inside RealizeBoundsRecursive
1933    wcfBoundsRealized,       // bounds were sent to the interface
1934    wcfUpdateShowing,
1935    wcfHandleVisible,
1936    wcfAdjustedLogicalClientRectValid,
1937    wcfKillIntfSetBounds
1938    );
1939  TWinControlFlags = set of TWinControlFlag;
1940
1941  TControlAtPosFlag = (
1942    capfAllowDisabled,   // include controls with Enabled=false
1943    capfAllowWinControls,// include TWinControls
1944    capfOnlyClientAreas, // use the client areas, not the whole child area
1945    capfRecursive,       // search recursively in grand childrens
1946    capfHasScrollOffset, // do not add the scroll offset to Pos (already included)
1947    capfOnlyWinControls  // include only TWinControls (ignore TControls)
1948    );
1949  TControlAtPosFlags = set of TControlAtPosFlag;
1950
1951  // needed for VCL compatibility on custom aligning
1952  TAlignInfo = record
1953    AlignList: TFPList;    // The list of controls currently being aligned
1954    ControlIndex: Integer; // Index of current control
1955    Align: TAlign;         // The kind of alignment currently processed
1956                           // since this info is only used for custom aligning,
1957                           // the value is always alCustom
1958    Scratch: Integer;      // ??? Declared in the VCL, not used and not documented
1959  end;
1960
1961  TAlignInsertBeforeEvent = function (Sender: TWinControl; Control1, Control2: TControl): Boolean of object;
1962  TAlignPositionEvent = procedure (Sender: TWinControl; Control: TControl;
1963                                   var NewLeft, NewTop, NewWidth, NewHeight: Integer;
1964                                   var AlignRect: TRect; AlignInfo: TAlignInfo) of object;
1965
1966  { TWinControlEnumerator }
1967
1968  TWinControlEnumerator = class
1969  protected
1970    FIndex: integer;
1971    FLowToHigh: boolean;
1972    FParent: TWinControl;
1973    function GetCurrent: TControl;
1974  public
1975    constructor Create(Parent: TWinControl; aLowToHigh: boolean = true);
1976    function GetEnumerator: TWinControlEnumerator;
1977    function MoveNext: Boolean;
1978    property Current: TControl read GetCurrent;
1979  end;
1980
1981  TWinControl = class(TControl)
1982  private
1983    FAlignOrder: TFPList; // list of TControl. Last moved (SetBounds) comes first. Used by AlignControls.
1984    FBorderWidth: TBorderWidth;
1985    FBoundsLockCount: integer;
1986    FBoundsRealized: TRect;
1987    FBorderStyle: TBorderStyle;
1988    FBrush: TBrush;
1989    FAdjustClientRectRealized: TRect;
1990    FAdjustClientRect: TRect; // valid if wcfAdjustClientRectValid
1991    FChildSizing: TControlChildSizing;
1992    FControls: TFPList;    // the child controls
1993    FOnGetDockCaption: TGetDockCaptionEvent;
1994    FDefWndProc: Pointer;
1995    FDockClients: TFPList;
1996    FClientWidth: Integer;
1997    FClientHeight: Integer;
1998    FDockManager: TDockManager;
1999    FFlipped: boolean; // true if flipped - false if native
2000    FOnAlignInsertBefore: TAlignInsertBeforeEvent;
2001    FOnAlignPosition: TAlignPositionEvent;
2002    FOnDockDrop: TDockDropEvent;
2003    FOnDockOver: TDockOverEvent;
2004    FOnGetSiteInfo: TGetSiteInfoEvent;
2005    FOnKeyDown: TKeyEvent;
2006    FOnKeyPress: TKeyPressEvent;
2007    FOnKeyUp: TKeyEvent;
2008    FOnEnter: TNotifyEvent;
2009    FOnExit: TNotifyEvent;
2010    FOnUnDock: TUnDockEvent;
2011    FOnUTF8KeyPress: TUTF8KeyPressEvent;
2012    FParentDoubleBuffered: Boolean;
2013    FParentWindow: HWND;
2014    FRealizeBoundsLockCount: integer;
2015    FHandle: HWND;
2016    FTabOrder: integer;
2017    FTabList: TFPList;
2018    // keep small variables together to save some bytes
2019    FTabStop: Boolean;
2020    FShowing: Boolean;
2021    FDockSite: Boolean;
2022    FUseDockManager: Boolean;
2023    FDesignerDeleting: Boolean;
2024    procedure AlignControl(AControl: TControl);
2025    function DoubleBufferedIsStored: Boolean;
2026    function GetBrush: TBrush;
2027    function GetControl(const Index: Integer): TControl;
2028    function GetControlCount: Integer;
2029    function GetDockClientCount: Integer;
2030    function GetDockClients(Index: Integer): TControl;
2031    function GetHandle: HWND;
2032    function GetIsResizing: boolean;
2033    function GetTabOrder: TTabOrder;
2034    function GetVisibleDockClientCount: Integer;
2035    procedure SetChildSizing(const AValue: TControlChildSizing);
2036    procedure SetDockSite(const NewDockSite: Boolean);
2037    procedure SetDoubleBuffered(Value: Boolean);
2038    procedure SetHandle(NewHandle: HWND);
2039    procedure SetBorderWidth(Value: TBorderWidth);
2040    procedure SetParentDoubleBuffered(Value: Boolean);
2041    procedure SetParentWindow(const AValue: HWND);
2042    procedure SetTabOrder(NewTabOrder: TTabOrder);
2043    procedure SetTabStop(NewTabStop: Boolean);
2044    procedure SetUseDockManager(const AValue: Boolean);
2045    procedure UpdateTabOrder(NewTabOrder: TTabOrder);
2046    procedure Insert(AControl: TControl);
2047    procedure Insert(AControl: TControl; Index: integer);
2048    procedure Remove(AControl: TControl);
2049    procedure AlignNonAlignedControls(ListOfControls: TFPList;
2050                                      var BoundsModified: Boolean);
2051    procedure CreateControlAlignList(TheAlign: TAlign;
2052                                    AlignList: TFPList; StartControl: TControl);
2053    procedure UpdateAlignIndex(aChild: TControl);
2054  protected
2055    FDoubleBuffered: Boolean;
2056    FWinControlFlags: TWinControlFlags;
2057    class procedure WSRegisterClass; override;
2058    procedure AdjustClientRect(var ARect: TRect); virtual;
2059    procedure GetAdjustedLogicalClientRect(out ARect: TRect);
2060    procedure AlignControls(AControl: TControl;
2061                            var RemainingClientRect: TRect); virtual;
2062    function CustomAlignInsertBefore(AControl1, AControl2: TControl): Boolean; virtual;
2063    procedure CustomAlignPosition(AControl: TControl; var ANewLeft, ANewTop, ANewWidth,
2064                                  ANewHeight: Integer; var AlignRect: TRect;
2065                                  AlignInfo: TAlignInfo); virtual;
2066    function DoAlignChildControls(TheAlign: TAlign; AControl: TControl;
2067                     AControlList: TFPList; var ARect: TRect): Boolean; virtual;
2068    procedure DoChildSizingChange(Sender: TObject); virtual;
2069    procedure InvalidatePreferredChildSizes;
2070    function CanTab: Boolean; override;
2071    function IsClientHeightStored: boolean; override;
2072    function IsClientWidthStored: boolean; override;
2073    procedure DoSendShowHideToInterface; virtual; // called by TWinControl.CMShowingChanged
2074    procedure ControlsAligned; virtual;// called by AlignControls after aligning controls
2075    procedure DoSendBoundsToInterface; virtual; // called by RealizeBounds
2076    procedure RealizeBounds; virtual;// checks for changes and calls DoSendBoundsToInterface
2077    procedure RealizeBoundsRecursive; // called by DoAllAutoSize
2078    procedure InvalidateBoundsRealized;
2079    procedure CreateSubClass(var Params: TCreateParams; ControlClassName: PChar);
2080    procedure DoConstraintsChange(Sender: TObject); override;
2081    procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
2082    procedure DoAutoSize; override;
2083    procedure DoAllAutoSize; override;
2084    procedure AllAutoSized; virtual; // called by DoAllAutoSize after all bounds are computed, see TCustomForm.AllAutoSized
2085    procedure CalculatePreferredSize(var PreferredWidth,
2086                                     PreferredHeight: integer;
2087                                     WithThemeSpace: Boolean); override;
2088    procedure GetPreferredSizeClientFrame(out aWidth, aHeight: integer); virtual;
2089    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
2090    function ChildClassAllowed(ChildClass: TClass): boolean; override;
2091    procedure PaintControls(DC: HDC; First: TControl);
2092    procedure PaintHandler(var TheMessage: TLMPaint);
2093    procedure PaintWindow(DC: HDC); virtual;
2094    procedure CreateBrush; virtual;
2095    procedure ScaleControls(Multiplier, Divider: Integer); virtual;
2096    procedure ChangeScale(Multiplier, Divider: Integer); override;
2097  protected
2098    // messages
2099    procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
2100    procedure CMBorderChanged(var Message: TLMessage); message CM_BORDERCHANGED;
2101    procedure CMDoubleBufferedChanged(var Message: TLMessage); message CM_DOUBLEBUFFEREDCHANGED;
2102    procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
2103    procedure CMParentDoubleBufferedChanged(var Message: TLMessage); message CM_PARENTDOUBLEBUFFEREDCHANGED;
2104    procedure CMShowingChanged(var Message: TLMessage); message CM_SHOWINGCHANGED; // called by TWinControl.UpdateShowing
2105    procedure CMShowHintChanged(var Message: TLMessage); message CM_SHOWHINTCHANGED;
2106    procedure CMVisibleChanged(var Message: TLMessage); message CM_VISIBLECHANGED;
2107    procedure CMEnter(var Message: TLMessage); message CM_ENTER;
2108    procedure CMExit(var Message: TLMessage); message CM_EXIT;
2109    procedure WMContextMenu(var Message: TLMContextMenu); message LM_CONTEXTMENU;
2110    procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
2111    procedure WMNotify(var Message: TLMNotify); message LM_NOTIFY;
2112    procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
2113    procedure WMKillFocus(var Message: TLMKillFocus); message LM_KILLFOCUS;
2114    procedure WMShowWindow(var Message: TLMShowWindow); message LM_SHOWWINDOW;
2115    procedure WMEnter(var Message: TLMEnter); message LM_ENTER;
2116    procedure WMExit(var Message: TLMExit); message LM_EXIT;
2117    procedure WMKeyDown(var Message: TLMKeyDown); message LM_KEYDOWN;
2118    procedure WMSysKeyDown(var Message: TLMKeyDown); message LM_SYSKEYDOWN;
2119    procedure WMKeyUp(var Message: TLMKeyUp); message LM_KEYUP;
2120    procedure WMSysKeyUp(var Message: TLMKeyUp); message LM_SYSKEYUP;
2121    procedure WMChar(var Message: TLMChar); message LM_CHAR;
2122    procedure WMSysChar(var Message: TLMKeyUp); message LM_SYSCHAR;
2123    procedure WMPaint(var Msg: TLMPaint); message LM_PAINT;
2124    procedure WMDestroy(var Message: TLMDestroy); message LM_DESTROY;
2125    procedure WMMove(var Message: TLMMove); message LM_MOVE;
2126    procedure WMSize(var Message: TLMSize); message LM_SIZE;
2127    procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED;
2128    procedure CNKeyDown(var Message: TLMKeyDown); message CN_KEYDOWN;
2129    procedure CNSysKeyDown(var Message: TLMKeyDown); message CN_SYSKEYDOWN;
2130    procedure CNKeyUp(var Message: TLMKeyUp); message CN_KEYUP;
2131    procedure CNSysKeyUp(var Message: TLMKeyUp); message CN_SYSKEYUP;
2132    procedure CNChar(var Message: TLMKeyUp); message CN_CHAR;
2133  protected
2134    // drag and drop/dock
2135    function DoDragMsg(ADragMessage: TDragMessage; APosition: TPoint;
2136                       ADragObject: TDragObject; ATarget:
2137                       TControl; ADocking: Boolean): LRESULT; override;
2138    function DoDockClientMsg(DragDockObject: TDragDockObject; aPosition: TPoint): boolean; virtual;
2139    function DoUndockClientMsg(NewTarget, Client: TControl):boolean; virtual;
2140    procedure DoAddDockClient(Client: TControl; const ARect: TRect); virtual;
2141    procedure DockOver(Source: TDragDockObject; X, Y: Integer;
2142                       State: TDragState; var Accept: Boolean); virtual;
2143    procedure DoDockOver(Source: TDragDockObject; X, Y: Integer;
2144                         State: TDragState; var Accept: Boolean); virtual;
2145    procedure DoRemoveDockClient(Client: TControl); virtual;
2146    function  DoUnDock(NewTarget: TWinControl; Client: TControl;
2147                       KeepDockSiteSize: Boolean = true): Boolean; virtual;
2148    procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
2149                          MousePos: TPoint; var CanDock: Boolean); virtual;
2150    function GetParentHandle: HWND;
2151    function GetTopParentHandle: HWND;
2152    procedure ReloadDockedControl(const AControlName: string;
2153                                  var AControl: TControl); virtual;
2154    function CreateDockManager: TDockManager; virtual;
2155    procedure SetDockManager(AMgr: TDockManager);
2156    procedure DoFloatMsg(ADockSource: TDragDockObject); override;//CM_FLOAT
2157    procedure DoGetDockCaption(AControl: TControl; var ACaption: String); virtual;
2158  protected
2159    // mouse and keyboard
2160    procedure DoEnter; virtual;
2161    procedure DoExit; virtual;
2162    function  DoKeyDownBeforeInterface(var Message: TLMKey; IsRecurseCall: Boolean): Boolean;
2163    function  DoRemainingKeyDown(var Message: TLMKeyDown): Boolean;
2164    function  DoRemainingKeyUp(var Message: TLMKeyDown): Boolean;
2165    function  DoKeyPress(var Message: TLMKey): Boolean;
2166    function  DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean; virtual;
2167    function  DoKeyUpBeforeInterface(var Message: TLMKey): Boolean;
2168    function  ChildKey(var Message: TLMKey): boolean; virtual;
2169    function  SendDialogChar(var Message: TLMKey): Boolean;
2170    function  DialogChar(var Message: TLMKey): boolean; override;
2171    procedure ControlKeyDown(var Key: Word; Shift: TShiftState); virtual;
2172    procedure ControlKeyUp(var Key: Word; Shift: TShiftState); virtual;
2173    procedure KeyDown(var Key: Word; Shift: TShiftState); virtual;
2174    procedure KeyDownBeforeInterface(var Key: Word; Shift: TShiftState); virtual;
2175    procedure KeyDownAfterInterface(var Key: Word; Shift: TShiftState); virtual;
2176    procedure KeyPress(var Key: char); virtual;
2177    procedure KeyUp(var Key: Word; Shift: TShiftState); virtual;
2178    procedure KeyUpBeforeInterface(var Key: Word; Shift: TShiftState); virtual;
2179    procedure KeyUpAfterInterface(var Key: Word; Shift: TShiftState); virtual;
2180    procedure UTF8KeyPress(var UTF8Key: TUTF8Char); virtual;
2181  protected
2182    function  FindNextControl(CurrentControl: TWinControl; GoForward,
2183                              CheckTabStop, CheckParent: Boolean): TWinControl;
2184    procedure SelectFirst;
2185    function  RealGetText: TCaption; override;
2186    function  GetBorderStyle: TBorderStyle;
2187    function  GetClientOrigin: TPoint; override;
2188    function  GetClientRect: TRect; override;
2189    function  GetControlOrigin: TPoint; override;
2190    function  GetDeviceContext(var WindowHandle: HWND): HDC; override;
2191    function GetParentBackground: Boolean;
2192    function  IsControlMouseMsg(var TheMessage): Boolean;
2193    procedure CreateHandle; virtual;
2194    procedure CreateParams(var Params: TCreateParams); virtual;
2195    procedure CreateWnd; virtual; //creates the window
2196    procedure DestroyHandle; virtual;
2197    procedure DestroyWnd; virtual;
2198    procedure DoFlipChildren; virtual;
2199    procedure FinalizeWnd; virtual; // gets called before the Handle is destroyed.
2200    procedure FixupTabList;
2201    procedure FontChanged(Sender: TObject); override;
2202    procedure InitializeWnd; virtual; // gets called after the Handle is created and before the missing child handles are created
2203    procedure Loaded; override;
2204    procedure FormEndUpdated; override;
2205    procedure MainWndProc(var Msg: TLMessage);
2206    procedure ParentFormHandleInitialized; override;
2207    procedure ChildHandlesCreated; virtual;// called after children handles are created
2208    function GetMouseCapture: Boolean; override;
2209    procedure RealSetText(const AValue: TCaption); override;
2210    procedure RemoveFocus(Removing: Boolean);
2211    procedure SendMoveSizeMessages(SizeChanged, PosChanged: boolean); override;
2212    procedure SetBorderStyle(NewStyle: TBorderStyle); virtual;
2213    procedure SetColor(Value: TColor); override;
2214    procedure SetChildZPosition(const AChild: TControl; const APosition: Integer);
2215    procedure SetParentBackground(const AParentBackground: Boolean); virtual;
2216    procedure ShowControl(AControl: TControl); virtual;
2217    procedure UpdateControlState;
2218    procedure UpdateShowing; virtual; // checks control's handle visibility, called by DoAllAutoSize and UpdateControlState
2219    procedure WndProc(var Message: TLMessage); override;
2220    procedure WSSetText(const AText: String); virtual;
2221  protected
2222    property WindowHandle: HWND read FHandle write FHandle;
2223    // properties which are not supported by all descendents
2224    property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone;
2225    property OnGetSiteInfo: TGetSiteInfoEvent read FOnGetSiteInfo write FOnGetSiteInfo;
2226    property OnGetDockCaption: TGetDockCaptionEvent read FOnGetDockCaption write FOnGetDockCaption;
2227    property ParentBackground: Boolean read GetParentBackground write SetParentBackground;
2228  public
2229    // properties which are supported by all descendents
2230    property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0;
2231    property BoundsLockCount: integer read FBoundsLockCount;
2232    property Brush: TBrush read GetBrush;
2233    property CachedClientHeight: integer read FClientHeight;
2234    property CachedClientWidth: integer read FClientWidth;
2235    property ChildSizing: TControlChildSizing read FChildSizing write SetChildSizing;
2236    property ControlCount: Integer read GetControlCount;
2237    property Controls[Index: Integer]: TControl read GetControl;
2238    property DefWndProc: Pointer read FDefWndProc write FDefWndPRoc;
2239    property DockClientCount: Integer read GetDockClientCount;
2240    property DockClients[Index: Integer]: TControl read GetDockClients;
2241    property DockManager: TDockManager read FDockManager write SetDockManager;
2242    property DockSite: Boolean read FDockSite write SetDockSite default False;
2243    property DoubleBuffered: Boolean read FDoubleBuffered write SetDoubleBuffered stored DoubleBufferedIsStored;
2244    property Handle: HWND read GetHandle write SetHandle;
2245    property IsFlipped: Boolean read FFlipped;
2246    property IsResizing: Boolean read GetIsResizing;
2247    property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1;
2248    property TabStop: Boolean read FTabStop write SetTabStop default false;
2249    property OnAlignInsertBefore: TAlignInsertBeforeEvent read FOnAlignInsertBefore write FOnAlignInsertBefore;
2250    property OnAlignPosition: TAlignPositionEvent read FOnAlignPosition write FOnAlignPosition;
2251    property OnDockDrop: TDockDropEvent read FOnDockDrop write FOnDockDrop;
2252    property OnDockOver: TDockOverEvent read FOnDockOver write FOnDockOver;
2253    property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
2254    property OnExit: TNotifyEvent read FOnExit write FOnExit;
2255    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
2256    property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
2257    property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
2258    property OnUnDock: TUnDockEvent read FOnUnDock write FOnUnDock;
2259    property OnUTF8KeyPress: TUTF8KeyPressEvent read FOnUTF8KeyPress write FOnUTF8KeyPress;
2260    property ParentDoubleBuffered: Boolean read FParentDoubleBuffered write SetParentDoubleBuffered default True;
2261    property ParentWindow: HWND read FParentWindow write SetParentWindow;
2262    property Showing: Boolean read FShowing; // handle visible
2263    property UseDockManager: Boolean read FUseDockManager
2264                                     write SetUseDockManager default False;
2265    property DesignerDeleting: Boolean read FDesignerDeleting write FDesignerDeleting;
2266    property VisibleDockClientCount: Integer read GetVisibleDockClientCount;
2267  public
2268    // size, position, bounds
2269    function AutoSizePhases: TControlAutoSizePhases; override;
2270    function AutoSizeDelayed: boolean; override;
2271    function AutoSizeDelayedReport: string; override;
2272    function AutoSizeDelayedHandle: Boolean; override;
2273    procedure BeginUpdateBounds; // disable SetBounds
2274    procedure EndUpdateBounds;   // enable SetBounds
2275    procedure LockRealizeBounds; // disable sending bounds to widgetset
2276    procedure UnlockRealizeBounds; // enable sending bounds to widgetset, changes will now be sent
2277    function ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean): TControl;
2278    function ControlAtPos(const Pos: TPoint;
2279                          AllowDisabled, AllowWinControls: Boolean): TControl;
2280    function ControlAtPos(const Pos: TPoint; Flags: TControlAtPosFlags): TControl; virtual;
2281    function  ContainsControl(Control: TControl): Boolean;
2282    procedure DoAdjustClientRectChange(const InvalidateRect: Boolean = True);
2283    procedure InvalidateClientRectCache(WithChildControls: boolean);
2284    function ClientRectNeedsInterfaceUpdate: boolean;
2285    procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
2286    function  GetChildrenRect(Scrolled: boolean): TRect; override;
2287    procedure DisableAlign;
2288    procedure EnableAlign;
2289    procedure ReAlign; // realign all children
2290    procedure ScrollBy_WS(DeltaX, DeltaY: Integer);
2291    procedure ScrollBy(DeltaX, DeltaY: Integer); virtual;
2292    procedure WriteLayoutDebugReport(const Prefix: string); override;
2293    procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy; const AFromPPI,
2294      AToPPI, AOldFormWidth, ANewFormWidth: Integer); override;
2295  public
2296    constructor Create(TheOwner: TComponent);override;
2297    constructor CreateParented(AParentWindow: HWND);
2298    class function CreateParentedControl(AParentWindow: HWND): TWinControl;
2299    destructor Destroy; override;
2300    procedure DockDrop(DragDockObject: TDragDockObject; X, Y: Integer); virtual;
2301    function CanFocus: Boolean; virtual;
2302    function CanSetFocus: Boolean; virtual;
2303    function GetControlIndex(AControl: TControl): integer;
2304    procedure SetControlIndex(AControl: TControl; NewIndex: integer);
2305    function Focused: Boolean; virtual;
2306    function PerformTab(ForwardTab: boolean): boolean; virtual;
2307    function FindChildControl(const ControlName: String): TControl;
2308    procedure SelectNext(CurControl: TWinControl;
2309                         GoForward, CheckTabStop: Boolean);
2310    procedure SetTempCursor(Value: TCursor); override;
2311    procedure BroadCast(var ToAllMessage);
2312    procedure NotifyControls(Msg: Word);
2313    procedure DefaultHandler(var AMessage); override;
2314    function  GetTextLen: Integer; override;
2315    procedure Invalidate; override;
2316    procedure AddControl; virtual; // tell widgetset
2317
2318    procedure InsertControl(AControl: TControl);
2319    procedure InsertControl(AControl: TControl; Index: integer); virtual;
2320    procedure RemoveControl(AControl: TControl); virtual;
2321    // enumerators
2322    function GetEnumeratorControls: TWinControlEnumerator;
2323    function GetEnumeratorControlsReverse: TWinControlEnumerator;
2324
2325    procedure Repaint; override;
2326    procedure Update; override;
2327    procedure SetFocus; virtual;
2328    procedure FlipChildren(AllLevels: Boolean); virtual;
2329    procedure ScaleBy(Multiplier, Divider: Integer);
2330    function GetDockCaption(AControl: TControl): String; virtual;
2331    procedure UpdateDockCaption(Exclude: TControl = nil); virtual;
2332    procedure GetTabOrderList(List: TFPList); virtual;
2333    function HandleAllocated: Boolean;
2334    function ParentHandlesAllocated: boolean; override;
2335    procedure HandleNeeded;
2336    function BrushCreated: Boolean;
2337    procedure EraseBackground(DC: HDC); virtual;
2338    function IntfUTF8KeyPress(var UTF8Key: TUTF8Char;
2339                              RepeatCount: integer; SystemKey: boolean): boolean; virtual;
2340    function IntfGetDropFilesTarget: TWinControl; virtual;
2341    procedure PaintTo(DC: HDC; X, Y: Integer); virtual; overload;
2342    procedure PaintTo(ACanvas: TCanvas; X, Y: Integer); overload;
2343    procedure SetShape(AShape: TBitmap); overload;
2344    procedure SetShape(AShape: TRegion); overload;
2345  end;
2346
2347
2348  { TGraphicControl }
2349
2350  TGraphicControl = class(TControl)
2351  private
2352    FCanvas: TCanvas;
2353    FOnPaint: TNotifyEvent;
2354    procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
2355  protected
2356    class procedure WSRegisterClass; override;
2357    procedure FontChanged(Sender: TObject); override;
2358    procedure Paint; virtual;
2359    procedure DoOnChangeBounds; override;
2360    procedure DoOnParentHandleDestruction; override;
2361    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
2362    procedure CMCursorChanged(var Message: TLMessage); message CM_CURSORCHANGED;
2363  public
2364    constructor Create(AOwner: TComponent); override;
2365    destructor Destroy; override;
2366    property Canvas: TCanvas read FCanvas;
2367  end;
2368
2369
2370  { TCustomControl }
2371
2372  TCustomControl = class(TWinControl)
2373  private
2374    FCanvas: TCanvas;
2375    FOnPaint: TNotifyEvent;
2376  protected
2377    class procedure WSRegisterClass; override;
2378    procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
2379    procedure DestroyWnd; override;
2380    procedure PaintWindow(DC: HDC); override;
2381    procedure FontChanged(Sender: TObject); override;
2382    procedure SetColor(Value: TColor); override;
2383    procedure Paint; virtual;
2384  public
2385    constructor Create(AOwner: TComponent); override;
2386    destructor Destroy; override;
2387  public
2388    property Canvas: TCanvas read FCanvas write FCanvas;
2389    property BorderStyle;
2390    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
2391  end;
2392
2393
2394  { TImageList }
2395
2396  TImageList = class(TDragImageList)
2397  published
2398    property AllocBy;
2399    property BlendColor;
2400    property BkColor;
2401    property DrawingStyle;
2402    property Height;
2403    property ImageType;
2404    property Masked;
2405    property Scaled;
2406    property ShareImages;
2407    property Width;
2408    property OnChange;
2409    property OnGetWidthForPPI;
2410  end;
2411
2412
2413  { TControlPropertyStorage - abstract base class }
2414
2415  TControlPropertyStorage = class(TCustomPropertyStorage)
2416  protected
2417    procedure GetPropertyList(List: TStrings); override;
2418  end;
2419
2420
2421  { TDockZone }
2422
2423  TDockTree = class;
2424
2425  { TDockZone is a node in the TDockTree and encapsulates a region into which
2426    other zones or a single control are contained. }
2427
2428  TDockZone = class
2429  private
2430    FChildControl: TControl;
2431    FChildCount: integer;
2432    FFirstChildZone: TDockZone;
2433    FTree: TDockTree;
2434    FParentZone: TDockZone;
2435    FOrientation: TDockOrientation;
2436    FNextSibling: TDockZone;
2437    FPrevSibling: TDockZone;
2438    FBounds: TRect;
2439  protected
2440    function GetHeight: Integer; virtual;
2441    function GetLeft: Integer; virtual;
2442    function GetLimitBegin: Integer; virtual;
2443    function GetLimitSize: Integer; virtual;
2444    function GetTop: Integer; virtual;
2445    function GetVisible: Boolean; virtual;
2446    function GetVisibleChildCount: Integer; virtual;
2447    function GetWidth: Integer; virtual;
2448    procedure SetLimitBegin(const AValue: Integer); virtual;
2449    procedure SetLimitSize(const AValue: Integer); virtual;
2450    procedure SetHeight(const AValue: Integer); virtual;
2451    procedure SetLeft(const AValue: Integer); virtual;
2452    procedure SetTop(const AValue: Integer); virtual;
2453    procedure SetWidth(const AValue: Integer); virtual;
2454  public
2455    constructor Create(TheTree: TDockTree; TheChildControl: TControl);
2456    function FindZone(AControl: TControl): TDockZone;
2457    function FirstVisibleChild: TDockZone;
2458    function GetNextVisibleZone: TDockZone;
2459    function NextVisible: TDockZone;
2460    function PrevVisible: TDockZone;
2461    procedure AddSibling(NewZone: TDockZone; InsertAt: TAlign);
2462    procedure AddAsFirstChild(NewChildZone: TDockZone);
2463    procedure AddAsLastChild(NewChildZone: TDockZone);
2464    procedure ReplaceChild(OldChild, NewChild: TDockZone);
2465    function GetLastChild: TDockZone;
2466    function GetIndex: Integer;
2467    procedure Remove(ChildZone: TDockZone);
2468  public
2469    property ChildControl: TControl read FChildControl;
2470    property ChildCount: Integer read FChildCount;
2471    property FirstChild: TDockZone read FFirstChildZone;
2472    property Height: Integer read GetHeight write SetHeight;
2473    property Left: Integer read GetLeft write SetLeft;
2474    property LimitBegin: Integer read GetLimitBegin write SetLimitBegin; // returns Left or Top
2475    property LimitSize: Integer read GetLimitSize write SetLimitSize;    // returns Width or Height
2476    property Orientation: TDockOrientation read FOrientation write FOrientation;
2477    property Parent: TDockZone read FParentZone;
2478    property Top: Integer read GetTop write SetTop;
2479    property Tree: TDockTree read FTree;
2480    property Visible: Boolean read GetVisible;
2481    property VisibleChildCount: Integer read GetVisibleChildCount;
2482    property Width: Integer read GetWidth write SetWidth;
2483    property NextSibling: TDockZone read FNextSibling;
2484    property PrevSibling: TDockZone read FPrevSibling;
2485  end;
2486  TDockZoneClass = class of TDockZone;
2487
2488
2489  { TDockTree - a tree of TDockZones - Every docked window has one tree
2490
2491    This is an abstract class.
2492    A real implementation can be found for example in ldocktree.pas.
2493
2494    Docking means here: Combining several windows to one. A window can here be
2495    a TCustomForm or a floating control (undocked) or a TDockForm.
2496    A window can be docked to another to the left, right, top, bottom or "into".
2497    The docking source window will be resized, to fit to the docking target
2498    window.
2499
2500    Example1: Docking "A" (source window) left to "B" (target window)
2501
2502       +---+    +----+
2503       | A | -> | B  |
2504       +---+    |    |
2505                +----+
2506      Result: A new docktree will be created. Height of "A" will be resized to
2507              the height of "B".
2508              A splitter will be inserted between "A" and "B".
2509              And all three are children of the newly created TLazDockForm of the
2510              newly created TDockTree.
2511
2512       +------------+
2513       |+---+|+----+|
2514       || A ||| B  ||
2515       ||   |||    ||
2516       |+---+|+----+|
2517       +------------+
2518
2519      If "A" or "B" were floating controls, the floating dock sites are freed.
2520      If "A" or "B" were forms, their decorations (title bars and borders) are
2521      replaced by docked decorations.
2522      If "A" had a TDockTree, it is freed and its child dockzones are merged to
2523      the docktree of "B". Analog for docking "C" left to "A":
2524
2525       +------------------+
2526       |+---+|+---+|+----+|
2527       || C ||| A ||| B  ||
2528       ||   |||   |||    ||
2529       |+---+|+---+|+----+|
2530       +------------------+
2531
2532
2533
2534    Example2: Docking A into B
2535                +-----+
2536       +---+    |     |
2537       | A | ---+-> B |
2538       +---+    |     |
2539                +-----+
2540
2541      Result: A new docktree will be created. "A" will be resized to the size
2542              of "B". Both will be put into a TLazDockPages control which is the
2543              child of the newly created TDockTree.
2544
2545       +-------+
2546       |[B][A] |
2547       |+-----+|
2548       ||     ||
2549       || A   ||
2550       ||     ||
2551       |+-----+|
2552       +-------+
2553
2554    Every DockZone has siblings and children. Siblings can either be
2555    - horizontally (left to right, splitter),
2556    - vertically (top to bottom, splitter)
2557    - or upon each other (as pages, left to right).
2558
2559
2560    InsertControl - undock control and dock it into the manager. For example
2561                    dock Form1 left to a Form2:
2562                    InsertControl(Form1,alLeft,Form2);
2563                    To dock "into", into a TDockPage, use Align=alNone.
2564    PositionDockRect - calculates where a control would be placed, if it would
2565                       be docked via InsertControl.
2566    RemoveControl - removes a control from the dock manager.
2567
2568    GetControlBounds - TODO for Delphi compatibility
2569    ResetBounds - TODO for Delphi compatibility
2570    SetReplacingControl - TODO for Delphi compatibility
2571    PaintSite - TODO for Delphi compatibility
2572  }
2573
2574  TForEachZoneProc = procedure(Zone: TDockZone) of object;
2575
2576  TDockTreeFlag = (
2577    dtfUpdateAllNeeded
2578    );
2579  TDockTreeFlags = set of TDockTreeFlag;
2580
2581  { TDockTree - see comment above }
2582
2583  TDockTree = class(TDockManager)
2584  private
2585    FBorderWidth: Integer; // width of the border of the preview rectangle
2586    FDockSite: TWinControl;
2587    FDockZoneClass: TDockZoneClass;
2588    FFlags: TDockTreeFlags;
2589    FUpdateCount: Integer;
2590    procedure DeleteZone(Zone: TDockZone);
2591    procedure SetDockSite(const AValue: TWinControl);
2592  protected
2593    FRootZone: TDockZone;
2594    function HitTest(const MousePos: TPoint; var HTFlag: Integer): TControl; virtual;
2595    procedure PaintDockFrame(ACanvas: TCanvas; AControl: TControl;
2596                             const ARect: TRect); virtual;
2597    procedure UpdateAll;
2598    procedure SetDockZoneClass(const AValue: TDockZoneClass);
2599  public
2600    constructor Create(TheDockSite: TWinControl); override;
2601    destructor Destroy; override;
2602    procedure BeginUpdate; override;
2603    procedure EndUpdate; override;
2604    procedure AdjustDockRect(AControl: TControl; var ARect: TRect); virtual;
2605    procedure GetControlBounds(AControl: TControl;
2606                               out ControlBounds: TRect); override;
2607    procedure InsertControl(AControl: TControl; InsertAt: TAlign;
2608                            DropControl: TControl); override;
2609    procedure LoadFromStream(SrcStream: TStream); override;
2610    procedure MessageHandler(Sender: TControl; var Message: TLMessage); override;
2611    procedure PositionDockRect(AClient, DropCtl: TControl; DropAlign: TAlign;
2612                               var DockRect: TRect); override;
2613    procedure RemoveControl(AControl: TControl); override;
2614    procedure SaveToStream(DestStream: TStream); override;
2615    procedure SetReplacingControl(AControl: TControl); override;
2616    procedure ResetBounds(Force: Boolean); override;
2617    procedure PaintSite(DC: HDC); override;
2618    procedure DumpLayout(FileName: String); virtual;
2619  public
2620    property DockZoneClass: TDockZoneClass read FDockZoneClass;
2621    property DockSite: TWinControl read FDockSite write SetDockSite;
2622    property RootZone: TDockZone read FRootZone;
2623  end;
2624
2625var
2626  DockSplitterClass: TControlClass = nil;
2627
2628type
2629  { TMouse }
2630
2631  TMouse = class
2632  private
2633    FWheelScrollLines: Integer;
2634    procedure SetCapture(const Value: HWND);
2635    function GetCapture: HWND;
2636    function GetCursorPos: TPoint;
2637    function GetIsDragging: Boolean;
2638    procedure SetCursorPos(AValue: TPoint);
2639    function GetWheelScrollLines: Integer;
2640    function GetDragImmediate: Boolean;
2641    procedure SetDragImmediate(const AValue: Boolean);
2642    function GetDragThreshold: Integer;
2643    procedure SetDragThreshold(const AValue: Integer);
2644  public
2645    property Capture: HWND read GetCapture write SetCapture;
2646    property CursorPos: TPoint read GetCursorPos write SetCursorPos;
2647    property IsDragging: Boolean read GetIsDragging;
2648    property WheelScrollLines: Integer read GetWheelScrollLines;
2649    property DragImmediate: Boolean read GetDragImmediate write SetDragImmediate;
2650    property DragThreshold: Integer read GetDragThreshold write SetDragThreshold;
2651  end;
2652
2653
2654const
2655  AnchorAlign: array[TAlign] of TAnchors = (
2656    [akLeft, akTop],                   // alNone
2657    [akLeft, akTop, akRight],          // alTop
2658    [akLeft, akRight, akBottom],       // alBottom
2659    [akLeft, akTop, akBottom],         // alLeft
2660    [akRight, akTop, akBottom],        // alRight
2661    [akLeft, akTop, akRight, akBottom],// alClient
2662    [akLeft, akTop]                    // alCustom
2663    );
2664  MainAlignAnchor: array[TAlign] of TAnchorKind = (
2665    akLeft,   // alNone
2666    akTop,    // alTop
2667    akBottom, // alBottom
2668    akLeft,   // alLeft
2669    akRight,  // alRight
2670    akLeft,   // alClient
2671    akLeft    // alCustom
2672    );
2673  OppositeAnchor: array[TAnchorKind] of TAnchorKind = (
2674    akBottom, // akTop,
2675    akRight,  // akLeft,
2676    akLeft,   // akRight,
2677    akTop     // akBottom
2678    );
2679  ClockwiseAnchor: array[TAnchorKind] of TAnchorKind = (
2680    akRight,  // akTop,
2681    akTop,    // akLeft,
2682    akBottom, // akRight,
2683    akLeft    // akBottom
2684    );
2685  DefaultSideForAnchorKind: array[TAnchorKind] of TAnchorSideReference = (
2686    asrBottom, // akTop
2687    asrBottom, // akLeft
2688    asrTop,    // akRight
2689    asrTop     // akBottom
2690    );
2691  AnchorReferenceSide: array[TAnchorKind,TAnchorSideReference] of TAnchorKind =(
2692    // akTop -> asrTop, asrBottom, asrCenter
2693    (akTop,akBottom,akTop),
2694    // akLeft -> asrTop, asrBottom, asrCenter
2695    (akLeft,akRight,akLeft),
2696    // akRight -> asrTop, asrBottom, asrCenter
2697    (akTop,akBottom,akTop),
2698    // akBottom -> asrTop, asrBottom, asrCenter
2699    (akLeft,akRight,akLeft)
2700    );
2701
2702function FindDragTarget(const Position: TPoint; AllowDisabled: Boolean): TControl;
2703function FindControlAtPosition(const Position: TPoint; AllowDisabled: Boolean): TControl;
2704function FindLCLWindow(const ScreenPos: TPoint; AllowDisabled: Boolean = True): TWinControl;
2705function FindControl(Handle: HWND): TWinControl;
2706function FindOwnerControl(Handle: HWND): TWinControl;
2707function FindLCLControl(const ScreenPos: TPoint): TControl;
2708
2709function SendAppMessage(Msg: Cardinal; WParam: WParam; LParam: LParam): Longint;
2710procedure MoveWindowOrg(dc: hdc; X,Y: Integer);
2711
2712// Interface support.
2713procedure RecreateWnd(const AWinControl:TWinControl);
2714
2715
2716// drag and drop
2717var
2718  DefaultDockManagerClass: TDockManagerClass;
2719
2720procedure CancelDrag;
2721procedure SetCaptureControl(AWinControl: TWinControl; const Position: TPoint);
2722procedure SetCaptureControl(Control: TControl);
2723function GetCaptureControl: TControl;
2724
2725var
2726  NewStyleControls: Boolean;
2727  Mouse: TMouse;
2728
2729// mouse cursor
2730function CursorToString(Cursor: TCursor): string;
2731function StringToCursor(const S: string): TCursor;
2732procedure GetCursorValues(Proc: TGetStrProc);
2733function CursorToIdent(Cursor: Longint; var Ident: string): Boolean;
2734function IdentToCursor(const Ident: string; var Cursor: Longint): Boolean;
2735
2736procedure CheckTransparentWindow(var Handle: THandle; var AWinControl: TWinControl);
2737function CheckMouseButtonDownUp(const AWinHandle: THandle; const AWinControl: TWinControl;
2738  var LastMouse: TLastMouseInfo; const AMousePos: TPoint; const AButton: Byte;
2739  const AMouseDown: Boolean): Cardinal;
2740
2741// shiftstate
2742function GetKeyShiftState: TShiftState;
2743
2744procedure AdjustBorderSpace(var RemainingClientRect, CurBorderSpace: TRect;
2745  Left, Top, Right, Bottom: integer);
2746procedure AdjustBorderSpace(var RemainingClientRect, CurBorderSpace: TRect;
2747  const Space: TRect);
2748
2749function IsColorDefault(AControl: TControl): Boolean;
2750
2751function BidiFlipAlignment(Alignment: TAlignment; Flip: Boolean = True): TAlignment;
2752function BidiFlipAnchors(Control: TControl; Flip: Boolean): TAnchors;
2753function BidiFlipRect(const Rect: TRect; const ParentRect: TRect; const Flip: Boolean): TRect;
2754procedure ChangeBiDiModeAlignment(var Alignment: TAlignment);
2755
2756function DbgS(a: TAnchorKind): string; overload;
2757function DbgS(Anchors: TAnchors): string; overload;
2758function DbgS(a: TAlign): string; overload;
2759function DbgS(a: TAnchorKind; Side: TAnchorSideReference): string; overload;
2760function DbgS(p: TControlAutoSizePhase): string; overload;
2761function DbgS(Phases: TControlAutoSizePhases): string; overload;
2762function DbgS(cst: TControlStyleType): string; overload;
2763function DbgS(cs: TControlStyle): string; overload;
2764
2765operator := (AVariant: Variant): TCaption;
2766
2767function CompareLazAccessibleObjectsByDataObject(o1, o2: Pointer): integer;
2768function CompareDataObjectWithLazAccessibleObject(o, ao: Pointer): integer;
2769
2770// register (called by the package initialization in design mode)
2771procedure Register;
2772
2773
2774implementation
2775
2776uses
2777  WSControls, // circle with base widgetset is allowed
2778  WSLCLClasses,
2779  Forms, // the circle can't be broken without breaking Delphi compatibility
2780  Math;  // Math is in RTL and only a few functions are used.
2781
2782var
2783  // The interface knows, which TWinControl has the capture. This stores
2784  // what child control of this TWinControl has actually the capture.
2785  CaptureControl: TControl=nil;
2786
2787operator := (AVariant: Variant): TCaption;
2788begin
2789  Result := String(AVariant);
2790end;
2791
2792procedure AdjustBorderSpace(var RemainingClientRect, CurBorderSpace: TRect;
2793  Left, Top, Right, Bottom: integer);
2794// RemainingClientRect: remaining clientrect without CurBorderSpace
2795// CurBorderSpace: current borderspace around RemainingClientRect
2796// Left, Top, Right, Bottom: apply these borderspaces to CurBorderSpace
2797//
2798// CurBorderSpace will be set to the maximum of CurBorderSpace and Left, Top,
2799// Right, Bottom.
2800// RemainingClientRect will shrink.
2801// RemainingClientRect will not shrink to negative size.
2802var
2803  NewWidth: Integer;
2804  NewHeight: Integer;
2805  NewLeft: Integer;
2806  NewTop: Integer;
2807begin
2808  // set CurBorderSpace to maximum border spacing and adjust RemainingClientRect
2809  if CurBorderSpace.Left<Left then begin
2810    inc(RemainingClientRect.Left,Left-CurBorderSpace.Left);
2811    CurBorderSpace.Left:=Left;
2812  end;
2813  if CurBorderSpace.Right<Right then begin
2814    dec(RemainingClientRect.Right,Right-CurBorderSpace.Right);
2815    CurBorderSpace.Right:=Right;
2816  end;
2817  if CurBorderSpace.Top<Top then begin
2818    inc(RemainingClientRect.Top,Top-CurBorderSpace.Top);
2819    CurBorderSpace.Top:=Top;
2820  end;
2821  if CurBorderSpace.Bottom<Bottom then begin
2822    dec(RemainingClientRect.Bottom,Bottom-CurBorderSpace.Bottom);
2823    CurBorderSpace.Bottom:=Bottom;
2824  end;
2825
2826  // make sure RemainingClientRect has no negative Size
2827  NewWidth:=RemainingClientRect.Right-RemainingClientRect.Left;
2828  if NewWidth<0 then begin
2829    // Width is negative
2830    // set Width to 0 and adjust borderspace. Set Left/Right to center.
2831    // Example: RemainingClientRect.Left=20, RemainingClientRect.Right=10,
2832    //          CurBorderSpace.Left:=17, CurBorderSpace.Right:=18
2833    // Result: RemainingClientRect.Left=RemainingClientRect.Right=15;
2834    //         CurBorderSpace.Left:=17, CurBorderSpace.Right:=18
2835    NewLeft:=(RemainingClientRect.Left+RemainingClientRect.Right) div 2;
2836    dec(CurBorderSpace.Left,RemainingClientRect.Left-NewLeft);
2837    dec(CurBorderSpace.Right,NewLeft-RemainingClientRect.Right);
2838    RemainingClientRect.Left:=NewLeft;
2839    RemainingClientRect.Right:=RemainingClientRect.Left;
2840  end;
2841  NewHeight:=RemainingClientRect.Bottom-RemainingClientRect.Top;
2842  if NewHeight<0 then begin
2843    // Height is negative
2844    NewTop:=(RemainingClientRect.Top+RemainingClientRect.Bottom) div 2;
2845    dec(CurBorderSpace.Top,RemainingClientRect.Top-NewTop);
2846    dec(CurBorderSpace.Bottom,NewTop-RemainingClientRect.Bottom);
2847    RemainingClientRect.Top:=NewTop;
2848    RemainingClientRect.Bottom:=RemainingClientRect.Top;
2849  end;
2850end;
2851
2852procedure AdjustBorderSpace(var RemainingClientRect, CurBorderSpace: TRect;
2853  const Space: TRect);
2854begin
2855  AdjustBorderSpace(RemainingClientRect,CurBorderSpace,Space.Left,Space.Top,
2856                    Space.Right,Space.Bottom);
2857end;
2858
2859function IsColorDefault(AControl: TControl): Boolean;
2860const
2861  NoDefaultValue = Longint($80000000);
2862var
2863  Info: PPropInfo;
2864begin
2865  Result := not AControl.ColorIsStored;
2866  if not Result then
2867  begin
2868    Info := GetPropInfo(AControl, 'Color');
2869    if Info <> nil then
2870      Result := (Info^.Default <> NoDefaultValue) and (Info^.Default = AControl.Color);
2871  end;
2872end;
2873
2874function BidiFlipAlignment(Alignment: TAlignment; Flip: Boolean): TAlignment;
2875const
2876  BidiAlignment: array[Boolean, TAlignment] of TAlignment =
2877  (
2878    ( taLeftJustify, taRightJustify, taCenter ),
2879    ( taRightJustify, taLeftJustify, taCenter )
2880  );
2881begin
2882  Result := BidiAlignment[Flip, Alignment];
2883end;
2884
2885function BidiFlipAnchors(Control: TControl; Flip: Boolean): TAnchors;
2886var
2887  LeftControl,RightControl : TControl;
2888  LeftSide,RightSide: TAnchorSideReference;
2889  NewAnchors: TAnchors;
2890begin
2891  Result := Control.Anchors;
2892  if Flip then
2893  begin
2894    LeftControl := Control.AnchorSide[akLeft].Control;
2895    LeftSide := Control.AnchorSide[akLeft].Side;
2896    if LeftSide = asrTop then LeftSide := asrBottom
2897    else if LeftSide = asrBottom then LeftSide := asrTop;
2898
2899    RightControl := Control.AnchorSide[akRight].Control;
2900    RightSide := Control.AnchorSide[akRight].Side;
2901    if RightSide = asrTop then RightSide := asrBottom
2902    else if RightSide = asrBottom then RightSide := asrTop;
2903
2904    Control.AnchorSide[akLeft].Control := RightControl;
2905    Control.AnchorSide[akLeft].Side := RightSide;
2906    Control.AnchorSide[akRight].Control := LeftControl;
2907    Control.AnchorSide[akRight].Side := LeftSide;
2908
2909    NewAnchors := [];
2910    if (akTop in Result) then NewAnchors := NewAnchors + [akTop];
2911    if (akBottom in Result) then NewAnchors := NewAnchors + [akBottom];
2912    if (akLeft in Result) then NewAnchors := NewAnchors + [akRight];
2913    if (akRight in Result) then NewAnchors := NewAnchors + [akLeft];
2914    Result := NewAnchors;
2915  end;
2916end;
2917
2918function BidiFlipRect(const Rect: TRect; const ParentRect: TRect; const Flip: Boolean): TRect;
2919var
2920  W: Integer;
2921begin
2922  Result := Rect;
2923  if Flip then
2924  begin
2925    W := Result.Right - Result.Left;
2926    Result.Left := ParentRect.Right - (Result.Left - ParentRect.Left) - W;
2927    Result.Right := Result.Left + W;
2928  end;
2929end;
2930
2931procedure ChangeBiDiModeAlignment(var Alignment: TAlignment);
2932begin
2933  case Alignment of
2934    taLeftJustify: Alignment := taRightJustify;
2935    taRightJustify: Alignment := taLeftJustify;
2936  end;
2937end;
2938
2939function DbgS(a: TAnchorKind): string;
2940begin
2941  WriteStr(Result, a);
2942end;
2943
2944function DbgS(Anchors: TAnchors): string;
2945var
2946  a: TAnchorKind;
2947begin
2948  Result:='';
2949  for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
2950    if a in Anchors then begin
2951      if Result<>'' then
2952        Result:=Result+',';
2953      Result:=Result+DbgS(a);
2954    end;
2955  end;
2956  Result:='['+Result+']';
2957end;
2958
2959function DbgS(a: TAlign): string;
2960begin
2961  WriteStr(Result, a);
2962end;
2963
2964function DbgS(a: TAnchorKind; Side: TAnchorSideReference): string;
2965begin
2966  case Side of
2967  asrTop: if a in [akLeft,akRight] then Result:='asrLeft' else Result:='asrTop';
2968  asrBottom: if a in [akLeft,akRight] then Result:='asrRight' else Result:='asrBottom';
2969  asrCenter: Result:='asrCenter';
2970  else Result:='asr???';
2971  end;
2972end;
2973
2974function DbgS(p: TControlAutoSizePhase): string; overload;
2975begin
2976  WriteStr(Result, p);
2977end;
2978
2979function DbgS(Phases: TControlAutoSizePhases): string; overload;
2980var
2981  p: TControlAutoSizePhase;
2982begin
2983  Result:='';
2984  for p:=Low(TControlAutoSizePhase) to High(TControlAutoSizePhase) do begin
2985    if p in Phases then begin
2986      if Result<>'' then
2987        Result:=Result+',';
2988      Result:=Result+DbgS(p);
2989    end;
2990  end;
2991  Result:='['+Result+']';
2992end;
2993
2994function DbgS(cst: TControlStyleType): string;
2995begin
2996  Result:='';
2997  WriteStr(Result,cst);
2998end;
2999
3000function DbgS(cs: TControlStyle): string;
3001var
3002  cst: TControlStyleType;
3003begin
3004  Result:='';
3005  for cst:=low(TControlStyleType) to high(TControlStyleType) do
3006    if cst in cs then begin
3007      if Result<>'' then Result:=Result+',';
3008      Result:=Result+dbgs(cst);
3009    end;
3010  Result:='['+Result+']';
3011end;
3012
3013function GetModalResultStr(ModalResult: TModalResult): ShortString;
3014begin
3015  Result := UITypes.ModalResultStr[ModalResult];
3016end;
3017
3018{------------------------------------------------------------------------------
3019 RecreateWnd
3020 This function was originally member of TWincontrol. From a VCL point of view
3021 that made perfectly sense since the VCL knows when a win32 widget has to be
3022 recreated when properties have changed.
3023 The LCL however doesn't know, the widgetset does. To avoid old VCL behaviour
3024 and to provide a central function to the widgetset, it is moved here.
3025 MWE.
3026------------------------------------------------------------------------------}
3027procedure RecreateWnd(const AWinControl:TWinControl);
3028var
3029  IsFocused: Boolean;
3030begin
3031  if csDestroying in AWinControl.ComponentState then Exit;
3032  if wcfCreatingHandle in AWinControl.FWinControlFlags then exit;
3033
3034  if not AWinControl.HandleAllocated
3035  then begin
3036    // since only the interface (or custom interface dependent controls) should
3037    // call us, the handle is always created
3038    {$IFNDEF DisableChecks}
3039    DebugLN('WARNING: obsolete call to RecreateWnd for %s', [AWinControl.ClassName]);
3040    {$ENDIF}
3041    //DumpStack;
3042  end;
3043
3044  IsFocused := AWinControl.Focused;
3045  AWinControl.DestroyHandle;
3046  AWinControl.UpdateControlState;
3047  if IsFocused and AWinControl.HandleAllocated
3048  then SetFocus(AWinControl.FHandle);
3049end;
3050
3051function CompareLazAccessibleObjectsByDataObject(o1, o2: Pointer): integer;
3052var
3053  AccObj1: TLazAccessibleObject absolute o1;
3054  AccObj2: TLazAccessibleObject absolute o2;
3055begin
3056  Result:=ComparePointers(AccObj1.DataObject,AccObj2.DataObject);
3057end;
3058
3059function CompareDataObjectWithLazAccessibleObject(o, ao: Pointer): integer;
3060var
3061  AccObj: TLazAccessibleObject absolute ao;
3062begin
3063  Result:=ComparePointers(o,AccObj.DataObject);
3064end;
3065
3066procedure Register;
3067begin
3068  RegisterComponents('Common Controls',[TImageList]);
3069  RegisterNoIcon([TCustomControl,TGraphicControl]);
3070end;
3071
3072function SendAppMessage(Msg: Cardinal; WParam: WParam; LParam: LParam): Longint;
3073begin
3074  Result:=LCLProc.SendApplicationMessage(Msg,WParam,LParam);
3075end;
3076
3077procedure MoveWindowOrg(dc: hdc; X, Y: Integer);
3078begin
3079  MoveWindowOrgEx(DC,X,Y);
3080end;
3081
3082procedure CheckTransparentWindow(var Handle: THandle; var AWinControl: TWinControl);
3083var
3084  NewFrm: TCustomForm;
3085  I: Integer;
3086  NewWinControl: TWinControl;
3087  LastFrm, NewFrmControl: TControl;
3088  MousePos: TPoint;
3089  MsgParam: LPARAM;
3090begin
3091  NewWinControl := AWinControl;
3092  MousePos := Mouse.CursorPos;
3093  MsgParam := MakeLParam(Word(MousePos.x), Word(MousePos.y));
3094  I := 0;
3095  while Assigned(NewWinControl)
3096  and (NewWinControl.Perform(LM_NCHITTEST, 0, MsgParam) = HTTRANSPARENT) do
3097  begin
3098    if NewWinControl.Parent=nil then
3099    begin // search underlying forms
3100      LastFrm := NewWinControl;
3101      NewWinControl := nil;
3102      while I < Screen.CustomFormZOrderCount do
3103      begin
3104        NewFrm := Screen.CustomFormsZOrdered[I];
3105        Inc(I);
3106        if (NewFrm<>NewWinControl)
3107        and PtInRect(NewFrm.BoundsRect, MousePos) then
3108        begin
3109          NewFrmControl := NewFrm.ControlAtPos(NewFrm.ScreenToClient(MousePos),
3110            [capfAllowWinControls, capfRecursive, capfOnlyWinControls]);
3111          if (NewFrmControl<>nil) and (NewFrmControl is TWinControl) then
3112            NewWinControl := TWinControl(NewFrmControl)
3113          else
3114            NewWinControl := NewFrm;
3115          Break;
3116        end;
3117      end;
3118    end else // search parent controls. todo (if really needed): search underlying controls within the same parent
3119      NewWinControl := NewWinControl.Parent;
3120  end;
3121
3122  if NewWinControl<>nil then
3123  begin
3124    AWinControl := NewWinControl;
3125    Handle := AWinControl.Handle;
3126  end else
3127  begin
3128    // if no overlayed control was found, eat the message
3129    Handle := 0;
3130    AWinControl := nil;
3131  end;
3132end;
3133
3134function CheckMouseButtonDownUp(const AWinHandle: THandle;
3135  const AWinControl: TWinControl; var LastMouse: TLastMouseInfo;
3136  const AMousePos: TPoint; const AButton: Byte; const AMouseDown: Boolean
3137  ): Cardinal;
3138const
3139  DblClickThreshold = 3;// max Movement between two clicks of a DblClick
3140
3141  // array of clickcount x buttontype
3142  MSGKINDDOWN: array[1..4, 1..4] of Integer =
3143  (
3144    (LM_LBUTTONDOWN, LM_LBUTTONDBLCLK, LM_LBUTTONTRIPLECLK, LM_LBUTTONQUADCLK),
3145    (LM_RBUTTONDOWN, LM_RBUTTONDBLCLK, LM_RBUTTONTRIPLECLK, LM_RBUTTONQUADCLK),
3146    (LM_MBUTTONDOWN, LM_MBUTTONDBLCLK, LM_MBUTTONTRIPLECLK, LM_MBUTTONQUADCLK),
3147    (LM_XBUTTONDOWN, LM_XBUTTONDBLCLK, LM_XBUTTONTRIPLECLK, LM_XBUTTONQUADCLK)
3148  );
3149  MSGKINDUP: array[1..4] of Integer =
3150    (LM_LBUTTONUP, LM_RBUTTONUP, LM_MBUTTONUP, LM_XBUTTONUP);
3151
3152  function LastClickInSameWinControl: boolean;
3153  begin
3154    Result := (LastMouse.WinHandle <> 0) and
3155              (LastMouse.WinHandle = AWinHandle) and
3156              (LastMouse.WinControl = AWinControl);
3157  end;
3158
3159  function LastClickAtSamePosition: boolean;
3160  begin
3161    Result:= (Abs(AMousePos.X-LastMouse.MousePos.X) <= DblClickThreshold) and
3162             (Abs(AMousePos.Y-LastMouse.MousePos.Y) <= DblClickThreshold);
3163  end;
3164
3165  function LastClickInTime: boolean;
3166  begin
3167    Result:=((GetTickCount64 - LastMouse.Time) <= GetDoubleClickTime);
3168  end;
3169
3170  function LastClickSameButton: boolean;
3171  begin
3172    Result:=(AButton=LastMouse.Button);
3173  end;
3174
3175  function TestIfMultiClickDown: boolean;
3176  begin
3177    Result:= LastClickInSameWinControl and
3178             LastClickAtSamePosition and
3179             LastClickInTime and
3180             LastClickSameButton;
3181  end;
3182
3183  function TestIfMultiClickUp: boolean;
3184  begin
3185    Result:= LastClickInSameWinControl and
3186             LastClickAtSamePosition and
3187             LastClickSameButton;
3188  end;
3189
3190var
3191  IsMultiClick: boolean;
3192  TargetControl: TControl;
3193  Button: Byte;
3194begin
3195  Result := LM_NULL;
3196
3197  if AMouseDown then
3198    IsMultiClick := TestIfMultiClickDown
3199  else
3200    IsMultiClick := TestIfMultiClickUp;
3201
3202  if AMouseDown then
3203  begin
3204    inc(LastMouse.ClickCount);
3205
3206    if (LastMouse.ClickCount <= 4) and IsMultiClick then
3207    begin
3208      // multi click
3209    end else
3210    begin
3211      // normal click
3212      LastMouse.ClickCount:=1;
3213    end;
3214
3215    LastMouse.Time := GetTickCount64;
3216    LastMouse.MousePos := AMousePos;
3217    LastMouse.WinControl := AWinControl;
3218    LastMouse.WinHandle := AWinHandle;
3219    LastMouse.Button := AButton;
3220  end else
3221  begin // mouse up
3222    if not IsMultiClick then
3223      LastMouse.ClickCount := 1;
3224  end;
3225
3226  if (AWinControl<>nil) and not(csDesigning in AWinControl.ComponentState) then
3227  begin // runtime - handle multi clicks according to ControlStyle
3228    if LastMouse.ClickCount > 1 then
3229    begin
3230      TargetControl := AWinControl.ControlAtPos(AWinControl.ScreenToClient(AMousePos), []);
3231      if TargetControl=nil then
3232        TargetControl := AWinControl;
3233      case LastMouse.ClickCount of
3234        2: if not(csDoubleClicks in TargetControl.ControlStyle) then LastMouse.ClickCount := 1;
3235        3: if not(csTripleClicks in TargetControl.ControlStyle) then LastMouse.ClickCount := 1;
3236        4: if not(csQuadClicks in TargetControl.ControlStyle) then LastMouse.ClickCount := 1;
3237      end;
3238    end;
3239  end else
3240  begin // design time or special system controls without TWinControl, allow only double clicks
3241    if LastMouse.ClickCount > 2 then
3242      LastMouse.ClickCount := 2;
3243  end;
3244  LastMouse.Down := AMouseDown;
3245
3246  // mouse buttons 4,5 share same messages
3247  if AButton = 5 then
3248    Button := 4
3249  else
3250    Button := AButton;
3251
3252  if AMouseDown then
3253    Result := MSGKINDDOWN[Button][LastMouse.ClickCount]
3254  else
3255    Result := MSGKINDUP[Button];
3256end;
3257
3258function GetKeyShiftState: TShiftState;
3259begin
3260  Result := [];
3261  if GetKeyState(VK_CONTROL) < 0 then
3262    Include(Result, ssCtrl);
3263  if GetKeyState(VK_SHIFT) < 0 then
3264    Include(Result, ssShift);
3265  if GetKeyState(VK_MENU) < 0 then
3266    Include(Result, ssAlt);
3267  if (GetKeyState(VK_LWIN) < 0) or (GetKeyState(VK_RWIN) < 0) then
3268    Include(Result, ssMeta);
3269end;
3270
3271{------------------------------------------------------------------------------
3272  FindControl
3273
3274  Returns the TWinControl associated with the Handle.
3275  This is very interface specific. Better use FindOwnerControl.
3276
3277  Handle can also be a child handle, and does not need to be the Handle
3278  property of the Result.
3279  IMPORTANT: So, in most cases: Result.Handle <> Handle in the params.
3280
3281------------------------------------------------------------------------------}
3282function FindControl(Handle: HWND): TWinControl;
3283begin
3284  if Handle <> 0
3285  then Result := TWinControl(GetProp(Handle,'WinControl'))
3286  else Result := nil;
3287end;
3288
3289{------------------------------------------------------------------------------
3290  FindOwnerControl
3291
3292  Returns the TWinControl owning the Handle. Handle can also be a child handle,
3293  and does not need to be the Handle property of the Result.
3294  IMPORTANT: Therefore, in most cases: parameter Handle <> Result.Handle
3295------------------------------------------------------------------------------}
3296function FindOwnerControl(Handle: HWND): TWinControl;
3297begin
3298  while Handle<>0 do
3299  begin
3300    Result := FindControl(Handle);
3301    if Result <> nil then
3302      Exit;
3303    Handle := GetParent(Handle);
3304  end;
3305  Result := nil;
3306end;
3307
3308{------------------------------------------------------------------------------
3309  FindLCLControl
3310
3311  Returns the TControl that it at the moment at the visible screen position.
3312  This is not reliable during resizing.
3313------------------------------------------------------------------------------}
3314function FindLCLControl(const ScreenPos: TPoint): TControl;
3315var
3316  AWinControl: TWinControl;
3317  ClientPos: TPoint;
3318begin
3319  Result := nil;
3320  // find wincontrol at mouse cursor
3321  AWinControl := FindLCLWindow(ScreenPos);
3322  if AWinControl = nil then Exit;
3323  // find control at mouse cursor
3324  ClientPos := AWinControl.ScreenToClient(ScreenPos);
3325  Result := AWinControl.ControlAtPos(ClientPos,
3326                        [capfAllowDisabled, capfAllowWinControls, capfRecursive]);
3327  if Result = nil then
3328    Result := AWinControl;
3329end;
3330
3331{-------------------------------------------------------------------------------
3332  function DoControlMsg(Handle: HWND; var Message): Boolean;
3333
3334  Find the owner wincontrol and Perform the Message.
3335-------------------------------------------------------------------------------}
3336function DoControlMsg(Handle: HWND; var Message): Boolean;
3337var
3338  AWinControl: TWinControl;
3339begin
3340  Result := false;
3341  AWinControl := FindOwnerControl(Handle);
3342  if AWinControl <> nil then
3343  begin
3344    { do not use Perform, use WndProc so we can save the Result }
3345    Inc(TLMessage(Message).Msg, CN_BASE);
3346    AWinControl.WindowProc(TLMessage(Message));
3347    Dec(TLMessage(Message).Msg, CN_BASE);
3348    Result := true;
3349  end;
3350end;
3351
3352{------------------------------------------------------------------------------
3353  Function: FindLCLWindow
3354  Params:
3355  Returns:
3356
3357 ------------------------------------------------------------------------------}
3358function FindLCLWindow(const ScreenPos: TPoint; AllowDisabled: Boolean = True): TWinControl;
3359var
3360  Handle: HWND;
3361begin
3362  Handle := WindowFromPoint(ScreenPos);
3363  if not AllowDisabled then
3364    // if disabled windows are not allowed then go up and search first enabled window
3365    while IsWindow(Handle) and not IsWindowEnabled(Handle) do
3366      Handle := GetParent(Handle);
3367
3368  if IsWindow(Handle) then
3369    Result := FindOwnerControl(Handle)
3370  else
3371    Result := nil;
3372end;
3373
3374function FindDragTarget(const Position: TPoint; AllowDisabled: Boolean): TControl;
3375begin
3376  Result := FindControlAtPosition(Position, AllowDisabled);
3377end;
3378
3379{------------------------------------------------------------------------------
3380  Function: FindControlAtPosition
3381  Params:
3382  Returns:
3383
3384 ------------------------------------------------------------------------------}
3385function FindControlAtPosition(const Position: TPoint; AllowDisabled: Boolean): TControl;
3386const
3387  DisabledFlag: array[Boolean] of TControlAtPosFlags = ([], [capfAllowDisabled]);
3388var
3389  WinControl: TWinControl;
3390  Control: TControl;
3391begin
3392  Result := nil;
3393  WinControl := FindLCLWindow(Position, AllowDisabled);
3394  if Assigned(WinControl) then
3395  begin
3396    Result := WinControl;
3397    Control := WinControl.ControlAtPos(WinControl.ScreenToClient(Position),
3398                        [capfAllowWinControls, capfRecursive] + DisabledFlag[AllowDisabled]);
3399    //debugln(['FindControlAtPosition ',dbgs(Position),' ',DbgSName(WinControl),' ',dbgs(WinControl.ScreenToClient(Position)),' ',DbgSName(Control)]);
3400    if Assigned(Control) then
3401      Result := Control;
3402  end;
3403end;
3404
3405{------------------------------------------------------------------------------
3406  Function: GetCaptureControl
3407  Params:
3408
3409  Returns the current capturing TControl.
3410  Note: For the interface only a Handle = TWinControl can capture. The LCL
3411  extends this to allow TControl capture the mouse.
3412 ------------------------------------------------------------------------------}
3413function GetCaptureControl: TControl;
3414begin
3415  Result := FindOwnerControl(GetCapture);
3416  if (Result <> nil)
3417  and (CaptureControl <> nil)
3418  and (CaptureControl.Parent = Result)
3419  then Result := CaptureControl;
3420end;
3421
3422procedure CancelDrag;
3423begin
3424  if (DragManager <> nil) and DragManager.IsDragging then
3425    DragManager.DragStop(False);
3426end;
3427
3428procedure SetCaptureControl(AWinControl: TWinControl; const Position: TPoint);
3429var
3430  Control: TControl;
3431begin
3432  Control:=AWinControl;
3433  if (AWinControl<>nil) then begin
3434    Control:=AWinControl.ControlAtPos(Position,
3435                                      [capfAllowWinControls,capfRecursive]);
3436    if Control=nil then
3437      Control:=AWinControl;
3438  end;
3439  SetCaptureControl(Control);
3440end;
3441
3442procedure SetCaptureControl(Control: TControl);
3443var
3444  // OldCaptureWinControl: TWinControl;
3445  NewCaptureWinControl: TWinControl;
3446begin
3447  //DebugLn('SetCaptureControl Old=',DbgSName(CaptureControl),' New=',DbgSName(Control));
3448  if (CaptureControl=Control) then exit;
3449
3450  if Control = nil then
3451  begin
3452    {$IFDEF VerboseMouseCapture}
3453    DebugLn('SetCaptureControl Only ReleaseCapture');
3454    {$ENDIF}
3455    // just unset the capturing, intf call not needed
3456    CaptureControl := nil;
3457    ReleaseCapture;
3458    Exit;
3459  end;
3460
3461  // OldCaptureWinControl := FindOwnerControl(GetCapture);
3462  if Control is TWinControl then
3463    NewCaptureWinControl := TWinControl(Control)
3464  else
3465    NewCaptureWinControl := Control.Parent;
3466
3467  if NewCaptureWinControl = nil then
3468  begin
3469    {$IFDEF VerboseMouseCapture}
3470    DebugLN('SetCaptureControl Only ReleaseCapture');
3471    {$ENDIF}
3472    // just unset the capturing, intf call not needed
3473    CaptureControl:=nil;
3474    ReleaseCapture;
3475    Exit;
3476  end;
3477
3478  // Paul: don't uncomment. Intf call is needed since some widgetsets can install
3479  // capture themselves and release capture. Thus we can be in situation when we
3480  // get widgetset installed capture and don't install our own, later widgetset
3481  // releases its own capture and we have no capture. Such behavior was registered
3482  // on windows and it cased a bug #13615
3483
3484// if NewCaptureWinControl = OldCaptureWinControl then
3485// begin
3486//  {$IFDEF VerboseMouseCapture}
3487//    DebugLN('SetCaptureControl Keep WinControl ',DbgSName(NewCaptureWinControl),
3488//    ' switch Control ',DbgSName(Control));
3489//  {$ENDIF}
3490//   CaptureControl := Control;
3491//   Exit;
3492// end;
3493
3494
3495  // switch capture control
3496  {$IFDEF VerboseMouseCapture}
3497  DebugLN('SetCaptureControl Switch to WinControl=',DbgSName(NewCaptureWinControl),
3498    ' and Control=',DbgSName(Control));
3499  {$ENDIF}
3500  CaptureControl := Control;
3501  ReleaseCapture;
3502  SetCapture(TWinControl(NewCaptureWinControl).Handle);
3503end;
3504
3505{ Cursor translation function }
3506
3507const
3508  DeadCursors = 1;
3509
3510const
3511  CursorIdents: array[0..30] of TIdentMapEntry = (
3512    (Value: crDefault;      Name: 'crDefault'),
3513    (Value: crNone;         Name: 'crNone'),
3514    (Value: crArrow;        Name: 'crArrow'),
3515    (Value: crCross;        Name: 'crCross'),
3516    (Value: crIBeam;        Name: 'crIBeam'),
3517    (Value: crSizeNESW;     Name: 'crSizeNESW'),
3518    (Value: crSizeNS;       Name: 'crSizeNS'),
3519    (Value: crSizeNWSE;     Name: 'crSizeNWSE'),
3520    (Value: crSizeWE;       Name: 'crSizeWE'),
3521    (Value: crSizeNW;       Name: 'crSizeNW'),
3522    (Value: crSizeN;        Name: 'crSizeN'),
3523    (Value: crSizeNE;       Name: 'crSizeNE'),
3524    (Value: crSizeW;        Name: 'crSizeW'),
3525    (Value: crSizeE;        Name: 'crSizeE'),
3526    (Value: crSizeSW;       Name: 'crSizeSW'),
3527    (Value: crSizeS;        Name: 'crSizeS'),
3528    (Value: crSizeSE;       Name: 'crSizeSE'),
3529    (Value: crUpArrow;      Name: 'crUpArrow'),
3530    (Value: crHourGlass;    Name: 'crHourGlass'),
3531    (Value: crDrag;         Name: 'crDrag'),
3532    (Value: crNoDrop;       Name: 'crNoDrop'),
3533    (Value: crHSplit;       Name: 'crHSplit'),
3534    (Value: crVSplit;       Name: 'crVSplit'),
3535    (Value: crMultiDrag;    Name: 'crMultiDrag'),
3536    (Value: crSQLWait;      Name: 'crSQLWait'),
3537    (Value: crNo;           Name: 'crNo'),
3538    (Value: crAppStart;     Name: 'crAppStart'),
3539    (Value: crHelp;         Name: 'crHelp'),
3540    (Value: crHandPoint;    Name: 'crHandPoint'),
3541    (Value: crSizeAll;      Name: 'crSizeAll'),
3542
3543    { Dead cursors }
3544    (Value: crSize;         Name: 'crSize'));
3545
3546function CursorToString(Cursor: TCursor): string;
3547begin
3548  Result := '';
3549  if not CursorToIdent(Cursor, Result) then FmtStr(Result, '%d', [Cursor]);
3550end;
3551
3552function StringToCursor(const S: string): TCursor;
3553var
3554  L: Longint;
3555begin
3556  if not IdentToCursor(S, L) then L := StrToInt(S);
3557  Result := TCursor(L);
3558end;
3559
3560procedure GetCursorValues(Proc: TGetStrProc);
3561var
3562  I: Integer;
3563begin
3564  for I := Low(CursorIdents) to High(CursorIdents) - DeadCursors do
3565    Proc(CursorIdents[I].Name);
3566end;
3567
3568function CursorToIdent(Cursor: Longint; var Ident: string): Boolean;
3569begin
3570  Result := IntToIdent(Cursor, Ident, CursorIdents);
3571end;
3572
3573function IdentToCursor(const Ident: string; var Cursor: Longint): Boolean;
3574begin
3575  Result := IdentToInt(Ident, Cursor, CursorIdents);
3576end;
3577
3578// turn off before includes !!
3579{$IFDEF ASSERT_IS_ON}
3580  {$UNDEF ASSERT_IS_ON}
3581  {$C-}
3582{$ENDIF}
3583
3584// helper types and functions
3585{$I dragdock.inc}
3586{$I controlsproc.inc}
3587
3588// components
3589{$I sizeconstraints.inc}
3590{$I dragmanager.inc}
3591{$I controlcanvas.inc}
3592{$I wincontrol.inc}
3593{$I controlactionlink.inc}
3594{$I control.inc}
3595{$I graphiccontrol.inc}
3596{$I customcontrol.inc}
3597{$I dockzone.inc}
3598{$I docktree.inc}
3599{$I mouse.inc}
3600{$I dragobject.inc}
3601{$I dragimagelist.inc}
3602
3603{ TControlBorderSpacing }
3604
3605procedure TControlBorderSpacing.SetAround(const AValue: TSpacingSize);
3606begin
3607  if FAround=AValue then exit;
3608  FAround:=AValue;
3609  Change(false);
3610end;
3611
3612function TControlBorderSpacing.IsAroundStored: boolean;
3613begin
3614  if FDefault = nil
3615  then Result := FAround <> 0
3616  else Result := FAround <> FDefault^.Around;
3617end;
3618
3619function TControlBorderSpacing.IsBottomStored: boolean;
3620begin
3621  if FDefault = nil
3622  then Result := FBottom <> 0
3623  else Result := FBottom <> FDefault^.Bottom;
3624end;
3625
3626function TControlBorderSpacing.IsInnerBorderStored: boolean;
3627begin
3628  if Control <> nil then
3629    Result:=Control.IsBorderSpacingInnerBorderStored
3630  else
3631    Result:=True;
3632end;
3633
3634function TControlBorderSpacing.IsLeftStored: boolean;
3635begin
3636  if FDefault = nil
3637  then Result := FLeft <> 0
3638  else Result := FLeft <> FDefault^.Left;
3639end;
3640
3641function TControlBorderSpacing.IsRightStored: boolean;
3642begin
3643  if FDefault = nil
3644  then Result := FRight <> 0
3645  else Result := FRight <> FDefault^.Right;
3646end;
3647
3648function TControlBorderSpacing.IsTopStored: boolean;
3649begin
3650  if FDefault = nil
3651  then Result := FTop <> 0
3652  else Result := FTop <> FDefault^.Top;
3653end;
3654
3655procedure TControlBorderSpacing.SetBottom(const AValue: TSpacingSize);
3656begin
3657  if FBottom=AValue then exit;
3658  FBottom:=AValue;
3659  Change(false);
3660end;
3661
3662procedure TControlBorderSpacing.SetCellAlignHorizontal(
3663  const AValue: TControlCellAlign);
3664begin
3665  if FCellAlignHorizontal=AValue then exit;
3666  FCellAlignHorizontal:=AValue;
3667  Change(false);
3668end;
3669
3670procedure TControlBorderSpacing.SetCellAlignVertical(
3671  const AValue: TControlCellAlign);
3672begin
3673  if FCellAlignVertical=AValue then exit;
3674  FCellAlignVertical:=AValue;
3675  Change(false);
3676end;
3677
3678procedure TControlBorderSpacing.SetInnerBorder(const AValue: Integer);
3679begin
3680  if FInnerBorder=AValue then exit;
3681  FInnerBorder:=AValue;
3682  if Control<>nil then Control.InvalidatePreferredSize;
3683  Change(true);
3684end;
3685
3686procedure TControlBorderSpacing.SetLeft(const AValue: TSpacingSize);
3687begin
3688  if FLeft=AValue then exit;
3689  FLeft:=AValue;
3690  Change(false);
3691end;
3692
3693procedure TControlBorderSpacing.SetRight(const AValue: TSpacingSize);
3694begin
3695  if FRight=AValue then exit;
3696  FRight:=AValue;
3697  Change(false);
3698end;
3699
3700procedure TControlBorderSpacing.SetSpace(Kind: TAnchorKind;
3701  const AValue: integer);
3702begin
3703  case Kind of
3704  akLeft: Left:=AValue;
3705  akTop: Top:=AValue;
3706  akBottom: Bottom:=AValue;
3707  akRight: Right:=AValue;
3708  end;
3709end;
3710
3711procedure TControlBorderSpacing.SetTop(const AValue: TSpacingSize);
3712begin
3713  if FTop=AValue then exit;
3714  FTop:=AValue;
3715  Change(false);
3716end;
3717
3718constructor TControlBorderSpacing.Create(OwnerControl: TControl; ADefault: PControlBorderSpacingDefault);
3719begin
3720  FControl := OwnerControl;
3721  FDefault := ADefault;
3722  if ADefault <> nil then
3723  begin
3724    FLeft := ADefault^.Left;
3725    FRight := ADefault^.Right;
3726    FTop := ADefault^.Top;
3727    FBottom := ADefault^.Bottom;
3728    FAround := ADefault^.Around;
3729  end;
3730  FCellAlignHorizontal := ccaFill;
3731  FCellAlignVertical := ccaFill;
3732  inherited Create;
3733end;
3734
3735procedure TControlBorderSpacing.Assign(Source: TPersistent);
3736var
3737  SrcSpacing: TControlBorderSpacing;
3738begin
3739  if Source is TControlBorderSpacing then begin
3740    SrcSpacing:=TControlBorderSpacing(Source);
3741    if IsEqual(SrcSpacing) then exit;
3742
3743    FAround:=SrcSpacing.Around;
3744    FBottom:=SrcSpacing.Bottom;
3745    FLeft:=SrcSpacing.Left;
3746    FRight:=SrcSpacing.Right;
3747    FTop:=SrcSpacing.Top;
3748    FInnerBorder:=SrcSpacing.InnerBorder;
3749    FCellAlignHorizontal:=SrcSpacing.CellAlignHorizontal;
3750    FCellAlignVertical:=SrcSpacing.CellAlignVertical;
3751
3752    Change(false);
3753  end else
3754    inherited Assign(Source);
3755end;
3756
3757procedure TControlBorderSpacing.AssignTo(Dest: TPersistent);
3758begin
3759  Dest.Assign(Self);
3760end;
3761
3762procedure TControlBorderSpacing.AutoAdjustLayout(const AXProportion,
3763  AYProportion: Double);
3764
3765  procedure Scale(var Value: Integer; const Proportion: Double; var Changed: Boolean);
3766  begin
3767    if Value<>0 then
3768    begin
3769      Value := Round(Value * Proportion);
3770      Changed := True;
3771    end;
3772  end;
3773var
3774  InnerChanged, OuterChanged: Boolean;
3775begin
3776  InnerChanged := False;
3777  OuterChanged := False;
3778
3779  Scale(FAround, AXProportion, OuterChanged);
3780  Scale(FInnerBorder, AXProportion, InnerChanged);
3781  Scale(FLeft, AXProportion, OuterChanged);
3782  Scale(FTop, AYProportion, OuterChanged);
3783  Scale(FRight, AXProportion, OuterChanged);
3784  Scale(FBottom, AYProportion, OuterChanged);
3785
3786  if OuterChanged or InnerChanged then
3787  begin
3788    if Control<>nil then Control.InvalidatePreferredSize;
3789    Change(InnerChanged);
3790  end;
3791end;
3792
3793function TControlBorderSpacing.IsEqual(Spacing: TControlBorderSpacing
3794  ): boolean;
3795begin
3796  Result:=(FAround=Spacing.Around)
3797      and (FBottom=Spacing.Bottom)
3798      and (FLeft=Spacing.Left)
3799      and (FRight=Spacing.Right)
3800      and (FTop=Spacing.Top);
3801end;
3802
3803procedure TControlBorderSpacing.GetSpaceAround(var SpaceAround: TRect);
3804begin
3805  SpaceAround.Left:=Left+Around;
3806  SpaceAround.Top:=Top+Around;
3807  SpaceAround.Right:=Right+Around;
3808  SpaceAround.Bottom:=Bottom+Around;
3809end;
3810
3811
3812function TControlBorderSpacing.GetSideSpace(Kind: TAnchorKind): Integer;
3813begin
3814  Result:=Around+GetSpace(Kind);
3815end;
3816
3817function TControlBorderSpacing.GetSpace(Kind: TAnchorKind): Integer;
3818begin
3819  case Kind of
3820  akLeft: Result:=Left;
3821  akTop: Result:=Top;
3822  akRight: Result:=Right;
3823  akBottom: Result:=Bottom;
3824  end;
3825end;
3826
3827procedure TControlBorderSpacing.Change(InnerSpaceChanged: Boolean);
3828begin
3829  if FControl <> nil then
3830    FControl.DoBorderSpacingChange(Self,InnerSpaceChanged);
3831  if Assigned(OnChange) then OnChange(Self);
3832end;
3833
3834function TControlBorderSpacing.GetAroundBottom: Integer;
3835begin
3836  Result := Around+Bottom;
3837end;
3838
3839function TControlBorderSpacing.GetAroundLeft: Integer;
3840begin
3841  Result := Around+Left;
3842end;
3843
3844function TControlBorderSpacing.GetAroundRight: Integer;
3845begin
3846  Result := Around+Right;
3847end;
3848
3849function TControlBorderSpacing.GetAroundTop: Integer;
3850begin
3851  Result := Around+Top;
3852end;
3853
3854function TControlBorderSpacing.GetControlBottom: Integer;
3855begin
3856  if FControl<>nil then
3857    Result := FControl.Top+FControl.Height+Around+Bottom
3858  else
3859    Result := 0;
3860end;
3861
3862function TControlBorderSpacing.GetControlHeight: Integer;
3863begin
3864  if FControl<>nil then
3865    Result := FControl.Height+Around*2+Top+Bottom
3866  else
3867    Result := 0;
3868end;
3869
3870function TControlBorderSpacing.GetControlLeft: Integer;
3871begin
3872  if FControl<>nil then
3873    Result := FControl.Left-Around-Left
3874  else
3875    Result := 0;
3876end;
3877
3878function TControlBorderSpacing.GetControlRight: Integer;
3879begin
3880  if FControl<>nil then
3881    Result := FControl.Left+FControl.Width+Around+Right
3882  else
3883    Result := 0;
3884end;
3885
3886function TControlBorderSpacing.GetControlTop: Integer;
3887begin
3888  if FControl<>nil then
3889    Result := FControl.Top-Around-Top
3890  else
3891    Result := 0;
3892end;
3893
3894function TControlBorderSpacing.GetControlWidth: Integer;
3895begin
3896  if FControl<>nil then
3897    Result := FControl.Width+Around*2+Left+Right
3898  else
3899    Result := 0;
3900end;
3901
3902{ TControlChildSizing }
3903
3904procedure TControlChildSizing.SetEnlargeHorizontal(
3905  const AValue: TChildControlResizeStyle);
3906begin
3907  if FEnlargeHorizontal=AValue then exit;
3908  FEnlargeHorizontal:=AValue;
3909  Change;
3910end;
3911
3912procedure TControlChildSizing.SetControlsPerLine(const AValue: integer);
3913begin
3914  if FControlsPerLine=AValue then exit;
3915  FControlsPerLine:=AValue;
3916  Change;
3917end;
3918
3919procedure TControlChildSizing.SetEnlargeVertical(
3920  const AValue: TChildControlResizeStyle);
3921begin
3922  if FEnlargeVertical=AValue then exit;
3923  FEnlargeVertical:=AValue;
3924  Change;
3925end;
3926
3927procedure TControlChildSizing.SetHorizontalSpacing(const AValue: integer);
3928begin
3929  if FHorizontalSpacing=AValue then exit;
3930  FHorizontalSpacing:=AValue;
3931  Change;
3932end;
3933
3934procedure TControlChildSizing.SetLayout(const AValue: TControlChildrenLayout);
3935begin
3936  if FLayout=AValue then exit;
3937  FLayout:=AValue;
3938  //debugln('TControlChildSizing.SetLayout ',DbgSName(Control));
3939  Change;
3940end;
3941
3942procedure TControlChildSizing.SetLeftRightSpacing(const AValue: integer);
3943begin
3944  if FLeftRightSpacing=AValue then exit;
3945  FLeftRightSpacing:=AValue;
3946  Change;
3947end;
3948
3949procedure TControlChildSizing.SetShrinkHorizontal(
3950  const AValue: TChildControlResizeStyle);
3951begin
3952  if FShrinkHorizontal=AValue then exit;
3953  FShrinkHorizontal:=AValue;
3954  Change;
3955end;
3956
3957procedure TControlChildSizing.SetShrinkVertical(
3958  const AValue: TChildControlResizeStyle);
3959begin
3960  if FShrinkVertical=AValue then exit;
3961  FShrinkVertical:=AValue;
3962  Change;
3963end;
3964
3965procedure TControlChildSizing.SetTopBottomSpacing(const AValue: integer);
3966begin
3967  if FTopBottomSpacing=AValue then exit;
3968  FTopBottomSpacing:=AValue;
3969  Change;
3970end;
3971
3972procedure TControlChildSizing.SetVerticalSpacing(const AValue: integer);
3973begin
3974  if FVerticalSpacing=AValue then exit;
3975  FVerticalSpacing:=AValue;
3976  Change;
3977end;
3978
3979constructor TControlChildSizing.Create(OwnerControl: TWinControl);
3980begin
3981  inherited Create;
3982  FControl := OwnerControl;
3983  FLayout := cclNone;
3984  FEnlargeHorizontal :=crsAnchorAligning;
3985  FEnlargeVertical := crsAnchorAligning;
3986  FShrinkHorizontal := crsAnchorAligning;
3987  FShrinkVertical := crsAnchorAligning;
3988end;
3989
3990procedure TControlChildSizing.Assign(Source: TPersistent);
3991var
3992  SrcSizing: TControlChildSizing;
3993begin
3994  if Source is TControlChildSizing then begin
3995    SrcSizing:=TControlChildSizing(Source);
3996    if IsEqual(SrcSizing) then exit;
3997
3998    FEnlargeHorizontal:=SrcSizing.EnlargeHorizontal;
3999    FEnlargeVertical:=SrcSizing.EnlargeVertical;
4000    FShrinkHorizontal:=SrcSizing.ShrinkHorizontal;
4001    FShrinkVertical:=SrcSizing.ShrinkVertical;
4002    FEnlargeHorizontal:=SrcSizing.EnlargeHorizontal;
4003    FEnlargeVertical:=SrcSizing.EnlargeVertical;
4004    FShrinkHorizontal:=SrcSizing.ShrinkHorizontal;
4005    FShrinkVertical:=SrcSizing.ShrinkVertical;
4006    FControlsPerLine:=SrcSizing.ControlsPerLine;
4007    FLayout:=SrcSizing.Layout;
4008    FLeftRightSpacing:=SrcSizing.LeftRightSpacing;
4009    FTopBottomSpacing:=SrcSizing.TopBottomSpacing;
4010    FHorizontalSpacing:=SrcSizing.HorizontalSpacing;
4011    FVerticalSpacing:=SrcSizing.VerticalSpacing;
4012
4013    Change;
4014  end else
4015    inherited Assign(Source);
4016end;
4017
4018procedure TControlChildSizing.AssignTo(Dest: TPersistent);
4019begin
4020  Dest.Assign(Self);
4021end;
4022
4023function TControlChildSizing.IsEqual(Sizing: TControlChildSizing): boolean;
4024begin
4025  Result:=(FEnlargeHorizontal=Sizing.EnlargeHorizontal)
4026      and (FEnlargeVertical=Sizing.EnlargeVertical)
4027      and (FShrinkHorizontal=Sizing.ShrinkHorizontal)
4028      and (FShrinkVertical=Sizing.ShrinkVertical)
4029      and (FEnlargeHorizontal=Sizing.EnlargeHorizontal)
4030      and (FEnlargeVertical=Sizing.EnlargeVertical)
4031      and (FShrinkHorizontal=Sizing.ShrinkHorizontal)
4032      and (FShrinkVertical=Sizing.ShrinkVertical)
4033      and (FControlsPerLine=Sizing.ControlsPerLine)
4034      and (FLayout=Sizing.Layout)
4035      and (FLeftRightSpacing=Sizing.LeftRightSpacing)
4036      and (FTopBottomSpacing=Sizing.TopBottomSpacing)
4037      and (FHorizontalSpacing=Sizing.HorizontalSpacing)
4038      and (FVerticalSpacing=Sizing.VerticalSpacing);
4039end;
4040
4041procedure TControlChildSizing.SetGridSpacing(Spacing: integer);
4042begin
4043  if (LeftRightSpacing=Spacing)
4044  and (TopBottomSpacing=Spacing)
4045  and (HorizontalSpacing=Spacing)
4046  and (VerticalSpacing=Spacing) then exit;
4047  fLeftRightSpacing:=Spacing;
4048  fTopBottomSpacing:=Spacing;
4049  fHorizontalSpacing:=Spacing;
4050  fVerticalSpacing:=Spacing;
4051  Change;
4052end;
4053
4054procedure TControlChildSizing.Change;
4055begin
4056  if Control<>nil then
4057    Control.DoChildSizingChange(Self);
4058  if Assigned(FOnChange) then FOnChange(Self);
4059end;
4060
4061{ TAnchorSide }
4062
4063procedure TAnchorSide.SetControl(const AValue: TControl);
4064
4065  {$IFNDEF DisableChecks}
4066  procedure RaiseOwnerCircle;
4067  begin
4068    DebugLN('RaiseOwnerCircle AValue=',DbgSName(AValue),' FOwner=',DbgSName(FOwner));
4069    raise Exception.Create('TAnchorSide.SetControl AValue=FOwner');
4070  end;
4071  {$ENDIF}
4072
4073var
4074  OldControl: TControl;
4075begin
4076  {$IFNDEF DisableChecks}
4077  if (AValue=FOwner) then RaiseOwnerCircle;
4078  {$ENDIF}
4079  if FControl=AValue then exit;
4080  OldControl:=FControl;
4081  if Side=asrCenter then begin
4082    FixCenterAnchoring;
4083    if Control<>OldControl then exit;
4084  end;
4085  FControl:=nil;
4086  if OldControl<>nil then
4087    OldControl.ForeignAnchorSideChanged(Self,ascoRemove);
4088  FControl:=AValue;
4089  //debugln('TAnchorSide.SetControl A ',DbgSName(FOwner),' FControl=',DbgSName(FControl));
4090  if FControl<>nil then
4091    FControl.ForeignAnchorSideChanged(Self,ascoAdd);
4092  FOwner.AnchorSideChanged(Self);
4093end;
4094
4095function TAnchorSide.IsSideStored: boolean;
4096begin
4097  Result:=(Control<>nil) and (Side<>DefaultSideForAnchorKind[Kind]);
4098end;
4099
4100procedure TAnchorSide.SetSide(const AValue: TAnchorSideReference);
4101var
4102  OldSide: TAnchorSideReference;
4103begin
4104  if FSide=AValue then exit;
4105  FOwner.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorSide.SetSide'){$ENDIF};
4106  if AValue=asrCenter then begin
4107    OldSide:=FSide;
4108    FixCenterAnchoring;
4109    if OldSide<>FSide then exit;
4110  end;
4111  FSide:=AValue;
4112  FOwner.AnchorSideChanged(Self);
4113  if FControl<>nil then
4114    FControl.ForeignAnchorSideChanged(Self,ascoChangeSide);
4115  FOwner.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TAnchorSide.SetSide'){$ENDIF};
4116end;
4117
4118function TAnchorSide.GetOwner: TPersistent;
4119begin
4120  Result := FOwner;
4121end;
4122
4123constructor TAnchorSide.Create(TheOwner: TControl; TheKind: TAnchorKind);
4124begin
4125  inherited Create;
4126  FOwner := TheOwner;
4127  FKind := TheKind;
4128  FSide := asrTop;
4129end;
4130
4131destructor TAnchorSide.Destroy;
4132var
4133  OldControl: TControl;
4134begin
4135  OldControl:=Control;
4136  FControl:=nil;
4137  //DebugLN('TAnchorSide.Destroy A ',DbgSName(Owner));
4138  if OldControl<>nil then
4139    OldControl.ForeignAnchorSideChanged(Self,ascoRemove);
4140  inherited Destroy;
4141end;
4142
4143procedure TAnchorSide.GetSidePosition(out ReferenceControl: TControl; out
4144  ReferenceSide: TAnchorSideReference; out Position: Integer);
4145begin
4146  CheckSidePosition(Control,Side,ReferenceControl,ReferenceSide,Position);
4147end;
4148
4149function TAnchorSide.CheckSidePosition(NewControl: TControl;
4150  NewSide: TAnchorSideReference;
4151  out ReferenceControl: TControl;
4152  out ReferenceSide: TAnchorSideReference; out Position: Integer): boolean;
4153{off $DEFINE VerboseAnchorSide}
4154var
4155  ParentRect: TRect;
4156  ParentRectValid: boolean;
4157
4158  procedure RaiseInvalidSide;
4159  begin
4160    raise Exception.Create('TAnchorSide.CheckSidePosition invalid Side');
4161  end;
4162
4163  function GetNextCentered(ReferenceControl: TControl; Side: TAnchorKind;
4164    var NextReferenceSide: TAnchorSide): boolean;
4165  begin
4166    if (Side in ReferenceControl.Anchors)
4167    and (ReferenceControl.AnchorSide[Side].Control<>nil)
4168    and (ReferenceControl.AnchorSide[Side].Side=asrCenter) then begin
4169      Result:=true;
4170      NextReferenceSide:=ReferenceControl.AnchorSide[Side];
4171    end else
4172      Result:=false;
4173  end;
4174
4175  function GetParentSidePos(Side: TAnchorKind): integer;
4176  begin
4177    if not ParentRectValid then begin
4178      FOwner.Parent.GetAdjustedLogicalClientRect(ParentRect);
4179      ParentRectValid:=true;
4180    end;
4181    case Side of
4182    akTop: Result:=ParentRect.Top;
4183    akLeft: Result:=ParentRect.Left;
4184    akRight: Result:=ParentRect.Right;
4185    akBottom: Result:=ParentRect.Bottom;
4186    end;
4187  end;
4188
4189var
4190  NextReferenceSide: TAnchorSide;
4191  ChainLength: Integer;
4192  MaxChainLength: LongInt;
4193  OwnerBorderSpacing: LongInt;
4194  OwnerParent: TWinControl;
4195  Found: Boolean;
4196  CurReferenceControl: TControl;
4197  CurReferenceSide: TAnchorSideReference;
4198begin
4199  Result:=false;
4200  ReferenceControl:=nil;
4201  ReferenceSide:=Side;
4202  Position:=0;
4203  OwnerParent:=FOwner.Parent;
4204  if OwnerParent=nil then begin
4205    // AnchorSide is only between siblings or its direct parent allowed
4206    //if CheckPosition(Owner) then DebugLn(['TAnchorSide.GetSidePosition OwnerParent=nil']);
4207    exit;
4208  end;
4209  ParentRectValid:=false;
4210  ChainLength:=0;
4211  MaxChainLength:=OwnerParent.ControlCount;
4212  Found:=false;
4213  CurReferenceControl:=NewControl;
4214  CurReferenceSide:=NewSide;
4215  while CurReferenceControl<>nil do begin
4216
4217    // check for circles
4218    if CurReferenceControl=Owner then begin
4219      // circle
4220      {$IFNDEF VerboseAnchorSide}
4221      DebugLn(['TAnchorSide.CheckSidePosition Circle, ',DbgSName(Owner),' ',dbgs(Kind)]);
4222      {$ENDIF}
4223      ReferenceControl:=nil;
4224      exit;
4225    end;
4226
4227    inc(ChainLength);
4228    if ChainLength>MaxChainLength then begin
4229      // the chain has more elements than there are siblings -> circle
4230      //if CheckPosition(Owner) then
4231      {$IFNDEF VerboseAnchorSide}
4232      DebugLn(['TAnchorSide.CheckSidePosition Circle, ',DbgSName(Owner),' ',dbgs(Kind)]);
4233      {$ENDIF}
4234      ReferenceControl:=nil;
4235      exit;
4236    end;
4237
4238    // check if ReferenceControl is valid
4239    if (CurReferenceControl.Parent<>OwnerParent)
4240    and (CurReferenceControl<>OwnerParent) then begin
4241      // not a sibling and not the parent -> invalid AnchorSide
4242      //if CheckPosition(Owner) then DebugLn(['TAnchorSide.GetSidePosition invalid AnchorSide ',dbgsName(ReferenceControl)]);
4243      {$IFNDEF VerboseAnchorSide}
4244      DebugLn(['TAnchorSide.CheckSidePosition invalid anchor control, ',DbgSName(Owner),' ',dbgs(Kind)]);
4245      {$ENDIF}
4246      ReferenceControl:=nil;
4247      exit;
4248    end;
4249
4250    //debugln(['TAnchorSide.CheckSidePosition CurReferenceControl=',DbgSName(CurReferenceControl),' Kind=',dbgs(Kind),' Visible=',CurReferenceControl.IsControlVisible]);
4251
4252    if CurReferenceControl.IsControlVisible then begin
4253      // ReferenceControl is visible
4254      if not Found then begin
4255        Found:=true;
4256        ReferenceControl:=CurReferenceControl;
4257        ReferenceSide:=CurReferenceSide;
4258
4259        // -> calculate Position
4260        OwnerBorderSpacing:=FOwner.BorderSpacing.GetSideSpace(Kind);
4261        //if CheckPosition(Owner) then DebugLn(['TAnchorSide.CheckSidePosition ',dbgsName(Owner),' ReferenceControl=',dbgsName(ReferenceControl),' ',dbgs(ReferenceControl.BoundsRect),' OwnerBorderSpacing=',OwnerBorderSpacing,' Kind=',dbgs(Kind),' ReferenceSide=',dbgs(Kind,ReferenceSide)]);
4262        case ReferenceSide of
4263
4264        asrTop: // asrTop = asrLeft
4265          if Kind in [akLeft,akRight] then begin
4266            // anchor to left side of ReferenceControl
4267            if ReferenceControl=OwnerParent then
4268              Position:=GetParentSidePos(akLeft)
4269            else
4270              Position:=ReferenceControl.Left;
4271            if ReferenceControl=OwnerParent then
4272              OwnerBorderSpacing:=Max(OwnerBorderSpacing,
4273                                      OwnerParent.ChildSizing.LeftRightSpacing)
4274            else if Kind=akRight then
4275              OwnerBorderSpacing:=Max(Max(OwnerBorderSpacing,
4276                   ReferenceControl.BorderSpacing.GetSideSpace(OppositeAnchor[Kind])),
4277                   OwnerParent.ChildSizing.HorizontalSpacing);
4278            if Kind=akLeft then begin
4279              // anchor left of ReferenceControl and left of Owner
4280              inc(Position,OwnerBorderSpacing);
4281            end else begin
4282              // anchor left of ReferenceControl and right of Owner
4283              dec(Position,OwnerBorderSpacing);
4284            end;
4285          end else begin
4286            // anchor to top side of ReferenceControl
4287            if ReferenceControl=OwnerParent then
4288              Position:=GetParentSidePos(akTop)
4289            else
4290              Position:=ReferenceControl.Top;
4291            if ReferenceControl=OwnerParent then
4292              OwnerBorderSpacing:=Max(OwnerBorderSpacing,
4293                                      OwnerParent.ChildSizing.TopBottomSpacing)
4294            else if Kind=akBottom then
4295              OwnerBorderSpacing:=Max(Max(OwnerBorderSpacing,
4296                   ReferenceControl.BorderSpacing.GetSideSpace(OppositeAnchor[Kind])),
4297                   OwnerParent.ChildSizing.VerticalSpacing);
4298            if Kind=akTop then begin
4299              // anchor top of ReferenceControl and top of Owner
4300              inc(Position,OwnerBorderSpacing);
4301            end else begin
4302              // anchor top of ReferenceControl and bottom of Owner
4303              dec(Position,OwnerBorderSpacing);
4304            end;
4305          end;
4306
4307        asrBottom: // asrBottom = asrRight
4308          if Kind in [akLeft,akRight] then begin
4309            // anchor to right side of ReferenceControl
4310            if ReferenceControl=OwnerParent then
4311              Position:=GetParentSidePos(akRight)
4312            else
4313              Position:=ReferenceControl.Left+ReferenceControl.Width;
4314            if ReferenceControl=OwnerParent then
4315              OwnerBorderSpacing:=Max(OwnerBorderSpacing,
4316                                      OwnerParent.ChildSizing.LeftRightSpacing)
4317            else if Kind=akLeft then
4318              OwnerBorderSpacing:=Max(Max(OwnerBorderSpacing,
4319                   ReferenceControl.BorderSpacing.GetSideSpace(OppositeAnchor[Kind])),
4320                   OwnerParent.ChildSizing.HorizontalSpacing);
4321            if Kind=akLeft then begin
4322              // anchor right of ReferenceControl and left of Owner
4323              inc(Position,OwnerBorderSpacing);
4324            end else begin
4325              // anchor right of ReferenceControl and right of Owner
4326              dec(Position,OwnerBorderSpacing);
4327            end;
4328          end else begin
4329            // anchor to bottom side of ReferenceControl
4330            if ReferenceControl=OwnerParent then
4331              Position:=GetParentSidePos(akBottom)
4332            else
4333              Position:=ReferenceControl.Top+ReferenceControl.Height;
4334            if ReferenceControl=OwnerParent then
4335              OwnerBorderSpacing:=Max(OwnerBorderSpacing,
4336                                      OwnerParent.ChildSizing.TopBottomSpacing)
4337            else if Kind=akTop then
4338              OwnerBorderSpacing:=Max(Max(OwnerBorderSpacing,
4339                   ReferenceControl.BorderSpacing.GetSideSpace(OppositeAnchor[Kind])),
4340                   OwnerParent.ChildSizing.VerticalSpacing);
4341            if Kind=akTop then begin
4342              // anchor bottom of ReferenceControl and top of Owner
4343              inc(Position,OwnerBorderSpacing);
4344            end else begin
4345              // anchor bottom of ReferenceControl and bottom of Owner
4346              dec(Position,OwnerBorderSpacing);
4347            end;
4348          end;
4349
4350        asrCenter:
4351          if Kind in [akLeft,akRight] then begin
4352            // center horizontally
4353            if ReferenceControl=OwnerParent then
4354              Position:=(GetParentSidePos(akRight)+GetParentSidePos(akLeft)) div 2
4355            else
4356              Position:=ReferenceControl.Left+(ReferenceControl.Width div 2);
4357            if Kind=akLeft then
4358              dec(Position,FOwner.Width div 2)
4359            else
4360              inc(Position,FOwner.Width div 2);
4361          end else begin
4362            // center vertically
4363            if ReferenceControl=OwnerParent then
4364              Position:=OwnerParent.ClientHeight div 2
4365            else
4366              Position:=ReferenceControl.Top+(ReferenceControl.Height div 2);
4367            if Kind=akTop then
4368              dec(Position,FOwner.Height div 2)
4369            else
4370              inc(Position,FOwner.Height div 2);
4371          end;
4372
4373        else
4374          RaiseInvalidSide;
4375        end;
4376      end;
4377      // side found
4378      // continue to detect circles
4379    end;
4380
4381    // try next
4382    NextReferenceSide:=nil;
4383    //debugln(['TAnchorSide.CheckSidePosition CurReferenceControl=',DbgSName(CurReferenceControl),' OwnerParent=',DbgSName(OwnerParent)]);
4384    if CurReferenceControl<>OwnerParent then
4385    begin
4386      // anchored to an invisible control
4387      //debugln(['TAnchorSide.CheckSidePosition skip invisible, try next CurReferenceControl=',DbgSName(CurReferenceControl),' Kind=',dbgs(Kind),' CurReferenceSide=',dbgs(Kind,CurReferenceSide)]);
4388      if CurReferenceSide=asrCenter then
4389      begin
4390        // center can only be anchored to another centered anchor
4391        if Kind in [akLeft,akRight] then
4392        begin
4393          if not GetNextCentered(CurReferenceControl,akLeft,NextReferenceSide)
4394          then   GetNextCentered(CurReferenceControl,akRight,NextReferenceSide);
4395        end else begin
4396          if not GetNextCentered(CurReferenceControl,akTop,NextReferenceSide)
4397          then   GetNextCentered(CurReferenceControl,akBottom,NextReferenceSide);
4398        end;
4399      end else if (CurReferenceSide=asrLeft) = (Kind in [akLeft,akTop]) then
4400      begin
4401        //debugln(['TAnchorSide.CheckSidePosition parallel CurReferenceControl=',DbgSName(CurReferenceControl),' Kind=',dbgs(Kind),' Anchors=',dbgs(CurReferenceControl.Anchors)]);
4402        // anchor parallel (e.g. a left side to a left side)
4403        if Kind in CurReferenceControl.Anchors then
4404          NextReferenceSide:=CurReferenceControl.AnchorSide[Kind]
4405        else if OppositeAnchor[Kind] in CurReferenceControl.Anchors then
4406          NextReferenceSide:=CurReferenceControl.AnchorSide[OppositeAnchor[Kind]];
4407      end else begin
4408        //debugln(['TAnchorSide.CheckSidePosition opposite CurReferenceControl=',DbgSName(CurReferenceControl),' Kind=',dbgs(Kind),' Anchors=',dbgs(CurReferenceControl.Anchors)]);
4409        // anchor opposite (e.g. a left side to a right side)
4410        if OppositeAnchor[Kind] in CurReferenceControl.Anchors then
4411          NextReferenceSide:=CurReferenceControl.AnchorSide[OppositeAnchor[Kind]]
4412        else if Kind in CurReferenceControl.Anchors then
4413          NextReferenceSide:=CurReferenceControl.AnchorSide[Kind];
4414      end;
4415    end;
4416    if (NextReferenceSide=nil) then
4417    begin
4418      // no further side => anchor ok
4419      // Note: if anchored control is not visible, it is anchored to the parent
4420      //if CheckPosition(Owner) and (Kind=akRight) then
4421      //if Owner.Name='ClassPartInsertPolicyRadioGroup' then
4422      //  DebugLn(['TAnchorSide.CheckSidePosition Success ',DbgSName(Owner),' ReferenceControl=',dbgsName(ReferenceControl),' CurReferenceControl=',DbgSName(CurReferenceControl),' CurReferenceSide=',dbgs(Kind,CurReferenceSide)]);
4423      exit(true);
4424    end;
4425    if NextReferenceSide=Self then begin
4426      CurReferenceControl:=NewControl;
4427      CurReferenceSide:=NewSide;
4428    end else begin
4429      CurReferenceControl:=NextReferenceSide.Control;
4430      CurReferenceSide:=NextReferenceSide.Side;
4431    end;
4432    //DebugLn(['TAnchorSide.CheckSidePosition ',DbgSName(FOwner),' ReferenceControl=',DbgSName(ReferenceControl),' Kind=',dbgs(Kind),' ReferenceSide=',dbgs(Kind,ReferenceSide)]);
4433  end;
4434  Result:=true;
4435end;
4436
4437procedure TAnchorSide.Assign(Source: TPersistent);
4438var
4439  Src: TAnchorSide;
4440begin
4441  if Source is TAnchorSide then begin
4442    Src:=TAnchorSide(Source);
4443    Side:=Src.Side;
4444    Control:=Src.Control;
4445  end else
4446    inherited Assign(Source);
4447end;
4448
4449function TAnchorSide.IsAnchoredToParent(ParentSide: TAnchorKind): boolean;
4450var
4451  ReferenceControl: TControl;
4452  ReferenceSide: TAnchorSideReference;
4453  p: Integer;
4454begin
4455  if (Owner.Align in [alClient,alLeft,alRight,alTop,alBottom])
4456  and (Kind in AnchorAlign[Owner.Align]) then
4457    exit(true); // aligned
4458  if not (Kind in Owner.Anchors) then
4459    exit(false); // not anchored
4460  GetSidePosition(ReferenceControl,ReferenceSide,p);
4461  if ReferenceControl=nil then
4462    exit(true); // default anchored to parent
4463  if Owner.Parent=nil then
4464    exit(false); // no parent
4465  if (ReferenceControl=Owner.Parent) and (Kind=ParentSide) then
4466    exit(true);
4467  Result:=false;
4468end;
4469
4470procedure TAnchorSide.FixCenterAnchoring;
4471begin
4472  if (Side=asrCenter) and (Control<>nil) and (Kind in FOwner.Anchors) then
4473  begin
4474    // in case asrCenter, both sides are controlled by one anchor
4475    // -> disable opposite anchor and aligning
4476    if not (FOwner.Align in [alNone,alCustom]) then
4477      FOwner.Align:=alNone;
4478    FOwner.Anchors:=FOwner.Anchors-[OppositeAnchor[Kind]];
4479  end;
4480end;
4481
4482{ TControlPropertyStorage }
4483
4484procedure TControlPropertyStorage.GetPropertyList(List: TStrings);
4485var
4486  ARoot: TPersistent;
4487  PropsAsStr: String;
4488  StartPos: Integer;
4489  EndPos: LongInt;
4490  PropertyStr: String;
4491  AControl: TControl;
4492  PointPos: LongInt;
4493begin
4494  ARoot:=Root;
4495  if ARoot is TControl then begin
4496    AControl:=TControl(ARoot);
4497    PropsAsStr:=AControl.SessionProperties;
4498    //debugln('PropsAsStr=',PropsAsStr);
4499    StartPos:=1;
4500    while (StartPos<=length(PropsAsStr)) do begin
4501      EndPos:=StartPos;
4502      while (EndPos<=length(PropsAsStr)) and (PropsAsStr[EndPos]<>';') do
4503        inc(EndPos);
4504      if (EndPos>StartPos) then begin
4505        PropertyStr:=copy(PropsAsStr,StartPos,EndPos-StartPos);
4506        //debugln('A PropertyStr=',PropertyStr);
4507        // if no point char, then prepend the owner name as default
4508        PointPos:=StartPos;
4509        while (PointPos<EndPos) and (PropsAsStr[PointPos]<>'.') do
4510          inc(PointPos);
4511        if PointPos=EndPos then
4512          PropertyStr:=AControl.Name+'.'+PropertyStr;
4513        // add to list
4514        //debugln('B PropertyStr=',PropertyStr);
4515        List.Add(PropertyStr);
4516      end;
4517      StartPos:=EndPos+1;
4518    end;
4519  end;
4520end;
4521
4522{ TDragManager }
4523
4524constructor TDragManager.Create(TheOwner: TComponent);
4525begin
4526  inherited Create(TheOwner);
4527  FDragImmediate := True;
4528  FDragThreshold := 5;
4529end;
4530
4531{ TDockManager }
4532
4533procedure TDockManager.PositionDockRect(ADockObject: TDragDockObject);
4534begin
4535(* for now: defer to old PositionDockRect.
4536  Overridden methods should determine DropOnControl and DropAlign, before
4537    calling inherited method.
4538*)
4539  with ADockObject do
4540  begin
4541    if DropAlign = alNone then
4542    begin
4543      if DropOnControl <> nil then
4544        DropAlign := DropOnControl.GetDockEdge(DropOnControl.ScreenToClient(DragPos))
4545      else
4546        DropAlign := Control.GetDockEdge(DragTargetPos);
4547    end;
4548    PositionDockRect(Control, DropOnControl, DropAlign, FDockRect);
4549  end;
4550end;
4551
4552procedure TDockManager.SetReplacingControl(Control: TControl);
4553begin
4554
4555end;
4556
4557function TDockManager.AutoFreeByControl: Boolean;
4558begin
4559  Result := True;
4560end;
4561
4562constructor TDockManager.Create(ADockSite: TWinControl);
4563begin
4564  inherited Create;
4565end;
4566
4567procedure TDockManager.BeginUpdate;
4568begin
4569
4570end;
4571
4572procedure TDockManager.EndUpdate;
4573begin
4574
4575end;
4576
4577function TDockManager.GetDockEdge(ADockObject: TDragDockObject): boolean;
4578begin
4579  { Determine the DropAlign.
4580    ADockObject contains valid DragTarget, DragPos, DragTargetPos relative
4581    dock site, and DropOnControl.
4582    Return True if ADockObject.DropAlign has been determined.
4583  }
4584  Result := False; // use the DockSite.GetDockEdge
4585end;
4586
4587procedure TDockManager.InsertControl(ADockObject: TDragDockObject);
4588begin
4589  InsertControl(ADockObject.Control,ADockObject.DropAlign,
4590                ADockObject.DropOnControl);
4591end;
4592
4593procedure TDockManager.PaintSite(DC: HDC);
4594begin
4595
4596end;
4597
4598procedure TDockManager.MessageHandler(Sender: TControl; var Message: TLMessage);
4599begin
4600
4601end;
4602
4603function TDockManager.IsEnabledControl(Control: TControl):Boolean;
4604begin
4605  Result := true;
4606  if Control is TWinControl then
4607    if (Control as TWinControl).DockManager <> nil then
4608      Result := (Control as TWinControl).DockManager = self;
4609end;
4610
4611
4612initialization
4613  //DebugLn('controls.pp - initialization');
4614  RegisterPropertyToSkip(TControl, 'AlignWithMargins', 'VCL compatibility property', '');
4615  RegisterPropertyToSkip(TControl, 'Ctl3D',            'VCL compatibility property', '');
4616  RegisterPropertyToSkip(TControl, 'ParentCtl3D',      'VCL compatibility property', '');
4617  RegisterPropertyToSkip(TControl, 'IsControl',        'VCL compatibility property', '');
4618  RegisterPropertyToSkip(TControl, 'DesignSize',       'VCL compatibility property', '');
4619  RegisterPropertyToSkip(TControl, 'ExplicitLeft',     'VCL compatibility property', '');
4620  RegisterPropertyToSkip(TControl, 'ExplicitHeight',   'VCL compatibility property', '');
4621  RegisterPropertyToSkip(TControl, 'ExplicitTop',      'VCL compatibility property', '');
4622  RegisterPropertyToSkip(TControl, 'ExplicitWidth',    'VCL compatibility property', '');
4623  {$IF FPC_FULLVERSION<30003}
4624  RegisterPropertyToSkip(TDataModule, 'PPI',    'PPI was introduced in FPC 3.0.3', '');
4625  {$ENDIF}
4626  Mouse := TMouse.Create;
4627  DefaultDockManagerClass := TDockTree;
4628  DragManager := TDragManagerDefault.Create(nil);
4629  RegisterIntegerConsts(TypeInfo(TCursor), @IdentToCursor, @CursorToIdent);
4630
4631finalization
4632  FreeThenNil(DragManager);
4633  FreeThenNil(Mouse);
4634
4635end.
4636