home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Source / Vcl / CONTROLS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  294.9 KB  |  9,957 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1995,99 Inprise Corporation       }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Controls;
  11.  
  12. {$P+,S-,W-,R-,T-,H+,X+}
  13. {$C PRELOAD}
  14.  
  15. interface
  16.  
  17. {$R CONTROLS}
  18.  
  19. { CommCtrl.hpp is not required in Controls.hpp }
  20. (*$NOINCLUDE CommCtrl *)
  21. uses Messages, Windows, MultiMon, Classes, Sysutils, Graphics, Menus, CommCtrl, Imm,
  22.   ImgList, ActnList;
  23.  
  24. { VCL control message IDs }
  25.  
  26. const
  27.   CM_BASE                   = $B000;
  28.   CM_ACTIVATE               = CM_BASE + 0;
  29.   CM_DEACTIVATE             = CM_BASE + 1;
  30.   CM_GOTFOCUS               = CM_BASE + 2;
  31.   CM_LOSTFOCUS              = CM_BASE + 3;
  32.   CM_CANCELMODE             = CM_BASE + 4;
  33.   CM_DIALOGKEY              = CM_BASE + 5;
  34.   CM_DIALOGCHAR             = CM_BASE + 6;
  35.   CM_FOCUSCHANGED           = CM_BASE + 7;
  36.   CM_PARENTFONTCHANGED      = CM_BASE + 8;
  37.   CM_PARENTCOLORCHANGED     = CM_BASE + 9;
  38.   CM_HITTEST                = CM_BASE + 10;
  39.   CM_VISIBLECHANGED         = CM_BASE + 11;
  40.   CM_ENABLEDCHANGED         = CM_BASE + 12;
  41.   CM_COLORCHANGED           = CM_BASE + 13;
  42.   CM_FONTCHANGED            = CM_BASE + 14;
  43.   CM_CURSORCHANGED          = CM_BASE + 15;
  44.   CM_CTL3DCHANGED           = CM_BASE + 16;
  45.   CM_PARENTCTL3DCHANGED     = CM_BASE + 17;
  46.   CM_TEXTCHANGED            = CM_BASE + 18;
  47.   CM_MOUSEENTER             = CM_BASE + 19;
  48.   CM_MOUSELEAVE             = CM_BASE + 20;
  49.   CM_MENUCHANGED            = CM_BASE + 21;
  50.   CM_APPKEYDOWN             = CM_BASE + 22;
  51.   CM_APPSYSCOMMAND          = CM_BASE + 23;
  52.   CM_BUTTONPRESSED          = CM_BASE + 24;
  53.   CM_SHOWINGCHANGED         = CM_BASE + 25;
  54.   CM_ENTER                  = CM_BASE + 26;
  55.   CM_EXIT                   = CM_BASE + 27;
  56.   CM_DESIGNHITTEST          = CM_BASE + 28;
  57.   CM_ICONCHANGED            = CM_BASE + 29;
  58.   CM_WANTSPECIALKEY         = CM_BASE + 30;
  59.   CM_INVOKEHELP             = CM_BASE + 31;
  60.   CM_WINDOWHOOK             = CM_BASE + 32;
  61.   CM_RELEASE                = CM_BASE + 33;
  62.   CM_SHOWHINTCHANGED        = CM_BASE + 34;
  63.   CM_PARENTSHOWHINTCHANGED  = CM_BASE + 35;
  64.   CM_SYSCOLORCHANGE         = CM_BASE + 36;
  65.   CM_WININICHANGE           = CM_BASE + 37;
  66.   CM_FONTCHANGE             = CM_BASE + 38;
  67.   CM_TIMECHANGE             = CM_BASE + 39;
  68.   CM_TABSTOPCHANGED         = CM_BASE + 40;
  69.   CM_UIACTIVATE             = CM_BASE + 41;
  70.   CM_UIDEACTIVATE           = CM_BASE + 42;
  71.   CM_DOCWINDOWACTIVATE      = CM_BASE + 43;
  72.   CM_CONTROLLISTCHANGE      = CM_BASE + 44;
  73.   CM_GETDATALINK            = CM_BASE + 45;
  74.   CM_CHILDKEY               = CM_BASE + 46;
  75.   CM_DRAG                   = CM_BASE + 47;
  76.   CM_HINTSHOW               = CM_BASE + 48;
  77.   CM_DIALOGHANDLE           = CM_BASE + 49;
  78.   CM_ISTOOLCONTROL          = CM_BASE + 50;
  79.   CM_RECREATEWND            = CM_BASE + 51;
  80.   CM_INVALIDATE             = CM_BASE + 52;
  81.   CM_SYSFONTCHANGED         = CM_BASE + 53;
  82.   CM_CONTROLCHANGE          = CM_BASE + 54;
  83.   CM_CHANGED                = CM_BASE + 55;
  84.   CM_DOCKCLIENT             = CM_BASE + 56;
  85.   CM_UNDOCKCLIENT           = CM_BASE + 57;
  86.   CM_FLOAT                  = CM_BASE + 58;
  87.   CM_BORDERCHANGED          = CM_BASE + 59;
  88.   CM_BIDIMODECHANGED        = CM_BASE + 60;
  89.   CM_PARENTBIDIMODECHANGED  = CM_BASE + 61;
  90.   CM_ALLCHILDRENFLIPPED     = CM_BASE + 62;
  91.   CM_ACTIONUPDATE           = CM_BASE + 63;
  92.   CM_ACTIONEXECUTE          = CM_BASE + 64;
  93.   CM_HINTSHOWPAUSE          = CM_BASE + 65;
  94.   CM_DOCKNOTIFICATION       = CM_BASE + 66;
  95.   CM_MOUSEWHEEL             = CM_BASE + 67;
  96.  
  97. { VCL control notification IDs }
  98.  
  99. const
  100.   CN_BASE              = $BC00;
  101.   CN_CHARTOITEM        = CN_BASE + WM_CHARTOITEM;
  102.   CN_COMMAND           = CN_BASE + WM_COMMAND;
  103.   CN_COMPAREITEM       = CN_BASE + WM_COMPAREITEM;
  104.   CN_CTLCOLORBTN       = CN_BASE + WM_CTLCOLORBTN;
  105.   CN_CTLCOLORDLG       = CN_BASE + WM_CTLCOLORDLG;
  106.   CN_CTLCOLOREDIT      = CN_BASE + WM_CTLCOLOREDIT;
  107.   CN_CTLCOLORLISTBOX   = CN_BASE + WM_CTLCOLORLISTBOX;
  108.   CN_CTLCOLORMSGBOX    = CN_BASE + WM_CTLCOLORMSGBOX;
  109.   CN_CTLCOLORSCROLLBAR = CN_BASE + WM_CTLCOLORSCROLLBAR;
  110.   CN_CTLCOLORSTATIC    = CN_BASE + WM_CTLCOLORSTATIC;
  111.   CN_DELETEITEM        = CN_BASE + WM_DELETEITEM;
  112.   CN_DRAWITEM          = CN_BASE + WM_DRAWITEM;
  113.   CN_HSCROLL           = CN_BASE + WM_HSCROLL;
  114.   CN_MEASUREITEM       = CN_BASE + WM_MEASUREITEM;
  115.   CN_PARENTNOTIFY      = CN_BASE + WM_PARENTNOTIFY;
  116.   CN_VKEYTOITEM        = CN_BASE + WM_VKEYTOITEM;
  117.   CN_VSCROLL           = CN_BASE + WM_VSCROLL;
  118.   CN_KEYDOWN           = CN_BASE + WM_KEYDOWN;
  119.   CN_KEYUP             = CN_BASE + WM_KEYUP;
  120.   CN_CHAR              = CN_BASE + WM_CHAR;
  121.   CN_SYSKEYDOWN        = CN_BASE + WM_SYSKEYDOWN;
  122.   CN_SYSCHAR           = CN_BASE + WM_SYSCHAR;
  123.   CN_NOTIFY            = CN_BASE + WM_NOTIFY;
  124.  
  125. { TModalResult values }
  126.  
  127. const
  128.   mrNone     = 0;
  129.   mrOk       = idOk;
  130.   mrCancel   = idCancel;
  131.   mrAbort    = idAbort;
  132.   mrRetry    = idRetry;
  133.   mrIgnore   = idIgnore;
  134.   mrYes      = idYes;
  135.   mrNo       = idNo;
  136.   mrAll      = mrNo + 1;
  137.   mrNoToAll  = mrAll + 1;
  138.   mrYesToAll = mrNoToAll + 1;
  139.  
  140. { Cursor identifiers }
  141.  
  142. type
  143.   TCursor = -32768..32767;
  144.   {$NODEFINE TCursor}
  145.  
  146.   (*$HPPEMIT 'namespace Controls'}*)
  147.   (*$HPPEMIT '{'}*)
  148.   (*$HPPEMIT '#pragma option -b-'*)
  149.   (*$HPPEMIT '  enum TCursor {crMin=-32768, crMax=32767};'}*)
  150.   (*$HPPEMIT '#pragma option -b.'*)
  151.   (*$HPPEMIT '}'*)
  152.  
  153. const
  154.   crDefault     = TCursor(0);
  155.   crNone        = TCursor(-1);
  156.   crArrow       = TCursor(-2);
  157.   crCross       = TCursor(-3);
  158.   crIBeam       = TCursor(-4);
  159.   crSize        = TCursor(-22);
  160.   crSizeNESW    = TCursor(-6);
  161.   crSizeNS      = TCursor(-7);
  162.   crSizeNWSE    = TCursor(-8);
  163.   crSizeWE      = TCursor(-9);
  164.   crUpArrow     = TCursor(-10);
  165.   crHourGlass   = TCursor(-11);
  166.   crDrag        = TCursor(-12);
  167.   crNoDrop      = TCursor(-13);
  168.   crHSplit      = TCursor(-14);
  169.   crVSplit      = TCursor(-15);
  170.   crMultiDrag   = TCursor(-16);
  171.   crSQLWait     = TCursor(-17);
  172.   crNo          = TCursor(-18);
  173.   crAppStart    = TCursor(-19);
  174.   crHelp        = TCursor(-20);
  175.   crHandPoint   = TCursor(-21);
  176.   crSizeAll     = TCursor(-22);
  177.  
  178. type
  179.  
  180. { Forward declarations }
  181.  
  182.   TDragObject = class;
  183.   TControl = class;
  184.   TWinControl = class;
  185.   TDragImageList = class;
  186.  
  187.   TWinControlClass = class of TWinControl;
  188.  
  189. { VCL control message records }
  190.  
  191.   TCMActivate = TWMNoParams;
  192.   TCMDeactivate = TWMNoParams;
  193.   TCMGotFocus = TWMNoParams;
  194.   TCMLostFocus = TWMNoParams;
  195.   TCMDialogKey = TWMKey;
  196.   TCMDialogChar = TWMKey;
  197.   TCMHitTest = TWMNCHitTest;
  198.   TCMEnter = TWMNoParams;
  199.   TCMExit = TWMNoParams;
  200.   TCMDesignHitTest = TWMMouse;
  201.   TCMWantSpecialKey = TWMKey;
  202.  
  203.   TCMMouseWheel = record
  204.     Msg: Cardinal;
  205.     ShiftState: TShiftState;
  206.     Unused: Byte;
  207.     WheelDelta: SmallInt;
  208.     case Integer of
  209.       0: (
  210.         XPos: Smallint;
  211.         YPos: Smallint);
  212.       1: (
  213.         Pos: TSmallPoint;
  214.         Result: Longint);
  215.   end;
  216.  
  217.   TCMCancelMode = record
  218.     Msg: Cardinal;
  219.     Unused: Integer;
  220.     Sender: TControl;
  221.     Result: Longint;
  222.   end;
  223.  
  224.   TCMFocusChanged = record
  225.     Msg: Cardinal;
  226.     Unused: Integer;
  227.     Sender: TWinControl;
  228.     Result: Longint;
  229.   end;
  230.  
  231.   TCMControlListChange = record
  232.     Msg: Cardinal;
  233.     Control: TControl;
  234.     Inserting: LongBool;
  235.     Result: Longint;
  236.   end;
  237.  
  238.   TCMChildKey = record
  239.     Msg: Cardinal;
  240.     CharCode: Word;
  241.     Unused: Word;
  242.     Sender: TWinControl;
  243.     Result: Longint;
  244.   end;
  245.  
  246.   TCMControlChange = record
  247.     Msg: Cardinal;
  248.     Control: TControl;
  249.     Inserting: LongBool;
  250.     Result: Longint;
  251.   end;
  252.  
  253.   TCMChanged = record
  254.     Msg: Cardinal;
  255.     Unused: Longint;
  256.     Child: TControl;
  257.     Result: Longint;
  258.   end;
  259.  
  260.   TDragMessage = (dmDragEnter, dmDragLeave, dmDragMove, dmDragDrop, dmDragCancel,
  261.     dmFindTarget);
  262.  
  263.   PDragRec = ^TDragRec;
  264.   TDragRec = record
  265.     Pos: TPoint;
  266.     Source: TDragObject;
  267.     Target: Pointer;
  268.     Docking: Boolean;
  269.   end;
  270.  
  271.   TCMDrag = packed record
  272.     Msg: Cardinal;
  273.     DragMessage: TDragMessage;
  274.     Reserved1: Byte;
  275.     Reserved2: Word;
  276.     DragRec: PDragRec;
  277.     Result: Longint;
  278.   end;
  279.  
  280.   TDragDockObject = class;
  281.  
  282.   TCMDockClient = packed record
  283.     Msg: Cardinal;
  284.     DockSource: TDragDockObject;
  285.     MousePos: TSmallPoint;
  286.     Result: Integer;
  287.   end;
  288.  
  289.   TCMUnDockClient = packed record
  290.     Msg: Cardinal;
  291.     NewTarget: TControl;
  292.     Client: TControl;
  293.     Result: Integer;
  294.   end;
  295.  
  296.   TCMFloat = packed record
  297.     Msg: Cardinal;
  298.     Reserved: Integer;
  299.     DockSource: TDragDockObject;
  300.     Result: Integer;
  301.   end;
  302.  
  303.   PDockNotifyRec = ^TDockNotifyRec;
  304.   TDockNotifyRec = record
  305.     ClientMsg: Cardinal;
  306.     MsgWParam: Integer;
  307.     MsgLParam: Integer;
  308.   end;
  309.  
  310.   TCMDockNotification = packed record
  311.     Msg: Cardinal;
  312.     Client: TControl;
  313.     NotifyRec: PDockNotifyRec;
  314.     Result: Integer;
  315.   end;
  316.  
  317.   TAlign = (alNone, alTop, alBottom, alLeft, alRight, alClient);
  318.  
  319.   TAlignSet = set of TAlign;
  320.  
  321. { Dragging objects }
  322.  
  323.   TDragObject = class(TObject)
  324.   private
  325.     FDragTarget: Pointer;
  326.     FDragHandle: HWND;
  327.     FDragPos: TPoint;
  328.     FDragTargetPos: TPoint;
  329.     FMouseDeltaX: Double;
  330.     FMouseDeltaY: Double;
  331.     FCancelling: Boolean;
  332.     function Capture: HWND;
  333.     procedure MouseMsg(var Msg: TMessage);
  334.     procedure ReleaseCapture(Handle: HWND);
  335.   protected
  336.     procedure Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); virtual;
  337.     function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; virtual;
  338.     function GetDragImages: TDragImageList; virtual;
  339.   public
  340.     procedure Assign(Source: TDragObject); virtual;
  341.     function GetName: string; virtual;
  342.     procedure HideDragImage; virtual;
  343.     function Instance: THandle; virtual;
  344.     procedure ShowDragImage; virtual;
  345.     property Cancelling: Boolean read FCancelling write FCancelling;
  346.     property DragHandle: HWND read FDragHandle write FDragHandle;
  347.     property DragPos: TPoint read FDragPos write FDragPos;
  348.     property DragTargetPos: TPoint read FDragTargetPos write FDragTargetPos;
  349.     property DragTarget: Pointer read FDragTarget write FDragTarget;
  350.     property MouseDeltaX: Double read FMouseDeltaX;
  351.     property MouseDeltaY: Double read FMouseDeltaX;
  352.   end;
  353.  
  354.   TBaseDragControlObject = class(TDragObject)
  355.   private
  356.     FControl: TControl;
  357.   protected
  358.     procedure EndDrag(Target: TObject; X, Y: Integer); virtual;
  359.     procedure Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); override;
  360.   public
  361.     constructor Create(AControl: TControl); virtual;
  362.     procedure Assign(Source: TDragObject); override;
  363.     property Control: TControl read FControl write FControl;
  364.   end;
  365.  
  366.   TDragControlObject = class(TBaseDragControlObject)
  367.   protected
  368.     function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
  369.     function GetDragImages: TDragImageList; override;
  370.   public
  371.     procedure HideDragImage; override;
  372.     procedure ShowDragImage; override;
  373.   end;
  374.  
  375.   TDragDockObject = class(TBaseDragControlObject)
  376.   private
  377.     FBrush: TBrush;
  378.     FDockRect: TRect;
  379.     FDropAlign: TAlign;
  380.     FDropOnControl: TControl;
  381.     FEraseDockRect: TRect;
  382.     FFloating: Boolean;
  383.     procedure SetBrush(Value: TBrush);
  384.   protected
  385.     procedure AdjustDockRect(ARect: TRect); virtual;
  386.     procedure DrawDragDockImage; virtual;
  387.     procedure EndDrag(Target: TObject; X, Y: Integer); override;
  388.     procedure EraseDragDockImage; virtual;
  389.     function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
  390.     function GetFrameWidth: Integer; virtual;
  391.   public
  392.     constructor Create(AControl: TControl); override;
  393.     destructor Destroy; override;
  394.     procedure Assign(Source: TDragObject); override;
  395.     property Brush: TBrush read FBrush write SetBrush;
  396.     property DockRect: TRect read FDockRect write FDockRect;
  397.     property DropAlign: TAlign read FDropAlign;
  398.     property DropOnControl: TControl read FDropOnControl;
  399.     property Floating: Boolean read FFloating write FFloating;
  400.     property FrameWidth: Integer read GetFrameWidth;
  401.   end;
  402.  
  403. { Controls }
  404.  
  405.   TControlCanvas = class(TCanvas)
  406.   private
  407.     FControl: TControl;
  408.     FDeviceContext: HDC;
  409.     FWindowHandle: HWnd;
  410.     procedure SetControl(AControl: TControl);
  411.   protected
  412.     procedure CreateHandle; override;
  413.   public
  414.     destructor Destroy; override;
  415.     procedure FreeHandle;
  416.     procedure UpdateTextFlags;
  417.     property Control: TControl read FControl write SetControl;
  418.   end;
  419.  
  420. { TControlActionLink }
  421.  
  422.   TControlActionLink = class(TActionLink)
  423.   protected
  424.     FClient: TControl;
  425.     procedure AssignClient(AClient: TObject); override;
  426.     function IsCaptionLinked: Boolean; override;
  427.     function IsEnabledLinked: Boolean; override;
  428.     function IsHintLinked: Boolean; override;
  429.     function IsVisibleLinked: Boolean; override;
  430.     function IsOnExecuteLinked: Boolean; override;
  431.     function DoShowHint(var HintStr: string): Boolean; virtual;
  432.     procedure SetCaption(const Value: string); override;
  433.     procedure SetEnabled(Value: Boolean); override;
  434.     procedure SetHint(const Value: string); override;
  435.     procedure SetVisible(Value: Boolean); override;
  436.     procedure SetOnExecute(Value: TNotifyEvent); override;
  437.   end;
  438.  
  439.   TControlActionLinkClass = class of TControlActionLink;
  440.  
  441. { TControl }
  442.  
  443.   TControlState = set of (csLButtonDown, csClicked, csPalette,
  444.     csReadingState, csAlignmentNeeded, csFocusing, csCreating,
  445.     csPaintCopy, csCustomPaint, csDestroyingHandle, csDocking);
  446.  
  447.   TControlStyle = set of (csAcceptsControls, csCaptureMouse,
  448.     csDesignInteractive, csClickEvents, csFramed, csSetCaption, csOpaque,
  449.     csDoubleClicks, csFixedWidth, csFixedHeight, csNoDesignVisible,
  450.     csReplicatable, csNoStdEvents, csDisplayDragImage, csReflector,
  451.     csActionClient, csMenuEvents);
  452.  
  453.   TMouseButton = (mbLeft, mbRight, mbMiddle);
  454.  
  455.   TDragMode = (dmManual, dmAutomatic);
  456.  
  457.   TDragState = (dsDragEnter, dsDragLeave, dsDragMove);
  458.  
  459.   TDragKind = (dkDrag, dkDock);
  460.  
  461.   TTabOrder = -1..32767;
  462.  
  463.   TCaption = type string;
  464.  
  465.   TDate = type TDateTime;
  466.  
  467.   TTime = type TDateTime;
  468.   {$EXTERNALSYM TDate}
  469.   {$EXTERNALSYM TTime}
  470.   (*$HPPEMIT 'namespace Controls'*)
  471.   (*$HPPEMIT '{'*)
  472.   (*$HPPEMIT '    typedef System::TDateTime TDate;'*)
  473.   (*$HPPEMIT '    typedef System::TDateTime TTime;'*)
  474.   (*$HPPEMIT '}'*)
  475.  
  476.  
  477.   TScalingFlags = set of (sfLeft, sfTop, sfWidth, sfHeight, sfFont);
  478.  
  479.   TAnchorKind = (akLeft, akTop, akRight, akBottom);
  480.   TAnchors = set of TAnchorKind;
  481.  
  482.   TConstraintSize = 0..MaxInt;
  483.  
  484.   TSizeConstraints = class(TPersistent)
  485.   private
  486.     FControl: TControl;
  487.     FMaxHeight: TConstraintSize;
  488.     FMaxWidth: TConstraintSize;
  489.     FMinHeight: TConstraintSize;
  490.     FMinWidth: TConstraintSize;
  491.     FOnChange: TNotifyEvent;
  492.     procedure SetConstraints(Index: Integer; Value: TConstraintSize);
  493.   protected
  494.     procedure Change; dynamic;
  495.     procedure AssignTo(Dest: TPersistent); override;
  496.     property Control: TControl read FControl;
  497.   public
  498.     constructor Create(Control: TControl); virtual;
  499.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  500.   published
  501.     property MaxHeight: TConstraintSize index 0 read FMaxHeight write SetConstraints default 0;
  502.     property MaxWidth: TConstraintSize index 1 read FMaxWidth write SetConstraints default 0;
  503.     property MinHeight: TConstraintSize index 2 read FMinHeight write SetConstraints default 0;
  504.     property MinWidth: TConstraintSize index 3 read FMinWidth write SetConstraints default 0;
  505.   end;
  506.  
  507.   TMouseEvent = procedure(Sender: TObject; Button: TMouseButton;
  508.     Shift: TShiftState; X, Y: Integer) of object;
  509.   TMouseMoveEvent = procedure(Sender: TObject; Shift: TShiftState;
  510.     X, Y: Integer) of object;
  511.   TKeyEvent = procedure(Sender: TObject; var Key: Word;
  512.     Shift: TShiftState) of object;
  513.   TKeyPressEvent = procedure(Sender: TObject; var Key: Char) of object;
  514.   TDragOverEvent = procedure(Sender, Source: TObject; X, Y: Integer;
  515.     State: TDragState; var Accept: Boolean) of object;
  516.   TDragDropEvent = procedure(Sender, Source: TObject;
  517.     X, Y: Integer) of object;
  518.   TStartDragEvent = procedure(Sender: TObject;
  519.     var DragObject: TDragObject) of object;
  520.   TEndDragEvent = procedure(Sender, Target: TObject;
  521.     X, Y: Integer) of object;
  522.   TDockDropEvent = procedure(Sender: TObject; Source: TDragDockObject;
  523.     X, Y: Integer) of object;
  524.   TDockOverEvent = procedure(Sender: TObject; Source: TDragDockObject;
  525.     X, Y: Integer; State: TDragState; var Accept: Boolean) of object;
  526.   TUnDockEvent = procedure(Sender: TObject; Client: TControl;
  527.     NewTarget: TWinControl; var Allow: Boolean) of object;
  528.   TStartDockEvent = procedure(Sender: TObject;
  529.     var DragObject: TDragDockObject) of object;
  530.   TGetSiteInfoEvent = procedure(Sender: TObject; DockClient: TControl;
  531.     var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean) of object;
  532.   TCanResizeEvent = procedure(Sender: TObject; var NewWidth, NewHeight: Integer;
  533.     var Resize: Boolean) of object;
  534.   TConstrainedResizeEvent = procedure(Sender: TObject; var MinWidth, MinHeight,
  535.     MaxWidth, MaxHeight: Integer) of object;
  536.   TMouseWheelEvent = procedure(Sender: TObject; Shift: TShiftState;
  537.     WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean) of object;
  538.   TMouseWheelUpDownEvent = procedure(Sender: TObject; Shift: TShiftState;
  539.     MousePos: TPoint; var Handled: Boolean) of object;
  540.   TContextPopupEvent = procedure(Sender: TObject; MousePos: TPoint; var Handled: Boolean) of object;
  541.  
  542.   TWndMethod = procedure(var Message: TMessage) of object;
  543.  
  544.   // TDockOrientation indicates how a zone's child zones are arranged.
  545.   // doNoOrient means a zone contains a TControl and not child zones.
  546.   // doHorizontal means a zone's children are stacked top-to-bottom.
  547.   // doVertical means a zone's children are arranged left-to-right.
  548.   TDockOrientation = (doNoOrient, doHorizontal, doVertical);
  549.  
  550.   TControl = class(TComponent)
  551.   private
  552.     FParent: TWinControl;
  553.     FWindowProc: TWndMethod;
  554.     FLeft: Integer;
  555.     FTop: Integer;
  556.     FWidth: Integer;
  557.     FHeight: Integer;
  558.     FControlStyle: TControlStyle;
  559.     FControlState: TControlState;
  560.     FDesktopFont: Boolean;
  561.     FVisible: Boolean;
  562.     FEnabled: Boolean;
  563.     FParentFont: Boolean;
  564.     FParentColor: Boolean;
  565.     FAlign: TAlign;
  566.     FAutoSize: Boolean;
  567.     FDragMode: TDragMode;
  568.     FIsControl: Boolean;
  569.     FBiDiMode: TBiDiMode;
  570.     FParentBiDiMode: Boolean;
  571.     FAnchors: TAnchors;
  572.     FAnchorMove: Boolean;
  573.     FText: PChar;
  574.     FFont: TFont;
  575.     FActionLink: TControlActionLink;
  576.     FColor: TColor;
  577.     FConstraints: TSizeConstraints;
  578.     FCursor: TCursor;
  579.     FDragCursor: TCursor;
  580.     FPopupMenu: TPopupMenu;
  581.     FHint: string;
  582.     FFontHeight: Integer;
  583.     FAnchorRules: TPoint;
  584.     FOriginalParentSize: TPoint;
  585.     FScalingFlags: TScalingFlags;
  586.     FShowHint: Boolean;
  587.     FParentShowHint: Boolean;
  588.     FDragKind: TDragKind;
  589.     FDockOrientation: TDockOrientation;
  590.     FHostDockSite: TWinControl;
  591.     FUndockWidth: Integer;
  592.     FUndockHeight: Integer;
  593.     FLRDockWidth: Integer;
  594.     FTBDockHeight: Integer;
  595.     FFloatingDockSiteClass: TWinControlClass;
  596.     FOnCanResize: TCanResizeEvent;
  597.     FOnConstrainedResize: TConstrainedResizeEvent;
  598.     FOnMouseDown: TMouseEvent;
  599.     FOnMouseMove: TMouseMoveEvent;
  600.     FOnMouseUp: TMouseEvent;
  601.     FOnDragDrop: TDragDropEvent;
  602.     FOnDragOver: TDragOverEvent;
  603.     FOnResize: TNotifyEvent;
  604.     FOnStartDock: TStartDockEvent;
  605.     FOnEndDock: TEndDragEvent;
  606.     FOnStartDrag: TStartDragEvent;
  607.     FOnEndDrag: TEndDragEvent;
  608.     FOnClick: TNotifyEvent;
  609.     FOnDblClick: TNotifyEvent;
  610.     FOnContextPopup: TContextPopupEvent;
  611.     procedure CalcDockSizes;
  612.     function CheckNewSize(var NewWidth, NewHeight: Integer): Boolean;
  613.     function CreateFloatingDockSite(Bounds: TRect): TWinControl;
  614.     procedure DoActionChange(Sender: TObject);
  615.     function DoCanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
  616.     function DoCanResize(var NewWidth, NewHeight: Integer): Boolean;
  617.     procedure DoConstraintsChange(Sender: TObject);
  618.     procedure DoConstrainedResize(var NewWidth, NewHeight: Integer);
  619.     procedure DoDragMsg(var DragMsg: TCMDrag);
  620.     procedure DoMouseDown(var Message: TWMMouse; Button: TMouseButton;
  621.       Shift: TShiftState);
  622.     procedure DoMouseUp(var Message: TWMMouse; Button: TMouseButton);
  623.     procedure FontChanged(Sender: TObject);
  624.     function GetAction: TBasicAction;
  625.     function GetBoundsRect: TRect;
  626.     function GetClientHeight: Integer;
  627.     function GetClientWidth: Integer;
  628.     function GetLRDockWidth: Integer;
  629.     function GetMouseCapture: Boolean;
  630.     function GetText: TCaption;
  631.     function GetTBDockHeight: Integer;
  632.     function GetUndockWidth: Integer;
  633.     function GetUndockHeight: Integer;
  634.     procedure InvalidateControl(IsVisible, IsOpaque: Boolean);
  635.     function IsAnchorsStored: Boolean;
  636.     function IsBiDiModeStored: Boolean;
  637.     function IsCaptionStored: Boolean;
  638.     function IsColorStored: Boolean;
  639.     function IsEnabledStored: Boolean;
  640.     function IsFontStored: Boolean;
  641.     function IsHintStored: Boolean;
  642.     function IsOnClickStored: Boolean;
  643.     function IsShowHintStored: Boolean;
  644.     function IsVisibleStored: Boolean;
  645.     procedure ReadIsControl(Reader: TReader);
  646.     procedure SetAnchors(Value: TAnchors);
  647.     procedure SetAction(Value: TBasicAction);
  648.     procedure SetAlign(Value: TAlign);
  649.     procedure SetAutoSize(Value: Boolean);
  650.     procedure SetBoundsRect(const Rect: TRect);
  651.     procedure SetClientHeight(Value: Integer);
  652.     procedure SetClientSize(Value: TPoint);
  653.     procedure SetClientWidth(Value: Integer);
  654.     procedure SetColor(Value: TColor);
  655.     procedure SetCursor(Value: TCursor);
  656.     procedure SetDesktopFont(Value: Boolean);
  657.     procedure SetFont(Value: TFont);
  658.     procedure SetHeight(Value: Integer);
  659.     procedure SetHostDockSite(Value: TWinControl);
  660.     procedure SetLeft(Value: Integer);
  661.     procedure SetMouseCapture(Value: Boolean);
  662.     procedure SetParentColor(Value: Boolean);
  663.     procedure SetParentFont(Value: Boolean);
  664.     procedure SetShowHint(Value: Boolean);
  665.     procedure SetParentShowHint(Value: Boolean);
  666.     procedure SetPopupMenu(Value: TPopupMenu);
  667.     procedure SetText(const Value: TCaption);
  668.     procedure SetTop(Value: Integer);
  669.     procedure SetVisible(Value: Boolean);
  670.     procedure SetWidth(Value: Integer);
  671.     procedure SetZOrderPosition(Position: Integer);
  672.     procedure UpdateAnchorRules;
  673.     procedure WriteIsControl(Writer: TWriter);
  674.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  675.     procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  676.     procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
  677.     procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN;
  678.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  679.     procedure WMRButtonDblClk(var Message: TWMRButtonDblClk); message WM_RBUTTONDBLCLK;
  680.     procedure WMMButtonDblClk(var Message: TWMMButtonDblClk); message WM_MBUTTONDBLCLK;
  681.     procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
  682.     procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  683.     procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
  684.     procedure WMMButtonUp(var Message: TWMMButtonUp); message WM_MBUTTONUP;
  685.     procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;
  686.     procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
  687.     procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
  688.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  689.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  690.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  691.     procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
  692.     procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED;
  693.     procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
  694.     procedure CMParentShowHintChanged(var Message: TMessage); message CM_PARENTSHOWHINTCHANGED;
  695.     procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
  696.     procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
  697.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  698.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  699.     procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
  700.     procedure CMFloat(var Message: TCMFloat); message CM_FLOAT;
  701.     procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
  702.     procedure CMParentBiDiModeChanged(var Message: TMessage); message CM_PARENTBIDIMODECHANGED;
  703.     procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
  704.   protected
  705.     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
  706.     procedure AdjustSize; dynamic;
  707.     procedure AssignTo(Dest: TPersistent); override;
  708.     procedure BeginAutoDrag; dynamic;
  709.     function CanResize(var NewWidth, NewHeight: Integer): Boolean; virtual;
  710.     function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; virtual;
  711.     procedure Changed;
  712.     procedure ChangeScale(M, D: Integer); dynamic;
  713.     procedure Click; dynamic;
  714.     procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); virtual;
  715.     procedure DblClick; dynamic;
  716.     procedure DefaultDockImage(DragDockObject: TDragDockObject; Erase: Boolean); dynamic;
  717.     procedure DefineProperties(Filer: TFiler); override;
  718.     procedure DockTrackNoTarget(Source: TDragDockObject; X, Y: Integer); dynamic;
  719.     procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); dynamic;
  720.     procedure DoEndDock(Target: TObject; X, Y: Integer); dynamic;
  721.     procedure DoDock(NewDockSite: TWinControl; var ARect: TRect); dynamic;
  722.     procedure DoStartDock(var DragObject: TDragObject); dynamic;
  723.     procedure DragCanceled; dynamic;
  724.     procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
  725.       var Accept: Boolean); dynamic;
  726.     procedure DoEndDrag(Target: TObject; X, Y: Integer); dynamic;
  727.     procedure DoStartDrag(var DragObject: TDragObject); dynamic;
  728.     procedure DrawDragDockImage(DragDockObject: TDragDockObject); dynamic;
  729.     procedure EraseDragDockImage(DragDockObject: TDragDockObject); dynamic;
  730.     function GetActionLinkClass: TControlActionLinkClass; dynamic;
  731.     function GetClientOrigin: TPoint; virtual;
  732.     function GetClientRect: TRect; virtual;
  733.     function GetDeviceContext(var WindowHandle: HWnd): HDC; virtual;
  734.     function GetDockEdge(MousePos: TPoint): TAlign; dynamic;
  735.     function GetDragImages: TDragImageList; virtual;
  736.     function GetEnabled: Boolean; virtual;
  737.     function GetFloating: Boolean; virtual;
  738.     function GetFloatingDockSiteClass: TWinControlClass; virtual;
  739.     function GetPalette: HPALETTE; dynamic;
  740.     function GetPopupMenu: TPopupMenu; dynamic;
  741.     procedure Loaded; override;
  742.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  743.       X, Y: Integer); dynamic;
  744.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
  745.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  746.       X, Y: Integer); dynamic;
  747.     procedure Notification(AComponent: TComponent;
  748.       Operation: TOperation); override;
  749.     procedure PositionDockRect(DragDockObject: TDragDockObject); dynamic;
  750.     function PaletteChanged(Foreground: Boolean): Boolean; dynamic;
  751.     procedure ReadState(Reader: TReader); override;
  752.     procedure RequestAlign; dynamic;
  753.     procedure Resize; dynamic;
  754.     procedure SendCancelMode(Sender: TControl);
  755.     procedure SendDockNotification(Msg: Cardinal; WParam, LParam: Integer);
  756.     procedure SetDragMode(Value: TDragMode); virtual;
  757.     procedure SetEnabled(Value: Boolean); virtual;
  758.     procedure SetName(const Value: TComponentName); override;
  759.     procedure SetParent(AParent: TWinControl); virtual;
  760.     procedure SetParentComponent(Value: TComponent); override;
  761.     procedure SetParentBiDiMode(Value: Boolean); virtual;
  762.     procedure SetBiDiMode(Value: TBiDiMode); virtual;
  763.     procedure SetZOrder(TopMost: Boolean); dynamic;
  764.     procedure UpdateBoundsRect(const R: TRect);
  765.     procedure VisibleChanging; dynamic;
  766.     procedure WndProc(var Message: TMessage); virtual;
  767.     property ActionLink: TControlActionLink read FActionLink write FActionLink;
  768.     property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
  769.     property Caption: TCaption read GetText write SetText stored IsCaptionStored;
  770.     property Color: TColor read FColor write SetColor stored IsColorStored default clWindow;
  771.     property DesktopFont: Boolean read FDesktopFont write SetDesktopFont default False;
  772.     property DragKind: TDragKind read FDragKind write FDragKind default dkDrag;
  773.     property DragCursor: TCursor read FDragCursor write FDragCursor default crDrag;
  774.     property DragMode: TDragMode read FDragMode write SetDragMode default dmManual;
  775.     property Font: TFont read FFont write SetFont stored IsFontStored;
  776.     property IsControl: Boolean read FIsControl write FIsControl;
  777.     property MouseCapture: Boolean read GetMouseCapture write SetMouseCapture;
  778.     property ParentBiDiMode: Boolean read FParentBiDiMode write SetParentBiDiMode default True;
  779.     property ParentColor: Boolean read FParentColor write SetParentColor default True;
  780.     property ParentFont: Boolean read FParentFont write SetParentFont default True;
  781.     property ParentShowHint: Boolean read FParentShowHint write SetParentShowHint default True;
  782.     property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
  783.     property ScalingFlags: TScalingFlags read FScalingFlags write FScalingFlags;
  784.     property Text: TCaption read GetText write SetText;
  785.     property WindowText: PChar read FText write FText;
  786.     property OnCanResize: TCanResizeEvent read FOnCanResize write FOnCanResize;
  787.     property OnClick: TNotifyEvent read FOnClick write FOnClick stored IsOnClickStored;
  788.     property OnConstrainedResize: TConstrainedResizeEvent read FOnConstrainedResize write FOnConstrainedResize;
  789.     property OnContextPopup: TContextPopupEvent read FOnContextPopup write FOnContextPopup;
  790.     property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
  791.     property OnDragDrop: TDragDropEvent read FOnDragDrop write FOnDragDrop;
  792.     property OnDragOver: TDragOverEvent read FOnDragOver write FOnDragOver;
  793.     property OnEndDock: TEndDragEvent read FOnEndDock write FOnEndDock;
  794.     property OnEndDrag: TEndDragEvent read FOnEndDrag write FOnEndDrag;
  795.     property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
  796.     property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
  797.     property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
  798.     property OnResize: TNotifyEvent read FOnResize write FOnResize;
  799.     property OnStartDock: TStartDockEvent read FOnStartDock write FOnStartDock;
  800.     property OnStartDrag: TStartDragEvent read FOnStartDrag write FOnStartDrag;
  801.   public
  802.     constructor Create(AOwner: TComponent); override;
  803.     destructor Destroy; override;
  804.     procedure BeginDrag(Immediate: Boolean; Threshold: Integer = -1);
  805.     procedure BringToFront;
  806.     function ClientToScreen(const Point: TPoint): TPoint;
  807.     procedure Dock(NewDockSite: TWinControl; ARect: TRect); dynamic;
  808.     procedure DefaultHandler(var Message); override;
  809.     function Dragging: Boolean;
  810.     procedure DragDrop(Source: TObject; X, Y: Integer); dynamic;
  811.     function DrawTextBiDiModeFlags(Flags: Longint): Longint;
  812.     function DrawTextBiDiModeFlagsReadingOnly: Longint;
  813.     property Enabled: Boolean read GetEnabled write SetEnabled stored IsEnabledStored default True;
  814.     procedure EndDrag(Drop: Boolean);
  815.     function GetControlsAlignment: TAlignment; dynamic;
  816.     function GetParentComponent: TComponent; override;
  817.     function GetTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  818.     function GetTextLen: Integer;
  819.     function HasParent: Boolean; override;
  820.     procedure Hide;
  821.     procedure InitiateAction; virtual;
  822.     procedure Invalidate; virtual;
  823.     function IsRightToLeft: Boolean;
  824.     function ManualDock(NewDockSite: TWinControl; DropControl: TControl = nil;
  825.       ControlSide: TAlign = alNone): Boolean;
  826.     function ManualFloat(ScreenPos: TRect): Boolean;
  827.     function Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
  828.     procedure Refresh;
  829.     procedure Repaint; virtual;
  830.     function ReplaceDockedControl(Control: TControl; NewDockSite: TWinControl;
  831.       DropControl: TControl; ControlSide: TAlign): Boolean;
  832.     function ScreenToClient(const Point: TPoint): TPoint;
  833.     procedure SendToBack;
  834.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); virtual;
  835.     procedure SetTextBuf(Buffer: PChar);
  836.     procedure Show;
  837.     procedure Update; virtual;
  838.     function UseRightToLeftAlignment: Boolean; dynamic;
  839.     function UseRightToLeftReading: Boolean;
  840.     function UseRightToLeftScrollBar: Boolean;
  841.     property Action: TBasicAction read GetAction write SetAction;
  842.     property Align: TAlign read FAlign write SetAlign default alNone;
  843.     property Anchors: TAnchors read FAnchors write SetAnchors stored IsAnchorsStored default [akLeft, akTop];
  844.     property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored;
  845.     property BoundsRect: TRect read GetBoundsRect write SetBoundsRect;
  846.     property ClientHeight: Integer read GetClientHeight write SetClientHeight stored False;
  847.     property ClientOrigin: TPoint read GetClientOrigin;
  848.     property ClientRect: TRect read GetClientRect;
  849.     property ClientWidth: Integer read GetClientWidth write SetClientWidth stored False;
  850.     property Constraints: TSizeConstraints read FConstraints write FConstraints;
  851.     property ControlState: TControlState read FControlState write FControlState;
  852.     property ControlStyle: TControlStyle read FControlStyle write FControlStyle;
  853.     property DockOrientation: TDockOrientation read FDockOrientation write FDockOrientation;
  854.     property Floating: Boolean read GetFloating;
  855.     property FloatingDockSiteClass: TWinControlClass read GetFloatingDockSiteClass write FFloatingDockSiteClass;
  856.     property HostDockSite: TWinControl read FHostDockSite write SetHostDockSite;
  857.     property LRDockWidth: Integer read GetLRDockWidth write FLRDockWidth;
  858.     property Parent: TWinControl read FParent write SetParent;
  859.     property ShowHint: Boolean read FShowHint write SetShowHint stored IsShowHintStored;
  860.     property TBDockHeight: Integer read GetTBDockHeight write FTBDockHeight;
  861.     property UndockHeight: Integer read GetUndockHeight write FUndockHeight;
  862.     property UndockWidth: Integer read GetUndockWidth write FUndockWidth;
  863.     property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default True;
  864.     property WindowProc: TWndMethod read FWindowProc write FWindowProc;
  865.   published
  866.     property Left: Integer read FLeft write SetLeft;
  867.     property Top: Integer read FTop write SetTop;
  868.     property Width: Integer read FWidth write SetWidth;
  869.     property Height: Integer read FHeight write SetHeight;
  870.     property Cursor: TCursor read FCursor write SetCursor default crDefault;
  871.     property Hint: string read FHint write FHint stored IsHintStored;
  872.   end;
  873.  
  874.   TControlClass = class of TControl;
  875.  
  876.   TCreateParams = record
  877.     Caption: PChar;
  878.     Style: DWORD;
  879.     ExStyle: DWORD;
  880.     X, Y: Integer;
  881.     Width, Height: Integer;
  882.     WndParent: HWnd;
  883.     Param: Pointer;
  884.     WindowClass: TWndClass;
  885.     WinClassName: array[0..63] of Char;
  886.   end;
  887.  
  888. { TWinControlActionLink }
  889.  
  890.   TWinControlActionLink = class(TControlActionLink)
  891.   protected
  892.     FClient: TWinControl;
  893.     procedure AssignClient(AClient: TObject); override;
  894.     function IsHelpContextLinked: Boolean; override;
  895.     procedure SetHelpContext(Value: THelpContext); override;
  896.   end;
  897.  
  898.   TWinControlActionLinkClass = class of TWinControlActionLink;
  899.  
  900. { TWinControl }
  901.  
  902.   TImeMode = (imDisable, imClose, imOpen, imDontCare,
  903.               imSAlpha, imAlpha, imHira, imSKata, imKata,
  904.               imChinese, imSHanguel, imHanguel);
  905.   TImeName = type string;
  906.  
  907.   TBorderWidth = 0..MaxInt;
  908.  
  909.   TBevelCut = (bvNone, bvLowered, bvRaised, bvSpace);
  910.   TBevelEdge = (beLeft, beTop, beRight, beBottom);
  911.   TBevelEdges = set of TBevelEdge;
  912.   TBevelKind = (bkNone, bkTile, bkSoft, bkFlat);
  913.   TBevelWidth = 1..MaxInt;
  914.  
  915.   // IDockManager defines an interface for managing a dock site's docked
  916.   // controls. The default VCL implementation of IDockManager is TDockTree.
  917.   IDockManager = interface
  918.     ['{8619FD79-C281-11D1-AA60-00C04FA370E8}']
  919.     procedure BeginUpdate;
  920.     procedure EndUpdate;
  921.     procedure GetControlBounds(Control: TControl; out CtlBounds: TRect);
  922.     procedure InsertControl(Control: TControl; InsertAt: TAlign;
  923.       DropCtl: TControl);
  924.     procedure LoadFromStream(Stream: TStream);
  925.     procedure PaintSite(DC: HDC);
  926.     procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign;
  927.       var DockRect: TRect);
  928.     procedure RemoveControl(Control: TControl);
  929.     procedure ResetBounds(Force: Boolean);
  930.     procedure SaveToStream(Stream: TStream);
  931.     procedure SetReplacingControl(Control: TControl);
  932.   end;
  933.  
  934.   TWinControl = class(TControl)
  935.   private
  936.     FAlignLevel: Word;
  937.     FBevelEdges: TBevelEdges;
  938.     FBevelInner: TBevelCut;
  939.     FBevelOuter: TBevelCut;
  940.     FBevelKind: TBevelKind;
  941.     FBevelWidth: TBevelWidth;
  942.     FBorderWidth: TBorderWidth;
  943.     FBrush: TBrush;
  944.     FControls: TList;
  945.     FCtl3D: Boolean;
  946.     FDefWndProc: Pointer;
  947.     FDockClients: TList;
  948.     FDockSite: Boolean;
  949.     FDockManager: IDockManager;
  950.     FHandle: HWnd;
  951.     FHelpContext: THelpContext;
  952.     FImeMode: TImeMode;
  953.     FImeName: TImeName;
  954.     FObjectInstance: Pointer;
  955.     FParentCtl3D: Boolean;
  956.     FParentWindow: HWnd;
  957.     FShowing: Boolean;
  958.     FTabList: TList;
  959.     FTabOrder: Integer;
  960.     FTabStop: Boolean;
  961.     FWheelAccumulator: Integer;
  962.     FUseDockManager: Boolean;
  963.     FWinControls: TList;
  964.     FOnDockDrop: TDockDropEvent;
  965.     FOnDockOver: TDockOverEvent;
  966.     FOnEnter: TNotifyEvent;
  967.     FOnExit: TNotifyEvent;
  968.     FOnGetSiteInfo: TGetSiteInfoEvent;
  969.     FOnKeyDown: TKeyEvent;
  970.     FOnKeyPress: TKeyPressEvent;
  971.     FOnKeyUp: TKeyEvent;
  972.     FOnMouseWheel: TMouseWheelEvent;
  973.     FOnMouseWheelDown: TMouseWheelUpDownEvent;
  974.     FOnMouseWheelUp: TMouseWheelUpDownEvent;
  975.     FOnUnDock: TUnDockEvent;
  976.     procedure AlignControl(AControl: TControl);
  977.     procedure CalcConstraints(var MinWidth, MinHeight, MaxWidth,
  978.       MaxHeight: Integer);
  979.     function GetControl(Index: Integer): TControl;
  980.     function GetControlCount: Integer;
  981.     function GetDockClientCount: Integer;
  982.     function GetDockClients(Index: Integer): TControl;
  983.     function GetHandle: HWnd;
  984.     function GetTabOrder: TTabOrder;
  985.     function GetVisibleDockClientCount: Integer;
  986.     procedure Insert(AControl: TControl);
  987.     procedure InvalidateFrame;
  988.     function IsCtl3DStored: Boolean;
  989.     function IsHelpContextStored: Boolean;
  990.     function PrecedingWindow(Control: TWinControl): HWnd;
  991.     procedure Remove(AControl: TControl);
  992.     procedure RemoveFocus(Removing: Boolean);
  993.     procedure SetBevelCut(Index: Integer; const Value: TBevelCut);
  994.     procedure SetBevelEdges(const Value: TBevelEdges);
  995.     procedure SetBevelKind(const Value: TBevelKind);
  996.     procedure SetBevelWidth(const Value: TBevelWidth);
  997.     procedure SetBorderWidth(Value: TBorderWidth);
  998.     procedure SetCtl3D(Value: Boolean);
  999.     procedure SetDockSite(Value: Boolean);
  1000.     procedure SetParentCtl3D(Value: Boolean);
  1001.     procedure SetParentWindow(Value: HWnd);
  1002.     procedure SetTabOrder(Value: TTabOrder);
  1003.     procedure SetTabStop(Value: Boolean);
  1004.     procedure SetUseDockManager(Value: Boolean);
  1005.     procedure SetZOrderPosition(Position: Integer);
  1006.     procedure UpdateTabOrder(Value: TTabOrder);
  1007.     procedure UpdateBounds;
  1008.     procedure UpdateShowing;
  1009.     function IsMenuKey(var Message: TWMKey): Boolean;
  1010.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  1011.     procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
  1012.     procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
  1013.     procedure WMSysColorChange(var Message: TWMSysColorChange); message WM_SYSCOLORCHANGE;
  1014.     procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
  1015.     procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  1016.     procedure WMCompareItem(var Message: TWMCompareItem); message WM_COMPAREITEM;
  1017.     procedure WMDeleteItem(var Message: TWMDeleteItem); message WM_DELETEITEM;
  1018.     procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
  1019.     procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM;
  1020.     procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
  1021.     procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
  1022.     procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
  1023.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  1024.     procedure WMMove(var Message: TWMMove); message WM_MOVE;
  1025.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  1026.     procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
  1027.     procedure WMSysKeyDown(var Message: TWMKeyDown); message WM_SYSKEYDOWN;
  1028.     procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
  1029.     procedure WMSysKeyUp(var Message: TWMKeyUp); message WM_SYSKEYUP;
  1030.     procedure WMChar(var Message: TWMChar); message WM_CHAR;
  1031.     procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  1032.     procedure WMCharToItem(var Message: TWMCharToItem); message WM_CHARTOITEM;
  1033.     procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY;
  1034.     procedure WMVKeyToItem(var Message: TWMVKeyToItem); message WM_VKEYTOITEM;
  1035.     procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
  1036.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  1037.     procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
  1038.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  1039.     procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  1040.     procedure WMQueryNewPalette(var Message: TMessage); message WM_QUERYNEWPALETTE;
  1041.     procedure WMPaletteChanged(var Message: TMessage); message WM_PALETTECHANGED;
  1042.     procedure WMWinIniChange(var Message: TMessage); message WM_WININICHANGE;
  1043.     procedure WMFontChange(var Message: TMessage); message WM_FONTCHANGE;
  1044.     procedure WMTimeChange(var Message: TMessage); message WM_TIMECHANGE;
  1045.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  1046.     procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;
  1047.     procedure WMIMEStartComp(var Message: TMessage); message WM_IME_STARTCOMPOSITION;
  1048.     procedure WMIMEEndComp(var Message: TMessage); message WM_IME_ENDCOMPOSITION;
  1049.     procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
  1050.     procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU;
  1051.     procedure CMChanged(var Message: TMessage); message CM_CHANGED;
  1052.     procedure CMChildKey(var Message: TMessage); message CM_CHILDKEY;
  1053.     procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
  1054.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  1055.     procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
  1056.     procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
  1057.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  1058.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  1059.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  1060.     procedure CMBorderChanged(var Message: TMessage); message CM_BORDERCHANGED;
  1061.     procedure CMCursorChanged(var Message: TMessage); message CM_CURSORCHANGED;
  1062.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  1063.     procedure CMParentCtl3DChanged(var Message: TMessage); message CM_PARENTCTL3DCHANGED;
  1064.     procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
  1065.     procedure CMShowHintChanged(var Message: TMessage); message CM_SHOWHINTCHANGED;
  1066.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  1067.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  1068.     procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
  1069.     procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
  1070.     procedure CMSysFontChanged(var Message: TMessage); message CM_SYSFONTCHANGED;
  1071.     procedure CMWinIniChange(var Message: TWMWinIniChange); message CM_WININICHANGE;
  1072.     procedure CMFontChange(var Message: TMessage); message CM_FONTCHANGE;
  1073.     procedure CMTimeChange(var Message: TMessage); message CM_TIMECHANGE;
  1074.     procedure CMDrag(var Message: TCMDrag); message CM_DRAG;
  1075.     procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
  1076.     procedure CNKeyUp(var Message: TWMKeyUp); message CN_KEYUP;
  1077.     procedure CNChar(var Message: TWMChar); message CN_CHAR;
  1078.     procedure CNSysKeyDown(var Message: TWMKeyDown); message CN_SYSKEYDOWN;
  1079.     procedure CNSysChar(var Message: TWMChar); message CN_SYSCHAR;
  1080.     procedure CMControlListChange(var Message: TMessage); message CM_CONTROLLISTCHANGE;
  1081.     procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND;
  1082.     procedure CMInvalidate(var Message: TMessage); message CM_INVALIDATE;
  1083.     procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT;
  1084.     procedure CMUnDockClient(var Message: TCMUnDockClient); message CM_UNDOCKCLIENT;
  1085.     procedure CMFloat(var Message: TCMFloat); message CM_FLOAT;
  1086.     procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
  1087.     procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL;
  1088.   protected
  1089.     FDoubleBuffered: Boolean;
  1090.     FInImeComposition: Boolean;
  1091.     procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
  1092.     procedure AddBiDiModeExStyle(var ExStyle: DWORD);
  1093.     procedure AssignTo(Dest: TPersistent); override;
  1094.     procedure AdjustClientRect(var Rect: TRect); virtual;
  1095.     procedure AdjustSize; override;
  1096.     procedure AlignControls(AControl: TControl; var Rect: TRect); virtual;
  1097.     function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
  1098.     function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
  1099.     procedure ChangeScale(M, D: Integer); override;
  1100.     procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth,
  1101.       MaxHeight: Integer); override;
  1102.     function CreateDockManager: IDockManager; dynamic;
  1103.     procedure CreateHandle; virtual;
  1104.     procedure CreateParams(var Params: TCreateParams); virtual;
  1105.     procedure CreateSubClass(var Params: TCreateParams;
  1106.       ControlClassName: PChar);
  1107.     procedure CreateWindowHandle(const Params: TCreateParams); virtual;
  1108.     procedure CreateWnd; virtual;
  1109.     procedure DestroyHandle;
  1110.     procedure DestroyWindowHandle; virtual;
  1111.     procedure DestroyWnd; virtual;
  1112.     procedure DoAddDockClient(Client: TControl; const ARect: TRect); dynamic;
  1113.     procedure DockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState;
  1114.       var Accept: Boolean); dynamic;
  1115.     procedure DoDockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState;
  1116.       var Accept: Boolean); dynamic;
  1117.     procedure DoEnter; dynamic;
  1118.     procedure DoExit; dynamic;
  1119.     procedure DoFlipChildren; dynamic;
  1120.     function DoKeyDown(var Message: TWMKey): Boolean;
  1121.     function DoKeyPress(var Message: TWMKey): Boolean;
  1122.     function DoKeyUp(var Message: TWMKey): Boolean;
  1123.     function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  1124.       MousePos: TPoint): Boolean; dynamic;
  1125.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; dynamic;
  1126.     function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; dynamic;
  1127.     procedure DoRemoveDockClient(Client: TControl); dynamic;
  1128.     function DoUnDock(NewTarget: TWinControl; Client: TControl): Boolean; dynamic;
  1129.     function FindNextControl(CurControl: TWinControl;
  1130.       GoForward, CheckTabStop, CheckParent: Boolean): TWinControl;
  1131.     procedure FixupTabList;
  1132.     function GetActionLinkClass: TControlActionLinkClass; override;
  1133.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  1134.     function GetClientOrigin: TPoint; override;
  1135.     function GetClientRect: TRect; override;
  1136.     function GetControlExtents: TRect; virtual;
  1137.     function GetDeviceContext(var WindowHandle: HWnd): HDC; override;
  1138.     function GetParentHandle: HWnd;
  1139.     procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
  1140.       MousePos: TPoint; var CanDock: Boolean); dynamic;
  1141.     function GetTopParentHandle: HWnd;
  1142.     function IsControlMouseMsg(var Message: TWMMouse): Boolean;
  1143.     procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic;
  1144.     procedure KeyUp(var Key: Word; Shift: TShiftState); dynamic;
  1145.     procedure KeyPress(var Key: Char); dynamic;
  1146.     procedure MainWndProc(var Message: TMessage);
  1147.     procedure NotifyControls(Msg: Word);
  1148.     procedure PaintControls(DC: HDC; First: TControl);
  1149.     procedure PaintHandler(var Message: TWMPaint);
  1150.     procedure PaintWindow(DC: HDC); virtual;
  1151.     function PaletteChanged(Foreground: Boolean): Boolean; override;
  1152.     procedure ReadState(Reader: TReader); override;
  1153.     procedure RecreateWnd;
  1154.     procedure ReloadDockedControl(const AControlName: string;
  1155.       var AControl: TControl); dynamic;
  1156.     procedure ResetIme;
  1157.     function ResetImeComposition(Action: DWORD): Boolean;
  1158.     procedure ScaleControls(M, D: Integer);
  1159.     procedure SelectFirst;
  1160.     procedure SelectNext(CurControl: TWinControl;
  1161.       GoForward, CheckTabStop: Boolean);
  1162.     procedure SetChildOrder(Child: TComponent; Order: Integer); override;
  1163.     procedure SetIme;
  1164.     function SetImeCompositionWindow(Font: TFont; XPos, YPos: Integer): Boolean;
  1165.     procedure SetZOrder(TopMost: Boolean); override;
  1166.     procedure ShowControl(AControl: TControl); virtual;
  1167.     procedure WndProc(var Message: TMessage); override;
  1168.     property BevelEdges: TBevelEdges read FBevelEdges write SetBevelEdges default [beLeft, beTop, beRight, beBottom];
  1169.     property BevelInner: TBevelCut index 0 read FBevelInner write SetBevelCut default bvRaised;
  1170.     property BevelOuter: TBevelCut index 1 read FBevelOuter write SetBevelCut default bvLowered;
  1171.     property BevelKind: TBevelKind read FBevelKind write SetBevelKind default bkNone;
  1172.     property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
  1173.     property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0;
  1174.     property Ctl3D: Boolean read FCtl3D write SetCtl3D stored IsCtl3DStored;
  1175.     property DefWndProc: Pointer read FDefWndProc write FDefWndProc;
  1176.     property DockSite: Boolean read FDockSite write SetDockSite default False;
  1177.     property DockManager: IDockManager read FDockManager write FDockManager;
  1178.     property ImeMode: TImeMode read FImeMode write FImeMode default imDontCare;
  1179.     property ImeName: TImeName read FImeName write FImeName;
  1180.     property ParentCtl3D: Boolean read FParentCtl3D write SetParentCtl3D default True;
  1181.     property UseDockManager: Boolean read FUseDockManager write SetUseDockManager
  1182.       default False;
  1183.     property WheelAccumulator: Integer read FWheelAccumulator write FWheelAccumulator;
  1184.     property WindowHandle: HWnd read FHandle write FHandle;
  1185.     property OnDockDrop: TDockDropEvent read FOnDockDrop write FOnDockDrop;
  1186.     property OnDockOver: TDockOverEvent read FOnDockOver write FOnDockOver;
  1187.     property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
  1188.     property OnExit: TNotifyEvent read FOnExit write FOnExit;
  1189.     property OnGetSiteInfo: TGetSiteInfoEvent read FOnGetSiteInfo write FOnGetSiteInfo;
  1190.     property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
  1191.     property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
  1192.     property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
  1193.     property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
  1194.     property OnMouseWheelDown: TMouseWheelUpDownEvent read FOnMouseWheelDown
  1195.       write FOnMouseWheelDown;
  1196.     property OnMouseWheelUp: TMouseWheelUpDownEvent read FOnMouseWheelUp write
  1197.       FOnMouseWheelUp;
  1198.     property OnUnDock: TUnDockEvent read FOnUnDock write FOnUnDock;
  1199.   public
  1200.     constructor Create(AOwner: TComponent); override;
  1201.     constructor CreateParented(ParentWindow: HWnd);
  1202.     class function CreateParentedControl(ParentWindow: HWnd): TWinControl;
  1203.     destructor Destroy; override;
  1204.     procedure Broadcast(var Message);
  1205.     function CanFocus: Boolean; dynamic;
  1206.     function ContainsControl(Control: TControl): Boolean;
  1207.     function ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean;
  1208.       AllowWinControls: Boolean = False): TControl;
  1209.     procedure DefaultHandler(var Message); override;
  1210.     procedure DisableAlign;
  1211.     property DockClientCount: Integer read GetDockClientCount;
  1212.     property DockClients[Index: Integer]: TControl read GetDockClients;
  1213.     procedure DockDrop(Source: TDragDockObject; X, Y: Integer); dynamic;
  1214.     property DoubleBuffered: Boolean read FDoubleBuffered write FDoubleBuffered;
  1215.     procedure EnableAlign;
  1216.     function FindChildControl(const ControlName: string): TControl;
  1217.     procedure FlipChildren(AllLevels: Boolean); dynamic;
  1218.     function Focused: Boolean; dynamic;
  1219.     procedure GetTabOrderList(List: TList); dynamic;
  1220.     function HandleAllocated: Boolean;
  1221.     procedure HandleNeeded;
  1222.     procedure InsertControl(AControl: TControl);
  1223.     procedure Invalidate; override;
  1224.     procedure MouseWheelHandler(var Message: TMessage); dynamic;
  1225.     procedure PaintTo(DC: HDC; X, Y: Integer);
  1226.     procedure RemoveControl(AControl: TControl);
  1227.     procedure Realign;
  1228.     procedure Repaint; override;
  1229.     procedure ScaleBy(M, D: Integer);
  1230.     procedure ScrollBy(DeltaX, DeltaY: Integer);
  1231.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  1232.     procedure SetFocus; virtual;
  1233.     procedure Update; override;
  1234.     procedure UpdateControlState;
  1235.     property VisibleDockClientCount: Integer read GetVisibleDockClientCount;
  1236.     property Brush: TBrush read FBrush;
  1237.     property Controls[Index: Integer]: TControl read GetControl;
  1238.     property ControlCount: Integer read GetControlCount;
  1239.     property Handle: HWnd read GetHandle;
  1240.     property ParentWindow: HWnd read FParentWindow write SetParentWindow;
  1241.     property Showing: Boolean read FShowing;
  1242.     property TabOrder: TTabOrder read GetTabOrder write SetTabOrder default -1;
  1243.     property TabStop: Boolean read FTabStop write SetTabStop default False;
  1244.   published
  1245.     property HelpContext: THelpContext read FHelpContext write FHelpContext stored IsHelpContextStored default 0;
  1246.   end;
  1247.  
  1248.   TGraphicControl = class(TControl)
  1249.   private
  1250.     FCanvas: TCanvas;
  1251.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  1252.   protected
  1253.     procedure Paint; virtual;
  1254.     property Canvas: TCanvas read FCanvas;
  1255.   public
  1256.     constructor Create(AOwner: TComponent); override;
  1257.     destructor Destroy; override;
  1258.   end;
  1259.  
  1260.   TCustomControl = class(TWinControl)
  1261.   private
  1262.     FCanvas: TCanvas;
  1263.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  1264.   protected
  1265.     procedure Paint; virtual;
  1266.     procedure PaintWindow(DC: HDC); override;
  1267.     property Canvas: TCanvas read FCanvas;
  1268.   public
  1269.     constructor Create(AOwner: TComponent); override;
  1270.     destructor Destroy; override;
  1271.   end;
  1272.  
  1273.   THintWindow = class(TCustomControl)
  1274.   private
  1275.     FActivating: Boolean;
  1276.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  1277.     procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  1278.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  1279.   protected
  1280.     procedure CreateParams(var Params: TCreateParams); override;
  1281.     procedure Paint; override;
  1282.   public
  1283.     constructor Create(AOwner: TComponent); override;
  1284.     procedure ActivateHint(Rect: TRect; const AHint: string); virtual;
  1285.     procedure ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer); virtual;
  1286.     function CalcHintRect(MaxWidth: Integer; const AHint: string;
  1287.       AData: Pointer): TRect; virtual;
  1288.     function IsHintMsg(var Msg: TMsg): Boolean; virtual;
  1289.     procedure ReleaseHandle;
  1290.     property BiDiMode;
  1291.     property Caption;
  1292.     property Color;
  1293.     property Canvas;
  1294.     property Font;
  1295.   end;
  1296.  
  1297.   THintWindowClass = class of THintWindow;
  1298.  
  1299. { TDragImageList }
  1300.  
  1301.   TDragImageList = class(TCustomImageList)
  1302.   private
  1303.     FDragCursor: TCursor;
  1304.     FDragging: Boolean;
  1305.     FDragHandle: HWND;
  1306.     FDragHotspot: TPoint;
  1307.     FDragIndex: Integer;
  1308.     procedure CombineDragCursor;
  1309.     procedure SetDragCursor(Value: TCursor);
  1310.   protected
  1311.     procedure Initialize; override;
  1312.   public
  1313.     function BeginDrag(Window: HWND; X, Y: Integer): Boolean;
  1314.     function DragLock(Window: HWND; XPos, YPos: Integer): Boolean;
  1315.     function DragMove(X, Y: Integer): Boolean;
  1316.     procedure DragUnlock;
  1317.     function EndDrag: Boolean;
  1318.     function GetHotSpot: TPoint; override;
  1319.     procedure HideDragImage;
  1320.     function SetDragImage(Index, HotSpotX, HotSpotY: Integer): Boolean;
  1321.     procedure ShowDragImage;
  1322.     property DragCursor: TCursor read FDragCursor write SetDragCursor;
  1323.     property Dragging: Boolean read FDragging;
  1324.   end;
  1325.  
  1326. { TImageList }
  1327.  
  1328.   TImageList = class(TDragImageList)
  1329.   published
  1330.     property BlendColor;
  1331.     property BkColor;
  1332.     property AllocBy;
  1333.     property DrawingStyle;
  1334.     property Height;
  1335.     property ImageType;
  1336.     property Masked;
  1337.     property OnChange;
  1338.     property ShareImages;
  1339.     property Width;
  1340.   end;
  1341.  
  1342. { TDockZone }
  1343.  
  1344.   TDockTree = class;
  1345.  
  1346.   // TDockZone encapsulates a region into which other zones are contained.
  1347.   // A TDockZone can be a parent to other zones (when FChildZones <> nil) or
  1348.   // can contain only a control (when FChildControl <> nil).  A TDockZone also
  1349.   // stores pointers to previous and next siblings and its parent.  Parents
  1350.   // store a pointer to only the first child in a doubly-linked list of child
  1351.   // zones, though each child maintains a pointer to its parent.  Thus, the
  1352.   // data structure of relating TDockZones works out to a kind of a
  1353.   // doubly-linked list tree.  The FZoneLimit field of TDockZone represents
  1354.   // the coordinate of either the left or bottom of the zone, depending on
  1355.   // whether its parent zone's orientation is doVertical or doHorizontal.
  1356.   TDockZone = class
  1357.   private
  1358.     FChildControl: TControl;
  1359.     FChildZones: TDockZone;
  1360.     FNextSibling: TDockZone;
  1361.     FOrientation: TDockOrientation;
  1362.     FParentZone: TDockZone;
  1363.     FPrevSibling: TDockZone;
  1364.     FTree: TDockTree;
  1365.     FZoneLimit: Integer;
  1366.     function GetChildCount: Integer;
  1367.     function GetLimitBegin: Integer;
  1368.     function GetLimitSize: Integer;
  1369.     function GetTopLeft(Orient: Integer{TDockOrientation}): Integer;
  1370.     function GetHeightWidth(Orient: Integer{TDockOrientation}): Integer;
  1371.     function GetControlName: string;
  1372.     function SetControlName(const Value: string): Boolean;
  1373.   public
  1374.     constructor Create(Tree: TDockTree);
  1375.     procedure ResetChildren;
  1376.     procedure Update;
  1377.     property ChildCount: Integer read GetChildCount;
  1378.     property Height: Integer index Ord(doHorizontal) read GetHeightWidth;
  1379.     property Left: Integer index Ord(doVertical) read GetTopLeft;
  1380.     property LimitBegin: Integer read GetLimitBegin;
  1381.     property LimitSize: Integer read GetLimitSize;
  1382.     property Top: Integer index Ord(doHorizontal) read GetTopLeft;
  1383.     property Width: Integer index Ord(doVertical) read GetHeightWidth;
  1384.   end;
  1385.  
  1386. { TDockTree }
  1387.  
  1388.   TForEachZoneProc = procedure(Zone: TDockZone) of object;
  1389.  
  1390.   TDockTreeClass = class of TDockTree;
  1391.  
  1392.   // TDockTree serves as a manager for a tree of TDockZones.  It is responsible
  1393.   // for inserting and removing controls (and thus zones) from the tree and
  1394.   // associated housekeeping, such as orientation, zone limits, parent zone
  1395.   // creation, and painting of controls into zone bounds.
  1396.   TDockTree = class(TInterfacedObject, IDockManager)
  1397.   private
  1398.     FBorderWidth: Integer;
  1399.     FBrush: TBrush;
  1400.     FDockSite: TWinControl;
  1401.     FGrabberSize: Integer;
  1402.     FGrabbersOnTop: Boolean;
  1403.     FOldRect: TRect;
  1404.     FOldWndProc: TWndMethod;
  1405.     FReplacementZone: TDockZone;
  1406.     FScaleBy: Double;
  1407.     FShiftScaleOrient: TDockOrientation;
  1408.     FShiftBy: Integer;
  1409.     FSizePos: TPoint;
  1410.     FSizingDC: HDC;
  1411.     FSizingWnd: HWND;
  1412.     FSizingZone: TDockZone;
  1413.     FTopZone: TDockZone;
  1414.     FTopXYLimit: Integer;
  1415.     FUpdateCount: Integer;
  1416.     FVersion: Integer;
  1417.     procedure ControlVisibilityChanged(Control: TControl; Visible: Boolean);
  1418.     procedure DrawSizeSplitter;
  1419.     function FindControlZone(Control: TControl): TDockZone;
  1420.     procedure ForEachAt(Zone: TDockZone; Proc: TForEachZoneProc);
  1421.     function GetNextLimit(AZone: TDockZone): Integer;
  1422.     procedure InsertNewParent(NewZone, SiblingZone: TDockZone;
  1423.       ParentOrientation: TDockOrientation; InsertLast: Boolean);
  1424.     procedure InsertSibling(NewZone, SiblingZone: TDockZone; InsertLast: Boolean);
  1425.     function InternalHitTest(const MousePos: TPoint; out HTFlag: Integer): TDockZone;
  1426.     procedure PruneZone(Zone: TDockZone);
  1427.     procedure RemoveZone(Zone: TDockZone);
  1428.     procedure ScaleZone(Zone: TDockZone);
  1429.     procedure SetNewBounds(Zone: TDockZone);
  1430.     procedure ShiftZone(Zone: TDockZone);
  1431.     procedure SplitterMouseDown(OnZone: TDockZone; MousePos: TPoint);
  1432.     procedure SplitterMouseUp;
  1433.     procedure UpdateZone(Zone: TDockZone);
  1434.     procedure WindowProc(var Message: TMessage);
  1435.   protected
  1436.     procedure AdjustDockRect(Control: TControl; var ARect: TRect); virtual;
  1437.     procedure BeginUpdate;
  1438.     procedure EndUpdate;
  1439.     procedure GetControlBounds(Control: TControl; out CtlBounds: TRect);
  1440.     function HitTest(const MousePos: TPoint; out HTFlag: Integer): TControl; virtual;
  1441.     procedure InsertControl(Control: TControl; InsertAt: TAlign;
  1442.       DropCtl: TControl); virtual;
  1443.     procedure LoadFromStream(Stream: TStream); virtual;
  1444.     procedure PaintDockFrame(Canvas: TCanvas; Control: TControl;
  1445.       const ARect: TRect); virtual;
  1446.     procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign;
  1447.       var DockRect: TRect); virtual;
  1448.     procedure RemoveControl(Control: TControl); virtual;
  1449.     procedure SaveToStream(Stream: TStream); virtual;
  1450.     procedure SetReplacingControl(Control: TControl);
  1451.     procedure ResetBounds(Force: Boolean); virtual;
  1452.     procedure UpdateAll;
  1453.     property DockSite: TWinControl read FDockSite write FDockSite;
  1454.   public
  1455.     constructor Create(DockSite: TWinControl); virtual;
  1456.     destructor Destroy; override;
  1457.     procedure PaintSite(DC: HDC); virtual;
  1458.   end;
  1459.  
  1460. { Mouse support }
  1461.  
  1462.   TMouse = class
  1463.   private
  1464.     FDragImmediate: Boolean;
  1465.     FDragThreshold: Integer;
  1466.     FMousePresent: Boolean;
  1467.     FNativeWheelSupport: Boolean;
  1468.     FScrollLines: Integer;
  1469.     FScrollLinesMessage: UINT;
  1470.     FWheelHwnd: HWND;
  1471.     FWheelMessage: UINT;
  1472.     FWheelPresent: Boolean;
  1473.     FWheelSupportMessage: UINT;
  1474.     procedure GetMouseData;
  1475.     procedure GetNativeData;
  1476.     procedure GetRegisteredData;
  1477.     function GetCursorPos: TPoint;
  1478.     procedure SetCursorPos(const Value: TPoint);
  1479.     function GetCapture: HWND;
  1480.     procedure SetCapture(const Value: HWND);
  1481.   public
  1482.     constructor Create;
  1483.     destructor Destroy; override;
  1484.     procedure SettingChanged(Setting: Integer);
  1485.     property Capture: HWND read GetCapture write SetCapture;
  1486.     property CursorPos: TPoint read GetCursorPos write SetCursorPos;
  1487.     property DragImmediate: Boolean read FDragImmediate write FDragImmediate default True;
  1488.     property DragThreshold: Integer read FDragThreshold write FDragThreshold default 5;
  1489.     property MousePresent: Boolean read FMousePresent;
  1490.     property RegWheelMessage: UINT read FWheelMessage;
  1491.     property WheelPresent: Boolean read FWheelPresent;
  1492.     property WheelScrollLines: Integer read FScrollLines;
  1493.   end;
  1494.  
  1495. var
  1496.   Mouse: TMouse;
  1497.  
  1498. { Drag stuff }
  1499.  
  1500. function IsDragObject(Sender: TObject): Boolean;
  1501. function FindControl(Handle: HWnd): TWinControl;
  1502. function FindVCLWindow(const Pos: TPoint): TWinControl;
  1503. function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl;
  1504. function GetCaptureControl: TControl;
  1505. procedure SetCaptureControl(Control: TControl);
  1506. procedure CancelDrag;
  1507.  
  1508. { Misc }
  1509.  
  1510. function CursorToString(Cursor: TCursor): string;
  1511. function StringToCursor(const S: string): TCursor;
  1512. procedure GetCursorValues(Proc: TGetStrProc);
  1513. function CursorToIdent(Cursor: Longint; var Ident: string): Boolean;
  1514. function IdentToCursor(const Ident: string; var Cursor: Longint): Boolean;
  1515.  
  1516. function GetShortHint(const Hint: string): string;
  1517. function GetLongHint(const Hint: string): string;
  1518.  
  1519. var
  1520.   CreationControl: TWinControl = nil;
  1521.   DefaultDockTreeClass: TDockTreeClass = TDockTree;
  1522.   
  1523. function InitWndProc(HWindow: HWnd; Message, WParam: Longint;
  1524.   LParam: Longint): Longint; stdcall;
  1525.  
  1526. const
  1527.   CTL3D_ALL = $FFFF;
  1528.   NullDockSite = TWinControl($FFFFFFFF);
  1529.   AnchorAlign: array[TAlign] of TAnchors = (
  1530.     { alNone }
  1531.     [akLeft, akTop],
  1532.     { alTop }
  1533.     [akLeft, akTop, akRight],
  1534.     { alBottom }
  1535.     [akLeft, akRight, akBottom],
  1536.     { alLeft }
  1537.     [akLeft, akTop, akBottom],
  1538.     { alRight }
  1539.     [akRight, akTop, akBottom],
  1540.     { alClient }
  1541.     [akLeft, akTop, akRight, akBottom]);
  1542.  
  1543. var
  1544.   NewStyleControls: Boolean;
  1545.  
  1546. procedure ChangeBiDiModeAlignment(var Alignment: TAlignment);
  1547.  
  1548. function SendAppMessage(Msg: Cardinal; WParam, LParam: Longint): Longint;
  1549. procedure MoveWindowOrg(DC: HDC; DX, DY: Integer);
  1550.  
  1551. procedure SetImeMode(hWnd: HWND; Mode: TImeMode);
  1552. procedure SetImeName(Name: TImeName);
  1553. function Win32NLSEnableIME(hWnd: HWND; Enable: Boolean): Boolean;
  1554. function Imm32GetContext(hWnd: HWND): HIMC;
  1555. function Imm32ReleaseContext(hWnd: HWND; hImc: HIMC): Boolean;
  1556. function Imm32GetConversionStatus(hImc: HIMC; var Conversion, Sentence: DWORD): Boolean;
  1557. function Imm32SetConversionStatus(hImc: HIMC; Conversion, Sentence: DWORD): Boolean;
  1558. function Imm32SetOpenStatus(hImc: HIMC; fOpen: Boolean): Boolean;
  1559. function Imm32SetCompositionWindow(hImc: HIMC; lpCompForm: PCOMPOSITIONFORM): Boolean;
  1560. function Imm32SetCompositionFont(hImc: HIMC; lpLogfont: PLOGFONTA): Boolean;
  1561. function Imm32GetCompositionString(hImc: HIMC; dWord1: DWORD; lpBuf: pointer; dwBufLen: DWORD): Longint;
  1562. function Imm32IsIME(hKl: HKL): Boolean;
  1563. function Imm32NotifyIME(hImc: HIMC; dwAction, dwIndex, dwValue: DWORD): Boolean;
  1564.  
  1565. implementation
  1566.  
  1567. uses Consts, Forms, ActiveX;
  1568.  
  1569. var
  1570.   WindowAtom: TAtom;
  1571.   ControlAtom: TAtom;
  1572.  
  1573. { BiDiMode support routines }
  1574.  
  1575. procedure ChangeBiDiModeAlignment(var Alignment: TAlignment);
  1576. begin
  1577.   case Alignment of
  1578.     taLeftJustify:  Alignment := taRightJustify;
  1579.     taRightJustify: Alignment := taLeftJustify;
  1580.   end;
  1581. end;
  1582.  
  1583. { Initialization window procedure }
  1584.  
  1585. function InitWndProc(HWindow: HWnd; Message, WParam,
  1586.   LParam: Longint): Longint;
  1587. begin
  1588.   CreationControl.FHandle := HWindow;
  1589.   SetWindowLong(HWindow, GWL_WNDPROC,
  1590.     Longint(CreationControl.FObjectInstance));
  1591.   if (GetWindowLong(HWindow, GWL_STYLE) and WS_CHILD <> 0) and
  1592.     (GetWindowLong(HWindow, GWL_ID) = 0) then
  1593.     SetWindowLong(HWindow, GWL_ID, HWindow);
  1594.   SetProp(HWindow, MakeIntAtom(ControlAtom), THandle(CreationControl));
  1595.   SetProp(HWindow, MakeIntAtom(WindowAtom), THandle(CreationControl));
  1596.   asm
  1597.         PUSH    LParam
  1598.         PUSH    WParam
  1599.         PUSH    Message
  1600.         PUSH    HWindow
  1601.         MOV     EAX,CreationControl
  1602.         MOV     CreationControl,0
  1603.         CALL    [EAX].TWinControl.FObjectInstance
  1604.         MOV     Result,EAX
  1605.   end;
  1606. end;
  1607.  
  1608. { Find a TWinControl given a window handle }
  1609.  
  1610. function FindControl(Handle: HWnd): TWinControl;
  1611. begin
  1612.   Result := nil;
  1613.   if Handle <> 0 then
  1614.   begin
  1615.     Result := Pointer(GetProp(Handle, MakeIntAtom(ControlAtom)));
  1616.   end;
  1617. end;
  1618.  
  1619. { Send message to application object }
  1620.  
  1621. function SendAppMessage(Msg: Cardinal; WParam, LParam: Longint): Longint;
  1622. begin
  1623.   if Application.Handle <> 0 then
  1624.     Result := SendMessage(Application.Handle, Msg, WParam, LParam) else
  1625.     Result := 0;
  1626. end;
  1627.  
  1628. { Cursor translation function }
  1629.  
  1630. const
  1631.   DeadCursors = 1;
  1632.  
  1633. const
  1634.   Cursors: array[0..21] of TIdentMapEntry = (
  1635.     (Value: crDefault;      Name: 'crDefault'),
  1636.     (Value: crArrow;        Name: 'crArrow'),
  1637.     (Value: crCross;        Name: 'crCross'),
  1638.     (Value: crIBeam;        Name: 'crIBeam'),
  1639.     (Value: crSizeNESW;     Name: 'crSizeNESW'),
  1640.     (Value: crSizeNS;       Name: 'crSizeNS'),
  1641.     (Value: crSizeNWSE;     Name: 'crSizeNWSE'),
  1642.     (Value: crSizeWE;       Name: 'crSizeWE'),
  1643.     (Value: crUpArrow;      Name: 'crUpArrow'),
  1644.     (Value: crHourGlass;    Name: 'crHourGlass'),
  1645.     (Value: crDrag;         Name: 'crDrag'),
  1646.     (Value: crNoDrop;       Name: 'crNoDrop'),
  1647.     (Value: crHSplit;       Name: 'crHSplit'),
  1648.     (Value: crVSplit;       Name: 'crVSplit'),
  1649.     (Value: crMultiDrag;    Name: 'crMultiDrag'),
  1650.     (Value: crSQLWait;      Name: 'crSQLWait'),
  1651.     (Value: crNo;           Name: 'crNo'),
  1652.     (Value: crAppStart;     Name: 'crAppStart'),
  1653.     (Value: crHelp;         Name: 'crHelp'),
  1654.     (Value: crHandPoint;    Name: 'crHandPoint'),
  1655.     (Value: crSizeAll;      Name: 'crSizeAll'),
  1656.  
  1657.     { Dead cursors }
  1658.     (Value: crSize;         Name: 'crSize'));
  1659.  
  1660. function CursorToString(Cursor: TCursor): string;
  1661. begin
  1662.   if not CursorToIdent(Cursor, Result) then FmtStr(Result, '%d', [Cursor]);
  1663. end;
  1664.  
  1665. function StringToCursor(const S: string): TCursor;
  1666. var
  1667.   L: Longint;
  1668. begin
  1669.   if not IdentToCursor(S, L) then L := StrToInt(S);
  1670.   Result := L;
  1671. end;
  1672.  
  1673. procedure GetCursorValues(Proc: TGetStrProc);
  1674. var
  1675.   I: Integer;
  1676. begin
  1677.   for I := Low(Cursors) to High(Cursors) - DeadCursors do Proc(Cursors[I].Name);
  1678. end;
  1679.  
  1680. function CursorToIdent(Cursor: Longint; var Ident: string): Boolean;
  1681. begin
  1682.   Result := IntToIdent(Cursor, Ident, Cursors);
  1683. end;
  1684.  
  1685. function IdentToCursor(const Ident: string; var Cursor: Longint): Boolean;
  1686. begin
  1687.   Result := IdentToInt(Ident, Cursor, Cursors);
  1688. end;
  1689.  
  1690. function GetShortHint(const Hint: string): string;
  1691. var
  1692.   I: Integer;
  1693. begin
  1694.   I := AnsiPos('|', Hint);
  1695.   if I = 0 then
  1696.     Result := Hint else
  1697.     Result := Copy(Hint, 1, I - 1);
  1698. end;
  1699.  
  1700. function GetLongHint(const Hint: string): string;
  1701. var
  1702.   I: Integer;
  1703. begin
  1704.   I := AnsiPos('|', Hint);
  1705.   if I = 0 then
  1706.     Result := Hint else
  1707.     Result := Copy(Hint, I + 1, Maxint);
  1708. end;
  1709.  
  1710. { Mouse capture management }
  1711.  
  1712. var
  1713.   CaptureControl: TControl = nil;
  1714.  
  1715. function GetCaptureControl: TControl;
  1716. begin
  1717.   Result := FindControl(GetCapture);
  1718.   if (Result <> nil) and (CaptureControl <> nil) and
  1719.     (CaptureControl.Parent = Result) then Result := CaptureControl;
  1720. end;
  1721.  
  1722. procedure SetCaptureControl(Control: TControl);
  1723. begin
  1724.   ReleaseCapture;
  1725.   CaptureControl := nil;
  1726.   if Control <> nil then
  1727.   begin
  1728.     if not (Control is TWinControl) then
  1729.     begin
  1730.       if Control.Parent = nil then Exit;
  1731.       CaptureControl := Control;
  1732.       Control := Control.Parent;
  1733.     end;
  1734.     SetCapture(TWinControl(Control).Handle);
  1735.   end;
  1736. end;
  1737.  
  1738. { Drag-and-drop management }
  1739.  
  1740. type
  1741.   TDragOperation = (dopNone, dopDrag, dopDock);
  1742.  
  1743.   PSiteInfoRec = ^TSiteInfoRec;
  1744.   TSiteInfoRec = record
  1745.     Site: TWinControl;
  1746.     TopParent: HWND;
  1747.   end;
  1748.  
  1749. { TSiteList }
  1750.  
  1751.   // TSiteList deals with the relative z-order positions of dock sites
  1752.   TSiteList = class(TList)
  1753.   public
  1754.     procedure AddSite(ASite: TWinControl);
  1755.     procedure Clear; override;
  1756.     function Find(ParentWnd: Hwnd; var Index: Integer): Boolean;
  1757.     function GetTopSite: TWinControl;
  1758.   end;
  1759.  
  1760. function TSiteList.Find(ParentWnd: Hwnd; var Index: Integer): Boolean;
  1761. begin
  1762.   Index := 0;
  1763.   Result := False;
  1764.   while Index < Count do
  1765.   begin
  1766.     Result := (PSiteInfoRec(Items[Index]).TopParent = ParentWnd);
  1767.     if Result then Exit;
  1768.     Inc(Index);
  1769.   end;
  1770. end;
  1771.  
  1772. procedure TSiteList.AddSite(ASite: TWinControl);
  1773.  
  1774.   function GetTopParent: HWND;
  1775.   var
  1776.     NextParent: HWND;
  1777.   begin
  1778.     NextParent := ASite.Handle;
  1779.     Result := NextParent;
  1780.     while NextParent <> 0 do
  1781.     begin
  1782.       Result := NextParent;
  1783.       NextParent := GetParent(NextParent);
  1784.     end;
  1785.   end;
  1786.  
  1787. var
  1788.   SI: PSiteInfoRec;
  1789.   Index: Integer;
  1790. begin
  1791.   New(SI);
  1792.   SI.Site := ASite;
  1793.   SI.TopParent := GetTopParent;
  1794.   if Find(SI.TopParent, Index) then
  1795.     Insert(Index, SI) else
  1796.     Add(SI);
  1797. end;
  1798.  
  1799. procedure TSiteList.Clear;
  1800. var
  1801.   I: Integer;
  1802. begin
  1803.   for I := 0 to Count - 1 do
  1804.     Dispose(PSiteInfoRec(Items[I]));
  1805.   inherited Clear;
  1806. end;
  1807.  
  1808. function TSiteList.GetTopSite: TWinControl;
  1809. var
  1810.   Index: Integer;
  1811.   DesktopWnd, CurrentWnd: HWND;
  1812. begin
  1813.   Result := nil;
  1814.   if Count = 0 then Exit
  1815.   else if Count = 1 then Result := PSiteInfoRec(Items[0]).Site
  1816.   else begin
  1817.     DesktopWnd := GetDesktopWindow;
  1818.     CurrentWnd := GetTopWindow(DesktopWnd);
  1819.     while (Result = nil) and (CurrentWnd <> 0) do
  1820.     begin
  1821.       if Find(CurrentWnd, Index) then
  1822.         Result := PSiteInfoRec(List[Index])^.Site
  1823.       else
  1824.         CurrentWnd := GetNextWindow(CurrentWnd, GW_HWNDNEXT);
  1825.     end;
  1826.   end;
  1827. end;
  1828.  
  1829. var
  1830.   DragControl: TControl;
  1831.   DragObject: TDragObject;
  1832.   DragFreeObject: Boolean;
  1833.   DragCapture: HWND;
  1834.   DragStartPos: TPoint;
  1835.   DragSaveCursor: HCURSOR;
  1836.   DragThreshold: Integer;
  1837.   ActiveDrag: TDragOperation;
  1838.   DragImageList: TDragImageList;
  1839.   DockSiteList: TList;
  1840.   QualifyingSites: TSiteList;
  1841.  
  1842. procedure DragTo(const Pos: TPoint); forward;
  1843. procedure DragDone(Drop: Boolean); forward;
  1844.  
  1845. function IsDragObject(Sender: TObject): Boolean;
  1846. var
  1847.   SenderClass: TClass;
  1848. begin
  1849.   SenderClass := Sender.ClassType;
  1850.   Result := True;
  1851.   while SenderClass <> nil do
  1852.     if SenderClass.ClassName = TDragObject.ClassName then Exit
  1853.     else SenderClass := SenderClass.ClassParent;
  1854.   Result := False;
  1855. end;
  1856.  
  1857. { TDragObject }
  1858.  
  1859. procedure TDragObject.Assign(Source: TDragObject);
  1860. begin
  1861.   FDragTarget := Source.FDragTarget;
  1862.   FDragHandle := Source.FDragHandle;
  1863.   FDragPos := Source.FDragPos;
  1864.   FDragTargetPos := Source.FDragTargetPos;
  1865.   FMouseDeltaX := Source.FMouseDeltaX;
  1866.   FMouseDeltaY := Source.FMouseDeltaY;
  1867. end;
  1868.  
  1869. function TDragObject.Capture: HWND;
  1870. begin
  1871.   Result := AllocateHWND(MouseMsg);
  1872.   SetCapture(Result);
  1873. end;
  1874.  
  1875. procedure TDragObject.Finished(Target: TObject; X, Y: Integer; Accepted: Boolean);
  1876. begin
  1877. end;
  1878.  
  1879. function TDragObject.GetName: string;
  1880. begin
  1881.   Result := ClassName;
  1882. end;
  1883.  
  1884. procedure TDragObject.ReleaseCapture(Handle: HWND);
  1885. begin
  1886.   Windows.ReleaseCapture;
  1887.   DeallocateHWND(Handle);
  1888. end;
  1889.  
  1890. procedure TDragObject.MouseMsg(var Msg: TMessage);
  1891. var
  1892.   P: TPoint;
  1893. begin
  1894.   try
  1895.     case Msg.Msg of
  1896.       WM_MOUSEMOVE:
  1897.         begin
  1898.           P := SmallPointToPoint(TWMMouse(Msg).Pos);
  1899.           ClientToScreen(DragCapture, P);
  1900.           DragTo(P);
  1901.         end;
  1902.       WM_CAPTURECHANGED:
  1903.         DragDone(False);
  1904.       WM_LBUTTONUP, WM_RBUTTONUP:
  1905.         DragDone(True);
  1906.       { Forms.IsKeyMsg sends WM_KEYxxx messages here (+CN_BASE) when a
  1907.         TPUtilWindow has the mouse capture. }
  1908.       CN_KEYUP:
  1909.         if Msg.WParam = VK_CONTROL then DragTo(DragObject.DragPos);
  1910.       CN_KEYDOWN:
  1911.         begin
  1912.           case Msg.WParam of
  1913.             VK_CONTROL:
  1914.               DragTo(DragObject.DragPos);
  1915.             VK_ESCAPE:
  1916.               begin
  1917.                 { Consume keystroke and cancel drag operation }
  1918.                 Msg.Result := 1;
  1919.                 DragDone(False);
  1920.               end;
  1921.           end;
  1922.         end;
  1923.     end;
  1924.   except
  1925.     if DragControl <> nil then DragDone(False);
  1926.     raise;
  1927.   end;
  1928. end;
  1929.  
  1930. function TDragObject.GetDragImages: TDragImageList;
  1931. begin
  1932.   Result := nil;
  1933. end;
  1934.  
  1935. function TDragObject.GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor;
  1936. begin
  1937.   if Accepted then Result := crDrag
  1938.   else Result := crNoDrop;
  1939. end;
  1940.  
  1941. procedure TDragObject.HideDragImage;
  1942. begin
  1943.   // do nothing
  1944. end;
  1945.  
  1946. function TDragObject.Instance: THandle;
  1947. begin
  1948.   Result := SysInit.HInstance;
  1949. end;
  1950.  
  1951. procedure TDragObject.ShowDragImage;
  1952. begin
  1953.   // do nothing
  1954. end;
  1955.  
  1956. { TBaseDragControlObject }
  1957.  
  1958. constructor TBaseDragControlObject.Create(AControl: TControl);
  1959. begin
  1960.   FControl := AControl;
  1961. end;
  1962.  
  1963. procedure TBaseDragControlObject.Assign(Source: TDragObject);
  1964. begin
  1965.   inherited Assign(Source);
  1966.   if Source is TBaseDragControlObject then
  1967.     FControl := TBaseDragControlObject(Source).FControl;
  1968. end;
  1969.  
  1970. procedure TBaseDragControlObject.EndDrag(Target: TObject; X, Y: Integer);
  1971. begin
  1972.   FControl.DoEndDrag(Target, X, Y);
  1973. end;
  1974.  
  1975. procedure TBaseDragControlObject.Finished(Target: TObject; X, Y: Integer; Accepted: Boolean);
  1976. begin
  1977.   if not Accepted then
  1978.   begin
  1979.     FControl.DragCanceled;
  1980.     Target := nil;
  1981.   end;
  1982.   EndDrag(Target, X, Y);
  1983. end;
  1984.  
  1985. { TDragControlObject }
  1986.  
  1987. function TDragControlObject.GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor;
  1988. begin
  1989.   if Accepted then Result := Control.DragCursor
  1990.   else Result := crNoDrop;
  1991. end;
  1992.  
  1993. function TDragControlObject.GetDragImages: TDragImageList;
  1994. begin
  1995.   Result := Control.GetDragImages;
  1996. end;
  1997.  
  1998. procedure TDragControlObject.HideDragImage;
  1999. begin
  2000.   if Control.GetDragImages <> nil then
  2001.     Control.GetDragImages.HideDragImage;
  2002. end;
  2003.  
  2004. procedure TDragControlObject.ShowDragImage;
  2005. begin
  2006.   if Control.GetDragImages <> nil then
  2007.     Control.GetDragImages.ShowDragImage;
  2008. end;
  2009.  
  2010. { TDragDockObject }
  2011.  
  2012. constructor TDragDockObject.Create(AControl: TControl);
  2013. begin
  2014.   inherited Create(AControl);
  2015.   FBrush := TBrush.Create;
  2016.   FBrush.Bitmap := AllocPatternBitmap(clBlack, clWhite);
  2017. end;
  2018.  
  2019. destructor TDragDockObject.Destroy;
  2020. begin
  2021.   FBrush.Free;
  2022.   inherited Destroy;
  2023. end;
  2024.  
  2025. procedure TDragDockObject.Assign(Source: TDragObject);
  2026. begin
  2027.   inherited Assign(Source);
  2028.   if Source is TDragDockObject then
  2029.   begin
  2030.     FDropAlign := TDragDockObject(Source).FDropAlign;
  2031.     FDropOnControl := TDragDockObject(Source).FDropOnControl;
  2032.     FFloating := TDragDockObject(Source).FFloating;
  2033.     FDockRect := TDragDockObject(Source).FDockRect;
  2034.     FEraseDockRect := TDragDockObject(Source).FEraseDockRect;
  2035.     FBrush.Assign(TDragDockObject(Source).FBrush);
  2036.   end;
  2037. end;
  2038.  
  2039. procedure TDragDockObject.SetBrush(Value: TBrush);
  2040. begin
  2041.   FBrush.Assign(Value);
  2042. end;
  2043.  
  2044. procedure TDragDockObject.EndDrag(Target: TObject; X, Y: Integer);
  2045. begin
  2046.   FControl.DoEndDock(Target, X, Y);
  2047. end;
  2048.  
  2049. procedure TDragDockObject.AdjustDockRect(ARect: TRect);
  2050. var
  2051.   DeltaX, DeltaY: Integer;
  2052.  
  2053.   function AbsMin(Value1, Value2: Integer): Integer;
  2054.   begin
  2055.     if Abs(Value1) < Abs(Value2) then Result := Value1
  2056.     else Result := Value2;
  2057.   end;
  2058.  
  2059. begin
  2060.   { Make sure dock rect is touching mouse point }
  2061.   if (ARect.Left > FDragPos.x) or (ARect.Right < FDragPos.x) then
  2062.     DeltaX := AbsMin(ARect.Left - FDragPos.x, ARect.Right - FDragPos.x)
  2063.   else DeltaX := 0;
  2064.   if (ARect.Top > FDragPos.y) or (ARect.Bottom < FDragPos.y) then
  2065.     DeltaY := AbsMin(ARect.Top - FDragPos.y, ARect.Bottom - FDragPos.y)
  2066.   else DeltaY := 0;
  2067.   if (DeltaX <> 0) or (DeltaY <> 0) then
  2068.     OffsetRect(FDockRect, -DeltaX, -DeltaY);
  2069. end;
  2070.  
  2071. procedure TDragDockObject.DrawDragDockImage;
  2072. begin
  2073.   FControl.DrawDragDockImage(Self);
  2074. end;
  2075.  
  2076. procedure TDragDockObject.EraseDragDockImage;
  2077. begin
  2078.   FControl.EraseDragDockImage(Self);
  2079. end;
  2080.  
  2081. function TDragDockObject.GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor;
  2082. begin
  2083.   Result := crDefault;
  2084. end;
  2085.  
  2086. function TDragDockObject.GetFrameWidth: Integer;
  2087. begin
  2088.   Result := 4;
  2089. end;
  2090.  
  2091. { Drag dock functions }
  2092.  
  2093. type
  2094.   PCheckTargetInfo = ^TCheckTargetInfo;
  2095.   TCheckTargetInfo = record
  2096.     ClientWnd, TargetWnd: HWnd;
  2097.     CurrentWnd: HWnd;
  2098.     MousePos: TPoint;
  2099.     Found: Boolean;
  2100.   end;
  2101.  
  2102. function IsBeforeTargetWindow(Window: HWnd; Data: Longint): Bool; stdcall;
  2103. var
  2104.   R: TRect;
  2105. begin
  2106.   if Window = PCheckTargetInfo(Data)^.TargetWnd then
  2107.     Result := False
  2108.   else
  2109.   begin
  2110.     if PCheckTargetInfo(Data)^.CurrentWnd = 0 then
  2111.     begin
  2112.       GetWindowRect(Window, R);
  2113.       if PtInRect(R, PCheckTargetInfo(Data)^.MousePos) then
  2114.         PCheckTargetInfo(Data)^.CurrentWnd := Window;
  2115.     end;
  2116.     if Window = PCheckTargetInfo(Data)^.CurrentWnd then
  2117.     begin
  2118.       Result := False;
  2119.       PCheckTargetInfo(Data)^.Found := True;
  2120.     end
  2121.     else if Window = PCheckTargetInfo(Data)^.ClientWnd then
  2122.     begin
  2123.       Result := True;
  2124.       PCheckTargetInfo(Data)^.CurrentWnd := 0; // Look for next window
  2125.     end
  2126.     else
  2127.       Result := True;
  2128.   end;
  2129. end;
  2130.  
  2131. function DragFindWindow(const Pos: TPoint): HWND; forward;
  2132.  
  2133. function GetDockSiteAtPos(MousePos: TPoint; Client: TControl): TWinControl;
  2134. var
  2135.   I: Integer;
  2136.   R: TRect;
  2137.   Site: TWinControl;
  2138.   CanDock, ControlKeyDown: Boolean;
  2139.  
  2140.   function ValidDockTarget(Target: TWinControl): Boolean;
  2141.   var
  2142.     Info: TCheckTargetInfo;
  2143.     Control: TWinControl;
  2144.     R1, R2: TRect;
  2145.   begin
  2146.     Result := True;
  2147.     { Find handle for topmost container of current }
  2148.     Info.CurrentWnd := DragFindWindow(MousePos);
  2149.     if (GetWindow(Info.CurrentWnd, GW_OWNER) <> Application.Handle) then
  2150.     begin
  2151.       Control := FindControl(Info.CurrentWnd);
  2152.       if Control = nil then Exit;
  2153.       while Control.Parent <> nil do Control := Control.Parent;
  2154.       Info.CurrentWnd := Control.Handle;
  2155.     end;
  2156.     if Info.CurrentWnd = 0 then Exit;
  2157.  
  2158.     { Find handle for topmost container of target }
  2159.     Control := Target;
  2160.     while Control.Parent <> nil do Control := Control.Parent;
  2161.     Info.TargetWnd := Control.Handle;
  2162.     if Info.CurrentWnd = Info.TargetWnd then Exit;
  2163.  
  2164.     { Find handle for topmost container of client }
  2165.     if Client.Parent <> nil then
  2166.     begin
  2167.       Control := Client.Parent;
  2168.       while Control.Parent <> nil do Control := Control.Parent;
  2169.       Info.ClientWnd := Control.Handle;
  2170.     end
  2171.     else if Client is TWinControl then
  2172.       Info.ClientWnd := TWinControl(Client).Handle
  2173.     else
  2174.       Info.ClientWnd := 0;
  2175.  
  2176.     Info.Found := False;
  2177.     Info.MousePos := MousePos;
  2178.     EnumThreadWindows(GetCurrentThreadID, @IsBeforeTargetWindow, Longint(@Info));
  2179.     { CurrentWnd is in front of TargetWnd, so check whether they're overlapped. }
  2180.     if Info.Found then
  2181.     begin
  2182.       GetWindowRect(Info.CurrentWnd, R1);
  2183.       Target.GetSiteInfo(Client, R2, MousePos, CanDock);
  2184.       { Docking control's host shouldn't count as an overlapped window }
  2185.       if DragObject is TDragDockObject
  2186.       and (TDragDockObject(DragObject).Control.HostDockSite <> nil)
  2187.       and (TDragDockObject(DragObject).Control.HostDockSite.Handle = Info.CurrentWnd) then
  2188.         Exit;
  2189.       if IntersectRect(R1, R1, R2) then
  2190.         Result := False;
  2191.     end;
  2192.   end;
  2193.  
  2194.   function IsSiteChildOfClient: Boolean;
  2195.   begin
  2196.     if Client is TWinControl then
  2197.       Result := IsChild(TWinControl(Client).Handle, Site.Handle)
  2198.     else
  2199.       Result := False;
  2200.   end;
  2201.  
  2202. begin
  2203.   Result := nil;
  2204.   ControlKeyDown := (GetKeyState(VK_CONTROL) and not $7FFF) <> 0;
  2205.   if (DockSiteList = nil) or ControlKeyDown then Exit;
  2206.   QualifyingSites.Clear;
  2207.   for I := 0 to DockSiteList.Count - 1 do
  2208.   begin
  2209.     Site := TWinControl(DockSiteList[I]);
  2210.     if (Site <> Client) and Site.Showing and Site.Enabled and
  2211.       IsWindowVisible(Site.Handle) and (not IsSiteChildOfClient) and
  2212.       ((Client.HostDockSite <> Site) or (Site.VisibleDockClientCount > 1)) then
  2213.     begin
  2214.       CanDock := True;
  2215.       Site.GetSiteInfo(Client, R, MousePos, CanDock);
  2216.       if CanDock and PtInRect(R, MousePos) then
  2217.         QualifyingSites.AddSite(Site);
  2218.     end;
  2219.   end;
  2220.   if QualifyingSites.Count > 0 then
  2221.     Result := QualifyingSites.GetTopSite;
  2222.   if (Result <> nil) and not ValidDockTarget(Result) then
  2223.     Result := nil;
  2224. end;
  2225.  
  2226. procedure RegisterDockSite(Site: TWinControl; DoRegister: Boolean);
  2227. var
  2228.   Index: Integer;
  2229. begin
  2230.   if (Site <> nil) then
  2231.   begin
  2232.     if DockSiteList = nil then DockSiteList := TList.Create;
  2233.     Index := DockSiteList.IndexOf(Pointer(Site));
  2234.     if DoRegister then
  2235.     begin
  2236.       if Index = -1 then DockSiteList.Add(Pointer(Site));
  2237.     end
  2238.     else begin
  2239.       if Index <> -1 then DockSiteList.Delete(Index);
  2240.     end;
  2241.   end;
  2242. end;
  2243.  
  2244. { Drag drop functions }
  2245.  
  2246. function DragMessage(Handle: HWND; Msg: TDragMessage;
  2247.   Source: TDragObject; Target: Pointer; const Pos: TPoint): Longint;
  2248. var
  2249.   DragRec: TDragRec;
  2250. begin
  2251.   Result := 0;
  2252.   if Handle <> 0 then
  2253.   begin
  2254.     DragRec.Pos := Pos;
  2255.     DragRec.Target := Target;
  2256.     DragRec.Source := Source;
  2257.     DragRec.Docking := ActiveDrag = dopDock;
  2258.     Result := SendMessage(Handle, CM_DRAG, Longint(Msg), Longint(@DragRec));
  2259.   end;
  2260. end;
  2261.  
  2262. function IsDelphiHandle(Handle: HWND): Boolean;
  2263. begin
  2264.   Result := (Handle <> 0) and
  2265.     (GetProp(Handle, MakeIntAtom(WindowAtom)) <> 0);
  2266. end;
  2267.  
  2268. function DragFindWindow(const Pos: TPoint): HWND;
  2269. begin
  2270.   Result := WindowFromPoint(Pos);
  2271.   while Result <> 0 do
  2272.     if not IsDelphiHandle(Result) then Result := GetParent(Result)
  2273.     else Exit;
  2274. end;
  2275.  
  2276. function DragFindTarget(const Pos: TPoint; var Handle: HWND;
  2277.   DragKind: TDragKind; Client: TControl): Pointer;
  2278. begin
  2279.   if DragKind = dkDrag then
  2280.   begin
  2281.     Handle := DragFindWindow(Pos);
  2282.     Result := Pointer(DragMessage(Handle, dmFindTarget, DragObject, nil, Pos));
  2283.   end
  2284.   else begin
  2285.     Result := GetDockSiteAtPos(Pos, Client);
  2286.     if Result <> nil then
  2287.       Handle := TWinControl(Result).Handle;
  2288.   end;
  2289. end;
  2290.  
  2291. function DoDragOver(DragMsg: TDragMessage): Boolean;
  2292. begin
  2293.   Result := False;
  2294.   if DragObject.DragTarget <> nil then
  2295.     Result := LongBool(DragMessage(DragObject.DragHandle, DragMsg, DragObject,
  2296.       DragObject.DragTarget, DragObject.DragPos));
  2297. end;
  2298.  
  2299. procedure DragTo(const Pos: TPoint);
  2300.  
  2301.   function GetDropCtl: TControl;
  2302.   var
  2303.     NextCtl: TControl;
  2304.     TargetCtl: TWinControl;
  2305.     CtlIdx: Integer;
  2306.   begin
  2307.     Result := nil;
  2308.     TargetCtl := TDragObject(DragObject).DragTarget;
  2309.     if (TargetCtl = nil) or not TargetCtl.UseDockManager or
  2310.       (TargetCtl.FDockClients = nil) or (TargetCtl.DockClientCount = 0) or
  2311.       ((TargetCtl.DockClientCount = 1) and
  2312.         (TargetCtl.FDockClients[0] = TDragDockObject(DragObject).Control)) then
  2313.       Exit;
  2314.     NextCtl := FindDragTarget(DragObject.DragPos, False);
  2315.     while (NextCtl <> nil) and (NextCtl <> TargetCtl) do
  2316.     begin
  2317.       CtlIdx := TargetCtl.FDockClients.IndexOf(NextCtl);
  2318.       if CtlIdx <> -1 then
  2319.       begin
  2320.         Result := TargetCtl.DockClients[CtlIdx];
  2321.         Exit;
  2322.       end
  2323.       else
  2324.         NextCtl := NextCtl.Parent;
  2325.     end;
  2326.   end;
  2327.  
  2328. var
  2329.   DragCursor: TCursor;
  2330.   Target: TControl;
  2331.   TargetHandle: HWND;
  2332.   DoErase: Boolean;
  2333. begin
  2334.   if (ActiveDrag <> dopNone) or (Abs(DragStartPos.X - Pos.X) >= DragThreshold) or
  2335.     (Abs(DragStartPos.Y - Pos.Y) >= DragThreshold) then
  2336.   begin
  2337.     Target := DragFindTarget(Pos, TargetHandle, DragControl.DragKind, DragControl);
  2338.     if (ActiveDrag = dopNone) and (DragImageList <> nil) then
  2339.       with DragStartPos do DragImageList.BeginDrag(GetDeskTopWindow, X, Y);
  2340.     if DragControl.DragKind = dkDrag then
  2341.     begin
  2342.       ActiveDrag := dopDrag;
  2343.       DoErase := False;
  2344.     end
  2345.     else begin
  2346.       DoErase := ActiveDrag <> dopNone;
  2347.       ActiveDrag := dopDock;
  2348.     end;
  2349.     if Target <> DragObject.DragTarget then
  2350.     begin
  2351.       DoDragOver(dmDragLeave);
  2352.       if DragObject = nil then Exit;
  2353.       DragObject.DragTarget := Target;
  2354.       DragObject.DragHandle := TargetHandle;
  2355.       DragObject.DragPos := Pos;
  2356.       DoDragOver(dmDragEnter);
  2357.       if DragObject = nil then Exit;
  2358.     end;
  2359.     DragObject.DragPos := Pos;
  2360.     if DragObject.DragTarget <> nil then
  2361.       DragObject.DragTargetPos := TControl(DragObject.DragTarget).ScreenToClient(Pos);
  2362.     DragCursor := TDragObject(DragObject).GetDragCursor(DoDragOver(dmDragMove),
  2363.       Pos.X, Pos.Y);
  2364.     if DragImageList <> nil then
  2365.     begin
  2366.       if (Target = nil) or (csDisplayDragImage in Target.ControlStyle) then
  2367.       begin
  2368.         DragImageList.DragCursor := DragCursor;
  2369.         if not DragImageList.Dragging then
  2370.           DragImageList.BeginDrag(GetDeskTopWindow, Pos.X, Pos.Y)
  2371.         else DragImageList.DragMove(Pos.X, Pos.Y);
  2372.       end
  2373.       else begin
  2374.         DragImageList.EndDrag;
  2375.         Windows.SetCursor(Screen.Cursors[DragCursor]);
  2376.       end;
  2377.     end;
  2378.     Windows.SetCursor(Screen.Cursors[DragCursor]);
  2379.     if ActiveDrag = dopDock then
  2380.     begin
  2381.       with TDragDockObject(DragObject) do
  2382.       begin
  2383.         if Target = nil then
  2384.           Control.DockTrackNoTarget(TDragDockObject(DragObject), Pos.X, Pos.Y)
  2385.         else begin
  2386.           FDropOnControl := GetDropCtl;
  2387.           if FDropOnControl = nil then
  2388.             with DragObject do
  2389.               FDropAlign := TWinControl(DragTarget).GetDockEdge(DragTargetPos)
  2390.           else
  2391.             FDropAlign := FDropOnControl.GetDockEdge(FDropOnControl.ScreenToClient(Pos));
  2392.         end;
  2393.       end;
  2394.       if DragObject <> nil then
  2395.         with TDragDockObject(DragObject) do
  2396.           if not CompareMem(@FDockRect, @FEraseDockRect, SizeOf(TRect)) then
  2397.           begin
  2398.             if DoErase then EraseDragDockImage;
  2399.             DrawDragDockImage;
  2400.             FEraseDockRect := FDockRect;
  2401.           end;
  2402.     end;
  2403.   end;
  2404. end;
  2405.  
  2406. procedure DragInit(ADragObject: TDragObject; Immediate: Boolean; Threshold: Integer);
  2407. begin
  2408.   DragObject := ADragObject;
  2409.   DragObject.DragTarget := nil;
  2410.   GetCursorPos(DragStartPos);
  2411.   DragObject.DragPos := DragStartPos;
  2412.   DragSaveCursor := Windows.GetCursor;
  2413.   DragCapture := DragObject.Capture;
  2414.   DragThreshold := Threshold;
  2415.   if ADragObject is TDragDockObject then
  2416.   begin
  2417.     with TDragDockObject(ADragObject), FDockRect do
  2418.     begin
  2419.       if Right - Left > 0 then
  2420.         FMouseDeltaX :=  (DragPos.x - Left) / (Right - Left) else
  2421.         FMouseDeltaX := 0;
  2422.       if Bottom - Top > 0 then
  2423.         FMouseDeltaY :=  (DragPos.y - Top) / (Bottom - Top) else
  2424.         FMouseDeltaY := 0;
  2425.       if Immediate then
  2426.       begin
  2427.         ActiveDrag := dopDock;
  2428.         DrawDragDockImage;
  2429.       end
  2430.       else ActiveDrag := dopNone;
  2431.     end;
  2432.   end
  2433.   else begin
  2434.     if Immediate then ActiveDrag := dopDrag
  2435.     else ActiveDrag := dopNone;
  2436.   end;
  2437.   DragImageList := DragObject.GetDragImages;
  2438.   if DragImageList <> nil then
  2439.     with DragStartPos do DragImageList.BeginDrag(GetDeskTopWindow, X, Y);
  2440.   QualifyingSites := TSiteList.Create;
  2441.   if ActiveDrag <> dopNone then DragTo(DragStartPos);
  2442. end;
  2443.  
  2444. procedure DragInitControl(Control: TControl; Immediate: Boolean; Threshold: Integer);
  2445. var
  2446.   DragObject: TDragObject;
  2447.   StartPos: TPoint;
  2448. begin
  2449.   DragControl := Control;
  2450.   try
  2451.     DragObject := nil;
  2452.     DragFreeObject := False;
  2453.     if Control.FDragKind = dkDrag then
  2454.     begin
  2455.       Control.DoStartDrag(DragObject);
  2456.       if DragControl = nil then Exit;
  2457.       if DragObject = nil then
  2458.       begin
  2459.         DragObject := TDragControlObject.Create(Control);
  2460.         DragFreeObject := True;
  2461.       end;
  2462.     end
  2463.     else begin
  2464.       Control.DoStartDock(DragObject);
  2465.       if DragControl = nil then Exit;
  2466.       if DragObject = nil then
  2467.       begin
  2468.         DragObject := TDragDockObject.Create(Control);
  2469.         DragFreeObject := True;
  2470.       end;
  2471.       with TDragDockObject(DragObject) do
  2472.       begin
  2473.         if Control is TWinControl then
  2474.           GetWindowRect(TWinControl(Control).Handle, FDockRect)
  2475.         else begin
  2476.           if (Control.Parent = nil) and not (Control is TWinControl) then
  2477.           begin
  2478.             GetCursorPos(StartPos);
  2479.             FDockRect.TopLeft := StartPos;
  2480.           end
  2481.           else
  2482.             FDockRect.TopLeft := Control.ClientToScreen(Point(0, 0));
  2483.           FDockRect.BottomRight := Point(FDockRect.Left + Control.Width,
  2484.             FDockRect.Top + Control.Height);
  2485.         end;
  2486.         FEraseDockRect := FDockRect;
  2487.       end;
  2488.     end;
  2489.     DragInit(DragObject, Immediate, Threshold);
  2490.   except
  2491.     DragControl := nil;
  2492.     raise;
  2493.   end;
  2494. end;
  2495.  
  2496. procedure DragDone(Drop: Boolean);
  2497.  
  2498.   function CheckUndock: Boolean;
  2499.   begin
  2500.     Result := DragObject.DragTarget <> nil;
  2501.     with DragControl do
  2502.       if Drop and (ActiveDrag = dopDock) then
  2503.         if Floating or (FHostDockSite = nil) then
  2504.           Result := True
  2505.         else if FHostDockSite <> nil then
  2506.           Result := FHostDockSite.DoUnDock(DragObject.DragTarget, DragControl);
  2507.   end;
  2508.  
  2509. var
  2510.   DragSave: TDragObject;
  2511.   DockObject: TDragDockObject;
  2512.   Accepted: Boolean;
  2513.   DragMsg: TDragMessage;
  2514.   TargetPos: TPoint;
  2515.   ParentForm: TCustomForm;
  2516. begin
  2517.   DockObject := nil;
  2518.   DragSave := nil;
  2519.   Accepted := False;
  2520.   if (DragObject = nil) or DragObject.Cancelling then Exit;  // recursion control
  2521.   try
  2522.     DragSave := DragObject;
  2523.     try
  2524.       DragObject.Cancelling := True;
  2525.       DragObject.ReleaseCapture(DragCapture);
  2526.       if ActiveDrag = dopDock then
  2527.       begin
  2528.         DockObject := DragObject as TDragDockObject;
  2529.         DockObject.EraseDragDockImage;
  2530.         DockObject.Floating := DockObject.DragTarget = nil;
  2531.       end;
  2532.       if (DragObject.DragTarget <> nil) and
  2533.         (TObject(DragObject.DragTarget) is TControl) then
  2534.         TargetPos := DragObject.DragTargetPos
  2535.       else
  2536.         TargetPos := DragObject.DragPos;
  2537.       Accepted := CheckUndock and
  2538.         (((ActiveDrag = dopDock) and DockObject.Floating) or
  2539.         ((ActiveDrag <> dopNone) and DoDragOver(dmDragLeave))) and
  2540.         Drop;
  2541.       if ActiveDrag = dopDock then
  2542.       begin
  2543.         if Accepted and DockObject.Floating then
  2544.         begin
  2545.           ParentForm := GetParentForm(DockObject.Control);
  2546.           if (ParentForm <> nil) and
  2547.             (ParentForm.ActiveControl = DockObject.Control) then
  2548.             ParentForm.ActiveControl := nil;
  2549.           DragControl.Perform(CM_FLOAT, 0, Integer(DragObject));
  2550.         end;
  2551.       end
  2552.       else begin
  2553.         if DragImageList <> nil then DragImageList.EndDrag
  2554.         else Windows.SetCursor(DragSaveCursor);
  2555.       end;
  2556.       DragControl := nil;
  2557.       DragObject := nil;
  2558.       if DragSave.DragTarget <> nil then
  2559.       begin
  2560.         DragMsg := dmDragDrop;
  2561.         if not Accepted then
  2562.         begin
  2563.           DragMsg := dmDragCancel;
  2564.           DragSave.FDragPos.X := 0;
  2565.           DragSave.FDragPos.Y := 0;
  2566.           TargetPos.X := 0;
  2567.           TargetPos.Y := 0;
  2568.         end;
  2569.         DragMessage(DragSave.DragHandle, DragMsg, DragSave,
  2570.           DragSave.DragTarget, DragSave.DragPos);
  2571.       end;
  2572.     finally
  2573.       QualifyingSites.Free;
  2574.       QualifyingSites := nil;
  2575.       DragSave.Cancelling := False;
  2576.       DragSave.Finished(DragSave.DragTarget, TargetPos.X, TargetPos.Y, Accepted);
  2577.       DragObject := nil;
  2578.     end;
  2579.   finally
  2580.     DragControl := nil;
  2581.     if DragFreeObject then DragSave.Free;
  2582.   end;
  2583. end;
  2584.  
  2585. procedure CancelDrag;
  2586. begin
  2587.   if DragObject <> nil then DragDone(False);
  2588.   DragControl := nil;
  2589. end;
  2590.  
  2591. function FindVCLWindow(const Pos: TPoint): TWinControl;
  2592. var
  2593.   Handle: HWND;
  2594. begin
  2595.   Handle := WindowFromPoint(Pos);
  2596.   Result := nil;
  2597.   while Handle <> 0 do
  2598.   begin
  2599.     Result := FindControl(Handle);
  2600.     if Result <> nil then Exit;
  2601.     Handle := GetParent(Handle);
  2602.   end;
  2603. end;
  2604.  
  2605. function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl;
  2606. var
  2607.   Window: TWinControl;
  2608.   Control: TControl;
  2609. begin
  2610.   Result := nil;
  2611.   Window := FindVCLWindow(Pos);
  2612.   if Window <> nil then
  2613.   begin
  2614.     Result := Window;
  2615.     Control := Window.ControlAtPos(Window.ScreenToClient(Pos), AllowDisabled);
  2616.     if Control <> nil then Result := Control;
  2617.   end;
  2618. end;
  2619.  
  2620. { List helpers }
  2621.  
  2622. procedure ListAdd(var List: TList; Item: Pointer);
  2623. begin
  2624.   if List = nil then List := TList.Create;
  2625.   List.Add(Item);
  2626. end;
  2627.  
  2628. procedure ListRemove(var List: TList; Item: Pointer);
  2629. begin
  2630.   List.Remove(Item);
  2631.   if List.Count = 0 then
  2632.   begin
  2633.     List.Free;
  2634.     List := nil;
  2635.   end;
  2636. end;
  2637.  
  2638. { Miscellaneous routines }
  2639.  
  2640. procedure MoveWindowOrg(DC: HDC; DX, DY: Integer);
  2641. var
  2642.   P: TPoint;
  2643. begin
  2644.   GetWindowOrgEx(DC, P);
  2645.   SetWindowOrgEx(DC, P.X - DX, P.Y - DY, nil);
  2646. end;
  2647.  
  2648. { Object implementations }
  2649.  
  2650. { TControlCanvas }
  2651.  
  2652. const
  2653.   CanvasListCacheSize = 4;
  2654.  
  2655. var
  2656.   CanvasList: TThreadList;
  2657.  
  2658. // Free the first available device context
  2659. procedure FreeDeviceContext;
  2660. var
  2661.   I: Integer;
  2662. begin
  2663.   with CanvasList.LockList do
  2664.   try
  2665.     for I := 0 to Count-1 do
  2666.       with TControlCanvas(Items[I]) do
  2667.         if TryLock then
  2668.         try
  2669.           FreeHandle;
  2670.           Exit;
  2671.         finally
  2672.           Unlock;
  2673.         end;
  2674.   finally
  2675.     CanvasList.UnlockList;
  2676.   end;
  2677. end;
  2678.  
  2679. procedure FreeDeviceContexts;
  2680. var
  2681.   I: Integer;
  2682. begin
  2683.   with CanvasList.LockList do
  2684.   try
  2685.     for I := Count-1 downto 0 do
  2686.       with TControlCanvas(Items[I]) do
  2687.         if TryLock then
  2688.         try
  2689.           FreeHandle;
  2690.         finally
  2691.           Unlock;
  2692.         end;
  2693.   finally
  2694.     CanvasList.UnlockList;
  2695.   end;
  2696. end;
  2697.  
  2698. destructor TControlCanvas.Destroy;
  2699. begin
  2700.   FreeHandle;
  2701.   inherited Destroy;
  2702. end;
  2703.  
  2704. procedure TControlCanvas.CreateHandle;
  2705. begin
  2706.   if FControl = nil then inherited CreateHandle else
  2707.   begin
  2708.     if FDeviceContext = 0 then
  2709.     begin
  2710.       with CanvasList.LockList do
  2711.       try
  2712.         if Count >= CanvasListCacheSize then FreeDeviceContext;
  2713.         FDeviceContext := FControl.GetDeviceContext(FWindowHandle);
  2714.         Add(Self);
  2715.       finally
  2716.         CanvasList.UnlockList;
  2717.       end;
  2718.     end;
  2719.     Handle := FDeviceContext;
  2720.     UpdateTextFlags;
  2721.   end;
  2722. end;
  2723.  
  2724. procedure TControlCanvas.FreeHandle;
  2725. begin
  2726.   if FDeviceContext <> 0 then
  2727.   begin
  2728.     Handle := 0;
  2729.     CanvasList.Remove(Self);
  2730.     ReleaseDC(FWindowHandle, FDeviceContext);
  2731.     FDeviceContext := 0;
  2732.   end;
  2733. end;
  2734.  
  2735. procedure TControlCanvas.SetControl(AControl: TControl);
  2736. begin
  2737.   if FControl <> AControl then
  2738.   begin
  2739.     FreeHandle;
  2740.     FControl := AControl;
  2741.   end;
  2742. end;
  2743.  
  2744. procedure TControlCanvas.UpdateTextFlags;
  2745. begin
  2746.   if Control = nil then Exit;
  2747.   if Control.UseRightToLeftReading then
  2748.     TextFlags := TextFlags or ETO_RTLREADING
  2749.   else
  2750.     TextFlags := TextFlags and not ETO_RTLREADING;
  2751. end;
  2752.  
  2753. { TSizeConstraints }
  2754.  
  2755. constructor TSizeConstraints.Create(Control: TControl);
  2756. begin
  2757.   inherited Create;
  2758.   FControl := Control;
  2759. end;
  2760.  
  2761. procedure TSizeConstraints.AssignTo(Dest: TPersistent);
  2762. begin
  2763.   if Dest is TSizeConstraints then
  2764.     with TSizeConstraints(Dest) do
  2765.     begin
  2766.       FMaxHeight := Self.FMaxHeight;
  2767.       FMaxWidth := Self.FMaxWidth;
  2768.       FMinHeight := Self.FMinHeight;
  2769.       FMaxHeight := Self.FMaxHeight;
  2770.       Change;
  2771.     end
  2772.   else inherited AssignTo(Dest);
  2773. end;
  2774.  
  2775. procedure TSizeConstraints.SetConstraints(Index: Integer;
  2776.   Value: TConstraintSize);
  2777. begin
  2778.   case Index of
  2779.     0:
  2780.       if Value <> FMaxHeight then
  2781.       begin
  2782.         FMaxHeight := Value;
  2783.         if (Value > 0) and (Value < FMinHeight) then
  2784.           FMinHeight := Value;
  2785.         Change;
  2786.       end;
  2787.     1:
  2788.       if Value <> FMaxWidth then
  2789.       begin
  2790.         FMaxWidth := Value;
  2791.         if (Value > 0) and (Value < FMinWidth) then
  2792.           FMinWidth := Value;
  2793.         Change;
  2794.       end;
  2795.     2:
  2796.       if Value <> FMinHeight then
  2797.       begin
  2798.         FMinHeight := Value;
  2799.         if (FMaxHeight > 0) and (Value > FMaxHeight) then
  2800.           FMaxHeight := Value;
  2801.         Change;
  2802.       end;
  2803.     3:
  2804.       if Value <> FMinWidth then
  2805.       begin
  2806.         FMinWidth := Value;
  2807.         if (FMaxWidth > 0) and (Value > FMaxWidth) then
  2808.           FMaxWidth := Value;
  2809.         Change;
  2810.       end;
  2811.   end;
  2812. end;
  2813.  
  2814. procedure TSizeConstraints.Change;
  2815. begin
  2816.   if Assigned(FOnChange) then FOnChange(Self);
  2817. end;
  2818.  
  2819. { TControlActionLink }
  2820.  
  2821. procedure TControlActionLink.AssignClient(AClient: TObject);
  2822. begin
  2823.   FClient := AClient as TControl;
  2824. end;
  2825.  
  2826. function TControlActionLink.DoShowHint(var HintStr: string): Boolean;
  2827. begin
  2828.   Result := True;
  2829.   if Action is TCustomAction then
  2830.   begin
  2831.     if TCustomAction(Action).DoHint(HintStr) and Application.HintShortCuts and
  2832.       (TCustomAction(Action).ShortCut <> scNone) then
  2833.     begin
  2834.       if HintStr <> '' then
  2835.         HintStr := Format('%s (%s)', [HintStr, ShortCutToText(TCustomAction(Action).ShortCut)]);
  2836.     end;
  2837.   end;
  2838. end;
  2839.  
  2840. function TControlActionLink.IsCaptionLinked: Boolean;
  2841. begin
  2842.   Result := inherited IsCaptionLinked and
  2843.     (FClient.Caption = (Action as TCustomAction).Caption);
  2844. end;
  2845.  
  2846. function TControlActionLink.IsEnabledLinked: Boolean;
  2847. begin
  2848.   Result := inherited IsEnabledLinked and
  2849.     (FClient.Enabled = (Action as TCustomAction).Enabled);
  2850. end;
  2851.  
  2852. function TControlActionLink.IsHintLinked: Boolean;
  2853. begin
  2854.   Result := inherited IsHintLinked and
  2855.     (FClient.Hint = (Action as TCustomAction).Hint);
  2856. end;
  2857.  
  2858. function TControlActionLink.IsVisibleLinked: Boolean;
  2859. begin
  2860.   Result := inherited IsVisibleLinked and
  2861.     (FClient.Visible = (Action as TCustomAction).Visible);
  2862. end;
  2863.  
  2864. function TControlActionLink.IsOnExecuteLinked: Boolean;
  2865. begin
  2866.   Result := inherited IsOnExecuteLinked and
  2867.     (@FClient.OnClick = @Action.OnExecute);
  2868. end;
  2869.  
  2870. procedure TControlActionLink.SetCaption(const Value: string);
  2871. begin
  2872.   if IsCaptionLinked then FClient.Caption := Value;
  2873. end;
  2874.  
  2875. procedure TControlActionLink.SetEnabled(Value: Boolean);
  2876. begin
  2877.   if IsEnabledLinked then FClient.Enabled := Value;
  2878. end;
  2879.  
  2880. procedure TControlActionLink.SetHint(const Value: string);
  2881. begin
  2882.   if IsHintLinked then FClient.Hint := Value;
  2883. end;
  2884.  
  2885. procedure TControlActionLink.SetVisible(Value: Boolean);
  2886. begin
  2887.   if IsVisibleLinked then FClient.Visible := Value;
  2888. end;
  2889.  
  2890. procedure TControlActionLink.SetOnExecute(Value: TNotifyEvent);
  2891. begin
  2892.   if IsOnExecuteLinked then FClient.OnClick := Value;
  2893. end;
  2894.  
  2895. { TControl }
  2896.  
  2897. constructor TControl.Create(AOwner: TComponent);
  2898. begin
  2899.   inherited Create(AOwner);
  2900.   FWindowProc := WndProc;
  2901.   FControlStyle := [csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks];
  2902.   FFont := TFont.Create;
  2903.   FFont.OnChange := FontChanged;
  2904.   FAnchors := [akLeft, akTop];
  2905.   FConstraints := TSizeConstraints.Create(Self);
  2906.   FConstraints.OnChange := DoConstraintsChange;
  2907.   FColor := clWindow;
  2908.   FVisible := True;
  2909.   FEnabled := True;
  2910.   FParentFont := True;
  2911.   FParentColor := True;
  2912.   FParentShowHint := True;
  2913.   FParentBiDiMode := True;
  2914.   FIsControl := False;
  2915.   FDragCursor := crDrag;
  2916.   FFloatingDockSiteClass := TCustomDockForm;
  2917. end;
  2918.  
  2919. destructor TControl.Destroy;
  2920. begin
  2921.   Application.ControlDestroyed(Self);
  2922.   if (FHostDockSite <> nil) and not (csDestroying in FHostDockSite.ComponentState) then
  2923.   begin
  2924.     FHostDockSite.Perform(CM_UNDOCKCLIENT, 0, Integer(Self));
  2925.     SetParent(nil);
  2926.     Dock(NullDockSite, BoundsRect);
  2927.     FHostDockSite := nil;
  2928.   end else
  2929.     SetParent(nil);
  2930.   FActionLink.Free;
  2931.   FActionLink := nil;
  2932.   FConstraints.Free;
  2933.   FFont.Free;
  2934.   StrDispose(FText);
  2935.   inherited Destroy;
  2936. end;
  2937.  
  2938. function TControl.GetDragImages: TDragImageList;
  2939. begin
  2940.   Result := nil;
  2941. end;
  2942.  
  2943. function TControl.GetEnabled: Boolean;
  2944. begin
  2945.   Result := FEnabled;
  2946. end;
  2947.  
  2948. function TControl.GetPalette: HPALETTE;
  2949. begin
  2950.   Result := 0;
  2951. end;
  2952.  
  2953. function TControl.HasParent: Boolean;
  2954. begin
  2955.   Result := FParent <> nil;
  2956. end;
  2957.  
  2958. function TControl.GetParentComponent: TComponent;
  2959. begin
  2960.   Result := Parent;
  2961. end;
  2962.  
  2963. procedure TControl.SetParentComponent(Value: TComponent);
  2964. begin
  2965.   if (Parent <> Value) and (Value is TWinControl) then
  2966.     SetParent(TWinControl(Value));
  2967. end;
  2968.  
  2969. function TControl.PaletteChanged(Foreground: Boolean): Boolean;
  2970. var
  2971.   OldPalette, Palette: HPALETTE;
  2972.   WindowHandle: HWnd;
  2973.   DC: HDC;
  2974. begin
  2975.   Result := False;
  2976.   if not Visible then Exit;
  2977.   Palette := GetPalette;
  2978.   if Palette <> 0 then
  2979.   begin
  2980.     DC := GetDeviceContext(WindowHandle);
  2981.     OldPalette := SelectPalette(DC, Palette, not Foreground);
  2982.     if RealizePalette(DC) <> 0 then Invalidate;
  2983.     SelectPalette(DC, OldPalette, True);
  2984.     ReleaseDC(WindowHandle, DC);
  2985.     Result := True;
  2986.   end;
  2987. end;
  2988.  
  2989. function TControl.GetAction: TBasicAction;
  2990. begin
  2991.   if ActionLink <> nil then
  2992.     Result := ActionLink.Action else
  2993.     Result := nil;
  2994. end;
  2995.  
  2996.  
  2997. procedure TControl.SetAnchors(Value: TAnchors);
  2998. begin
  2999.   if FAnchors <> Value then
  3000.   begin
  3001.     FAnchors := Value;
  3002.     UpdateAnchorRules;
  3003.   end;
  3004. end;
  3005.  
  3006. procedure TControl.SetAction(Value: TBasicAction);
  3007. begin
  3008.   if Value = nil then
  3009.   begin
  3010.     ActionLink.Free;
  3011.     ActionLink := nil;
  3012.     Exclude(FControlStyle, csActionClient);
  3013.   end
  3014.   else
  3015.   begin
  3016.     Include(FControlStyle, csActionClient);
  3017.     if ActionLink = nil then
  3018.       ActionLink := GetActionLinkClass.Create(Self);
  3019.     ActionLink.Action := Value;
  3020.     ActionLink.OnChange := DoActionChange;
  3021.     ActionChange(Value, csLoading in Value.ComponentState);
  3022.     Value.FreeNotification(Self);
  3023.   end;
  3024. end;
  3025.  
  3026. function TControl.IsAnchorsStored: Boolean;
  3027. begin
  3028.   Result := Anchors <> AnchorAlign[Align];
  3029. end;
  3030.  
  3031. procedure TControl.SetDragMode(Value: TDragMode);
  3032. begin
  3033.   FDragMode := Value;
  3034. end;
  3035.  
  3036. procedure TControl.RequestAlign;
  3037. begin
  3038.   if Parent <> nil then Parent.AlignControl(Self);
  3039. end;
  3040.  
  3041. procedure TControl.Resize;
  3042. begin
  3043.   if Assigned(FOnResize) then FOnResize(Self);
  3044. end;
  3045.  
  3046. procedure TControl.ReadState(Reader: TReader);
  3047. begin
  3048.   Include(FControlState, csReadingState);
  3049.   if Reader.Parent is TWinControl then Parent := TWinControl(Reader.Parent);
  3050.   inherited ReadState(Reader);
  3051.   Exclude(FControlState, csReadingState);
  3052.   if Parent <> nil then
  3053.   begin
  3054.     Perform(CM_PARENTCOLORCHANGED, 0, 0);
  3055.     Perform(CM_PARENTFONTCHANGED, 0, 0);
  3056.     Perform(CM_PARENTSHOWHINTCHANGED, 0, 0);
  3057.     Perform(CM_SYSFONTCHANGED, 0, 0);
  3058.     Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
  3059.   end;
  3060. end;
  3061.  
  3062. procedure TControl.Notification(AComponent: TComponent;
  3063.   Operation: TOperation);
  3064. begin
  3065.   inherited Notification(AComponent, Operation);
  3066.   if Operation = opRemove then
  3067.     if AComponent = PopupMenu then PopupMenu := nil
  3068.     else if AComponent = Action then Action := nil;
  3069. end;
  3070.  
  3071. procedure TControl.SetAlign(Value: TAlign);
  3072. var
  3073.   OldAlign: TAlign;
  3074. begin
  3075.   if FAlign <> Value then
  3076.   begin
  3077.     OldAlign := FAlign;
  3078.     FAlign := Value;
  3079.     Anchors := AnchorAlign[Value];
  3080.     if not (csLoading in ComponentState) and (not (csDesigning in ComponentState) or
  3081.       (Parent <> nil)) then
  3082.       if ((OldAlign in [alTop, alBottom]) = (Value in [alRight, alLeft])) and
  3083.         not (OldAlign in [alNone, alClient]) and not (Value in [alNone, alClient]) then
  3084.         SetBounds(Left, Top, Height, Width)
  3085.       else
  3086.         AdjustSize;
  3087.   end;
  3088.   RequestAlign;
  3089. end;
  3090.  
  3091. procedure TControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  3092. begin
  3093.   if CheckNewSize(AWidth, AHeight) and
  3094.     ((ALeft <> FLeft) or (ATop <> FTop) or
  3095.     (AWidth <> FWidth) or (AHeight <> FHeight)) then
  3096.   begin
  3097.     InvalidateControl(Visible, False);
  3098.     FLeft := ALeft;
  3099.     FTop := ATop;
  3100.     FWidth := AWidth;
  3101.     FHeight := AHeight;
  3102.     UpdateAnchorRules;
  3103.     Invalidate;
  3104.     Perform(WM_WINDOWPOSCHANGED, 0, 0);
  3105.     RequestAlign;
  3106.     if not (csLoading in ComponentState) then Resize;
  3107.   end;
  3108. end;
  3109.  
  3110. procedure TControl.UpdateAnchorRules;
  3111. var
  3112.   Anchors: TAnchors;
  3113. begin
  3114.   if not FAnchorMove and not (csLoading in ComponentState) then
  3115.   begin
  3116.     Anchors := FAnchors;
  3117.     if Anchors = [akLeft, akTop] then Exit;
  3118.     if akRight in Anchors then
  3119.       if akLeft in Anchors then
  3120.         FAnchorRules.X := Width else
  3121.         FAnchorRules.X := Left
  3122.     else
  3123.       FAnchorRules.X := Left + Width div 2;
  3124.     if akBottom in Anchors then
  3125.       if akTop in Anchors then
  3126.         FAnchorRules.Y := Height else
  3127.         FAnchorRules.Y := Top
  3128.     else
  3129.       FAnchorRules.Y := Top + Height div 2;
  3130.     if (Parent <> nil) and not (csReading in Parent.ComponentState) then
  3131.       if Parent.HandleAllocated then
  3132.         FOriginalParentSize := Parent.ClientRect.BottomRight
  3133.       else
  3134.       begin
  3135.         FOriginalParentSize.X := Parent.Width;
  3136.         FOriginalParentSize.Y := Parent.Height;
  3137.       end;
  3138.   end;
  3139. end;
  3140.  
  3141. procedure TControl.SetLeft(Value: Integer);
  3142. begin
  3143.   SetBounds(Value, FTop, FWidth, FHeight);
  3144.   Include(FScalingFlags, sfLeft);
  3145. end;
  3146.  
  3147. procedure TControl.SetTop(Value: Integer);
  3148. begin
  3149.   SetBounds(FLeft, Value, FWidth, FHeight);
  3150.   Include(FScalingFlags, sfTop);
  3151. end;
  3152.  
  3153. procedure TControl.SetWidth(Value: Integer);
  3154. begin
  3155.   SetBounds(FLeft, FTop, Value, FHeight);
  3156.   Include(FScalingFlags, sfWidth);
  3157. end;
  3158.  
  3159. procedure TControl.SetHeight(Value: Integer);
  3160. begin
  3161.   SetBounds(FLeft, FTop, FWidth, Value);
  3162.   Include(FScalingFlags, sfHeight);
  3163. end;
  3164.  
  3165. procedure TControl.Dock(NewDockSite: TWinControl; ARect: TRect);
  3166. var
  3167.   PrevDockSite: TWinControl;
  3168. begin
  3169.   if HostDockSite <> NewDockSite then
  3170.   begin
  3171.     if (FHostDockSite <> nil) and (FHostDockSite.FDockClients <> nil) then
  3172.       FHostDockSite.FDockClients.Remove(Self);
  3173.     if (NewDockSite <> nil) and (NewDockSite <> NullDockSite) and
  3174.       (NewDockSite.FDockClients <> nil) then
  3175.       NewDockSite.FDockClients.Add(Self);
  3176.   end;
  3177.   Include(FControlState, csDocking);
  3178.   try
  3179.     if NewDockSite <> NullDockSite then
  3180.       DoDock(NewDockSite, ARect);
  3181.     if FHostDockSite <> NewDockSite then
  3182.     begin
  3183.       PrevDockSite := FHostDockSite;
  3184.       if NewDockSite <> NullDockSite then
  3185.       begin
  3186.         FHostDockSite := NewDockSite;
  3187.         if NewDockSite <> nil then NewDockSite.DoAddDockClient(Self, ARect);
  3188.       end
  3189.       else
  3190.         FHostDockSite := nil;
  3191.       if PrevDockSite <> nil then PrevDockSite.DoRemoveDockClient(Self);
  3192.     end;
  3193.   finally
  3194.     Exclude(FControlState, csDocking);
  3195.   end;
  3196. end;
  3197.  
  3198. procedure TControl.DoDock(NewDockSite: TWinControl; var ARect: TRect);
  3199. begin
  3200.   { Erase TControls before UpdateboundsRect modifies position }
  3201.   if not (Self is TWinControl) then InvalidateControl(Visible, False);
  3202.   if Parent <> NewDockSite then
  3203.     UpdateBoundsRect(ARect) else
  3204.     BoundsRect := ARect;
  3205.   if (NewDockSite = nil) or (NewDockSite = NullDockSite) then Parent := nil;
  3206. end;
  3207.  
  3208. procedure TControl.SetHostDockSite(Value: TWinControl);
  3209. begin
  3210.   Dock(Value, BoundsRect);
  3211. end;
  3212.  
  3213. function TControl.GetBoundsRect: TRect;
  3214. begin
  3215.   Result.Left := Left;
  3216.   Result.Top := Top;
  3217.   Result.Right := Left + Width;
  3218.   Result.Bottom := Top + Height;
  3219. end;
  3220.  
  3221. procedure TControl.SetBoundsRect(const Rect: TRect);
  3222. begin
  3223.   with Rect do SetBounds(Left, Top, Right - Left, Bottom - Top);
  3224. end;
  3225.  
  3226. function TControl.GetClientRect: TRect;
  3227. begin
  3228.   Result.Left := 0;
  3229.   Result.Top := 0;
  3230.   Result.Right := Width;
  3231.   Result.Bottom := Height;
  3232. end;
  3233.  
  3234. function TControl.GetClientWidth: Integer;
  3235. begin
  3236.   Result := ClientRect.Right;
  3237. end;
  3238.  
  3239. procedure TControl.SetClientWidth(Value: Integer);
  3240. begin
  3241.   SetClientSize(Point(Value, ClientHeight));
  3242. end;
  3243.  
  3244. function TControl.GetClientHeight: Integer;
  3245. begin
  3246.   Result := ClientRect.Bottom;
  3247. end;
  3248.  
  3249. procedure TControl.SetClientHeight(Value: Integer);
  3250. begin
  3251.   SetClientSize(Point(ClientWidth, Value));
  3252. end;
  3253.  
  3254. function TControl.GetClientOrigin: TPoint;
  3255. begin
  3256.   if Parent = nil then
  3257.     raise EInvalidOperation.CreateFmt(SParentRequired, [Name]);
  3258.   Result := Parent.ClientOrigin;
  3259.   Inc(Result.X, FLeft);
  3260.   Inc(Result.Y, FTop);
  3261. end;
  3262.  
  3263. function TControl.ClientToScreen(const Point: TPoint): TPoint;
  3264. var
  3265.   Origin: TPoint;
  3266. begin
  3267.   Origin := ClientOrigin;
  3268.   Result.X := Point.X + Origin.X;
  3269.   Result.Y := Point.Y + Origin.Y;
  3270. end;
  3271.  
  3272. function TControl.ScreenToClient(const Point: TPoint): TPoint;
  3273. var
  3274.   Origin: TPoint;
  3275. begin
  3276.   Origin := ClientOrigin;
  3277.   Result.X := Point.X - Origin.X;
  3278.   Result.Y := Point.Y - Origin.Y;
  3279. end;
  3280.  
  3281. procedure TControl.SendCancelMode(Sender: TControl);
  3282. var
  3283.   Control: TControl;
  3284. begin
  3285.   Control := Self;
  3286.   while Control <> nil do
  3287.   begin
  3288.     if Control is TCustomForm then
  3289.       TCustomForm(Control).SendCancelMode(Sender);
  3290.     Control := Control.Parent;
  3291.   end;
  3292. end;
  3293.  
  3294. procedure TControl.SendDockNotification(Msg: Cardinal; WParam, LParam: Integer);
  3295. var
  3296.   NotifyRec: TDockNotifyRec;
  3297. begin
  3298.   if (FHostDockSite <> nil) and (DragObject = nil) and
  3299.     (ComponentState * [csLoading, csDestroying] = []) then
  3300.   begin
  3301.     with NotifyRec do
  3302.     begin
  3303.       ClientMsg := Msg;
  3304.       MsgWParam := WParam;
  3305.       MsgLParam := LParam;
  3306.     end;
  3307.     FHostDockSite.Perform(CM_DOCKNOTIFICATION, Integer(Self), Integer(@NotifyRec));
  3308.   end;
  3309. end;
  3310.  
  3311. procedure TControl.Changed;
  3312. begin
  3313.   Perform(CM_CHANGED, 0, Longint(Self));
  3314. end;
  3315.  
  3316. procedure TControl.ChangeScale(M, D: Integer);
  3317. var
  3318.   X, Y, W, H: Integer;
  3319.   Flags: TScalingFlags;
  3320. begin
  3321.   if M <> D then
  3322.   begin
  3323.     if csLoading in ComponentState then
  3324.       Flags := ScalingFlags else
  3325.       Flags := [sfLeft, sfTop, sfWidth, sfHeight, sfFont];
  3326.     if sfLeft in Flags then
  3327.       X := MulDiv(FLeft, M, D) else
  3328.       X := FLeft;
  3329.     if sfTop in Flags then
  3330.       Y := MulDiv(FTop, M, D) else
  3331.       Y := FTop;
  3332.     if (sfWidth in Flags) and not (csFixedWidth in ControlStyle) then
  3333.       if sfLeft in Flags then
  3334.         W := MulDiv(FLeft + FWidth, M, D) - X else
  3335.         W := MulDiv(FWidth, M, D)
  3336.     else W := FWidth;
  3337.     if (sfHeight in Flags) and not (csFixedHeight in ControlStyle) then
  3338.       if sfHeight in Flags then
  3339.         H := MulDiv(FTop + FHeight, M, D) - Y else
  3340.         H := MulDiv(FTop, M, D )
  3341.     else H := FHeight;
  3342.     SetBounds(X, Y, W, H);
  3343.     if not ParentFont and (sfFont in Flags) then
  3344.       Font.Size := MulDiv(Font.Size, M, D);
  3345.   end;
  3346.   FScalingFlags := [];
  3347. end;
  3348.  
  3349. procedure TControl.SetAutoSize(Value: Boolean);
  3350. begin
  3351.   if FAutoSize <> Value then
  3352.   begin
  3353.     FAutoSize := Value;
  3354.     if Value then AdjustSize;
  3355.   end;
  3356. end;
  3357.  
  3358. procedure TControl.SetName(const Value: TComponentName);
  3359. var
  3360.   ChangeText: Boolean;
  3361. begin
  3362.   ChangeText := (csSetCaption in ControlStyle) and
  3363.     not (csLoading in ComponentState) and (Name = Text) and
  3364.     ((Owner = nil) or not (Owner is TControl) or
  3365.     not (csLoading in TControl(Owner).ComponentState));
  3366.   inherited SetName(Value);
  3367.   if ChangeText then Text := Value;
  3368. end;
  3369.  
  3370. procedure TControl.SetClientSize(Value: TPoint);
  3371. var
  3372.   Client: TRect;
  3373. begin
  3374.   Client := GetClientRect;
  3375.   SetBounds(FLeft, FTop, Width - Client.Right + Value.X, Height -
  3376.     Client.Bottom + Value.Y);
  3377. end;
  3378.  
  3379. procedure TControl.SetParent(AParent: TWinControl);
  3380. begin
  3381.   if FParent <> AParent then
  3382.   begin
  3383.     if AParent = Self then
  3384.       raise EInvalidOperation.CreateRes(@SControlParentSetToSelf);
  3385.     if FParent <> nil then
  3386.       FParent.RemoveControl(Self);
  3387.     if AParent <> nil then
  3388.     begin
  3389.       AParent.InsertControl(Self);
  3390.       UpdateAnchorRules;
  3391.     end;
  3392.   end;
  3393. end;
  3394.  
  3395. procedure TControl.SetVisible(Value: Boolean);
  3396. begin
  3397.   if FVisible <> Value then
  3398.   begin
  3399.     VisibleChanging;
  3400.     FVisible := Value;
  3401.     Perform(CM_VISIBLECHANGED, Ord(Value), 0);
  3402.     RequestAlign;
  3403.   end;
  3404. end;
  3405.  
  3406. procedure TControl.SetEnabled(Value: Boolean);
  3407. begin
  3408.   if FEnabled <> Value then
  3409.   begin
  3410.     FEnabled := Value;
  3411.     Perform(CM_ENABLEDCHANGED, 0, 0);
  3412.   end;
  3413. end;
  3414.  
  3415. function TControl.GetTextLen: Integer;
  3416. begin
  3417.   Result := Perform(WM_GETTEXTLENGTH, 0, 0);
  3418. end;
  3419.  
  3420. function TControl.GetTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  3421. begin
  3422.   Result := Perform(WM_GETTEXT, BufSize, Longint(Buffer));
  3423. end;
  3424.  
  3425. function TControl.GetUndockHeight: Integer;
  3426. begin
  3427.   if FUndockHeight > 0 then Result := FUndockHeight
  3428.   else Result := Height;
  3429. end;
  3430.  
  3431. function TControl.GetUndockWidth: Integer;
  3432. begin
  3433.   if FUndockWidth > 0 then Result := FUndockWidth
  3434.   else Result := Width;
  3435. end;
  3436.  
  3437. function TControl.GetTBDockHeight: Integer;
  3438. begin
  3439.   if FTBDockHeight > 0 then Result := FTBDockHeight
  3440.   else Result := UndockHeight;
  3441. end;
  3442.  
  3443. function TControl.GetLRDockWidth: Integer;
  3444. begin
  3445.   if FLRDockWidth > 0 then Result := FLRDockWidth
  3446.   else Result := UndockWidth;
  3447. end;
  3448.  
  3449. procedure TControl.SetPopupMenu(Value: TPopupMenu);
  3450. begin
  3451.   FPopupMenu := Value;
  3452.   if Value <> nil then
  3453.   begin
  3454.     Value.ParentBiDiModeChanged(Self);
  3455.     Value.FreeNotification(Self);
  3456.   end;
  3457. end;
  3458.  
  3459. procedure TControl.SetTextBuf(Buffer: PChar);
  3460. begin
  3461.   Perform(WM_SETTEXT, 0, Longint(Buffer));
  3462.   Perform(CM_TEXTCHANGED, 0, 0);
  3463. end;
  3464.  
  3465. function TControl.GetText: TCaption;
  3466. var
  3467.   Len: Integer;
  3468. begin
  3469.   Len := GetTextLen;
  3470.   SetString(Result, PChar(nil), Len);
  3471.   if Len <> 0 then GetTextBuf(Pointer(Result), Len + 1);
  3472. end;
  3473.  
  3474. procedure TControl.SetText(const Value: TCaption);
  3475. begin
  3476.   if GetText <> Value then SetTextBuf(PChar(Value));
  3477. end;
  3478.  
  3479. procedure TControl.SetBiDiMode(Value: TBiDiMode);
  3480. begin
  3481.   if FBiDiMode <> Value then
  3482.   begin
  3483.     FBiDiMode := Value;
  3484.     FParentBiDiMode := False;
  3485.     Perform(CM_BIDIMODECHANGED, 0, 0);
  3486.   end;
  3487. end;
  3488.  
  3489. procedure TControl.FontChanged(Sender: TObject);
  3490. begin
  3491.   FParentFont := False;
  3492.   FDesktopFont := False;
  3493.   if Font.Height <> FFontHeight then
  3494.   begin
  3495.     Include(FScalingFlags, sfFont);
  3496.     FFontHeight := Font.Height;
  3497.   end;
  3498.   Perform(CM_FONTCHANGED, 0, 0);
  3499. end;
  3500.  
  3501. procedure TControl.SetFont(Value: TFont);
  3502. begin
  3503.   FFont.Assign(Value);
  3504. end;
  3505.  
  3506. function TControl.IsFontStored: Boolean;
  3507. begin
  3508.   Result := not ParentFont and not DesktopFont;
  3509. end;
  3510.  
  3511. function TControl.IsShowHintStored: Boolean;
  3512. begin
  3513.   Result := not ParentShowHint;
  3514. end;
  3515.  
  3516. function TControl.IsBiDiModeStored: Boolean;
  3517. begin
  3518.   Result := not ParentBiDiMode;
  3519. end;
  3520.  
  3521. procedure TControl.SetParentFont(Value: Boolean);
  3522. begin
  3523.   if FParentFont <> Value then
  3524.   begin
  3525.     FParentFont := Value;
  3526.     if FParent <> nil then Perform(CM_PARENTFONTCHANGED, 0, 0);
  3527.   end;
  3528. end;
  3529.  
  3530. procedure TControl.SetDesktopFont(Value: Boolean);
  3531. begin
  3532.   if FDesktopFont <> Value then
  3533.   begin
  3534.     FDesktopFont := Value;
  3535.     Perform(CM_SYSFONTCHANGED, 0, 0);
  3536.   end;
  3537. end;
  3538.  
  3539. procedure TControl.SetShowHint(Value: Boolean);
  3540. begin
  3541.   if FShowHint <> Value then
  3542.   begin
  3543.     FShowHint := Value;
  3544.     FParentShowHint := False;
  3545.     Perform(CM_SHOWHINTCHANGED, 0, 0);
  3546.   end;
  3547. end;
  3548.  
  3549. procedure TControl.SetParentShowHint(Value: Boolean);
  3550. begin
  3551.   if FParentShowHint <> Value then
  3552.   begin
  3553.     FParentShowHint := Value;
  3554.     if FParent <> nil then Perform(CM_PARENTSHOWHINTCHANGED, 0, 0);
  3555.   end;
  3556. end;
  3557.  
  3558. procedure TControl.SetColor(Value: TColor);
  3559. begin
  3560.   if FColor <> Value then
  3561.   begin
  3562.     FColor := Value;
  3563.     FParentColor := False;
  3564.     Perform(CM_COLORCHANGED, 0, 0);
  3565.   end;
  3566. end;
  3567.  
  3568. function TControl.IsColorStored: Boolean;
  3569. begin
  3570.   Result := not ParentColor;
  3571. end;
  3572.  
  3573. procedure TControl.SetParentColor(Value: Boolean);
  3574. begin
  3575.   if FParentColor <> Value then
  3576.   begin
  3577.     FParentColor := Value;
  3578.     if FParent <> nil then Perform(CM_PARENTCOLORCHANGED, 0, 0);
  3579.   end;
  3580. end;
  3581.  
  3582. procedure TControl.SetParentBiDiMode(Value: Boolean);
  3583. begin
  3584.   if FParentBiDiMode <> Value then
  3585.   begin
  3586.     FParentBiDiMode := Value;
  3587.     if FParent <> nil then Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
  3588.   end;
  3589. end;
  3590.  
  3591. procedure TControl.SetCursor(Value: TCursor);
  3592. begin
  3593.   if FCursor <> Value then
  3594.   begin
  3595.     FCursor := Value;
  3596.     Perform(CM_CURSORCHANGED, 0, 0);
  3597.   end;
  3598. end;
  3599.  
  3600. function TControl.GetMouseCapture: Boolean;
  3601. begin
  3602.   Result := GetCaptureControl = Self;
  3603. end;
  3604.  
  3605. procedure TControl.SetMouseCapture(Value: Boolean);
  3606. begin
  3607.   if MouseCapture <> Value then
  3608.     if Value then SetCaptureControl(Self) else SetCaptureControl(nil);
  3609. end;
  3610.  
  3611. procedure TControl.BringToFront;
  3612. begin
  3613.   SetZOrder(True);
  3614. end;
  3615.  
  3616. procedure TControl.SendToBack;
  3617. begin
  3618.   SetZOrder(False);
  3619. end;
  3620.  
  3621. procedure TControl.SetZOrderPosition(Position: Integer);
  3622. var
  3623.   I, Count: Integer;
  3624.   ParentForm: TCustomForm;
  3625. begin
  3626.   if FParent <> nil then
  3627.   begin
  3628.     I := FParent.FControls.IndexOf(Self);
  3629.     if I >= 0 then
  3630.     begin
  3631.       Count := FParent.FControls.Count;
  3632.       if Position < 0 then Position := 0;
  3633.       if Position >= Count then Position := Count - 1;
  3634.       if Position <> I then
  3635.       begin
  3636.         FParent.FControls.Delete(I);
  3637.         FParent.FControls.Insert(Position, Self);
  3638.         InvalidateControl(Visible, True);
  3639.         ParentForm := ValidParentForm(Self);
  3640.         if csPalette in ParentForm.ControlState then
  3641.           TControl(ParentForm).PaletteChanged(True);
  3642.       end;
  3643.     end;
  3644.   end;
  3645. end;
  3646.  
  3647. procedure TControl.SetZOrder(TopMost: Boolean);
  3648. begin
  3649.   if FParent <> nil then
  3650.     if TopMost then
  3651.       SetZOrderPosition(FParent.FControls.Count - 1) else
  3652.       SetZOrderPosition(0);
  3653. end;
  3654.  
  3655. function TControl.GetDeviceContext(var WindowHandle: HWnd): HDC;
  3656. begin
  3657.   if Parent = nil then
  3658.     raise EInvalidOperation.CreateFmt(SParentRequired, [Name]);
  3659.   Result := Parent.GetDeviceContext(WindowHandle);
  3660.   SetViewportOrgEx(Result, Left, Top, nil);
  3661.   IntersectClipRect(Result, 0, 0, Width, Height);
  3662. end;
  3663.  
  3664. procedure TControl.InvalidateControl(IsVisible, IsOpaque: Boolean);
  3665. var
  3666.   Rect: TRect;
  3667.  
  3668.   function BackgroundClipped: Boolean;
  3669.   var
  3670.     R: TRect;
  3671.     List: TList;
  3672.     I: Integer;
  3673.     C: TControl;
  3674.   begin
  3675.     Result := True;
  3676.     List := FParent.FControls;
  3677.     I := List.IndexOf(Self);
  3678.     while I > 0 do
  3679.     begin
  3680.       Dec(I);
  3681.       C := List[I];
  3682.       with C do
  3683.         if C.Visible and (csOpaque in ControlStyle) then
  3684.         begin
  3685.           IntersectRect(R, Rect, BoundsRect);
  3686.           if EqualRect(R, Rect) then Exit;
  3687.         end;
  3688.     end;
  3689.     Result := False;
  3690.   end;
  3691.  
  3692. begin
  3693.   if (IsVisible or (csDesigning in ComponentState) and
  3694.     not (csNoDesignVisible in ControlStyle)) and (Parent <> nil) and
  3695.     Parent.HandleAllocated then
  3696.   begin
  3697.     Rect := BoundsRect;
  3698.     InvalidateRect(Parent.Handle, @Rect, not (IsOpaque or
  3699.       (csOpaque in Parent.ControlStyle) or BackgroundClipped));
  3700.   end;
  3701. end;
  3702.  
  3703. procedure TControl.Invalidate;
  3704. begin
  3705.   InvalidateControl(Visible, csOpaque in ControlStyle);
  3706. end;
  3707.  
  3708. procedure TControl.Hide;
  3709. begin
  3710.   Visible := False;
  3711. end;
  3712.  
  3713. procedure TControl.Show;
  3714. begin
  3715.   if Parent <> nil then Parent.ShowControl(Self);
  3716.   if not (csDesigning in ComponentState) or
  3717.     (csNoDesignVisible in ControlStyle) then Visible := True;
  3718. end;
  3719.  
  3720. procedure TControl.Update;
  3721. begin
  3722.   if Parent <> nil then Parent.Update;
  3723. end;
  3724.  
  3725. procedure TControl.Refresh;
  3726. begin
  3727.   Repaint;
  3728. end;
  3729.  
  3730. procedure TControl.Repaint;
  3731. var
  3732.   DC: HDC;
  3733. begin
  3734.   if (Visible or (csDesigning in ComponentState) and
  3735.     not (csNoDesignVisible in ControlStyle)) and (Parent <> nil) and
  3736.     Parent.HandleAllocated then
  3737.     if csOpaque in ControlStyle then
  3738.     begin
  3739.       DC := GetDC(Parent.Handle);
  3740.       try
  3741.         IntersectClipRect(DC, Left, Top, Left + Width, Top + Height);
  3742.         Parent.PaintControls(DC, Self);
  3743.       finally
  3744.         ReleaseDC(Parent.Handle, DC);
  3745.       end;
  3746.     end else
  3747.     begin
  3748.       Invalidate;
  3749.       Update;
  3750.     end;
  3751. end;
  3752.  
  3753. function TControl.GetControlsAlignment: TAlignment;
  3754. begin
  3755.   Result := taLeftJustify;
  3756. end;
  3757.  
  3758. function TControl.IsRightToLeft: Boolean;
  3759. begin
  3760.   Result := SysLocale.MiddleEast and (BiDiMode <> bdLeftToRight);
  3761. end;
  3762.  
  3763. function TControl.UseRightToLeftReading: Boolean;
  3764. begin
  3765.   Result := SysLocale.MiddleEast and (BiDiMode <> bdLeftToRight);
  3766. end;
  3767.  
  3768. function TControl.UseRightToLeftAlignment: Boolean;
  3769. begin
  3770.   Result := SysLocale.MiddleEast and (BiDiMode = bdRightToLeft);
  3771. end;
  3772.  
  3773. function TControl.UseRightToLeftScrollBar: Boolean;
  3774. begin
  3775.   Result := SysLocale.MiddleEast and
  3776.     (BiDiMode in [bdRightToLeft, bdRightToLeftNoAlign]);
  3777. end;
  3778.  
  3779. procedure TControl.BeginAutoDrag;
  3780. begin
  3781.   BeginDrag(Mouse.DragImmediate, Mouse.DragThreshold);
  3782. end;
  3783.  
  3784. procedure TControl.BeginDrag(Immediate: Boolean; Threshold: Integer);
  3785. var
  3786.   P: TPoint;
  3787. begin
  3788.   if (Self is TCustomForm) and (FDragKind <> dkDock) then
  3789.     raise EInvalidOperation.CreateRes(@SCannotDragForm);
  3790.   CalcDockSizes;
  3791.   if (DragControl = nil) or (DragControl = Pointer($FFFFFFFF)) then
  3792.   begin
  3793.     DragControl := nil;
  3794.     if csLButtonDown in ControlState then
  3795.     begin
  3796.       GetCursorPos(P);
  3797.       P := ScreenToClient(P);
  3798.       Perform(WM_LBUTTONUP, 0, Longint(PointToSmallPoint(P)));
  3799.     end;
  3800.     { Use default value when Threshold < 0 }
  3801.     if Threshold < 0 then
  3802.       Threshold := Mouse.DragThreshold;
  3803.     // prevent calling EndDrag within BeginDrag
  3804.     if DragControl <> Pointer($FFFFFFFF) then
  3805.       DragInitControl(Self, Immediate, Threshold);
  3806.   end;
  3807. end;
  3808.  
  3809. procedure TControl.EndDrag(Drop: Boolean);
  3810. begin
  3811.   if Dragging then DragDone(Drop)
  3812.   // prevent calling EndDrag within BeginDrag
  3813.   else if DragControl = nil then DragControl := Pointer($FFFFFFFF);
  3814. end;
  3815.  
  3816. procedure TControl.DragCanceled;
  3817. begin
  3818. end;
  3819.  
  3820. function TControl.Dragging: Boolean;
  3821. begin
  3822.   Result := DragControl = Self;
  3823. end;
  3824.  
  3825. procedure TControl.DragOver(Source: TObject; X, Y: Integer;
  3826.   State: TDragState; var Accept: Boolean);
  3827. begin
  3828.   Accept := False;
  3829.   if Assigned(FOnDragOver) then
  3830.   begin
  3831.     Accept := True;
  3832.     FOnDragOver(Self, Source, X, Y, State, Accept);
  3833.   end;
  3834. end;
  3835.  
  3836. procedure TControl.DragDrop(Source: TObject; X, Y: Integer);
  3837. begin
  3838.   if Assigned(FOnDragDrop) then FOnDragDrop(Self, Source, X, Y);
  3839. end;
  3840.  
  3841. procedure TControl.DoStartDrag(var DragObject: TDragObject);
  3842. begin
  3843.   if Assigned(FOnStartDrag) then FOnStartDrag(Self, DragObject);
  3844. end;
  3845.  
  3846. procedure TControl.DoEndDrag(Target: TObject; X, Y: Integer);
  3847. begin
  3848.   if Assigned(FOnEndDrag) then FOnEndDrag(Self, Target, X, Y);
  3849. end;
  3850.  
  3851. procedure TControl.PositionDockRect(DragDockObject: TDragDockObject);
  3852. var
  3853.   NewWidth, NewHeight: Integer;
  3854.   TempX, TempY: Double;
  3855. begin
  3856.   with DragDockObject do
  3857.   begin
  3858.     if (DragTarget = nil) or (not TWinControl(DragTarget).UseDockManager) then
  3859.     begin
  3860.       NewWidth := Control.UndockWidth;
  3861.       NewHeight := Control.UndockHeight;
  3862.       // Drag position for dock rect is scaled relative to control's click point.
  3863.       TempX := DragPos.X - ((NewWidth) * FMouseDeltaX);
  3864.       TempY := DragPos.Y - ((NewHeight) * FMouseDeltaY);
  3865.       with FDockRect do
  3866.       begin
  3867.         Left := Round(TempX);
  3868.         Top := Round(TempY);
  3869.         Right := Left + NewWidth;
  3870.         Bottom := Top + NewHeight;
  3871.       end;
  3872.       { Allow DragDockObject final say on this new dock rect }
  3873.       AdjustDockRect(FDockRect);
  3874.     end
  3875.     else begin
  3876.       GetWindowRect(TWinControl(DragTarget).Handle, FDockRect);
  3877.       if TWinControl(DragTarget).UseDockManager and
  3878.         (TWinControl(DragTarget).DockManager <> nil) then
  3879.         TWinControl(DragTarget).DockManager.PositionDockRect(Control,
  3880.           DropOnControl, DropAlign, FDockRect);
  3881.     end;
  3882.   end;
  3883. end;
  3884.  
  3885. procedure TControl.DockTrackNoTarget(Source: TDragDockObject; X, Y: Integer);
  3886. begin
  3887.   PositionDockRect(Source);
  3888. end;
  3889.  
  3890. procedure TControl.DoEndDock(Target: TObject; X, Y: Integer);
  3891. begin
  3892.   if Assigned(FOnEndDock) then FOnEndDock(Self, Target, X, Y);
  3893. end;
  3894.  
  3895. procedure TControl.DoStartDock(var DragObject: TDragObject);
  3896. begin
  3897.   if Assigned(FOnStartDock) then FOnStartDock(Self, TDragDockObject(DragObject));
  3898. end;
  3899.  
  3900. procedure TControl.DefaultDockImage(DragDockObject: TDragDockObject;
  3901.   Erase: Boolean);
  3902. var
  3903.   DesktopWindow: HWND;
  3904.   DC: HDC;
  3905.   OldBrush: HBrush;
  3906.   DrawRect: TRect;
  3907.   PenSize: Integer;
  3908. begin
  3909.   with DragDockObject do
  3910.   begin
  3911.     PenSize := FrameWidth;
  3912.     if Erase then DrawRect := FEraseDockRect
  3913.     else DrawRect := FDockRect;
  3914.   end;
  3915.   DesktopWindow := GetDesktopWindow;
  3916.   DC := GetDCEx(DesktopWindow, 0, DCX_CACHE or DCX_LOCKWINDOWUPDATE);
  3917.   try
  3918.     OldBrush := SelectObject(DC, DragDockObject.Brush.Handle);
  3919.     with DrawRect do
  3920.     begin
  3921.       PatBlt(DC, Left + PenSize, Top, Right - Left - PenSize, PenSize, PATINVERT);
  3922.       PatBlt(DC, Right - PenSize, Top + PenSize, PenSize, Bottom - Top - PenSize, PATINVERT);
  3923.       PatBlt(DC, Left, Bottom - PenSize, Right - Left - PenSize, PenSize, PATINVERT);
  3924.       PatBlt(DC, Left, Top, PenSize, Bottom - Top - PenSize, PATINVERT);
  3925.     end;
  3926.     SelectObject(DC, OldBrush);
  3927.   finally
  3928.     ReleaseDC(DesktopWindow, DC);
  3929.   end;
  3930. end;
  3931.  
  3932. procedure TControl.DrawDragDockImage(DragDockObject: TDragDockObject);
  3933. begin
  3934.   DefaultDockImage(DragDockObject, False);
  3935. end;
  3936.  
  3937. procedure TControl.EraseDragDockImage(DragDockObject: TDragDockObject);
  3938. begin
  3939.   DefaultDockImage(DragDockObject, True);
  3940. end;
  3941.  
  3942. procedure TControl.DoDragMsg(var DragMsg: TCMDrag);
  3943. var
  3944.   S: TObject;
  3945.   Accepts, IsDockOp: Boolean;
  3946. begin
  3947.   with DragMsg, DragRec^ do
  3948.   begin
  3949.     S := Source;
  3950.     IsDockOp := S is TDragDockObject;
  3951.     if DragFreeObject and not IsDockOp then
  3952.       S := (S as TDragControlObject).Control;
  3953.     with ScreenToClient(Pos) do
  3954.       case DragMessage of
  3955.         dmDragEnter, dmDragLeave, dmDragMove:
  3956.           begin
  3957.             Accepts := True;
  3958.             if IsDockOp then
  3959.             begin
  3960.               TWinControl(Target).DockOver(TDragDockObject(S), X, Y,
  3961.                 TDragState(DragMessage), Accepts)
  3962.             end
  3963.             else
  3964.               DragOver(S, X, Y, TDragState(DragMessage), Accepts);
  3965.             Result := Ord(Accepts);
  3966.           end;
  3967.         dmDragDrop:
  3968.           begin
  3969.             if IsDockOp then TWinControl(Target).DockDrop(TDragDockObject(S), X, Y)
  3970.             else DragDrop(S, X, Y);
  3971.           end;
  3972.       end;
  3973.   end;
  3974. end;
  3975.  
  3976. function TControl.ManualDock(NewDockSite: TWinControl; DropControl: TControl;
  3977.   ControlSide: TAlign): Boolean;
  3978. var
  3979.   R: TRect;
  3980.   DockObject: TDragDockObject;
  3981.   HostDockSiteHandle: THandle;
  3982. begin
  3983.   if (NewDockSite = nil) or (NewDockSite = NullDockSite) then
  3984.   begin
  3985.     if (HostDockSite <> nil) and HostDockSite.UseDockManager and
  3986.       (HostDockSite.DockManager <> nil) then
  3987.     begin
  3988.       HostDockSite.DockManager.GetControlBounds(Self, R);
  3989.       MapWindowPoints(HostDockSite.Handle, 0, R.TopLeft, 2);
  3990.     end
  3991.     else begin
  3992.       R.TopLeft := Point(Left, Top);
  3993.       if Parent <> nil then R.TopLeft := Parent.ClientToScreen(R.TopLeft);
  3994.     end;
  3995.     R := Bounds(R.Left, R.Top, UndockWidth, UndockHeight);
  3996.     Result := ManualFloat(R);
  3997.   end
  3998.   else
  3999.   begin
  4000.     CalcDockSizes;
  4001.     Result := (HostDockSite = nil) or HostDockSite.DoUndock(NewDockSite, Self);
  4002.     if Result then
  4003.     begin
  4004.       DockObject := TDragDockObject.Create(Self);
  4005.       try
  4006.         if HostDockSite <> nil then
  4007.           HostDockSiteHandle := HostDockSite.Handle else
  4008.           HostDockSiteHandle := 0;
  4009.         R := BoundsRect;
  4010.         if HostDockSiteHandle <> 0 then
  4011.           MapWindowPoints(HostDockSiteHandle, 0, R, 2);
  4012.         with DockObject do
  4013.         begin
  4014.           FDragTarget := NewDockSite;
  4015.           FDropAlign := ControlSide;
  4016.           FDropOnControl := DropControl;
  4017.           DockRect := R;
  4018.         end;
  4019.         MapWindowPoints(0, NewDockSite.Handle, R.TopLeft, 1);
  4020.         NewDockSite.DockDrop(DockObject, R.Left, R.Top);
  4021.       finally
  4022.         DockObject.Free;
  4023.       end;
  4024.     end;
  4025.   end;
  4026. end;
  4027.  
  4028. function TControl.ManualFloat(ScreenPos: TRect): Boolean;
  4029. var
  4030.   FloatHost: TWinControl;
  4031. begin
  4032.   Result := (HostDockSite = nil) or HostDockSite.DoUndock(nil, Self);
  4033.   if Result then
  4034.   begin
  4035.     FloatHost := CreateFloatingDockSite(ScreenPos);
  4036.     if FloatHost <> nil then
  4037.       Dock(FloatHost, Rect(0, 0, FloatHost.ClientWidth, FloatHost.ClientHeight))
  4038.     else
  4039.       Dock(FloatHost, ScreenPos);
  4040.   end;
  4041. end;
  4042.  
  4043. function TControl.ReplaceDockedControl(Control: TControl;
  4044.   NewDockSite: TWinControl; DropControl: TControl; ControlSide: TAlign): Boolean;
  4045. var
  4046.   OldDockSite: TWinControl;
  4047. begin
  4048.   Result := False;
  4049.   if (Control.HostDockSite = nil) or ((Control.HostDockSite.UseDockManager) and
  4050.     (Control.HostDockSite.DockManager <> nil)) then
  4051.   begin
  4052.     OldDockSite := Control.HostDockSite;
  4053.     if OldDockSite <> nil then
  4054.       OldDockSite.DockManager.SetReplacingControl(Control);
  4055.     try
  4056.       ManualDock(OldDockSite, nil, alTop);
  4057.     finally
  4058.       if OldDockSite <> nil then
  4059.         OldDockSite.DockManager.SetReplacingControl(nil);
  4060.     end;
  4061.     if Control.ManualDock(NewDockSite, DropControl, ControlSide) then
  4062.       Result := True;
  4063.   end;
  4064. end;
  4065.  
  4066. procedure TControl.DoConstraintsChange(Sender: TObject);
  4067. begin
  4068.   AdjustSize;
  4069. end;
  4070.  
  4071. function TControl.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
  4072. begin
  4073.   Result := True;
  4074. end;
  4075.  
  4076. function TControl.CanResize(var NewWidth, NewHeight: Integer): Boolean;
  4077. begin
  4078.   Result := True;
  4079.   if Assigned(FOnCanResize) then FOnCanResize(Self, NewWidth, NewHeight, Result);
  4080. end;
  4081.  
  4082. function TControl.DoCanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
  4083. var
  4084.   W, H: Integer;
  4085. begin
  4086.   if Align <> alClient then
  4087.   begin
  4088.     W := NewWidth;
  4089.     H := NewHeight;
  4090.     Result := CanAutoSize(W, H);
  4091.     if Align in [alNone, alLeft, alRight] then
  4092.       NewWidth := W;
  4093.     if Align in [alNone, alTop, alBottom] then
  4094.       NewHeight := H;
  4095.   end
  4096.   else Result := True;
  4097. end;
  4098.  
  4099. function TControl.DoCanResize(var NewWidth, NewHeight: Integer): Boolean;
  4100. begin
  4101.   Result := CanResize(NewWidth, NewHeight);
  4102.   if Result then DoConstrainedResize(NewWidth, NewHeight);
  4103. end;
  4104.  
  4105. procedure TControl.ConstrainedResize(var MinWidth, MinHeight, MaxWidth,
  4106.   MaxHeight: Integer);
  4107. begin
  4108.   if Assigned(FOnConstrainedResize) then FOnConstrainedResize(Self, MinWidth,
  4109.     MinHeight, MaxWidth, MaxHeight);
  4110. end;
  4111.  
  4112. procedure TControl.DoConstrainedResize(var NewWidth, NewHeight: Integer);
  4113. var
  4114.   MinWidth, MinHeight, MaxWidth, MaxHeight: Integer;
  4115. begin
  4116.   if Constraints.MinWidth > 0 then
  4117.     MinWidth := Constraints.MinWidth
  4118.   else
  4119.     MinWidth := 0;
  4120.   if Constraints.MinHeight > 0 then
  4121.     MinHeight := Constraints.MinHeight
  4122.   else
  4123.     MinHeight := 0;
  4124.   if Constraints.MaxWidth > 0 then
  4125.     MaxWidth := Constraints.MaxWidth
  4126.   else
  4127.     MaxWidth := 0;
  4128.   if Constraints.MaxHeight > 0 then
  4129.     MaxHeight := Constraints.MaxHeight
  4130.   else
  4131.     MaxHeight := 0;
  4132.   { Allow override of constraints }
  4133.   ConstrainedResize(MinWidth, MinHeight, MaxWidth, MaxHeight);
  4134.   if (MaxWidth > 0) and (NewWidth > MaxWidth) then
  4135.     NewWidth := MaxWidth
  4136.   else if (MinWidth > 0) and (NewWidth < MinWidth) then
  4137.     NewWidth := MinWidth;
  4138.   if (MaxHeight > 0) and (NewHeight > MaxHeight) then
  4139.     NewHeight := MaxHeight
  4140.   else if (MinHeight > 0) and (NewHeight < MinHeight) then
  4141.     NewHeight := MinHeight;
  4142. end;
  4143.  
  4144. function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
  4145. var
  4146.   Message: TMessage;
  4147. begin
  4148.   Message.Msg := Msg;
  4149.   Message.WParam := WParam;
  4150.   Message.LParam := LParam;
  4151.   Message.Result := 0;
  4152.   if Self <> nil then WindowProc(Message);
  4153.   Result := Message.Result;
  4154. end;
  4155.  
  4156. procedure TControl.CalcDockSizes;
  4157. begin
  4158.   if Floating then
  4159.   begin
  4160.     UndockHeight := Height;
  4161.     UndockWidth := Width;
  4162.   end
  4163.   else if HostDockSite <> nil then
  4164.   begin
  4165.     if (DockOrientation = doVertical) or
  4166.       (HostDockSite.Align in [alTop, alBottom]) then
  4167.       TBDockHeight := Height
  4168.     else if (DockOrientation = doHorizontal) or
  4169.       (HostDockSite.Align in [alLeft, alRight]) then
  4170.       LRDockWidth := Width;
  4171.   end;
  4172. end;
  4173.  
  4174. procedure TControl.UpdateBoundsRect(const R: TRect);
  4175. begin
  4176.   FLeft := R.Left;
  4177.   FTop := R.Top;
  4178.   FWidth := R.Right - R.Left;
  4179.   FHeight := R.Bottom - R.Top;
  4180.   UpdateAnchorRules;
  4181. end;
  4182.  
  4183. procedure TControl.VisibleChanging;
  4184. begin
  4185. end;
  4186.  
  4187. procedure TControl.WndProc(var Message: TMessage);
  4188. var
  4189.   Form: TCustomForm;
  4190. begin
  4191.   if (csDesigning in ComponentState) then
  4192.   begin
  4193.     Form := GetParentForm(Self);
  4194.     if (Form <> nil) and (Form.Designer <> nil) and
  4195.       Form.Designer.IsDesignMsg(Self, Message) then Exit;
  4196.   end
  4197.   else if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then
  4198.   begin
  4199.     Form := GetParentForm(Self);
  4200.     if (Form <> nil) and Form.WantChildKey(Self, Message) then Exit;
  4201.   end
  4202.   else if (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) then
  4203.   begin
  4204.     if not (csDoubleClicks in ControlStyle) then
  4205.       case Message.Msg of
  4206.         WM_LBUTTONDBLCLK, WM_RBUTTONDBLCLK, WM_MBUTTONDBLCLK:
  4207.           Dec(Message.Msg, WM_LBUTTONDBLCLK - WM_LBUTTONDOWN);
  4208.       end;
  4209.     case Message.Msg of
  4210.       WM_MOUSEMOVE: Application.HintMouseMessage(Self, Message);
  4211.       WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  4212.         begin
  4213.           if FDragMode = dmAutomatic then
  4214.           begin
  4215.             BeginAutoDrag;
  4216.             Exit;
  4217.           end;
  4218.           Include(FControlState, csLButtonDown);
  4219.         end;
  4220.       WM_LBUTTONUP:
  4221.         Exclude(FControlState, csLButtonDown);
  4222.     end;
  4223.   end
  4224.   else if Message.Msg = CM_VISIBLECHANGED then
  4225.     with Message do
  4226.       SendDockNotification(Msg, WParam, LParam);
  4227.   Dispatch(Message);
  4228. end;
  4229.  
  4230. procedure TControl.DefaultHandler(var Message);
  4231. var
  4232.   P: PChar;
  4233. begin
  4234.   with TMessage(Message) do
  4235.     case Msg of
  4236.       WM_GETTEXT:
  4237.         begin
  4238.           if FText <> nil then P := FText else P := '';
  4239.           Result := StrLen(StrLCopy(PChar(LParam), P, WParam - 1));
  4240.         end;
  4241.       WM_GETTEXTLENGTH:
  4242.         if FText = nil then Result := 0 else Result := StrLen(FText);
  4243.       WM_SETTEXT:
  4244.         begin
  4245.           P := StrNew(PChar(LParam));
  4246.           StrDispose(FText);
  4247.           FText := P;
  4248.           SendDockNotification(Msg, WParam, LParam);
  4249.         end;
  4250.     end;
  4251. end;
  4252.  
  4253. procedure TControl.ReadIsControl(Reader: TReader);
  4254. begin
  4255.   FIsControl := Reader.ReadBoolean;
  4256. end;
  4257.  
  4258. procedure TControl.WriteIsControl(Writer: TWriter);
  4259. begin
  4260.   Writer.WriteBoolean(FIsControl);
  4261. end;
  4262.  
  4263. procedure TControl.DefineProperties(Filer: TFiler);
  4264.  
  4265.   function DoWrite: Boolean;
  4266.   begin
  4267.     if Filer.Ancestor <> nil then
  4268.       Result := TControl(Filer.Ancestor).IsControl <> IsControl else
  4269.       Result := IsControl;
  4270.   end;
  4271.  
  4272. begin
  4273.   { The call to inherited DefinedProperties is omitted since the Left and
  4274.     Top special properties are redefined with real properties }
  4275.   Filer.DefineProperty('IsControl', ReadIsControl, WriteIsControl, DoWrite);
  4276. end;
  4277.  
  4278. procedure TControl.Click;
  4279. begin
  4280.   { Call OnClick if assigned and not equal to associated action's OnExecute.
  4281.     If associated action's OnExecute assigned then call it, otherwise, call
  4282.     OnClick. }
  4283.   if Assigned(FOnClick) and (Action <> nil) and (@FOnClick <> @Action.OnExecute) then
  4284.     FOnClick(Self)
  4285.   else if not (csDesigning in ComponentState) and (ActionLink <> nil) then
  4286.     ActionLink.Execute
  4287.   else if Assigned(FOnClick) then
  4288.     FOnClick(Self);
  4289. end;
  4290.  
  4291. procedure TControl.DblClick;
  4292. begin
  4293.   if Assigned(FOnDblClick) then FOnDblClick(Self);
  4294. end;
  4295.  
  4296. procedure TControl.MouseDown(Button: TMouseButton;
  4297.   Shift: TShiftState; X, Y: Integer);
  4298. begin
  4299.   if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y);
  4300. end;
  4301.  
  4302. procedure TControl.DoMouseDown(var Message: TWMMouse; Button: TMouseButton;
  4303.   Shift: TShiftState);
  4304. begin
  4305.   if not (csNoStdEvents in ControlStyle) then
  4306.     with Message do
  4307.       MouseDown(Button, KeysToShiftState(Keys) + Shift, XPos, YPos);
  4308. end;
  4309.  
  4310. procedure TControl.WMLButtonDown(var Message: TWMLButtonDown);
  4311. begin
  4312.   SendCancelMode(Self);
  4313.   inherited;
  4314.   if csCaptureMouse in ControlStyle then MouseCapture := True;
  4315.   if csClickEvents in ControlStyle then Include(FControlState, csClicked);
  4316.   DoMouseDown(Message, mbLeft, []);
  4317. end;
  4318.  
  4319. procedure TControl.WMNCLButtonDown(var Message: TWMNCLButtonDown);
  4320. begin
  4321.   SendCancelMode(Self);
  4322.   inherited;
  4323. end;
  4324.  
  4325. procedure TControl.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  4326. begin
  4327.   SendCancelMode(Self);
  4328.   inherited;
  4329.   if csCaptureMouse in ControlStyle then MouseCapture := True;
  4330.   if csClickEvents in ControlStyle then DblClick;
  4331.   DoMouseDown(Message, mbLeft, [ssDouble]);
  4332. end;
  4333.  
  4334. function TControl.GetPopupMenu: TPopupMenu;
  4335. begin
  4336.   Result := FPopupMenu;
  4337. end;
  4338.  
  4339. function TControl.CheckNewSize(var NewWidth, NewHeight: Integer): Boolean;
  4340. var
  4341.   W, H, W2, H2: Integer;
  4342. begin
  4343.   Result := False;
  4344.   W := NewWidth;
  4345.   H := NewHeight;
  4346.   if DoCanResize(W, H) then
  4347.   begin
  4348.     W2 := W;
  4349.     H2 := H;
  4350.     Result := not AutoSize or (DoCanAutoSize(W2, H2) and (W2 = W) and (H2 = H)) or
  4351.       DoCanResize(W2, H2);
  4352.     if Result then
  4353.     begin
  4354.       NewWidth := W2;
  4355.       NewHeight := H2;
  4356.     end;
  4357.   end;
  4358. end;
  4359.  
  4360. procedure TControl.WMRButtonDown(var Message: TWMRButtonDown);
  4361. begin
  4362.   inherited;
  4363.   DoMouseDown(Message, mbRight, []);
  4364. end;
  4365.  
  4366. procedure TControl.WMRButtonDblClk(var Message: TWMRButtonDblClk);
  4367. begin
  4368.   inherited;
  4369.   DoMouseDown(Message, mbRight, [ssDouble]);
  4370. end;
  4371.  
  4372. procedure TControl.WMMButtonDown(var Message: TWMMButtonDown);
  4373. begin
  4374.   inherited;
  4375.   DoMouseDown(Message, mbMiddle, []);
  4376. end;
  4377.  
  4378. procedure TControl.WMMButtonDblClk(var Message: TWMMButtonDblClk);
  4379. begin
  4380.   inherited;
  4381.   DoMouseDown(Message, mbMiddle, [ssDouble]);
  4382. end;
  4383.  
  4384. procedure TControl.MouseMove(Shift: TShiftState; X, Y: Integer);
  4385. begin
  4386.   if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X, Y);
  4387. end;
  4388.  
  4389. procedure TControl.WMMouseMove(var Message: TWMMouseMove);
  4390. begin
  4391.   inherited;
  4392.   if not (csNoStdEvents in ControlStyle) then
  4393.     with Message do MouseMove(KeysToShiftState(Keys), XPos, YPos);
  4394. end;
  4395.  
  4396. procedure TControl.MouseUp(Button: TMouseButton;
  4397.   Shift: TShiftState; X, Y: Integer);
  4398. begin
  4399.   if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X, Y);
  4400. end;
  4401.  
  4402. procedure TControl.DoMouseUp(var Message: TWMMouse; Button: TMouseButton);
  4403. begin
  4404.   if not (csNoStdEvents in ControlStyle) then
  4405.     with Message do MouseUp(Button, KeysToShiftState(Keys), XPos, YPos);
  4406. end;
  4407.  
  4408. procedure TControl.WMLButtonUp(var Message: TWMLButtonUp);
  4409. begin
  4410.   inherited;
  4411.   if csCaptureMouse in ControlStyle then MouseCapture := False;
  4412.   if csClicked in ControlState then
  4413.   begin
  4414.     Exclude(FControlState, csClicked);
  4415.     if PtInRect(ClientRect, SmallPointToPoint(Message.Pos)) then Click;
  4416.   end;
  4417.   DoMouseUp(Message, mbLeft);
  4418. end;
  4419.  
  4420. procedure TControl.WMRButtonUp(var Message: TWMRButtonUp);
  4421. begin
  4422.   inherited;
  4423.   DoMouseUp(Message, mbRight);
  4424. end;
  4425.  
  4426. procedure TControl.WMMButtonUp(var Message: TWMMButtonUp);
  4427. begin
  4428.   inherited;
  4429.   DoMouseUp(Message, mbMiddle);
  4430. end;
  4431.  
  4432. procedure TControl.WMCancelMode(var Message: TWMCancelMode);
  4433. begin
  4434.   inherited;
  4435.   if MouseCapture then
  4436.   begin
  4437.     MouseCapture := False;
  4438.     if csLButtonDown in ControlState then Perform(WM_LBUTTONUP, 0,
  4439.       Integer($FFFFFFFF));
  4440.   end
  4441.   else
  4442.     Exclude(FControlState, csLButtonDown);
  4443. end;
  4444.  
  4445. procedure TControl.WMWindowPosChanged(var Message: TWMWindowPosChanged);
  4446. begin
  4447.   inherited;
  4448.   { Update min/max width/height to actual extents control will allow }
  4449.   if ComponentState * [csReading, csLoading] = [] then
  4450.   begin
  4451.     with Constraints do
  4452.     begin
  4453.       if (MaxWidth > 0) and (Width > MaxWidth) then
  4454.         FMaxWidth := Width
  4455.       else if (MinWidth > 0) and (Width < MinWidth) then
  4456.         FMinWidth := Width;
  4457.       if (MaxHeight > 0) and (Height > MaxHeight) then
  4458.         FMaxHeight := Height
  4459.       else if (MinHeight > 0) and (Height < MinHeight) then
  4460.         FMinHeight := Height;
  4461.     end;
  4462.     if Message.WindowPos <> nil then
  4463.       with Message.WindowPos^ do
  4464.         if (FHostDockSite <> nil) and not (csDocking in ControlState)  and
  4465.           (Flags and SWP_NOSIZE = 0) and (cx <> 0) and (cy <> 0) then
  4466.           CalcDockSizes;
  4467.   end;
  4468. end;
  4469.  
  4470. procedure TControl.CMVisibleChanged(var Message: TMessage);
  4471. begin
  4472.   if not (csDesigning in ComponentState) or
  4473.     (csNoDesignVisible in ControlStyle) then
  4474.     InvalidateControl(True, FVisible and (csOpaque in ControlStyle));
  4475. end;
  4476.  
  4477. procedure TControl.CMEnabledChanged(var Message: TMessage);
  4478. begin
  4479.   Invalidate;
  4480. end;
  4481.  
  4482. procedure TControl.CMFontChanged(var Message: TMessage);
  4483. begin
  4484.   Invalidate;
  4485. end;
  4486.  
  4487. procedure TControl.CMColorChanged(var Message: TMessage);
  4488. begin
  4489.   Invalidate;
  4490. end;
  4491.  
  4492. procedure TControl.CMParentColorChanged(var Message: TMessage);
  4493. begin
  4494.   if FParentColor then
  4495.   begin
  4496.     if Message.wParam <> 0 then
  4497.       SetColor(TColor(Message.lParam)) else
  4498.       SetColor(FParent.FColor);
  4499.     FParentColor := True;
  4500.   end;
  4501. end;
  4502.  
  4503. procedure TControl.CMParentBiDiModeChanged(var Message: TMessage);
  4504. begin
  4505.   if FParentBiDiMode then
  4506.   begin
  4507.     if FParent <> nil then BiDiMode := FParent.BiDiMode;
  4508.     FParentBiDiMode := True;
  4509.   end;
  4510. end;
  4511.  
  4512. procedure TControl.CMBiDiModeChanged(var Message: TMessage);
  4513. begin
  4514.   if (SysLocale.MiddleEast) and (Message.wParam = 0) then Invalidate;
  4515. end;
  4516.  
  4517. procedure TControl.CMParentShowHintChanged(var Message: TMessage);
  4518. begin
  4519.   if FParentShowHint then
  4520.   begin
  4521.     SetShowHint(FParent.FShowHint);
  4522.     FParentShowHint := True;
  4523.   end;
  4524. end;
  4525.  
  4526. procedure TControl.CMParentFontChanged(var Message: TMessage);
  4527. begin
  4528.   if FParentFont then
  4529.   begin
  4530.     if Message.wParam <> 0 then
  4531.       SetFont(TFont(Message.lParam)) else
  4532.       SetFont(FParent.FFont);
  4533.     FParentFont := True;
  4534.   end;
  4535. end;
  4536.  
  4537. procedure TControl.CMSysFontChanged(var Message: TMessage);
  4538. begin
  4539.   if FDesktopFont then
  4540.   begin
  4541.     SetFont(Screen.IconFont);
  4542.     FDesktopFont := True;
  4543.   end;
  4544. end;
  4545.  
  4546. procedure TControl.CMHitTest(var Message: TCMHitTest);
  4547. begin
  4548.   Message.Result := HTCLIENT;
  4549. end;
  4550.  
  4551. procedure TControl.CMMouseEnter(var Message: TMessage);
  4552. begin
  4553.   if FParent <> nil then
  4554.     FParent.Perform(CM_MOUSEENTER, 0, Longint(Self));
  4555. end;
  4556.  
  4557. procedure TControl.CMMouseLeave(var Message: TMessage);
  4558. begin
  4559.   if FParent <> nil then
  4560.     FParent.Perform(CM_MOUSELEAVE, 0, Longint(Self));
  4561. end;
  4562.  
  4563. procedure TControl.CMDesignHitTest(var Message: TCMDesignHitTest);
  4564. begin
  4565.   Message.Result := 0;
  4566. end;
  4567.  
  4568. function TControl.CreateFloatingDockSite(Bounds: TRect): TWinControl;
  4569. begin
  4570.   Result := nil;
  4571.   if (FloatingDockSiteClass <> nil) and
  4572.     (FloatingDockSiteClass <> TWinControlClass(ClassType)) then
  4573.   begin
  4574.     Result := FloatingDockSiteClass.Create(Application);
  4575.     with Bounds do
  4576.     begin
  4577.       Result.Top := Top;
  4578.       Result.Left := Left;
  4579.       Result.ClientWidth := Right - Left;
  4580.       Result.ClientHeight := Bottom - Top;
  4581.     end;
  4582.   end;
  4583. end;
  4584.  
  4585. procedure TControl.CMFloat(var Message: TCMFloat);
  4586. var
  4587.   FloatHost: TWinControl;
  4588.  
  4589.   procedure UpdateFloatingDockSitePos;
  4590.   var
  4591.     P: TPoint;
  4592.   begin
  4593.     P := Parent.ClientToScreen(Point(Left, Top));
  4594.     with Message.DockSource.DockRect do
  4595.       Parent.BoundsRect := Bounds(Left + Parent.Left - P.X,
  4596.         Top + Parent.Top - P.Y,
  4597.         Right - Left + Parent.Width - Width,
  4598.         Bottom - Top + Parent.Height - Height);
  4599.   end;
  4600.  
  4601. begin
  4602.   if Floating and (Parent <> nil) then
  4603.     UpdateFloatingDockSitePos
  4604.   else
  4605.   begin
  4606.     FloatHost := CreateFloatingDockSite(Message.DockSource.DockRect);
  4607.     if FloatHost <> nil then
  4608.     begin
  4609.       Message.DockSource.DragTarget := FloatHost;
  4610.       Message.DockSource.DragHandle := FloatHost.Handle;
  4611.     end;
  4612.   end;
  4613. end;
  4614.  
  4615. procedure TControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
  4616. begin
  4617.   if Sender is TCustomAction then
  4618.     with TCustomAction(Sender) do
  4619.     begin
  4620.       if not CheckDefaults or (Self.Caption = '') or (Self.Caption = Self.Name) then
  4621.         Self.Caption := Caption;
  4622.       if not CheckDefaults or (Self.Enabled = True) then
  4623.         Self.Enabled := Enabled;
  4624.       if not CheckDefaults or (Self.Hint = '') then
  4625.         Self.Hint := Hint;
  4626.       if not CheckDefaults or (Self.Visible = True) then
  4627.         Self.Visible := Visible;
  4628.       if not CheckDefaults or not Assigned(Self.OnClick) then
  4629.         Self.OnClick := OnExecute;
  4630.     end;
  4631. end;
  4632.  
  4633. procedure TControl.DoActionChange(Sender: TObject);
  4634. begin
  4635.   if Sender = Action then ActionChange(Sender, False);
  4636. end;
  4637.  
  4638. function TControl.GetActionLinkClass: TControlActionLinkClass;
  4639. begin
  4640.   Result := TControlActionLink;
  4641. end;
  4642.  
  4643. function TControl.IsCaptionStored: Boolean;
  4644. begin
  4645.   Result := (ActionLink = nil) or not ActionLink.IsCaptionLinked;
  4646. end;
  4647.  
  4648. function TControl.IsEnabledStored: Boolean;
  4649. begin
  4650.   Result := (ActionLink = nil) or not ActionLink.IsEnabledLinked;
  4651. end;
  4652.  
  4653. function TControl.IsHintStored: Boolean;
  4654. begin
  4655.   Result := (ActionLink = nil) or not ActionLink.IsHintLinked;
  4656. end;
  4657.  
  4658. function TControl.IsVisibleStored: Boolean;
  4659. begin
  4660.   Result := (ActionLink = nil) or not ActionLink.IsVisibleLinked;
  4661. end;
  4662.  
  4663. function TControl.IsOnClickStored: Boolean;
  4664. begin
  4665.   Result := (ActionLink = nil) or not ActionLink.IsOnExecuteLinked;
  4666. end;
  4667.  
  4668. procedure TControl.Loaded;
  4669. begin
  4670.   inherited Loaded;
  4671.   if Action <> nil then ActionChange(Action, True);
  4672.   UpdateAnchorRules;
  4673. end;
  4674.  
  4675. procedure TControl.AssignTo(Dest: TPersistent);
  4676. begin
  4677.   if Dest is TCustomAction then
  4678.     with TCustomAction(Dest) do
  4679.     begin
  4680.       Enabled := Self.Enabled;
  4681.       Hint := Self.Hint;
  4682.       Caption := Self.Caption;
  4683.       Visible := Self.Visible;
  4684.       OnExecute := Self.OnClick;
  4685.     end
  4686.   else inherited AssignTo(Dest);
  4687. end;
  4688.  
  4689. function TControl.GetDockEdge(MousePos: TPoint): TAlign;
  4690.  
  4691.   function MinVar(const Data: array of Double): Integer;
  4692.   var
  4693.     I: Integer;
  4694.   begin
  4695.     Result := 0;
  4696.     for I := Low(Data) + 1 to High(Data) do
  4697.       if Data[I] < Data[Result] then Result := I;
  4698.   end;
  4699.  
  4700. var
  4701.   T, L, B, R: Integer;
  4702. begin
  4703.   Result := alNone;
  4704.   R := Width;
  4705.   B := Height;
  4706.   // if Point is outside control, then we can determine side quickly
  4707.   if MousePos.X <= 0 then Result := alLeft
  4708.   else if MousePos.X >= R then Result := alRight
  4709.   else if MousePos.Y <= 0 then Result := alTop
  4710.   else if MousePos.Y >= B then Result := alBottom
  4711.   else begin
  4712.     // if MousePos is inside the control, then we need to figure out which side
  4713.     // MousePos is closest to.
  4714.     T := MousePos.Y;
  4715.     B := B - MousePos.Y;
  4716.     L := MousePos.X;
  4717.     R := R - MousePos.X;
  4718.     case MinVar([L, R, T, B]) of
  4719.       0: Result := alLeft;
  4720.       1: Result := alRight;
  4721.       2: Result := alTop;
  4722.       3: Result := alBottom;
  4723.     end;
  4724.   end;
  4725. end;
  4726.  
  4727. function TControl.GetFloating: Boolean;
  4728. begin
  4729.   Result := (HostDockSite <> nil) and (HostDockSite is FloatingDockSiteClass);
  4730. end;
  4731.  
  4732. function TControl.GetFloatingDockSiteClass: TWinControlClass;
  4733. begin
  4734.   Result := FFloatingDockSiteClass;
  4735. end;
  4736.  
  4737. procedure TControl.AdjustSize;
  4738. begin
  4739.   if not (csLoading in ComponentState) then SetBounds(Left, Top, Width, Height);
  4740. end;
  4741.  
  4742. function TControl.DrawTextBiDiModeFlags(Flags: Longint): Longint;
  4743. begin
  4744.   Result := Flags;
  4745.   { do not change center alignment }
  4746.   if UseRightToLeftAlignment then
  4747.     if Result and DT_RIGHT = DT_RIGHT then
  4748.       Result := Result and not DT_RIGHT { removing DT_RIGHT, makes it DT_LEFT }
  4749.     else if not (Result and DT_CENTER = DT_CENTER) then
  4750.       Result := Result or DT_RIGHT;
  4751.   Result := Result or DrawTextBiDiModeFlagsReadingOnly;
  4752. end;
  4753.  
  4754. function TControl.DrawTextBiDiModeFlagsReadingOnly: Longint;
  4755. begin
  4756.   if UseRightToLeftReading then
  4757.     Result := DT_RTLREADING
  4758.   else
  4759.     Result := 0;
  4760. end;
  4761.  
  4762. procedure TControl.InitiateAction;
  4763. begin
  4764.   if ActionLink <> nil then ActionLink.Update;
  4765. end;
  4766.  
  4767. procedure TControl.CMHintShow(var Message: TMessage);
  4768. begin
  4769.   if (ActionLink <> nil) and
  4770.     not ActionLink.DoShowHint(TCMHintShow(Message).HintInfo^.HintStr) then
  4771.     Message.Result := 1;
  4772. end;
  4773.  
  4774. procedure TControl.WMContextMenu(var Message: TWMContextMenu);
  4775. var
  4776.   Pt, Temp: TPoint;
  4777.   Handled: Boolean;
  4778.   PopupMenu: TPopupMenu;
  4779. begin
  4780.   if Message.Result <> 0 then Exit;
  4781.   if csDesigning in ComponentState then Exit;
  4782.  
  4783.   Pt := SmallPointToPoint(Message.Pos);
  4784.   if Pt.X < 0 then
  4785.     Temp := Pt
  4786.   else
  4787.   begin
  4788.     Temp := ScreenToClient(Pt);
  4789.     if not PtInRect(ClientRect, Temp) then
  4790.     begin
  4791.       inherited;
  4792.       Exit;
  4793.     end;
  4794.   end;
  4795.  
  4796.   Handled := False;
  4797.   DoContextPopup(Temp, Handled);
  4798.   Message.Result := Ord(Handled);
  4799.   if Handled then Exit;
  4800.  
  4801.   PopupMenu := GetPopupMenu;
  4802.   if (PopupMenu <> nil) and PopupMenu.AutoPopup then
  4803.   begin
  4804.     SendCancelMode(nil);
  4805.     PopupMenu.PopupComponent := Self;
  4806.     if Pt.X < 0 then
  4807.       Pt := ClientToScreen(Point(0,0));
  4808.     PopupMenu.Popup(Pt.X, Pt.Y);
  4809.     Message.Result := 1;
  4810.   end;
  4811.  
  4812.   if Message.Result = 0 then
  4813.     inherited;
  4814. end;
  4815.  
  4816. procedure TControl.DoContextPopup(MousePos: TPoint; var Handled: Boolean);
  4817. begin
  4818.   if Assigned(FOnContextPopup) then FOnContextPopup(Self, MousePos, Handled);
  4819. end;
  4820.  
  4821. { TWinControlActionLink }
  4822.  
  4823. procedure TWinControlActionLink.AssignClient(AClient: TObject);
  4824. begin
  4825.   inherited AssignClient(AClient);
  4826.   FClient := AClient as TWinControl;
  4827. end;
  4828.  
  4829. function TWinControlActionLink.IsHelpContextLinked: Boolean;
  4830. begin
  4831.   Result := inherited IsHelpContextLinked and
  4832.     (FClient.HelpContext = (Action as TCustomAction).HelpContext);
  4833. end;
  4834.  
  4835. procedure TWinControlActionLink.SetHelpContext(Value: THelpContext);
  4836. begin
  4837.   if IsHelpContextLinked then FClient.HelpContext := Value
  4838. end;
  4839.  
  4840. { TWinControl }
  4841.  
  4842. constructor TWinControl.Create(AOwner: TComponent);
  4843. begin
  4844.   inherited Create(AOwner);
  4845.   FObjectInstance := MakeObjectInstance(MainWndProc);
  4846.   FBrush := TBrush.Create;
  4847.   FBrush.Color := FColor;
  4848.   FParentCtl3D := True;
  4849.   FTabOrder := -1;
  4850.   FImeMode := imDontCare;
  4851.   if SysLocale.PriLangID = LANG_JAPANESE then
  4852.     FImeName := ''
  4853.   else
  4854.     FImeName := Screen.DefaultIme;
  4855.   FUseDockManager := False;
  4856.   FBevelEdges := [beLeft, beTop, beRight, beBottom];
  4857.   FBevelInner := bvRaised;
  4858.   FBevelOuter := bvLowered;
  4859.   FBevelWidth := 1;
  4860. end;
  4861.  
  4862. constructor TWinControl.CreateParented(ParentWindow: HWnd);
  4863. begin
  4864.   FParentWindow := ParentWindow;
  4865.   Create(nil);
  4866. end;
  4867.  
  4868. class function TWinControl.CreateParentedControl(ParentWindow: HWnd): TWinControl;
  4869. begin
  4870.   Result := TWinControl(NewInstance);
  4871.   Result.FParentWindow := ParentWindow;
  4872.   Result.Create(nil);
  4873. end;
  4874.  
  4875. destructor TWinControl.Destroy;
  4876. var
  4877.   I: Integer;
  4878.   Instance: TControl;
  4879. begin
  4880.   Destroying;
  4881.   if FDockSite then
  4882.   begin
  4883.     FDockSite := False;
  4884.     RegisterDockSite(Self, False);
  4885.   end;
  4886.   FDockManager := nil;
  4887.   FDockClients.Free;
  4888.   if Parent <> nil then RemoveFocus(True);
  4889.   if FHandle <> 0 then DestroyWindowHandle;
  4890.   I := ControlCount;
  4891.   while I <> 0 do
  4892.   begin
  4893.     Instance := Controls[I - 1];
  4894.     Remove(Instance);
  4895.     Instance.Destroy;
  4896.     I := ControlCount;
  4897.   end;
  4898.   FBrush.Free;
  4899.   if FObjectInstance <> nil then FreeObjectInstance(FObjectInstance);
  4900.   inherited Destroy;
  4901. end;
  4902.  
  4903. procedure TWinControl.FixupTabList;
  4904. var
  4905.   Count, I, J: Integer;
  4906.   List: TList;
  4907.   Control: TWinControl;
  4908. begin
  4909.   if FWinControls <> nil then
  4910.   begin
  4911.     List := TList.Create;
  4912.     try
  4913.       Count := FWinControls.Count;
  4914.       List.Count := Count;
  4915.       for I := 0 to Count - 1 do
  4916.       begin
  4917.         Control := FWinControls[I];
  4918.         J := Control.FTabOrder;
  4919.         if (J >= 0) and (J < Count) then List[J] := Control;
  4920.       end;
  4921.       for I := 0 to Count - 1 do
  4922.       begin
  4923.         Control := List[I];
  4924.         if Control <> nil then Control.UpdateTabOrder(I);
  4925.       end;
  4926.     finally
  4927.       List.Free;
  4928.     end;
  4929.   end;
  4930. end;
  4931.  
  4932. procedure TWinControl.ReadState(Reader: TReader);
  4933. begin
  4934.   DisableAlign;
  4935.   try
  4936.     inherited ReadState(Reader);
  4937.   finally
  4938.     EnableAlign;
  4939.   end;
  4940.   FixupTabList;
  4941.   if FParent <> nil then Perform(CM_PARENTCTL3DCHANGED, 0, 0);
  4942.   UpdateControlState;
  4943. end;
  4944.  
  4945. procedure TWinControl.AdjustClientRect(var Rect: TRect);
  4946. begin
  4947.   { WM_NCCALCSIZE performs our BorderWidth logic }
  4948. end;
  4949.  
  4950. procedure TWinControl.AlignControls(AControl: TControl; var Rect: TRect);
  4951. var
  4952.   AlignList: TList;
  4953.  
  4954.   function InsertBefore(C1, C2: TControl; AAlign: TAlign): Boolean;
  4955.   begin
  4956.     Result := False;
  4957.     case AAlign of
  4958.       alTop: Result := C1.Top < C2.Top;
  4959.       alBottom: Result := (C1.Top + C1.Height) >= (C2.Top + C2.Height);
  4960.       alLeft: Result := C1.Left < C2.Left;
  4961.       alRight: Result := (C1.Left + C1.Width) >= (C2.Left + C2.Width);
  4962.     end;
  4963.   end;
  4964.  
  4965.   procedure DoPosition(Control: TControl; AAlign: TAlign);
  4966.   var
  4967.     NewLeft, NewTop, NewWidth, NewHeight: Integer;
  4968.     ParentSize: TPoint;
  4969.   begin
  4970.     with Rect do
  4971.     begin
  4972.       if (AAlign = alNone) or (Control.Anchors <> AnchorAlign[AAlign]) then
  4973.       begin
  4974.         with Control do
  4975.           if (FOriginalParentSize.X <> 0) and (FOriginalParentSize.Y <> 0) then
  4976.           begin
  4977.             NewLeft := Left;
  4978.             NewTop := Top;
  4979.             NewWidth := Width;
  4980.             NewHeight := Height;
  4981.             if Parent.HandleAllocated then
  4982.               ParentSize := Parent.ClientRect.BottomRight
  4983.             else
  4984.               ParentSize := Point(Parent.Width, Parent.Height);
  4985.             if akRight in Anchors then
  4986.               if akLeft in Anchors then
  4987.                 // The AnchorRules.X is the original width
  4988.                 NewWidth := ParentSize.X - (FOriginalParentSize.X - FAnchorRules.X)
  4989.               else
  4990.                 // The AnchorRules.X is the original left
  4991.                 NewLeft := ParentSize.X - (FOriginalParentSize.X - FAnchorRules.X)
  4992.             else if not (akLeft in Anchors) then
  4993.               // The AnchorRules.X is the original middle of the control
  4994.               NewLeft := MulDiv(FAnchorRules.X, ParentSize.X, FOriginalParentSize.X) -
  4995.                 NewWidth div 2;
  4996.             if akBottom in Anchors then
  4997.               if akTop in Anchors then
  4998.                 // The AnchorRules.Y is the original height
  4999.                 NewHeight := ParentSize.Y - (FOriginalParentSize.Y - FAnchorRules.Y)
  5000.               else
  5001.                 // The AnchorRules.Y is the original top
  5002.                 NewTop := ParentSize.Y - (FOriginalParentSize.Y - FAnchorRules.Y)
  5003.             else if not (akTop in Anchors) then
  5004.               // The AnchorRules.Y is the original middle of the control
  5005.               NewTop := MulDiv(FAnchorRules.Y, ParentSize.Y, FOriginalParentSize.Y) -
  5006.                 NewHeight div 2;
  5007.             FAnchorMove := True;
  5008.             try
  5009.               SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
  5010.             finally
  5011.               FAnchorMove := False;
  5012.             end;
  5013.           end;
  5014.         if AAlign = alNone then Exit;
  5015.       end;
  5016.  
  5017.       NewWidth := Right - Left;
  5018.       if (NewWidth < 0) or (AAlign in [alLeft, alRight]) then
  5019.         NewWidth := Control.Width;
  5020.       NewHeight := Bottom - Top;
  5021.       if (NewHeight < 0) or (AAlign in [alTop, alBottom]) then
  5022.         NewHeight := Control.Height;
  5023.       NewLeft := Left;
  5024.       NewTop := Top;
  5025.       case AAlign of
  5026.         alTop:
  5027.           Inc(Top, NewHeight);
  5028.         alBottom:
  5029.           begin
  5030.             Dec(Bottom, NewHeight);
  5031.             NewTop := Bottom;
  5032.           end;
  5033.         alLeft:
  5034.           Inc(Left, NewWidth);
  5035.         alRight:
  5036.           begin
  5037.             Dec(Right, NewWidth);
  5038.             NewLeft := Right;
  5039.           end;
  5040.       end;
  5041.     end;
  5042.     Control.FAnchorMove := True;
  5043.     try
  5044.       Control.SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
  5045.     finally
  5046.       Control.FAnchorMove := False;
  5047.     end;
  5048.     { Adjust client rect if control didn't resize as we expected }
  5049.     if (Control.Width <> NewWidth) or (Control.Height <> NewHeight) then
  5050.       with Rect do
  5051.         case AAlign of
  5052.           alTop: Dec(Top, NewHeight - Control.Height);
  5053.           alBottom: Inc(Bottom, NewHeight - Control.Height);
  5054.           alLeft: Dec(Left, NewWidth - Control.Width);
  5055.           alRight: Inc(Right, NewWidth - Control.Width);
  5056.           alClient:
  5057.             begin
  5058.               Inc(Right, NewWidth - Control.Width);
  5059.               Inc(Bottom, NewHeight - Control.Height);
  5060.             end;
  5061.         end;
  5062.   end;
  5063.  
  5064.   function Anchored(Align: TAlign; Anchors: TAnchors): Boolean;
  5065.   begin
  5066.     case Align of
  5067.       alLeft: Result := akLeft in Anchors;
  5068.       alTop: Result := akTop in Anchors;
  5069.       alRight: Result := akRight in Anchors;
  5070.       alBottom: Result := akBottom in Anchors;
  5071.       alClient: Result := Anchors = [akLeft, akTop, akRight, akBottom];
  5072.     else
  5073.       Result := False;
  5074.     end;
  5075.   end;
  5076.  
  5077.   procedure DoAlign(AAlign: TAlign);
  5078.   var
  5079.     I, J: Integer;
  5080.     Control: TControl;
  5081.   begin
  5082.     AlignList.Clear;
  5083.     if (AControl <> nil) and ((AAlign = alNone) or AControl.Visible or
  5084.       (csDesigning in AControl.ComponentState) and
  5085.       not (csNoDesignVisible in AControl.ControlStyle)) and
  5086.       (AControl.Align = AAlign) then
  5087.       AlignList.Add(AControl);
  5088.     for I := 0 to ControlCount - 1 do
  5089.     begin
  5090.       Control := Controls[I];
  5091.       if (Control.Align = AAlign) and ((AAlign = alNone) or (Control.Visible or
  5092.         (Control.ControlStyle * [csAcceptsControls, csNoDesignVisible] =
  5093.           [csAcceptsControls, csNoDesignVisible])) or
  5094.         (csDesigning in Control.ComponentState) and
  5095.         not (csNoDesignVisible in Control.ControlStyle)) then
  5096.       begin
  5097.         if Control = AControl then Continue;
  5098.         J := 0;
  5099.         while (J < AlignList.Count) and not InsertBefore(Control,
  5100.           TControl(AlignList[J]), AAlign) do Inc(J);
  5101.         AlignList.Insert(J, Control);
  5102.       end;
  5103.     end;
  5104.     for I := 0 to AlignList.Count - 1 do
  5105.       DoPosition(TControl(AlignList[I]), AAlign);
  5106.   end;
  5107.  
  5108.   function AlignWork: Boolean;
  5109.   var
  5110.     I: Integer;
  5111.   begin
  5112.     Result := True;
  5113.     for I := ControlCount - 1 downto 0 do
  5114.       if (Controls[I].Align <> alNone) or
  5115.         (Controls[I].Anchors <> [akLeft, akTop]) then Exit;
  5116.     Result := False;
  5117.   end;
  5118.  
  5119. begin
  5120.   if FDockSite and FUseDockManager and (FDockManager <> nil) then
  5121.     FDockManager.ResetBounds(False);
  5122.   { D5 VCL Change (ME): Aligned controls that are not dock clients now
  5123.     get realigned.  Previously the code below was "else if AlignWork". }
  5124.   if AlignWork then
  5125.   begin
  5126.     AdjustClientRect(Rect);
  5127.     AlignList := TList.Create;
  5128.     try
  5129.       DoAlign(alTop);
  5130.       DoAlign(alBottom);
  5131.       DoAlign(alLeft);
  5132.       DoAlign(alRight);
  5133.       DoAlign(alClient);
  5134.       DoAlign(alNone);// Move anchored controls
  5135.     finally
  5136.       AlignList.Free;
  5137.     end;
  5138.   end;
  5139.   { Apply any constraints }
  5140.   if Showing then AdjustSize;
  5141. end;
  5142.  
  5143. procedure TWinControl.AlignControl(AControl: TControl);
  5144. var
  5145.   Rect: TRect;
  5146. begin
  5147.   if not HandleAllocated or (csDestroying in ComponentState) then Exit;
  5148.   if FAlignLevel <> 0 then
  5149.     Include(FControlState, csAlignmentNeeded)
  5150.   else
  5151.   begin
  5152.     DisableAlign;
  5153.     try
  5154.       Rect := GetClientRect;
  5155.       AlignControls(AControl, Rect);
  5156.     finally
  5157.       Exclude(FControlState, csAlignmentNeeded);
  5158.       EnableAlign;
  5159.     end;
  5160.   end;
  5161. end;
  5162.  
  5163. procedure TWinControl.DisableAlign;
  5164. begin
  5165.   Inc(FAlignLevel);
  5166. end;
  5167.  
  5168. procedure TWinControl.EnableAlign;
  5169. begin
  5170.   Dec(FAlignLevel);
  5171.   if FAlignLevel = 0 then
  5172.   begin
  5173.     if csAlignmentNeeded in ControlState then Realign;
  5174.   end;
  5175. end;
  5176.  
  5177. procedure TWinControl.Realign;
  5178. begin
  5179.   AlignControl(nil);
  5180. end;
  5181.  
  5182. procedure TWinControl.DoFlipChildren;
  5183. var
  5184.   Loop: Integer;
  5185.   TheWidth: Integer;
  5186.   FlippedList: TList;
  5187. begin
  5188.   FlippedList := TList.Create;
  5189.   try
  5190.     TheWidth := ClientWidth;
  5191.     for Loop := 0 to ControlCount - 1 do with Controls[Loop] do
  5192.       if (Owner = Self.Owner) then
  5193.       begin
  5194.         FlippedList.Add(Controls[Loop]);
  5195.         Left := TheWidth - Width - Left;
  5196.       end;
  5197.     { Allow controls that have associations to realign themselves }
  5198.     for Loop := 0 to FlippedList.Count - 1 do
  5199.       TControl(FlippedList[Loop]).Perform(CM_ALLCHILDRENFLIPPED, 0, 0);
  5200.   finally
  5201.     FlippedList.Free;
  5202.   end;
  5203. end;
  5204.  
  5205. procedure TWinControl.FlipChildren(AllLevels: Boolean);
  5206. var
  5207.   Loop: Integer;
  5208.   AlignList: TList;
  5209. begin
  5210.   if ControlCount = 0 then Exit;
  5211.   AlignList := TList.Create;
  5212.   DisableAlign;
  5213.   try
  5214.     { Collect all the Right and Left alignments }
  5215.     for Loop := 0 to ControlCount - 1 do with Controls[Loop] do
  5216.       if Align in [alLeft, alRight] then AlignList.Add(Controls[Loop]);
  5217.     { Flip 'em }
  5218.     DoFlipChildren;
  5219.   finally
  5220.     { Reverse the Right and Left alignments }
  5221.     while AlignList.Count > 0 do
  5222.     begin
  5223.       with TControl(AlignList.Items[AlignList.Count - 1]) do
  5224.         if Align = alLeft then
  5225.           Align := alRight
  5226.         else
  5227.           Align := alLeft;
  5228.       AlignList.Delete(AlignList.Count - 1);
  5229.     end;
  5230.     AlignList.Free;
  5231.     EnableAlign;
  5232.   end;
  5233.   if AllLevels then
  5234.     for Loop := 0 to ControlCount - 1 do
  5235.       if Controls[Loop] is TWinControl then
  5236.         TWinControl(Controls[Loop]).FlipChildren(True);
  5237. end;
  5238.  
  5239. function TWinControl.ContainsControl(Control: TControl): Boolean;
  5240. begin
  5241.   while (Control <> nil) and (Control <> Self) do Control := Control.Parent;
  5242.   Result := Control <> nil;
  5243. end;
  5244.  
  5245. procedure TWinControl.RemoveFocus(Removing: Boolean);
  5246. var
  5247.   Form: TCustomForm;
  5248. begin
  5249.   Form := GetParentForm(Self);
  5250.   if Form <> nil then Form.DefocusControl(Self, Removing);
  5251. end;
  5252.  
  5253. procedure TWinControl.Insert(AControl: TControl);
  5254. begin
  5255.   if AControl <> nil then
  5256.   begin
  5257.     if AControl is TWinControl then
  5258.     begin
  5259.       ListAdd(FWinControls, AControl);
  5260.       ListAdd(FTabList, AControl);
  5261.     end else
  5262.       ListAdd(FControls, AControl);
  5263.     AControl.FParent := Self;
  5264.   end;
  5265. end;
  5266.  
  5267. procedure TWinControl.Remove(AControl: TControl);
  5268. begin
  5269.   if AControl is TWinControl then
  5270.   begin
  5271.     ListRemove(FTabList, AControl);
  5272.     ListRemove(FWinControls, AControl);
  5273.   end else
  5274.     ListRemove(FControls, AControl);
  5275.   AControl.FParent := nil;
  5276. end;
  5277.  
  5278. procedure TWinControl.InsertControl(AControl: TControl);
  5279. begin
  5280.   AControl.ValidateContainer(Self);
  5281.   Perform(CM_CONTROLLISTCHANGE, Integer(AControl), Integer(True));
  5282.   Insert(AControl);
  5283.   if not (csReadingState in AControl.ControlState) then
  5284.   begin
  5285.     AControl.Perform(CM_PARENTCOLORCHANGED, 0, 0);
  5286.     AControl.Perform(CM_PARENTFONTCHANGED, 0, 0);
  5287.     AControl.Perform(CM_PARENTSHOWHINTCHANGED, 0, 0);
  5288.     AControl.Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
  5289.     if AControl is TWinControl then
  5290.     begin
  5291.       AControl.Perform(CM_PARENTCTL3DCHANGED, 0, 0);
  5292.       UpdateControlState;
  5293.     end else
  5294.       if HandleAllocated then AControl.Invalidate;
  5295.     AlignControl(AControl);
  5296.   end;
  5297.   Perform(CM_CONTROLCHANGE, Integer(AControl), Integer(True));
  5298. end;
  5299.  
  5300. procedure TWinControl.RemoveControl(AControl: TControl);
  5301. begin
  5302.   Perform(CM_CONTROLCHANGE, Integer(AControl), Integer(False));
  5303.   if AControl is TWinControl then
  5304.     with TWinControl(AControl) do
  5305.     begin
  5306.       RemoveFocus(True);
  5307.       DestroyHandle;
  5308.     end
  5309.   else
  5310.     if HandleAllocated then
  5311.       AControl.InvalidateControl(AControl.Visible, False);
  5312.   Remove(AControl);
  5313.   Perform(CM_CONTROLLISTCHANGE, Integer(AControl), Integer(False));
  5314.   Realign;
  5315. end;
  5316.  
  5317. function TWinControl.GetControl(Index: Integer): TControl;
  5318. var
  5319.   N: Integer;
  5320. begin
  5321.   if FControls <> nil then N := FControls.Count else N := 0;
  5322.   if Index < N then
  5323.     Result := FControls[Index] else
  5324.     Result := FWinControls[Index - N];
  5325. end;
  5326.  
  5327. function TWinControl.GetControlCount: Integer;
  5328. begin
  5329.   Result := 0;
  5330.   if FControls <> nil then Inc(Result, FControls.Count);
  5331.   if FWinControls <> nil then Inc(Result, FWinControls.Count);
  5332. end;
  5333.  
  5334. procedure TWinControl.Broadcast(var Message);
  5335. var
  5336.   I: Integer;
  5337. begin
  5338.   for I := 0 to ControlCount - 1 do
  5339.   begin
  5340.     Controls[I].WindowProc(TMessage(Message));
  5341.     if TMessage(Message).Result <> 0 then Exit;
  5342.   end;
  5343. end;
  5344.  
  5345. procedure TWinControl.NotifyControls(Msg: Word);
  5346. var
  5347.   Message: TMessage;
  5348. begin
  5349.   Message.Msg := Msg;
  5350.   Message.WParam := 0;
  5351.   Message.LParam := 0;
  5352.   Message.Result := 0;
  5353.   Broadcast(Message);
  5354. end;
  5355.  
  5356. procedure TWinControl.CreateSubClass(var Params: TCreateParams;
  5357.   ControlClassName: PChar);
  5358. const
  5359.   CS_OFF = CS_OWNDC or CS_CLASSDC or CS_PARENTDC or CS_GLOBALCLASS;
  5360.   CS_ON = CS_VREDRAW or CS_HREDRAW;
  5361. var
  5362.   SaveInstance: THandle;
  5363. begin
  5364.   if ControlClassName <> nil then
  5365.     with Params do
  5366.     begin
  5367.       SaveInstance := WindowClass.hInstance;
  5368.       if not GetClassInfo(HInstance, ControlClassName, WindowClass) and
  5369.         not GetClassInfo(0, ControlClassName, WindowClass) and
  5370.         not GetClassInfo(MainInstance, ControlClassName, WindowClass) then
  5371.         GetClassInfo(WindowClass.hInstance, ControlClassName, WindowClass);
  5372.       WindowClass.hInstance := SaveInstance;
  5373.       WindowClass.style := WindowClass.style and not CS_OFF or CS_ON;
  5374.     end;
  5375. end;
  5376.  
  5377. procedure TWinControl.AddBiDiModeExStyle(var ExStyle: DWORD);
  5378. begin
  5379.   if UseRightToLeftReading then
  5380.     ExStyle := ExStyle or WS_EX_RTLREADING;
  5381.   if UseRightToLeftScrollbar then
  5382.     ExStyle := ExStyle or WS_EX_LEFTSCROLLBAR;
  5383.   if UseRightToLeftAlignment then
  5384.     if GetControlsAlignment = taLeftJustify then
  5385.       ExStyle := ExStyle or WS_EX_RIGHT
  5386.     else if GetControlsAlignment = taRightJustify then
  5387.       ExStyle := ExStyle or WS_EX_LEFT;
  5388. end;
  5389.  
  5390. procedure TWinControl.CreateParams(var Params: TCreateParams);
  5391. begin
  5392.   FillChar(Params, SizeOf(Params), 0);
  5393.   with Params do
  5394.   begin
  5395.     Caption := FText;
  5396.     Style := WS_CHILD or WS_CLIPSIBLINGS;
  5397.     AddBiDiModeExStyle(ExStyle);
  5398.     if csAcceptsControls in ControlStyle then
  5399.     begin
  5400.       Style := Style or WS_CLIPCHILDREN;
  5401.       ExStyle := ExStyle or WS_EX_CONTROLPARENT;
  5402.     end;
  5403.     if not (csDesigning in ComponentState) and not Enabled then
  5404.       Style := Style or WS_DISABLED;
  5405.     if FTabStop then Style := Style or WS_TABSTOP;
  5406.     X := FLeft;
  5407.     Y := FTop;
  5408.     Width := FWidth;
  5409.     Height := FHeight;
  5410.     if Parent <> nil then
  5411.       WndParent := Parent.GetHandle else
  5412.       WndParent := FParentWindow;
  5413.     WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS;
  5414.     WindowClass.lpfnWndProc := @DefWindowProc;
  5415.     WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
  5416.     WindowClass.hbrBackground := 0;
  5417.     WindowClass.hInstance := HInstance;
  5418.     StrPCopy(WinClassName, ClassName);
  5419.   end;
  5420. end;
  5421.  
  5422. procedure TWinControl.CreateWnd;
  5423. var
  5424.   Params: TCreateParams;
  5425.   TempClass: TWndClass;
  5426.   ClassRegistered: Boolean;
  5427. begin
  5428.   CreateParams(Params);
  5429.   with Params do
  5430.   begin
  5431.     if (WndParent = 0) and (Style and WS_CHILD <> 0) then
  5432.       if (Owner <> nil) and (csReading in Owner.ComponentState) and
  5433.         (Owner is TWinControl) then
  5434.         WndParent := TWinControl(Owner).Handle
  5435.       else
  5436.         raise EInvalidOperation.CreateFmt(SParentRequired, [Name]);
  5437.     FDefWndProc := WindowClass.lpfnWndProc;
  5438.     ClassRegistered := GetClassInfo(WindowClass.hInstance, WinClassName, TempClass);
  5439.     if not ClassRegistered or (TempClass.lpfnWndProc <> @InitWndProc) then
  5440.     begin
  5441.       if ClassRegistered then Windows.UnregisterClass(WinClassName,
  5442.         WindowClass.hInstance);
  5443.       WindowClass.lpfnWndProc := @InitWndProc;
  5444.       WindowClass.lpszClassName := WinClassName;
  5445.       if Windows.RegisterClass(WindowClass) = 0 then RaiseLastWin32Error;
  5446.     end;
  5447.     CreationControl := Self;
  5448.     CreateWindowHandle(Params);
  5449.     if FHandle = 0 then RaiseLastWin32Error;
  5450.   end;
  5451.   StrDispose(FText);
  5452.   FText := nil;
  5453.   UpdateBounds;
  5454.   Perform(WM_SETFONT, FFont.Handle, 1);
  5455.   if AutoSize then AdjustSize;
  5456. end;
  5457.  
  5458. procedure TWinControl.CreateWindowHandle(const Params: TCreateParams);
  5459. begin
  5460.   with Params do
  5461.     FHandle := CreateWindowEx(ExStyle, WinClassName, Caption, Style,
  5462.       X, Y, Width, Height, WndParent, 0, WindowClass.hInstance, Param);
  5463. end;
  5464.  
  5465. procedure TWinControl.DestroyWnd;
  5466. var
  5467.   Len: Integer;
  5468. begin
  5469.   Len := GetTextLen;
  5470.   if Len < 1 then FText := StrNew('') else
  5471.   begin
  5472.     FText := StrAlloc(Len + 1);
  5473.     GetTextBuf(FText, StrBufSize(FText));
  5474.   end;
  5475.   FreeDeviceContexts;
  5476.   DestroyWindowHandle;
  5477. end;
  5478.  
  5479. procedure TWinControl.DestroyWindowHandle;
  5480. begin
  5481.   Include(FControlState, csDestroyingHandle);
  5482.   try
  5483.     if not Windows.DestroyWindow(FHandle) then
  5484.       RaiseLastWin32Error;
  5485.   finally
  5486.     Exclude(FControlState, csDestroyingHandle);
  5487.   end;
  5488.   FHandle := 0;
  5489. end;
  5490.  
  5491. function TWinControl.PrecedingWindow(Control: TWinControl): HWnd;
  5492. var
  5493.   I: Integer;
  5494. begin
  5495.   for I := FWinControls.IndexOf(Control) + 1 to FWinControls.Count - 1 do
  5496.   begin
  5497.     Result := TWinControl(FWinControls[I]).FHandle;
  5498.     if Result <> 0 then Exit;
  5499.   end;
  5500.   Result := HWND_TOP;
  5501. end;
  5502.  
  5503. procedure TWinControl.CreateHandle;
  5504. var
  5505.   I: Integer;
  5506. begin
  5507.   if FHandle = 0 then
  5508.   begin
  5509.     CreateWnd;
  5510.     SetProp(FHandle, MakeIntAtom(ControlAtom), THandle(Self));
  5511.     SetProp(FHandle, MakeIntAtom(WindowAtom), THandle(Self));
  5512.     if Parent <> nil then
  5513.       SetWindowPos(FHandle, Parent.PrecedingWindow(Self), 0, 0, 0, 0,
  5514.         SWP_NOMOVE + SWP_NOSIZE + SWP_NOACTIVATE);
  5515.     for I := 0 to ControlCount - 1 do
  5516.       Controls[I].UpdateAnchorRules;
  5517.   end;
  5518. end;
  5519.  
  5520. procedure TWinControl.DestroyHandle;
  5521. var
  5522.   I: Integer;
  5523. begin
  5524.   if FHandle <> 0 then
  5525.   begin
  5526.     if FWinControls <> nil then
  5527.       for I := 0 to FWinControls.Count - 1 do
  5528.         TWinControl(FWinControls[I]).DestroyHandle;
  5529.     DestroyWnd;
  5530.   end;
  5531. end;
  5532.  
  5533. procedure TWinControl.RecreateWnd;
  5534. begin
  5535.   if FHandle <> 0 then Perform(CM_RECREATEWND, 0, 0);
  5536. end;
  5537.  
  5538. procedure TWinControl.CMRecreateWnd(var Message: TMessage);
  5539. var
  5540.   WasFocused: Boolean;
  5541. begin
  5542.   WasFocused := Focused;
  5543.   DestroyHandle;
  5544.   UpdateControlState;
  5545.   if WasFocused and (FHandle <> 0) then Windows.SetFocus(FHandle);
  5546. end;
  5547.  
  5548. procedure TWinControl.UpdateShowing;
  5549. var
  5550.   ShowControl: Boolean;
  5551.   I: Integer;
  5552. begin
  5553.   ShowControl := (FVisible or (csDesigning in ComponentState) and
  5554.     not (csNoDesignVisible in ControlStyle)) and
  5555.     not (csReadingState in ControlState);
  5556.   if ShowControl then
  5557.   begin
  5558.     if FHandle = 0 then CreateHandle;
  5559.     if FWinControls <> nil then
  5560.       for I := 0 to FWinControls.Count - 1 do
  5561.         TWinControl(FWinControls[I]).UpdateShowing;
  5562.   end;
  5563.   if FHandle <> 0 then
  5564.     if FShowing <> ShowControl then
  5565.     begin
  5566.       FShowing := ShowControl;
  5567.       try
  5568.         Perform(CM_SHOWINGCHANGED, 0, 0);
  5569.       except
  5570.         FShowing := not ShowControl;
  5571.         raise;
  5572.       end;
  5573.     end;
  5574. end;
  5575.  
  5576. procedure TWinControl.UpdateControlState;
  5577. var
  5578.   Control: TWinControl;
  5579. begin
  5580.   Control := Self;
  5581.   while Control.Parent <> nil do
  5582.   begin
  5583.     Control := Control.Parent;
  5584.     if not Control.Showing then Exit;
  5585.   end;
  5586.   if (Control is TCustomForm) or (Control.FParentWindow <> 0) then UpdateShowing;
  5587. end;
  5588.  
  5589. procedure TWinControl.SetParentWindow(Value: HWnd);
  5590. begin
  5591.   if (FParent = nil) and (FParentWindow <> Value) then
  5592.   begin
  5593.     if (FHandle <> 0) and (FParentWindow <> 0) and (Value <> 0) then
  5594.     begin
  5595.       FParentWindow := Value;
  5596.       Windows.SetParent(FHandle, Value);
  5597.       if (Win32MajorVersion >= 5) and (Win32Platform = VER_PLATFORM_WIN32_NT) then
  5598.         Perform(WM_CHANGEUISTATE, MakeWParam(UIS_INITIALIZE, UISF_HIDEACCEL or UISF_HIDEFOCUS), 0);
  5599.     end else
  5600.     begin
  5601.       DestroyHandle;
  5602.       FParentWindow := Value;
  5603.     end;
  5604.     UpdateControlState;
  5605.   end;
  5606. end;
  5607.  
  5608. procedure TWinControl.MainWndProc(var Message: TMessage);
  5609. begin
  5610.   try
  5611.     try
  5612.       WindowProc(Message);
  5613.     finally
  5614.       FreeDeviceContexts;
  5615.       FreeMemoryContexts;
  5616.     end;
  5617.   except
  5618.     Application.HandleException(Self);
  5619.   end;
  5620. end;
  5621.  
  5622. function TWinControl.ControlAtPos(const Pos: TPoint; AllowDisabled,
  5623.   AllowWinControls: Boolean): TControl;
  5624. var
  5625.   I: Integer;
  5626.   P: TPoint;
  5627.   vControl: TControl;
  5628.   function GetControlAtPos(AControl: TControl): Boolean;
  5629.   begin
  5630.     with AControl do
  5631.     begin
  5632.       P := Point(Pos.X - Left, Pos.Y - Top);
  5633.       Result := PtInRect(ClientRect, P) and
  5634.                 ((csDesigning in ComponentState) and (Visible or
  5635.                 not (csNoDesignVisible in ControlStyle)) or
  5636.                 (Visible and (Enabled or AllowDisabled) and
  5637.                 (Perform(CM_HITTEST, 0, Longint(PointToSmallPoint(P))) <> 0)));
  5638.       if Result then
  5639.         vControl := AControl;
  5640.     end;
  5641.   end;
  5642. begin
  5643.   vControl := nil;
  5644.   if AllowWinControls and
  5645.      (FWinControls <> nil) then
  5646.     for I := FWinControls.Count - 1 downto 0 do
  5647.       if GetControlAtPos(FWinControls[I]) then
  5648.         Break;
  5649.   if (FControls <> nil) and
  5650.      (vControl = nil) then
  5651.     for I := FControls.Count - 1 downto 0 do
  5652.       if GetControlAtPos(FControls[I]) then
  5653.         Break;
  5654.   Result := vControl;
  5655. end;
  5656.  
  5657. function TWinControl.IsControlMouseMsg(var Message: TWMMouse): Boolean;
  5658. var
  5659.   Control: TControl;
  5660.   P: TPoint;
  5661. begin
  5662.   if GetCapture = Handle then
  5663.   begin
  5664.     Control := nil;
  5665.     if (CaptureControl <> nil) and (CaptureControl.Parent = Self) then
  5666.       Control := CaptureControl;
  5667.   end else
  5668.     Control := ControlAtPos(SmallPointToPoint(Message.Pos), False);
  5669.   Result := False;
  5670.   if Control <> nil then
  5671.   begin
  5672.     P.X := Message.XPos - Control.Left;
  5673.     P.Y := Message.YPos - Control.Top;
  5674.     Message.Result := Control.Perform(Message.Msg, Message.Keys, Longint(PointToSmallPoint(P)));
  5675.     Result := True;
  5676.   end;
  5677. end;
  5678.  
  5679. procedure TWinControl.WndProc(var Message: TMessage);
  5680. var
  5681.   Form: TCustomForm;
  5682.   KeyState: TKeyboardState;
  5683.   WheelMsg: TCMMouseWheel;
  5684. begin
  5685.   case Message.Msg of
  5686.     WM_SETFOCUS:
  5687.       begin
  5688.         Form := GetParentForm(Self);
  5689.         if (Form <> nil) and not Form.SetFocusedControl(Self) then Exit;
  5690.       end;
  5691.     WM_KILLFOCUS:
  5692.       if csFocusing in ControlState then Exit;
  5693.     WM_NCHITTEST:
  5694.       begin
  5695.         inherited WndProc(Message);
  5696.         if (Message.Result = HTTRANSPARENT) and (ControlAtPos(ScreenToClient(
  5697.           SmallPointToPoint(TWMNCHitTest(Message).Pos)), False) <> nil) then
  5698.           Message.Result := HTCLIENT;
  5699.         Exit;
  5700.       end;
  5701.     WM_MOUSEFIRST..WM_MOUSELAST:
  5702.       if IsControlMouseMsg(TWMMouse(Message)) then
  5703.       begin
  5704.         if Message.Result = 0 then
  5705.           DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam);
  5706.         Exit;
  5707.       end;
  5708.     WM_KEYFIRST..WM_KEYLAST:
  5709.       if Dragging then Exit;
  5710.     WM_CANCELMODE:
  5711.       if (GetCapture = Handle) and (CaptureControl <> nil) and
  5712.         (CaptureControl.Parent = Self) then
  5713.         CaptureControl.Perform(WM_CANCELMODE, 0, 0);
  5714.   else
  5715.     with Mouse do
  5716.       if WheelPresent and (RegWheelMessage <> 0) and
  5717.         (Message.Msg = RegWheelMessage) then
  5718.       begin
  5719.         GetKeyboardState(KeyState);
  5720.         with WheelMsg do
  5721.         begin
  5722.           Msg := Message.Msg;
  5723.           ShiftState := KeyboardStateToShiftState(KeyState);
  5724.           WheelDelta := Message.WParam;
  5725.           Pos := TSmallPoint(Message.LParam);
  5726.         end;
  5727.         MouseWheelHandler(TMessage(WheelMsg));
  5728.         Exit;
  5729.       end;
  5730.   end;
  5731.   inherited WndProc(Message);
  5732. end;
  5733.  
  5734. procedure TWinControl.DefaultHandler(var Message);
  5735. begin
  5736.   if FHandle <> 0 then
  5737.   begin
  5738.     with TMessage(Message) do
  5739.     begin
  5740.       if (Msg = WM_CONTEXTMENU) and (Parent <> nil) then
  5741.       begin
  5742.         Result := Parent.Perform(Msg, WParam, LParam);
  5743.         if Result <> 0 then Exit;
  5744.       end;
  5745.       case Msg of
  5746.         WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC:
  5747.           Result := SendMessage(LParam, CN_BASE + Msg, WParam, LParam);
  5748.         CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC:
  5749.           begin
  5750.             SetTextColor(WParam, ColorToRGB(FFont.Color));
  5751.             SetBkColor(WParam, ColorToRGB(FBrush.Color));
  5752.             Result := FBrush.Handle;
  5753.           end;
  5754.       else
  5755.         Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
  5756.       end;
  5757.       if Msg = WM_SETTEXT then
  5758.         SendDockNotification(Msg, WParam, LParam);
  5759.     end;
  5760.   end
  5761.   else
  5762.     inherited DefaultHandler(Message);
  5763. end;
  5764.  
  5765. function DoControlMsg(ControlHandle: HWnd; var Message): Boolean;
  5766. var
  5767.   Control: TWinControl;
  5768. begin
  5769.   DoControlMsg := False;
  5770.   Control := FindControl(ControlHandle);
  5771.   if Control <> nil then
  5772.     with TMessage(Message) do
  5773.     begin
  5774.       Result := Control.Perform(Msg + CN_BASE, WParam, LParam);
  5775.       DoControlMsg := True;
  5776.     end;
  5777. end;
  5778.  
  5779. procedure TWinControl.PaintHandler(var Message: TWMPaint);
  5780. var
  5781.   I, Clip, SaveIndex: Integer;
  5782.   DC: HDC;
  5783.   PS: TPaintStruct;
  5784. begin
  5785.   DC := Message.DC;
  5786.   if DC = 0 then DC := BeginPaint(Handle, PS);
  5787.   try
  5788.     if FControls = nil then PaintWindow(DC) else
  5789.     begin
  5790.       SaveIndex := SaveDC(DC);
  5791.       Clip := SimpleRegion;
  5792.       for I := 0 to FControls.Count - 1 do
  5793.         with TControl(FControls[I]) do
  5794.           if (Visible or (csDesigning in ComponentState) and
  5795.             not (csNoDesignVisible in ControlStyle)) and
  5796.             (csOpaque in ControlStyle) then
  5797.           begin
  5798.             Clip := ExcludeClipRect(DC, Left, Top, Left + Width, Top + Height);
  5799.             if Clip = NullRegion then Break;
  5800.           end;
  5801.       if Clip <> NullRegion then PaintWindow(DC);
  5802.       RestoreDC(DC, SaveIndex);
  5803.     end;
  5804.     PaintControls(DC, nil);
  5805.   finally
  5806.     if Message.DC = 0 then EndPaint(Handle, PS);
  5807.   end;
  5808. end;
  5809.  
  5810. procedure TWinControl.PaintWindow(DC: HDC);
  5811. var
  5812.   Message: TMessage;
  5813. begin
  5814.   Message.Msg := WM_PAINT;
  5815.   Message.WParam := DC;
  5816.   Message.LParam := 0;
  5817.   Message.Result := 0;
  5818.   DefaultHandler(Message);
  5819. end;
  5820.  
  5821. procedure TWinControl.PaintControls(DC: HDC; First: TControl);
  5822. var
  5823.   I, Count, SaveIndex: Integer;
  5824.   FrameBrush: HBRUSH;
  5825. begin
  5826.   if DockSite and UseDockManager and (DockManager <> nil) then
  5827.     DockManager.PaintSite(DC);
  5828.   if FControls <> nil then
  5829.   begin
  5830.     I := 0;
  5831.     if First <> nil then
  5832.     begin
  5833.       I := FControls.IndexOf(First);
  5834.       if I < 0 then I := 0;
  5835.     end;
  5836.     Count := FControls.Count;
  5837.     while I < Count do
  5838.     begin
  5839.       with TControl(FControls[I]) do
  5840.         if (Visible or (csDesigning in ComponentState) and
  5841.           not (csNoDesignVisible in ControlStyle)) and
  5842.           RectVisible(DC, Rect(Left, Top, Left + Width, Top + Height)) then
  5843.         begin
  5844.           if csPaintCopy in Self.ControlState then
  5845.             Include(FControlState, csPaintCopy);
  5846.           SaveIndex := SaveDC(DC);
  5847.           MoveWindowOrg(DC, Left, Top);
  5848.           IntersectClipRect(DC, 0, 0, Width, Height);
  5849.           Perform(WM_PAINT, DC, 0);
  5850.           RestoreDC(DC, SaveIndex);
  5851.           Exclude(FControlState, csPaintCopy);
  5852.         end;
  5853.       Inc(I);
  5854.     end;
  5855.   end;
  5856.   if FWinControls <> nil then
  5857.     for I := 0 to FWinControls.Count - 1 do
  5858.       with TWinControl(FWinControls[I]) do
  5859.         if FCtl3D and (csFramed in ControlStyle) and
  5860.           (Visible or (csDesigning in ComponentState) and
  5861.           not (csNoDesignVisible in ControlStyle)) then
  5862.         begin
  5863.           FrameBrush := CreateSolidBrush(ColorToRGB(clBtnShadow));
  5864.           FrameRect(DC, Rect(Left - 1, Top - 1, Left + Width, Top + Height),
  5865.             FrameBrush);
  5866.           DeleteObject(FrameBrush);
  5867.           FrameBrush := CreateSolidBrush(ColorToRGB(clBtnHighlight));
  5868.           FrameRect(DC, Rect(Left, Top, Left + Width + 1, Top + Height + 1),
  5869.             FrameBrush);
  5870.           DeleteObject(FrameBrush);
  5871.         end;
  5872. end;
  5873.  
  5874. procedure TWinControl.PaintTo(DC: HDC; X, Y: Integer);
  5875. var
  5876.   I, EdgeFlags, BorderFlags, SaveIndex: Integer;
  5877.   R: TRect;
  5878. begin
  5879.   Include(FControlState, csPaintCopy);
  5880.   SaveIndex := SaveDC(DC);
  5881.   MoveWindowOrg(DC, X, Y);
  5882.   IntersectClipRect(DC, 0, 0, Width, Height);
  5883.   BorderFlags := 0;
  5884.   EdgeFlags := 0;
  5885.   if GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_CLIENTEDGE <> 0 then
  5886.   begin
  5887.     EdgeFlags := EDGE_SUNKEN;
  5888.     BorderFlags := BF_RECT or BF_ADJUST
  5889.   end else
  5890.   if GetWindowLong(Handle, GWL_STYLE) and WS_BORDER <> 0 then
  5891.   begin
  5892.     EdgeFlags := BDR_OUTER;
  5893.     BorderFlags := BF_RECT or BF_ADJUST or BF_MONO;
  5894.   end;
  5895.   if BorderFlags <> 0 then
  5896.   begin
  5897.     SetRect(R, 0, 0, Width, Height);
  5898.     DrawEdge(DC, R, EdgeFlags, BorderFlags);
  5899.     MoveWindowOrg(DC, R.Left, R.Top);
  5900.     IntersectClipRect(DC, 0, 0, R.Right - R.Left, R.Bottom - R.Top);
  5901.   end;
  5902.   Perform(WM_ERASEBKGND, DC, 0);
  5903.   Perform(WM_PAINT, DC, 0);
  5904.   if FWinControls <> nil then
  5905.     for I := 0 to FWinControls.Count - 1 do
  5906.       with TWinControl(FWinControls[I]) do
  5907.         if Visible then PaintTo(DC, Left, Top);
  5908.   RestoreDC(DC, SaveIndex);
  5909.   Exclude(FControlState, csPaintCopy);
  5910. end;
  5911.  
  5912. procedure TWinControl.WMPaint(var Message: TWMPaint);
  5913. var
  5914.   DC, MemDC: HDC;
  5915.   MemBitmap, OldBitmap: HBITMAP;
  5916.   PS: TPaintStruct;
  5917. begin
  5918.   if not FDoubleBuffered or (Message. DC <> 0) then
  5919.   begin
  5920.     if not (csCustomPaint in ControlState) and (ControlCount = 0) then
  5921.       inherited
  5922.     else
  5923.       PaintHandler(Message);
  5924.   end
  5925.   else
  5926.   begin
  5927.     DC := GetDC(0);
  5928.     MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
  5929.     ReleaseDC(0, DC);
  5930.     MemDC := CreateCompatibleDC(0);
  5931.     OldBitmap := SelectObject(MemDC, MemBitmap);
  5932.     try
  5933.       DC := BeginPaint(Handle, PS);
  5934.       Perform(WM_ERASEBKGND, MemDC, MemDC);
  5935.       Message.DC := MemDC;
  5936.       WMPaint(Message);
  5937.       Message.DC := 0;
  5938.       BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
  5939.       EndPaint(Handle, PS);
  5940.     finally
  5941.       SelectObject(MemDC, OldBitmap);
  5942.       DeleteDC(MemDC);
  5943.       DeleteObject(MemBitmap);
  5944.     end;
  5945.   end;
  5946. end;
  5947.  
  5948. procedure TWinControl.WMCommand(var Message: TWMCommand);
  5949. begin
  5950.   if not DoControlMsg(Message.Ctl, Message) then inherited;
  5951. end;
  5952.  
  5953. procedure TWinControl.WMNotify(var Message: TWMNotify);
  5954. begin
  5955.   if not DoControlMsg(Message.NMHdr^.hWndFrom, Message) then inherited;
  5956. end;
  5957.  
  5958. procedure TWinControl.WMSysColorChange(var Message: TWMSysColorChange);
  5959. begin
  5960.   Graphics.PaletteChanged;
  5961.   Perform(CM_SYSCOLORCHANGE, 0, 0);
  5962. end;
  5963.  
  5964. procedure TWinControl.WMWinIniChange(var Message: TMessage);
  5965. begin
  5966.   Perform(CM_WININICHANGE, Message.wParam, Message.lParam);
  5967. end;
  5968.  
  5969. procedure TWinControl.WMFontChange(var Message: TMessage);
  5970. begin
  5971.   Perform(CM_FONTCHANGE, 0, 0);
  5972. end;
  5973.  
  5974. procedure TWinControl.WMTimeChange(var Message: TMessage);
  5975. begin
  5976.   Perform(CM_TIMECHANGE, 0, 0);
  5977. end;
  5978.  
  5979. procedure TWinControl.WMHScroll(var Message: TWMHScroll);
  5980. begin
  5981.   if not DoControlMsg(Message.ScrollBar, Message) then inherited;
  5982. end;
  5983.  
  5984. procedure TWinControl.WMVScroll(var Message: TWMVScroll);
  5985. begin
  5986.   if not DoControlMsg(Message.ScrollBar, Message) then inherited;
  5987. end;
  5988.  
  5989. procedure TWinControl.WMCompareItem(var Message: TWMCompareItem);
  5990. begin
  5991.   if not DoControlMsg(Message.CompareItemStruct^.CtlID, Message) then inherited;
  5992. end;
  5993.  
  5994. procedure TWinControl.WMDeleteItem(var Message: TWMDeleteItem);
  5995. begin
  5996.   if not DoControlMsg(Message.DeleteItemStruct^.CtlID, Message) then inherited;
  5997. end;
  5998.  
  5999. procedure TWinControl.WMDrawItem(var Message: TWMDrawItem);
  6000. begin
  6001.   if not DoControlMsg(Message.DrawItemStruct^.CtlID, Message) then inherited;
  6002. end;
  6003.  
  6004. procedure TWinControl.WMMeasureItem(var Message: TWMMeasureItem);
  6005. begin
  6006.   if not DoControlMsg(Message.MeasureItemStruct^.CtlID, Message) then inherited;
  6007. end;
  6008.  
  6009. procedure TWinControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  6010. begin
  6011.   { Only erase background if we're not doublebuffering or painting to memory. }
  6012.   if not FDoubleBuffered or
  6013.     (TMessage(Message).wParam = TMessage(Message).lParam) then
  6014.     FillRect(Message.DC, ClientRect, FBrush.Handle);
  6015.   Message.Result := 1;
  6016. end;
  6017.  
  6018. procedure TWinControl.WMWindowPosChanged(var Message: TWMWindowPosChanged);
  6019. var
  6020.   Framed, Moved, Sized: Boolean;
  6021. begin
  6022.   Framed := FCtl3D and (csFramed in ControlStyle) and (Parent <> nil) and
  6023.     (Message.WindowPos^.flags and SWP_NOREDRAW = 0);
  6024.   Moved := (Message.WindowPos^.flags and SWP_NOMOVE = 0) and
  6025.     IsWindowVisible(FHandle);
  6026.   Sized := (Message.WindowPos^.flags and SWP_NOSIZE = 0) and
  6027.     IsWindowVisible(FHandle);
  6028.   if Framed and (Moved or Sized) then
  6029.     InvalidateFrame;
  6030.   if not (csDestroyingHandle in ControlState) then
  6031.     UpdateBounds;
  6032.   inherited;
  6033.   if Framed and ((Moved or Sized) or (Message.WindowPos^.flags and
  6034.     (SWP_SHOWWINDOW or SWP_HIDEWINDOW) <> 0)) then
  6035.     InvalidateFrame;
  6036. end;
  6037.  
  6038. procedure TWinControl.WMWindowPosChanging(var Message: TWMWindowPosChanging);
  6039. begin
  6040.   if ComponentState * [csReading, csDestroying] = [] then
  6041.     with Message.WindowPos^ do
  6042.       if (flags and SWP_NOSIZE = 0) and not CheckNewSize(cx, cy) then
  6043.         flags := flags or SWP_NOSIZE;
  6044.   inherited;
  6045. end;
  6046.  
  6047. procedure TWinControl.WMSize(var Message: TWMSize);
  6048. begin
  6049.   UpdateBounds;
  6050.   inherited;
  6051.   Realign;
  6052.   if not (csLoading in ComponentState) then Resize;
  6053. end;
  6054.  
  6055. procedure TWinControl.WMMove(var Message: TWMMove);
  6056. begin
  6057.   inherited;
  6058.   UpdateBounds;
  6059. end;
  6060.  
  6061. procedure TWinControl.WMSetCursor(var Message: TWMSetCursor);
  6062. var
  6063.   Cursor: TCursor;
  6064.   Control: TControl;
  6065.   P: TPoint;
  6066. begin
  6067.   with Message do
  6068.     if CursorWnd = FHandle then
  6069.       case Smallint(HitTest) of
  6070.         HTCLIENT:
  6071.           begin
  6072.             Cursor := Screen.Cursor;
  6073.             if Cursor = crDefault then
  6074.             begin
  6075.               GetCursorPos(P);
  6076.               Control := ControlAtPos(ScreenToClient(P), False);
  6077.               if (Control <> nil) then
  6078.                 if csDesigning in Control.ComponentState then
  6079.                   Cursor := crArrow
  6080.                 else
  6081.                   Cursor := Control.FCursor;
  6082.               if Cursor = crDefault then
  6083.                 if csDesigning in ComponentState then
  6084.                   Cursor := crArrow
  6085.                 else
  6086.                   Cursor := FCursor;
  6087.             end;
  6088.             if Cursor <> crDefault then
  6089.             begin
  6090.               Windows.SetCursor(Screen.Cursors[Cursor]);
  6091.               Result := 1;
  6092.               Exit;
  6093.             end;
  6094.           end;
  6095.         HTERROR:
  6096.           if (MouseMsg = WM_LBUTTONDOWN) and (Application.Handle <> 0) and
  6097.             (GetForegroundWindow <> GetLastActivePopup(Application.Handle)) then
  6098.           begin
  6099.             Application.BringToFront;
  6100.             Exit;
  6101.           end;
  6102.       end;
  6103.   inherited;
  6104. end;
  6105.  
  6106. procedure TWinControl.WMSetFocus(var Message: TWMSetFocus);
  6107. begin
  6108.   inherited;
  6109.   SetIme;
  6110. end;
  6111.  
  6112. procedure TWinControl.WMKillFocus(var Message: TWMSetFocus);
  6113. begin
  6114.   inherited;
  6115.   ResetIme;
  6116. end;
  6117.  
  6118. procedure TWinControl.WMIMEStartComp(var Message: TMessage);
  6119. begin
  6120.   FInImeComposition := True;
  6121.   inherited;
  6122. end;
  6123.  
  6124. procedure TWinControl.WMIMEEndComp(var Message: TMessage);
  6125. begin
  6126.   FInImeComposition := False;
  6127.   inherited;
  6128. end;
  6129.  
  6130. function TWinControl.SetImeCompositionWindow(Font: TFont;
  6131.   XPos, YPos: Integer): Boolean;
  6132. var
  6133.   H: HIMC;
  6134.   CForm: TCompositionForm;
  6135.   LFont: TLogFont;
  6136. begin
  6137.   Result := False;
  6138.   H := Imm32GetContext(Handle);
  6139.   if H <> 0 then
  6140.   begin
  6141.     with CForm do
  6142.     begin
  6143.       dwStyle := CFS_POINT;
  6144.       ptCurrentPos.x := XPos;
  6145.       ptCurrentPos.y := YPos;
  6146.     end;
  6147.     Imm32SetCompositionWindow(H, @CForm);
  6148.     if Assigned(Font) then
  6149.     begin
  6150.       GetObject(Font.Handle, SizeOf(TLogFont), @LFont);
  6151.       Imm32SetCompositionFont(H, @LFont);
  6152.     end;
  6153.     Imm32ReleaseContext(Handle, H);
  6154.     Result := True;
  6155.   end;
  6156. end;
  6157.  
  6158. function TWinControl.ResetImeComposition(Action: DWORD): Boolean;
  6159. var
  6160.   H: HIMC;
  6161. begin
  6162.   Result := False;
  6163.   if FInImeComposition then
  6164.   begin
  6165.     H := Imm32GetContext(Handle);
  6166.     if H <> 0 then
  6167.     begin
  6168.       Result := Imm32NotifyIME(H, NI_COMPOSITIONSTR, Action, 0);
  6169.       Imm32ReleaseContext(Handle, H);
  6170.     end;
  6171.   end;
  6172. end;
  6173.  
  6174. procedure TWinControl.SetIme;
  6175. var
  6176.   I: Integer;
  6177.   HandleToSet: HKL;
  6178. begin
  6179.   if not SysLocale.FarEast then Exit;
  6180.   if FImeName <> '' then
  6181.   begin
  6182.     if (AnsiCompareText(FImeName, Screen.DefaultIme) <> 0) and (Screen.Imes.Count <> 0) then
  6183.     begin
  6184.       HandleToSet := Screen.DefaultKbLayout;
  6185.       if FImeMode <> imDisable then
  6186.       begin
  6187.         I := Screen.Imes.IndexOf(FImeName);
  6188.         if I >= 0 then
  6189.           HandleToSet := HKL(Screen.Imes.Objects[I]);
  6190.       end;
  6191.       ActivateKeyboardLayout(HandleToSet, KLF_ACTIVATE);
  6192.     end;
  6193.   end;
  6194.   SetImeMode(Handle, FImeMode);
  6195. end;
  6196.  
  6197. procedure TWinControl.ResetIme;
  6198. begin
  6199.   if not SysLocale.FarEast then Exit;
  6200.   if FImeName <> '' then
  6201.   begin
  6202.     if AnsiCompareText(FImeName, Screen.DefaultIme) <> 0 then
  6203.       ActivateKeyboardLayout(Screen.DefaultKbLayout, KLF_ACTIVATE);
  6204.   end;
  6205.   if FImeMode = imDisable then Win32NLSEnableIME(Handle, TRUE);
  6206. end;
  6207.  
  6208. procedure TWinControl.DoAddDockClient(Client: TControl; const ARect: TRect);
  6209. begin
  6210.   Client.Parent := Self;
  6211. end;
  6212.  
  6213. procedure TWinControl.DoRemoveDockClient(Client: TControl);
  6214. begin
  6215.   // do nothing by default
  6216. end;
  6217.  
  6218. procedure TWinControl.DoEnter;
  6219. begin
  6220.   if Assigned(FOnEnter) then FOnEnter(Self);
  6221. end;
  6222.  
  6223. procedure TWinControl.DoExit;
  6224. begin
  6225.   if Assigned(FOnExit) then FOnExit(Self);
  6226. end;
  6227.  
  6228. procedure TWinControl.DockDrop(Source: TDragDockObject; X, Y: Integer);
  6229. begin
  6230.   if (Perform(CM_DOCKCLIENT, Integer(Source), Integer(SmallPoint(X, Y))) >= 0)
  6231.     and Assigned(FOnDockDrop) then
  6232.     FOnDockDrop(Self, Source, X, Y);
  6233. end;
  6234.  
  6235. procedure TWinControl.DoDockOver(Source: TDragDockObject; X, Y: Integer;
  6236.   State: TDragState; var Accept: Boolean);
  6237. begin
  6238.   if Assigned(FOnDockOver) then
  6239.     FOnDockOver(Self, Source, X, Y, State, Accept);
  6240. end;
  6241.  
  6242. procedure TWinControl.DockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState;
  6243.   var Accept: Boolean);
  6244. begin
  6245.   PositionDockRect(Source);
  6246.   DoDockOver(Source, X, Y, State, Accept);
  6247. end;
  6248.  
  6249. function TWinControl.DoUnDock(NewTarget: TWinControl; Client: TControl): Boolean;
  6250. begin
  6251.   Result := True;
  6252.   if Assigned(FOnUnDock) then FOnUnDock(Self, Client, NewTarget, Result);
  6253.   Result := Result and (Perform(CM_UNDOCKCLIENT, Integer(NewTarget), Integer(Client)) = 0);
  6254. end;
  6255.  
  6256. procedure TWinControl.ReloadDockedControl(const AControlName: string;
  6257.   var AControl: TControl);
  6258. begin
  6259.   AControl := Owner.FindComponent(AControlName) as TControl;
  6260. end;
  6261.  
  6262. function TWinControl.GetDockClientCount: Integer;
  6263. begin
  6264.   if FDockClients <> nil then Result := FDockClients.Count
  6265.   else Result := 0;
  6266. end;
  6267.  
  6268. function TWinControl.GetDockClients(Index: Integer): TControl;
  6269. begin
  6270.   if FDockClients <> nil then Result := FDockClients[Index]
  6271.   else Result := nil;
  6272. end;
  6273.  
  6274. procedure TWinControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
  6275.   MousePos: TPoint; var CanDock: Boolean);
  6276. const
  6277.   DefExpandoRect = 10;
  6278. begin
  6279.   GetWindowRect(Handle, InfluenceRect);
  6280.   InflateRect(InfluenceRect, DefExpandoRect, DefExpandoRect);
  6281.   if Assigned(FOnGetSiteInfo) then
  6282.     FOnGetSiteInfo(Self, Client, InfluenceRect, MousePos, CanDock);
  6283. end;
  6284.  
  6285. function TWinControl.GetVisibleDockClientCount: Integer;
  6286. var
  6287.   I: Integer;
  6288. begin
  6289.   Result := GetDockClientCount;
  6290.   if Result > 0 then
  6291.     for I := Result - 1 downto 0 do
  6292.       if not TControl(FDockClients[I]).Visible then Dec(Result);
  6293. end;
  6294.  
  6295. function TWinControl.CreateDockManager: IDockManager;
  6296. begin
  6297.   if (FDockManager = nil) and DockSite and UseDockManager then
  6298.     Result := DefaultDockTreeClass.Create(Self) else
  6299.     Result := FDockManager;
  6300.   DoubleBuffered := DoubleBuffered or (Result <> nil);
  6301. end;
  6302.  
  6303. procedure TWinControl.SetDockSite(Value: Boolean);
  6304. begin
  6305.   if Value <> FDockSite then
  6306.   begin
  6307.     FDockSite := Value;
  6308.     if not (csDesigning in ComponentState) then
  6309.     begin
  6310.       RegisterDockSite(Self, Value);
  6311.       if not Value then
  6312.       begin
  6313.         FDockClients.Free;
  6314.         FDockClients := nil;
  6315.         FDockManager := nil;
  6316.       end
  6317.       else begin
  6318.         if FDockClients = nil then FDockClients := TList.Create;
  6319.         FDockManager := CreateDockManager;
  6320.       end;
  6321.     end;
  6322.   end;
  6323. end;
  6324.  
  6325. procedure TWinControl.CMDockClient(var Message: TCMDockClient);
  6326. var
  6327.   DestRect: TRect;
  6328.   Form: TCustomForm;
  6329. begin
  6330.   with Message do
  6331.     if Result = 0 then
  6332.     begin
  6333.       { Map DockRect to dock site's client coordinates }
  6334.       DestRect := Message.DockSource.DockRect;
  6335.       MapWindowPoints(0, Handle, DestRect, 2);
  6336.       DisableAlign;
  6337.       try
  6338.         DockSource.Control.Dock(Self, DestRect);
  6339.         if FUseDockManager and (FDockManager <> nil) then
  6340.           FDockManager.InsertControl(DockSource.Control,
  6341.             DockSource.DropAlign, DockSource.DropOnControl);
  6342.       finally
  6343.         EnableAlign;
  6344.       end;
  6345.       Form := GetParentForm(Self);
  6346.       if Form <> nil then Form.BringToFront;
  6347.       Result := 1;
  6348.     end;
  6349. end;
  6350.  
  6351. procedure TWinControl.CMUnDockClient(var Message: TCMUnDockClient);
  6352. begin
  6353.   with Message do
  6354.   begin
  6355.     Result := 0;
  6356.     if FUseDockManager and (FDockManager <> nil) then
  6357.       FDockManager.RemoveControl(Client)
  6358.   end;
  6359. end;
  6360.  
  6361. procedure TWinControl.CMFloat(var Message: TCMFloat);
  6362. var
  6363.   WasVisible: Boolean;
  6364. begin
  6365.   if (FloatingDockSiteClass = ClassType) then
  6366.   begin
  6367.     WasVisible := Visible;
  6368.     try
  6369.       Dock(nil, Message.DockSource.FDockRect);
  6370.     finally
  6371.       if WasVisible then BringToFront;
  6372.     end;
  6373.   end
  6374.   else
  6375.     inherited;
  6376. end;
  6377.  
  6378. procedure TWinControl.KeyDown(var Key: Word; Shift: TShiftState);
  6379. begin
  6380.   if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift);
  6381. end;
  6382.  
  6383. function TWinControl.DoKeyDown(var Message: TWMKey): Boolean;
  6384. var
  6385.   ShiftState: TShiftState;
  6386.   Form: TCustomForm;
  6387. begin
  6388.   Result := True;
  6389.   Form := GetParentForm(Self);
  6390.   if (Form <> nil) and (Form <> Self) and Form.KeyPreview and
  6391.     TWinControl(Form).DoKeyDown(Message) then Exit;
  6392.   with Message do
  6393.   begin
  6394.     ShiftState := KeyDataToShiftState(KeyData);
  6395.     if not (csNoStdEvents in ControlStyle) then
  6396.     begin
  6397.       KeyDown(CharCode, ShiftState);
  6398.       if CharCode = 0 then Exit;
  6399.     end;
  6400.   end;
  6401.   Result := False;
  6402. end;
  6403.  
  6404. procedure TWinControl.WMKeyDown(var Message: TWMKeyDown);
  6405. begin
  6406.   if not DoKeyDown(Message) then inherited;
  6407. end;
  6408.  
  6409. procedure TWinControl.WMSysKeyDown(var Message: TWMKeyDown);
  6410. begin
  6411.   if not DoKeyDown(Message) then inherited;
  6412. end;
  6413.  
  6414. procedure TWinControl.KeyUp(var Key: Word; Shift: TShiftState);
  6415. begin
  6416.   if Assigned(FOnKeyUp) then FOnKeyUp(Self, Key, Shift);
  6417. end;
  6418.  
  6419. function TWinControl.DoKeyUp(var Message: TWMKey): Boolean;
  6420. var
  6421.   ShiftState: TShiftState;
  6422.   Form: TCustomForm;
  6423. begin
  6424.   Result := True;
  6425.   Form := GetParentForm(Self);
  6426.   if (Form <> nil) and (Form <> Self) and Form.KeyPreview and
  6427.     TWinControl(Form).DoKeyUp(Message) then Exit;
  6428.   with Message do
  6429.   begin
  6430.     ShiftState := KeyDataToShiftState(KeyData);
  6431.     if not (csNoStdEvents in ControlStyle) then
  6432.     begin
  6433.       KeyUp(CharCode, ShiftState);
  6434.       if CharCode = 0 then Exit;
  6435.     end;
  6436.   end;
  6437.   Result := False;
  6438. end;
  6439.  
  6440. procedure TWinControl.WMKeyUp(var Message: TWMKeyUp);
  6441. begin
  6442.   if not DoKeyUp(Message) then inherited;
  6443. end;
  6444.  
  6445. procedure TWinControl.WMSysKeyUp(var Message: TWMKeyUp);
  6446. begin
  6447.   if not DoKeyUp(Message) then inherited;
  6448. end;
  6449.  
  6450. procedure TWinControl.KeyPress(var Key: Char);
  6451. begin
  6452.   if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key);
  6453. end;
  6454.  
  6455. function TWinControl.DoKeyPress(var Message: TWMKey): Boolean;
  6456. var
  6457.   Form: TCustomForm;
  6458.   Ch: Char;
  6459. begin
  6460.   Result := True;
  6461.   Form := GetParentForm(Self);
  6462.   if (Form <> nil) and (Form <> Self) and Form.KeyPreview and
  6463.     TWinControl(Form).DoKeyPress(Message) then Exit;
  6464.   if not (csNoStdEvents in ControlStyle) then
  6465.     with Message do
  6466.     begin
  6467.       Ch := Char(CharCode);
  6468.       KeyPress(Ch);
  6469.       CharCode := Word(Ch);
  6470.       if Char(CharCode) = #0 then Exit;
  6471.     end;
  6472.   Result := False;
  6473. end;
  6474.  
  6475. procedure TWinControl.WMChar(var Message: TWMChar);
  6476. begin
  6477.   if not DoKeyPress(Message) then inherited;
  6478. end;
  6479.  
  6480. procedure TWinControl.CMMouseWheel(var Message: TCMMouseWheel);
  6481. begin
  6482.   with Message do
  6483.   begin
  6484.     Result := 0;
  6485.     if DoMouseWheel(ShiftState, WheelDelta, SmallPointToPoint(Pos)) then
  6486.       Message.Result := 1
  6487.     else if Parent <> nil then
  6488.       with TMessage(Message) do
  6489.         Result := Parent.Perform(CM_MOUSEWHEEL, WParam, LParam);
  6490.   end;
  6491. end;
  6492.  
  6493. procedure TWinControl.WMMouseWheel(var Message: TWMMouseWheel);
  6494. begin
  6495.   if not Mouse.WheelPresent then
  6496.   begin
  6497.     Mouse.FWheelPresent := True;
  6498.     Mouse.SettingChanged(SPI_GETWHEELSCROLLLINES);
  6499.   end;
  6500.   TCMMouseWheel(Message).ShiftState := KeysToShiftState(Message.Keys);
  6501.   MouseWheelHandler(TMessage(Message));
  6502.   if Message.Result = 0 then inherited;
  6503. end;
  6504.  
  6505. procedure TWinControl.MouseWheelHandler(var Message: TMessage);
  6506. var
  6507.   Form: TCustomForm;
  6508. begin
  6509.   Form := GetParentForm(Self);
  6510.   if (Form <> nil) and (Form <> Self) then Form.MouseWheelHandler(TMessage(Message))
  6511.   else with TMessage(Message) do
  6512.     Result := Perform(CM_MOUSEWHEEL, WParam, LParam);
  6513. end;
  6514.  
  6515. function TWinControl.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  6516.   MousePos: TPoint): Boolean;
  6517. var
  6518.   IsNeg: Boolean;
  6519. begin
  6520.   Result := False;
  6521.   if Assigned(FOnMouseWheel) then
  6522.     FOnMouseWheel(Self, Shift, WheelDelta, MousePos, Result);
  6523.   if not Result then
  6524.   begin
  6525.     Inc(FWheelAccumulator, WheelDelta);
  6526.     while Abs(FWheelAccumulator) >= WHEEL_DELTA do
  6527.     begin
  6528.       IsNeg := FWheelAccumulator < 0;
  6529.       FWheelAccumulator := Abs(FWheelAccumulator) - WHEEL_DELTA;
  6530.       if IsNeg then
  6531.       begin
  6532.         if FWheelAccumulator <> 0 then FWheelAccumulator := -FWheelAccumulator;
  6533.         Result := DoMouseWheelDown(Shift, MousePos);
  6534.       end
  6535.       else
  6536.         Result := DoMouseWheelUp(Shift, MousePos);
  6537.     end;
  6538.   end;
  6539. end;
  6540.  
  6541. function TWinControl.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
  6542. begin
  6543.   Result := False;
  6544.   if Assigned(FOnMouseWheelDown) then
  6545.     FOnMouseWheelDown(Self, Shift, MousePos, Result);
  6546. end;
  6547.  
  6548. function TWinControl.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
  6549. begin
  6550.   Result := False;
  6551.   if Assigned(FOnMouseWheelUp) then
  6552.     FOnMouseWheelUp(Self, Shift, MousePos, Result);
  6553. end;
  6554.  
  6555. procedure TWinControl.WMSysCommand(var Message: TWMSysCommand);
  6556. var
  6557.   Form: TCustomForm;
  6558.  
  6559.   function TraverseControls(Container: TWinControl): Boolean;
  6560.   var
  6561.     I: Integer;
  6562.     Control: TControl;
  6563.   begin
  6564.     Result := False;
  6565.     if Container.Showing then
  6566.       for I := 0 to Container.ControlCount - 1 do
  6567.       begin
  6568.         Control := Container.Controls[I];
  6569.         if Control.Visible and Control.Enabled then
  6570.         begin
  6571.           if (csMenuEvents in Control.ControlStyle) and
  6572.             (Control.Perform(WM_SYSCOMMAND, TMessage(Message).WParam,
  6573.               TMessage(Message).LParam) <> 0) or (Control is TWinControl) and
  6574.             TraverseControls(TWinControl(Control)) then
  6575.           begin
  6576.             Result := True;
  6577.             Exit;
  6578.           end;
  6579.         end;
  6580.       end;
  6581.   end;
  6582.  
  6583. begin
  6584.   with Message do
  6585.   begin
  6586.     if (CmdType and $FFF0 = SC_KEYMENU) and (Key <> VK_SPACE) and
  6587.       (Key <> Word('-')) and not IsIconic(FHandle) and (GetCapture = 0) and
  6588.       (Application.MainForm <> Self) then
  6589.     begin
  6590.       Form := GetParentForm(Self);
  6591.       if (Form <> nil) and
  6592.         (Form.Perform(CM_APPSYSCOMMAND, 0, Longint(@Message)) <> 0) then
  6593.         Exit;
  6594.     end;
  6595.     { Broadcast WMSysCommand to all controls which have a csMenuEvents style. }
  6596.     if (CmdType and $FFF0 = SC_KEYMENU) and TraverseControls(Self) then
  6597.       Exit;
  6598.   end;
  6599.   inherited;
  6600. end;
  6601.  
  6602. procedure TWinControl.WMCharToItem(var Message: TWMCharToItem);
  6603. begin
  6604.   if not DoControlMsg(Message.ListBox, Message) then inherited;
  6605. end;
  6606.  
  6607. procedure TWinControl.WMParentNotify(var Message: TWMParentNotify);
  6608. begin
  6609.   with Message do
  6610.     if (Event <> WM_CREATE) and (Event <> WM_DESTROY) or
  6611.       not DoControlMsg(Message.ChildWnd, Message) then inherited;
  6612. end;
  6613.  
  6614. procedure TWinControl.WMVKeyToItem(var Message: TWMVKeyToItem);
  6615. begin
  6616.   if not DoControlMsg(Message.ListBox, Message) then inherited;
  6617. end;
  6618.  
  6619. procedure TWinControl.WMDestroy(var Message: TWMDestroy);
  6620. begin
  6621.   inherited;
  6622.   RemoveProp(FHandle, MakeIntAtom(ControlAtom));
  6623.   RemoveProp(FHandle, MakeIntAtom(WindowAtom));
  6624. end;
  6625.  
  6626. procedure TWinControl.WMNCDestroy(var Message: TWMNCDestroy);
  6627. begin
  6628.   inherited;
  6629.   FHandle := 0;
  6630.   FShowing := False;
  6631. end;
  6632.  
  6633. procedure TWinControl.WMNCHitTest(var Message: TWMNCHitTest);
  6634. begin
  6635.   with Message do
  6636.     if (csDesigning in ComponentState) and (FParent <> nil) then
  6637.       Result := HTCLIENT
  6638.     else
  6639.       inherited;
  6640. end;
  6641.  
  6642. function TWinControl.PaletteChanged(Foreground: Boolean): Boolean;
  6643. var
  6644.   I: Integer;
  6645. begin
  6646.   Result := inherited PaletteChanged(Foreground);
  6647.   if Visible then
  6648.     for I := ControlCount - 1 downto 0 do
  6649.     begin
  6650.       if Foreground and Result then Exit;
  6651.       Result := Controls[I].PaletteChanged(Foreground) or Result;
  6652.     end;
  6653. end;
  6654.  
  6655. procedure TWinControl.WMQueryNewPalette(var Message: TMessage);
  6656. begin
  6657.   Include(FControlState, csPalette);
  6658.   Message.Result := Longint(PaletteChanged(True));
  6659. end;
  6660.  
  6661. procedure TWinControl.WMPaletteChanged(var Message: TMessage);
  6662. begin
  6663.   Message.Result := Longint(PaletteChanged(False));
  6664. end;
  6665.  
  6666. procedure TWinControl.CMShowHintChanged(var Message: TMessage);
  6667. begin
  6668.   inherited;
  6669.   NotifyControls(CM_PARENTSHOWHINTCHANGED);
  6670. end;
  6671.  
  6672. procedure TWinControl.CMBiDiModeChanged(var Message: TMessage);
  6673. begin
  6674.   inherited;
  6675.   if (SysLocale.MiddleEast) and (Message.wParam = 0) then RecreateWnd;
  6676.   NotifyControls(CM_PARENTBIDIMODECHANGED);
  6677. end;
  6678.  
  6679. procedure TWinControl.CMEnter(var Message: TCMEnter);
  6680. begin
  6681.   if SysLocale.MiddleEast then
  6682.     if UseRightToLeftReading then
  6683.     begin
  6684.       if Application.BiDiKeyboard <> '' then
  6685.         LoadKeyboardLayout(PChar(Application.BiDiKeyboard), KLF_ACTIVATE);
  6686.     end
  6687.     else
  6688.       if Application.NonBiDiKeyboard <> '' then
  6689.         LoadKeyboardLayout(PChar(Application.NonBiDiKeyboard), KLF_ACTIVATE);
  6690.   DoEnter;
  6691. end;
  6692.  
  6693. procedure TWinControl.CMExit(var Message: TCMExit);
  6694. begin
  6695.   DoExit;
  6696. end;
  6697.  
  6698. procedure TWinControl.CMDesignHitTest(var Message: TCMDesignHitTest);
  6699. begin
  6700.   if not IsControlMouseMsg(Message) then inherited;
  6701. end;
  6702.  
  6703. procedure TWinControl.CMChanged(var Message: TMessage);
  6704. begin
  6705.   if FParent <> nil then FParent.WindowProc(Message);
  6706. end;
  6707.  
  6708. procedure TWinControl.CMChildKey(var Message: TMessage);
  6709. begin
  6710.   if FParent <> nil then FParent.WindowProc(Message);
  6711. end;
  6712.  
  6713. procedure TWinControl.CMDialogKey(var Message: TCMDialogKey);
  6714. begin
  6715.   Broadcast(Message);
  6716. end;
  6717.  
  6718. procedure TWinControl.CMDialogChar(var Message: TCMDialogChar);
  6719. begin
  6720.   Broadcast(Message);
  6721. end;
  6722.  
  6723. procedure TWinControl.CMFocusChanged(var Message: TCMFocusChanged);
  6724. begin
  6725.   Broadcast(Message);
  6726. end;
  6727.  
  6728. procedure TWinControl.CMVisibleChanged(var Message: TMessage);
  6729. begin
  6730.   if not FVisible and (Parent <> nil) then RemoveFocus(False);
  6731.   if not (csDesigning in ComponentState) or
  6732.     (csNoDesignVisible in ControlStyle) then UpdateControlState;
  6733. end;
  6734.  
  6735. procedure TWinControl.CMShowingChanged(var Message: TMessage);
  6736. const
  6737.   ShowFlags: array[Boolean] of Word = (
  6738.     SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_HIDEWINDOW,
  6739.     SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_SHOWWINDOW);
  6740. begin
  6741.   SetWindowPos(FHandle, 0, 0, 0, 0, 0, ShowFlags[FShowing]);
  6742. end;
  6743.  
  6744. procedure TWinControl.CMEnabledChanged(var Message: TMessage);
  6745. begin
  6746.   if not Enabled and (Parent <> nil) then RemoveFocus(False);
  6747.   if HandleAllocated and not (csDesigning in ComponentState) then
  6748.     EnableWindow(FHandle, Enabled);
  6749. end;
  6750.  
  6751. procedure TWinControl.CMColorChanged(var Message: TMessage);
  6752. begin
  6753.   inherited;
  6754.   FBrush.Color := FColor;
  6755.   NotifyControls(CM_PARENTCOLORCHANGED);
  6756. end;
  6757.  
  6758. procedure TWinControl.CMFontChanged(var Message: TMessage);
  6759. begin
  6760.   inherited;
  6761.   if HandleAllocated then Perform(WM_SETFONT, FFont.Handle, 0);
  6762.   NotifyControls(CM_PARENTFONTCHANGED);
  6763. end;
  6764.  
  6765. procedure TWinControl.CMCursorChanged(var Message: TMessage);
  6766. var
  6767.   P: TPoint;
  6768. begin
  6769.   if GetCapture = 0 then
  6770.   begin
  6771.     GetCursorPos(P);
  6772.     if FindDragTarget(P, False) = Self then
  6773.       Perform(WM_SETCURSOR, Handle, HTCLIENT);
  6774.   end;
  6775. end;
  6776.  
  6777. procedure TWinControl.CMBorderChanged(var Message: TMessage);
  6778. begin
  6779.   inherited;
  6780.   if HandleAllocated then SetWindowPos(Handle, 0, 0,0,0,0, SWP_NOACTIVATE or
  6781.     SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_FRAMECHANGED);
  6782. end;
  6783.  
  6784. procedure TWinControl.CMCtl3DChanged(var Message: TMessage);
  6785. begin
  6786.   if (csFramed in ControlStyle) and (Parent <> nil) and HandleAllocated and
  6787.     IsWindowVisible(FHandle) then InvalidateFrame;
  6788.   NotifyControls(CM_PARENTCTL3DCHANGED);
  6789. end;
  6790.  
  6791. procedure TWinControl.CMParentCtl3DChanged(var Message: TMessage);
  6792. begin
  6793.   if FParentCtl3D then
  6794.   begin
  6795.     if Message.wParam <> 0 then
  6796.       SetCtl3D(Message.lParam <> 0) else
  6797.       SetCtl3D(FParent.FCtl3D);
  6798.     FParentCtl3D := True;
  6799.   end;
  6800. end;
  6801.  
  6802. procedure TWinControl.CMSysColorChange(var Message: TMessage);
  6803. begin
  6804.   Broadcast(Message);
  6805. end;
  6806.  
  6807. procedure TWinControl.CMWinIniChange(var Message: TWMWinIniChange);
  6808. begin
  6809.   Broadcast(Message);
  6810. end;
  6811.  
  6812. procedure TWinControl.CMFontChange(var Message: TMessage);
  6813. begin
  6814.   Broadcast(Message);
  6815. end;
  6816.  
  6817. procedure TWinControl.CMTimeChange(var Message: TMessage);
  6818. begin
  6819.   Broadcast(Message);
  6820. end;
  6821.  
  6822. procedure TWinControl.CMDrag(var Message: TCMDrag);
  6823. begin
  6824.   with Message, DragRec^ do
  6825.     case DragMessage of
  6826.       dmDragEnter, dmDragLeave, dmDragMove, dmDragDrop:
  6827.         if Target <> nil then TControl(Target).DoDragMsg(Message);
  6828.       dmFindTarget:
  6829.         begin
  6830.           Result := Longint(ControlAtPos(ScreenToClient(Pos), False));
  6831.           if Result = 0 then Result := Longint(Self);
  6832.         end;
  6833.     end;
  6834. end;
  6835.  
  6836. procedure TWinControl.CMControlListChange(var Message: TMessage);
  6837. begin
  6838.   if FParent <> nil then FParent.WindowProc(Message);
  6839. end;
  6840.  
  6841. procedure TWinControl.CMSysFontChanged(var Message: TMessage);
  6842. begin
  6843.   inherited;
  6844.   Broadcast(Message);
  6845. end;
  6846.  
  6847. function TWinControl.IsMenuKey(var Message: TWMKey): Boolean;
  6848. var
  6849.   Control: TWinControl;
  6850.   Form: TCustomForm;
  6851.   LocalPopupMenu: TPopupMenu;
  6852. begin
  6853.   Result := True;
  6854.   if not (csDesigning in ComponentState) then
  6855.   begin
  6856.     Control := Self;
  6857.     while Control <> nil do
  6858.     begin
  6859.       LocalPopupMenu := Control.GetPopupMenu;
  6860.       if Assigned(LocalPopupMenu) and (LocalPopupMenu.WindowHandle <> 0) and
  6861.         LocalPopupMenu.IsShortCut(Message) then Exit;
  6862.       Control := Control.Parent;
  6863.     end;
  6864.     Form := GetParentForm(Self);
  6865.     if (Form <> nil) and Form.IsShortCut(Message) then Exit;
  6866.   end;
  6867.   with Message do
  6868.     if SendAppMessage(CM_APPKEYDOWN, CharCode, KeyData) <> 0 then Exit;
  6869.   Result := False;
  6870. end;
  6871.  
  6872. procedure TWinControl.CNKeyDown(var Message: TWMKeyDown);
  6873. var
  6874.   Mask: Integer;
  6875. begin
  6876.   with Message do
  6877.   begin
  6878.     Result := 1;
  6879.     if IsMenuKey(Message) then Exit;
  6880.     if not (csDesigning in ComponentState) then
  6881.     begin
  6882.       if Perform(CM_CHILDKEY, CharCode, Integer(Self)) <> 0 then Exit;
  6883.       Mask := 0;
  6884.       case CharCode of
  6885.         VK_TAB:
  6886.           Mask := DLGC_WANTTAB;
  6887.         VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN:
  6888.           Mask := DLGC_WANTARROWS;
  6889.         VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
  6890.           Mask := DLGC_WANTALLKEYS;
  6891.       end;
  6892.       if (Mask <> 0) and
  6893.         (Perform(CM_WANTSPECIALKEY, CharCode, 0) = 0) and
  6894.         (Perform(WM_GETDLGCODE, 0, 0) and Mask = 0) and
  6895.         (GetParentForm(Self).Perform(CM_DIALOGKEY,
  6896.         CharCode, KeyData) <> 0) then Exit;
  6897.     end;
  6898.     Result := 0;
  6899.   end;
  6900. end;
  6901.  
  6902. procedure TWinControl.CNKeyUp(var Message: TWMKeyUp);
  6903. begin
  6904.   if not (csDesigning in ComponentState) then
  6905.     with Message do
  6906.       case CharCode of
  6907.         VK_TAB, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN,
  6908.         VK_RETURN, VK_EXECUTE, VK_ESCAPE, VK_CANCEL:
  6909.           Result := Perform(CM_WANTSPECIALKEY, CharCode, 0);
  6910.       end;
  6911. end;
  6912.  
  6913. procedure TWinControl.CNChar(var Message: TWMChar);
  6914. begin
  6915.   if not (csDesigning in ComponentState) then
  6916.     with Message do
  6917.     begin
  6918.       Result := 1;
  6919.       if (Perform(WM_GETDLGCODE, 0, 0) and DLGC_WANTCHARS = 0) and
  6920.         (GetParentForm(Self).Perform(CM_DIALOGCHAR,
  6921.         CharCode, KeyData) <> 0) then Exit;
  6922.       Result := 0;
  6923.     end;
  6924. end;
  6925.  
  6926. procedure TWinControl.CNSysKeyDown(var Message: TWMKeyDown);
  6927. begin
  6928.   with Message do
  6929.   begin
  6930.     Result := 1;
  6931.     if IsMenuKey(Message) then Exit;
  6932.     if not (csDesigning in ComponentState) then
  6933.     begin
  6934.       if Perform(CM_CHILDKEY, CharCode, Integer(Self)) <> 0 then Exit;
  6935.       if GetParentForm(Self).Perform(CM_DIALOGKEY,
  6936.         CharCode, KeyData) <> 0 then Exit;
  6937.     end;
  6938.     Result := 0;
  6939.   end;
  6940. end;
  6941.  
  6942. procedure TWinControl.CNSysChar(var Message: TWMChar);
  6943. begin
  6944.   if not (csDesigning in ComponentState) then
  6945.     with Message do
  6946.       if CharCode <> VK_SPACE then
  6947.         Result := GetParentForm(Self).Perform(CM_DIALOGCHAR,
  6948.           CharCode, KeyData);
  6949. end;
  6950.  
  6951. procedure TWinControl.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  6952. var
  6953.   WindowPlacement: TWindowPlacement;
  6954. begin
  6955.   if (ALeft <> FLeft) or (ATop <> FTop) or
  6956.     (AWidth <> FWidth) or (AHeight <> FHeight) then
  6957.   begin
  6958.     if HandleAllocated and not IsIconic(FHandle) then
  6959.       SetWindowPos(FHandle, 0, ALeft, ATop, AWidth, AHeight,
  6960.         SWP_NOZORDER + SWP_NOACTIVATE)
  6961.     else
  6962.     begin
  6963.       FLeft := ALeft;
  6964.       FTop := ATop;
  6965.       FWidth := AWidth;
  6966.       FHeight := AHeight;
  6967.       if HandleAllocated then
  6968.       begin
  6969.         WindowPlacement.Length := SizeOf(WindowPlacement);
  6970.         GetWindowPlacement(FHandle, @WindowPlacement);
  6971.         WindowPlacement.rcNormalPosition := BoundsRect;
  6972.         SetWindowPlacement(FHandle, @WindowPlacement);
  6973.       end;
  6974.     end;
  6975.     UpdateAnchorRules;
  6976.     RequestAlign;
  6977.   end;
  6978. end;
  6979.  
  6980. procedure TWinControl.ScaleControls(M, D: Integer);
  6981. var
  6982.   I: Integer;
  6983. begin
  6984.   for I := 0 to ControlCount - 1 do Controls[I].ChangeScale(M, D);
  6985. end;
  6986.  
  6987. procedure TWinControl.ChangeScale(M, D: Integer);
  6988. begin
  6989.   DisableAlign;
  6990.   try
  6991.     ScaleControls(M, D);
  6992.     inherited ChangeScale(M, D);
  6993.   finally
  6994.     EnableAlign;
  6995.   end;
  6996. end;
  6997.  
  6998. procedure TWinControl.ScaleBy(M, D: Integer);
  6999. const
  7000.   SWP_HIDE = SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_HIDEWINDOW;
  7001.   SWP_SHOW = SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_SHOWWINDOW;
  7002. var
  7003.   IsVisible: Boolean;
  7004.   R: TRect;
  7005. begin
  7006.   IsVisible := HandleAllocated and IsWindowVisible(Handle);
  7007.   if IsVisible then SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_HIDE);
  7008.   R := BoundsRect;
  7009.   ChangeScale(M, D);
  7010.   SetBounds(R.Left, R.Top, Width, Height);
  7011.   if IsVisible then SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_SHOW);
  7012. end;
  7013.  
  7014. procedure TWinControl.ScrollBy(DeltaX, DeltaY: Integer);
  7015. var
  7016.   IsVisible: Boolean;
  7017.   I: Integer;
  7018.   Control: TControl;
  7019. begin
  7020.   IsVisible := (FHandle <> 0) and IsWindowVisible(FHandle);
  7021.   if IsVisible then ScrollWindow(FHandle, DeltaX, DeltaY, nil, nil);
  7022.   for I := 0 to ControlCount - 1 do
  7023.   begin
  7024.     Control := Controls[I];
  7025.     if not (Control is TWinControl) or (TWinControl(Control).FHandle = 0) then
  7026.     begin
  7027.       Inc(Control.FLeft, DeltaX);
  7028.       Inc(Control.FTop, DeltaY);
  7029.     end else
  7030.       if not IsVisible then
  7031.         with TWinControl(Control) do
  7032.           SetWindowPos(FHandle, 0, FLeft + DeltaX, FTop + DeltaY,
  7033.             FWidth, FHeight, SWP_NOZORDER + SWP_NOACTIVATE);
  7034.   end;
  7035.   Realign;
  7036. end;
  7037.  
  7038. procedure TWinControl.ShowControl(AControl: TControl);
  7039. begin
  7040.   if Parent <> nil then Parent.ShowControl(Self);
  7041. end;
  7042.  
  7043. procedure TWinControl.SetZOrderPosition(Position: Integer);
  7044. var
  7045.   I, Count: Integer;
  7046.   Pos: HWND;
  7047. begin
  7048.   if FParent <> nil then
  7049.   begin
  7050.     if FParent.FControls <> nil then
  7051.       Dec(Position, FParent.FControls.Count);
  7052.     I := FParent.FWinControls.IndexOf(Self);
  7053.     if I >= 0 then
  7054.     begin
  7055.       Count := FParent.FWinControls.Count;
  7056.       if Position < 0 then Position := 0;
  7057.       if Position >= Count then Position := Count - 1;
  7058.       if Position <> I then
  7059.       begin
  7060.         FParent.FWinControls.Delete(I);
  7061.         FParent.FWinControls.Insert(Position, Self);
  7062.       end;
  7063.     end;
  7064.     if FHandle <> 0 then
  7065.     begin
  7066.       if Position = 0 then Pos := HWND_BOTTOM
  7067.       else if Position = FParent.FWinControls.Count - 1 then Pos := HWND_TOP
  7068.       else if Position > I then
  7069.         Pos := TWinControl(FParent.FWinControls[Position + 1]).Handle
  7070.       else if Position < I then
  7071.         Pos := TWinControl(FParent.FWinControls[Position]).Handle
  7072.       else Exit;
  7073.       SetWindowPos(FHandle, Pos, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE);
  7074.     end;
  7075.   end;
  7076. end;
  7077.  
  7078. procedure TWinControl.SetZOrder(TopMost: Boolean);
  7079. const
  7080.   WindowPos: array[Boolean] of Word = (HWND_BOTTOM, HWND_TOP);
  7081. var
  7082.   N, M: Integer;
  7083. begin
  7084.   if FParent <> nil then
  7085.   begin
  7086.     if TopMost then N := FParent.FWinControls.Count - 1 else N := 0;
  7087.     M := 0;
  7088.     if FParent.FControls <> nil then M := FParent.FControls.Count;
  7089.     SetZOrderPosition(M + N);
  7090.   end
  7091.   else if FHandle <> 0 then
  7092.     SetWindowPos(FHandle, WindowPos[TopMost], 0, 0, 0, 0,
  7093.       SWP_NOMOVE + SWP_NOSIZE);
  7094. end;
  7095.  
  7096. function TWinControl.GetDeviceContext(var WindowHandle: HWnd): HDC;
  7097. begin
  7098.   if csDesigning in ComponentState then
  7099.     Result := GetDCEx(Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS)
  7100.   else
  7101.     Result := GetDC(Handle);
  7102.   if Result = 0 then raise EOutOfResources.CreateRes(@SWindowDCError);
  7103.   WindowHandle := FHandle;
  7104. end;
  7105.  
  7106. function TWinControl.GetParentHandle: HWnd;
  7107. begin
  7108.   if Parent <> nil then
  7109.     Result := Parent.Handle
  7110.   else
  7111.     Result := ParentWindow;
  7112. end;
  7113.  
  7114. function TWinControl.GetTopParentHandle: HWnd;
  7115. var
  7116.   C: TWinControl;
  7117. begin
  7118.   C := Self;
  7119.   while C.Parent <> nil do
  7120.     C := C.Parent;
  7121.   Result := C.ParentWindow;
  7122.   if Result = 0 then Result := C.Handle;
  7123. end;
  7124.  
  7125. procedure TWinControl.Invalidate;
  7126. begin
  7127.   Perform(CM_INVALIDATE, 0, 0);
  7128. end;
  7129.  
  7130. procedure TWinControl.CMInvalidate(var Message: TMessage);
  7131. begin
  7132.   if HandleAllocated then
  7133.   begin
  7134.     if Parent <> nil then Parent.Perform(CM_INVALIDATE, 1, 0);
  7135.     if Message.WParam = 0 then
  7136.       InvalidateRect(FHandle, nil, not (csOpaque in ControlStyle));
  7137.   end;
  7138. end;
  7139.  
  7140. procedure TWinControl.Update;
  7141. begin
  7142.   if HandleAllocated then UpdateWindow(FHandle);
  7143. end;
  7144.  
  7145. procedure TWinControl.Repaint;
  7146. begin
  7147.   Invalidate;
  7148.   Update;
  7149. end;
  7150.  
  7151. procedure TWinControl.InvalidateFrame;
  7152. var
  7153.   R: TRect;
  7154. begin
  7155.   R := BoundsRect;
  7156.   InflateRect(R, 1, 1);
  7157.   InvalidateRect(Parent.FHandle, @R, True);
  7158. end;
  7159.  
  7160. function TWinControl.CanFocus: Boolean;
  7161. var
  7162.   Control: TWinControl;
  7163.   Form: TCustomForm;
  7164. begin
  7165.   Result := False;
  7166.   Form := GetParentForm(Self);
  7167.   if Form <> nil then
  7168.   begin
  7169.     Control := Self;
  7170.     while Control <> Form do
  7171.     begin
  7172.       if not (Control.FVisible and Control.Enabled) then Exit;
  7173.       Control := Control.Parent;
  7174.     end;
  7175.     Result := True;
  7176.   end;
  7177. end;
  7178.  
  7179. procedure TWinControl.SetFocus;
  7180. var
  7181.   Parent: TCustomForm;
  7182. begin
  7183.   Parent := GetParentForm(Self);
  7184.   if Parent <> nil then
  7185.     Parent.FocusControl(Self)
  7186.   else if ParentWindow <> 0 then
  7187.     Windows.SetFocus(Handle)
  7188.   else
  7189.     ValidParentForm(Self);
  7190. end;
  7191.  
  7192. function TWinControl.Focused: Boolean;
  7193. begin
  7194.   Result := (FHandle <> 0) and (GetFocus = FHandle);
  7195. end;
  7196.  
  7197. procedure TWinControl.HandleNeeded;
  7198. begin
  7199.   if FHandle = 0 then
  7200.   begin
  7201.     if Parent <> nil then Parent.HandleNeeded;
  7202.     CreateHandle;
  7203.   end;
  7204. end;
  7205.  
  7206. function TWinControl.GetHandle: HWnd;
  7207. begin
  7208.   HandleNeeded;
  7209.   Result := FHandle;
  7210. end;
  7211.  
  7212. function TWinControl.GetControlExtents: TRect;
  7213. var
  7214.   I: Integer;
  7215. begin
  7216.   Result := Rect(MaxInt, MaxInt, 0, 0);
  7217.   for I := 0 to ControlCount - 1 do
  7218.     with Controls[I] do
  7219.       if Visible or (csDesigning in ComponentState) and
  7220.         not (csNoDesignVisible in ControlStyle) then
  7221.       begin
  7222.         if Left < Result.Left then Result.Left := Left;
  7223.         if Top < Result.Top then Result.Top := Top;
  7224.         if Left + Width > Result.Right then Result.Right := Left + Width;
  7225.         if Top + Height > Result.Bottom then Result.Bottom := Top + Height;
  7226.       end;
  7227. end;
  7228.  
  7229. function TWinControl.GetClientOrigin: TPoint;
  7230. begin
  7231.   Result.X := 0;
  7232.   Result.Y := 0;
  7233.   Windows.ClientToScreen(Handle, Result);
  7234. end;
  7235.  
  7236. function TWinControl.GetClientRect: TRect;
  7237. begin
  7238.   Windows.GetClientRect(Handle, Result);
  7239. end;
  7240.  
  7241. procedure TWinControl.AdjustSize;
  7242. begin
  7243.   if not (csLoading in ComponentState) and HandleAllocated then
  7244.   begin
  7245.     SetWindowPos(Handle, 0, 0, 0, Width, Height, SWP_NOACTIVATE or SWP_NOMOVE or
  7246.       SWP_NOZORDER);
  7247.     RequestAlign;
  7248.   end;
  7249. end;
  7250.  
  7251. procedure TWinControl.SetBorderWidth(Value: TBorderWidth);
  7252. begin
  7253.   if FBorderWidth <> Value then
  7254.   begin
  7255.     FBorderWidth := Value;
  7256.     Perform(CM_BORDERCHANGED, 0, 0);
  7257.   end;
  7258. end;
  7259.  
  7260. procedure TWinControl.SetCtl3D(Value: Boolean);
  7261. begin
  7262.   if FCtl3D <> Value then
  7263.   begin
  7264.     FCtl3D := Value;
  7265.     FParentCtl3D := False;
  7266.     Perform(CM_CTL3DCHANGED, 0, 0);
  7267.   end;
  7268. end;
  7269.  
  7270. function TWinControl.IsCtl3DStored: Boolean;
  7271. begin
  7272.   Result := not ParentCtl3D;
  7273. end;
  7274.  
  7275. procedure TWinControl.SetParentCtl3D(Value: Boolean);
  7276. begin
  7277.   if FParentCtl3D <> Value then
  7278.   begin
  7279.     FParentCtl3D := Value;
  7280.     if FParent <> nil then Perform(CM_PARENTCTL3DCHANGED, 0, 0);
  7281.   end;
  7282. end;
  7283.  
  7284. function TWinControl.GetTabOrder: TTabOrder;
  7285. begin
  7286.   if FParent <> nil then
  7287.     Result := FParent.FTabList.IndexOf(Self)
  7288.   else
  7289.     Result := -1;
  7290. end;
  7291.  
  7292. procedure TWinControl.UpdateTabOrder(Value: TTabOrder);
  7293. var
  7294.   CurIndex, Count: Integer;
  7295. begin
  7296.   CurIndex := GetTabOrder;
  7297.   if CurIndex >= 0 then
  7298.   begin
  7299.     Count := FParent.FTabList.Count;
  7300.     if Value < 0 then Value := 0;
  7301.     if Value >= Count then Value := Count - 1;
  7302.     if Value <> CurIndex then
  7303.     begin
  7304.       FParent.FTabList.Delete(CurIndex);
  7305.       FParent.FTabList.Insert(Value, Self);
  7306.     end;
  7307.   end;
  7308. end;
  7309.  
  7310. procedure TWinControl.SetTabOrder(Value: TTabOrder);
  7311. begin
  7312.   if csReadingState in ControlState then
  7313.     FTabOrder := Value else
  7314.     UpdateTabOrder(Value);
  7315. end;
  7316.  
  7317. procedure TWinControl.SetTabStop(Value: Boolean);
  7318. var
  7319.   Style: Longint;
  7320. begin
  7321.   if FTabStop <> Value then
  7322.   begin
  7323.     FTabStop := Value;
  7324.     if HandleAllocated then
  7325.     begin
  7326.       Style := GetWindowLong(FHandle, GWL_STYLE) and not WS_TABSTOP;
  7327.       if Value then Style := Style or WS_TABSTOP;
  7328.       SetWindowLong(FHandle, GWL_STYLE, Style);
  7329.     end;
  7330.     Perform(CM_TABSTOPCHANGED, 0, 0);
  7331.   end;
  7332. end;
  7333.  
  7334. procedure TWinControl.SetUseDockManager(Value: Boolean);
  7335. begin
  7336.   if FUseDockManager <> Value then
  7337.   begin
  7338.     FUseDockManager := Value;
  7339.     if not (csDesigning in ComponentState) and Value then
  7340.       FDockManager := CreateDockManager;
  7341.   end;
  7342. end;
  7343.  
  7344. function TWinControl.HandleAllocated: Boolean;
  7345. begin
  7346.   Result := FHandle <> 0;
  7347. end;
  7348.  
  7349. procedure TWinControl.UpdateBounds;
  7350. var
  7351.   ParentHandle: HWnd;
  7352.   Rect: TRect;
  7353.   WindowPlacement: TWindowPlacement;
  7354. begin
  7355.   if IsIconic(FHandle) then
  7356.   begin
  7357.     WindowPlacement.Length := SizeOf(WindowPlacement);
  7358.     GetWindowPlacement(FHandle, @WindowPlacement);
  7359.     Rect := WindowPlacement.rcNormalPosition;
  7360.   end else
  7361.     GetWindowRect(FHandle, Rect);
  7362.   if GetWindowLong(FHandle, GWL_STYLE) and WS_CHILD <> 0 then
  7363.   begin
  7364.     ParentHandle := GetWindowLong(FHandle, GWL_HWNDPARENT);
  7365.     if ParentHandle <> 0 then
  7366.     begin
  7367.       Windows.ScreenToClient(ParentHandle, Rect.TopLeft);
  7368.       Windows.ScreenToClient(ParentHandle, Rect.BottomRight);
  7369.     end;
  7370.   end;
  7371.   FLeft := Rect.Left;
  7372.   FTop := Rect.Top;
  7373.   FWidth := Rect.Right - Rect.Left;
  7374.   FHeight := Rect.Bottom - Rect.Top;
  7375.   UpdateAnchorRules;
  7376. end;
  7377.  
  7378. procedure TWinControl.GetTabOrderList(List: TList);
  7379. var
  7380.   I: Integer;
  7381.   Control: TWinControl;
  7382. begin
  7383.   if FTabList <> nil then
  7384.     for I := 0 to FTabList.Count - 1 do
  7385.     begin
  7386.       Control := FTabList[I];
  7387.       List.Add(Control);
  7388.       Control.GetTabOrderList(List);
  7389.     end;
  7390. end;
  7391.  
  7392. function TWinControl.FindNextControl(CurControl: TWinControl;
  7393.   GoForward, CheckTabStop, CheckParent: Boolean): TWinControl;
  7394. var
  7395.   I, StartIndex: Integer;
  7396.   List: TList;
  7397. begin
  7398.   Result := nil;
  7399.   List := TList.Create;
  7400.   try
  7401.     GetTabOrderList(List);
  7402.     if List.Count > 0 then
  7403.     begin
  7404.       StartIndex := List.IndexOf(CurControl);
  7405.       if StartIndex = -1 then
  7406.         if GoForward then StartIndex := List.Count - 1 else StartIndex := 0;
  7407.       I := StartIndex;
  7408.       repeat
  7409.         if GoForward then
  7410.         begin
  7411.           Inc(I);
  7412.           if I = List.Count then I := 0;
  7413.         end else
  7414.         begin
  7415.           if I = 0 then I := List.Count;
  7416.           Dec(I);
  7417.         end;
  7418.         CurControl := List[I];
  7419.         if CurControl.CanFocus and
  7420.           (not CheckTabStop or CurControl.TabStop) and
  7421.           (not CheckParent or (CurControl.Parent = Self)) then
  7422.           Result := CurControl;
  7423.       until (Result <> nil) or (I = StartIndex);
  7424.     end;
  7425.   finally
  7426.     List.Free;
  7427.   end;
  7428. end;
  7429.  
  7430. procedure TWinControl.SelectNext(CurControl: TWinControl;
  7431.   GoForward, CheckTabStop: Boolean);
  7432. begin
  7433.   CurControl := FindNextControl(CurControl, GoForward,
  7434.     CheckTabStop, not CheckTabStop);
  7435.   if CurControl <> nil then CurControl.SetFocus;
  7436. end;
  7437.  
  7438. procedure TWinControl.SelectFirst;
  7439. var
  7440.   Form: TCustomForm;
  7441.   Control: TWinControl;
  7442. begin
  7443.   Form := GetParentForm(Self);
  7444.   if Form <> nil then
  7445.   begin
  7446.     Control := FindNextControl(nil, True, True, False);
  7447.     if Control = nil then
  7448.       Control := FindNextControl(nil, True, False, False);
  7449.     if Control <> nil then Form.ActiveControl := Control;
  7450.   end;
  7451. end;
  7452.  
  7453. procedure TWinControl.GetChildren(Proc: TGetChildProc; Root: TComponent);
  7454. var
  7455.   I: Integer;
  7456.   Control: TControl;
  7457. begin
  7458.   for I := 0 to ControlCount - 1 do
  7459.   begin
  7460.     Control := Controls[I];
  7461.     if Control.Owner = Root then Proc(Control);
  7462.   end;
  7463. end;
  7464.  
  7465. procedure TWinControl.SetChildOrder(Child: TComponent; Order: Integer);
  7466. begin
  7467.   if Child is TWinControl then
  7468.     TWinControl(Child).SetZOrderPosition(Order)
  7469.   else if Child is TControl then
  7470.     TControl(Child).SetZOrderPosition(Order);
  7471. end;
  7472.  
  7473.  
  7474. function TWinControl.CanResize(var NewWidth, NewHeight: Integer): Boolean;
  7475. begin
  7476.   Result := inherited CanResize(NewWidth, NewHeight);
  7477. end;
  7478.  
  7479. procedure TWinControl.CalcConstraints(var MinWidth, MinHeight, MaxWidth,
  7480.   MaxHeight: Integer);
  7481. type
  7482.   TScale = (sNone, sReg, sStretch, sOther);
  7483. var
  7484.   AdjustMinWidth, AdjustMinHeight, AdjustMaxWidth, AdjustMaxHeight: Integer;
  7485.   I, TotalMinWidth, TotalMaxWidth, TotalMinHeight, TotalMaxHeight: Integer;
  7486.   TotalMinWidth2, TotalMaxWidth2, TotalMinHeight2, TotalMaxHeight2: Integer;
  7487.   ControlMinWidth, ControlMaxWidth, ControlMinHeight, ControlMaxHeight: Integer;
  7488.   Control: TControl;
  7489.   R: TRect;
  7490.  
  7491.   WidthScale: TScale;
  7492.   HeightScale: TScale;
  7493.  
  7494.   procedure DoCalcConstraints(Control: TControl; var MinWidth, MinHeight,
  7495.     MaxWidth, MaxHeight: Integer);
  7496.   begin
  7497.     with Control do
  7498.     begin
  7499.       if Constraints.MinWidth > 0 then
  7500.         MinWidth := Constraints.MinWidth
  7501.       else
  7502.         MinWidth := 0;
  7503.       if Constraints.MinHeight > 0 then
  7504.         MinHeight := Constraints.MinHeight
  7505.       else
  7506.         MinHeight := 0;
  7507.       if Constraints.MaxWidth > 0 then
  7508.         MaxWidth := Constraints.MaxWidth
  7509.       else
  7510.         MaxWidth := 0;
  7511.       if Constraints.MaxHeight > 0 then
  7512.         MaxHeight := Constraints.MaxHeight
  7513.       else
  7514.         MaxHeight := 0;
  7515.       { Allow override of constraints }
  7516.       ConstrainedResize(MinWidth, MinHeight, MaxWidth, MaxHeight);
  7517.     end;
  7518.   end;
  7519.  
  7520. begin
  7521.   if not HandleAllocated or (ControlCount = 0) then Exit;
  7522.   { Adjust min/max size to compensate for non-client area }
  7523.   R := GetClientRect;
  7524.   AdjustClientRect(R);
  7525.   if IsRectEmpty(R) then Exit; // Coming from an icon view, don't do constraints
  7526.   AdjustMinWidth := Width - (R.Right - R.Left);
  7527.   AdjustMinHeight := Height - (R.Bottom - R.Top);
  7528.   AdjustMaxWidth := Width - (R.Right - R.Left);
  7529.   AdjustMaxHeight := Height - (R.Bottom - R.Top);
  7530.   if MinWidth > 0 then Dec(MinWidth, AdjustMinWidth);
  7531.   if MinHeight > 0 then Dec(MinHeight, AdjustMinHeight);
  7532.   if MaxWidth > 0 then Dec(MaxWidth, AdjustMaxWidth);
  7533.   if MaxHeight > 0 then Dec(MaxHeight, AdjustMaxHeight);
  7534.   { Compare incoming min/max constraints with those that we calculate }
  7535.   try
  7536.     TotalMinWidth := 0;
  7537.     TotalMinWidth2 := 0;
  7538.     TotalMaxWidth := 0;
  7539.     TotalMaxWidth2 := 0;
  7540.     TotalMinHeight := 0;
  7541.     TotalMinHeight2 := 0;
  7542.     TotalMaxHeight := 0;
  7543.     TotalMaxHeight2 := 0;
  7544.     for I := 0 to ControlCount - 1 do
  7545.     begin
  7546.       Control := Controls[I];
  7547.       with Control do
  7548.         if Visible or (csDesigning in ComponentState) and
  7549.           not (csNoDesignVisible in ControlStyle) then
  7550.         begin
  7551.           DoCalcConstraints(Control, ControlMinWidth, ControlMinHeight,
  7552.             ControlMaxWidth, ControlMaxHeight);
  7553.  
  7554.           case Align of
  7555.             alTop, alBottom: WidthScale := sReg;
  7556.             alClient: WidthScale := sStretch;
  7557.             alNone:
  7558.               if Anchors * [akLeft, akRight] = [akLeft, akRight] then
  7559.               begin
  7560.                 WidthScale := sReg;
  7561.                 { Adjust Anchored controls }
  7562.                 if ControlMinWidth > 0 then
  7563.                   ControlMinWidth := (R.Right - R.Left) - Width - ControlMinWidth;
  7564.                 if ControlMaxWidth > 0 then
  7565.                   ControlMaxWidth := (R.Right - R.Left) + ControlMaxWidth - Width;
  7566.               end
  7567.               else
  7568.                 WidthScale := sNone;
  7569.           else
  7570.             WidthScale := sOther;
  7571.           end;
  7572.  
  7573.           case Align of
  7574.             alLeft, alRight: HeightScale := sReg;
  7575.             alClient: HeightScale := sStretch;
  7576.             alNone:
  7577.               if Anchors * [akTop, akBottom] = [akTop, akBottom] then
  7578.               begin
  7579.                 HeightScale := sReg;
  7580.                 { Adjust Anchored controls }
  7581.                 if ControlMinHeight > 0 then
  7582.                   ControlMinHeight := (R.Bottom - R.Top) - Height - ControlMinHeight;
  7583.                 if ControlMaxHeight > 0 then
  7584.                   ControlMaxHeight := (R.Bottom - R.Top) + ControlMaxHeight - Height;
  7585.               end
  7586.               else
  7587.                 HeightScale := sNone;
  7588.           else
  7589.             HeightScale := sOther;
  7590.           end;
  7591.  
  7592.           { Calculate min/max width }
  7593.           case WidthScale of
  7594.             sReg, sStretch:
  7595.               begin
  7596.                 if (ControlMinWidth > 0) and (ControlMinWidth > MinWidth) then
  7597.                 begin
  7598.                   MinWidth := ControlMinWidth;
  7599.                   if MinWidth > TotalMinWidth then
  7600.                     TotalMinWidth := MinWidth;
  7601.                 end;
  7602.                 if (ControlMaxWidth > 0) and (ControlMaxWidth < MaxWidth) then
  7603.                 begin
  7604.                   MaxWidth := ControlMaxWidth;
  7605.                   if MaxWidth > TotalMaxWidth then
  7606.                     TotalMaxWidth := MaxWidth;
  7607.                 end;
  7608.               end;
  7609.             sOther:
  7610.               begin
  7611.                 Inc(TotalMinWidth2, Width);
  7612.                 Inc(TotalMaxWidth2, Width);
  7613.               end;
  7614.           end;
  7615.  
  7616.           { Calculate min/max height }
  7617.           case HeightScale of
  7618.             sReg, sStretch:
  7619.               begin
  7620.                 if (ControlMinHeight > 0) and (ControlMinHeight > MinHeight) then
  7621.                 begin
  7622.                   MinHeight := ControlMinHeight;
  7623.                   if MinHeight > TotalMinHeight then
  7624.                     TotalMinHeight := MinHeight;
  7625.                 end;
  7626.                 if (ControlMaxHeight > 0) and (ControlMaxHeight < MaxHeight) then
  7627.                 begin
  7628.                   MaxHeight := ControlMaxHeight;
  7629.                   if MaxHeight > TotalMaxHeight then
  7630.                     TotalMaxHeight := MaxHeight;
  7631.                 end;
  7632.               end;
  7633.             sOther:
  7634.               begin
  7635.                 Inc(TotalMinHeight2, Height);
  7636.                 Inc(TotalMaxHeight2, Height);
  7637.               end;
  7638.           end;
  7639.         end;
  7640.     end;
  7641.     if (TotalMinWidth > 0) and (TotalMinWidth+TotalMinWidth2 > MinWidth) then
  7642.       MinWidth := TotalMinWidth+TotalMinWidth2;
  7643.     if (TotalMaxWidth > 0) and ((MaxWidth = 0) or (TotalMaxWidth+TotalMaxWidth2 > MaxWidth)) then
  7644.       MaxWidth := TotalMaxWidth+TotalMaxWidth2;
  7645.     if (TotalMinHeight > 0) and (TotalMinHeight+TotalMinHeight2 > MinHeight) then
  7646.       MinHeight := TotalMinHeight+TotalMinHeight2;
  7647.     if (TotalMaxHeight > 0) and ((MaxHeight = 0) or (TotalMaxHeight+TotalMaxHeight2 > MaxHeight)) then
  7648.       MaxHeight := TotalMaxHeight+TotalMaxHeight2;
  7649.   finally
  7650.     if MinWidth > 0 then Inc(MinWidth, AdjustMinWidth);
  7651.     if MinHeight > 0 then Inc(MinHeight, AdjustMinHeight);
  7652.     if MaxWidth > 0 then Inc(MaxWidth, AdjustMaxWidth);
  7653.     if MaxHeight > 0 then Inc(MaxHeight, AdjustMaxHeight);
  7654.   end;
  7655. end;
  7656.  
  7657. procedure TWinControl.ConstrainedResize(var MinWidth, MinHeight, MaxWidth,
  7658.   MaxHeight: Integer);
  7659. begin
  7660.   CalcConstraints(MinWidth, MinHeight, MaxWidth, MaxHeight);
  7661.   inherited ConstrainedResize(MinWidth, MinHeight, MaxWidth, MaxHeight);
  7662. end;
  7663.  
  7664. procedure TWinControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
  7665. begin
  7666.   inherited ActionChange(Sender, CheckDefaults);
  7667.   if Sender is TCustomAction then
  7668.     with TCustomAction(Sender) do
  7669.     if not CheckDefaults or (Self.HelpContext = 0) then
  7670.       Self.HelpContext := HelpContext;
  7671. end;
  7672.  
  7673. function TWinControl.GetActionLinkClass: TControlActionLinkClass;
  7674. begin
  7675.   Result := TWinControlActionLink;
  7676. end;
  7677.  
  7678. function TWinControl.IsHelpContextStored: Boolean;
  7679. begin
  7680.   Result := (ActionLink = nil) or not ActionLink.IsHelpContextLinked;
  7681. end;
  7682.  
  7683. procedure TWinControl.AssignTo(Dest: TPersistent);
  7684. begin
  7685.   inherited AssignTo(Dest);
  7686.   if Dest is TCustomAction then TCustomAction(Dest).HelpContext := HelpContext;
  7687. end;
  7688.  
  7689. function TWinControl.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
  7690. var
  7691.   I, LeftOffset, TopOffset: Integer;
  7692.   Extents, R: TRect;
  7693. begin
  7694.   Result := True;
  7695.   { Restrict size to visible extents of children }
  7696.   if HandleAllocated and (Align <> alClient) and
  7697.     (not (csDesigning in ComponentState) or (ControlCount > 0)) then
  7698.   begin
  7699.     Extents := GetControlExtents;
  7700.     { Here's where HandleAllocated is needed }
  7701.     R := GetClientRect;
  7702.     AdjustClientRect(R);
  7703.     DisableAlign;
  7704.     try
  7705.       for I := 0 to ControlCount - 1 do
  7706.         with Controls[I] do
  7707.           if Visible or (csDesigning in ComponentState) and
  7708.             not (csNoDesignVisible in ControlStyle) then
  7709.           begin
  7710.             if Self.Align in [alNone, alLeft, alRight] then
  7711.               LeftOffset := Extents.Left - R.Left else
  7712.               LeftOffset := 0;
  7713.             if Self.Align in [alNone, alTop, alBottom] then
  7714.               TopOffset := Extents.Top - R.Top else
  7715.               TopOffset := 0;
  7716.             SetBounds(Left - LeftOffset, Top - TopOffset, Width, Height);
  7717.           end;
  7718.     finally
  7719.       Exclude(FControlState, csAlignmentNeeded);
  7720.       EnableAlign;
  7721.     end;
  7722.     if Align in [alNone, alLeft, alRight] then
  7723.       if Extents.Right - Extents.Left > 0 then
  7724.       begin
  7725.         NewWidth := Extents.Right - Extents.Left + Width - (R.Right - R.Left);
  7726.         if Align = alRight then RequestAlign;
  7727.       end
  7728.       else
  7729.         NewWidth := 0;
  7730.     if Align in [alNone, alTop, alBottom] then
  7731.       if Extents.Bottom - Extents.Top > 0 then
  7732.       begin
  7733.         NewHeight := Extents.Bottom - Extents.Top + Height - (R.Bottom - R.Top);
  7734.         if Align = alBottom then RequestAlign;
  7735.       end
  7736.       else
  7737.         NewHeight := 0;
  7738.   end;
  7739. end;
  7740.  
  7741. procedure TWinControl.SetBevelCut(Index: Integer; const Value: TBevelCut);
  7742. begin
  7743.   case Index of
  7744.     0: { BevelInner }
  7745.       if Value <> FBevelInner then
  7746.       begin
  7747.         FBevelInner := Value;
  7748.         Perform(CM_BORDERCHANGED, 0, 0);
  7749.       end;
  7750.     1: { BevelOuter }
  7751.       if Value <> FBevelOuter then
  7752.       begin
  7753.         FBevelOuter := Value;
  7754.         Perform(CM_BORDERCHANGED, 0, 0);
  7755.       end;
  7756.   end;
  7757. end;
  7758.  
  7759. procedure TWinControl.SetBevelEdges(const Value: TBevelEdges);
  7760. begin
  7761.   if Value <> FBevelEdges then
  7762.   begin
  7763.     FBevelEdges := Value;
  7764.     Perform(CM_BORDERCHANGED, 0, 0);
  7765.   end;
  7766. end;
  7767.  
  7768. procedure TWinControl.SetBevelKind(const Value: TBevelKind);
  7769. begin
  7770.   if Value <> FBevelKind then
  7771.   begin
  7772.     FBevelKind := Value;
  7773.     Perform(CM_BORDERCHANGED, 0, 0);
  7774.   end;
  7775. end;
  7776.  
  7777. procedure TWinControl.SetBevelWidth(const Value: TBevelWidth);
  7778. begin
  7779.   if Value <> FBevelWidth then
  7780.   begin
  7781.     FBevelWidth := Value;
  7782.     Perform(CM_BORDERCHANGED, 0, 0);
  7783.   end;
  7784. end;
  7785.  
  7786. procedure TWinControl.WMNCCalcSize(var Message: TWMNCCalcSize);
  7787. var
  7788.   EdgeSize: Integer;
  7789. begin
  7790.   inherited;
  7791.   with Message.CalcSize_Params^ do
  7792.   begin
  7793.     InflateRect(rgrc[0], -BorderWidth, -BorderWidth);
  7794.     if BevelKind <> bkNone then
  7795.     begin
  7796.       EdgeSize := 0;
  7797.       if BevelInner <> bvNone then Inc(EdgeSize, BevelWidth);
  7798.       if BevelOuter <> bvNone then Inc(EdgeSize, BevelWidth);
  7799.       with rgrc[0] do
  7800.       begin
  7801.         if beLeft in BevelEdges then Inc(Left, EdgeSize);
  7802.         if beTop in BevelEdges then Inc(Top, EdgeSize);
  7803.         if beRight in BevelEdges then Dec(Right, EdgeSize);
  7804.         if beBottom in BevelEdges then Dec(Bottom, EdgeSize);
  7805.       end;
  7806.     end;
  7807.   end;
  7808. end;
  7809.  
  7810. procedure TWinControl.WMNCPaint(var Message: TMessage);
  7811. const
  7812.   InnerStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENINNER, BDR_RAISEDINNER, 0);
  7813.   OuterStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENOUTER, BDR_RAISEDOUTER, 0);
  7814.   EdgeStyles: array[TBevelKind] of Integer = (0, 0, BF_SOFT, BF_FLAT);
  7815.   Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, 0);
  7816. var
  7817.   DC: HDC;
  7818.   RC, RW, SaveRW: TRect;
  7819.   EdgeSize: Integer;
  7820.   WinStyle: Longint;
  7821. begin
  7822.   { Get window DC that is clipped to the non-client area }
  7823.   if (BevelKind <> bkNone) or (BorderWidth > 0) then
  7824.   begin
  7825.     DC := GetWindowDC(Handle);
  7826.     try
  7827.       Windows.GetClientRect(Handle, RC);
  7828.       GetWindowRect(Handle, RW);
  7829.       MapWindowPoints(0, Handle, RW, 2);
  7830.       OffsetRect(RC, -RW.Left, -RW.Top);
  7831.       ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
  7832.       { Draw borders in non-client area }
  7833.       SaveRW := RW;
  7834.       InflateRect(RC, BorderWidth, BorderWidth);
  7835.       RW := RC;
  7836.       if BevelKind <> bkNone then
  7837.       begin
  7838.         EdgeSize := 0;
  7839.         if BevelInner <> bvNone then Inc(EdgeSize, BevelWidth);
  7840.         if BevelOuter <> bvNone then Inc(EdgeSize, BevelWidth);
  7841.         with RW do
  7842.         begin
  7843.           WinStyle := GetWindowLong(Handle, GWL_STYLE);
  7844.           if beLeft in BevelEdges then Dec(Left, EdgeSize);
  7845.           if beTop in BevelEdges then Dec(Top, EdgeSize);
  7846.           if beRight in BevelEdges then Inc(Right, EdgeSize);
  7847.           if (WinStyle and WS_VSCROLL) <> 0 then Inc(Right, GetSystemMetrics(SM_CYVSCROLL));
  7848.           if beBottom in BevelEdges then Inc(Bottom, EdgeSize);
  7849.           if (WinStyle and WS_HSCROLL) <> 0 then Inc(Bottom, GetSystemMetrics(SM_CXHSCROLL));
  7850.         end;
  7851.         DrawEdge(DC, RW, InnerStyles[BevelInner] or OuterStyles[BevelOuter],
  7852.           Byte(BevelEdges) or EdgeStyles[BevelKind] or Ctl3DStyles[Ctl3D] or BF_ADJUST);
  7853.       end;
  7854.       IntersectClipRect(DC, RW.Left, RW.Top, RW.Right, RW.Bottom);
  7855.       RW := SaveRW;
  7856.       { Erase parts not drawn }
  7857.       OffsetRect(RW, -RW.Left, -RW.Top);
  7858.       Windows.FillRect(DC, RW, Brush.Handle);
  7859.     finally
  7860.       ReleaseDC(Handle, DC);
  7861.     end;
  7862.   end;
  7863.   inherited;
  7864. end;
  7865.  
  7866. function TWinControl.FindChildControl(const ControlName: string): TControl;
  7867. var
  7868.   I: Integer;
  7869. begin
  7870.   Result := nil;
  7871.   if FWinControls <> nil then
  7872.     for I := 0 to FWinControls.Count - 1 do
  7873.       if CompareText(TWinControl(FWinControls[I]).Name, ControlName) = 0 then
  7874.       begin
  7875.         Result := FWinControls[I];
  7876.         Exit;
  7877.       end;
  7878. end;
  7879.  
  7880. procedure TWinControl.WMContextMenu(var Message: TWMContextMenu);
  7881. var
  7882.   Ctrl: TControl;
  7883. begin
  7884.   if Message.Result <> 0 then Exit;
  7885.   Ctrl := ControlAtPos(ScreenToClient(SmallPointToPoint(Message.Pos)), False);
  7886.   if Ctrl <> nil then
  7887.     Message.Result := Ctrl.Perform(WM_CONTEXTMENU, 0, Integer(Message.Pos));
  7888.  
  7889.   if Message.Result = 0 then
  7890.     inherited;
  7891. end;
  7892.  
  7893. { TGraphicControl }
  7894.  
  7895. constructor TGraphicControl.Create(AOwner: TComponent);
  7896. begin
  7897.   inherited Create(AOwner);
  7898.   FCanvas := TControlCanvas.Create;
  7899.   TControlCanvas(FCanvas).Control := Self;
  7900. end;
  7901.  
  7902. destructor TGraphicControl.Destroy;
  7903. begin
  7904.   if CaptureControl = Self then SetCaptureControl(nil);
  7905.   FCanvas.Free;
  7906.   inherited Destroy;
  7907. end;
  7908.  
  7909. procedure TGraphicControl.WMPaint(var Message: TWMPaint);
  7910. begin
  7911.   if Message.DC <> 0 then
  7912.   begin
  7913.     Canvas.Lock;
  7914.     try
  7915.       Canvas.Handle := Message.DC;
  7916.       try
  7917.         Paint;
  7918.       finally
  7919.         Canvas.Handle := 0;
  7920.       end;
  7921.     finally
  7922.       Canvas.Unlock;
  7923.     end;
  7924.   end;
  7925. end;
  7926.  
  7927. procedure TGraphicControl.Paint;
  7928. begin
  7929. end;
  7930.  
  7931. { THintWindow }
  7932.  
  7933. constructor THintWindow.Create(AOwner: TComponent);
  7934. begin
  7935.   inherited Create(AOwner);
  7936.   Color := $80FFFF;
  7937.   Canvas.Font := Screen.HintFont;
  7938.   Canvas.Brush.Style := bsClear;
  7939. end;
  7940.  
  7941. procedure THintWindow.CreateParams(var Params: TCreateParams);
  7942. begin
  7943.   inherited CreateParams(Params);
  7944.   with Params do
  7945.   begin
  7946.     Style := WS_POPUP or WS_BORDER;
  7947.     WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
  7948.     if NewStyleControls then ExStyle := WS_EX_TOOLWINDOW;
  7949.     AddBiDiModeExStyle(ExStyle);
  7950.   end;
  7951. end;
  7952.  
  7953. procedure THintWindow.WMNCHitTest(var Message: TWMNCHitTest);
  7954. begin
  7955.   Message.Result := HTTRANSPARENT;
  7956. end;
  7957.  
  7958. procedure THintWindow.WMNCPaint(var Message: TMessage);
  7959. var
  7960.   DC: HDC;
  7961.   R: TRect;
  7962. begin
  7963.   DC := GetWindowDC(Handle);
  7964.   try
  7965.     R := Rect(0, 0, Width, Height);
  7966.     DrawEdge(DC, R, BDR_RAISEDOUTER, BF_RECT);
  7967.   finally
  7968.     ReleaseDC(Handle, DC);
  7969.   end;
  7970. end;
  7971.  
  7972. procedure THintWindow.Paint;
  7973. var
  7974.   R: TRect;
  7975. begin
  7976.   R := ClientRect;
  7977.   Inc(R.Left, 2);
  7978.   Inc(R.Top, 2);
  7979.   Canvas.Font.Color := clInfoText;
  7980.   DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_LEFT or DT_NOPREFIX or
  7981.     DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
  7982. end;
  7983.  
  7984. function THintWindow.IsHintMsg(var Msg: TMsg): Boolean;
  7985. begin
  7986.   with Msg do
  7987.     Result := ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) or
  7988.       ((Message = CM_ACTIVATE) or (Message = CM_DEACTIVATE)) or
  7989.       (Message = CM_APPKEYDOWN) or (Message = CM_APPSYSCOMMAND) or
  7990.       (Message = WM_COMMAND) or ((Message > WM_MOUSEMOVE) and
  7991.       (Message <= WM_MOUSELAST)) or (Message = WM_NCMOUSEMOVE);
  7992. end;
  7993.  
  7994. procedure THintWindow.ReleaseHandle;
  7995. begin
  7996.   DestroyHandle;
  7997. end;
  7998.  
  7999. procedure THintWindow.CMTextChanged(var Message: TMessage);
  8000. begin
  8001.   inherited;
  8002.   { Avoid flicker when calling ActivateHint }
  8003.   if FActivating then Exit;
  8004.   Width := Canvas.TextWidth(Caption) + 6;
  8005.   Height := Canvas.TextHeight(Caption) + 4;
  8006. end;
  8007.  
  8008. procedure THintWindow.ActivateHint(Rect: TRect; const AHint: string);
  8009. begin
  8010.   FActivating := True;
  8011.   try
  8012.     Caption := AHint;
  8013.     Inc(Rect.Bottom, 4);
  8014.     UpdateBoundsRect(Rect);
  8015.     if Rect.Top + Height > Screen.DesktopHeight then
  8016.       Rect.Top := Screen.DesktopHeight - Height;
  8017.     if Rect.Left + Width > Screen.DesktopWidth then
  8018.       Rect.Left := Screen.DesktopWidth - Width;
  8019.     if Rect.Left < Screen.DesktopLeft then Rect.Left := Screen.DesktopLeft;
  8020.     if Rect.Bottom < Screen.DesktopTop then Rect.Bottom := Screen.DesktopTop;
  8021.     SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
  8022.       SWP_SHOWWINDOW or SWP_NOACTIVATE);
  8023.     Invalidate;
  8024.   finally
  8025.     FActivating := False;
  8026.   end;
  8027. end;
  8028.  
  8029. procedure THintWindow.ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer);
  8030. begin
  8031.   ActivateHint(Rect, AHint);
  8032. end;
  8033.  
  8034. function THintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
  8035. begin
  8036.   Result := Rect(0, 0, MaxWidth, 0);
  8037.   DrawText(Canvas.Handle, PChar(AHint), -1, Result, DT_CALCRECT or DT_LEFT or
  8038.     DT_WORDBREAK or DT_NOPREFIX or DrawTextBiDiModeFlagsReadingOnly);
  8039.   Inc(Result.Right, 6);
  8040.   Inc(Result.Bottom, 2);
  8041. end;
  8042.  
  8043. { TDragImageList }
  8044.  
  8045. function ClientToWindow(Handle: HWND; X, Y: Integer): TPoint;
  8046. var
  8047.   Rect: TRect;
  8048.   Point: TPoint;
  8049. begin
  8050.   Point.X := X;
  8051.   Point.Y := Y;
  8052.   ClientToScreen(Handle, Point);
  8053.   GetWindowRect(Handle, Rect);
  8054.   Result.X := Point.X - Rect.Left;
  8055.   Result.Y := Point.Y - Rect.Top;
  8056. end;
  8057.  
  8058. procedure TDragImageList.Initialize;
  8059. begin
  8060.   inherited Initialize;
  8061.   DragCursor := crNone;
  8062. end;
  8063.  
  8064. procedure TDragImageList.CombineDragCursor;
  8065. var
  8066.   TempList: HImageList;
  8067.   Point: TPoint;
  8068. begin
  8069.   if DragCursor <> crNone then
  8070.   begin
  8071.     TempList := ImageList_Create(GetSystemMetrics(SM_CXCURSOR),
  8072.       GetSystemMetrics(SM_CYCURSOR), ILC_MASK, 1, 1);
  8073.     try
  8074.       ImageList_AddIcon(TempList, Screen.Cursors[DragCursor]);
  8075.       ImageList_AddIcon(TempList, Screen.Cursors[DragCursor]);
  8076.       ImageList_SetDragCursorImage(TempList, 0, 0, 0);
  8077.       ImageList_GetDragImage(nil, @Point);
  8078.       ImageList_SetDragCursorImage(TempList, 1, Point.X, Point.Y);
  8079.     finally
  8080.       ImageList_Destroy(TempList);
  8081.     end;
  8082.   end;
  8083. end;
  8084.  
  8085. function TDragImageList.SetDragImage(Index, HotSpotX, HotSpotY: Integer): Boolean;
  8086. begin
  8087.   if HandleAllocated then
  8088.   begin
  8089.     FDragIndex := Index;
  8090.     FDragHotspot.x := HotSpotX;
  8091.     FDragHotspot.y := HotSpotY;
  8092.     ImageList_BeginDrag(Handle, Index, HotSpotX, HotSpotY);
  8093.     Result := True;
  8094.     FDragging := Result;
  8095.   end
  8096.   else Result := False;
  8097. end;
  8098.  
  8099. procedure TDragImageList.SetDragCursor(Value: TCursor);
  8100. begin
  8101.   if Value <> DragCursor then
  8102.   begin
  8103.     FDragCursor := Value;
  8104.     if Dragging then CombineDragCursor;
  8105.   end;
  8106. end;
  8107.  
  8108. function TDragImageList.GetHotSpot: TPoint;
  8109. begin
  8110.   Result := inherited GetHotSpot;
  8111.   if HandleAllocated and Dragging then
  8112.     ImageList_GetDragImage(nil, @Result);
  8113. end;
  8114.  
  8115. function TDragImageList.BeginDrag(Window: HWND; X, Y: Integer): Boolean;
  8116. begin
  8117.   Result := False;
  8118.   if HandleAllocated then
  8119.   begin
  8120.     if not Dragging then SetDragImage(FDragIndex, FDragHotspot.x, FDragHotspot.y);
  8121.     CombineDragCursor;
  8122.     Result := DragLock(Window, X, Y);
  8123.     if Result then ShowCursor(False);
  8124.   end;
  8125. end;
  8126.  
  8127. function TDragImageList.DragLock(Window: HWND; XPos, YPos: Integer): Boolean;
  8128. begin
  8129.   Result := False;
  8130.   if HandleAllocated and (Window <> FDragHandle) then
  8131.   begin
  8132.     DragUnlock;
  8133.     FDragHandle := Window;
  8134.     with ClientToWindow(FDragHandle, XPos, YPos) do
  8135.       Result := ImageList_DragEnter(FDragHandle, X, Y);
  8136.   end;
  8137. end;
  8138.  
  8139. procedure TDragImageList.DragUnlock;
  8140. begin
  8141.   if HandleAllocated and (FDragHandle <> 0) then
  8142.   begin
  8143.     ImageList_DragLeave(FDragHandle);
  8144.     FDragHandle := 0;
  8145.   end;
  8146. end;
  8147.  
  8148. function TDragImageList.DragMove(X, Y: Integer): Boolean;
  8149. begin
  8150.   if HandleAllocated then
  8151.     with ClientToWindow(FDragHandle, X, Y) do
  8152.       Result := ImageList_DragMove(X, Y)
  8153.   else
  8154.     Result := False;
  8155. end;
  8156.  
  8157. procedure TDragImageList.ShowDragImage;
  8158. begin
  8159.   if HandleAllocated then ImageList_DragShowNoLock(True);
  8160. end;
  8161.  
  8162. procedure TDragImageList.HideDragImage;
  8163. begin
  8164.   if HandleAllocated then ImageList_DragShowNoLock(False);
  8165. end;
  8166.  
  8167. function TDragImageList.EndDrag: Boolean;
  8168. begin
  8169.   if HandleAllocated and Dragging then
  8170.   begin
  8171.     DragUnlock;
  8172.     Result := ImageList_EndDrag;
  8173.     FDragging := False;
  8174.     DragCursor := crNone;
  8175.     ShowCursor(True);
  8176.   end
  8177.   else Result := False;
  8178. end;
  8179.  
  8180. { TCustomControl }
  8181.  
  8182. constructor TCustomControl.Create(AOwner: TComponent);
  8183. begin
  8184.   inherited Create(AOwner);
  8185.   FCanvas := TControlCanvas.Create;
  8186.   TControlCanvas(FCanvas).Control := Self;
  8187. end;
  8188.  
  8189. destructor TCustomControl.Destroy;
  8190. begin
  8191.   FCanvas.Free;
  8192.   inherited Destroy;
  8193. end;
  8194.  
  8195. procedure TCustomControl.WMPaint(var Message: TWMPaint);
  8196. begin
  8197.   Include(FControlState, csCustomPaint);
  8198.   inherited;
  8199.   Exclude(FControlState, csCustomPaint);
  8200. end;
  8201.  
  8202. procedure TCustomControl.PaintWindow(DC: HDC);
  8203. begin
  8204.   FCanvas.Lock;
  8205.   try
  8206.     FCanvas.Handle := DC;
  8207.     try
  8208.       TControlCanvas(FCanvas).UpdateTextFlags;
  8209.       Paint;
  8210.     finally
  8211.       FCanvas.Handle := 0;
  8212.     end;
  8213.   finally
  8214.     FCanvas.Unlock;
  8215.   end;
  8216. end;
  8217.  
  8218. procedure TCustomControl.Paint;
  8219. begin
  8220. end;
  8221.  
  8222. { TDockZone }
  8223.  
  8224. constructor TDockZone.Create(Tree: TDockTree);
  8225. begin
  8226.   FTree := Tree;
  8227. end;
  8228.  
  8229. function TDockZone.GetChildCount: Integer;
  8230. var
  8231.   Zone: TDockZone;
  8232. begin
  8233.   Result := 0;
  8234.   Zone := FChildZones;
  8235.   while Zone <> nil do
  8236.   begin
  8237.     Zone := Zone.FNextSibling;
  8238.     Inc(Result);
  8239.   end;
  8240. end;
  8241.  
  8242. function TDockZone.GetLimitBegin: Integer;
  8243. var
  8244.   CheckZone: TDockZone;
  8245. begin
  8246.   if FTree.FTopZone = Self then CheckZone := Self
  8247.   else CheckZone := FParentZone;
  8248.   if CheckZone.FOrientation = doHorizontal then Result := Top
  8249.   else if CheckZone.FOrientation = doVertical then Result := Left
  8250.   else raise Exception.Create('');
  8251. end;
  8252.  
  8253. function TDockZone.GetLimitSize: Integer;
  8254. var
  8255.   CheckZone: TDockZone;
  8256. begin
  8257.   if FTree.FTopZone = Self then CheckZone := Self
  8258.   else CheckZone := FParentZone;
  8259.   if CheckZone.FOrientation = doHorizontal then Result := Height
  8260.   else if CheckZone.FOrientation = doVertical then Result := Width
  8261.   else raise Exception.Create('');
  8262. end;
  8263.  
  8264. function TDockZone.GetTopLeft(Orient: Integer{TDockOrientation}): Integer;
  8265. var
  8266.   Zone: TDockZone;
  8267.   R: TRect;
  8268. begin
  8269.   Zone := Self;
  8270.   while Zone <> FTree.FTopZone do
  8271.   begin
  8272.     if (Zone.FParentZone.FOrientation = TDockOrientation(Orient)) and
  8273.       (Zone.FPrevSibling <> nil) then
  8274.     begin
  8275.       Result := Zone.FPrevSibling.FZoneLimit;
  8276.       Exit;
  8277.     end
  8278.     else
  8279.       Zone := Zone.FParentZone;
  8280.   end;
  8281.   R := FTree.FDockSite.ClientRect;
  8282.   FTree.FDockSite.AdjustClientRect(R);
  8283.   case TDockOrientation(Orient) of
  8284.     doVertical: Result := R.Left;
  8285.     doHorizontal: Result := R.Top;
  8286.   else
  8287.     Result := 0;
  8288.   end;
  8289. end;
  8290.  
  8291. function TDockZone.GetHeightWidth(Orient: Integer{TDockOrientation}): Integer;
  8292. var
  8293.   Zone: TDockZone;
  8294.   R: TRect;
  8295. begin
  8296.   if (Self = FTree.FTopZone) or ((FParentZone = FTree.FTopZone) and
  8297.     (FChildControl <> nil) and (FTree.FTopZone.ChildCount = 1)) then
  8298.   begin
  8299.     R := FTree.FDockSite.ClientRect;
  8300.     FTree.FDockSite.AdjustClientRect(R);
  8301.     if TDockOrientation(Orient) = doHorizontal then
  8302.       Result := R.Bottom - R.Top
  8303.     else
  8304.       Result := R.Right - R.Left;
  8305.   end
  8306.   else begin
  8307.     Zone := Self;
  8308.     while Zone <> FTree.FTopZone do
  8309.     begin
  8310.       if Zone.FParentZone.FOrientation = TDockOrientation(Orient) then
  8311.       begin
  8312.         Result := Zone.FZoneLimit - Zone.LimitBegin;
  8313.         Exit;
  8314.       end
  8315.       else
  8316.         Zone := Zone.FParentZone;
  8317.     end;
  8318.     if FTree.FTopZone.FOrientation = TDockOrientation(Orient) then
  8319.       Result := FTree.FTopXYLimit
  8320.     else
  8321.       Result := FTree.FTopZone.FZoneLimit;
  8322.   end;
  8323. end;
  8324.  
  8325. procedure TDockZone.ResetChildren;
  8326. var
  8327.   OldLimit: Integer;
  8328.   NewLimit: Integer;
  8329.   ChildNode: TDockZone;
  8330. begin
  8331.   case FOrientation of
  8332.     doHorizontal: NewLimit := Height;
  8333.     doVertical: NewLimit := Width;
  8334.   else
  8335.     Exit;
  8336.   end;
  8337.   ChildNode := FChildZones;
  8338.   OldLimit := NewLimit;
  8339.   NewLimit := NewLimit div ChildCount;
  8340.   ChildNode.FZoneLimit := ChildNode.LimitBegin + NewLimit;
  8341.   ChildNode.Update;
  8342.   ChildNode := ChildNode.FNextSibling;
  8343.   while ChildNode <> nil do
  8344.   begin
  8345.     ChildNode.FZoneLimit := ChildNode.FPrevSibling.FZoneLimit + NewLimit;
  8346.     if ChildNode.FNextSibling = nil then
  8347.       ChildNode.FZoneLimit := ChildNode.FZoneLimit + (OldLimit mod NewLimit);
  8348.     ChildNode.Update;
  8349.     ChildNode := ChildNode.FNextSibling;
  8350.   end;
  8351. end;
  8352.  
  8353. function TDockZone.GetControlName: string;
  8354. begin
  8355.   Result := '';
  8356.   if FChildControl <> nil then
  8357.   begin
  8358.     if FChildControl.Name = '' then
  8359.       raise Exception.CreateRes(@SDockedCtlNeedsName);
  8360.     Result := FChildControl.Name;
  8361.   end;
  8362. end;
  8363.  
  8364. function TDockZone.SetControlName(const Value: string): Boolean;
  8365. var
  8366.   Client: TControl;
  8367. begin
  8368.   Client := nil;
  8369.   with FTree do
  8370.   begin
  8371.     FDockSite.ReloadDockedControl(Value, Client);
  8372.     Result := Client <> nil;
  8373.     if Result then
  8374.     begin
  8375.       FReplacementZone := Self;
  8376.       try
  8377.         Client.ManualDock(FDockSite, nil, alNone);
  8378.       finally
  8379.         FReplacementZone := nil;
  8380.       end;
  8381.     end;
  8382.   end;
  8383. end;
  8384.  
  8385. procedure TDockZone.Update;
  8386.  
  8387.   function ParentNotLast: Boolean;
  8388.   var
  8389.     Parent: TDockZone;
  8390.   begin
  8391.     Result := False;
  8392.     Parent := FParentZone;
  8393.     while Parent <> nil do
  8394.     begin
  8395.       if Parent.FNextSibling <> nil then
  8396.       begin
  8397.         Result := True;
  8398.         Exit;
  8399.       end;
  8400.       Parent := Parent.FParentZone;
  8401.     end;
  8402.   end;
  8403.  
  8404. var
  8405.   NewWidth, NewHeight: Integer;
  8406.   R: TRect;
  8407. begin
  8408.   if (FChildControl <> nil) and (FTree.FUpdateCount = 0) then
  8409.   begin
  8410.     FChildControl.DockOrientation := FParentZone.FOrientation;
  8411.     NewWidth := Width;
  8412.     NewHeight := Height;
  8413.     if ParentNotLast then
  8414.     begin
  8415.       if FParentZone.FOrientation = doHorizontal then
  8416.         Dec(NewWidth, FTree.FBorderWidth)
  8417.       else
  8418.         Dec(NewHeight, FTree.FBorderWidth);
  8419.     end;
  8420.     if (FNextSibling <> nil) or ((FParentZone <> FTree.FTopZone) and
  8421.       ((FParentZone.FOrientation = FTree.FTopZone.FOrientation) and
  8422.       (FZoneLimit < FTree.FTopXYLimit)) or
  8423.       ((FParentZone.FOrientation <> FTree.FTopZone.FOrientation) and
  8424.       (FZoneLimit < FTree.FTopZone.FZoneLimit))) then
  8425.     begin
  8426.       if FParentZone.FOrientation = doHorizontal then
  8427.         Dec(NewHeight, FTree.FBorderWidth)
  8428.       else
  8429.         Dec(NewWidth, FTree.FBorderWidth);
  8430.     end;
  8431.     R := Bounds(Left, Top, NewWidth, NewHeight);
  8432.     FTree.AdjustDockRect(FChildControl, R);
  8433.     FChildControl.BoundsRect := R;
  8434.   end;
  8435. end;
  8436.  
  8437. { TDockTree }
  8438.  
  8439. const
  8440.   GrabberSize = 12;
  8441.  
  8442. constructor TDockTree.Create(DockSite: TWinControl);
  8443. var
  8444.   I: Integer;
  8445. begin
  8446.   inherited Create;
  8447.   FBorderWidth := 4;
  8448.   FDockSite := DockSite;
  8449.   FVersion := $00040000;
  8450.   FGrabberSize := GrabberSize;
  8451.   FGrabbersOnTop := (DockSite.Align <> alTop) and (DockSite.Align <> alBottom);
  8452.   FTopZone := TDockZone.Create(Self);
  8453.   FBrush := TBrush.Create;
  8454.   FBrush.Bitmap := AllocPatternBitmap(clBlack, clWhite);
  8455.   // insert existing controls into tree
  8456.   BeginUpdate;
  8457.   try
  8458.     for I := 0 to DockSite.ControlCount - 1 do
  8459.       InsertControl(DockSite.Controls[I], alLeft, nil);
  8460.     FTopZone.ResetChildren;
  8461.   finally
  8462.     EndUpdate;
  8463.   end;
  8464.   if not (csDesigning in DockSite.ComponentState) then
  8465.   begin
  8466.     FOldWndProc := FDockSite.WindowProc;
  8467.     FDockSite.WindowProc := WindowProc;
  8468.   end;
  8469. end;
  8470.  
  8471. destructor TDockTree.Destroy;
  8472. begin
  8473.   if @FOldWndProc <> nil then
  8474.     FDockSite.WindowProc := FOldWndProc;
  8475.   PruneZone(FTopZone);
  8476.   FBrush.Free;
  8477.   inherited Destroy;
  8478. end;
  8479.  
  8480. procedure TDockTree.AdjustDockRect(Control: TControl; var ARect: TRect);
  8481. begin
  8482.   { Allocate room for the caption on the left if docksite is horizontally
  8483.     oriented, otherwise allocate room for the caption on the top. }
  8484.   if FDockSite.Align in [alTop, alBottom] then
  8485.     Inc(ARect.Left, GrabberSize) else
  8486.     Inc(ARect.Top, GrabberSize);
  8487. end;
  8488.  
  8489. procedure TDockTree.BeginUpdate;
  8490. begin
  8491.   Inc(FUpdateCount);
  8492. end;
  8493.  
  8494. procedure TDockTree.EndUpdate;
  8495. begin
  8496.   Dec(FUpdateCount);
  8497.   if FUpdateCount <= 0 then
  8498.   begin
  8499.     FUpdateCount := 0;
  8500.     UpdateAll;
  8501.   end;
  8502. end;
  8503.  
  8504. function TDockTree.FindControlZone(Control: TControl): TDockZone;
  8505. var
  8506.   CtlZone: TDockZone;
  8507.  
  8508.   procedure DoFindControlZone(StartZone: TDockZone);
  8509.   begin
  8510.     if StartZone.FChildControl = Control then
  8511.       CtlZone := StartZone
  8512.     else begin
  8513.       // Recurse sibling
  8514.       if (CtlZone = nil) and (StartZone.FNextSibling <> nil) then
  8515.         DoFindControlZone(StartZone.FNextSibling);
  8516.       // Recurse child
  8517.       if (CtlZone = nil) and (StartZone.FChildZones <> nil) then
  8518.         DoFindControlZone(StartZone.FChildZones);
  8519.     end;
  8520.   end;
  8521.  
  8522. begin
  8523.   CtlZone := nil;
  8524.   if (Control <> nil) and (FTopZone <> nil) then DoFindControlZone(FTopZone);
  8525.   Result := CtlZone;
  8526. end;
  8527.  
  8528. procedure TDockTree.ForEachAt(Zone: TDockZone; Proc: TForEachZoneProc);
  8529.  
  8530.   procedure DoForEach(Zone: TDockZone);
  8531.   begin
  8532.     Proc(Zone);
  8533.     // Recurse sibling
  8534.     if Zone.FNextSibling <> nil then DoForEach(Zone.FNextSibling);
  8535.     // Recurse child
  8536.     if Zone.FChildZones <> nil then DoForEach(Zone.FChildZones);
  8537.   end;
  8538.  
  8539. begin
  8540.   if Zone = nil then Zone := FTopZone;
  8541.   DoForEach(Zone);
  8542. end;
  8543.  
  8544. procedure TDockTree.GetControlBounds(Control: TControl; out CtlBounds: TRect);
  8545. var
  8546.   Z: TDockZone;
  8547. begin
  8548.   Z := FindControlZone(Control);
  8549.   if Z = nil then
  8550.     FillChar(CtlBounds, SizeOf(CtlBounds), 0)
  8551.   else
  8552.     with Z do
  8553.       CtlBounds := Bounds(Left, Top, Width, Height);
  8554. end;
  8555.  
  8556. function TDockTree.HitTest(const MousePos: TPoint; out HTFlag: Integer): TControl;
  8557. var
  8558.   Zone: TDockZone;
  8559. begin
  8560.   Zone := InternalHitTest(MousePos, HTFlag);
  8561.   if Zone <> nil then Result := Zone.FChildControl
  8562.   else Result := nil;
  8563. end;
  8564.  
  8565. procedure TDockTree.InsertControl(Control: TControl; InsertAt: TAlign;
  8566.   DropCtl: TControl);
  8567. const
  8568.   OrientArray: array[TAlign] of TDockOrientation = (doNoOrient, doHorizontal,
  8569.     doHorizontal, doVertical, doVertical, doNoOrient);
  8570.   MakeLast: array[TAlign] of Boolean = (False, False, True, False, True, False);
  8571. var
  8572.   Sibling, Me: TDockZone;
  8573.   InsertOrientation, CurrentOrientation: TDockOrientation;
  8574.   NewWidth, NewHeight: Integer;
  8575.   R: TRect;
  8576. begin
  8577.   if not Control.Visible then Exit;
  8578.   if FReplacementZone <> nil then
  8579.   begin
  8580.     FReplacementZone.FChildControl := Control;
  8581.     FReplacementZone.Update;
  8582.   end
  8583.   else if FTopZone.FChildZones = nil then
  8584.   begin
  8585.     // Tree is empty, so add first child
  8586.     R := FDockSite.ClientRect;
  8587.     FDockSite.AdjustClientRect(R);
  8588.     NewWidth := R.Right - R.Left;
  8589.     NewHeight := R.Bottom - R.Top;
  8590.     if FDockSite.AutoSize then
  8591.     begin
  8592.       if NewWidth = 0 then NewWidth := Control.UndockWidth;
  8593.       if NewHeight = 0 then NewHeight := Control.UndockHeight;
  8594.     end;
  8595.     R := Bounds(R.Left, R.Top, NewWidth, NewHeight);
  8596.     AdjustDockRect(Control, R);
  8597.     Control.BoundsRect := R;
  8598.     Me := TDockZone.Create(Self);
  8599.     FTopZone.FChildZones := Me;
  8600.     Me.FParentZone := FTopZone;
  8601.     Me.FChildControl := Control;
  8602.   end
  8603.   else begin
  8604.     // Default to right-side docking
  8605.     if InsertAt in [alClient, alNone] then InsertAt := alRight;
  8606.     Me := FindControlZone(Control);
  8607.     if Me <> nil then RemoveZone(Me);
  8608.     Sibling := FindControlZone(DropCtl);
  8609.     InsertOrientation := OrientArray[InsertAt];
  8610.     if FTopZone.ChildCount = 1 then
  8611.     begin
  8612.       // Tree only has one child, and a second is being added, so orientation and
  8613.       // limits must be set up
  8614.       FTopZone.FOrientation := InsertOrientation;
  8615.       case InsertOrientation of
  8616.         doHorizontal:
  8617.           begin
  8618.             FTopZone.FZoneLimit := FTopZone.FChildZones.Width;
  8619.             FTopXYLimit := FTopZone.FChildZones.Height;
  8620.           end;
  8621.         doVertical:
  8622.           begin
  8623.             FTopZone.FZoneLimit := FTopZone.FChildZones.Height;
  8624.             FTopXYLimit := FTopZone.FChildZones.Width;
  8625.           end;
  8626.       end;
  8627.     end;
  8628.     Me := TDockZone.Create(Self);
  8629.     Me.FChildControl := Control;
  8630.     if Sibling <> nil then CurrentOrientation := Sibling.FParentZone.FOrientation
  8631.     else CurrentOrientation := FTopZone.FOrientation;
  8632.     if InsertOrientation = doNoOrient then
  8633.       InsertOrientation := CurrentOrientation;
  8634.     // Control is being dropped into a zone with the same orientation we
  8635.     // are requesting, so we just need to add ourselves to the sibling last
  8636.     if InsertOrientation = CurrentOrientation then InsertSibling(Me, Sibling,
  8637.       MakeLast[InsertAt])
  8638.     // Control is being dropped into a zone with a different orientation than
  8639.     // we are requesting
  8640.     else InsertNewParent(Me, Sibling, InsertOrientation, MakeLast[InsertAt]);
  8641.   end;
  8642.   { Redraw client dock frames }
  8643.   FDockSite.Invalidate;
  8644. end;
  8645.  
  8646. procedure TDockTree.InsertNewParent(NewZone, SiblingZone: TDockZone;
  8647.   ParentOrientation: TDockOrientation; InsertLast: Boolean);
  8648. var
  8649.   NewParent: TDockZone;
  8650. begin
  8651.   NewParent := TDockZone.Create(Self);
  8652.   NewParent.FOrientation := ParentOrientation;
  8653.   if SiblingZone = nil then
  8654.   begin
  8655.     // if SiblingZone is nil, then we need to insert zone as a child of the top
  8656.     NewParent.FZoneLimit := FTopXYLimit;
  8657.     FTopXYLimit := FTopZone.FZoneLimit;
  8658.     FShiftScaleOrient := ParentOrientation;
  8659.     FScaleBy := 0.5;
  8660.     if InsertLast then
  8661.     begin
  8662.       NewParent.FChildZones := FTopZone;
  8663.       FTopZone.FParentZone := NewParent;
  8664.       FTopZone.FNextSibling := NewZone;
  8665.       NewZone.FPrevSibling := FTopZone;
  8666.       NewZone.FParentZone := NewParent;
  8667.       FTopZone := NewParent;
  8668.       ForEachAt(NewParent.FChildZones, ScaleZone);
  8669.     end
  8670.     else begin
  8671.       NewParent.FChildZones := NewZone;
  8672.       FTopZone.FParentZone := NewParent;
  8673.       FTopZone.FPrevSibling := NewZone;
  8674.       NewZone.FNextSibling := FTopZone;
  8675.       NewZone.FParentZone := NewParent;
  8676.       FTopZone := NewParent;
  8677.       ForEachAt(NewParent.FChildZones, ScaleZone);
  8678.       FShiftBy := FTopZone.FZoneLimit div 2;
  8679.       ForEachAt(NewParent.FChildZones, ShiftZone);
  8680.       NewZone.FZoneLimit := FTopZone.FZoneLimit div 2;
  8681.     end;
  8682.     ForEachAt(nil, UpdateZone);
  8683.   end
  8684.   else begin
  8685.     // if SiblingZone is not nil, we need to insert a new parent zone for me
  8686.     // and my SiblingZone
  8687.     NewParent.FZoneLimit := SiblingZone.FZoneLimit;
  8688.     NewParent.FParentZone := SiblingZone.FParentZone;
  8689.     NewParent.FPrevSibling := SiblingZone.FPrevSibling;
  8690.     if NewParent.FPrevSibling <> nil then
  8691.       NewParent.FPrevSibling.FNextSibling := NewParent;
  8692.     NewParent.FNextSibling := SiblingZone.FNextSibling;
  8693.     if NewParent.FNextSibling <> nil then
  8694.       NewParent.FNextSibling.FPrevSibling := NewParent;
  8695.     if NewParent.FParentZone.FChildZones = SiblingZone then
  8696.       NewParent.FParentZone.FChildZones := NewParent;
  8697.     NewZone.FParentZone := NewParent;
  8698.     SiblingZone.FParentZone := NewParent;
  8699.     if InsertLast then
  8700.     begin
  8701.       // insert after SiblingZone
  8702.       NewParent.FChildZones := SiblingZone;
  8703.       SiblingZone.FPrevSibling := nil;
  8704.       SiblingZone.FNextSibling := NewZone;
  8705.       NewZone.FPrevSibling := SiblingZone;
  8706.     end
  8707.     else begin
  8708.       // insert before SiblingZone
  8709.       NewParent.FChildZones := NewZone;
  8710.       SiblingZone.FPrevSibling := NewZone;
  8711.       SiblingZone.FNextSibling := nil;
  8712.       NewZone.FNextSibling := SiblingZone;
  8713.     end;
  8714.     // Set bounds of new children
  8715.   end;
  8716.   NewParent.ResetChildren;
  8717.   ForEachAt(nil, UpdateZone);
  8718. end;
  8719.  
  8720. procedure TDockTree.InsertSibling(NewZone, SiblingZone: TDockZone;
  8721.   InsertLast: Boolean);
  8722. begin
  8723.   if SiblingZone = nil then
  8724.   begin
  8725.     // If sibling is nil then make me the a child of the top
  8726.     SiblingZone := FTopZone.FChildZones;
  8727.     if InsertLast then
  8728.       while SiblingZone.FNextSibling <> nil do
  8729.         SiblingZone := SiblingZone.FNextSibling;
  8730.   end;
  8731.   if InsertLast then
  8732.   begin
  8733.     // Insert me after sibling
  8734.     NewZone.FParentZone := SiblingZone.FParentZone;
  8735.     NewZone.FPrevSibling := SiblingZone;
  8736.     NewZone.FNextSibling := SiblingZone.FNextSibling;
  8737.     if NewZone.FNextSibling <> nil then
  8738.       NewZone.FNextSibling.FPrevSibling := NewZone;
  8739.     SiblingZone.FNextSibling := NewZone;
  8740.   end
  8741.   else begin
  8742.     // insert before sibling
  8743.     NewZone.FNextSibling := SiblingZone;
  8744.     NewZone.FPrevSibling := SiblingZone.FPrevSibling;
  8745.     if NewZone.FPrevSibling <> nil then
  8746.       NewZone.FPrevSibling.FNextSibling := NewZone;
  8747.     SiblingZone.FPrevSibling := NewZone;
  8748.     NewZone.FParentZone := SiblingZone.FParentZone;
  8749.     if NewZone.FParentZone.FChildZones = SiblingZone then
  8750.       NewZone.FParentZone.FChildZones := NewZone;
  8751.   end;
  8752.   // Set up zone limits for all siblings
  8753.   SiblingZone.FParentZone.ResetChildren;
  8754. end;
  8755.  
  8756. function TDockTree.InternalHitTest(const MousePos: TPoint; out HTFlag: Integer): TDockZone;
  8757. var
  8758.   ResultZone: TDockZone;
  8759.  
  8760.   procedure DoFindZone(Zone: TDockZone);
  8761.   var
  8762.     ZoneTop, ZoneLeft: Integer;
  8763.   begin
  8764.     // Check for hit on bottom splitter...
  8765.     if (Zone.FParentZone.FOrientation = doHorizontal) and
  8766.       ((MousePos.Y <= Zone.FZoneLimit) and
  8767.       (MousePos.Y >= Zone.FZoneLimit - FBorderWidth)) then
  8768.     begin
  8769.       HTFlag := HTBORDER;
  8770.       ResultZone := Zone;
  8771.     end
  8772.     // Check for hit on left splitter...
  8773.     else if (Zone.FParentZone.FOrientation = doVertical) and
  8774.       ((MousePos.X <= Zone.FZoneLimit) and
  8775.       (MousePos.X >= Zone.FZoneLimit - FBorderWidth)) then
  8776.     begin
  8777.       HTFlag := HTBORDER;
  8778.       ResultZone := Zone;
  8779.     end
  8780.     // Check for hit on grabber...
  8781.     else if Zone.FChildControl <> nil then
  8782.     begin
  8783.       ZoneTop := Zone.Top;
  8784.       ZoneLeft := Zone.Left;
  8785.       if FGrabbersOnTop then
  8786.       begin
  8787.         if (MousePos.Y >= ZoneTop) and (MousePos.Y <= ZoneTop + FGrabberSize) and
  8788.           (MousePos.X >= ZoneLeft) and (MousePos.X <= ZoneLeft + Zone.Width) then
  8789.         begin
  8790.           ResultZone := Zone;
  8791.           with Zone.FChildControl do
  8792.             if MousePos.X > Left + Width - 15 then HTFlag := HTCLOSE
  8793.             else HTFlag := HTCAPTION;
  8794.         end;
  8795.       end
  8796.       else begin
  8797.         if (MousePos.X >= ZoneLeft) and (MousePos.X <= ZoneLeft + FGrabberSize) and
  8798.           (MousePos.Y >= ZoneTop) and (MousePos.Y <= ZoneTop + Zone.Height) then
  8799.         begin
  8800.           ResultZone := Zone;
  8801.           if MousePos.Y < Zone.FChildControl.Top + 15 then HTFlag := HTCLOSE
  8802.           else HTFlag := HTCAPTION;
  8803.         end;
  8804.       end;
  8805.     end;
  8806.     // Recurse to next zone...
  8807.     if (ResultZone = nil) and (Zone.FNextSibling <> nil) then
  8808.       DoFindZone(Zone.FNextSibling);
  8809.     if (ResultZone = nil) and (Zone.FChildZones <> nil) then
  8810.       DoFindZone(Zone.FChildZones);
  8811.   end;
  8812.  
  8813.   function FindControlAtPos(const Pos: TPoint): TControl;
  8814.   var
  8815.     I: Integer;
  8816.     P: TPoint;
  8817.   begin
  8818.     for I := FDockSite.ControlCount - 1 downto 0 do
  8819.     begin
  8820.       Result := FDockSite.Controls[I];
  8821.       with Result do
  8822.       begin
  8823.         { Control must be Visible and Showing }
  8824.         if not Result.Visible or ((Result is TWinControl) and
  8825.            not TWinControl(Result).Showing) then continue;
  8826.         P := Point(Pos.X - Left, Pos.Y - Top);
  8827.         if PtInRect(ClientRect, P) then Exit;
  8828.       end;
  8829.     end;
  8830.     Result := nil;
  8831.   end;
  8832.  
  8833. var
  8834.   CtlAtPos: TControl;
  8835. begin
  8836.   ResultZone := nil;
  8837.   HTFlag := HTNOWHERE;
  8838.   CtlAtPos := FindControlAtPos(MousePos);
  8839.   if (CtlAtPos <> nil) and (CtlAtPos.HostDockSite = FDockSite) then
  8840.   begin
  8841.     ResultZone := FindControlZone(CtlAtPos);
  8842.     if ResultZone <> nil then HTFlag := HTCLIENT;
  8843.   end
  8844.   else if (FTopZone.FChildZones <> nil) and (FTopZone.ChildCount >= 1) and
  8845.     (CtlAtPos = nil) then
  8846.     DoFindZone(FTopZone.FChildZones);
  8847.   Result := ResultZone;
  8848. end;
  8849.  
  8850. var
  8851.   TreeStreamEndFlag: Integer = -1;
  8852.  
  8853. procedure TDockTree.LoadFromStream(Stream: TStream);
  8854.  
  8855.   procedure ReadControlName(var ControlName: string);
  8856.   var
  8857.     Size: Integer;
  8858.   begin
  8859.     ControlName := '';
  8860.     Stream.Read(Size, SizeOf(Size));
  8861.     if Size > 0 then
  8862.     begin
  8863.       SetLength(ControlName, Size);
  8864.       Stream.Read(Pointer(ControlName)^, Size);
  8865.     end;
  8866.   end;
  8867.  
  8868. var
  8869.   CompName: string;
  8870.   Client: TControl;
  8871.   Level, LastLevel, I, InVisCount: Integer;
  8872.   Zone, LastZone, NextZone: TDockZone;
  8873. begin
  8874.   PruneZone(FTopZone);
  8875.   BeginUpdate;
  8876.   try
  8877.     // read stream version
  8878.     Stream.Read(I, SizeOf(I));
  8879.     // read invisible dock clients
  8880.     Stream.Read(InVisCount, SizeOf(InVisCount));
  8881.     for I := 0 to InVisCount - 1 do
  8882.     begin
  8883.       ReadControlName(CompName);
  8884.       if CompName <> '' then
  8885.       begin
  8886.         FDockSite.ReloadDockedControl(CompName, Client);
  8887.         if Client <> nil then
  8888.         begin
  8889.           Client.Visible := False;
  8890.           Client.ManualDock(FDockSite);
  8891.         end;
  8892.       end;
  8893.     end;
  8894.     // read top zone data
  8895.     Stream.Read(FTopXYLimit, SizeOf(FTopXYLimit));
  8896.     LastLevel := 0;
  8897.     LastZone := nil;
  8898.     // read dock zone tree
  8899.     while True do
  8900.     begin
  8901.       with Stream do
  8902.       begin
  8903.         Read(Level, SizeOf(Level));
  8904.         if Level = TreeStreamEndFlag then Break;
  8905.         Zone := TDockZone.Create(Self);
  8906.         Read(Zone.FOrientation, SizeOf(Zone.FOrientation));
  8907.         Read(Zone.FZoneLimit, SizeOf(Zone.FZoneLimit));
  8908.         ReadControlName(CompName);
  8909.         if CompName <> '' then
  8910.           if not Zone.SetControlName(CompName) then
  8911.           begin
  8912.             {Remove dock zone if control cannot be found}
  8913.             Zone.Free;
  8914.             Continue;
  8915.           end;
  8916.       end;
  8917.       if Level = 0 then FTopZone := Zone
  8918.       else if Level = LastLevel then
  8919.       begin
  8920.         LastZone.FNextSibling := Zone;
  8921.         Zone.FPrevSibling := LastZone;
  8922.         Zone.FParentZone := LastZone.FParentZone;
  8923.       end
  8924.       else if Level > LastLevel then
  8925.       begin
  8926.         LastZone.FChildZones := Zone;
  8927.         Zone.FParentZone := LastZone;
  8928.       end
  8929.       else if Level < LastLevel then
  8930.       begin
  8931.         NextZone := LastZone;
  8932.         for I := 1 to LastLevel - Level do NextZone := NextZone.FParentZone;
  8933.         NextZone.FNextSibling := Zone;
  8934.         Zone.FPrevSibling := NextZone;
  8935.         Zone.FParentZone := NextZone.FParentZone;
  8936.       end;
  8937.       LastLevel := Level;
  8938.       LastZone := Zone;
  8939.     end;
  8940.   finally
  8941.     EndUpdate;
  8942.   end;
  8943. //  ResetBounds(True);
  8944. end;
  8945.  
  8946. procedure TDockTree.PaintDockFrame(Canvas: TCanvas; Control: TControl;
  8947.   const ARect: TRect);
  8948.  
  8949.   procedure DrawCloseButton(Left, Top: Integer);
  8950.   begin
  8951.     DrawFrameControl(Canvas.Handle, Rect(Left, Top, Left+FGrabberSize-2,
  8952.       Top+FGrabberSize-2), DFC_CAPTION, DFCS_CAPTIONCLOSE);
  8953.   end;
  8954.  
  8955.   procedure DrawGrabberLine(Left, Top, Right, Bottom: Integer);
  8956.   begin
  8957.     with Canvas do
  8958.     begin
  8959.       Pen.Color := clBtnHighlight;
  8960.       MoveTo(Right, Top);
  8961.       LineTo(Left, Top);
  8962.       LineTo(Left, Bottom);
  8963.       Pen.Color := clBtnShadow;
  8964.       LineTo(Right, Bottom);
  8965.       LineTo(Right, Top-1);
  8966.     end;
  8967.   end;
  8968.  
  8969. begin
  8970.   with ARect do
  8971.     if FDockSite.Align in [alTop, alBottom] then
  8972.     begin
  8973.       DrawCloseButton(Left+1, Top+1);
  8974.       DrawGrabberLine(Left+3, Top+FGrabberSize+1, Left+5, Bottom-2);
  8975.       DrawGrabberLine(Left+6, Top+FGrabberSize+1, Left+8, Bottom-2);
  8976.     end
  8977.     else
  8978.     begin
  8979.       DrawCloseButton(Right-FGrabberSize+1, Top+1);
  8980.       DrawGrabberLine(Left+2, Top+3, Right-FGrabberSize-2, Top+5);
  8981.       DrawGrabberLine(Left+2, Top+6, Right-FGrabberSize-2, Top+8);
  8982.     end;
  8983. end;
  8984.  
  8985. procedure TDockTree.PaintSite(DC: HDC);
  8986. var
  8987.   Canvas: TControlCanvas;
  8988.   Control: TControl;
  8989.   I: Integer;
  8990.   R: TRect;
  8991. begin
  8992.   Canvas := TControlCanvas.Create;
  8993.   try
  8994.     Canvas.Control := FDockSite;
  8995.     Canvas.Lock;
  8996.     try
  8997.       Canvas.Handle := DC;
  8998.       try
  8999.         for I := 0 to FDockSite.ControlCount - 1 do
  9000.         begin
  9001.           Control := FDockSite.Controls[I];
  9002.           if Control.Visible and (Control.HostDockSite = FDockSite) then
  9003.           begin
  9004.             R := Control.BoundsRect;
  9005.             AdjustDockRect(Control, R);
  9006.             Dec(R.Left, 2 * (R.Left - Control.Left));
  9007.             Dec(R.Top, 2 * (R.Top - Control.Top));
  9008.             Dec(R.Right, 2 * (Control.Width - (R.Right - R.Left)));
  9009.             Dec(R.Bottom, 2 * (Control.Height - (R.Bottom - R.Top)));
  9010.             PaintDockFrame(Canvas, Control, R);
  9011.           end;
  9012.         end;
  9013.       finally
  9014.         Canvas.Handle := 0;
  9015.       end;
  9016.     finally
  9017.       Canvas.Unlock;
  9018.     end;
  9019.   finally
  9020.     Canvas.Free;
  9021.   end;
  9022. end;
  9023.  
  9024. procedure TDockTree.PositionDockRect(Client, DropCtl: TControl;
  9025.   DropAlign: TAlign; var DockRect: TRect);
  9026. var
  9027.   VisibleClients,
  9028.   NewX, NewY, NewWidth, NewHeight: Integer;
  9029. begin
  9030.   VisibleClients := FDockSite.VisibleDockClientCount;
  9031.   { When docksite has no controls in it, or 1 or less clients then the
  9032.     dockrect should only be based on the client area of the docksite }
  9033.   if (DropCtl = nil) or (DropCtl.DockOrientation = doNoOrient) or
  9034.      {(DropCtl = Client) or }(VisibleClients < 2) then
  9035.   begin
  9036.     DockRect := Rect(0, 0, FDockSite.ClientWidth, FDockSite.ClientHeight);
  9037.     { When there is exactly 1 client we divide the docksite client area in half}
  9038.     if VisibleClients > 0 then
  9039.     with DockRect do
  9040.       case DropAlign of
  9041.         alLeft: Right := Right div 2;
  9042.         alRight: Left := Right div 2;
  9043.         alTop: Bottom := Bottom div 2;
  9044.         alBottom: Top := Bottom div 2;
  9045.       end;
  9046.   end
  9047.   else begin
  9048.   { Otherwise, if the docksite contains more than 1 client, set the coordinates
  9049.     for the dockrect based on the control under the mouse }
  9050.     NewX := DropCtl.Left;
  9051.     NewY := DropCtl.Top;
  9052.     NewWidth := DropCtl.Width;
  9053.     NewHeight := DropCtl.Height;
  9054.     if DropAlign in [alLeft, alRight] then
  9055.       NewWidth := DropCtl.Width div 2
  9056.     else if DropAlign in [alTop, alBottom] then
  9057.       NewHeight := DropCtl.Height div 2;
  9058.     case DropAlign of
  9059.       alRight: Inc(NewX, NewWidth);
  9060.       alBottom: Inc(NewY, NewHeight);
  9061.     end;
  9062.     DockRect := Bounds(NewX, NewY, NewWidth, NewHeight);
  9063.   end;
  9064.   MapWindowPoints(FDockSite.Handle, 0, DockRect, 2);
  9065. end;
  9066.  
  9067. procedure TDockTree.PruneZone(Zone: TDockZone);
  9068.  
  9069.   procedure DoPrune(Zone: TDockZone);
  9070.   begin
  9071.     // Recurse sibling
  9072.     if Zone.FNextSibling <> nil then
  9073.       DoPrune(Zone.FNextSibling);
  9074.     // Recurse child
  9075.     if Zone.FChildZones <> nil then
  9076.       DoPrune(Zone.FChildZones);
  9077.     // Free zone
  9078.     Zone.Free;
  9079.   end;
  9080.  
  9081. begin
  9082.   if Zone = nil then Exit;
  9083.   // Delete children recursively
  9084.   if Zone.FChildZones <> nil then DoPrune(Zone.FChildZones);
  9085.   // Fixup all pointers to this zone
  9086.   if Zone.FPrevSibling <> nil then
  9087.     Zone.FPrevSibling.FNextSibling := Zone.FNextSibling
  9088.   else if Zone.FParentZone <> nil then
  9089.     Zone.FParentZone.FChildZones := Zone.FNextSibling;
  9090.   if Zone.FNextSibling <> nil then
  9091.     Zone.FNextSibling.FPrevSibling := Zone.FPrevSibling;
  9092.   // Free this zone
  9093.   if Zone = FTopZone then FTopZone := nil;
  9094.   Zone.Free;
  9095. end;
  9096.  
  9097. procedure TDockTree.RemoveControl(Control: TControl);
  9098. var
  9099.   Z: TDockZone;
  9100. begin
  9101.   Z := FindControlZone(Control);
  9102.   if (Z <> nil) then
  9103.   begin
  9104.     if Z = FReplacementZone then
  9105.       Z.FChildControl := nil
  9106.     else
  9107.      RemoveZone(Z);
  9108.     Control.DockOrientation := doNoOrient;
  9109.     { Redraw client dock frames }
  9110.     FDockSite.Invalidate;
  9111.   end;
  9112. end;
  9113.  
  9114. procedure TDockTree.RemoveZone(Zone: TDockZone);
  9115. var
  9116.   Sibling, LastChild: TDockZone;
  9117.   ZoneChildCount: Integer;
  9118. begin
  9119.   if Zone = nil then
  9120.     raise Exception.Create(SDockTreeRemoveError + SDockZoneNotFound);
  9121.   if Zone.FChildControl = nil then
  9122.     raise Exception.Create(SDockTreeRemoveError + SDockZoneHasNoCtl);
  9123.   ZoneChildCount := Zone.FParentZone.ChildCount;
  9124.   if ZoneChildCount = 1 then
  9125.   begin
  9126.     FTopZone.FChildZones := nil;
  9127.     FTopZone.FOrientation := doNoOrient;
  9128.   end
  9129.   else if ZoneChildCount = 2 then
  9130.   begin
  9131.     // This zone has only one sibling zone
  9132.     if Zone.FPrevSibling = nil then Sibling := Zone.FNextSibling
  9133.     else Sibling := Zone.FPrevSibling;
  9134.     if Sibling.FChildControl <> nil then
  9135.     begin
  9136.       // Sibling is a zone with one control and no child zones
  9137.       if Zone.FParentZone = FTopZone then
  9138.       begin
  9139.         // If parent is top zone, then just remove the zone
  9140.         FTopZone.FChildZones := Sibling;
  9141.         Sibling.FPrevSibling := nil;
  9142.         Sibling.FNextSibling := nil;
  9143.         Sibling.FZoneLimit := FTopZone.LimitSize;
  9144.         Sibling.Update;
  9145.       end
  9146.       else begin
  9147.         // Otherwise, move sibling's control up into parent zone and dispose of sibling
  9148.         Zone.FParentZone.FOrientation := doNoOrient;
  9149.         Zone.FParentZone.FChildControl := Sibling.FChildControl;
  9150.         Zone.FParentZone.FChildZones := nil;
  9151.         Sibling.Free;
  9152.       end;
  9153.       ForEachAt(Zone.FParentZone, UpdateZone);
  9154.     end
  9155.     else begin
  9156.       // Sibling is a zone with child zones, so sibling must be made topmost
  9157.       // or collapsed into higher zone.
  9158.       if Zone.FParentZone = FTopZone then
  9159.       begin
  9160.         // Zone is a child of topmost zone, so sibling becomes topmost
  9161.         Sibling.FZoneLimit := FTopXYLimit;
  9162.         FTopXYLimit := FTopZone.FZoneLimit;
  9163.         FTopZone.Free;
  9164.         FTopZone := Sibling;
  9165.         Sibling.FNextSibling := nil;
  9166.         Sibling.FPrevSibling := nil;
  9167.         Sibling.FParentZone := nil;
  9168.         UpdateAll;
  9169.       end
  9170.       else begin
  9171.         // Zone's parent is not the topmost zone, so child zones must be
  9172.         // collapsed into parent zone
  9173.         Sibling.FChildZones.FPrevSibling := Zone.FParentZone.FPrevSibling;
  9174.         if Sibling.FChildZones.FPrevSibling = nil then
  9175.           Zone.FParentZone.FParentZone.FChildZones := Sibling.FChildZones
  9176.         else
  9177.           Sibling.FChildZones.FPrevSibling.FNextSibling := Sibling.FChildZones;
  9178.         LastChild := Sibling.FChildZones;
  9179.         LastChild.FParentZone := Zone.FParentZone.FParentZone;
  9180.         repeat
  9181.           LastChild := LastChild.FNextSibling;
  9182.           LastChild.FParentZone := Zone.FParentZone.FParentZone;
  9183.         until LastChild.FNextSibling = nil;
  9184.         LastChild.FNextSibling := Zone.FParentZone.FNextSibling;
  9185.         if LastChild.FNextSibling <> nil then
  9186.           LastChild.FNextSibling.FPrevSibling := LastChild;
  9187.         ForEachAt(LastChild.FParentZone, UpdateZone);
  9188.         Zone.FParentZone.Free;
  9189.         Sibling.Free;
  9190.       end;
  9191.     end;
  9192.   end
  9193.   else begin
  9194.     // This zone has multiple sibling zones
  9195.     if Zone.FPrevSibling = nil then
  9196.     begin
  9197.       // First zone in parent's child list, so make next one first and remove
  9198.       // from list
  9199.       Zone.FParentZone.FChildZones := Zone.FNextSibling;
  9200.       Zone.FNextSibling.FPrevSibling := nil;
  9201.       Zone.FNextSibling.Update;
  9202.     end
  9203.     else begin
  9204.       // Not first zone in parent's child list, so remove zone from list and fix
  9205.       // up adjacent siblings
  9206.       Zone.FPrevSibling.FNextSibling := Zone.FNextSibling;
  9207.       if Zone.FNextSibling <> nil then
  9208.         Zone.FNextSibling.FPrevSibling := Zone.FPrevSibling;
  9209.       Zone.FPrevSibling.FZoneLimit := Zone.FZoneLimit;
  9210.       Zone.FPrevSibling.Update;
  9211.     end;
  9212.     ForEachAt(Zone.FParentZone, UpdateZone);
  9213.   end;
  9214.   Zone.Free;
  9215. end;
  9216.  
  9217. procedure TDockTree.ResetBounds(Force: Boolean);
  9218. var
  9219.   R: TRect;
  9220. begin
  9221.   if not (csLoading in FDockSite.ComponentState) and
  9222.     (FTopZone <> nil) and (FDockSite.DockClientCount > 0) then
  9223.   begin
  9224.     R := FDockSite.ClientRect;
  9225.     FDockSite.AdjustClientRect(R);
  9226.     if Force or (not CompareMem(@R, @FOldRect, SizeOf(TRect))) then
  9227.     begin
  9228.       FOldRect := R;
  9229.       case FTopZone.FOrientation of
  9230.         doHorizontal:
  9231.           begin
  9232.             FTopZone.FZoneLimit := R.Right - R.Left;
  9233.             FTopXYLimit := R.Bottom - R.Top;
  9234.           end;
  9235.         doVertical:
  9236.           begin
  9237.             FTopZone.FZoneLimit := R.Bottom - R.Top;
  9238.             FTopXYLimit := R.Right - R.Left;
  9239.           end;
  9240.       end;
  9241.       if FDockSite.DockClientCount > 0 then
  9242.       begin
  9243.         SetNewBounds(nil);
  9244.         if FUpdateCount = 0 then ForEachAt(nil, UpdateZone);
  9245.       end;
  9246.     end;
  9247.   end;
  9248. end;
  9249.  
  9250. procedure TDockTree.ScaleZone(Zone: TDockZone);
  9251. begin
  9252.   if Zone = nil then Exit;
  9253.   if (Zone <> nil) and (Zone.FParentZone.FOrientation = FShiftScaleOrient) then
  9254.     with Zone do
  9255.       FZoneLimit := Integer(Round(FZoneLimit * FScaleBy));
  9256. end;
  9257.  
  9258. procedure TDockTree.SaveToStream(Stream: TStream);
  9259.  
  9260.   procedure WriteControlName(ControlName: string);
  9261.   var
  9262.     NameLen: Integer;
  9263.   begin
  9264.     NameLen := Length(ControlName);
  9265.     Stream.Write(NameLen, SizeOf(NameLen));
  9266.     if NameLen > 0 then Stream.Write(Pointer(ControlName)^, NameLen);
  9267.   end;
  9268.  
  9269.   procedure DoSaveZone(Zone: TDockZone; Level: Integer);
  9270.   begin
  9271.     with Stream do
  9272.     begin
  9273.       Write(Level, SizeOf(Level));
  9274.       Write(Zone.FOrientation, SizeOf(Zone.FOrientation));
  9275.       Write(Zone.FZoneLimit, SizeOf(Zone.FZoneLimit));
  9276.       WriteControlName(Zone.GetControlName);
  9277.     end;
  9278.     // Recurse child
  9279.     if Zone.FChildZones <> nil then
  9280.       DoSaveZone(Zone.FChildZones, Level + 1);
  9281.     // Recurse sibling
  9282.     if Zone.FNextSibling <> nil then
  9283.       DoSaveZone(Zone.FNextSibling, Level);
  9284.   end;
  9285.  
  9286. var
  9287.   I, NVCount: Integer;
  9288.   Ctl: TControl;
  9289.   NonVisList: TStringList;
  9290. begin
  9291.   // write stream version
  9292.   Stream.Write(FVersion, SizeOf(FVersion));
  9293.   // get list of non-visible dock clients
  9294.   NonVisList := TStringList.Create;
  9295.   try
  9296.     for I := 0 to FDockSite.DockClientCount - 1 do
  9297.     begin
  9298.       Ctl := FDockSite.DockClients[I];
  9299.       if (not Ctl.Visible) and (Ctl.Name <> '') then
  9300.         NonVisList.Add(Ctl.Name);
  9301.     end;
  9302.     // write non-visible dock client list
  9303.     NVCount := NonVisList.Count;
  9304.     Stream.Write(NVCount, SizeOf(NVCount));
  9305.     for I := 0 to NVCount - 1 do WriteControlName(NonVisList[I]);
  9306.   finally
  9307.     NonVisList.Free;
  9308.   end;
  9309.   // write top zone data
  9310.   Stream.Write(FTopXYLimit, SizeOf(FTopXYLimit));
  9311.   // write all zones from tree
  9312.   DoSaveZone(FTopZone, 0);
  9313.   Stream.Write(TreeStreamEndFlag, SizeOf(TreeStreamEndFlag));
  9314. end;
  9315.  
  9316. procedure TDockTree.SetNewBounds(Zone: TDockZone);
  9317.  
  9318.   procedure DoSetNewBounds(Zone: TDockZone);
  9319.   begin
  9320.     if Zone <> nil then
  9321.     begin
  9322.       if (Zone.FNextSibling = nil) and (Zone <> FTopZone) then
  9323.       begin
  9324.         if Zone.FParentZone = FTopZone then Zone.FZoneLimit := FTopXYLimit
  9325.         else Zone.FZoneLimit := Zone.FParentZone.FParentZone.FZoneLimit;
  9326.       end;
  9327.       if Zone.FChildZones <> nil then DoSetNewBounds(Zone.FChildZones);
  9328.       if Zone.FNextSibling <> nil then DoSetNewBounds(Zone.FNextSibling);
  9329.     end;
  9330.   end;
  9331.  
  9332. begin
  9333.   if Zone = nil then Zone := FTopZone.FChildZones;
  9334.   DoSetNewBounds(Zone);
  9335.   { Redraw client dock frames }
  9336.   FDockSite.Invalidate;
  9337. end;
  9338.  
  9339. procedure TDockTree.SetReplacingControl(Control: TControl);
  9340. begin
  9341.   FReplacementZone := FindControlZone(Control);
  9342. end;
  9343.  
  9344. procedure TDockTree.ShiftZone(Zone: TDockZone);
  9345. begin
  9346.   if (Zone <> nil) and (Zone <> FTopZone) and
  9347.     (Zone.FParentZone.FOrientation = FShiftScaleOrient) then
  9348.     Inc(Zone.FZoneLimit, FShiftBy);
  9349. end;
  9350.  
  9351. procedure TDockTree.SplitterMouseDown(OnZone: TDockZone; MousePos: TPoint);
  9352. begin
  9353.   FSizingZone := OnZone;
  9354.   Mouse.Capture := FDockSite.Handle;
  9355.   FSizingWnd := FDockSite.Handle;
  9356.   FSizingDC := GetDCEx(FSizingWnd, 0, DCX_CACHE or DCX_CLIPSIBLINGS or
  9357.     DCX_LOCKWINDOWUPDATE);
  9358.   FSizePos := MousePos;
  9359.   DrawSizeSplitter;
  9360. end;
  9361.  
  9362. procedure TDockTree.SplitterMouseUp;
  9363. begin
  9364.   Mouse.Capture := 0;
  9365.   DrawSizeSplitter;
  9366.   ReleaseDC(FSizingWnd, FSizingDC);
  9367.   if FSizingZone.FParentZone.FOrientation = doHorizontal then
  9368.     FSizingZone.FZoneLimit := FSizePos.y + (FBorderWidth div 2) else
  9369.     FSizingZone.FZoneLimit := FSizePos.x + (FBorderWidth div 2);
  9370.   SetNewBounds(FSizingZone.FParentZone);
  9371.   ForEachAt(FSizingZone.FParentZone, UpdateZone);
  9372.   FSizingZone := nil;
  9373. end;
  9374.  
  9375. procedure TDockTree.UpdateAll;
  9376. begin
  9377.   if (FUpdateCount = 0) and (FDockSite.DockClientCount > 0) then
  9378.     ForEachAt(nil, UpdateZone);
  9379. end;
  9380.  
  9381. procedure TDockTree.UpdateZone(Zone: TDockZone);
  9382. begin
  9383.   if FUpdateCount = 0 then Zone.Update;
  9384. end;
  9385.  
  9386. procedure TDockTree.DrawSizeSplitter;
  9387. var
  9388.   R: TRect;
  9389.   PrevBrush: HBrush;
  9390. begin
  9391.   if FSizingZone <> nil then
  9392.   begin
  9393.     with R do
  9394.     begin
  9395.       if FSizingZone.FParentZone.FOrientation = doHorizontal then
  9396.       begin
  9397.         Left := FSizingZone.Left;
  9398.         Top := FSizePos.Y - (FBorderWidth div 2);
  9399.         Right := Left + FSizingZone.Width;
  9400.         Bottom := Top + FBorderWidth;
  9401.       end
  9402.       else begin
  9403.         Left := FSizePos.X - (FBorderWidth div 2);
  9404.         Top := FSizingZone.Top;
  9405.         Right := Left + FBorderWidth;
  9406.         Bottom := Top + FSizingZone.Height;
  9407.       end;
  9408.     end;
  9409.     PrevBrush := SelectObject(FSizingDC, FBrush.Handle);
  9410.     with R do
  9411.       PatBlt(FSizingDC, Left, Top, Right - Left, Bottom - Top, PATINVERT);
  9412.     SelectObject(FSizingDC, PrevBrush);
  9413.   end;
  9414. end;
  9415.  
  9416. function TDockTree.GetNextLimit(AZone: TDockZone): Integer;
  9417. var
  9418.   LimitResult: Integer;
  9419.  
  9420.   function Min(I1, I2: Integer): Integer;
  9421.   begin
  9422.     if I1 > I2 then Result := I2
  9423.     else Result := I1;
  9424.   end;
  9425.  
  9426.   procedure DoGetNextLimit(Zone: TDockZone);
  9427.   begin
  9428.     if (Zone <> AZone) and
  9429.       (Zone.FParentZone.FOrientation = AZone.FParentZone.FOrientation) and
  9430.       (Zone.FZoneLimit > AZone.FZoneLimit) and ((Zone.FChildControl = nil) or
  9431.       ((Zone.FChildControl <> nil) and (Zone.FChildControl.Visible))) then
  9432.       LimitResult := Min(LimitResult, Zone.FZoneLimit);
  9433.     if Zone.FNextSibling <> nil then DoGetNextLimit(Zone.FNextSibling);
  9434.     if Zone.FChildZones <> nil then DoGetNextLimit(Zone.FChildZones);
  9435.   end;
  9436.  
  9437. begin
  9438.   if AZone.FNextSibling <> nil then
  9439.     LimitResult := AZone.FNextSibling.FZoneLimit
  9440.   else
  9441.     LimitResult := AZone.FZoneLimit + AZone.LimitSize;
  9442.   DoGetNextLimit(FTopZone.FChildZones);
  9443.   Result := LimitResult;
  9444. end;
  9445.  
  9446. procedure TDockTree.ControlVisibilityChanged(Control: TControl;
  9447.   Visible: Boolean);
  9448.  
  9449.   function GetDockAlign(Client, DropCtl: TControl): TAlign;
  9450.   var
  9451.     CRect, DRect: TRect;
  9452.   begin
  9453.     Result := alRight;
  9454.     if DropCtl <> nil then
  9455.     begin
  9456.       CRect := Client.BoundsRect;
  9457.       DRect := DropCtl.BoundsRect;
  9458.       if (CRect.Top <= DRect.Top) and (CRect.Bottom < DRect.Bottom) and
  9459.          (CRect.Right >= DRect.Right) then
  9460.         Result := alTop
  9461.       else if (CRect.Left <= DRect.Left) and (CRect.Right < DRect.Right) and
  9462.          (CRect.Bottom >= DRect.Bottom) then
  9463.         Result := alLeft
  9464.       else if CRect.Top >= ((DRect.Top + DRect.Bottom) div 2) then
  9465.         Result := alBottom;
  9466.     end;
  9467.   end;
  9468.  
  9469. var
  9470.   HitTest: Integer;
  9471.   DropCtlZone: TDockZone;
  9472.   DropCtl: TControl;
  9473. begin
  9474.   if Visible then
  9475.   begin
  9476.     if FindControlZone(Control) = nil then
  9477.     begin
  9478.       DropCtlZone := InternalHitTest(Point(Control.Left, Control.Top), HitTest);
  9479.       if DropCtlZone <> nil then DropCtl := DropCtlZone.FChildControl
  9480.       else DropCtl := nil;
  9481.       InsertControl(Control, GetDockAlign(Control, DropCtl), DropCtl);
  9482.     end;
  9483.   end
  9484.   else
  9485.     RemoveControl(Control)
  9486. end;
  9487.  
  9488. procedure TDockTree.WindowProc(var Message: TMessage);
  9489.  
  9490.   procedure CalcSplitterPos;
  9491.   var
  9492.     MinWidth,
  9493.     TestLimit: Integer;
  9494.   begin
  9495.     MinWidth := FGrabberSize;
  9496.     if (FSizingZone.FParentZone.FOrientation = doHorizontal) then
  9497.     begin
  9498.       TestLimit := FSizingZone.Top + MinWidth;
  9499.       if FSizePos.y <= TestLimit then FSizePos.y := TestLimit;
  9500.       TestLimit := GetNextLimit(FSizingZone) - MinWidth;
  9501.       if FSizePos.y >= TestLimit then FSizePos.y := TestLimit;
  9502.     end
  9503.     else begin
  9504.       TestLimit := FSizingZone.Left + MinWidth;
  9505.       if FSizePos.x <= TestLimit then FSizePos.x := TestLimit;
  9506.       TestLimit := GetNextLimit(FSizingZone) - MinWidth;
  9507.       if FSizePos.x >= TestLimit then FSizePos.x := TestLimit;
  9508.     end;
  9509.   end;
  9510.  
  9511. const
  9512.   SizeCursors: array[TDockOrientation] of TCursor = (crDefault, crVSplit, crHSplit);
  9513. var
  9514.   TempZone: TDockZone;
  9515.   Control: TControl;
  9516.   P: TPoint;
  9517.   R: TRect;
  9518.   HitTestValue: Integer;
  9519.   Msg: TMsg;
  9520. begin
  9521.   case Message.Msg of
  9522.     CM_DOCKNOTIFICATION:
  9523.       with TCMDockNotification(Message) do
  9524.         if (NotifyRec.ClientMsg = CM_VISIBLECHANGED) then
  9525.           ControlVisibilityChanged(Client, Boolean(NotifyRec.MsgWParam));
  9526.     WM_MOUSEMOVE:
  9527.       if FSizingZone <> nil then
  9528.       begin
  9529.         DrawSizeSplitter;
  9530.         FSizePos := SmallPointToPoint(TWMMouse(Message).Pos);
  9531.         CalcSplitterPos;
  9532.         DrawSizeSplitter;
  9533.       end;
  9534.     WM_LBUTTONDBLCLK:
  9535.       begin
  9536.         TempZone := InternalHitTest(SmallPointToPoint(TWMMouse(Message).Pos),
  9537.           HitTestValue);
  9538.         if TempZone <> nil then
  9539.           with TempZone do
  9540.             if (FChildControl <> nil) and (HitTestValue = HTCAPTION) then
  9541.             begin
  9542.               CancelDrag;
  9543.               FChildControl.ManualDock(nil, nil, alTop);
  9544.             end;
  9545.       end;
  9546.     WM_LBUTTONDOWN:
  9547.       begin
  9548.         P := SmallPointToPoint(TWMMouse(Message).Pos);
  9549.         TempZone := InternalHitTest(P, HitTestValue);
  9550.         if (TempZone <> nil) then
  9551.         begin
  9552.           if HitTestValue = HTBORDER then
  9553.             SplitterMouseDown(TempZone, P)
  9554.           else if HitTestValue = HTCAPTION then
  9555.           begin
  9556.             if (not PeekMessage(Msg, FDockSite.Handle, WM_LBUTTONDBLCLK,
  9557.               WM_LBUTTONDBLCLK, PM_NOREMOVE)) and
  9558.               (TempZone.FChildControl is TWinControl) then
  9559.               TWinControl(TempZone.FChildControl).SetFocus;
  9560.         if (TempZone.FChildControl.DragKind = dkDock) and
  9561.               (TempZone.FChildControl.DragMode = dmAutomatic)then
  9562.                 TempZone.FChildControl.BeginDrag(False);
  9563.         Exit;
  9564.           end;
  9565.         end;
  9566.       end;
  9567.     WM_LBUTTONUP:
  9568.       if FSizingZone = nil then
  9569.       begin
  9570.         P := SmallPointToPoint(TWMMouse(Message).Pos);
  9571.         TempZone := InternalHitTest(P, HitTestValue);
  9572.         if (TempZone <> nil) and (HitTestValue = HTCLOSE) then
  9573.         begin
  9574.           if TempZone.FChildControl is TCustomForm then
  9575.             TCustomForm(TempZone.FChildControl).Close
  9576.           else
  9577.             TempZone.FChildControl.Visible := False;
  9578.         end;
  9579.       end
  9580.       else
  9581.         SplitterMouseUp;
  9582.     WM_SETCURSOR:
  9583.       begin
  9584.         GetCursorPos(P);
  9585.         P := FDockSite.ScreenToClient(P);
  9586.         with TWMSetCursor(Message) do
  9587.           if (Smallint(HitTest) = HTCLIENT) and (CursorWnd = FDockSite.Handle)
  9588.             and (FDockSite.VisibleDockClientCount > 0) then
  9589.           begin
  9590.             TempZone := InternalHitTest(P, HitTestValue);
  9591.             if (TempZone <> nil) and (HitTestValue = HTBORDER) then
  9592.             begin
  9593.               Windows.SetCursor(Screen.Cursors[SizeCursors[TempZone.FParentZone.FOrientation]]);
  9594.               Result := 1;
  9595.               Exit;
  9596.             end;
  9597.           end;
  9598.       end;
  9599.     CM_HINTSHOW:
  9600.       with TCMHintShow(Message) do
  9601.       begin
  9602.         FOldWndProc(Message);
  9603.         if Result = 0 then
  9604.         begin
  9605.           Control := HitTest(HintInfo^.CursorPos, HitTestValue);
  9606.           if HitTestValue = HTBORDER then
  9607.             HintInfo^.HintStr := ''
  9608.           else if (Control <> nil) and (HitTestValue in [HTCAPTION, HTCLOSE]) then
  9609.           begin
  9610.             R := Control.BoundsRect;
  9611.             AdjustDockRect(Control, R);
  9612.             Dec(R.Left, 2 * (R.Left - Control.Left));
  9613.             Dec(R.Top, 2 * (R.Top - Control.Top));
  9614.             Dec(R.Right, 2 * (Control.Width - (R.Right - R.Left)));
  9615.             Dec(R.Bottom, 2 * (Control.Height - (R.Bottom - R.Top)));
  9616.             HintInfo^.HintStr := Control.Caption;
  9617.             HintInfo^.CursorRect := R;
  9618.           end;
  9619.         end;
  9620.         Exit;
  9621.       end;
  9622.   end;
  9623.   FOldWndProc(Message);
  9624. end;
  9625.  
  9626. { TMouse }
  9627.  
  9628. constructor TMouse.Create;
  9629. begin
  9630.   inherited Create;
  9631.   FDragImmediate := True;
  9632.   FDragThreshold := 5;
  9633.   // Mouse wheel is natively supported on Windows 98 and higher
  9634.   // and Windows NT 4.0 and higher.
  9635.   FNativeWheelSupport :=
  9636.     ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 4)) or
  9637.     ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
  9638.     ((Win32MajorVersion > 4) or
  9639.     ((Win32MajorVersion = 4) and (Win32MinorVersion >= 10))));
  9640.   SettingChanged(0);
  9641. end;
  9642.  
  9643. destructor TMouse.Destroy;
  9644. begin
  9645.   Capture := 0;
  9646.   inherited Destroy;
  9647. end;
  9648.  
  9649. function TMouse.GetCapture: HWND;
  9650. begin
  9651.   Result := Windows.GetCapture;
  9652. end;
  9653.  
  9654. function TMouse.GetCursorPos: TPoint;
  9655. begin
  9656.   Win32Check(Windows.GetCursorPos(Result));
  9657. end;
  9658.  
  9659. procedure TMouse.GetMouseData;
  9660. begin
  9661.   FMousePresent := BOOL(GetSystemMetrics(SM_MOUSEPRESENT));
  9662. end;
  9663.  
  9664. procedure TMouse.GetNativeData;
  9665. begin
  9666.   FWheelPresent := BOOL(GetSystemMetrics(SM_MOUSEWHEELPRESENT));
  9667.   if FWheelPresent then
  9668.     SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @FScrollLines, 0);
  9669. end;
  9670.  
  9671. procedure TMouse.GetRegisteredData;
  9672. var
  9673.   HasWheel: BOOL;
  9674. begin
  9675.   FWheelHwnd := HwndMsWheel(FWheelMessage, FWheelSupportMessage,
  9676.     FScrollLinesMessage, HasWheel, FScrollLines);
  9677.   FWheelPresent := FWheelMessage <> 0;
  9678. end;
  9679.  
  9680. procedure TMouse.SetCapture(const Value: HWND);
  9681. begin
  9682.   if Capture <> Value then
  9683.   begin
  9684.     if Value = 0 then ReleaseCapture
  9685.     else Windows.SetCapture(Value);
  9686.   end;
  9687. end;
  9688.  
  9689. procedure TMouse.SetCursorPos(const Value: TPoint);
  9690. begin
  9691.   Win32Check(Windows.SetCursorPos(Value.x, Value.y));
  9692. end;
  9693.  
  9694. procedure TMouse.SettingChanged(Setting: Integer);
  9695. begin
  9696.   case Setting of
  9697.     0:
  9698.       begin
  9699.         GetMouseData;
  9700.         if not FNativeWheelSupport then GetRegisteredData
  9701.         else GetNativeData;
  9702.       end;
  9703.     SPI_GETWHEELSCROLLLINES:
  9704.       if FWheelPresent then
  9705.       begin
  9706.         if FNativeWheelSupport then
  9707.           SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @FScrollLines, 0)
  9708.         else
  9709.           FScrollLines := SendMessage(FWheelHwnd, FScrollLinesMessage, 0, 0)
  9710.       end;
  9711.   end;
  9712. end;
  9713.  
  9714. { Input Method Editor (IME) support code }
  9715.  
  9716. var
  9717.   IMM32DLL: THandle = 0;
  9718.   _WINNLSEnableIME: function(hwnd: HWnd; bool: LongBool): Boolean stdcall;
  9719.   _ImmGetContext: function(hWnd: HWND): HIMC stdcall;
  9720.   _ImmReleaseContext: function(hWnd: HWND; hImc: HIMC): Boolean stdcall;
  9721.   _ImmGetConversionStatus: function(hImc: HIMC; var Conversion, Sentence: DWORD): Boolean stdcall;
  9722.   _ImmSetConversionStatus: function(hImc: HIMC; Conversion, Sentence: DWORD): Boolean stdcall;
  9723.   _ImmSetOpenStatus: function(hImc: HIMC; fOpen: Boolean): Boolean stdcall;
  9724.   _ImmSetCompositionWindow: function(hImc: HIMC; lpCompForm: PCOMPOSITIONFORM): Boolean stdcall;
  9725.   _ImmSetCompositionFont: function(hImc: HIMC; lpLogfont: PLOGFONTA): Boolean stdcall;
  9726.   _ImmGetCompositionString: function(hImc: HIMC; dWord1: DWORD; lpBuf: pointer; dwBufLen: DWORD): Longint stdcall;
  9727.   _ImmIsIME: function(hKl: HKL): Boolean stdcall;
  9728.   _ImmNotifyIME: function(hImc: HIMC; dwAction, dwIndex, dwValue: DWORD): Boolean stdcall;
  9729.  
  9730. procedure InitIMM32;
  9731. var
  9732.   UserHandle: THandle;
  9733.   OldError: Longint;
  9734. begin
  9735.   if not Syslocale.FarEast then Exit;
  9736.   OldError := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  9737.   try
  9738.     if not Assigned(_WINNLSEnableIME) then
  9739.     begin
  9740.       UserHandle := GetModuleHandle('USER32');
  9741.       @_WINNLSEnableIME := GetProcAddress(UserHandle, 'WINNLSEnableIME');
  9742.     end;
  9743.  
  9744.     if IMM32DLL = 0 then
  9745.     begin
  9746.       IMM32DLL := LoadLibrary('IMM32.DLL');
  9747.       if IMM32DLL <> 0 then
  9748.       begin
  9749.         @_ImmGetContext := GetProcAddress(IMM32DLL, 'ImmGetContext');
  9750.         @_ImmReleaseContext := GetProcAddress(IMM32DLL, 'ImmReleaseContext');
  9751.         @_ImmGetConversionStatus := GetProcAddress(IMM32DLL, 'ImmGetConversionStatus');
  9752.         @_ImmSetConversionStatus := GetProcAddress(IMM32DLL, 'ImmSetConversionStatus');
  9753.         @_ImmSetOpenStatus := GetProcAddress(IMM32DLL, 'ImmSetOpenStatus');
  9754.         @_ImmSetCompositionWindow := GetProcAddress(IMM32DLL, 'ImmSetCompositionWindow');
  9755.         @_ImmSetCompositionFont := GetProcAddress(IMM32DLL, 'ImmSetCompositionFontA');
  9756.         @_ImmGetCompositionString := GetProcAddress(IMM32DLL, 'ImmGetCompositionStringA');
  9757.         @_ImmIsIME := GetProcAddress(IMM32DLL, 'ImmIsIME');
  9758.         @_ImmNotifyIME := GetProcAddress(IMM32DLL, 'ImmNotifyIME');
  9759.       end;
  9760.     end;
  9761.   finally
  9762.     SetErrorMode(OldError);
  9763.   end;
  9764. end;
  9765.  
  9766. function Win32NLSEnableIME(hWnd: HWnd; Enable: Boolean): Boolean;
  9767. begin
  9768.   if Assigned(_WINNLSEnableIME) then
  9769.     Result := _WINNLSEnableIME(hWnd, Enable)
  9770.   else
  9771.     Result := False;
  9772. end;
  9773.  
  9774. procedure SetImeMode(hWnd: HWnd; Mode: TImeMode);
  9775. const
  9776.   ModeMap: array [imSAlpha..imHanguel] of Byte =  // flags in use are all < 255
  9777.     ( { imSAlpha: } IME_CMODE_ALPHANUMERIC,
  9778.       { imAlpha:  } IME_CMODE_ALPHANUMERIC or IME_CMODE_FULLSHAPE,
  9779.       { imHira:   } IME_CMODE_NATIVE or IME_CMODE_FULLSHAPE,
  9780.       { imSKata:  } IME_CMODE_NATIVE or IME_CMODE_KATAKANA,
  9781.       { imKata:   } IME_CMODE_NATIVE or IME_CMODE_KATAKANA or IME_CMODE_FULLSHAPE,
  9782.       { imChinese:} IME_CMODE_NATIVE or IME_CMODE_FULLSHAPE,
  9783.       { imSHanguel} IME_CMODE_NATIVE,
  9784.       { imHanguel } IME_CMODE_NATIVE or IME_CMODE_FULLSHAPE );
  9785. var
  9786.   IMC: HIMC;
  9787.   Conv, Sent: DWORD;
  9788. begin
  9789.   if (not SysLocale.FarEast) or (Mode = imDontCare) then Exit;
  9790.  
  9791.   if Mode = imDisable then
  9792.   begin
  9793.     Win32NLSEnableIME(hWnd, FALSE);
  9794.     Exit;
  9795.   end;
  9796.  
  9797.   Win32NLSEnableIME(hWnd, TRUE);
  9798.  
  9799.   if IMM32DLL = 0 then Exit;
  9800.  
  9801.   IMC := _ImmGetContext(hWnd);
  9802.   if IMC = 0 then Exit;
  9803.  
  9804.   _ImmGetConversionStatus(IMC, Conv, Sent);
  9805.  
  9806.   case Mode of
  9807.     imClose: _ImmSetOpenStatus(IMC, FALSE);
  9808.     imOpen : _ImmSetOpenStatus(IMC, TRUE);
  9809.   else
  9810.     _ImmSetOpenStatus(IMC, TRUE);
  9811.     _ImmGetConversionStatus(IMC, Conv, Sent);
  9812.     Conv := Conv and
  9813.      (not(IME_CMODE_LANGUAGE or IME_CMODE_FULLSHAPE)) or ModeMap[Mode];
  9814.   end;
  9815.   _ImmSetConversionStatus(IMC, Conv, Sent);
  9816.   _ImmReleaseContext(hWnd, IMC);
  9817. end;
  9818.  
  9819. procedure SetImeName(Name: TImeName);
  9820. var
  9821.   I: Integer;
  9822.   HandleToSet: HKL;
  9823. begin
  9824.   if not SysLocale.FarEast then Exit;
  9825.   if (Name <> '') and (Screen.Imes.Count <> 0) then
  9826.   begin
  9827.     HandleToSet := Screen.DefaultKbLayout;
  9828.     I := Screen.Imes.IndexOf(Name);
  9829.     if I >= 0 then HandleToSet := HKL(Screen.Imes.Objects[I]);
  9830.     ActivateKeyboardLayout(HandleToSet, KLF_ACTIVATE);
  9831.   end;
  9832. end;
  9833.  
  9834. function Imm32GetContext(hWnd: HWND): HIMC;
  9835. begin
  9836.   if IMM32DLL <> 0 then
  9837.     Result := _ImmGetContext(hWnd)
  9838.   else
  9839.     Result := 0;
  9840. end;
  9841.  
  9842. function Imm32ReleaseContext(hWnd: HWND; hImc: HIMC): Boolean;
  9843. begin
  9844.   if IMM32DLL <> 0 then
  9845.     Result := _ImmReleaseContext(hWnd, hImc)
  9846.   else
  9847.     Result := False;
  9848. end;
  9849.  
  9850. function Imm32GetConversionStatus(hImc: HIMC; var Conversion, Sentence: DWORD): Boolean;
  9851. begin
  9852.   if IMM32DLL <> 0 then
  9853.     Result := _ImmGetConversionStatus(hImc, Conversion, Sentence)
  9854.   else
  9855.     Result := False;
  9856. end;
  9857.  
  9858. function Imm32SetConversionStatus(hImc: HIMC; Conversion, Sentence: DWORD): Boolean;
  9859. begin
  9860.   if IMM32DLL <> 0 then
  9861.     Result := _ImmSetConversionStatus(hImc, Conversion, Sentence)
  9862.   else
  9863.     Result := False;
  9864. end;
  9865.  
  9866. function Imm32SetOpenStatus(hImc: HIMC; fOpen: Boolean): Boolean;
  9867. begin
  9868.   if IMM32DLL <> 0 then
  9869.     Result := _ImmSetOpenStatus(hImc, fOpen)
  9870.   else
  9871.     Result := False;
  9872. end;
  9873.  
  9874. function Imm32SetCompositionWindow(hImc: HIMC; lpCompForm: PCOMPOSITIONFORM): Boolean;
  9875. begin
  9876.   if IMM32DLL <> 0 then
  9877.     Result := _ImmSetCompositionWindow(hImc, lpCompForm)
  9878.   else
  9879.     Result := False;
  9880. end;
  9881.  
  9882. function Imm32SetCompositionFont(hImc: HIMC; lpLogfont: PLOGFONTA): Boolean;
  9883. begin
  9884.   if IMM32DLL <> 0 then
  9885.     Result := _ImmSetCompositionFont(hImc, lpLogFont)
  9886.   else
  9887.     Result := False;
  9888. end;
  9889.  
  9890. function Imm32GetCompositionString(hImc: HIMC; dWord1: DWORD; lpBuf: pointer; dwBufLen: DWORD): Longint;
  9891. begin
  9892.   if IMM32DLL <> 0 then
  9893.     Result := _ImmGetCompositionString(hImc, dWord1, lpBuf, dwBufLen)
  9894.   else
  9895.     Result := 0;
  9896. end;
  9897.  
  9898. function Imm32IsIME(hKl: HKL): Boolean;
  9899. begin
  9900.   if IMM32DLL <> 0 then
  9901.     Result := _ImmIsIME(hKl)
  9902.   else
  9903.     Result := False;
  9904. end;
  9905.  
  9906. function Imm32NotifyIME(hImc: HIMC; dwAction, dwIndex, dwValue: DWORD): Boolean;
  9907. begin
  9908.   if IMM32DLL <> 0 then
  9909.     Result := _ImmNotifyIME(hImc, dwAction, dwIndex, dwValue)
  9910.   else
  9911.     Result := False;
  9912. end;
  9913.  
  9914. { Initialization and cleanup }
  9915.  
  9916. procedure DoneControls;
  9917. begin
  9918.   Application.Free;
  9919.   Application := nil;
  9920.   Screen.Free;
  9921.   Screen := nil;
  9922.   Mouse.Free;
  9923.   Mouse := nil;
  9924.   CanvasList.Free;
  9925.   GlobalDeleteAtom(ControlAtom);
  9926.   GlobalDeleteAtom(WindowAtom);
  9927.   if IMM32DLL <> 0 then FreeLibrary(IMM32DLL);
  9928. end;
  9929.  
  9930. procedure InitControls;
  9931. var
  9932.   AtomText: array[0..31] of Char;
  9933. begin
  9934.   WindowAtom := GlobalAddAtom(StrFmt(AtomText, 'Delphi%.8X',
  9935.     [GetCurrentProcessID]));
  9936.   ControlAtom := GlobalAddAtom(
  9937.     StrFmt(AtomText, 'ControlOfs%.8X%.8X', [HInstance, GetCurrentThreadID]));
  9938.   CanvasList := TThreadList.Create;
  9939.   InitIMM32;
  9940.   Mouse := TMouse.Create;
  9941.   Screen := TScreen.Create(nil);
  9942.   Application := TApplication.Create(nil);
  9943.   InitCtl3D;
  9944.   Application.ShowHint := True;
  9945.   RegisterIntegerConsts(TypeInfo(TCursor), IdentToCursor, CursorToIdent);
  9946. end;
  9947.  
  9948. initialization
  9949.   NewStyleControls := Lo(GetVersion) >= 4;
  9950.   InitControls;
  9951.  
  9952. finalization
  9953.   DockSiteList.Free;
  9954.   DoneControls;
  9955.  
  9956. end.
  9957.