home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d23456 / TB97.ZIP / Source / TB97.pas < prev    next >
Pascal/Delphi Source File  |  2001-01-05  |  158KB  |  4,520 lines
  1. unit TB97;
  2.  
  3. {
  4.   Toolbar97
  5.   Copyright (C) 1998-2001 by Jordan Russell
  6.   For conditions of distribution and use, see LICENSE.TXT.
  7.  
  8.   e-mail:     jr@jrsoftware.org
  9.   home page:  http://www.jrsoftware.org/
  10.               (alternate address: http://www.jordanr.cjb.net/)
  11.  
  12.   *PLEASE NOTE*  Before making any bug reports please first verify you are
  13.                  using the latest version by checking my home page. And if
  14.                  you do report a bug, please, if applicable, include a code
  15.                  sample.
  16.  
  17.   Notes:
  18.   - I cannot support modified versions of this code. So if you encounter a
  19.     possible bug while using a modified version, always first revert back to
  20.     the my original code before making an attempt to contact me.
  21.   - While debugging the toolbar code you might want to enable the
  22.     'TB97DisableLock' conditional define, as described below.
  23.   - In the WM_NCPAINT handlers, GetWindowRect is used to work around a possible
  24.     VCL problem. The Width, Height, and BoundsRect properties are sometimes
  25.     wrong. So it avoids any use of these properties in the WM_NCPAINT handlers.
  26.   - In case you are unsure of its meaning, NewStyleControls is a VCL variable
  27.     set to True at application startup if the user is running Windows 95 or NT
  28.     4.0 or later.
  29.  
  30.   $Id: TB97.pas,v 1.4 2001/01/04 04:17:14 jr Exp $
  31. }
  32.  
  33. {x$DEFINE TB97DisableLock}
  34. { Remove the 'x' to enable the define. It will disable calls to
  35.   LockWindowUpdate, which it calls to disable screen updates while dragging.
  36.   You should temporarily enable that while debugging so you are able to see
  37.   your code window if you have something like a breakpoint that's set inside
  38.   the dragging routines }
  39.  
  40. {$I TB97Ver.inc}
  41.  
  42. interface
  43.  
  44. uses
  45.   Windows, Messages, Classes, Controls, Forms, Graphics,
  46.   TB97Vers;
  47.  
  48. const
  49.   WM_TB97PaintDockedNCArea = WM_USER + 5039;    { used internally }
  50.   WM_TB97PaintFloatingNCArea = WM_USER + 5040;  { used internally }
  51.  
  52. type
  53.   { TDock97 }
  54.  
  55.   TDockBoundLinesValues = (blTop, blBottom, blLeft, blRight);
  56.   TDockBoundLines = set of TDockBoundLinesValues;
  57.   TDockPosition = (dpTop, dpBottom, dpLeft, dpRight);
  58.   TDockType = (dtNotDocked, dtTopBottom, dtLeftRight);
  59.   TDockableTo = set of TDockPosition;
  60.  
  61.   TCustomToolWindow97 = class;
  62.  
  63.   TInsertRemoveEvent = procedure(Sender: TObject; Inserting: Boolean;
  64.     Bar: TCustomToolWindow97) of object;
  65.   TRequestDockEvent = procedure(Sender: TObject; Bar: TCustomToolWindow97;
  66.     var Accept: Boolean) of object;
  67.  
  68.   TDock97 = class(TCustomControl)
  69.   private
  70.     { Property values }
  71.     FPosition: TDockPosition;
  72.     FAllowDrag: Boolean;
  73.     FBoundLines: TDockBoundLines;
  74.     FBkg, FBkgCache: TBitmap;
  75.     FBkgTransparent, FBkgOnToolbars: Boolean;
  76.     FFixAlign: Boolean;
  77.     FLimitToOneRow: Boolean;
  78.     FOnInsertRemoveBar: TInsertRemoveEvent;
  79.     FOnRequestDock: TRequestDockEvent;
  80.     FOnResize: TNotifyEvent;
  81.  
  82.     { Internal }
  83.     FDisableArrangeToolbars: Integer;  { Increment to disable ArrangeToolbars }
  84.     FArrangeToolbarsNeeded, FArrangeToolbarsClipPoses: Boolean;
  85.     FNonClientWidth, FNonClientHeight: Integer;
  86.     DockList: TList;  { List of the toolbars docked, and those floating and have LastDock
  87.                         pointing to the dock. Items are casted in TCustomToolWindow97's. }
  88.     DockVisibleList: TList;  { Similar to DockList, but lists only docked and visible toolbars }
  89.     RowSizes: TList;  { List of the width or height of each row, depending on what Position
  90.                         is set to. Items are casted info Longint's }
  91.  
  92.     { Property access methods }
  93.     function GetVersion: TToolbar97Version;
  94.     procedure SetAllowDrag (Value: Boolean);
  95.     procedure SetBackground (Value: TBitmap);
  96.     procedure SetBackgroundOnToolbars (Value: Boolean);
  97.     procedure SetBackgroundTransparent (Value: Boolean);
  98.     procedure SetBoundLines (Value: TDockBoundLines);
  99.     procedure SetFixAlign (Value: Boolean);
  100.     procedure SetPosition (Value: TDockPosition);
  101.     procedure SetVersion (const Value: TToolbar97Version);
  102.  
  103.     function GetToolbarCount: Integer;
  104.     function GetToolbars (Index: Integer): TCustomToolWindow97;
  105.  
  106.     { Internal }
  107.     procedure ArrangeToolbars (const ClipPoses: Boolean);
  108.     procedure BackgroundChanged (Sender: TObject);
  109.     procedure BuildRowInfo;
  110.     procedure ChangeDockList (const Insert: Boolean; const Bar: TCustomToolWindow97);
  111.     procedure ChangeWidthHeight (const NewWidth, NewHeight: Integer);
  112.     procedure DrawBackground (const DC: HDC;
  113.       const IntersectClippingRect: TRect; const ExcludeClippingRect: PRect;
  114.       const DrawRect: TRect);
  115.     procedure DrawNCArea (const DrawToDC: Boolean; const ADC: HDC;
  116.       const Clip: HRGN);
  117.     function GetDesignModeRowOf (const XY: Integer): Integer;
  118.     function GetNumberOfToolbarsOnRow (const Row: Integer;
  119.       const NotIncluding: TCustomToolWindow97): Integer;
  120.     function GetRowOf (const XY: Integer; var Before: Boolean): Integer;
  121.     function HasVisibleToolbars: Boolean;
  122.     procedure InsertRowBefore (const BeforeRow: Integer);
  123.     procedure InvalidateBackgrounds;
  124.     procedure RemoveBlankRows;
  125.     function ToolbarVisibleOnDock (const AToolbar: TCustomToolWindow97): Boolean;
  126.     procedure ToolbarVisibilityChanged (const Bar: TCustomToolWindow97;
  127.       const ForceRemove: Boolean);
  128.     function UsingBackground: Boolean;
  129.  
  130.     { Messages }
  131.     procedure CMColorChanged (var Message: TMessage); message CM_COLORCHANGED;
  132.     procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
  133.     procedure WMMove (var Message: TWMMove); message WM_MOVE;
  134.     procedure WMSize (var Message: TWMSize); message WM_SIZE;
  135.     procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  136.     procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
  137.     procedure WMPrint (var Message: TMessage); message WM_PRINT;
  138.     procedure WMPrintClient (var Message: TMessage); message WM_PRINTCLIENT;
  139.   protected
  140.     procedure AlignControls (AControl: TControl; var Rect: TRect); override;
  141.     function GetPalette: HPALETTE; override;
  142.     procedure Loaded; override;
  143.     procedure Notification (AComponent: TComponent; Operation: TOperation); override;
  144.     procedure SetParent (AParent: TWinControl); override;
  145.     procedure Paint; override;
  146.   public
  147.     constructor Create (AOwner: TComponent); override;
  148.     procedure CreateParams (var Params: TCreateParams); override;
  149.     destructor Destroy; override;
  150.  
  151.     procedure BeginUpdate;
  152.     procedure EndUpdate;
  153.     function GetHighestRow: Integer;
  154.     function GetRowSize (const Row: Integer;
  155.       const DefaultToolbar: TCustomToolWindow97): Integer;
  156.  
  157.     property NonClientWidth: Integer read FNonClientWidth;
  158.     property NonClientHeight: Integer read FNonClientHeight;
  159.     property ToolbarCount: Integer read GetToolbarCount;
  160.     property Toolbars[Index: Integer]: TCustomToolWindow97 read GetToolbars;
  161.   published
  162.     property AllowDrag: Boolean read FAllowDrag write SetAllowDrag default True;
  163.     property Background: TBitmap read FBkg write SetBackground;
  164.     property BackgroundOnToolbars: Boolean read FBkgOnToolbars write SetBackgroundOnToolbars default True;
  165.     property BackgroundTransparent: Boolean read FBkgTransparent write SetBackgroundTransparent default False;
  166.     property BoundLines: TDockBoundLines read FBoundLines write SetBoundLines default [];
  167.     property Color default clBtnFace;
  168.     property FixAlign: Boolean read FFixAlign write SetFixAlign default False;
  169.     property LimitToOneRow: Boolean read FLimitToOneRow write FLimitToOneRow default False;
  170.     property PopupMenu;
  171.     property Position: TDockPosition read FPosition write SetPosition default dpTop;
  172.     property Version: TToolbar97Version read GetVersion write SetVersion stored False;
  173.     property Visible;
  174.  
  175.     property OnInsertRemoveBar: TInsertRemoveEvent read FOnInsertRemoveBar write FOnInsertRemoveBar;
  176.     property OnMouseDown;
  177.     property OnMouseMove;
  178.     property OnMouseUp;
  179.     property OnRequestDock: TRequestDockEvent read FOnRequestDock write FOnRequestDock;
  180.     property OnResize: TNotifyEvent read FOnResize write FOnResize;
  181.   end;
  182.  
  183.   { TFloatingWindowParent - internal }
  184.  
  185.   TFloatingWindowParent = class(TForm)
  186.   private
  187.     FParentForm: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  188.     FShouldShow: Boolean;
  189.     procedure CMShowingChanged (var Message: TMessage); message CM_SHOWINGCHANGED;
  190.     procedure CMDialogKey (var Message: TCMDialogKey); message CM_DIALOGKEY;
  191.   protected
  192.     procedure CreateParams (var Params: TCreateParams); override;
  193.   public
  194.     property ParentForm: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF} read FParentForm;
  195.     constructor Create (AOwner: TComponent); override;
  196.   end;
  197.  
  198.   { TCustomToolWindow97 }
  199.  
  200.   TDockChangingExEvent = procedure(Sender: TObject; DockingTo: TDock97) of object;
  201.   TDragHandleStyle = (dhDouble, dhNone, dhSingle);
  202.   TToolWindowDockMode = (dmCanFloat, dmCannotFloat, dmCannotFloatOrChangeDocks);
  203.   TToolWindowFloatingMode = (fmOnTopOfParentForm, fmOnTopOfAllForms);
  204.   TToolWindowParams = record
  205.     CallAlignControls, ResizeEightCorner, ResizeClipCursor: Boolean;
  206.   end;
  207.   TToolWindowSizeHandle = (twshLeft, twshRight, twshTop, twshTopLeft,
  208.     twshTopRight, twshBottom, twshBottomLeft, twshBottomRight);
  209.     { ^ must be in same order as HTLEFT..HTBOTTOMRIGHT }
  210.   TToolWindowNCRedrawWhatElement = (twrdBorder, twrdCaption, twrdCloseButton);
  211.   TToolWindowNCRedrawWhat = set of TToolWindowNCRedrawWhatElement;
  212.   TPositionReadIntProc = function(const ToolbarName, Value: String; const Default: Longint;
  213.     const ExtraData: Pointer): Longint;
  214.   TPositionReadStringProc = function(const ToolbarName, Value, Default: String;
  215.     const ExtraData: Pointer): String;
  216.   TPositionWriteIntProc = procedure(const ToolbarName, Value: String; const Data: Longint;
  217.     const ExtraData: Pointer);
  218.   TPositionWriteStringProc = procedure(const ToolbarName, Value, Data: String;
  219.     const ExtraData: Pointer);
  220.  
  221.   TCustomToolWindow97 = class(TCustomControl)
  222.   private
  223.     { Property variables }
  224.     FDockPos, FDockRow: Integer;
  225.     FDocked: Boolean;
  226.     FDockedTo, FDefaultDock, FLastDock: TDock97;
  227.     FOnClose, FOnDockChanged, FOnDockChanging, FOnMove, FOnRecreated,
  228.       FOnRecreating, FOnResize, FOnVisibleChanged: TNotifyEvent;
  229.     FOnCloseQuery: TCloseQueryEvent;
  230.     FOnDockChangingEx, FOnDockChangingHidden: TDockChangingExEvent;
  231.     FActivateParent, FHideWhenInactive, FCloseButton, FCloseButtonWhenDocked,
  232.       FFullSize, FResizable, FShowCaption, FUseLastDock: Boolean;
  233.     FBorderStyle: TBorderStyle;
  234.     FDockMode: TToolWindowDockMode;
  235.     FDragHandleStyle: TDragHandleStyle;
  236.     FDockableTo: TDockableTo;
  237.     FFloatingMode: TToolWindowFloatingMode;
  238.     FLastDockType: TDockType;
  239.     FLastDockTypeSet: Boolean;
  240.     FParams: TToolWindowParams;
  241.  
  242.     { Misc. }
  243.     FUpdatingBounds,           { Incremented while internally changing the bounds. This allows
  244.                                  it to move the toolbar freely in design mode and prevents the
  245.                                  SizeChanging protected method from begin called }
  246.     FDisableArrangeControls,   { Incremented to disable ArrangeControls }
  247.     FDisableOnMove,            { Incremented to prevent WM_MOVE handler from calling the OnMoved handler }
  248.     FHidden: Integer;          { Incremented while the toolbar is temporarily hidden }
  249.     FArrangeNeeded, FMoved: Boolean;
  250.     FInactiveCaption: Boolean; { True when the caption of the toolbar is currently the inactive color }
  251.     FFloatingTopLeft: TPoint;
  252.     FDockForms: TList;
  253.     FSavedAtRunTime: Boolean;
  254.     FNonClientWidth, FNonClientHeight: Integer;
  255.  
  256.     { When floating. These are not used in design mode }
  257.     FFloatParent: TFloatingWindowParent; { Run-time only: The actual Parent of the toolbar when it is floating }
  258.     FCloseButtonDown: Boolean; { True if Close button is currently depressed }
  259.  
  260.     { Property access methods }
  261.     function GetVersion: TToolbar97Version;
  262.     function IsLastDockStored: Boolean;
  263.     procedure SetBorderStyle (Value: TBorderStyle);
  264.     procedure SetCloseButton (Value: Boolean);
  265.     procedure SetCloseButtonWhenDocked (Value: Boolean);
  266.     procedure SetDefaultDock (Value: TDock97);
  267.     procedure SetDockedTo (Value: TDock97);
  268.     procedure SetDockPos (Value: Integer);
  269.     procedure SetDockRow (Value: Integer);
  270.     procedure SetDragHandleStyle (Value: TDragHandleStyle);
  271.     procedure SetFloatingMode (Value: TToolWindowFloatingMode);
  272.     procedure SetFullSize (Value: Boolean);
  273.     procedure SetLastDock (Value: TDock97);
  274.     procedure SetResizable (Value: Boolean);
  275.     procedure SetShowCaption (Value: Boolean);
  276.     procedure SetUseLastDock (Value: Boolean);
  277.     procedure SetVersion (const Value: TToolbar97Version);
  278.  
  279.     { Internal }
  280.     procedure CalculateNonClientSizes (R: PRect);
  281.     procedure MoveOnScreen (const OnlyIfFullyOffscreen: Boolean);
  282.     procedure DrawDraggingOutline (const DC: HDC; const NewRect, OldRect: PRect;
  283.       const NewDocking, OldDocking: Boolean);
  284.     procedure DrawFloatingNCArea (const DrawToDC: Boolean; const ADC: HDC;
  285.       const Clip: HRGN; RedrawWhat: TToolWindowNCRedrawWhat);
  286.     procedure DrawDockedNCArea (const DrawToDC: Boolean; const ADC: HDC;
  287.       const Clip: HRGN);
  288.     procedure InvalidateDockedNCArea;
  289.     procedure InvalidateFloatingNCArea (const RedrawWhat: TToolWindowNCRedrawWhat);
  290.     procedure ValidateDockedNCArea;
  291.     function ValidateFloatingNCArea: TToolWindowNCRedrawWhat;
  292.     procedure SetInactiveCaption (Value: Boolean);
  293.     procedure Moved;
  294.     function GetShowingState: Boolean;
  295.     procedure UpdateTopmostFlag;
  296.     procedure UpdateVisibility;
  297.     procedure ReadSavedAtRunTime (Reader: TReader);
  298.     procedure WriteSavedAtRunTime (Writer: TWriter);
  299.  
  300.     { Messages }
  301.     procedure CMColorChanged (var Message: TMessage); message CM_COLORCHANGED;
  302.     procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED;
  303.     procedure CMShowingChanged (var Message: TMessage); message CM_SHOWINGCHANGED;
  304.     procedure CMVisibleChanged (var Message: TMessage); message CM_VISIBLECHANGED;
  305.     procedure WMActivate (var Message: TWMActivate); message WM_ACTIVATE;
  306.     procedure WMClose (var Message: TWMClose); message WM_CLOSE;
  307.     procedure WMEnable (var Message: TWMEnable); message WM_ENABLE;
  308.     procedure WMGetMinMaxInfo (var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
  309.     procedure WMMove (var Message: TWMMove); message WM_MOVE;
  310.     procedure WMMouseActivate (var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
  311.     procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  312.     procedure WMNCHitTest (var Message: TWMNCHitTest); message WM_NCHITTEST;
  313.     procedure WMNCLButtonDown (var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  314.     procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
  315.     procedure WMPrint (var Message: TMessage); message WM_PRINT;
  316.     procedure WMPrintClient (var Message: TMessage); message WM_PRINTCLIENT;
  317.     procedure WMTB97PaintDockedNCArea (var Message: TMessage); message WM_TB97PaintDockedNCArea;
  318.     procedure WMTB97PaintFloatingNCArea (var Message: TMessage); message WM_TB97PaintFloatingNCArea;
  319.     procedure WMSize (var Message: TWMSize); message WM_SIZE;
  320.   protected
  321.     property ActivateParent: Boolean read FActivateParent write FActivateParent default True;
  322.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  323.     property Color default clBtnFace;
  324.     property CloseButton: Boolean read FCloseButton write SetCloseButton default True;
  325.     property CloseButtonWhenDocked: Boolean read FCloseButtonWhenDocked write SetCloseButtonWhenDocked default False;
  326.     property DefaultDock: TDock97 read FDefaultDock write SetDefaultDock;
  327.     property DockableTo: TDockableTo read FDockableTo write FDockableTo default [dpTop, dpBottom, dpLeft, dpRight];
  328.     property DockMode: TToolWindowDockMode read FDockMode write FDockMode default dmCanFloat;
  329.     property DragHandleStyle: TDragHandleStyle read FDragHandleStyle write SetDragHandleStyle default dhDouble;
  330.     property FloatingMode: TToolWindowFloatingMode read FFloatingMode write SetFloatingMode default fmOnTopOfParentForm;
  331.     property FullSize: Boolean read FFullSize write SetFullSize default False;
  332.     property HideWhenInactive: Boolean read FHideWhenInactive write FHideWhenInactive default True;
  333.     property LastDock: TDock97 read FLastDock write SetLastDock stored IsLastDockStored;
  334.     property Params: TToolWindowParams read FParams;
  335.     property Resizable: Boolean read FResizable write SetResizable default True;
  336.     property ShowCaption: Boolean read FShowCaption write SetShowCaption default True;
  337.     property UseLastDock: Boolean read FUseLastDock write SetUseLastDock default True;
  338.     property Version: TToolbar97Version read GetVersion write SetVersion stored False;
  339.  
  340.     property OnClose: TNotifyEvent read FOnClose write FOnClose;
  341.     property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
  342.     property OnDockChanged: TNotifyEvent read FOnDockChanged write FOnDockChanged;
  343.     property OnDockChanging: TNotifyEvent read FOnDockChanging write FOnDockChanging;
  344.     property OnDockChangingEx: TDockChangingExEvent read FOnDockChangingEx write FOnDockChangingEx;
  345.     property OnDockChangingHidden: TDockChangingExEvent read FOnDockChangingHidden write FOnDockChangingHidden;
  346.     property OnMove: TNotifyEvent read FOnMove write FOnMove;
  347.     property OnRecreated: TNotifyEvent read FOnRecreated write FOnRecreated;
  348.     property OnRecreating: TNotifyEvent read FOnRecreating write FOnRecreating;
  349.     property OnResize: TNotifyEvent read FOnResize write FOnResize;
  350.     property OnVisibleChanged: TNotifyEvent read FOnVisibleChanged write FOnVisibleChanged;
  351.  
  352.     { Overridden methods }
  353.     procedure AlignControls (AControl: TControl; var Rect: TRect); override;
  354.     procedure CreateParams (var Params: TCreateParams); override;
  355.     procedure DefineProperties (Filer: TFiler); override;
  356.     function GetPalette: HPALETTE; override;
  357.     procedure Loaded; override;
  358.     procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  359.     procedure Notification (AComponent: TComponent; Operation: TOperation); override;
  360.     procedure Paint; override;
  361.     function PaletteChanged (Foreground: Boolean): Boolean; override;
  362.     procedure SetParent (AParent: TWinControl); override;
  363.  
  364.     { Methods accessible to descendants }
  365.     procedure ArrangeControls;
  366.     function ChildControlTransparent (Ctl: TControl): Boolean; dynamic;
  367.     procedure CustomArrangeControls (const PreviousDockType: TDockType;
  368.       const DockingTo: TDock97; const Resize: Boolean);
  369.     procedure DoDockChangingHidden (DockingTo: TDock97); dynamic;
  370.     procedure DoMove; dynamic;
  371.     procedure GetBarSize (var ASize: Integer; const DockType: TDockType); virtual; abstract;
  372.     procedure GetDockRowSize (var AHeightOrWidth: Integer);
  373.     procedure GetMinimumSize (var AClientWidth, AClientHeight: Integer); virtual; abstract;
  374.     procedure GetParams (var Params: TToolWindowParams); dynamic;
  375.     procedure InitializeOrdering; dynamic;
  376.     function OrderControls (CanMoveControls: Boolean; PreviousDockType: TDockType;
  377.       DockingTo: TDock97): TPoint; virtual; abstract;
  378.     procedure ResizeBegin (SizeHandle: TToolWindowSizeHandle); dynamic;
  379.     procedure ResizeEnd (Accept: Boolean); dynamic;
  380.     procedure ResizeTrack (var Rect: TRect; const OrigRect: TRect); dynamic;
  381.     procedure SizeChanging (const AWidth, AHeight: Integer); virtual;
  382.   public
  383.     property Docked: Boolean read FDocked;
  384.     property DockedTo: TDock97 read FDockedTo write SetDockedTo stored False;
  385.     property DockPos: Integer read FDockPos write SetDockPos default -1;
  386.     property DockRow: Integer read FDockRow write SetDockRow default 0;
  387.     property FloatingPosition: TPoint read FFloatingTopLeft write FFloatingTopLeft;
  388.     property NonClientWidth: Integer read FNonClientWidth;
  389.     property NonClientHeight: Integer read FNonClientHeight;
  390.  
  391.     constructor Create (AOwner: TComponent); override;
  392.     destructor Destroy; override;
  393.     function GetParentComponent: TComponent; override;
  394.     function HasParent: Boolean; override;
  395.     procedure SetBounds (ALeft, ATop, AWidth, AHeight: Integer); override;
  396.  
  397.     procedure AddDockForm (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF});
  398.     procedure AddDockedNCAreaToSize (var S: TPoint; const LeftRight: Boolean);
  399.     procedure AddFloatingNCAreaToSize (var S: TPoint);
  400.     procedure BeginMoving (const InitX, InitY: Integer);
  401.     procedure BeginSizing (const ASizeHandle: TToolWindowSizeHandle);
  402.     procedure BeginUpdate;
  403.     procedure DoneReadingPositionData (const ReadIntProc: TPositionReadIntProc;
  404.       const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); dynamic;
  405.     procedure EndUpdate;
  406.     procedure GetDockedNCArea (var TopLeft, BottomRight: TPoint;
  407.       const LeftRight: Boolean);
  408.     function GetFloatingBorderSize: TPoint;
  409.     procedure GetFloatingNCArea (var TopLeft, BottomRight: TPoint);
  410.     procedure ReadPositionData (const ReadIntProc: TPositionReadIntProc;
  411.       const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); dynamic;
  412.     procedure RemoveDockForm (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF});
  413.     procedure WritePositionData (const WriteIntProc: TPositionWriteIntProc;
  414.       const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); dynamic;
  415.   published
  416.     property Height stored False;
  417.     property Width stored False;
  418.   end;
  419.  
  420. procedure RegLoadToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}; const BaseRegistryKey: String);
  421. procedure RegLoadToolbarPositionsEx (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}; const RootKey: DWORD; const BaseRegistryKey: String);
  422. procedure RegSaveToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}; const BaseRegistryKey: String);
  423. procedure RegSaveToolbarPositionsEx (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}; const RootKey: DWORD; const BaseRegistryKey: String);
  424. procedure IniLoadToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}; const Filename, SectionNamePrefix: String);
  425. procedure IniSaveToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}; const Filename, SectionNamePrefix: String);
  426.  
  427. procedure CustomLoadToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  428.   const ReadIntProc: TPositionReadIntProc;
  429.   const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
  430. procedure CustomSaveToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  431.   const WriteIntProc: TPositionWriteIntProc;
  432.   const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer);
  433.  
  434. function GetDockTypeOf (const Control: TDock97): TDockType;
  435. function GetToolWindowParentForm (const ToolWindow: TCustomToolWindow97):
  436.   {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  437. function ValidToolWindowParentForm (const ToolWindow: TCustomToolWindow97):
  438.   {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  439.  
  440. implementation
  441.  
  442. uses
  443.   Registry, IniFiles, SysUtils, Consts,
  444.   TB97Cmn, TB97Cnst;
  445.  
  446. const
  447.   DockedBorderSize = 2;
  448.   DockedBorderSize2 = DockedBorderSize*2;
  449.   DragHandleSizes: array[Boolean, TDragHandleStyle] of Integer =
  450.     ((9, 0, 6), (14, 14, 14));
  451.   DragHandleOffsets: array[Boolean, TDragHandleStyle] of Integer =
  452.     ((2, 0, 1), (3, 0, 5));
  453.  
  454.   DefaultBarWidthHeight = 8;
  455.  
  456.   ForceDockAtTopRow = 0;
  457.   ForceDockAtLeftPos = -8;
  458.  
  459.   PositionLeftOrRight = [dpLeft, dpRight];
  460.  
  461.   twrdAll = [Low(TToolWindowNCRedrawWhatElement)..High(TToolWindowNCRedrawWhatElement)];
  462.  
  463.   { Constants for TCustomToolWindow97 registry values/data.
  464.     Don't localize any of these names! }
  465.   rvRev = 'Rev';
  466.   rdCurrentRev = 3;
  467.   rvVisible = 'Visible';
  468.   rvDockedTo = 'DockedTo';
  469.   rdDockedToFloating = '+';
  470.   rvLastDock = 'LastDock';
  471.   rvDockRow = 'DockRow';
  472.   rvDockPos = 'DockPos';
  473.   rvFloatLeft = 'FloatLeft';
  474.   rvFloatTop = 'FloatTop';
  475.  
  476. var
  477.   FloatingToolWindows: TList = nil;
  478.  
  479.  
  480. { Misc. functions }
  481.  
  482. function GetSmallCaptionHeight: Integer;
  483. { Returns height of the caption of a small window }
  484. begin
  485.   if NewStyleControls then
  486.     Result := GetSystemMetrics(SM_CYSMCAPTION)
  487.   else
  488.     { Win 3.x doesn't support small captions, so, like Office 97, use the size
  489.       of normal captions minus one }
  490.     Result := GetSystemMetrics(SM_CYCAPTION) - 1;
  491. end;
  492.  
  493. function GetPrimaryDesktopArea: TRect;
  494. { Returns a rectangle containing the "work area" of the primary display
  495.   monitor, which is the area not taken up by the taskbar. }
  496. begin
  497.   if not SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0) then
  498.     { SPI_GETWORKAREA is only supported by Win95 and NT 4.0. So it fails under
  499.       Win 3.x. In that case, return a rectangle of the entire screen }
  500.     Result := Rect(0, 0, GetSystemMetrics(SM_CXSCREEN),
  501.       GetSystemMetrics(SM_CYSCREEN));
  502. end;
  503.  
  504. function UsingMultipleMonitors: Boolean;
  505. { Returns True if the system has more than one display monitor configured. }
  506. var
  507.   NumMonitors: Integer;
  508. begin
  509.   NumMonitors := GetSystemMetrics(80 {SM_CMONITORS});
  510.   Result := (NumMonitors <> 0) and (NumMonitors <> 1);
  511.   { ^ NumMonitors will be zero if not running Win98, NT 5, or later }
  512. end;
  513.  
  514. type
  515.   HMONITOR = type Integer;
  516.   PMonitorInfoA = ^TMonitorInfoA;
  517.   TMonitorInfoA = record
  518.     cbSize: DWORD;
  519.     rcMonitor: TRect;
  520.     rcWork: TRect;
  521.     dwFlags: DWORD;
  522.   end;
  523. const
  524.   MONITOR_DEFAULTTONEAREST = $2;
  525. type
  526.   TMultiMonApis = record
  527.     funcMonitorFromRect: function(lprcScreenCoords: PRect; dwFlags: DWORD): HMONITOR; stdcall;
  528.     funcMonitorFromPoint: function(ptScreenCoords: TPoint; dwFlags: DWORD): HMONITOR; stdcall;
  529.     funcGetMonitorInfoA: function(hMonitor: HMONITOR; lpMonitorInfo: PMonitorInfoA): BOOL; stdcall;
  530.   end;
  531.  
  532. { Under D4 I could be using the MultiMon unit for the multiple monitor
  533.   function imports, but its stubs for MonitorFromRect and MonitorFromPoint
  534.   are seriously bugged... So I chose to avoid the MultiMon unit entirely. }
  535.  
  536. function InitMultiMonApis (var Apis: TMultiMonApis): Boolean;
  537. var
  538.   User32Handle: THandle;
  539. begin
  540.   User32Handle := GetModuleHandle(user32);
  541.   Apis.funcMonitorFromRect := GetProcAddress(User32Handle, 'MonitorFromRect');
  542.   Apis.funcMonitorFromPoint := GetProcAddress(User32Handle, 'MonitorFromPoint');
  543.   Apis.funcGetMonitorInfoA := GetProcAddress(User32Handle, 'GetMonitorInfoA');
  544.   Result := Assigned(Apis.funcMonitorFromRect) and
  545.     Assigned(Apis.funcMonitorFromPoint) and Assigned(Apis.funcGetMonitorInfoA);
  546. end;
  547.  
  548. function GetDesktopAreaOfMonitorContainingRect (const R: TRect): TRect;
  549. { Returns the work area of the monitor which the rectangle R intersects with
  550.   the most, or the monitor nearest R if no monitors intersect. }
  551. var
  552.   Apis: TMultiMonApis;
  553.   M: HMONITOR;
  554.   MonitorInfo: TMonitorInfoA;
  555. begin
  556.   if UsingMultipleMonitors and InitMultiMonApis(Apis) then begin
  557.     M := Apis.funcMonitorFromRect(@R, MONITOR_DEFAULTTONEAREST);
  558.     MonitorInfo.cbSize := SizeOf(MonitorInfo);
  559.     if Apis.funcGetMonitorInfoA(M, @MonitorInfo) then begin
  560.       Result := MonitorInfo.rcWork;
  561.       Exit;
  562.     end;
  563.   end;
  564.   Result := GetPrimaryDesktopArea;
  565. end;
  566.  
  567. function GetDesktopAreaOfMonitorContainingPoint (const P: TPoint): TRect;
  568. { Returns the work area of the monitor containing the point P, or the monitor
  569.   nearest P if P isn't in any monitor's work area. }
  570. var
  571.   Apis: TMultiMonApis;
  572.   M: HMONITOR;
  573.   MonitorInfo: TMonitorInfoA;
  574. begin
  575.   if UsingMultipleMonitors and InitMultiMonApis(Apis) then begin
  576.     M := Apis.funcMonitorFromPoint(P, MONITOR_DEFAULTTONEAREST);
  577.     MonitorInfo.cbSize := SizeOf(MonitorInfo);
  578.     if Apis.funcGetMonitorInfoA(M, @MonitorInfo) then begin
  579.       Result := MonitorInfo.rcWork;
  580.       Exit;
  581.     end;
  582.   end;
  583.   Result := GetPrimaryDesktopArea;
  584. end;
  585.  
  586. function GetMDIParent (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}):
  587.   {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  588. { Returns the parent of the specified MDI child form. But, if Form isn't a
  589.   MDI child, it simply returns Form. }
  590. var
  591.   I, J: Integer;
  592. begin
  593.   Result := Form;
  594.   if Form = nil then Exit;
  595.   if {$IFDEF TB97D3} (Form is TForm) and {$ENDIF}
  596.      (TForm(Form).FormStyle = fsMDIChild) then
  597.     for I := 0 to Screen.FormCount-1 do
  598.       with Screen.Forms[I] do begin
  599.         if FormStyle <> fsMDIForm then Continue;
  600.         for J := 0 to MDIChildCount-1 do
  601.           if MDIChildren[J] = Form then begin
  602.             Result := Screen.Forms[I];
  603.             Exit;
  604.           end;
  605.       end;
  606. end;
  607.  
  608. function GetDockTypeOf (const Control: TDock97): TDockType;
  609. begin
  610.   if Control = nil then
  611.     Result := dtNotDocked
  612.   else begin
  613.     if not(Control.Position in PositionLeftOrRight) then
  614.       Result := dtTopBottom
  615.     else
  616.       Result := dtLeftRight;
  617.   end;
  618. end;
  619.  
  620. function GetToolWindowParentForm (const ToolWindow: TCustomToolWindow97):
  621.   {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  622. var
  623.   Ctl: TWinControl;
  624. begin
  625.   Result := nil;
  626.   Ctl := ToolWindow;
  627.   while Assigned(Ctl.Parent) do begin
  628.     if Ctl.Parent is {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF} then
  629.       Result := {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}(Ctl.Parent);
  630.     Ctl := Ctl.Parent;
  631.   end;
  632.   { ^ for compatibility with ActiveX controls, that code is used instead of
  633.     GetParentForm because it returns nil unless the form is the *topmost*
  634.     parent }
  635.   if Result is TFloatingWindowParent then
  636.     Result := TFloatingWindowParent(Result).ParentForm;
  637. end;
  638.  
  639. function ValidToolWindowParentForm (const ToolWindow: TCustomToolWindow97):
  640.   {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  641. begin
  642.   Result := GetToolWindowParentForm(ToolWindow);
  643.   if Result = nil then
  644.     raise EInvalidOperation.{$IFDEF TB97D3}CreateFmt{$ELSE}CreateResFmt{$ENDIF}
  645.       (SParentRequired, [ToolWindow.Name]);
  646. end;
  647.  
  648. procedure ToolbarHookProc (Code: THookProcCode; Wnd: HWND; WParam: WPARAM; LParam: LPARAM);
  649. var
  650.   I: Integer;
  651.   ToolWindow: TCustomToolWindow97;
  652.   Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  653. begin
  654.   case Code of
  655.     hpSendActivateApp: begin
  656.         if Assigned(FloatingToolWindows) then
  657.           for I := 0 to FloatingToolWindows.Count-1 do
  658.             with TCustomToolWindow97(FloatingToolWindows.List[I]) do
  659.               { Hide or restore toolbars when application is deactivated or activated.
  660.                 UpdateVisibility also sets caption state active/inactive }
  661.               UpdateVisibility;
  662.       end;
  663.     hpSendWindowPosChanged: begin
  664.         if Assigned(FloatingToolWindows) then
  665.           for I := 0 to FloatingToolWindows.Count-1 do begin
  666.             ToolWindow := TCustomToolWindow97(FloatingToolWindows.List[I]);
  667.             with ToolWindow do begin
  668.               if (FFloatingMode = fmOnTopOfParentForm) and HandleAllocated then begin
  669.                 with PWindowPos(LParam)^ do
  670.                   { Call UpdateVisibility if parent form's visibility has
  671.                     changed, or if it has been minimized or restored }
  672.                   if ((flags and (SWP_SHOWWINDOW or SWP_HIDEWINDOW) <> 0) or
  673.                       (flags and SWP_FRAMECHANGED <> 0)) then begin
  674.                     Form := GetToolWindowParentForm(ToolWindow);
  675.                     if Assigned(Form) and Form.HandleAllocated and ((Wnd = Form.Handle) or IsChild(Wnd, Form.Handle)) then
  676.                       UpdateVisibility;
  677.                   end;
  678.               end;
  679.             end;
  680.           end;
  681.       end;
  682.     hpPreDestroy: begin
  683.         if Assigned(FloatingToolWindows) then
  684.           for I := 0 to FloatingToolWindows.Count-1 do begin
  685.             with TCustomToolWindow97(FloatingToolWindows.List[I]) do
  686.               { It must remove the form window's ownership of the tool window
  687.                 *before* the form gets destroyed, otherwise Windows will destroy
  688.                 the tool window's handle. }
  689.               if HandleAllocated and (HWND(GetWindowLong(Handle, GWL_HWNDPARENT)) = Wnd) then
  690.                 SetWindowLong (Handle, GWL_HWNDPARENT, Longint(Parent.Handle));
  691.                 { ^ Restore GWL_HWNDPARENT back to the TFloatingWindowParent }
  692.           end;
  693.       end;
  694.   end;
  695. end;
  696.  
  697. procedure ProcessPaintMessages;
  698. { Dispatches all pending WM_PAINT messages. In effect, this is like an
  699.   'UpdateWindow' on all visible windows }
  700. var
  701.   Msg: TMsg;
  702. begin
  703.   while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_NOREMOVE) do begin
  704.     case Integer(GetMessage(Msg, 0, WM_PAINT, WM_PAINT)) of
  705.       -1: Break; { if GetMessage failed }
  706.       0: begin
  707.            { Repost WM_QUIT messages }
  708.            PostQuitMessage (Msg.WParam);
  709.            Break;
  710.          end;
  711.     end;
  712.     DispatchMessage (Msg);
  713.   end;
  714. end;
  715.  
  716. type
  717.   PFindWindowData = ^TFindWindowData;
  718.   TFindWindowData = record
  719.     TaskActiveWindow, TaskFirstWindow, TaskFirstTopMost: HWND;
  720.   end;
  721.  
  722. function DoFindWindow (Wnd: HWND; Param: Longint): Bool; stdcall;
  723. begin
  724.   with PFindWindowData(Param)^ do
  725.     if (Wnd <> TaskActiveWindow) and (Wnd <> Application.Handle) and
  726.        IsWindowVisible(Wnd) and IsWindowEnabled(Wnd) then begin
  727.       if GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOPMOST = 0 then begin
  728.         if TaskFirstWindow = 0 then TaskFirstWindow := Wnd;
  729.       end
  730.       else begin
  731.         if TaskFirstTopMost = 0 then TaskFirstTopMost := Wnd;
  732.       end;
  733.     end;
  734.   Result := True;
  735. end;
  736.  
  737. function FindTopLevelWindow (ActiveWindow: HWND): HWND;
  738. var
  739.   FindData: TFindWindowData;
  740. begin
  741.   with FindData do begin
  742.     TaskActiveWindow := ActiveWindow;
  743.     TaskFirstWindow := 0;
  744.     TaskFirstTopMost := 0;
  745.     EnumThreadWindows (GetCurrentThreadID, @DoFindWindow, Longint(@FindData));
  746.     if TaskFirstWindow <> 0 then
  747.       Result := TaskFirstWindow
  748.     else
  749.       Result := TaskFirstTopMost;
  750.   end;
  751. end;
  752.  
  753. procedure RecalcNCArea (const Ctl: TWinControl);
  754. begin
  755.   if Ctl.HandleAllocated then
  756.     SetWindowPos (Ctl.Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or
  757.       SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
  758. end;
  759.  
  760. function GetToolbarDockPos (Ctl: TControl): TGetToolbarDockPosType;
  761. begin
  762.   Result := gtpNone;
  763.   while Assigned(Ctl) and not(Ctl is TCustomToolWindow97) do
  764.     Ctl := Ctl.Parent;
  765.   if Assigned(Ctl) and Assigned(TCustomToolWindow97(Ctl).DockedTo) then
  766.     Result := TGetToolbarDockPosType(TCustomToolWindow97(Ctl).DockedTo.Position);
  767.     { ^ TDockPosition can be casted TGetToolbarDockPosType because its values
  768.       are in the same order }
  769. end;
  770.  
  771.  
  772. { TDock97 - internal }
  773.  
  774. constructor TDock97.Create (AOwner: TComponent);
  775. begin
  776.   inherited;
  777.  
  778.   ControlStyle := ControlStyle + [csAcceptsControls] -
  779.     [csClickEvents, csCaptureMouse, csOpaque];
  780.   FAllowDrag := True;
  781.   FBkgOnToolbars := True;
  782.   DockList := TList.Create;
  783.   DockVisibleList := TList.Create;
  784.   RowSizes := TList.Create;
  785.   FBkg := TBitmap.Create;
  786.   FBkg.OnChange := BackgroundChanged;
  787.   Color := clBtnFace;
  788.   Position := dpTop;
  789. end;
  790.  
  791. procedure TDock97.CreateParams (var Params: TCreateParams);
  792. begin
  793.   inherited;
  794.   { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker
  795.     and are not necessary for this control at run time }
  796.   if not(csDesigning in ComponentState) then
  797.     with Params.WindowClass do
  798.       Style := Style and not(CS_HREDRAW or CS_VREDRAW);
  799. end;
  800.  
  801. destructor TDock97.Destroy;
  802. begin
  803.   FBkgCache.Free;
  804.   FBkg.Free;
  805.   inherited;
  806.   RowSizes.Free;
  807.   DockVisibleList.Free;
  808.   DockList.Free;
  809. end;
  810.  
  811. procedure TDock97.SetParent (AParent: TWinControl);
  812. begin
  813.   if (AParent is TCustomToolWindow97) or (AParent is TDock97) then
  814.     raise EInvalidOperation.Create(STB97DockParentNotAllowed);
  815.  
  816.   inherited;
  817. end;
  818.  
  819. procedure TDock97.BeginUpdate;
  820. begin
  821.   Inc (FDisableArrangeToolbars);
  822. end;
  823.  
  824. procedure TDock97.EndUpdate;
  825. begin
  826.   Dec (FDisableArrangeToolbars);
  827.   if FArrangeToolbarsNeeded and (FDisableArrangeToolbars = 0) then
  828.     ArrangeToolbars (FArrangeToolbarsClipPoses);
  829. end;
  830.  
  831. function TDock97.HasVisibleToolbars: Boolean;
  832. var
  833.   I: Integer;
  834. begin
  835.   Result := False;
  836.   for I := 0 to DockList.Count-1 do
  837.     if ToolbarVisibleOnDock(TCustomToolWindow97(DockList[I])) then begin
  838.       Result := True;
  839.       Break;
  840.     end;
  841. end;
  842.  
  843. function TDock97.ToolbarVisibleOnDock (const AToolbar: TCustomToolWindow97): Boolean;
  844. begin
  845.   Result := (AToolbar.Parent = Self) and
  846.     (AToolbar.Visible or (csDesigning in AToolbar.ComponentState));
  847. end;
  848.  
  849. procedure TDock97.BuildRowInfo;
  850. var
  851.   R, I, Size, HighestSize: Integer;
  852.   ToolbarOnRow: Boolean;
  853.   T: TCustomToolWindow97;
  854. begin
  855.   RowSizes.Clear;
  856.   for R := 0 to GetHighestRow do begin
  857.     ToolbarOnRow := False;
  858.     HighestSize := 0;
  859.     for I := 0 to DockList.Count-1 do begin
  860.       T := TCustomToolWindow97(DockList[I]);
  861.       with T do
  862.         if (FDockRow = R) and ToolbarVisibleOnDock(T) then begin
  863.           ToolbarOnRow := True;
  864.           GetBarSize (Size, GetDockTypeOf(Self));
  865.           if Size > HighestSize then HighestSize := Size;
  866.         end;
  867.     end;
  868.     if ToolbarOnRow and (HighestSize < DefaultBarWidthHeight) then
  869.       HighestSize := DefaultBarWidthHeight;
  870.     RowSizes.Add (Pointer(HighestSize));
  871.   end;
  872. end;
  873.  
  874. function TDock97.GetRowSize (const Row: Integer;
  875.   const DefaultToolbar: TCustomToolWindow97): Integer;
  876. begin
  877.   Result := 0;
  878.   if Row < RowSizes.Count then
  879.     Result := Longint(RowSizes[Row]);
  880.   if (Result = 0) and Assigned(DefaultToolbar) then
  881.     DefaultToolbar.GetBarSize (Result, GetDockTypeOf(Self));
  882. end;
  883.  
  884. function TDock97.GetRowOf (const XY: Integer; var Before: Boolean): Integer;
  885. { Returns row number of the specified coordinate. Before is set to True if it
  886.   was close to being in between two rows. }
  887. var
  888.   HighestRow, R, CurY, NextY, CurRowSize: Integer;
  889. begin
  890.   Result := 0;  Before := False;
  891.   HighestRow := GetHighestRow;
  892.   CurY := 0;
  893.   for R := 0 to HighestRow+1 do begin
  894.     NextY := High(NextY);
  895.     if R <= HighestRow then begin
  896.       CurRowSize := GetRowSize(R, nil);
  897.       if CurRowSize = 0 then Continue;
  898.       NextY := CurY + CurRowSize + DockedBorderSize2;
  899.     end;
  900.     if XY < CurY+5 then begin
  901.       Result := R;
  902.       Before := True;
  903.       Break;
  904.     end;
  905.     if (XY >= CurY+5) and (XY < NextY-5) then begin
  906.       Result := R;
  907.       Break;
  908.     end;
  909.     CurY := NextY;
  910.   end;
  911. end;
  912.  
  913. function TDock97.GetDesignModeRowOf (const XY: Integer): Integer;
  914. { Similar to GetRowOf, but is a little different to accomidate design mode
  915.   better }
  916. var
  917.   HighestRowPlus1, R, CurY, CurRowSize: Integer;
  918. begin
  919.   Result := 0;
  920.   HighestRowPlus1 := GetHighestRow+1;
  921.   CurY := 0;
  922.   for R := 0 to HighestRowPlus1 do begin
  923.     Result := R;
  924.     if R = HighestRowPlus1 then Break;
  925.     CurRowSize := GetRowSize(R, nil);
  926.     if CurRowSize = 0 then Continue;
  927.     Inc (CurY, CurRowSize + DockedBorderSize2);
  928.     if XY < CurY then
  929.       Break;
  930.   end;
  931. end;
  932.  
  933. function TDock97.GetHighestRow: Integer;
  934. { Returns highest used row number, or -1 if no rows are used }
  935. var
  936.   I: Integer;
  937. begin
  938.   Result := -1;
  939.   for I := 0 to DockList.Count-1 do
  940.     with TCustomToolWindow97(DockList[I]) do
  941.       if FDockRow > Result then
  942.         Result := FDockRow;
  943. end;
  944.  
  945. function TDock97.GetNumberOfToolbarsOnRow (const Row: Integer;
  946.   const NotIncluding: TCustomToolWindow97): Integer;
  947. { Returns number of toolbars on the specified row. The toolbar specified by
  948.   "NotIncluding" is not included in the count. }
  949. var
  950.   I: Integer;
  951. begin
  952.   Result := 0;
  953.   for I := 0 to DockList.Count-1 do
  954.     if (TCustomToolWindow97(DockList[I]).FDockRow = Row) and
  955.        (DockList[I] <> NotIncluding) then
  956.       Inc (Result);
  957. end;
  958.  
  959. procedure TDock97.RemoveBlankRows;
  960. { Deletes any blank row numbers, adjusting the docked toolbars' FDockRow as
  961.   needed }
  962. var
  963.   HighestRow, R, I: Integer;
  964.   RowIsEmpty: Boolean;
  965. begin
  966.   HighestRow := GetHighestRow;
  967.   R := 0;
  968.   while R <= HighestRow do begin
  969.     RowIsEmpty := True;
  970.     for I := 0 to DockList.Count-1 do
  971.       if TCustomToolWindow97(DockList[I]).FDockRow = R then begin
  972.         RowIsEmpty := False;
  973.         Break;
  974.       end;
  975.     if RowIsEmpty then begin
  976.       { Shift all ones higher than R back one }
  977.       for I := 0 to DockList.Count-1 do
  978.         with TCustomToolWindow97(DockList[I]) do
  979.           if FDockRow > R then
  980.             Dec (FDockRow);
  981.       Dec (HighestRow);
  982.     end
  983.     else
  984.       Inc (R);
  985.   end;
  986. end;
  987.  
  988. procedure TDock97.InsertRowBefore (const BeforeRow: Integer);
  989. { Inserts a blank row before BeforeRow, adjusting all the docked toolbars'
  990.   FDockRow as needed }
  991. var
  992.   I: Integer;
  993. begin
  994.   for I := 0 to DockList.Count-1 do
  995.     with TCustomToolWindow97(DockList[I]) do
  996.       if FDockRow >= BeforeRow then
  997.         Inc (FDockRow);
  998. end;
  999.  
  1000. procedure TDock97.ChangeWidthHeight (const NewWidth, NewHeight: Integer);
  1001. { Same as setting Width/Height directly, but does not lose Align position. }
  1002. begin
  1003.   case Align of
  1004.     alTop, alLeft:
  1005.       SetBounds (Left, Top, NewWidth, NewHeight);
  1006.     alBottom:
  1007.       SetBounds (Left, Top-NewHeight+Height, NewWidth, NewHeight);
  1008.     alRight:
  1009.       SetBounds (Left-NewWidth+Width, Top, NewWidth, NewHeight);
  1010.   end;
  1011. end;
  1012.  
  1013. procedure TDock97.AlignControls (AControl: TControl; var Rect: TRect);
  1014. begin
  1015.   ArrangeToolbars (False);
  1016. end;
  1017.  
  1018. function CompareDockRowPos (const Item1, Item2, ExtraData: Pointer): Integer; far;
  1019. begin
  1020.   if TCustomToolWindow97(Item1).FDockRow <> TCustomToolWindow97(Item2).FDockRow then
  1021.     Result := TCustomToolWindow97(Item1).FDockRow - TCustomToolWindow97(Item2).FDockRow
  1022.   else
  1023.     Result := TCustomToolWindow97(Item1).FDockPos - TCustomToolWindow97(Item2).FDockPos;
  1024. end;
  1025.  
  1026. procedure TDock97.ArrangeToolbars (const ClipPoses: Boolean);
  1027. { The main procedure to arrange all the toolbars docked to it }
  1028. type
  1029.   PIntegerArray = ^TIntegerArray;
  1030.   TIntegerArray = array[0..$7FFFFFFF div SizeOf(Integer)-1] of Integer;
  1031. var
  1032.   LeftRight: Boolean;
  1033.   EmptySize: Integer;
  1034.   HighestRow, R, CurDockPos, CurRowPixel, I, J, K, ClientW, ClientH: Integer;
  1035.   CurRowSize: Integer;
  1036.   T: TCustomToolWindow97;
  1037.   NewDockPos: PIntegerArray;
  1038. begin
  1039.   if ClipPoses then
  1040.     FArrangeToolbarsClipPoses := True;
  1041.   if (FDisableArrangeToolbars > 0) or (csLoading in ComponentState) then begin
  1042.     FArrangeToolbarsNeeded := True;
  1043.     Exit;
  1044.   end;
  1045.  
  1046.   Inc (FDisableArrangeToolbars);
  1047.   try
  1048.     { Work around VCL alignment bug when docking toolbars taller or wider than
  1049.       the client height or width of the form. }
  1050.     if not(csDesigning in ComponentState) and HandleAllocated then
  1051.       SetWindowPos (Handle, HWND_TOP, 0, 0, 0, 0,
  1052.         SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  1053.  
  1054.     LeftRight := Position in PositionLeftOrRight;
  1055.  
  1056.     if not HasVisibleToolbars then begin
  1057.       EmptySize := Ord(FFixAlign);
  1058.       if csDesigning in ComponentState then
  1059.         EmptySize := 9;
  1060.       if not LeftRight then
  1061.         ChangeWidthHeight (Width, EmptySize)
  1062.       else
  1063.         ChangeWidthHeight (EmptySize, Height);
  1064.       Exit;
  1065.     end;
  1066.  
  1067.     { It can't read the ClientWidth and ClientHeight properties because they
  1068.       attempt to create a handle, which requires Parent to be set. "ClientW"
  1069.       and "ClientH" are calculated instead. }
  1070.     ClientW := Width - FNonClientWidth;
  1071.     if ClientW < 0 then ClientW := 0;
  1072.     ClientH := Height - FNonClientHeight;
  1073.     if ClientH < 0 then ClientH := 0;
  1074.  
  1075.     { If LimitToOneRow is True, only use the first row }
  1076.     if FLimitToOneRow then
  1077.       for I := 0 to DockList.Count-1 do
  1078.         with TCustomToolWindow97(DockList[I]) do
  1079.           FDockRow := 0;
  1080.     { Remove any blank rows }
  1081.     RemoveBlankRows;
  1082.  
  1083.     { Ensure DockList is in correct ordering according to DockRow/DockPos }
  1084.     ListSortEx (DockList, CompareDockRowPos, nil);
  1085.     ListSortEx (DockVisibleList, CompareDockRowPos, nil);
  1086.     { Find highest row number }
  1087.     HighestRow := GetHighestRow;
  1088.     { Find FullSize toolbars and make sure there aren't any other toolbars
  1089.       on the same row. If there are, shift them down a row. }
  1090.     R := 0;
  1091.     while R <= HighestRow do begin
  1092.       for I := 0 to DockList.Count-1 do
  1093.         with TCustomToolWindow97(DockList[I]) do
  1094.           if (FDockRow = R) and FullSize then
  1095.             for J := 0 to DockList.Count-1 do
  1096.               if (J <> I) and (TCustomToolWindow97(DockList[J]).FDockRow = R) then begin
  1097.                 for K := 0 to DockList.Count-1 do
  1098.                   with TCustomToolWindow97(DockList[K]) do
  1099.                     if (K <> I) and (FDockRow >= R) then begin
  1100.                       Inc (FDockRow);
  1101.                       if FDockRow > HighestRow then
  1102.                         HighestRow := FDockRow;
  1103.                     end;
  1104.                 Break;
  1105.               end;
  1106.       Inc (R);
  1107.     end;
  1108.     { Rebuild the RowInfo, since rows numbers may have shifted }
  1109.     BuildRowInfo;
  1110.     HighestRow := RowSizes.Count-1;
  1111.     { Adjust DockPos's of toolbars to make sure none of the them overlap }
  1112.     for R := 0 to HighestRow do begin
  1113.       CurDockPos := 0;
  1114.       for I := 0 to DockList.Count-1 do begin
  1115.         T := TCustomToolWindow97(DockList[I]);
  1116.         with T do
  1117.           if (FDockRow = R) and ToolbarVisibleOnDock(T) then begin
  1118.             if FullSize then
  1119.               FDockPos := 0
  1120.             else begin
  1121.               if FDockPos <= CurDockPos then
  1122.                 FDockPos := CurDockPos
  1123.               else
  1124.                 CurDockPos := FDockPos;
  1125.               if not LeftRight then
  1126.                 Inc (CurDockPos, Width)
  1127.               else
  1128.                 Inc (CurDockPos, Height);
  1129.             end;
  1130.           end;
  1131.       end;
  1132.     end;
  1133.     { Create a temporary array that holds new DockPos's for the toolbars }
  1134.     GetMem (NewDockPos, DockList.Count * SizeOf(Integer));
  1135.     try
  1136.       for I := 0 to DockList.Count-1 do
  1137.         NewDockPos[I] := TCustomToolWindow97(DockList[I]).FDockPos;
  1138.  
  1139.       { Move toolbars that go off the edge of the dock to a fully visible
  1140.         position if possible }
  1141.       for R := 0 to HighestRow do begin
  1142.         if not LeftRight then
  1143.           CurDockPos := ClientW
  1144.         else
  1145.           CurDockPos := ClientH;
  1146.         for I := DockList.Count-1 downto 0 do begin
  1147.           T := TCustomToolWindow97(DockList[I]);
  1148.           with T do
  1149.             if (FDockRow = R) and ToolbarVisibleOnDock(T) and not FullSize then begin
  1150.               if not LeftRight then
  1151.                 Dec (CurDockPos, Width)
  1152.               else
  1153.                 Dec (CurDockPos, Height);
  1154.               if NewDockPos[I] > CurDockPos then
  1155.                 NewDockPos[I] := CurDockPos;
  1156.               CurDockPos := NewDockPos[I];
  1157.             end;
  1158.         end;
  1159.         { Since the above code will make the toolbars go off the left if the
  1160.           width of all toolbars is more than the width of the dock, push them
  1161.           back right if needed }
  1162.         CurDockPos := 0;
  1163.         for I := 0 to DockList.Count-1 do begin
  1164.           T := TCustomToolWindow97(DockList[I]);
  1165.           with T do
  1166.             if (FDockRow = R) and ToolbarVisibleOnDock(T) and not FullSize then begin
  1167.               if NewDockPos[I] <= CurDockPos then
  1168.                 NewDockPos[I] := CurDockPos
  1169.               else
  1170.                 CurDockPos := NewDockPos[I];
  1171.               if not LeftRight then
  1172.                 Inc (CurDockPos, Width)
  1173.               else
  1174.                 Inc (CurDockPos, Height);
  1175.             end;
  1176.         end;
  1177.       end;
  1178.  
  1179.       { If FArrangeToolbarsClipPoses (ClipPoses) is True, update all the
  1180.         toolbars' DockPos's to match the actual positions }
  1181.       if FArrangeToolbarsClipPoses then
  1182.         for I := 0 to DockList.Count-1 do
  1183.           TCustomToolWindow97(DockList[I]).FDockPos := NewDockPos[I];
  1184.  
  1185.       { Now actually move the toolbars }
  1186.       CurRowPixel := 0;
  1187.       for R := 0 to HighestRow do begin
  1188.         CurRowSize := Longint(RowSizes[R]);
  1189.         if CurRowSize <> 0 then
  1190.           Inc (CurRowSize, DockedBorderSize2);
  1191.         for I := 0 to DockList.Count-1 do begin
  1192.           T := TCustomToolWindow97(DockList[I]);
  1193.           with T do
  1194.             if (FDockRow = R) and ToolbarVisibleOnDock(T) then begin
  1195.               Inc (FUpdatingBounds);
  1196.               try
  1197.                 if not LeftRight then begin
  1198.                   J := Width;
  1199.                   if FullSize then J := ClientW;
  1200.                   SetBounds (NewDockPos[I], CurRowPixel, J, CurRowSize)
  1201.                 end
  1202.                 else begin
  1203.                   J := Height;
  1204.                   if FullSize then J := ClientH;
  1205.                   SetBounds (CurRowPixel, NewDockPos[I], CurRowSize, J);
  1206.                 end;
  1207.               finally
  1208.                 Dec (FUpdatingBounds);
  1209.               end;
  1210.             end;
  1211.         end;
  1212.         Inc (CurRowPixel, CurRowSize);
  1213.       end;
  1214.     finally
  1215.       FreeMem (NewDockPos);
  1216.     end;
  1217.  
  1218.     { Set the size of the dock }
  1219.     if not LeftRight then
  1220.       ChangeWidthHeight (Width, CurRowPixel + FNonClientHeight)
  1221.     else
  1222.       ChangeWidthHeight (CurRowPixel + FNonClientWidth, Height);
  1223.   finally
  1224.     Dec (FDisableArrangeToolbars);
  1225.     FArrangeToolbarsNeeded := False;
  1226.     FArrangeToolbarsClipPoses := False;
  1227.   end;
  1228. end;
  1229.  
  1230. procedure TDock97.ChangeDockList (const Insert: Boolean;
  1231.   const Bar: TCustomToolWindow97);
  1232. { Inserts or removes Bar from DockList }
  1233. var
  1234.   I: Integer;
  1235. begin
  1236.   I := DockList.IndexOf(Bar);
  1237.   if Insert then begin
  1238.     if I = -1 then begin
  1239.       Bar.FreeNotification (Self);
  1240.       DockList.Add (Bar);
  1241.     end;
  1242.   end
  1243.   else begin
  1244.     if I <> -1 then
  1245.       DockList.Delete (I);
  1246.   end;
  1247.   ToolbarVisibilityChanged (Bar, False);
  1248. end;
  1249.  
  1250. procedure TDock97.ToolbarVisibilityChanged (const Bar: TCustomToolWindow97;
  1251.   const ForceRemove: Boolean);
  1252. var
  1253.   Modified, VisibleOnDock: Boolean;
  1254.   I: Integer;
  1255. begin
  1256.   Modified := False;
  1257.   I := DockVisibleList.IndexOf(Bar);
  1258.   VisibleOnDock := not ForceRemove and ToolbarVisibleOnDock(Bar);
  1259.   if VisibleOnDock then begin
  1260.     if I = -1 then begin
  1261.       DockVisibleList.Add (Bar);
  1262.       Modified := True;
  1263.     end;
  1264.   end
  1265.   else begin
  1266.     if I <> -1 then begin
  1267.       DockVisibleList.Remove (Bar);
  1268.       Modified := True;
  1269.     end;
  1270.   end;
  1271.  
  1272.   if Modified then begin
  1273.     ArrangeToolbars (False);
  1274.  
  1275.     if Assigned(FOnInsertRemoveBar) then
  1276.       FOnInsertRemoveBar (Self, VisibleOnDock, Bar);
  1277.   end;
  1278. end;
  1279.  
  1280. procedure TDock97.Loaded;
  1281. begin
  1282.   inherited;
  1283.   { Rearranging is disabled while the component is loading, so now that it's
  1284.     loaded, rearrange it. }
  1285.   ArrangeToolbars (False);
  1286. end;
  1287.  
  1288. procedure TDock97.Notification (AComponent: TComponent; Operation: TOperation);
  1289. begin
  1290.   inherited;
  1291.   if (Operation = opRemove) and (AComponent is TCustomToolWindow97) then begin
  1292.     DockList.Remove (AComponent);
  1293.     DockVisibleList.Remove (AComponent);
  1294.   end;
  1295. end;
  1296.  
  1297. function TDock97.GetPalette: HPALETTE;
  1298. begin
  1299.   Result := FBkg.Palette;
  1300. end;
  1301.  
  1302. procedure TDock97.DrawBackground (const DC: HDC;
  1303.   const IntersectClippingRect: TRect; const ExcludeClippingRect: PRect;
  1304.   const DrawRect: TRect);
  1305. var
  1306.   UseBmp: TBitmap;
  1307.   R2: TRect;
  1308.   SaveIndex: Integer;
  1309.   DC2: HDC;
  1310. begin
  1311.   UseBmp := FBkg;
  1312.   { When FBkgTransparent is True, it keeps a cached copy of the
  1313.     background that has the transparent color already translated. Without the
  1314.     cache, redraws can be very slow.
  1315.     Note: The cache is cleared in the OnChange event of FBkg }
  1316.   if FBkgTransparent then begin
  1317.     if FBkgCache = nil then begin
  1318.       FBkgCache := TBitmap.Create;
  1319.       with FBkgCache do begin
  1320.         Palette := CopyPalette(FBkg.Palette);
  1321.         Width := FBkg.Width;
  1322.         Height := FBkg.Height;
  1323.         Canvas.Brush.Color := Self.Color;
  1324.         Canvas.BrushCopy (Rect(0, 0, Width, Height), FBkg,
  1325.           Rect(0, 0, Width, Height), FBkg.Canvas.Pixels[0, Height-1] or $02000000);
  1326.       end;
  1327.     end;
  1328.     UseBmp := FBkgCache;
  1329.   end;
  1330.  
  1331.   SaveIndex := SaveDC(DC);
  1332.   try
  1333.     with IntersectClippingRect do
  1334.       IntersectClipRect (DC, Left, Top, Right, Bottom);
  1335.     if Assigned(ExcludeClippingRect) then
  1336.       with ExcludeClippingRect^ do
  1337.         ExcludeClipRect (DC, Left, Top, Right, Bottom);
  1338.     if UseBmp.Palette <> 0 then begin
  1339.       SelectPalette (DC, UseBmp.Palette, True);
  1340.       RealizePalette (DC);
  1341.     end;
  1342.     R2 := DrawRect;
  1343.     while R2.Left < R2.Right do begin
  1344.       while R2.Top < R2.Bottom do begin
  1345.         { Note: versions of Toolbar97 prior to 1.68 used 'UseBmp.Canvas.Handle'
  1346.           instead of DC2 in the BitBlt call. This was changed because there
  1347.           seems to be a bug in D2/BCB1's Graphics.pas: if you called
  1348.           <dockname>.Background.LoadFromFile(<filename>) twice the background
  1349.           would not be shown. }  
  1350.         DC2 := CreateCompatibleDC(DC);
  1351.         SelectObject (DC2, UseBmp.Handle);
  1352.         BitBlt (DC, R2.Left, R2.Top, UseBmp.Width, UseBmp.Height,
  1353.           DC2, 0, 0, SRCCOPY);
  1354.         DeleteDC (DC2);
  1355.  
  1356.         Inc (R2.Top, UseBmp.Height);
  1357.       end;
  1358.       R2.Top := DrawRect.Top;
  1359.       Inc (R2.Left, UseBmp.Width);
  1360.     end;
  1361.   finally
  1362.     { Restores the clipping region and palette back }
  1363.     RestoreDC (DC, SaveIndex);
  1364.   end;
  1365. end;
  1366.  
  1367. procedure TDock97.Paint;
  1368. var
  1369.   R, R2: TRect;
  1370.   P1, P2: TPoint;
  1371. begin
  1372.   inherited;
  1373.   with Canvas do begin
  1374.     R := ClientRect;
  1375.  
  1376.     { Draw dotted border in design mode }
  1377.     if csDesigning in ComponentState then begin
  1378.       Pen.Style := psDot;
  1379.       Pen.Color := clBtnShadow;
  1380.       Brush.Style := bsClear;
  1381.       Rectangle (R.Left, R.Top, R.Right, R.Bottom);
  1382.       Pen.Style := psSolid;
  1383.       InflateRect (R, -1, -1);
  1384.     end;
  1385.  
  1386.     { Draw the Background }
  1387.     if UsingBackground then begin
  1388.       R2 := ClientRect;
  1389.       { Make up for nonclient area }
  1390.       P1 := ClientToScreen(Point(0, 0));
  1391.       P2 := Parent.ClientToScreen(BoundsRect.TopLeft);
  1392.       Dec (R2.Left, Left + (P1.X-P2.X));
  1393.       Dec (R2.Top, Top + (P1.Y-P2.Y));
  1394.       DrawBackground (Canvas.Handle, R, nil, R2);
  1395.     end;
  1396.   end;
  1397. end;
  1398.  
  1399. procedure TDock97.WMMove (var Message: TWMMove);
  1400. begin
  1401.   inherited;
  1402.   if UsingBackground then
  1403.     InvalidateBackgrounds;
  1404. end;
  1405.  
  1406. procedure TDock97.WMSize (var Message: TWMSize);
  1407. begin
  1408.   inherited;
  1409.   ArrangeToolbars (False);
  1410.   if not(csLoading in ComponentState) and Assigned(FOnResize) then
  1411.     FOnResize (Self);
  1412. end;
  1413.  
  1414. procedure TDock97.WMNCCalcSize (var Message: TWMNCCalcSize);
  1415. begin
  1416.   inherited;
  1417.   { note to self: non-client size is stored in FNonClientWidth &
  1418.     FNonClientHeight }
  1419.   with Message.CalcSize_Params^.rgrc[0] do begin
  1420.     if blTop in BoundLines then Inc (Top);
  1421.     if blBottom in BoundLines then Dec (Bottom);
  1422.     if blLeft in BoundLines then Inc (Left);
  1423.     if blRight in BoundLines then Dec (Right);
  1424.   end;
  1425. end;
  1426.  
  1427. procedure TDock97.DrawNCArea (const DrawToDC: Boolean; const ADC: HDC;
  1428.   const Clip: HRGN);
  1429.  
  1430.   procedure DrawLine (const DC: HDC; const X1, Y1, X2, Y2: Integer);
  1431.   begin
  1432.     MoveToEx (DC, X1, Y1, nil);  LineTo (DC, X2, Y2);
  1433.   end;
  1434. var
  1435.   RW, R, R2, RC: TRect;
  1436.   DC: HDC;
  1437.   HighlightPen, ShadowPen, SavePen: HPEN;
  1438.   FillBrush: HBRUSH;
  1439. label 1;
  1440. begin
  1441.   { This works around WM_NCPAINT problem described at top of source code }
  1442.   {no!  R := Rect(0, 0, Width, Height);}
  1443.   GetWindowRect (Handle, RW);
  1444.   R := RW;
  1445.   OffsetRect (R, -R.Left, -R.Top);
  1446.  
  1447.   if not DrawToDC then
  1448.     DC := GetWindowDC(Handle)
  1449.   else
  1450.     DC := ADC;
  1451.   try
  1452.     { Use update region }
  1453.     if not DrawToDC then
  1454.       SelectNCUpdateRgn (Handle, DC, Clip);
  1455.  
  1456.     { Draw BoundLines }
  1457.     R2 := R;
  1458.     if (BoundLines <> []) and
  1459.        ((csDesigning in ComponentState) or HasVisibleToolbars) then begin
  1460.       HighlightPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT));
  1461.       ShadowPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW));
  1462.       SavePen := SelectObject(DC, ShadowPen);
  1463.       if blTop in BoundLines then begin
  1464.         DrawLine (DC, R.Left, R.Top, R.Right, R.Top);
  1465.         Inc (R2.Top);
  1466.       end;
  1467.       if blLeft in BoundLines then begin
  1468.         DrawLine (DC, R.Left, R.Top, R.Left, R.Bottom);
  1469.         Inc (R2.Left);
  1470.       end;
  1471.       SelectObject (DC, HighlightPen);
  1472.       if blBottom in BoundLines then begin
  1473.         DrawLine (DC, R.Left, R.Bottom-1, R.Right, R.Bottom-1);
  1474.         Dec (R2.Bottom);
  1475.       end;
  1476.       if blRight in BoundLines then begin
  1477.         DrawLine (DC, R.Right-1, R.Top, R.Right-1, R.Bottom);
  1478.         Dec (R2.Right);
  1479.       end;
  1480.       SelectObject (DC, SavePen);
  1481.       DeleteObject (ShadowPen);
  1482.       DeleteObject (HighlightPen);
  1483.     end;
  1484.     Windows.GetClientRect (Handle, RC);
  1485.     if not IsRectEmpty(RC) then begin
  1486.       { ^ ExcludeClipRect can't be passed rectangles that have (Bottom < Top) or
  1487.         (Right < Left) since it doesn't treat them as empty }
  1488.       MapWindowPoints (Handle, 0, RC, 2);
  1489.       OffsetRect (RC, -RW.Left, -RW.Top);
  1490.       if EqualRect(RC, R2) then
  1491.         { Skip FillRect because there would be nothing left after ExcludeClipRect }
  1492.         goto 1;
  1493.       ExcludeClipRect (DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
  1494.     end;
  1495.     FillBrush := CreateSolidBrush(ColorToRGB(Color));
  1496.     FillRect (DC, R2, FillBrush);
  1497.     DeleteObject (FillBrush);
  1498.     1:
  1499.   finally
  1500.     if not DrawToDC then
  1501.       ReleaseDC (Handle, DC);
  1502.   end;
  1503. end;
  1504.  
  1505. procedure TDock97.WMNCPaint (var Message: TMessage);
  1506. begin
  1507.   DrawNCArea (False, 0, HRGN(Message.WParam));
  1508. end;
  1509.  
  1510. procedure DockNCPaintProc (Wnd: HWND; DC: HDC; AppData: Longint);
  1511. begin
  1512.   TDock97(AppData).DrawNCArea (True, DC, 0);
  1513. end;
  1514.  
  1515. procedure TDock97.WMPrint (var Message: TMessage);
  1516. begin
  1517.   HandleWMPrint (Handle, Message, DockNCPaintProc, Longint(Self));
  1518. end;
  1519.  
  1520. procedure TDock97.WMPrintClient (var Message: TMessage);
  1521. begin
  1522.   HandleWMPrintClient (Self, Message);
  1523. end;
  1524.  
  1525. procedure TDock97.CMColorChanged (var Message: TMessage);
  1526. begin
  1527.   if UsingBackground then
  1528.     { Erase the cache }
  1529.     BackgroundChanged (FBkg);
  1530.   inherited;
  1531. end;
  1532.  
  1533. procedure TDock97.CMSysColorChange (var Message: TMessage);
  1534. begin
  1535.   inherited;
  1536.   if UsingBackground then
  1537.     { Erase the cache }
  1538.     BackgroundChanged (FBkg);
  1539. end;
  1540.  
  1541. { TDock97 - property access methods }
  1542.  
  1543. procedure TDock97.SetAllowDrag (Value: Boolean);
  1544. var
  1545.   I: Integer;
  1546. begin
  1547.   if FAllowDrag <> Value then begin
  1548.     FAllowDrag := Value;
  1549.     for I := 0 to ControlCount-1 do
  1550.       if Controls[I] is TCustomToolWindow97 then
  1551.         RecalcNCArea (TCustomToolWindow97(Controls[I]));
  1552.   end;
  1553. end;
  1554.  
  1555. procedure TDock97.SetBackground (Value: TBitmap);
  1556. begin
  1557.   FBkg.Assign (Value);
  1558. end;
  1559.  
  1560. function TDock97.UsingBackground: Boolean;
  1561. begin
  1562.   Result := (FBkg.Width <> 0) and (FBkg.Height <> 0);
  1563. end;
  1564.  
  1565. procedure TDock97.InvalidateBackgrounds;
  1566. { Called after background is changed }
  1567. var
  1568.   I: Integer;
  1569.   T: TCustomToolWindow97;
  1570. begin
  1571.   Invalidate;
  1572.   { Synchronize child toolbars also }
  1573.   for I := 0 to DockList.Count-1 do begin
  1574.     T := TCustomToolWindow97(DockList[I]);
  1575.     with T do
  1576.       if ToolbarVisibleOnDock(T) then begin
  1577.         InvalidateDockedNCArea;
  1578.         Invalidate;
  1579.       end;
  1580.   end;
  1581. end;
  1582.  
  1583. procedure TDock97.BackgroundChanged (Sender: TObject);
  1584. begin
  1585.   { Erase the cache }
  1586.   FBkgCache.Free;
  1587.   FBkgCache := nil;
  1588.   InvalidateBackgrounds;
  1589. end;
  1590.  
  1591. procedure TDock97.SetBackgroundOnToolbars (Value: Boolean);
  1592. begin
  1593.   if FBkgOnToolbars <> Value then begin
  1594.     FBkgOnToolbars := Value;
  1595.     InvalidateBackgrounds;
  1596.   end;
  1597. end;
  1598.  
  1599. procedure TDock97.SetBackgroundTransparent (Value: Boolean);
  1600. begin
  1601.   if FBkgTransparent <> Value then begin
  1602.     FBkgTransparent := Value;
  1603.     if UsingBackground then
  1604.       { Erase the cache }
  1605.       BackgroundChanged (FBkg);
  1606.   end;
  1607. end;
  1608.  
  1609. procedure TDock97.SetBoundLines (Value: TDockBoundLines);
  1610. var
  1611.   X, Y: Integer;
  1612.   B: TDockBoundLines;
  1613. begin
  1614.   if FBoundLines <> Value then begin
  1615.     FBoundLines := Value;
  1616.     X := 0;
  1617.     Y := 0;
  1618.     B := BoundLines;  { optimization }
  1619.     if blTop in B then Inc (Y);
  1620.     if blBottom in B then Inc (Y);
  1621.     if blLeft in B then Inc (X);
  1622.     if blRight in B then Inc (X);
  1623.     FNonClientWidth := X;
  1624.     FNonClientHeight := Y;
  1625.     RecalcNCArea (Self);
  1626.   end;
  1627. end;
  1628.  
  1629. procedure TDock97.SetFixAlign (Value: Boolean);
  1630. begin
  1631.   if FFixAlign <> Value then begin
  1632.     FFixAlign := Value;
  1633.     ArrangeToolbars (False);
  1634.   end;
  1635. end;
  1636.  
  1637. procedure TDock97.SetPosition (Value: TDockPosition);
  1638. begin
  1639.   if (FPosition <> Value) and (ControlCount <> 0) then
  1640.     raise EInvalidOperation.Create(STB97DockCannotChangePosition);
  1641.   FPosition := Value;
  1642.   case Position of
  1643.     dpTop: Align := alTop;
  1644.     dpBottom: Align := alBottom;
  1645.     dpLeft: Align := alLeft;
  1646.     dpRight: Align := alRight;
  1647.   end;
  1648. end;
  1649.  
  1650. function TDock97.GetToolbarCount: Integer;
  1651. begin
  1652.   Result := DockVisibleList.Count;
  1653. end;
  1654.  
  1655. function TDock97.GetToolbars (Index: Integer): TCustomToolWindow97;
  1656. begin
  1657.   Result := TCustomToolWindow97(DockVisibleList[Index]);
  1658. end;
  1659.  
  1660. function TDock97.GetVersion: TToolbar97Version;
  1661. begin
  1662.   Result := Toolbar97VersionPropText;
  1663. end;
  1664.  
  1665. procedure TDock97.SetVersion (const Value: TToolbar97Version);
  1666. begin
  1667.   { write method required for the property to show up in Object Inspector }
  1668. end;
  1669.  
  1670.  
  1671. { TFloatingWindowParent - Internal }
  1672.  
  1673. constructor TFloatingWindowParent.Create (AOwner: TComponent);
  1674. begin
  1675.   { Don't use TForm's Create since it attempts to load a form resource, which
  1676.     TFloatingWindowParent doesn't have. }
  1677.   CreateNew (AOwner {$IFDEF VER93} , 0 {$ENDIF});
  1678. end;
  1679.  
  1680. procedure TFloatingWindowParent.CreateParams (var Params: TCreateParams);
  1681. begin
  1682.   inherited;
  1683.   { The WS_EX_TOOLWINDOW style is needed to prevent the form from having
  1684.     a taskbar button when Toolbar97 is used in a DLL or OCX. }
  1685.   Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW;
  1686. end;
  1687.  
  1688. procedure TFloatingWindowParent.CMShowingChanged (var Message: TMessage);
  1689. const
  1690.   ShowFlags: array[Boolean] of UINT = (
  1691.     SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW,
  1692.     SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW);
  1693. begin
  1694.   { Must override TCustomForm/TForm's CM_SHOWINGCHANGED handler so that the
  1695.     form doesn't get activated when Visible is set to True. }
  1696.   SetWindowPos (WindowHandle, 0, 0, 0, 0, 0, ShowFlags[Showing and FShouldShow]);
  1697. end;
  1698.  
  1699. procedure TFloatingWindowParent.CMDialogKey (var Message: TCMDialogKey);
  1700. begin
  1701.   { If Escape if pressed on a floating toolbar, return focus to the form }
  1702.   if (Message.CharCode = VK_ESCAPE) and (KeyDataToShiftState(Message.KeyData) = []) and
  1703.      Assigned(ParentForm) then begin
  1704.     ParentForm.SetFocus;
  1705.     Message.Result := 1;
  1706.   end
  1707.   else
  1708.     inherited;
  1709. end;
  1710.  
  1711.  
  1712. { Global procedures }
  1713.  
  1714. procedure CustomLoadToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  1715.   const ReadIntProc: TPositionReadIntProc;
  1716.   const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
  1717. var
  1718.   Rev: Integer;
  1719.  
  1720.   function FindDock (AName: String): TDock97;
  1721.   var
  1722.     I: Integer;
  1723.   begin
  1724.     Result := nil;
  1725.     for I := 0 to Form.ComponentCount-1 do
  1726.       if (Form.Components[I] is TDock97) and (Form.Components[I].Name = AName) then begin
  1727.         Result := TDock97(Form.Components[I]);
  1728.         Break;
  1729.       end;
  1730.   end;
  1731.   procedure ReadValues (const Toolbar: TCustomToolWindow97; const NewDock: TDock97);
  1732.   var
  1733.     Pos: TPoint;
  1734.     LastDockName: String;
  1735.     ADock: TDock97;
  1736.   begin
  1737.     with Toolbar do begin
  1738.       DockRow := ReadIntProc(Name, rvDockRow, DockRow, ExtraData);
  1739.       DockPos := ReadIntProc(Name, rvDockPos, DockPos, ExtraData);
  1740.       Pos.X := ReadIntProc(Name, rvFloatLeft, 0, ExtraData);
  1741.       Pos.Y := ReadIntProc(Name, rvFloatTop, 0, ExtraData);
  1742.       ReadPositionData (ReadIntProc, ReadStringProc, ExtraData);
  1743.       FFloatingTopLeft := Pos;
  1744.       if Assigned(NewDock) then
  1745.         Parent := NewDock
  1746.       else begin
  1747.         Parent := Form;
  1748.         SetBounds (Pos.X, Pos.Y, Width, Height);
  1749.         MoveOnScreen (True);
  1750.         if (Rev >= 3) and FUseLastDock then begin
  1751.           LastDockName := ReadStringProc(Name, rvLastDock, '', ExtraData);
  1752.           if LastDockName <> '' then begin
  1753.             ADock := FindDock(LastDockName);
  1754.             if Assigned(ADock) then
  1755.               LastDock := ADock;
  1756.           end;
  1757.         end;
  1758.       end;
  1759.       ArrangeControls;
  1760.       DoneReadingPositionData (ReadIntProc, ReadStringProc, ExtraData);
  1761.     end;
  1762.   end;
  1763. var
  1764.   DocksDisabled: TList;
  1765.   I: Integer;
  1766.   ToolWindow: TComponent;
  1767.   ADock: TDock97;
  1768.   DockedToName: String;
  1769. begin
  1770.   DocksDisabled := TList.Create;
  1771.   try
  1772.     with Form do
  1773.       for I := 0 to ComponentCount-1 do
  1774.         if Components[I] is TDock97 then begin
  1775.           TDock97(Components[I]).BeginUpdate;
  1776.           DocksDisabled.Add (Components[I]);
  1777.         end;
  1778.  
  1779.     for I := 0 to Form.ComponentCount-1 do begin
  1780.       ToolWindow := Form.Components[I];
  1781.       if ToolWindow is TCustomToolWindow97 then
  1782.         with TCustomToolWindow97(ToolWindow) do begin
  1783.           if Name = '' then
  1784.             raise Exception.Create (STB97ToolWinNameNotSet);
  1785.           Rev := ReadIntProc(Name, rvRev, 0, ExtraData);
  1786.           if Rev in [2..3] then begin
  1787.             Visible := ReadIntProc(Name, rvVisible, Ord(Visible), ExtraData) <> 0;
  1788.             DockedToName := ReadStringProc(Name, rvDockedTo, '', ExtraData);
  1789.             if DockedToName <> '' then begin
  1790.               if DockedToName <> rdDockedToFloating then begin
  1791.                 ADock := FindDock(DockedToName);
  1792.                 if (ADock <> nil) and (ADock.FAllowDrag) then
  1793.                   ReadValues (TCustomToolWindow97(ToolWindow), ADock);
  1794.               end
  1795.               else
  1796.                 ReadValues (TCustomToolWindow97(ToolWindow), nil);
  1797.             end;
  1798.           end;
  1799.         end;
  1800.     end;
  1801.   finally
  1802.     for I := DocksDisabled.Count-1 downto 0 do
  1803.       TDock97(DocksDisabled[I]).EndUpdate;
  1804.     DocksDisabled.Free;
  1805.   end;
  1806. end;
  1807.  
  1808. procedure CustomSaveToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  1809.   const WriteIntProc: TPositionWriteIntProc;
  1810.   const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer);
  1811. var
  1812.   I: Integer;
  1813.   N, L: String;
  1814. begin
  1815.   for I := 0 to Form.ComponentCount-1 do
  1816.     if Form.Components[I] is TCustomToolWindow97 then
  1817.       with TCustomToolWindow97(Form.Components[I]) do begin
  1818.         if Name = '' then
  1819.           raise Exception.Create (STB97ToolwinNameNotSet);
  1820.         if not Docked then
  1821.           N := rdDockedToFloating
  1822.         else begin
  1823.           if DockedTo.FAllowDrag then begin
  1824.             N := DockedTo.Name;
  1825.             if N = '' then
  1826.               raise Exception.Create (STB97ToolwinDockedToNameNotSet);
  1827.           end
  1828.           else
  1829.             N := '';
  1830.         end;
  1831.         L := '';
  1832.         if Assigned(FLastDock) then
  1833.           L := FLastDock.Name;
  1834.         WriteIntProc (Name, rvRev, rdCurrentRev, ExtraData);
  1835.         WriteIntProc (Name, rvVisible, Ord(Visible), ExtraData);
  1836.         WriteStringProc (Name, rvDockedTo, N, ExtraData);
  1837.         WriteStringProc (Name, rvLastDock, L, ExtraData);
  1838.         WriteIntProc (Name, rvDockRow, FDockRow, ExtraData);
  1839.         WriteIntProc (Name, rvDockPos, FDockPos, ExtraData);
  1840.         WriteIntProc (Name, rvFloatLeft, FFloatingTopLeft.X, ExtraData);
  1841.         WriteIntProc (Name, rvFloatTop, FFloatingTopLeft.Y, ExtraData);
  1842.         WritePositionData (WriteIntProc, WriteStringProc, ExtraData);
  1843.       end;
  1844. end;
  1845.  
  1846. type
  1847.   PIniReadWriteData = ^TIniReadWriteData;
  1848.   TIniReadWriteData = record
  1849.     IniFile: TIniFile;
  1850.     SectionNamePrefix: String;
  1851.   end;
  1852.  
  1853. function IniReadInt (const ToolbarName, Value: String; const Default: Longint;
  1854.   const ExtraData: Pointer): Longint; far;
  1855. begin
  1856.   Result := PIniReadWriteData(ExtraData).IniFile.ReadInteger(
  1857.     PIniReadWriteData(ExtraData).SectionNamePrefix + ToolbarName, Value, Default);
  1858. end;
  1859. function IniReadString (const ToolbarName, Value, Default: String;
  1860.   const ExtraData: Pointer): String; far;
  1861. begin
  1862.   Result := PIniReadWriteData(ExtraData).IniFile.ReadString(
  1863.     PIniReadWriteData(ExtraData).SectionNamePrefix + ToolbarName, Value, Default);
  1864. end;
  1865. procedure IniWriteInt (const ToolbarName, Value: String; const Data: Longint;
  1866.   const ExtraData: Pointer); far;
  1867. begin
  1868.   PIniReadWriteData(ExtraData).IniFile.WriteInteger (
  1869.     PIniReadWriteData(ExtraData).SectionNamePrefix + ToolbarName, Value, Data);
  1870. end;
  1871. procedure IniWriteString (const ToolbarName, Value, Data: String;
  1872.   const ExtraData: Pointer); far;
  1873. begin
  1874.   PIniReadWriteData(ExtraData).IniFile.WriteString (
  1875.     PIniReadWriteData(ExtraData).SectionNamePrefix + ToolbarName, Value, Data);
  1876. end;
  1877.  
  1878. procedure IniLoadToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  1879.   const Filename, SectionNamePrefix: String);
  1880. var
  1881.   Data: TIniReadWriteData;
  1882. begin
  1883.   Data.IniFile := TIniFile.Create(Filename);
  1884.   try
  1885.     Data.SectionNamePrefix := SectionNamePrefix;
  1886.     CustomLoadToolbarPositions (Form, IniReadInt, IniReadString, @Data);
  1887.   finally
  1888.     Data.IniFile.Free;
  1889.   end;
  1890. end;
  1891.  
  1892. procedure IniSaveToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  1893.   const Filename, SectionNamePrefix: String);
  1894. var
  1895.   Data: TIniReadWriteData;
  1896. begin
  1897.   Data.IniFile := TIniFile.Create(Filename);
  1898.   try
  1899.     Data.SectionNamePrefix := SectionNamePrefix;
  1900.     CustomSaveToolbarPositions (Form, IniWriteInt, IniWriteString, @Data);
  1901.   finally
  1902.     Data.IniFile.Free;
  1903.   end;
  1904. end;
  1905.  
  1906. function RegReadInt (const ToolbarName, Value: String; const Default: Longint;
  1907.   const ExtraData: Pointer): Longint; far;
  1908. begin
  1909.   Result := TRegIniFile(ExtraData).ReadInteger(ToolbarName, Value, Default);
  1910. end;
  1911. function RegReadString (const ToolbarName, Value, Default: String;
  1912.   const ExtraData: Pointer): String; far;
  1913. begin
  1914.   Result := TRegIniFile(ExtraData).ReadString(ToolbarName, Value, Default);
  1915. end;
  1916. procedure RegWriteInt (const ToolbarName, Value: String; const Data: Longint;
  1917.   const ExtraData: Pointer); far;
  1918. begin
  1919.   TRegIniFile(ExtraData).WriteInteger (ToolbarName, Value, Data);
  1920. end;
  1921. procedure RegWriteString (const ToolbarName, Value, Data: String;
  1922.   const ExtraData: Pointer); far;
  1923. begin
  1924.   TRegIniFile(ExtraData).WriteString (ToolbarName, Value, Data);
  1925. end;
  1926.  
  1927. procedure RegLoadToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  1928.   const BaseRegistryKey: String);
  1929. begin
  1930.   RegLoadToolbarPositionsEx (Form, HKEY_CURRENT_USER, BaseRegistryKey);
  1931. end;
  1932.  
  1933. procedure RegLoadToolbarPositionsEx (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  1934.   const RootKey: DWORD; const BaseRegistryKey: String);
  1935. var
  1936.   Reg: TRegIniFile;
  1937. begin
  1938.   Reg := TRegIniFile.Create('');
  1939.   try
  1940.     Reg.RootKey := RootKey;
  1941.     Reg.OpenKey (BaseRegistryKey, True);  { assigning to RootKey resets the current key }
  1942.     CustomLoadToolbarPositions (Form, RegReadInt, RegReadString, Reg);
  1943.   finally
  1944.     Reg.Free;
  1945.   end;
  1946. end;
  1947.  
  1948. procedure RegSaveToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  1949.   const BaseRegistryKey: String);
  1950. begin
  1951.   RegSaveToolbarPositionsEx (Form, HKEY_CURRENT_USER, BaseRegistryKey);
  1952. end;
  1953.  
  1954. procedure RegSaveToolbarPositionsEx (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  1955.   const RootKey: DWORD; const BaseRegistryKey: String);
  1956. var
  1957.   Reg: TRegIniFile;
  1958. begin
  1959.   Reg := TRegIniFile.Create('');
  1960.   try
  1961.     Reg.RootKey := RootKey;
  1962.     Reg.OpenKey (BaseRegistryKey, True);  { assigning to RootKey resets the current key }
  1963.     CustomSaveToolbarPositions (Form, RegWriteInt, RegWriteString, Reg);
  1964.   finally
  1965.     Reg.Free;
  1966.   end;
  1967. end;
  1968.  
  1969.  
  1970. { TCustomToolWindow97 - Internal }
  1971.  
  1972. constructor TCustomToolWindow97.Create (AOwner: TComponent);
  1973. begin
  1974.   inherited;
  1975.  
  1976.   GetToolbarDockPosProc := GetToolbarDockPos;
  1977.  
  1978.   ControlStyle := ControlStyle +
  1979.     [csAcceptsControls, csClickEvents, csDoubleClicks, csSetCaption] -
  1980.     [csCaptureMouse{capturing is done manually}, csOpaque];
  1981.  
  1982.   InstallHookProc (ToolbarHookProc,
  1983.     [hpSendActivateApp, hpSendWindowPosChanged, hpPreDestroy],
  1984.     csDesigning in ComponentState);
  1985.  
  1986.   GetParams (FParams);
  1987.  
  1988.   FActivateParent := True;
  1989.   FBorderStyle := bsSingle;
  1990.   FDockableTo := [dpTop, dpBottom, dpLeft, dpRight];
  1991.   FCloseButton := True;
  1992.   FResizable := True;
  1993.   FShowCaption := True;
  1994.   FHideWhenInactive := True;
  1995.   FUseLastDock := True;
  1996.   FDockPos := -1;
  1997.   Color := clBtnFace;
  1998. end;
  1999.  
  2000. destructor TCustomToolWindow97.Destroy;
  2001. begin
  2002.   inherited;
  2003.   FDockForms.Free;  { must be done after 'inherited' because Notification accesses FDockForms }
  2004.   FFloatParent.Free;
  2005.   UninstallHookProc (ToolbarHookProc);
  2006. end;
  2007.  
  2008. function TCustomToolWindow97.HasParent: Boolean;
  2009. begin
  2010.   if Parent is TFloatingWindowParent then
  2011.     Result := False
  2012.   else
  2013.     Result := inherited HasParent;
  2014. end;
  2015.  
  2016. function TCustomToolWindow97.GetParentComponent: TComponent;
  2017. begin
  2018.   if Parent is TFloatingWindowParent then
  2019.     Result := nil
  2020.   else
  2021.     Result := inherited GetParentComponent;
  2022. end;
  2023.  
  2024. procedure TCustomToolWindow97.SetInactiveCaption (Value: Boolean);
  2025. begin
  2026.   if csDesigning in ComponentState then
  2027.     Value := False;
  2028.   if FInactiveCaption <> Value then begin
  2029.     FInactiveCaption := Value;
  2030.     InvalidateFloatingNCArea ([twrdCaption]);
  2031.   end;
  2032. end;
  2033.  
  2034. procedure TCustomToolWindow97.Moved;
  2035. begin
  2036.   if not(csLoading in ComponentState) and (FDisableOnMove <= 0) then
  2037.     DoMove;
  2038. end;
  2039.  
  2040. procedure TCustomToolWindow97.WMMove (var Message: TWMMove);
  2041. begin
  2042.   inherited;
  2043.   FMoved := True;
  2044.   if Docked and DockedTo.UsingBackground then begin
  2045.     { Needs to redraw so that background is lined up with the dock at the
  2046.       new position }
  2047.     InvalidateDockedNCArea;
  2048.     { To minimize flicker, InvalidateRect is called with the Erase parameter
  2049.       set to False instead of calling the Invalidate method }
  2050.     if HandleAllocated then
  2051.       InvalidateRect (Handle, nil, False);
  2052.   end;
  2053.   Moved;
  2054. end;
  2055.  
  2056. procedure TCustomToolWindow97.WMSize (var Message: TWMSize);
  2057. begin
  2058.   inherited;
  2059.   if not(csLoading in ComponentState) and Assigned(FOnResize) then
  2060.     FOnResize (Self);
  2061. end;
  2062.  
  2063. procedure TCustomToolWindow97.WMGetMinMaxInfo (var Message: TWMGetMinMaxInfo);
  2064. begin
  2065.   inherited;
  2066.   { Because the window uses the WS_THICKFRAME style (but not for the usual
  2067.     purpose), it must process the WM_GETMINMAXINFO message to remove the
  2068.     minimum and maximum size limits it imposes by default. }
  2069.   with Message.MinMaxInfo^ do begin
  2070.     with ptMinTrackSize do begin
  2071.       X := 1;
  2072.       Y := 1;
  2073.       { Note to self: Don't put GetMinimumSize code here, since
  2074.         ClientWidth/Height values are sometimes invalid during a RecreateWnd }
  2075.     end;
  2076.     with ptMaxTrackSize do begin
  2077.       { Because of the 16-bit (signed) size limitations of Windows 95,
  2078.         Smallints must be used instead of Integers or Longints }
  2079.       X := High(Smallint);
  2080.       Y := High(Smallint);
  2081.     end;
  2082.   end;
  2083. end;
  2084.  
  2085. procedure TCustomToolWindow97.WMEnable (var Message: TWMEnable);
  2086. begin
  2087.   inherited;
  2088.   { When a modal dialog is displayed and the toolbar window gets disabled as
  2089.     a result, remove its topmost flag. }
  2090.   if FFloatingMode = fmOnTopOfAllForms then
  2091.     UpdateTopmostFlag;
  2092. end;
  2093.  
  2094. function TCustomToolWindow97.GetShowingState: Boolean;
  2095. var
  2096.   HideFloatingToolbars: Boolean;
  2097.   ParentForm, MDIParentForm: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  2098. begin
  2099.   Result := Showing and (FHidden = 0);
  2100.   if not Docked and not(csDesigning in ComponentState) then begin
  2101.     HideFloatingToolbars := FFloatingMode = fmOnTopOfParentForm;
  2102.     if HideFloatingToolbars then begin
  2103.       ParentForm := GetToolWindowParentForm(Self);
  2104.       MDIParentForm := GetMDIParent(ParentForm);
  2105.       if Assigned(ParentForm) and Assigned(MDIParentForm) then begin
  2106.         HideFloatingToolbars := not ParentForm.HandleAllocated or
  2107.           not MDIParentForm.HandleAllocated;
  2108.         if not HideFloatingToolbars then begin
  2109.           HideFloatingToolbars := IsIconic(Application.Handle) or
  2110.             not IsWindowVisible(ParentForm.Handle) or IsIconic(ParentForm.Handle);
  2111.           if MDIParentForm <> ParentForm then
  2112.             HideFloatingToolbars := HideFloatingToolbars or
  2113.               not IsWindowVisible(MDIParentForm.Handle) or IsIconic(MDIParentForm.Handle);
  2114.         end;
  2115.       end;
  2116.     end;
  2117.     Result := Result and not (HideFloatingToolbars or (FHideWhenInactive and not ApplicationIsActive));
  2118.   end;
  2119. end;
  2120.  
  2121. procedure TCustomToolWindow97.UpdateVisibility;
  2122. begin
  2123.   SetInactiveCaption (not Docked and (not FHideWhenInactive and not ApplicationIsActive));
  2124.   if HandleAllocated and (IsWindowVisible(Handle) <> GetShowingState) then
  2125.     Perform (CM_SHOWINGCHANGED, 0, 0);
  2126. end;
  2127.  
  2128. procedure TCustomToolWindow97.UpdateTopmostFlag;
  2129.   function IsTopmost (const Wnd: HWND): Boolean;
  2130.   begin
  2131.     Result := GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOPMOST <> 0;
  2132.   end;
  2133. const
  2134.   Wnds: array[Boolean] of HWND = (HWND_NOTOPMOST, HWND_TOPMOST);
  2135. var
  2136.   ShouldBeTopmost: Boolean;
  2137. begin
  2138.   if HandleAllocated then begin
  2139.     if FFloatingMode = fmOnTopOfAllForms then
  2140.       ShouldBeTopmost := IsWindowEnabled(Handle)
  2141.     else
  2142.       ShouldBeTopmost := IsTopmost(HWND(GetWindowLong(Handle, GWL_HWNDPARENT)));
  2143.     if ShouldBeTopmost <> IsTopmost(Handle) then
  2144.       { ^ it must check if it already was topmost or non-topmost or else
  2145.         it causes problems on Win95/98 for some reason }
  2146.       SetWindowPos (Handle, Wnds[ShouldBeTopmost], 0, 0, 0, 0,
  2147.         SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  2148.   end;
  2149. end;
  2150.  
  2151. procedure TCustomToolWindow97.CMShowingChanged (var Message: TMessage);
  2152.   function GetPrevWnd (W: HWND): HWND;
  2153.   var
  2154.     Done: Boolean;
  2155.     ParentWnd: HWND;
  2156.   label 1;
  2157.   begin
  2158.     Result := W;
  2159.     repeat
  2160.       Done := True;
  2161.       Result := GetWindow(Result, GW_HWNDPREV);
  2162.       ParentWnd := Result;
  2163.       while ParentWnd <> 0 do begin
  2164.         ParentWnd := HWND(GetWindowLong(ParentWnd, GWL_HWNDPARENT));
  2165.         if ParentWnd = W then begin
  2166.           Done := False;
  2167.           Break;
  2168.         end;
  2169.       end;
  2170.     until Done;
  2171.   end;
  2172. const
  2173.   ShowFlags: array[Boolean] of UINT = (
  2174.     SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW,
  2175.     SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW);
  2176. var
  2177.   Show: Boolean;
  2178.   Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  2179. begin
  2180.   { inherited isn't called since TCustomToolWindow97 handles CM_SHOWINGCHANGED
  2181.     itself. For reference, the original TWinControl implementation is:
  2182.     const
  2183.       ShowFlags: array[Boolean] of Word = (
  2184.         SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_HIDEWINDOW,
  2185.         SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_SHOWWINDOW);
  2186.     begin
  2187.       SetWindowPos(FHandle, 0, 0, 0, 0, 0, ShowFlags[FShowing]);
  2188.     end;
  2189.   }
  2190.   if HandleAllocated then begin
  2191.     Show := GetShowingState;
  2192.     if Parent is TFloatingWindowParent then begin
  2193.       if Show then begin
  2194.         { If the toolbar is floating, set its "owner window" to the parent form
  2195.           so that the toolbar window always stays on top of the form }
  2196.         if FFloatingMode = fmOnTopOfParentForm then begin
  2197.           Form := GetMDIParent(GetToolWindowParentForm(Self));
  2198.           if Assigned(Form) and Form.HandleAllocated and
  2199.              (HWND(GetWindowLong(Handle, GWL_HWNDPARENT)) <> Form.Handle) then begin
  2200.             SetWindowLong (Handle, GWL_HWNDPARENT, Longint(Form.Handle));
  2201.             { Following is necessarily to make it immediately realize the
  2202.               GWL_HWNDPARENT change }
  2203.             SetWindowPos (Handle, GetPrevWnd(Form.Handle), 0, 0, 0, 0, SWP_NOACTIVATE or
  2204.               SWP_NOMOVE or SWP_NOSIZE);
  2205.           end;
  2206.           UpdateTopmostFlag;
  2207.         end
  2208.         else begin
  2209.           SetWindowLong (Handle, GWL_HWNDPARENT, Longint(Application.Handle));
  2210.           UpdateTopmostFlag;
  2211.         end;
  2212.       end
  2213.       else
  2214.         UpdateTopmostFlag;
  2215.       { Show/hide the TFloatingWindowParent. The following lines had to be
  2216.         added to fix a problem that was in 1.65d/e. In 1.65d/e, it always
  2217.         kept TFloatingWindowParent visible (this change was made to improve
  2218.         compatibility with D4's Actions), but this for some odd reason would
  2219.         cause a Stack Overflow error if the program's main form was closed
  2220.         while a floating toolwindow was focused. (This problem did not occur
  2221.         on NT.) }
  2222.       TFloatingWindowParent(Parent).FShouldShow := Show;
  2223.       Parent.Perform (CM_SHOWINGCHANGED, 0, 0);
  2224.     end;
  2225.     SetWindowPos (Handle, 0, 0, 0, 0, 0, ShowFlags[Show]);
  2226.     if not Show and (GetActiveWindow = Handle) then
  2227.       { If the window is hidden but is still active, find and activate a
  2228.         different window }
  2229.       SetActiveWindow (FindTopLevelWindow(Handle));
  2230.   end;
  2231. end;
  2232.  
  2233. procedure TCustomToolWindow97.CreateParams (var Params: TCreateParams);
  2234. const
  2235.   ThickFrames: array[Boolean] of DWORD = (0, WS_THICKFRAME);
  2236. begin
  2237.   inherited;
  2238.  
  2239.   { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker
  2240.     and are not necessary for this control at run time }
  2241.   if not(csDesigning in ComponentState) then
  2242.     with Params.WindowClass do
  2243.       Style := Style and not(CS_HREDRAW or CS_VREDRAW);
  2244.  
  2245.   { When floating... }
  2246.   if not(Parent is TDock97) then
  2247.     with Params do begin
  2248.       { Note: WS_THICKFRAME and WS_BORDER styles are included to ensure that
  2249.         sizing grips are displayed on child controls with scrollbars. The
  2250.         thick frame or border is not drawn by Windows; TCustomToolWindow97
  2251.         handles all border drawing by itself. }
  2252.       if not(csDesigning in ComponentState) then
  2253.         Style := WS_POPUP or WS_BORDER or ThickFrames[FResizable]
  2254.       else
  2255.         Style := Style or WS_BORDER or ThickFrames[FResizable];
  2256.       { The WS_EX_TOOLWINDOW style is needed so there isn't a taskbar button
  2257.         for the toolbar when FloatingMode = fmOnTopOfAllForms. }
  2258.       ExStyle := WS_EX_TOOLWINDOW;
  2259.     end;
  2260. end;
  2261.  
  2262. procedure TCustomToolWindow97.Notification (AComponent: TComponent; Operation: TOperation);
  2263. begin
  2264.   inherited;
  2265.   if Operation = opRemove then begin
  2266.     if AComponent = FDefaultDock then
  2267.       FDefaultDock := nil
  2268.     else
  2269.     if AComponent = FLastDock then
  2270.       FLastDock := nil
  2271.     else begin
  2272.       if Assigned(FDockForms) then begin
  2273.         FDockForms.Remove (AComponent);
  2274.         if FDockForms.Count = 0 then begin
  2275.           FDockForms.Free;
  2276.           FDockForms := nil;
  2277.         end;
  2278.       end;
  2279.       if Assigned(FFloatParent) and (AComponent = FFloatParent.FParentForm) then begin
  2280.         if Parent = FFloatParent then begin
  2281.           if FFloatingMode = fmOnTopOfParentForm then
  2282.             Parent := nil
  2283.           else
  2284.             FFloatParent.FParentForm := nil;
  2285.         end
  2286.         else begin
  2287.           FFloatParent.Free;
  2288.           FFloatParent := nil;
  2289.         end;
  2290.       end;
  2291.     end;
  2292.   end;
  2293. end;
  2294.  
  2295. procedure TCustomToolWindow97.MoveOnScreen (const OnlyIfFullyOffscreen: Boolean);
  2296. { Moves the (floating) toolbar so that it is fully (or at least mostly) in
  2297.   view on the screen }
  2298. var
  2299.   R, S, Test: TRect;
  2300. begin
  2301.   if not Docked then begin
  2302.     R := BoundsRect;
  2303.     S := GetDesktopAreaOfMonitorContainingRect(R);
  2304.  
  2305.     if OnlyIfFullyOffscreen and IntersectRect(Test, R, S) then
  2306.       Exit;
  2307.  
  2308.     if R.Right > S.Right then
  2309.       OffsetRect (R, S.Right - R.Right, 0);
  2310.     if R.Bottom > S.Bottom then
  2311.       OffsetRect (R, 0, S.Bottom - R.Bottom);
  2312.     if R.Left < S.Left then
  2313.       OffsetRect (R, S.Left - R.Left, 0);
  2314.     if R.Top < S.Top then
  2315.       OffsetRect (R, 0, S.Top - R.Top);
  2316.     BoundsRect := R;
  2317.   end;
  2318. end;
  2319.  
  2320. procedure TCustomToolWindow97.ReadPositionData (const ReadIntProc: TPositionReadIntProc;
  2321.   const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
  2322. begin
  2323. end;
  2324.  
  2325. procedure TCustomToolWindow97.DoneReadingPositionData (const ReadIntProc: TPositionReadIntProc;
  2326.   const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
  2327. begin
  2328. end;
  2329.  
  2330. procedure TCustomToolWindow97.WritePositionData (const WriteIntProc: TPositionWriteIntProc;
  2331.   const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer);
  2332. begin
  2333. end;
  2334.  
  2335. procedure TCustomToolWindow97.InitializeOrdering;
  2336. begin
  2337. end;
  2338.  
  2339. procedure TCustomToolWindow97.GetDockRowSize (var AHeightOrWidth: Integer);
  2340. begin
  2341.   if Docked then
  2342.     with DockedTo do begin
  2343.       BuildRowInfo;
  2344.       AHeightOrWidth := DockedTo.GetRowSize(FDockRow, Self);
  2345.     end
  2346.   else
  2347.     GetBarSize (AHeightOrWidth, dtNotDocked);
  2348. end;
  2349.  
  2350. procedure TCustomToolWindow97.SizeChanging (const AWidth, AHeight: Integer);
  2351. begin
  2352. end;
  2353.  
  2354. procedure TCustomToolWindow97.ReadSavedAtRunTime (Reader: TReader);
  2355. begin
  2356.   FSavedAtRunTime := Reader.ReadBoolean;
  2357. end;
  2358.  
  2359. procedure TCustomToolWindow97.WriteSavedAtRunTime (Writer: TWriter);
  2360. begin
  2361.   { WriteSavedAtRunTime only called when not(csDesigning in ComponentState) }
  2362.   Writer.WriteBoolean (True);
  2363. end;
  2364.  
  2365. procedure TCustomToolWindow97.DefineProperties (Filer: TFiler);
  2366. begin
  2367.   inherited;
  2368.   Filer.DefineProperty ('SavedAtRunTime', ReadSavedAtRunTime,
  2369.     WriteSavedAtRunTime, not(csDesigning in ComponentState));
  2370. end;
  2371.  
  2372. procedure TCustomToolWindow97.Loaded;
  2373. var
  2374.   R: TRect;
  2375. begin
  2376.   inherited;
  2377.   { Adjust coordinates if it was initially floating }
  2378.   if not FSavedAtRunTime and not(csDesigning in ComponentState) and
  2379.      (Parent is TFloatingWindowParent) then begin
  2380.     R := BoundsRect;
  2381.     MapWindowPoints (ValidToolWindowParentForm(Self).Handle, 0, R, 2);
  2382.     BoundsRect := R;
  2383.     MoveOnScreen (False);
  2384.   end;
  2385.   InitializeOrdering;
  2386.   { Arranging of controls is disabled while component was loading, so rearrange
  2387.     it now }
  2388.   ArrangeControls;
  2389. end;
  2390.  
  2391. procedure TCustomToolWindow97.BeginUpdate;
  2392. begin
  2393.   Inc (FDisableArrangeControls);
  2394. end;
  2395.  
  2396. procedure TCustomToolWindow97.EndUpdate;
  2397. begin
  2398.   Dec (FDisableArrangeControls);
  2399.   if FArrangeNeeded and (FDisableArrangeControls = 0) then
  2400.     ArrangeControls;
  2401. end;
  2402.  
  2403. procedure TCustomToolWindow97.AddDockForm (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF});
  2404. begin
  2405.   if Form = nil then Exit;
  2406.   if FDockForms = nil then FDockForms := TList.Create;
  2407.   if FDockForms.IndexOf(Form) = -1 then begin
  2408.     FDockForms.Add (Form);
  2409.     Form.FreeNotification (Self);
  2410.   end;
  2411. end;
  2412.  
  2413. procedure TCustomToolWindow97.RemoveDockForm (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF});
  2414. begin
  2415.   if Assigned(FDockForms) then begin
  2416.     FDockForms.Remove (Form);
  2417.     if FDockForms.Count = 0 then begin
  2418.       FDockForms.Free;
  2419.       FDockForms := nil;
  2420.     end;
  2421.   end;
  2422. end;
  2423.  
  2424. procedure TCustomToolWindow97.CustomArrangeControls (const PreviousDockType: TDockType;
  2425.   const DockingTo: TDock97; const Resize: Boolean);
  2426. var
  2427.   WH: Integer;
  2428.   Size: TPoint;
  2429. begin
  2430.   if (FDisableArrangeControls > 0) or
  2431.      { Prevent flicker while loading or destroying }
  2432.      (csLoading in ComponentState) or
  2433.      { This will not work if it's destroying }
  2434.      (csDestroying in ComponentState) or
  2435.      (Parent = nil) or
  2436.      (Parent.HandleAllocated and (csDestroying in Parent.ComponentState)) then begin
  2437.     FArrangeNeeded := True;
  2438.     Exit;
  2439.   end;
  2440.  
  2441.   FArrangeNeeded := False;
  2442.  
  2443.   Inc (FDisableArrangeControls);
  2444.   try
  2445.     Size := OrderControls(True, PreviousDockType, DockingTo);
  2446.     with Size do
  2447.       if Resize then begin
  2448.         if Docked then begin
  2449.           GetDockRowSize (WH);
  2450.           if not(DockedTo.Position in PositionLeftOrRight) then begin
  2451.             if WH > Y then Y := WH;
  2452.             if FullSize then
  2453.               X := (DockedTo.Width-DockedTo.NonClientWidth) - FNonClientWidth;
  2454.           end
  2455.           else begin
  2456.             if WH > X then X := WH;
  2457.             if FullSize then
  2458.               Y := (DockedTo.Height-DockedTo.NonClientHeight) - FNonClientHeight;
  2459.           end;
  2460.         end;
  2461.         Inc (X, FNonClientWidth);
  2462.         Inc (Y, FNonClientHeight);
  2463.         if (Width <> X) or (Height <> Y) then begin
  2464.           Inc (FUpdatingBounds);
  2465.           try
  2466.             SetBounds (Left, Top, X, Y);
  2467.           finally
  2468.             Dec (FUpdatingBounds);
  2469.           end;
  2470.         end;
  2471.       end;
  2472.   finally
  2473.     Dec (FDisableArrangeControls);
  2474.   end;
  2475. end;
  2476.  
  2477. procedure TCustomToolWindow97.ArrangeControls;
  2478. begin
  2479.   CustomArrangeControls (GetDockTypeOf(DockedTo), DockedTo, True);
  2480. end;
  2481.  
  2482. procedure TCustomToolWindow97.AlignControls (AControl: TControl; var Rect: TRect);
  2483. { VCL calls this whenever any child controls in the toolbar are moved, sized,
  2484.   inserted, etc. It doesn't need to make use of the AControl and Rect
  2485.   parameters. }
  2486. begin
  2487.   if Params.CallAlignControls then
  2488.     inherited;
  2489.   ArrangeControls;
  2490. end;
  2491.  
  2492. procedure TCustomToolWindow97.SetBounds (ALeft, ATop, AWidth, AHeight: Integer);
  2493. begin
  2494.   if (FUpdatingBounds = 0) and ((AWidth <> Width) or (AHeight <> Height)) then
  2495.     SizeChanging (AWidth, AHeight);
  2496.   { This allows you to drag the toolbar around the dock at design time }
  2497.   if (csDesigning in ComponentState) and not(csLoading in ComponentState) and
  2498.      Docked and (FUpdatingBounds = 0) and ((ALeft <> Left) or (ATop <> Top)) then begin
  2499.     if not(DockedTo.Position in PositionLeftOrRight) then begin
  2500.       FDockRow := DockedTo.GetDesignModeRowOf(ATop+(Height div 2));
  2501.       FDockPos := ALeft;
  2502.     end
  2503.     else begin
  2504.       FDockRow := DockedTo.GetDesignModeRowOf(ALeft+(Width div 2));
  2505.       FDockPos := ATop;
  2506.     end;
  2507.     inherited SetBounds (Left, Top, AWidth, AHeight);  { only pass any size changes }
  2508.     DockedTo.ArrangeToolbars (False);  { let ArrangeToolbars take care of position changes }
  2509.   end
  2510.   else begin
  2511.     inherited;
  2512.     if not(csLoading in ComponentState) and not Docked and (FUpdatingBounds = 0) then
  2513.       FFloatingTopLeft := BoundsRect.TopLeft;
  2514.   end;
  2515. end;
  2516.  
  2517. procedure TCustomToolWindow97.SetParent (AParent: TWinControl);
  2518.   procedure UpdateFloatingToolWindows;
  2519.   begin
  2520.     if Parent is TFloatingWindowParent then begin
  2521.       if FloatingToolWindows = nil then
  2522.         FloatingToolWindows := TList.Create;
  2523.       if FloatingToolWindows.IndexOf(Self) = -1 then
  2524.         FloatingToolWindows.Add (Self);
  2525.       SetBounds (FFloatingTopLeft.X, FFloatingTopLeft.Y, Width, Height);
  2526.     end
  2527.     else 
  2528.       if Assigned(FloatingToolWindows) then begin
  2529.         FloatingToolWindows.Remove (Self);
  2530.         if FloatingToolWindows.Count = 0 then begin
  2531.           FloatingToolWindows.Free;
  2532.           FloatingToolWindows := nil;
  2533.         end;
  2534.       end;
  2535.   end;
  2536.   function ParentToDockedTo (const Ctl: TWinControl): TDock97;
  2537.   begin
  2538.     if Ctl is TDock97 then
  2539.       Result := TDock97(Ctl)
  2540.     else
  2541.       Result := nil;
  2542.   end;
  2543. var
  2544.   NewFloatParent: TFloatingWindowParent;
  2545.   OldDockedTo, NewDockedTo: TDock97;
  2546.   OldParent: TWinControl;
  2547. begin
  2548.   if (AParent <> nil) and not(AParent is TDock97) and
  2549.      not(AParent is {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}) then
  2550.     raise EInvalidOperation.Create(STB97ToolwinParentNotAllowed);
  2551.  
  2552.   if not(csDesigning in ComponentState) and
  2553.      (AParent is {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}) then begin
  2554.     if (FFloatParent = nil) or (FFloatParent.FParentForm <> AParent) then begin
  2555.       NewFloatParent := TFloatingWindowParent.Create(nil);
  2556.       try
  2557.         with NewFloatParent do begin
  2558.           TWinControl(FParentForm) := AParent;
  2559.           Name := Format('TB97FloatingWindowParent_%.8x', [Longint(NewFloatParent)]);
  2560.           { ^ Must assign a unique name. In previous versions, reading in
  2561.             components at run-time that had no name caused them to get assigned
  2562.             names like "_1" because a component with no name -- the
  2563.             TFloatingWindowParent form -- already existed. }
  2564.           BorderStyle := bsNone;
  2565.           SetBounds (0, 0, 0, 0);
  2566.           ShowHint := True;
  2567.           Visible := True;
  2568.         end;
  2569.       except
  2570.         NewFloatParent.Free;
  2571.         raise;
  2572.       end;
  2573.       FFloatParent := NewFloatParent;
  2574.     end;
  2575.     AParent.FreeNotification (Self);
  2576.     AParent := FFloatParent;
  2577.   end;
  2578.  
  2579.   OldDockedTo := ParentToDockedTo(Parent);
  2580.   NewDockedTo := ParentToDockedTo(AParent);
  2581.  
  2582.   if AParent = Parent then begin
  2583.     { Even though AParent is the same as the current Parent, this code is
  2584.       necessary because when the VCL destroys the parent of the tool window,
  2585.       it calls TWinControl.Remove to set FParent instead of using SetParent.
  2586.       However TControl.Destroy does call SetParent(nil), so it is
  2587.       eventually notified of the change before it is destroyed. }
  2588.     FDockedTo := ParentToDockedTo(Parent);
  2589.     FDocked := FDockedTo <> nil;
  2590.     UpdateFloatingToolWindows;
  2591.   end
  2592.   else begin
  2593.     if not(csDestroying in ComponentState) and Assigned(AParent) then begin
  2594.       if Assigned(FOnDockChanging) then
  2595.         FOnDockChanging (Self);
  2596.       if Assigned(FOnDockChangingEx) then
  2597.         FOnDockChangingEx (Self, NewDockedTo);
  2598.       if Assigned(FOnRecreating) then
  2599.         FOnRecreating (Self);
  2600.     end;
  2601.  
  2602.     { Before changing between docked and floating state (and vice-versa)
  2603.       or between docks, increment FHidden and call UpdateVisibility to hide the
  2604.       toolbar. This prevents any flashing while it's being moved }
  2605.     Inc (FHidden);
  2606.     Inc (FDisableOnMove);
  2607.     try
  2608.       UpdateVisibility;
  2609.       if Assigned(OldDockedTo) then
  2610.         OldDockedTo.BeginUpdate;
  2611.       if Assigned(NewDockedTo) then
  2612.         NewDockedTo.BeginUpdate;
  2613.       Inc (FUpdatingBounds);
  2614.       try
  2615.         if Assigned(AParent) then begin
  2616.           DoDockChangingHidden (NewDockedTo);
  2617.           { Must pre-arrange controls in new dock orientation before changing
  2618.             the Parent }
  2619.           if FLastDockTypeSet then
  2620.             CustomArrangeControls (FLastDockType, NewDockedTo, False);
  2621.         end;
  2622.         FArrangeNeeded := True;  { force EndUpdate to rearrange }
  2623.         BeginUpdate;
  2624.         try
  2625.           if Parent is TDock97 then begin
  2626.             if not FUseLastDock then
  2627.               TDock97(Parent).ChangeDockList (False, Self);
  2628.             TDock97(Parent).ToolbarVisibilityChanged (Self, True);
  2629.           end;
  2630.  
  2631.           OldParent := Parent;
  2632.  
  2633.           { Ensure that the handle is destroyed now so that any messages in the queue
  2634.             get flushed. This is neccessary since existing messages may reference
  2635.             FDockedTo or FDocked, which is changed below. }
  2636.           inherited SetParent (nil);
  2637.           { ^ Note to self: SetParent is used instead of DestroyHandle because it does
  2638.             additional processing }
  2639.           FDockedTo := NewDockedTo;
  2640.           FDocked := FDockedTo <> nil;
  2641.           try
  2642.             inherited;
  2643.           except
  2644.             { Failure is rare, but just in case, restore FDockedTo and FDocked back. }
  2645.             FDockedTo := ParentToDockedTo(Parent);
  2646.             FDocked := FDockedTo <> nil;
  2647.             raise;
  2648.           end;
  2649.           { Force a recalc of NC sizes now so that FNonClientWidth &
  2650.             FNonClientHeight are accurate, even if the control didn't receive
  2651.             a WM_NCCALCSIZE message because it has no handle. }
  2652.           CalculateNonClientSizes (nil);
  2653.  
  2654.           if OldParent is TFloatingWindowParent then begin
  2655.             if FFloatParent = OldParent then FFloatParent := nil;
  2656.             OldParent.Free;
  2657.           end;
  2658.  
  2659.           if Parent is TDock97 then begin
  2660.             if FUseLastDock then begin
  2661.               LastDock := TDock97(Parent);  { calls ChangeDockList if LastDock changes }
  2662.               TDock97(Parent).ToolbarVisibilityChanged (Self, False);
  2663.             end
  2664.             else
  2665.               TDock97(Parent).ChangeDockList (True, Self);
  2666.           end;
  2667.  
  2668.           UpdateFloatingToolWindows;
  2669.         finally
  2670.           EndUpdate;
  2671.         end;
  2672.         if Assigned(Parent) then begin
  2673.           FLastDockType := GetDockTypeOf(NewDockedTo);
  2674.           FLastDockTypeSet := True;
  2675.         end;
  2676.       finally
  2677.         Dec (FUpdatingBounds);
  2678.         if Assigned(NewDockedTo) then
  2679.           NewDockedTo.EndUpdate;
  2680.         if Assigned(OldDockedTo) then
  2681.           OldDockedTo.EndUpdate;
  2682.       end;
  2683.     finally
  2684.       Dec (FDisableOnMove);
  2685.       Dec (FHidden);
  2686.       UpdateVisibility;
  2687.       { ^ The above UpdateVisibility call not only updates the tool window's
  2688.         visibility after decrementing FHidden, it also sets the
  2689.         active/inactive state of the caption. }
  2690.     end;
  2691.     if Assigned(Parent) then
  2692.       Moved;
  2693.  
  2694.     if not(csDestroying in ComponentState) and Assigned(AParent) then begin
  2695.       if Assigned(FOnRecreated) then
  2696.         FOnRecreated (Self);
  2697.       if Assigned(FOnDockChanged) then
  2698.         FOnDockChanged (Self);
  2699.     end;
  2700.   end;
  2701. end;
  2702.  
  2703. procedure TCustomToolWindow97.AddDockedNCAreaToSize (var S: TPoint;
  2704.   const LeftRight: Boolean);
  2705. var
  2706.   TopLeft, BottomRight: TPoint;
  2707. begin
  2708.   GetDockedNCArea (TopLeft, BottomRight, LeftRight);
  2709.   Inc (S.X, TopLeft.X + BottomRight.X);
  2710.   Inc (S.Y, TopLeft.Y + BottomRight.Y);
  2711. end;
  2712.  
  2713. procedure TCustomToolWindow97.AddFloatingNCAreaToSize (var S: TPoint);
  2714. var
  2715.   TopLeft, BottomRight: TPoint;
  2716. begin
  2717.   GetFloatingNCArea (TopLeft, BottomRight);
  2718.   Inc (S.X, TopLeft.X + BottomRight.X);
  2719.   Inc (S.Y, TopLeft.Y + BottomRight.Y);
  2720. end;
  2721.  
  2722. procedure TCustomToolWindow97.GetDockedNCArea (var TopLeft, BottomRight: TPoint;
  2723.   const LeftRight: Boolean);
  2724. var
  2725.   Z: Integer;
  2726. begin
  2727.   Z := DockedBorderSize;  { code optimization... }
  2728.   TopLeft.X := Z;
  2729.   TopLeft.Y := Z;
  2730.   BottomRight.X := Z;
  2731.   BottomRight.Y := Z;
  2732.   if not LeftRight then
  2733.     Inc (TopLeft.X, DragHandleSizes[CloseButtonWhenDocked, DragHandleStyle])
  2734.   else
  2735.     Inc (TopLeft.Y, DragHandleSizes[CloseButtonWhenDocked, DragHandleStyle]);
  2736. end;
  2737.  
  2738. function TCustomToolWindow97.GetFloatingBorderSize: TPoint;
  2739. { Returns size of a thick border. Note that, depending on the Windows version,
  2740.   this may not be the same as the actual window metrics since it draws its
  2741.   own border }
  2742. const
  2743.   XMetrics: array[Boolean] of Integer = (SM_CXDLGFRAME, SM_CXFRAME);
  2744.   YMetrics: array[Boolean] of Integer = (SM_CYDLGFRAME, SM_CYFRAME);
  2745. begin
  2746.   Result.X := GetSystemMetrics(XMetrics[Resizable]);
  2747.   Result.Y := GetSystemMetrics(YMetrics[Resizable]);
  2748. end;
  2749.  
  2750. procedure TCustomToolWindow97.GetFloatingNCArea (var TopLeft, BottomRight: TPoint);
  2751. begin
  2752.   with GetFloatingBorderSize do begin
  2753.     TopLeft.X := X;
  2754.     TopLeft.Y := Y;
  2755.     if ShowCaption then
  2756.       Inc (TopLeft.Y, GetSmallCaptionHeight);
  2757.     BottomRight.X := X;
  2758.     BottomRight.Y := Y;
  2759.   end;
  2760. end;
  2761.  
  2762. function GetCaptionRect (const Control: TCustomToolWindow97;
  2763.   const AdjustForBorder, MinusCloseButton: Boolean): TRect;
  2764. begin
  2765.   Result := Rect(0, 0, Control.ClientWidth, GetSmallCaptionHeight-1);
  2766.   if MinusCloseButton then
  2767.     Dec (Result.Right, Result.Bottom);
  2768.   if AdjustForBorder then
  2769.     with Control.GetFloatingBorderSize do
  2770.       OffsetRect (Result, X, Y);
  2771. end;
  2772.  
  2773. function GetCloseButtonRect (const Control: TCustomToolWindow97;
  2774.   const AdjustForBorder: Boolean): TRect;
  2775. begin
  2776.   Result := GetCaptionRect(Control, AdjustForBorder, False);
  2777.   Result.Left := Result.Right - (GetSmallCaptionHeight-1);
  2778. end;
  2779.  
  2780. function GetDockedCloseButtonRect (const Control: TCustomToolWindow97;
  2781.   const LeftRight: Boolean): TRect;
  2782. var
  2783.   X, Y, Z: Integer;
  2784. begin
  2785.   Z := DragHandleSizes[Control.CloseButtonWhenDocked, Control.FDragHandleStyle] - 3;
  2786.   if not LeftRight then begin
  2787.     X := DockedBorderSize+1;
  2788.     Y := DockedBorderSize;
  2789.   end
  2790.   else begin
  2791.     X := (Control.ClientWidth + DockedBorderSize) - Z;
  2792.     Y := DockedBorderSize+1;
  2793.   end;
  2794.   Result := Bounds(X, Y, Z, Z);
  2795. end;
  2796.  
  2797. procedure TCustomToolWindow97.CalculateNonClientSizes (R: PRect);
  2798. { Recalculates FNonClientWidth and FNonClientHeight.
  2799.   If R isn't nil, it deflates the rectangle to exclude the non-client area. }
  2800. var
  2801.   Temp: TRect;
  2802.   TL, BR: TPoint;
  2803.   Z: Integer;
  2804. begin
  2805.   if R = nil then
  2806.     R := @Temp;
  2807.   if not Docked then begin
  2808.     GetFloatingNCArea (TL, BR);
  2809.     FNonClientWidth := TL.X + BR.X;
  2810.     FNonClientHeight := TL.Y + BR.Y;
  2811.     with R^ do begin
  2812.       Inc (Left, TL.X);
  2813.       Inc (Top, TL.Y);
  2814.       Dec (Right, BR.X);
  2815.       Dec (Bottom, BR.Y);
  2816.     end;
  2817.   end
  2818.   else begin
  2819.     InflateRect (R^, -DockedBorderSize, -DockedBorderSize);
  2820.     FNonClientWidth := DockedBorderSize2;
  2821.     FNonClientHeight := DockedBorderSize2;
  2822.     if DockedTo.FAllowDrag then begin
  2823.       Z := DragHandleSizes[FCloseButtonWhenDocked, FDragHandleStyle];
  2824.       if not(DockedTo.Position in PositionLeftOrRight) then begin
  2825.         Inc (R.Left, Z);
  2826.         Inc (FNonClientWidth, Z);
  2827.       end
  2828.       else begin
  2829.         Inc (R.Top, Z);
  2830.         Inc (FNonClientHeight, Z);
  2831.       end;
  2832.     end;
  2833.   end;
  2834. end;
  2835.  
  2836. procedure TCustomToolWindow97.WMNCCalcSize (var Message: TWMNCCalcSize);
  2837. begin
  2838.   { Doesn't call inherited since it overrides the normal NC sizes }
  2839.   Message.Result := 0;
  2840.   CalculateNonClientSizes (@Message.CalcSize_Params^.rgrc[0]);
  2841. end;
  2842.  
  2843. procedure TCustomToolWindow97.DrawFloatingNCArea (const DrawToDC: Boolean;
  2844.   const ADC: HDC; const Clip: HRGN; RedrawWhat: TToolWindowNCRedrawWhat);
  2845. { Redraws all the non-client area (the border, title bar, and close button) of
  2846.   the toolbar when it is floating. }
  2847. const
  2848.   COLOR_GRADIENTACTIVECAPTION = 27;
  2849.   COLOR_GRADIENTINACTIVECAPTION = 28;
  2850.   CaptionBkColors: array[Boolean, Boolean] of Integer =
  2851.     ((COLOR_ACTIVECAPTION, COLOR_INACTIVECAPTION),
  2852.      (COLOR_GRADIENTACTIVECAPTION, COLOR_GRADIENTINACTIVECAPTION));
  2853.   CaptionTextColors: array[Boolean] of Integer =
  2854.     (COLOR_CAPTIONTEXT, COLOR_INACTIVECAPTIONTEXT);
  2855.  
  2856.   function GradientCaptionsEnabled: Boolean;
  2857.   const
  2858.     SPI_GETGRADIENTCAPTIONS = $1008;  { Win98/NT5 only }
  2859.   var
  2860.     S: BOOL;
  2861.   begin
  2862.     Result := False;
  2863.     if NewStyleControls and SystemParametersInfo(SPI_GETGRADIENTCAPTIONS, 0, @S, 0) then
  2864.       Result := S;
  2865.   end;
  2866.  
  2867.   procedure Win3DrawCaption (const DC: HDC; const R: TRect);
  2868.   { Emulates DrawCaption, which isn't supported in Win 3.x }
  2869.   const
  2870.     Ellipsis = '...';
  2871.   var
  2872.     R2: TRect;
  2873.     SaveTextColor, SaveBkColor: TColorRef;
  2874.     SaveFont: HFONT;
  2875.     Cap: String;
  2876.  
  2877.     function CaptionTextWidth: Integer;
  2878.     var
  2879.       Size: TSize;
  2880.     begin
  2881.       GetTextExtentPoint32 (DC, PChar(Cap), Length(Cap), Size);
  2882.       Result := Size.cx;
  2883.     end;
  2884.   begin
  2885.     R2 := R;
  2886.  
  2887.     { Fill the rectangle }
  2888.     FillRect (DC, R2, GetSysColorBrush(CaptionBkColors[False, FInactiveCaption]));
  2889.  
  2890.     Inc (R2.Left);
  2891.     Dec (R2.Right);
  2892.  
  2893.     SaveFont := SelectObject(DC, CreateFont(-11, 0, 0, 0, FW_NORMAL, 0, 0, 0, 0, 0, 0, 0, 0, 'MS Sans Serif'));
  2894.  
  2895.     { Add ellipsis to caption if necessary }
  2896.     Cap := Caption;
  2897.     if CaptionTextWidth > R2.Right-R2.Left then begin
  2898.       Cap := Cap + Ellipsis;
  2899.       while (CaptionTextWidth > R2.Right-R2.Left) and (Length(Cap) > 4) do
  2900.         Delete (Cap, Length(Cap)-Length(Ellipsis), 1)
  2901.     end;
  2902.  
  2903.     { Draw the text }
  2904.     SaveBkColor := SetBkColor(DC, GetSysColor(CaptionBkColors[False, FInactiveCaption]));
  2905.     SaveTextColor := SetTextColor(DC, GetSysColor(CaptionTextColors[FInactiveCaption]));
  2906.     DrawText (DC, PChar(Cap), Length(Cap), R2, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER);
  2907.     SetTextColor (DC, SaveTextColor);
  2908.     SetBkColor (DC, SaveBkColor);
  2909.  
  2910.     DeleteObject (SelectObject(DC, SaveFont));
  2911.   end;
  2912. const
  2913.   CloseButtonState: array[Boolean] of UINT = (0, DFCS_PUSHED);
  2914.   ActiveCaptionFlags: array[Boolean] of UINT = (DC_ACTIVE, 0);
  2915.   DC_GRADIENT = $20;
  2916.   GradientCaptionFlags: array[Boolean] of UINT = (0, DC_GRADIENT);
  2917. var
  2918.   DC: HDC;
  2919.   R: TRect;
  2920.   Gradient: Boolean;
  2921.   NewDrawCaption: function(p1: HWND; p2: HDC; const p3: TRect; p4: UINT): BOOL; stdcall;
  2922.   SavePen: HPEN;
  2923.   SaveIndex: Integer;
  2924.   TL, BR: TPoint;
  2925. begin
  2926.   if not DrawToDC then
  2927.     RedrawWhat := RedrawWhat + ValidateFloatingNCArea;
  2928.   if Docked or not HandleAllocated then Exit;
  2929.  
  2930.   if not DrawToDC then
  2931.     DC := GetWindowDC(Handle)
  2932.   else
  2933.     DC := ADC;
  2934.   try
  2935.     { Use update region }
  2936.     if not DrawToDC then
  2937.       SelectNCUpdateRgn (Handle, DC, Clip);
  2938.  
  2939.     Gradient := GradientCaptionsEnabled;
  2940.  
  2941.     { Border }
  2942.     if twrdBorder in RedrawWhat then begin
  2943.       { This works around WM_NCPAINT problem described at top of source code }
  2944.       {no!  R := Rect(0, 0, Width, Height);}
  2945.       GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  2946.       DrawEdge (DC, R, EDGE_RAISED, BF_RECT);
  2947.       SaveIndex := SaveDC(DC);
  2948.       GetFloatingNCArea (TL, BR);
  2949.       with R do
  2950.         ExcludeClipRect (DC, Left + TL.X, Top + TL.Y, Right - BR.X, Bottom - BR.Y);
  2951.       InflateRect (R, -2, -2);
  2952.       FillRect (DC, R, GetSysColorBrush(COLOR_BTNFACE));
  2953.       RestoreDC (DC, SaveIndex);
  2954.     end;
  2955.  
  2956.     if ShowCaption then begin
  2957.       if (twrdCaption in RedrawWhat) and FCloseButton and (twrdCloseButton in RedrawWhat) then
  2958.         SaveIndex := SaveDC(DC)
  2959.       else
  2960.         SaveIndex := 0;
  2961.       try
  2962.         if SaveIndex <> 0 then
  2963.           with GetCloseButtonRect(Self, True) do
  2964.             { Reduces flicker }
  2965.             ExcludeClipRect (DC, Left, Top, Right, Bottom);
  2966.  
  2967.         { Caption }
  2968.         if twrdCaption in RedrawWhat then begin
  2969.           R := GetCaptionRect(Self, True, FCloseButton);
  2970.           if NewStyleControls then begin
  2971.             { Use a dynamic import of DrawCaption since it's Win95/NT 4.0 only.
  2972.               Also note that Delphi's Win32 help for DrawCaption is totally wrong!
  2973.               I got updated info from www.microsoft.com/msdn/sdk/ }
  2974.             NewDrawCaption := GetProcAddress(GetModuleHandle(user32), 'DrawCaption');
  2975.             NewDrawCaption (Handle, DC, R, DC_TEXT or DC_SMALLCAP or
  2976.               ActiveCaptionFlags[FInactiveCaption] or
  2977.               GradientCaptionFlags[Gradient]);
  2978.           end
  2979.           else
  2980.             Win3DrawCaption (DC, R);
  2981.  
  2982.           { Line below caption }
  2983.           R := GetCaptionRect(Self, True, False);
  2984.           SavePen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNFACE)));
  2985.           MoveToEx (DC, R.Left, R.Bottom, nil);
  2986.           LineTo (DC, R.Right, R.Bottom);
  2987.           DeleteObject (SelectObject(DC, SavePen));
  2988.         end;
  2989.       finally
  2990.         if SaveIndex <> 0 then
  2991.           RestoreDC (DC, SaveIndex);
  2992.       end;
  2993.  
  2994.       { Close button }
  2995.       if FCloseButton then begin
  2996.         if twrdCloseButton in RedrawWhat then begin
  2997.           R := GetCloseButtonRect(Self, True);
  2998.           InflateRect (R, -1, -1);
  2999.           DrawFrameControl (DC, R, DFC_CAPTION, DFCS_CAPTIONCLOSE or
  3000.             CloseButtonState[FCloseButtonDown]);
  3001.         end;
  3002.         if twrdCaption in RedrawWhat then begin
  3003.           { Caption-colored frame around close button }
  3004.           R := GetCloseButtonRect(Self, True);
  3005.           FrameRect (DC, R, GetSysColorBrush(CaptionBkColors[Gradient, FInactiveCaption]));
  3006.         end;
  3007.       end;
  3008.     end;
  3009.   finally
  3010.     if not DrawToDC then
  3011.       ReleaseDC (Handle, DC);
  3012.   end;
  3013. end;
  3014.  
  3015. procedure TCustomToolWindow97.ValidateDockedNCArea;
  3016. var
  3017.   Msg: TMsg;
  3018. begin
  3019.   { Remove any WM_TB97PaintDockedNCArea messages from the queue }
  3020.   if HandleAllocated then
  3021.     while PeekMessage(Msg, Handle, WM_TB97PaintDockedNCArea,
  3022.        WM_TB97PaintDockedNCArea, PM_REMOVE or PM_NOYIELD) do begin
  3023.       if Msg.Message = WM_QUIT then begin
  3024.         { If a WM_QUIT message was posted with PostQuitMessage (and not
  3025.           PostMessage(..., WM_QUIT, ...) which is NOT equivalent), it isn't
  3026.           returned the same way as ordinary messages. First,
  3027.           PeekMessage/GetMessage can return it even if the specified range
  3028.           doesn't include WM_QUIT. Also, PeekMessage/GetMessage will only
  3029.           return the WM_QUIT message if there are no other user messages in the
  3030.           queue. So if a WM_QUIT message is returned here, there can't be any
  3031.           WM_TB97PaintDockedNCArea messages in the queue. }
  3032.         PostQuitMessage (Msg.wParam);  { repost it }
  3033.         Break;
  3034.       end;
  3035.     end;
  3036. end;
  3037.  
  3038. function TCustomToolWindow97.ValidateFloatingNCArea: TToolWindowNCRedrawWhat;
  3039. var
  3040.   Msg: TMsg;
  3041. begin
  3042.   Result := [];
  3043.   { Remove any WM_TB97PaintFloatingNCArea messages from the queue }
  3044.   if HandleAllocated then
  3045.     while PeekMessage(Msg, Handle, WM_TB97PaintFloatingNCArea,
  3046.        WM_TB97PaintFloatingNCArea, PM_REMOVE or PM_NOYIELD) do begin
  3047.       if Msg.Message = WM_QUIT then begin
  3048.         { If a WM_QUIT message was posted with PostQuitMessage (and not
  3049.           PostMessage(..., WM_QUIT, ...) which is NOT equivalent), it isn't
  3050.           returned the same way as ordinary messages. First,
  3051.           PeekMessage/GetMessage can return it even if the specified range
  3052.           doesn't include WM_QUIT. Also, PeekMessage/GetMessage will only
  3053.           return the WM_QUIT message if there are no other user messages in the
  3054.           queue. So if a WM_QUIT message is returned here, there can't be any
  3055.           WM_TB97PaintFloatingNCArea messages in the queue. }
  3056.         PostQuitMessage (Msg.wParam);  { repost it }
  3057.         Break;
  3058.       end;
  3059.       Result := Result + TToolWindowNCRedrawWhat(Byte(Msg.lParam));
  3060.     end;
  3061. end;
  3062.  
  3063. procedure TCustomToolWindow97.InvalidateDockedNCArea;
  3064. begin
  3065.   ValidateDockedNCArea;
  3066.   if HandleAllocated and IsWindowVisible(Handle) then
  3067.     PostMessage (Handle, WM_TB97PaintDockedNCArea, 0, 0);
  3068. end;
  3069.  
  3070. procedure TCustomToolWindow97.InvalidateFloatingNCArea (const RedrawWhat: TToolWindowNCRedrawWhat);
  3071. var
  3072.   Old: TToolWindowNCRedrawWhat;
  3073. begin
  3074.   Old := ValidateFloatingNCArea;
  3075.   if HandleAllocated and IsWindowVisible(Handle) then
  3076.     PostMessage (Handle, WM_TB97PaintFloatingNCArea, 0, Byte(RedrawWhat + Old));
  3077. end;
  3078.  
  3079. procedure TCustomToolWindow97.WMTB97PaintDockedNCArea (var Message: TMessage);
  3080. begin
  3081.   DrawDockedNCArea (False, 0, 0);
  3082. end;
  3083.  
  3084. procedure TCustomToolWindow97.WMTB97PaintFloatingNCArea (var Message: TMessage);
  3085. begin
  3086.   DrawFloatingNCArea (False, 0, 0, TToolWindowNCRedrawWhat(Byte(Message.LParam)));
  3087. end;
  3088.  
  3089. procedure TCustomToolWindow97.DrawDockedNCArea (const DrawToDC: Boolean;
  3090.   const ADC: HDC; const Clip: HRGN);
  3091. { Redraws all the non-client area of the toolbar when it is docked. }
  3092. var
  3093.   DC: HDC;
  3094.   R: TRect;
  3095.   DockType: TDockType;
  3096.   X, Y, Y2, Y3, S, SaveIndex: Integer;
  3097.   R2, R3, R4: TRect;
  3098.   P1, P2: TPoint;
  3099.   Brush: HBRUSH;
  3100.   Clr: TColorRef;
  3101.   UsingBackground, B: Boolean;
  3102.   procedure DrawRaisedEdge (R: TRect; const FillInterior: Boolean);
  3103.   const
  3104.     FillMiddle: array[Boolean] of UINT = (0, BF_MIDDLE);
  3105.   begin
  3106.     DrawEdge (DC, R, BDR_RAISEDINNER, BF_RECT or FillMiddle[FillInterior]);
  3107.   end;
  3108. const
  3109.   CloseButtonState: array[Boolean] of UINT = (0, DFCS_PUSHED);
  3110. begin
  3111.   if not DrawToDC then
  3112.     ValidateDockedNCArea;
  3113.   if not Docked or not HandleAllocated then Exit;
  3114.  
  3115.   if not DrawToDC then
  3116.     DC := GetWindowDC(Handle)
  3117.   else
  3118.     DC := ADC;
  3119.   try
  3120.     { Use update region }
  3121.     if not DrawToDC then
  3122.       SelectNCUpdateRgn (Handle, DC, Clip);
  3123.  
  3124.     { This works around WM_NCPAINT problem described at top of source code }
  3125.     {no!  R := Rect(0, 0, Width, Height);}
  3126.     GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  3127.  
  3128.     if not(DockedTo.Position in PositionLeftOrRight) then
  3129.       DockType := dtTopBottom
  3130.     else
  3131.       DockType := dtLeftRight;
  3132.  
  3133.     Brush := CreateSolidBrush(ColorToRGB(Color));
  3134.  
  3135.     UsingBackground := DockedTo.UsingBackground and DockedTo.FBkgOnToolbars;
  3136.  
  3137.     { Border }
  3138.     if BorderStyle = bsSingle then
  3139.       DrawRaisedEdge (R, False)
  3140.     else
  3141.       FrameRect (DC, R, Brush);
  3142.     R2 := R;
  3143.     InflateRect (R2, -1, -1);
  3144.     if not UsingBackground then
  3145.       FrameRect (DC, R2, Brush);
  3146.  
  3147.     { Draw the Background }
  3148.     if UsingBackground then begin
  3149.       R2 := R;
  3150.       P1 := DockedTo.ClientToScreen(Point(0, 0));
  3151.       P2 := DockedTo.Parent.ClientToScreen(DockedTo.BoundsRect.TopLeft);
  3152.       Dec (R2.Left, Left + DockedTo.Left + (P1.X-P2.X));
  3153.       Dec (R2.Top, Top + DockedTo.Top + (P1.Y-P2.Y));
  3154.       InflateRect (R, -1, -1);
  3155.       GetWindowRect (Handle, R4);
  3156.       R3 := ClientRect;
  3157.       with ClientToScreen(Point(0, 0)) do
  3158.         OffsetRect (R3, X-R4.Left, Y-R4.Top);
  3159.       DockedTo.DrawBackground (DC, R, @R3, R2);
  3160.     end;
  3161.  
  3162.     { The drag handle at the left, or top }
  3163.     if DockedTo.FAllowDrag then begin
  3164.       SaveIndex := SaveDC(DC);
  3165.       if DockType <> dtLeftRight then
  3166.         Y2 := ClientHeight
  3167.       else
  3168.         Y2 := ClientWidth;
  3169.       Inc (Y2, DockedBorderSize);
  3170.       Y3 := Y2;
  3171.       S := DragHandleSizes[FCloseButtonWhenDocked, FDragHandleStyle];
  3172.       if FDragHandleStyle <> dhNone then begin
  3173.         X := DockedBorderSize + DragHandleOffsets[FCloseButtonWhenDocked, FDragHandleStyle];
  3174.         Y := DockedBorderSize;
  3175.         if FCloseButtonWhenDocked then begin
  3176.           if DockType <> dtLeftRight then
  3177.             Inc (Y, S - 2)
  3178.           else
  3179.             Dec (Y3, S - 2);
  3180.         end;
  3181.         Clr := GetSysColor(COLOR_BTNHIGHLIGHT);
  3182.         for B := False to (FDragHandleStyle = dhDouble) do begin
  3183.           if DockType <> dtLeftRight then
  3184.             R := Rect(X, Y, X+3, Y2)
  3185.           else
  3186.             R := Rect(Y, X, Y3, X+3);
  3187.           DrawRaisedEdge (R, True);
  3188.           if DockType <> dtLeftRight then
  3189.             SetPixelV (DC, X, Y2-1, Clr)
  3190.           else
  3191.             SetPixelV (DC, Y2-1, X, Clr);
  3192.           ExcludeClipRect (DC, R.Left, R.Top, R.Right, R.Bottom);
  3193.           Inc (X, 3);
  3194.         end;
  3195.       end;
  3196.       { Close button }
  3197.       if FCloseButtonWhenDocked then begin
  3198.         R := GetDockedCloseButtonRect(Self, DockType = dtLeftRight);
  3199.         DrawFrameControl (DC, R, DFC_CAPTION,
  3200.           DFCS_CAPTIONCLOSE or CloseButtonState[FCloseButtonDown]);
  3201.         ExcludeClipRect (DC, R.Left, R.Top, R.Right, R.Bottom);
  3202.       end;
  3203.       if not UsingBackground then begin
  3204.         if DockType <> dtLeftRight then
  3205.           R := Rect(DockedBorderSize, DockedBorderSize,
  3206.             DockedBorderSize+S, Y2)
  3207.         else
  3208.           R := Rect(DockedBorderSize, DockedBorderSize,
  3209.             Y2, DockedBorderSize+S);
  3210.         FillRect (DC, R, Brush);
  3211.       end;
  3212.       RestoreDC (DC, SaveIndex);
  3213.     end;
  3214.  
  3215.     DeleteObject (Brush);
  3216.   finally
  3217.     if not DrawToDC then
  3218.       ReleaseDC (Handle, DC);
  3219.   end;
  3220. end;
  3221.  
  3222. procedure TCustomToolWindow97.WMNCPaint (var Message: TMessage);
  3223. begin
  3224.   { Don't call inherited because it overrides the default NC painting }
  3225.   if Docked then
  3226.     DrawDockedNCArea (False, 0, HRGN(Message.WParam))
  3227.   else
  3228.     DrawFloatingNCArea (False, 0, HRGN(Message.WParam), twrdAll);
  3229. end;
  3230.  
  3231. procedure ToolWindowNCPaintProc (Wnd: HWND; DC: HDC; AppData: Longint);
  3232. begin
  3233.   with TCustomToolWindow97(AppData) do begin
  3234.     if Docked then
  3235.       DrawDockedNCArea (True, DC, 0)
  3236.     else
  3237.       DrawFloatingNCArea (True, DC, 0, twrdAll);
  3238.   end;
  3239. end;
  3240.  
  3241. procedure TCustomToolWindow97.WMPrint (var Message: TMessage);
  3242. begin
  3243.   HandleWMPrint (Handle, Message, ToolWindowNCPaintProc, Longint(Self));
  3244. end;
  3245.  
  3246. procedure TCustomToolWindow97.WMPrintClient (var Message: TMessage);
  3247. begin
  3248.   HandleWMPrintClient (Self, Message);
  3249. end;
  3250.  
  3251. procedure TCustomToolWindow97.Paint;
  3252. var
  3253.   R, R2, R3: TRect;
  3254.   P1, P2: TPoint;
  3255. begin
  3256.   inherited;
  3257.  
  3258.   if Docked and DockedTo.UsingBackground and DockedTo.FBkgOnToolbars then begin
  3259.     R := ClientRect;
  3260.     R2 := R;
  3261.     P1 := DockedTo.ClientToScreen(Point(0, 0));
  3262.     P2 := DockedTo.Parent.ClientToScreen(DockedTo.BoundsRect.TopLeft);
  3263.     Dec (R2.Left, Left + DockedTo.Left + (P1.X-P2.X));
  3264.     Dec (R2.Top, Top + DockedTo.Top + (P1.Y-P2.Y));
  3265.     GetWindowRect (Handle, R3);
  3266.     with ClientToScreen(Point(0, 0)) do begin
  3267.       Inc (R2.Left, R3.Left-X);
  3268.       Inc (R2.Top, R3.Top-Y);
  3269.     end;
  3270.     DockedTo.DrawBackground (Canvas.Handle, R, nil, R2);
  3271.   end;
  3272. end;
  3273.  
  3274. function TCustomToolWindow97.GetPalette: HPALETTE;
  3275. begin
  3276.   if Docked and DockedTo.UsingBackground then
  3277.     Result := DockedTo.FBkg.Palette
  3278.   else
  3279.     Result := 0;
  3280. end;
  3281.  
  3282. function TCustomToolWindow97.PaletteChanged (Foreground: Boolean): Boolean;
  3283. begin
  3284.   Result := inherited PaletteChanged(Foreground);
  3285.   if Result and not Foreground then begin
  3286.     { There seems to be a bug in Delphi's palette handling. When the form is
  3287.       inactive and another window realizes a palette, docked TToolbar97s
  3288.       weren't getting redrawn. So this workaround code was added. }
  3289.     InvalidateDockedNCArea;
  3290.     Invalidate;
  3291.   end;
  3292. end;
  3293.  
  3294. procedure DrawDragRect (const DC: HDC; const NewRect, OldRect: PRect;
  3295.   const NewSize, OldSize: TSize; const Brush: HBRUSH; BrushLast: HBRUSH);
  3296. { Draws a dragging outline, hiding the old one if neccessary. This is
  3297.   completely flicker free, unlike the old DrawFocusRect method. In case
  3298.   you're wondering, I got a lot of ideas from the MFC sources.
  3299.  
  3300.   Either NewRect or OldRect can be nil or empty. }
  3301.   function CreateNullRegion: HRGN;
  3302.   var
  3303.     R: TRect;
  3304.   begin
  3305.     SetRectEmpty (R);
  3306.     Result := CreateRectRgnIndirect(R);
  3307.   end;
  3308. var
  3309.   SaveIndex: Integer;
  3310.   rgnNew, rgnOutside, rgnInside, rgnLast, rgnUpdate: HRGN;
  3311.   R: TRect;
  3312. begin
  3313.   rgnLast := 0;
  3314.   rgnUpdate := 0;
  3315.  
  3316.   { First, determine the update region and select it }
  3317.   if NewRect = nil then begin
  3318.     SetRectEmpty (R);
  3319.     rgnOutside := CreateRectRgnIndirect(R);
  3320.   end
  3321.   else begin
  3322.     R := NewRect^;
  3323.     rgnOutside := CreateRectRgnIndirect(R);
  3324.     InflateRect (R, -NewSize.cx, -NewSize.cy);
  3325.     IntersectRect (R, R, NewRect^);
  3326.   end;
  3327.   rgnInside := CreateRectRgnIndirect(R);
  3328.   rgnNew := CreateNullRegion;
  3329.   CombineRgn (rgnNew, rgnOutside, rgnInside, RGN_XOR);
  3330.  
  3331.   if BrushLast = 0 then
  3332.     BrushLast := Brush;
  3333.  
  3334.   if OldRect <> nil then begin
  3335.     { Find difference between new region and old region }
  3336.     rgnLast := CreateNullRegion;
  3337.     with OldRect^ do
  3338.       SetRectRgn (rgnOutside, Left, Top, Right, Bottom);
  3339.     R := OldRect^;
  3340.     InflateRect (R, -OldSize.cx, -OldSize.cy);
  3341.     IntersectRect (R, R, OldRect^);
  3342.     SetRectRgn (rgnInside, R.Left, R.Top, R.Right, R.Bottom);
  3343.     CombineRgn (rgnLast, rgnOutside, rgnInside, RGN_XOR);
  3344.  
  3345.     { Only diff them if brushes are the same }
  3346.     if Brush = BrushLast then begin
  3347.       rgnUpdate := CreateNullRegion;
  3348.       CombineRgn (rgnUpdate, rgnLast, rgnNew, RGN_XOR);
  3349.     end;
  3350.   end;
  3351.  
  3352.   { Save the DC state so that the clipping region can be restored }
  3353.   SaveIndex := SaveDC(DC);
  3354.   try
  3355.     if (Brush <> BrushLast) and (OldRect <> nil) then begin
  3356.       { Brushes are different -- erase old region first }
  3357.       SelectClipRgn (DC, rgnLast);
  3358.       GetClipBox (DC, R);
  3359.       SelectObject (DC, BrushLast);
  3360.       PatBlt (DC, R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top, PATINVERT);
  3361.     end;
  3362.  
  3363.     { Draw into the update/new region }
  3364.     if rgnUpdate <> 0 then
  3365.       SelectClipRgn (DC, rgnUpdate)
  3366.     else
  3367.       SelectClipRgn (DC, rgnNew);
  3368.     GetClipBox (DC, R);
  3369.     SelectObject (DC, Brush);
  3370.     PatBlt (DC, R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top, PATINVERT);
  3371.   finally
  3372.     { Clean up DC }
  3373.     RestoreDC (DC, SaveIndex);
  3374.   end;
  3375.  
  3376.   { Free regions }
  3377.   if rgnNew <> 0 then DeleteObject (rgnNew);
  3378.   if rgnOutside <> 0 then DeleteObject (rgnOutside);
  3379.   if rgnInside <> 0 then DeleteObject (rgnInside);
  3380.   if rgnLast <> 0 then DeleteObject (rgnLast);
  3381.   if rgnUpdate <> 0 then DeleteObject (rgnUpdate);
  3382. end;
  3383.  
  3384. procedure TCustomToolWindow97.DrawDraggingOutline (const DC: HDC;
  3385.   const NewRect, OldRect: PRect; const NewDocking, OldDocking: Boolean);
  3386.  
  3387.   function CreateHalftoneBrush: HBRUSH;
  3388.   const
  3389.     GrayPattern: array[0..7] of Word =
  3390.       ($5555, $AAAA, $5555, $AAAA, $5555, $AAAA, $5555, $AAAA);
  3391.   var
  3392.     GrayBitmap: HBITMAP;
  3393.   begin
  3394.     GrayBitmap := CreateBitmap(8, 8, 1, 1, @GrayPattern);
  3395.     Result := CreatePatternBrush(GrayBitmap);
  3396.     DeleteObject (GrayBitmap);
  3397.   end;
  3398. var
  3399.   NewSize, OldSize: TSize;
  3400.   Brush: HBRUSH;
  3401. begin
  3402.   Brush := CreateHalftoneBrush;
  3403.   try
  3404.     with GetFloatingBorderSize do begin
  3405.       if NewDocking then NewSize.cx := 1 else NewSize.cx := X;
  3406.       NewSize.cy := NewSize.cx;
  3407.       if OldDocking then OldSize.cx := 1 else OldSize.cx := X;
  3408.       OldSize.cy := OldSize.cx;
  3409.     end;
  3410.     DrawDragRect (DC, NewRect, OldRect, NewSize, OldSize, Brush, Brush);
  3411.   finally
  3412.     DeleteObject (Brush);
  3413.   end;
  3414. end;
  3415.  
  3416.  
  3417. procedure TCustomToolWindow97.CMColorChanged (var Message: TMessage);
  3418. begin
  3419.   { Make sure non-client area is redrawn }
  3420.   InvalidateDockedNCArea;
  3421.   inherited;  { the inherited handler calls Invalidate }
  3422. end;
  3423.  
  3424. procedure TCustomToolWindow97.CMTextChanged (var Message: TMessage);
  3425. begin
  3426.   inherited;
  3427.   { Update the title bar to use the new Caption }
  3428.   InvalidateFloatingNCArea ([twrdCaption]);
  3429. end;
  3430.  
  3431. procedure TCustomToolWindow97.CMVisibleChanged (var Message: TMessage);
  3432. begin
  3433.   if not(csDesigning in ComponentState) and Docked then 
  3434.     DockedTo.ToolbarVisibilityChanged (Self, False);
  3435.   inherited;
  3436.   if Assigned(FOnVisibleChanged) then
  3437.     FOnVisibleChanged (Self);
  3438. end;
  3439.  
  3440. procedure TCustomToolWindow97.WMActivate (var Message: TWMActivate);
  3441. var
  3442.   ParentForm: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  3443. begin
  3444.   if Docked or (csDesigning in ComponentState) then begin
  3445.     inherited;
  3446.     Exit;
  3447.   end;
  3448.  
  3449.   ParentForm := GetMDIParent(GetToolWindowParentForm(Self));
  3450.  
  3451.   if Assigned(ParentForm) and ParentForm.HandleAllocated then
  3452.     SendMessage (ParentForm.Handle, WM_NCACTIVATE, Ord(Message.Active <> WA_INACTIVE), 0);
  3453.  
  3454.   if Message.Active <> WA_INACTIVE then begin
  3455.     { This works around a "gotcha" in TCustomForm.CMShowingChanged. When a form
  3456.       is hidden, it uses the internal VCL function FindTopMostWindow to
  3457.       find a new active window. The problem is that handles of floating
  3458.       toolbars on the form being hidden can be returned by
  3459.       FindTopMostWindow, so the following code is used to prevent floating
  3460.       toolbars on the hidden form from being left active. }
  3461.     if not IsWindowVisible(Handle) then
  3462.       { ^ Calling IsWindowVisible with a floating toolbar handle will
  3463.          always return False if its parent form is hidden since the
  3464.          WH_CALLWNDPROC hook automatically updates the toolbars'
  3465.          visibility. }
  3466.       { Find and activate a window besides this toolbar }
  3467.       SetActiveWindow (FindTopLevelWindow(Handle))
  3468.     else
  3469.       { If the toolbar is being activated and the previous active window wasn't
  3470.         its parent form, the form is activated instead. This is done so that if
  3471.         the application is deactivated while a floating toolbar was active and
  3472.         the application is reactivated again, it returns focus to the form. }
  3473.       if Assigned(ParentForm) and ParentForm.HandleAllocated and
  3474.          (Message.ActiveWindow <> ParentForm.Handle) then
  3475.         SetActiveWindow (ParentForm.Handle);
  3476.   end;
  3477. end;
  3478.  
  3479. procedure TCustomToolWindow97.WMMouseActivate (var Message: TWMMouseActivate);
  3480. var
  3481.   ParentForm, MDIParentForm: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  3482. begin
  3483.   if Docked or (csDesigning in ComponentState) then
  3484.     inherited
  3485.   else begin
  3486.     { When floating, prevent the toolbar from activating when clicked.
  3487.       This is so it doesn't take the focus away from the window that had it }
  3488.     Message.Result := MA_NOACTIVATE;
  3489.  
  3490.     { Similar to calling BringWindowToTop, but doesn't activate it }
  3491.     SetWindowPos (Handle, HWND_TOP, 0, 0, 0, 0,
  3492.       SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  3493.  
  3494.     { Since it is returning MA_NOACTIVATE, activate the form instead. }
  3495.     ParentForm := GetToolWindowParentForm(Self);
  3496.     MDIParentForm := GetMDIParent(ParentForm);
  3497.     if (FFloatingMode = fmOnTopOfParentForm) and FActivateParent and
  3498.        Assigned(MDIParentForm) and (GetActiveWindow <> Handle) then begin
  3499.       { ^ Note to self: The GetActiveWindow check must be in there so that
  3500.           double-clicks work properly on controls like Edits }
  3501.       if MDIParentForm.HandleAllocated then
  3502.         SetActiveWindow (MDIParentForm.Handle);
  3503.       if (MDIParentForm <> ParentForm) and  { if it's an MDI child form }
  3504.          ParentForm.HandleAllocated then
  3505.         BringWindowToTop (ParentForm.Handle);
  3506.     end;
  3507.   end;
  3508. end;
  3509.  
  3510. procedure TCustomToolWindow97.BeginMoving (const InitX, InitY: Integer);
  3511. type
  3512.   PDockedSize = ^TDockedSize;
  3513.   TDockedSize = record
  3514.     Dock: TDock97;
  3515.     Size: TPoint;
  3516.   end;
  3517. var
  3518.   DockList: TList;
  3519.   NewDockedSizes: TList; {items are pointers to TDockedSizes}
  3520.   MouseOverDock: TDock97;
  3521.   MoveRect: TRect;
  3522.   PreventDocking, PreventFloating: Boolean;
  3523.   ScreenDC: HDC;
  3524.   OldCursor: HCURSOR;
  3525.   NPoint, DPoint: TPoint;
  3526.  
  3527.   procedure Dropped;
  3528.   var
  3529.     NewDockRow: Integer;
  3530.     Before: Boolean;
  3531.     MoveRectClient: TRect;
  3532.     C: Integer;
  3533.   begin
  3534.     if MouseOverDock <> nil then begin
  3535.       MoveRectClient := MoveRect;
  3536.       MapWindowPoints (0, MouseOverDock.Handle, MoveRectClient, 2);
  3537.       if not(MouseOverDock.Position in PositionLeftOrRight) then
  3538.         C := (MoveRectClient.Top+MoveRectClient.Bottom) div 2
  3539.       else
  3540.         C := (MoveRectClient.Left+MoveRectClient.Right) div 2;
  3541.       NewDockRow := MouseOverDock.GetRowOf(C, Before);
  3542.       if Before then
  3543.         MouseOverDock.InsertRowBefore (NewDockRow)
  3544.       else
  3545.         if FullSize and
  3546.            (MouseOverDock.GetNumberOfToolbarsOnRow(NewDockRow, Self) <> 0) then begin
  3547.           Inc (NewDockRow);
  3548.           MouseOverDock.InsertRowBefore (NewDockRow);
  3549.         end;
  3550.       FDockRow := NewDockRow;
  3551.       if not(MouseOverDock.Position in PositionLeftOrRight) then
  3552.         FDockPos := MoveRectClient.Left
  3553.       else
  3554.         FDockPos := MoveRectClient.Top;
  3555.       Parent := MouseOverDock;
  3556.       DockedTo.ArrangeToolbars (True);
  3557.     end
  3558.     else begin
  3559.       FFloatingTopLeft := MoveRect.TopLeft;
  3560.       if DockedTo <> nil then
  3561.         Parent := ValidToolWindowParentForm(Self)
  3562.       else
  3563.         SetBounds (FFloatingTopLeft.X, FFloatingTopLeft.Y, Width, Height);
  3564.     end;
  3565.  
  3566.     { Make sure it doesn't go completely off the screen }
  3567.     MoveOnScreen (True);
  3568.   end;
  3569.  
  3570.   procedure MouseMoved;
  3571.   var
  3572.     OldMouseOverDock: TDock97;
  3573.     OldMoveRect: TRect;
  3574.     Pos: TPoint;
  3575.  
  3576.     function CheckIfCanDockTo (Control: TDock97): Boolean;
  3577.     const
  3578.       DockSensX = 32;
  3579.       DockSensY = 20;
  3580.     var
  3581.       R, S, Temp: TRect;
  3582.       I: Integer;
  3583.       Sens: Integer;
  3584.     begin
  3585.       with Control do begin
  3586.         Result := False;
  3587.  
  3588.         GetWindowRect (Handle, R);
  3589.         for I := 0 to NewDockedSizes.Count-1 do
  3590.           with PDockedSize(NewDockedSizes[I])^ do begin
  3591.             if Dock <> Control then Continue;
  3592.             S := Bounds(Pos.X-MulDiv(Size.X-1, NPoint.X, DPoint.X),
  3593.               Pos.Y-MulDiv(Size.Y-1, NPoint.Y, DPoint.Y),
  3594.               Size.X, Size.Y);
  3595.             Break;
  3596.           end;
  3597.         if (R.Left = R.Right) or (R.Top = R.Bottom) then begin
  3598.           if not(Control.Position in PositionLeftOrRight) then
  3599.             InflateRect (R, 0, 1)
  3600.           else
  3601.             InflateRect (R, 1, 0);
  3602.         end;
  3603.  
  3604.         { Like Office 97, distribute ~32 pixels of extra dock detection area
  3605.           to the left side if the toolbar was grabbed at the left, both sides
  3606.           if the toolbar was grabbed at the middle, or the right side if
  3607.           toolbar was grabbed at the right. If outside, don't try to dock. }
  3608.         Sens := MulDiv(DockSensX, NPoint.X, DPoint.X);
  3609.         if (Pos.X < R.Left-(DockSensX-Sens)) or (Pos.X > R.Right-1+Sens) then
  3610.           Exit;
  3611.  
  3612.         { Don't try to dock to the left or right if pointer is above or below
  3613.           the boundaries of the dock }
  3614.         if (Control.Position in PositionLeftOrRight) and
  3615.            ((Pos.Y < R.Top) or (Pos.Y >= R.Bottom)) then
  3616.           Exit;
  3617.  
  3618.         { And also distribute ~20 pixels of extra dock detection area to
  3619.           the top or bottom side }
  3620.         Sens := MulDiv(DockSensY, NPoint.Y, DPoint.Y);
  3621.         if (Pos.Y < R.Top-(DockSensY-Sens)) or (Pos.Y > R.Bottom-1+Sens) then
  3622.           Exit;
  3623.  
  3624.         Result := IntersectRect(Temp, R, S);
  3625.       end;
  3626.     end;
  3627.   var
  3628.     R, R2: TRect;
  3629.     I: Integer;
  3630.     Dock: TDock97;
  3631.     Accept: Boolean;
  3632.     TL, BR: TPoint;
  3633.   begin
  3634.     OldMouseOverDock := MouseOverDock;
  3635.     OldMoveRect := MoveRect;
  3636.  
  3637.     GetCursorPos (Pos);
  3638.  
  3639.     { Check if it can dock }
  3640.     MouseOverDock := nil;
  3641.     if not PreventDocking then
  3642.       for I := 0 to DockList.Count-1 do begin
  3643.         Dock := DockList[I];
  3644.         if CheckIfCanDockTo(Dock) then begin
  3645.           MouseOverDock := Dock;
  3646.           Accept := True;
  3647.           if Assigned(MouseOverDock.FOnRequestDock) then
  3648.             MouseOverDock.FOnRequestDock (MouseOverDock, Self, Accept);
  3649.           if Accept then
  3650.             Break
  3651.           else
  3652.             MouseOverDock := nil;
  3653.         end;
  3654.       end;
  3655.  
  3656.     { If not docking, clip the point so it doesn't get dragged under the
  3657.       taskbar }
  3658.     if MouseOverDock = nil then begin
  3659.       R := GetDesktopAreaOfMonitorContainingPoint(Pos);
  3660.       if Pos.X < R.Left then Pos.X := R.Left;
  3661.       if Pos.X > R.Right then Pos.X := R.Right;
  3662.       if Pos.Y < R.Top then Pos.Y := R.Top;
  3663.       if Pos.Y > R.Bottom then Pos.Y := R.Bottom;
  3664.     end;
  3665.  
  3666.     for I := 0 to NewDockedSizes.Count-1 do
  3667.       with PDockedSize(NewDockedSizes[I])^ do begin
  3668.         if Dock <> MouseOverDock then Continue;
  3669.         MoveRect := Bounds(Pos.X-MulDiv(Size.X-1, NPoint.X, DPoint.X),
  3670.           Pos.Y-MulDiv(Size.Y-1, NPoint.Y, DPoint.Y),
  3671.           Size.X, Size.Y);
  3672.         Break;
  3673.       end;
  3674.  
  3675.     { Make sure title bar (or at least part of the toolbar) is still accessible
  3676.       if it's dragged almost completely off the screen. This prevents the
  3677.       problem seen in Office 97 where you drag it offscreen so that only the
  3678.       border is visible, sometimes leaving you no way to move it back short of
  3679.       resetting the toolbar. }
  3680.     if MouseOverDock = nil then begin
  3681.       R2 := GetDesktopAreaOfMonitorContainingPoint(Pos);
  3682.       R := R2;
  3683.       with GetFloatingBorderSize do
  3684.         InflateRect (R, -(X+4), -(Y+4));
  3685.       if MoveRect.Bottom < R.Top then
  3686.         OffsetRect (MoveRect, 0, R.Top-MoveRect.Bottom);
  3687.       if MoveRect.Top > R.Bottom then
  3688.         OffsetRect (MoveRect, 0, R.Bottom-MoveRect.Top);
  3689.       if MoveRect.Right < R.Left then
  3690.         OffsetRect (MoveRect, R.Left-MoveRect.Right, 0);
  3691.       if MoveRect.Left > R.Right then
  3692.         OffsetRect (MoveRect, R.Right-MoveRect.Left, 0);
  3693.  
  3694.       GetFloatingNCArea (TL, BR);
  3695.       I := R2.Top + 4 - TL.Y;
  3696.       if MoveRect.Top < I then
  3697.         OffsetRect (MoveRect, 0, I-MoveRect.Top);
  3698.     end;
  3699.  
  3700.     { Empty MoveRect if it's wanting to float but it's not allowed to, and
  3701.       set the mouse cursor accordingly. }
  3702.     if PreventFloating and not Assigned(MouseOverDock) then begin
  3703.       SetRectEmpty (MoveRect);
  3704.       SetCursor (LoadCursor(0, IDC_NO));
  3705.     end
  3706.     else
  3707.       SetCursor (OldCursor);
  3708.  
  3709.     { Update the dragging outline }
  3710.     DrawDraggingOutline (ScreenDC, @MoveRect, @OldMoveRect, MouseOverDock <> nil,
  3711.       OldMouseOverDock <> nil);
  3712.   end;
  3713.   procedure BuildDockList;
  3714.     procedure Recurse (const ParentCtl: TWinControl);
  3715.     var
  3716.       D: TDockPosition;
  3717.       I: Integer;
  3718.     begin
  3719.       if ContainsControl(ParentCtl) or not ParentCtl.Showing then
  3720.         Exit;
  3721.       with ParentCtl do begin
  3722.         for D := Low(D) to High(D) do
  3723.           for I := 0 to ParentCtl.ControlCount-1 do
  3724.             if (Controls[I] is TDock97) and (TDock97(Controls[I]).Position = D) then
  3725.               Recurse (TWinControl(Controls[I]));
  3726.         for I := 0 to ParentCtl.ControlCount-1 do
  3727.           if (Controls[I] is TWinControl) and not(Controls[I] is TDock97) then
  3728.             Recurse (TWinControl(Controls[I]));
  3729.       end;
  3730.       if (ParentCtl is TDock97) and TDock97(ParentCtl).FAllowDrag and
  3731.          (TDock97(ParentCtl).Position in DockableTo) then
  3732.         DockList.Add (ParentCtl);
  3733.     end;
  3734.   var
  3735.     ParentForm: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  3736.     DockFormsList: TList;
  3737.     I, J: Integer;
  3738.   begin
  3739.     ParentForm := GetToolWindowParentForm(Self);
  3740.     DockFormsList := TList.Create;
  3741.     try
  3742.       if Assigned(FDockForms) then begin
  3743.         for I := 0 to Screen.{$IFDEF TB97D3}CustomFormCount{$ELSE}FormCount{$ENDIF}-1 do begin
  3744.           J := FDockForms.IndexOf(Screen.{$IFDEF TB97D3}CustomForms{$ELSE}Forms{$ENDIF}[I]);
  3745.           if (J <> -1) and (FDockForms[J] <> ParentForm) then
  3746.             DockFormsList.Add (FDockForms[J]);
  3747.         end;
  3748.       end;
  3749.       if Assigned(ParentForm) then
  3750.         DockFormsList.Insert (0, ParentForm);
  3751.       for I := 0 to DockFormsList.Count-1 do
  3752.         Recurse (DockFormsList[I]);
  3753.     finally
  3754.       DockFormsList.Free;
  3755.     end;
  3756.   end;
  3757. var
  3758.   Accept: Boolean;
  3759.   R: TRect;
  3760.   Msg: TMsg;
  3761.   NewDockedSize: PDockedSize;
  3762.   I: Integer;
  3763. begin
  3764.   Accept := False;
  3765.  
  3766.   NPoint := Point(InitX, InitY);
  3767.   { Adjust for non-client area }
  3768.   GetWindowRect (Handle, R);
  3769.   R.BottomRight := ClientToScreen(Point(0, 0));
  3770.   Dec (NPoint.X, R.Left-R.Right);
  3771.   Dec (NPoint.Y, R.Top-R.Bottom);
  3772.  
  3773.   DPoint := Point(Width-1, Height-1);
  3774.  
  3775.   PreventDocking := GetKeyState(VK_CONTROL) < 0;
  3776.   PreventFloating := DockMode <> dmCanFloat;
  3777.  
  3778.   { Build list of all TDock97's on the form }
  3779.   DockList := TList.Create;
  3780.   try
  3781.     if DockMode <> dmCannotFloatOrChangeDocks then
  3782.       BuildDockList
  3783.     else
  3784.       if Docked then
  3785.         DockList.Add (DockedTo);
  3786.     { Set up potential sizes for each dock type }
  3787.     NewDockedSizes := TList.Create;
  3788.     try
  3789.       New (NewDockedSize);
  3790.       try
  3791.         with NewDockedSize^ do begin
  3792.           Dock := nil;
  3793.           Size := OrderControls(False, GetDockTypeOf(DockedTo), nil);
  3794.           AddFloatingNCAreaToSize (Size);
  3795.         end;
  3796.         NewDockedSizes.Add (NewDockedSize);
  3797.       except
  3798.         Dispose (NewDockedSize);
  3799.         raise;
  3800.       end;
  3801.       for I := 0 to DockList.Count-1 do begin
  3802.         New (NewDockedSize);
  3803.         try
  3804.           with NewDockedSize^ do begin
  3805.             Dock := TDock97(DockList[I]);
  3806.             if DockList[I] <> DockedTo then
  3807.               Size := OrderControls(False, GetDockTypeOf(DockedTo), Dock)
  3808.             else
  3809.               Size := Self.ClientRect.BottomRight;
  3810.             AddDockedNCAreaToSize (Size, Dock.Position in PositionLeftOrRight);
  3811.           end;
  3812.           NewDockedSizes.Add (NewDockedSize);
  3813.         except
  3814.           Dispose (NewDockedSize);
  3815.           raise;
  3816.         end;
  3817.       end;
  3818.  
  3819.       { Before locking, make sure all pending paint messages are processed }
  3820.       ProcessPaintMessages;
  3821.  
  3822.       { Save the original mouse cursor }
  3823.       OldCursor := GetCursor;
  3824.  
  3825.       { This uses LockWindowUpdate to suppress all window updating so the
  3826.         dragging outlines doesn't sometimes get garbled. (This is safe, and in
  3827.         fact, is the main purpose of the LockWindowUpdate function)
  3828.         IMPORTANT! While debugging you might want to enable the 'TB97DisableLock'
  3829.         conditional define (see top of the source code). }
  3830.       {$IFNDEF TB97DisableLock}
  3831.       LockWindowUpdate (GetDesktopWindow);
  3832.       {$ENDIF}
  3833.       { Get a DC of the entire screen. Works around the window update lock
  3834.         by specifying DCX_LOCKWINDOWUPDATE. }
  3835.       ScreenDC := GetDCEx(GetDesktopWindow, 0,
  3836.         DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
  3837.       try
  3838.         SetCapture (Handle);
  3839.  
  3840.         { Initialize }
  3841.         MouseOverDock := nil;
  3842.         SetRectEmpty (MoveRect);
  3843.         MouseMoved;
  3844.  
  3845.         { Stay in message loop until capture is lost. Capture is removed either
  3846.           by this procedure manually doing it, or by an outside influence (like
  3847.           a message box or menu popping up) }
  3848.         while GetCapture = Handle do begin
  3849.           case Integer(GetMessage(Msg, 0, 0, 0)) of
  3850.             -1: Break; { if GetMessage failed }
  3851.             0: begin
  3852.                  { Repost WM_QUIT messages }
  3853.                  PostQuitMessage (Msg.WParam);
  3854.                  Break;
  3855.                end;
  3856.           end;
  3857.  
  3858.           case Msg.Message of
  3859.             WM_KEYDOWN, WM_KEYUP:
  3860.               { Ignore all keystrokes while dragging. But process Ctrl and Escape }
  3861.               case Msg.WParam of
  3862.                 VK_CONTROL:
  3863.                   if PreventDocking <> (Msg.Message = WM_KEYDOWN) then begin
  3864.                     PreventDocking := Msg.Message = WM_KEYDOWN;
  3865.                     MouseMoved;
  3866.                   end;
  3867.                 VK_ESCAPE:
  3868.                   Break;
  3869.               end;
  3870.             WM_MOUSEMOVE:
  3871.               { Note to self: WM_MOUSEMOVE messages should never be dispatched
  3872.                 here to ensure no hints get shown during the drag process }
  3873.               MouseMoved;
  3874.             WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  3875.               { Make sure it doesn't begin another loop }
  3876.               Break;
  3877.             WM_LBUTTONUP: begin
  3878.                 Accept := True;
  3879.                 Break;
  3880.               end;
  3881.             WM_RBUTTONDOWN..WM_MBUTTONDBLCLK:
  3882.               { Ignore all other mouse up/down messages }
  3883.               ;
  3884.           else
  3885.             TranslateMessage (Msg);
  3886.             DispatchMessage (Msg);
  3887.           end;
  3888.         end;
  3889.       finally
  3890.         { Since it sometimes breaks out of the loop without capture being
  3891.           released }
  3892.         if GetCapture = Handle then
  3893.           ReleaseCapture;
  3894.  
  3895.       { Hide dragging outline. Since NT will release a window update lock if
  3896.         another thread comes to the foreground, it has to release the DC
  3897.         and get a new one for erasing the dragging outline. Otherwise,
  3898.         the DrawDraggingOutline appears to have no effect when this happens. }
  3899.         ReleaseDC (GetDesktopWindow, ScreenDC);
  3900.         ScreenDC := GetDCEx(GetDesktopWindow, 0,
  3901.           DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
  3902.         DrawDraggingOutline (ScreenDC, nil, @MoveRect, True, MouseOverDock <> nil);
  3903.         ReleaseDC (GetDesktopWindow, ScreenDC);
  3904.  
  3905.         { Release window update lock }
  3906.         {$IFNDEF TB97DisableLock}
  3907.         LockWindowUpdate (0);
  3908.         {$ENDIF}
  3909.       end;
  3910.     finally
  3911.       for I := NewDockedSizes.Count-1 downto 0 do
  3912.         Dispose (PDockedSize(NewDockedSizes[I]));
  3913.       NewDockedSizes.Free;
  3914.     end;
  3915.   finally
  3916.     DockList.Free;
  3917.   end;
  3918.  
  3919.   { Move to new position only if MoveRect isn't empty }
  3920.   if Accept and not IsRectEmpty(MoveRect) then
  3921.     Dropped;
  3922. end;
  3923.  
  3924. function TCustomToolWindow97.ChildControlTransparent (Ctl: TControl): Boolean;
  3925. begin
  3926.   Result := False;
  3927. end;
  3928.  
  3929. procedure TCustomToolWindow97.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  3930.  
  3931.   function ControlExistsAtPos (const P: TPoint): Boolean;
  3932.   var
  3933.     I: Integer;
  3934.   begin
  3935.     Result := False;
  3936.     if PtInRect(ClientRect, P) then
  3937.       for I := 0 to ControlCount-1 do
  3938.         if not ChildControlTransparent(Controls[I]) and Controls[I].Visible and
  3939.            PtInRect(Controls[I].BoundsRect, P) then begin
  3940.           Result := True;
  3941.           Break;
  3942.         end;
  3943.   end;
  3944. begin
  3945.   inherited;
  3946.   if (Button <> mbLeft) or
  3947.      { Ignore message if user clicked on a child control that was probably
  3948.        disabled }
  3949.      ControlExistsAtPos(Point(X, Y)) or
  3950.      (Docked and not DockedTo.FAllowDrag) then
  3951.     Exit;
  3952.  
  3953.   { Handle double click }
  3954.   if ssDouble in Shift then begin
  3955.     if Docked then begin
  3956.       if DockMode = dmCanFloat then begin
  3957.         Parent := GetToolWindowParentForm(Self);
  3958.         MoveOnScreen (True);
  3959.       end;
  3960.     end
  3961.     else
  3962.     if Assigned(LastDock) then
  3963.       Parent := LastDock
  3964.     else
  3965.     if Assigned(DefaultDock) then begin
  3966.       FDockRow := ForceDockAtTopRow;
  3967.       FDockPos := ForceDockAtLeftPos;
  3968.       Parent := DefaultDock;
  3969.     end;
  3970.     Exit;
  3971.   end;
  3972.  
  3973.   BeginMoving (X, Y);
  3974.   MouseUp (mbLeft, [], -1, -1);
  3975. end;
  3976.  
  3977. procedure TCustomToolWindow97.WMNCHitTest (var Message: TWMNCHitTest);
  3978. var
  3979.   P: TPoint;
  3980.   R: TRect;
  3981.   BorderSize: TPoint;
  3982.   C: Integer;
  3983. begin
  3984.   inherited;
  3985.   with Message do begin
  3986.     P := SmallPointToPoint(Pos);
  3987.     GetWindowRect (Handle, R);
  3988.     Dec (P.X, R.Left);  Dec (P.Y, R.Top);
  3989.     if Docked then begin
  3990.       if Result = HTNOWHERE then begin
  3991.         if FCloseButtonWhenDocked and DockedTo.FAllowDrag and
  3992.            PtInRect(GetDockedCloseButtonRect(Self, GetDockTypeOf(DockedTo) = dtLeftRight), P) then
  3993.           Result := HTCLOSE
  3994.         else
  3995.           Result := HTCLIENT;
  3996.       end;
  3997.     end
  3998.     else begin
  3999.       if Result <> HTCLIENT then begin
  4000.         if ShowCaption and PtInRect(GetCaptionRect(Self, True, False), P) then begin
  4001.           if FCloseButton and PtInRect(GetCloseButtonRect(Self, True), P) then
  4002.             Result := HTCLOSE
  4003.           else
  4004.             Result := HTCLIENT;
  4005.         end
  4006.         else begin
  4007.           if Result in [HTLEFT..HTBOTTOMRIGHT] {set covers all resizing corners} then
  4008.             Result := HTNOWHERE;  { handles all resize hit-tests itself }
  4009.  
  4010.           if Resizable then begin
  4011.             BorderSize := GetFloatingBorderSize;
  4012.             if not Params.ResizeEightCorner then begin
  4013.               if (P.Y >= 0) and (P.Y < BorderSize.Y) then Result := HTTOP else
  4014.               if (P.Y < Height) and (P.Y >= Height-BorderSize.Y-1) then Result := HTBOTTOM else
  4015.               if (P.X >= 0) and (P.X < BorderSize.X) then Result := HTLEFT else
  4016.               if (P.X < Width) and (P.X >= Width-BorderSize.X-1) then Result := HTRIGHT;
  4017.             end
  4018.             else begin
  4019.               C := BorderSize.X + (GetSmallCaptionHeight-1);
  4020.               if (P.X >= 0) and (P.X < BorderSize.X) then begin
  4021.                 Result := HTLEFT;
  4022.                 if (P.Y < C) then Result := HTTOPLEFT else
  4023.                 if (P.Y >= Height-C) then Result := HTBOTTOMLEFT;
  4024.               end
  4025.               else
  4026.               if (P.X < Width) and (P.X >= Width-BorderSize.X-1) then begin
  4027.                 Result := HTRIGHT;
  4028.                 if (P.Y < C) then Result := HTTOPRIGHT else
  4029.                 if (P.Y >= Height-C) then Result := HTBOTTOMRIGHT;
  4030.               end
  4031.               else
  4032.               if (P.Y >= 0) and (P.Y < BorderSize.Y) then begin
  4033.                 Result := HTTOP;
  4034.                 if (P.X < C) then Result := HTTOPLEFT else
  4035.                 if (P.X >= Width-C) then Result := HTTOPRIGHT;
  4036.               end
  4037.               else
  4038.               if (P.Y < Height) and (P.Y >= Height-BorderSize.Y-1) then begin
  4039.                 Result := HTBOTTOM;
  4040.                 if (P.X < C) then Result := HTBOTTOMLEFT else
  4041.                 if (P.X >= Width-C) then Result := HTBOTTOMRIGHT;
  4042.               end;
  4043.             end;
  4044.           end;
  4045.         end;
  4046.       end;
  4047.     end;
  4048.   end;
  4049. end;
  4050.  
  4051. procedure TCustomToolWindow97.WMNCLButtonDown (var Message: TWMNCLButtonDown);
  4052.   procedure CloseButtonLoop;
  4053.     procedure RedrawCloseButton;
  4054.     begin
  4055.       if not Docked then
  4056.         InvalidateFloatingNCArea ([twrdCloseButton])
  4057.       else
  4058.         InvalidateDockedNCArea;
  4059.     end;
  4060.   var
  4061.     Accept, NewCloseButtonDown: Boolean;
  4062.     P: TPoint;
  4063.     R: TRect;
  4064.     Msg: TMsg;
  4065.   begin
  4066.     Accept := False;
  4067.  
  4068.     FCloseButtonDown := True;
  4069.     RedrawCloseButton;
  4070.  
  4071.     SetCapture (Handle);
  4072.  
  4073.     try
  4074.       while GetCapture = Handle do begin
  4075.         case Integer(GetMessage(Msg, 0, 0, 0)) of
  4076.           -1: Break; { if GetMessage failed }
  4077.           0: begin
  4078.                { Repost WM_QUIT messages }
  4079.                PostQuitMessage (Msg.WParam);
  4080.                Break;
  4081.              end;
  4082.         end;
  4083.  
  4084.         case Msg.Message of
  4085.           WM_KEYDOWN, WM_KEYUP:
  4086.             { Ignore all keystrokes while in a close button loop }
  4087.             ;
  4088.           WM_MOUSEMOVE: begin
  4089.               { Note to self: WM_MOUSEMOVE messages should never be dispatched
  4090.                 here to ensure no hints get shown }
  4091.               GetCursorPos (P);
  4092.               GetWindowRect (Handle, R);
  4093.               Dec (P.X, R.Left);  Dec (P.Y, R.Top);
  4094.  
  4095.               if not Docked then
  4096.                 NewCloseButtonDown := PtInRect(GetCloseButtonRect(Self, True), P)
  4097.               else
  4098.                 NewCloseButtonDown := PtInRect(GetDockedCloseButtonRect(Self, GetDockTypeOf(DockedTo) = dtLeftRight), P);
  4099.               if FCloseButtonDown <> NewCloseButtonDown then begin
  4100.                 FCloseButtonDown := NewCloseButtonDown;
  4101.                 RedrawCloseButton;
  4102.               end;
  4103.             end;
  4104.           WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  4105.             { Make sure it doesn't begin another loop }
  4106.             Break;
  4107.           WM_LBUTTONUP: begin
  4108.               if FCloseButtonDown then
  4109.                 Accept := True;
  4110.               Break;
  4111.             end;
  4112.           WM_RBUTTONDOWN..WM_MBUTTONDBLCLK:
  4113.             { Ignore all other mouse up/down messages }
  4114.             ;
  4115.         else
  4116.           TranslateMessage (Msg);
  4117.           DispatchMessage (Msg);
  4118.         end;
  4119.       end;
  4120.     finally
  4121.       if GetCapture = Handle then
  4122.         ReleaseCapture;
  4123.       if FCloseButtonDown <> False then begin
  4124.         FCloseButtonDown := False;
  4125.         RedrawCloseButton;
  4126.       end;
  4127.     end;
  4128.     if Accept then begin
  4129.       { Hide the window after close button is pushed }
  4130.       if Assigned(FOnCloseQuery) then
  4131.         FOnCloseQuery (Self, Accept);
  4132.       { Did the CloseQuery event return True? }
  4133.       if Accept then begin
  4134.         Hide;
  4135.         if Assigned(FOnClose) then
  4136.           FOnClose (Self);
  4137.       end;
  4138.     end;
  4139.   end;
  4140. begin
  4141.   case Message.HitTest of
  4142.     HTLEFT..HTBOTTOMRIGHT:
  4143.       BeginSizing (TToolWindowSizeHandle(Message.HitTest - HTLEFT));
  4144.     HTCLOSE:
  4145.       CloseButtonLoop;
  4146.   else
  4147.     inherited;
  4148.   end;
  4149. end;
  4150.  
  4151. procedure TCustomToolWindow97.GetParams (var Params: TToolWindowParams);
  4152. begin
  4153.   with Params do begin
  4154.     CallAlignControls := True;
  4155.     ResizeEightCorner := True;
  4156.     ResizeClipCursor := True;
  4157.   end;
  4158. end;
  4159.  
  4160. procedure TCustomToolWindow97.ResizeBegin;
  4161. begin
  4162. end;
  4163.  
  4164. procedure TCustomToolWindow97.ResizeTrack (var Rect: TRect; const OrigRect: TRect);
  4165. begin
  4166. end;
  4167.  
  4168. procedure TCustomToolWindow97.ResizeEnd;
  4169. begin
  4170. end;
  4171.  
  4172. procedure TCustomToolWindow97.BeginSizing (const ASizeHandle: TToolWindowSizeHandle);
  4173. var
  4174.   DragX, DragY, ReverseX, ReverseY: Boolean;
  4175.   MinWidth, MinHeight: Integer;
  4176.   DragRect, OrigDragRect: TRect;
  4177.   ScreenDC: HDC;
  4178.   OrigPos, OldPos: TPoint;
  4179.  
  4180.   procedure MouseMoved;
  4181.   var
  4182.     Pos: TPoint;
  4183.     OldDragRect: TRect;
  4184.   begin
  4185.     GetCursorPos (Pos);
  4186.     { It needs to check if the cursor actually moved since last time. This is
  4187.       because a call to LockWindowUpdate (apparently) generates a mouse move
  4188.       message even when mouse hasn't moved. }
  4189.     if (Pos.X = OldPos.X) and (Pos.Y = OldPos.Y) then Exit;
  4190.     OldPos := Pos;
  4191.  
  4192.     OldDragRect := DragRect;
  4193.     DragRect := OrigDragRect;
  4194.     if DragX then begin
  4195.       if not ReverseX then Inc (DragRect.Right, Pos.X-OrigPos.X)
  4196.       else Inc (DragRect.Left, Pos.X-OrigPos.X);
  4197.     end;
  4198.     if DragY then begin
  4199.       if not ReverseY then Inc (DragRect.Bottom, Pos.Y-OrigPos.Y)
  4200.       else Inc (DragRect.Top, Pos.Y-OrigPos.Y);
  4201.     end;
  4202.     if DragRect.Right-DragRect.Left < MinWidth then begin
  4203.       if not ReverseX then DragRect.Right := DragRect.Left + MinWidth
  4204.       else DragRect.Left := DragRect.Right - MinWidth;
  4205.     end;
  4206.     if DragRect.Bottom-DragRect.Top < MinHeight then begin
  4207.       if not ReverseY then DragRect.Bottom := DragRect.Top + MinHeight
  4208.       else DragRect.Top := DragRect.Bottom - MinHeight;
  4209.     end;
  4210.  
  4211.     ResizeTrack (DragRect, OrigDragRect);
  4212.     DrawDraggingOutline (ScreenDC, @DragRect, @OldDragRect, False, False);
  4213.   end;
  4214. var
  4215.   Accept: Boolean;
  4216.   Msg: TMsg;
  4217.   R: TRect;
  4218. begin
  4219.   if Docked then Exit;
  4220.  
  4221.   Accept := False;
  4222.  
  4223.   GetMinimumSize (MinWidth, MinHeight);
  4224.   Inc (MinWidth, Width-ClientWidth);
  4225.   Inc (MinHeight, Height-ClientHeight);
  4226.  
  4227.   DragX := ASizeHandle in [twshLeft, twshRight, twshTopLeft, twshTopRight,
  4228.     twshBottomLeft, twshBottomRight];
  4229.   ReverseX := ASizeHandle in [twshLeft, twshTopLeft, twshBottomLeft];
  4230.   DragY := ASizeHandle in [twshTop, twshTopLeft, twshTopRight, twshBottom,
  4231.     twshBottomLeft, twshBottomRight];
  4232.   ReverseY := ASizeHandle in [twshTop, twshTopLeft, twshTopRight];
  4233.  
  4234.   ResizeBegin (ASizeHandle);
  4235.   try
  4236.     { Before locking, make sure all pending paint messages are processed }
  4237.     ProcessPaintMessages;
  4238.  
  4239.     { This uses LockWindowUpdate to suppress all window updating so the
  4240.       dragging outlines doesn't sometimes get garbled. (This is safe, and in
  4241.       fact, is the main purpose of the LockWindowUpdate function)
  4242.       IMPORTANT! While debugging you might want to enable the 'TB97DisableLock'
  4243.       conditional define (see top of the source code). }
  4244.     {$IFNDEF TB97DisableLock}
  4245.     LockWindowUpdate (GetDesktopWindow);
  4246.     {$ENDIF}
  4247.     { Get a DC of the entire screen. Works around the window update lock
  4248.       by specifying DCX_LOCKWINDOWUPDATE. }
  4249.     ScreenDC := GetDCEx(GetDesktopWindow, 0,
  4250.       DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
  4251.     try
  4252.       SetCapture (Handle);
  4253.       if Params.ResizeClipCursor and not UsingMultipleMonitors then begin
  4254.         R := GetPrimaryDesktopArea;
  4255.         ClipCursor (@R);
  4256.       end;
  4257.  
  4258.       { Initialize }
  4259.       OrigDragRect := BoundsRect;
  4260.       DragRect := OrigDragRect;
  4261.       DrawDraggingOutline (ScreenDC, @DragRect, nil, False, False);
  4262.       GetCursorPos (OrigPos);
  4263.       OldPos := OrigPos;
  4264.  
  4265.       { Stay in message loop until capture is lost. Capture is removed either
  4266.         by this procedure manually doing it, or by an outside influence (like
  4267.         a message box or menu popping up) }
  4268.       while GetCapture = Handle do begin
  4269.         case Integer(GetMessage(Msg, 0, 0, 0)) of
  4270.           -1: Break; { if GetMessage failed }
  4271.           0: begin
  4272.                { Repost WM_QUIT messages }
  4273.                PostQuitMessage (Msg.WParam);
  4274.                Break;
  4275.              end;
  4276.         end;
  4277.  
  4278.         case Msg.Message of
  4279.           WM_KEYDOWN, WM_KEYUP:
  4280.             { Ignore all keystrokes while sizing except for Escape }
  4281.             if Msg.WParam = VK_ESCAPE then
  4282.               Break;
  4283.           WM_MOUSEMOVE:
  4284.             { Note to self: WM_MOUSEMOVE messages should never be dispatched
  4285.               here to ensure no hints get shown during the drag process }
  4286.             MouseMoved;
  4287.           WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
  4288.             { Make sure it doesn't begin another loop }
  4289.             Break;
  4290.           WM_LBUTTONUP: begin
  4291.               Accept := True;
  4292.               Break;
  4293.             end;
  4294.           WM_RBUTTONDOWN..WM_MBUTTONDBLCLK:
  4295.             { Ignore all other mouse up/down messages }
  4296.             ;
  4297.         else
  4298.           TranslateMessage (Msg);
  4299.           DispatchMessage (Msg);
  4300.         end;
  4301.       end;
  4302.     finally
  4303.       { Since it sometimes breaks out of the loop without capture being
  4304.         released }
  4305.       if GetCapture = Handle then
  4306.         ReleaseCapture;
  4307.       ClipCursor (nil);
  4308.  
  4309.       { Hide dragging outline. Since NT will release a window update lock if
  4310.         another thread comes to the foreground, it has to release the DC
  4311.         and get a new one for erasing the dragging outline. Otherwise,
  4312.         the DrawDraggingOutline appears to have no effect when this happens. }
  4313.       ReleaseDC (GetDesktopWindow, ScreenDC);
  4314.       ScreenDC := GetDCEx(GetDesktopWindow, 0,
  4315.         DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
  4316.       DrawDraggingOutline (ScreenDC, nil, @DragRect, False, False);
  4317.       ReleaseDC (GetDesktopWindow, ScreenDC);
  4318.  
  4319.       { Release window update lock }
  4320.       {$IFNDEF TB97DisableLock}
  4321.       LockWindowUpdate (0);
  4322.       {$ENDIF}
  4323.     end;
  4324.   finally
  4325.     ResizeEnd (Accept);
  4326.   end;
  4327.  
  4328.   if Accept then begin
  4329.     BeginUpdate;
  4330.     try
  4331.       BoundsRect := DragRect;
  4332.     finally
  4333.       EndUpdate;
  4334.     end;
  4335.  
  4336.     { Make sure it doesn't go completely off the screen }
  4337.     MoveOnScreen (True);
  4338.   end;
  4339. end;
  4340.  
  4341. procedure TCustomToolWindow97.WMClose (var Message: TWMClose);
  4342. var
  4343.   MDIParentForm: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
  4344. begin
  4345.   { A floating toolbar does not use WM_CLOSE messages when its close button
  4346.     is clicked, but Windows still sends a WM_CLOSE message if the user
  4347.     presses Alt+F4 while one of the toolbar's controls is focused. Inherited
  4348.     is not called since we do not want Windows' default processing - which
  4349.     destroys the window. Instead, relay the message to the parent form. }
  4350.   MDIParentForm := GetMDIParent(GetToolWindowParentForm(Self));
  4351.   if Assigned(MDIParentForm) and MDIParentForm.HandleAllocated then
  4352.     SendMessage (MDIParentForm.Handle, WM_CLOSE, 0, 0);
  4353.   { Note to self: MDIParentForm is used instead of OwnerForm since MDI
  4354.     childs don't process Alt+F4 as Close }
  4355. end;
  4356.  
  4357. procedure TCustomToolWindow97.DoDockChangingHidden (DockingTo: TDock97);
  4358. begin
  4359.   if not(csDestroying in ComponentState) and Assigned(FOnDockChangingHidden) then
  4360.     FOnDockChangingHidden (Self, DockingTo);
  4361. end;
  4362.  
  4363. procedure TCustomToolWindow97.DoMove;
  4364. begin
  4365.   if Assigned(FOnMove) then
  4366.     FOnMove (Self);
  4367. end;
  4368.  
  4369. { TCustomToolWindow97 - property access methods }
  4370.  
  4371. function TCustomToolWindow97.IsLastDockStored: Boolean;
  4372. begin
  4373.   Result := FDockedTo = nil;
  4374. end;
  4375.  
  4376. procedure TCustomToolWindow97.SetCloseButton (Value: Boolean);
  4377. begin
  4378.   if FCloseButton <> Value then begin
  4379.     FCloseButton := Value;
  4380.  
  4381.     { Update the close button's visibility }
  4382.     InvalidateFloatingNCArea ([twrdCaption, twrdCloseButton]);
  4383.   end;
  4384. end;
  4385.  
  4386. procedure TCustomToolWindow97.SetCloseButtonWhenDocked (Value: Boolean);
  4387. begin
  4388.   if FCloseButtonWhenDocked <> Value then begin
  4389.     FCloseButtonWhenDocked := Value;
  4390.     if Docked then
  4391.       RecalcNCArea (Self);
  4392.   end;
  4393. end;
  4394.  
  4395. procedure TCustomToolWindow97.SetDefaultDock (Value: TDock97);
  4396. begin
  4397.   if FDefaultDock <> Value then begin
  4398.     FDefaultDock := Value;
  4399.     if Assigned(Value) then
  4400.       Value.FreeNotification (Self);
  4401.   end;
  4402. end;
  4403.  
  4404. procedure TCustomToolWindow97.SetDockedTo (Value: TDock97);
  4405. begin
  4406.   if Assigned(Value) then
  4407.     Parent := Value
  4408.   else
  4409.     Parent := ValidToolWindowParentForm(Self);
  4410. end;
  4411.  
  4412. procedure TCustomToolWindow97.SetDockPos (Value: Integer);
  4413. begin
  4414.   FDockPos := Value;
  4415.   if Docked then
  4416.     DockedTo.ArrangeToolbars (False);
  4417. end;
  4418.  
  4419. procedure TCustomToolWindow97.SetDockRow (Value: Integer);
  4420. begin
  4421.   FDockRow := Value;
  4422.   if Docked then
  4423.     DockedTo.ArrangeToolbars (False);
  4424. end;
  4425.  
  4426. procedure TCustomToolWindow97.SetBorderStyle (Value: TBorderStyle);
  4427. begin
  4428.   if FBorderStyle <> Value then begin
  4429.     FBorderStyle := Value;
  4430.     if Docked then
  4431.       RecalcNCArea (Self);
  4432.   end;
  4433. end;
  4434.  
  4435. procedure TCustomToolWindow97.SetDragHandleStyle (Value: TDragHandleStyle);
  4436. begin
  4437.   if FDragHandleStyle <> Value then begin
  4438.     FDragHandleStyle := Value;
  4439.     if Docked then
  4440.       RecalcNCArea (Self);
  4441.   end;
  4442. end;
  4443.  
  4444. procedure TCustomToolWindow97.SetFloatingMode (Value: TToolWindowFloatingMode);
  4445. begin
  4446.   if FFloatingMode <> Value then begin
  4447.     FFloatingMode := Value;
  4448.     if HandleAllocated then
  4449.       Perform (CM_SHOWINGCHANGED, 0, 0);
  4450.   end;
  4451. end;
  4452.  
  4453. procedure TCustomToolWindow97.SetFullSize (Value: Boolean);
  4454. begin
  4455.   if FFullSize <> Value then begin
  4456.     FFullSize := Value;
  4457.     ArrangeControls;
  4458.   end;
  4459. end;
  4460.  
  4461. procedure TCustomToolWindow97.SetLastDock (Value: TDock97);
  4462. begin
  4463.   if FUseLastDock and Assigned(FDockedTo) then
  4464.     { When docked, LastDock must be equal to DockedTo }
  4465.     Value := FDockedTo;
  4466.   if FLastDock <> Value then begin
  4467.     if Assigned(FLastDock) and (FLastDock <> Parent) then
  4468.       FLastDock.ChangeDockList (False, Self);
  4469.     FLastDock := Value;
  4470.     if Assigned(Value) then begin
  4471.       FUseLastDock := True;
  4472.       Value.FreeNotification (Self);
  4473.       Value.ChangeDockList (True, Self);
  4474.     end;
  4475.   end;
  4476. end;
  4477.  
  4478. procedure TCustomToolWindow97.SetResizable (Value: Boolean);
  4479. begin
  4480.   if FResizable <> Value then begin
  4481.     FResizable := Value;
  4482.     if not Docked then
  4483.       { Recreate the window handle because Resizable affects whether the
  4484.         tool window is created with a WS_THICKFRAME style }
  4485.       RecreateWnd;
  4486.   end;
  4487. end;
  4488.  
  4489. procedure TCustomToolWindow97.SetShowCaption (Value: Boolean);
  4490. begin
  4491.   if FShowCaption <> Value then begin
  4492.     FShowCaption := Value;
  4493.     if not Docked then
  4494.       RecalcNCArea (Self);
  4495.   end;
  4496. end;
  4497.  
  4498. procedure TCustomToolWindow97.SetUseLastDock (Value: Boolean);
  4499. begin
  4500.   if FUseLastDock <> Value then begin
  4501.     FUseLastDock := Value;
  4502.     if not Value then
  4503.       LastDock := nil
  4504.     else
  4505.       LastDock := FDockedTo;
  4506.   end;
  4507. end;
  4508.  
  4509. function TCustomToolWindow97.GetVersion: TToolbar97Version;
  4510. begin
  4511.   Result := Toolbar97VersionPropText;
  4512. end;
  4513.  
  4514. procedure TCustomToolWindow97.SetVersion (const Value: TToolbar97Version);
  4515. begin
  4516.   { write method required for the property to show up in Object Inspector }
  4517. end;
  4518.  
  4519. end.
  4520.