unit TB97;

{

  Toolbar97 version 1.63 (with Delphi 4 support)
  Copyright (C) 1998 by Jordan Russell

  e-mail:     jordanr@iname.com
  home page:  http://www.connect.net/jordanr/
              (alternate address: http://www.digicron.com/jordanr/)

  *PLEASE NOTE*  Before making any bug reports please first verify you are
                 using the latest version by checking my home page. And if
                 you do report a bug, please, if applicable, include a code
                 sample.

  You are free to use Toolbar97 in compiled form for any purpose. However,
  use in commercial or shareware applications requires registration. The
  Toolbar97 source code or DCU, in whole or in part, modified or unmodified,
  may not be redistributed for profit or as part of another commercial or
  shareware software package without express written permission from me.

  This code is distributed "as is" without any warranties, express or implied.

  Notes:
  - I cannot support modified versions of this code. So if you encounter a
    possible bug while using a modified version, always first revert back to
    the my original code before making an attempt to contact me.
  - While debugging the toolbar code you might want to enable the
    'TB97DisableLock' conditional define, as described below.
  - In the WM_NCPAINT handlers, GetWindowRect is used to work around a possible
    VCL problem. The Width, Height, and BoundsRect properties are sometimes
    wrong. So it avoids any use of these properties in the WM_NCPAINT handlers.
  - In case you are unsure of its meaning, NewStyleControls is a VCL variable
    set to True at application startup if the user is running Windows 95 or NT
    4.0 or later.
}

{$IFNDEF WIN32} Delphi 1 is not supported. {$ENDIF}

{$ALIGN ON}
{$BOOLEVAL OFF}
{$LONGSTRINGS ON}
{$WRITEABLECONST ON}

{x$DEFINE TB97DisableLock}
{ Remove the 'x' to enable the define. It will disable calls to
  LockWindowUpdate, which it calls to disable screen updates while dragging.
  You should temporarily enable that while debugging so you are able to see
  your code window if you have something like a breakpoint that's set inside
  the dragging routines }

{ Determine Delphi/C++Builder version }
{$IFNDEF VER90}  { if it's not Delphi 2.0 }
  {$IFNDEF VER93}  { and it's not C++Builder 1.0 }
    {$DEFINE TB97Delphi3orHigher}  { then it must be Delphi 3 or C++Builder 3 }
  {$ENDIF}
{$ENDIF}


interface

uses
  Windows, Messages, Classes, Controls, Forms, Menus, Graphics, Buttons,
  StdCtrls, ExtCtrls;

const
  Toolbar97Version = '1.63';

  WM_TB97DoneCreating = WM_USER + 5038;       { used internally }
  WM_TB97DoneCreating_Magic = $73A590F4;      { used internally }
  WM_TB97PaintDockedNCArea = WM_USER + 5039;  { used internally }

type
  { TDock97 }

  TDockBoundLinesValues = (blTop, blBottom, blLeft, blRight);
  TDockBoundLines = set of TDockBoundLinesValues;
  TDockPosition = (dpTop, dpBottom, dpLeft, dpRight);
  TDockType = (dtNotDocked, dtTopBottom, dtLeftRight);
  TDockableTo = set of TDockPosition;

  TCustomToolWindow97 = class;

  TInsertRemoveEvent = procedure(Sender: TObject; Inserting: Boolean;
    Bar: TCustomToolWindow97) of object;
  TRequestDockEvent = procedure(Sender: TObject; Bar: TCustomToolWindow97;
    var Accept: Boolean) of object;

  TDock97 = class(TCustomControl)
  private
    { Property values }
    FPosition: TDockPosition;
    FAllowDrag: Boolean;
    FBoundLines: TDockBoundLines;
    FBkg, FBkgCache: TBitmap;
    FBkgTransparent, FBkgOnToolbars: Boolean;
    FFixAlign: Boolean;
    FLimitToOneRow: Boolean;
    FOnInsertRemoveBar: TInsertRemoveEvent;
    FOnRequestDock: TRequestDockEvent;
    FOnResize: TNotifyEvent;

    { Internal }
    DisableArrangeToolbars: Integer; { Increment to disable ArrangeToolbars }
    DockList: TList;  { List of the visible toolbars docked. Items are casted in TCustomToolWindow97's.
                        But, at design time, all docked toolbars are here regardless of visibility }
    RowSizes: TList;  { List of the width or height of each row, depending on what Position is set to.
                        Items are casted info Longint's }

    { Property access methods }
    procedure SetAllowDrag (Value: Boolean);
    procedure SetBackground (Value: TBitmap);
    procedure SetBackgroundOnToolbars (Value: Boolean);
    procedure SetBackgroundTransparent (Value: Boolean);
    procedure SetBoundLines (Value: TDockBoundLines);
    procedure SetFixAlign (Value: Boolean);
    procedure SetPosition (Value: TDockPosition);

    function GetToolbarCount: Integer;
    function GetToolbars (Index: Integer): TCustomToolWindow97;

    { Internal }
    procedure FreeRowInfo;
    function GetRowOf (const XY: Integer; var Before: Boolean): Integer;
    function GetDesignModeRowOf (const XY: Integer): Integer;
    function GetHighestRow: Integer;
    function GetNumberOfToolbarsOnRow (const Row: Integer;
      const NotIncluding: TCustomToolWindow97): Integer;
    procedure RemoveBlankRows;
    procedure InsertRowBefore (const BeforeRow: Integer);
    procedure BuildRowInfo;
    procedure ChangeDockList (const Insert: Boolean; const Bar: TCustomToolWindow97;
      const IsVisible: Boolean);
    procedure ChangeWidthHeight (const IsClientWidthAndHeight: Boolean;
      NewWidth, NewHeight: Integer);
    procedure ArrangeToolbars;
    procedure DrawBackground (const DC: HDC;
      const IntersectClippingRect: TRect; const ExcludeClippingRect: PRect;
      const DrawRect: TRect);
    procedure InvalidateBackgrounds;
    procedure BackgroundChanged (Sender: TObject);
    function UsingBackground: Boolean;

    { Messages }
    procedure CMColorChanged (var Message: TMessage); message CM_COLORCHANGED;
    procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure WMMove (var Message: TWMMove); message WM_MOVE;
    procedure WMSize (var Message: TWMSize); message WM_SIZE;
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
  protected
    procedure AlignControls (AControl: TControl; var Rect: TRect); override;
    function GetPalette: HPALETTE; override;
    procedure Loaded; override;
    procedure SetParent (AParent: TWinControl); override;
    procedure Paint; override;
    procedure VisibleChanging; override;
  public
    constructor Create (AOwner: TComponent); override;
    procedure CreateParams (var Params: TCreateParams); override;
    destructor Destroy; override;

    function GetRowSize (const Row: Integer;
      const DefaultToolbar: TCustomToolWindow97): Integer;

    property ToolbarCount: Integer read GetToolbarCount;
    property Toolbars[Index: Integer]: TCustomToolWindow97 read GetToolbars;
  published
    property AllowDrag: Boolean read FAllowDrag write SetAllowDrag default True;
    property Background: TBitmap read FBkg write SetBackground;
    property BackgroundOnToolbars: Boolean read FBkgOnToolbars write SetBackgroundOnToolbars default True;
    property BackgroundTransparent: Boolean read FBkgTransparent write SetBackgroundTransparent default False;
    property BoundLines: TDockBoundLines read FBoundLines write SetBoundLines default [];
    property Color default clBtnFace;
    property FixAlign: Boolean read FFixAlign write SetFixAlign default False;
    property LimitToOneRow: Boolean read FLimitToOneRow write FLimitToOneRow default False;
    property PopupMenu;
    property Position: TDockPosition read FPosition write SetPosition default dpTop;

    property OnInsertRemoveBar: TInsertRemoveEvent read FOnInsertRemoveBar write FOnInsertRemoveBar;
    property OnRequestDock: TRequestDockEvent read FOnRequestDock write FOnRequestDock;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
  end;

  { TCustomToolWindow97 }

  TToolWindowArrangeType = (atNone, atMoveControls, atMoveControlsAndResize);
  TToolWindowParams = record
    CallAlignControls, ResizeEightCorner, ResizeClipCursor: Boolean;
  end;
  TPositionReadIntProc = function(const ToolbarName, Value: String; const Default: Longint;
    const ExtraData: Pointer): Longint;
  TPositionReadStringProc = function(const ToolbarName, Value, Default: String;
    const ExtraData: Pointer): String;
  TPositionWriteIntProc = procedure(const ToolbarName, Value: String; const Data: Longint;
    const ExtraData: Pointer);
  TPositionWriteStringProc = procedure(const ToolbarName, Value, Data: String;
    const ExtraData: Pointer);

  TCustomToolWindow97 = class(TCustomControl)
  private
    { Property variables }
    FDockPos, FDockRow: Integer;
    FDocked: Boolean;
    FDockedTo, FDefaultDock: TDock97;
    FOnClose, FOnDockChanged, FOnDockChanging, FOnRecreated, FOnRecreating,
      FOnResize, FOnVisibleChanged: TNotifyEvent;
    FActivateParent, FHideWhenInactive, FCloseButton, FFullSize, FResizable,
      FDragHandle: Boolean;
    FDockableTo: TDockableTo;
    FParams: TToolWindowParams;

    { Misc. }
    FUpdatingBounds,           { Incremented while internally changing the bounds. This allows
                                 it to move the toolbar freely in design mode and prevents the
                                 SizeChanging protected method from begin called }
    FDisableArrangeControls,   { Incremented to disable ArrangeControls }
    FHidden: Integer;          { Incremented while the toolbar is temporarily hidden }
    FArrangeNeeded: Boolean;
    FInactiveCaption: Boolean; { True when the caption of the toolbar is currently the inactive color }
    FFloatingTopLeft: TPoint;

    { When floating. These are not used (and FloatParent isn't created) in design mode }
    FloatParent: TWinControl; { The actual Parent of the toolbar when it is floating }
    MDIParentForm: TForm;     { Either the owner form, or the MDI parent if the owner form is an MDI child form }
    NotOnScreen: Boolean;     { True if the toolbar is currently hidden from view.
                                This is True while the toolbar is creating or when the application is deactivated }
    CloseButtonDown: Boolean; { True if Close button is currently depressed }

    { Property access methods }
    procedure SetCloseButton (Value: Boolean);
    procedure SetDefaultDock (Value: TDock97);
    procedure SetDockedTo (Value: TDock97);
    procedure SetDockPos (Value: Integer);
    procedure SetDockRow (Value: Integer);
    procedure SetDragHandle (Value: Boolean);
    procedure SetFullSize (Value: Boolean);
    procedure SetResizable (Value: Boolean);

    { Internal }
    procedure MoveOnScreen (const OnlyIfFullyOffscreen: Boolean);
    procedure CustomArrangeControls (const ArrangeType: TToolWindowArrangeType;
      const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint);
    procedure ArrangeControls;
    procedure DrawDraggingOutline (const DC: HDC; const NewRect, OldRect: PRect;
      const NewDocking, OldDocking: Boolean);
    class function NewMainWindowHook (var Message: TMessage): Boolean;
    procedure BeginMoving (const InitX, InitY: Integer);
    procedure BeginSizing (const HitTestValue: Integer; var Accept: Boolean;
      var NewRect: TRect);
    procedure DrawFloatingNCArea (const Clip: HRGN; const RedrawBorder, RedrawCaption, RedrawCloseButton: Boolean);
    procedure DrawDockedNCArea (const Clip: HRGN);
    procedure InvalidateDockedNCArea;
    procedure ValidateDockedNCArea;
    procedure SetNotOnScreen (const Value: Boolean);
    procedure SetInactiveCaption (const Value: Boolean);

    { Messages }
    procedure CMColorChanged (var Message: TMessage); message CM_COLORCHANGED;
    procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMShowingChanged (var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure CMVisibleChanged (var Message: TMessage); message CM_VISIBLECHANGED;
    procedure WMActivate (var Message: TWMActivate); message WM_ACTIVATE;
    procedure WMClose (var Message: TWMClose); message WM_CLOSE;
    procedure WMGetMinMaxInfo (var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
    procedure WMMove (var Message: TWMMove); message WM_MOVE;
    procedure WMMouseActivate (var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCHitTest (var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCLButtonDown (var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
    procedure WMTB97PaintDockedNCArea (var Message: TMessage); message WM_TB97PaintDockedNCArea;
    procedure WMSize (var Message: TWMSize); message WM_SIZE;
  protected
    property ActivateParent: Boolean read FActivateParent write FActivateParent default True;
    property Color default clBtnFace;
    property CloseButton: Boolean read FCloseButton write SetCloseButton default True;
    property DefaultDock: TDock97 read FDefaultDock write SetDefaultDock;
    property DockableTo: TDockableTo read FDockableTo write FDockableTo default [dpTop, dpBottom, dpLeft, dpRight];
    property DockedTo: TDock97 read FDockedTo write SetDockedTo;
    property DockPos: Integer read FDockPos write SetDockPos default -1;
    property DockRow: Integer read FDockRow write SetDockRow default 0;
    property DragHandle: Boolean read FDragHandle write SetDragHandle default True;
    property FullSize: Boolean read FFullSize write SetFullSize default False;
    property HideWhenInactive: Boolean read FHideWhenInactive write FHideWhenInactive default True;
    property Params: TToolWindowParams read FParams;
    property Resizable: Boolean read FResizable write SetResizable default True;

    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnDockChanged: TNotifyEvent read FOnDockChanged write FOnDockChanged;
    property OnDockChanging: TNotifyEvent read FOnDockChanging write FOnDockChanging;
    property OnRecreated: TNotifyEvent read FOnRecreated write FOnRecreated;
    property OnRecreating: TNotifyEvent read FOnRecreating write FOnRecreating;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
    property OnVisibleChanged: TNotifyEvent read FOnVisibleChanged write FOnVisibleChanged;

    { Overridden methods }
    procedure AlignControls (AControl: TControl; var Rect: TRect); override;
    procedure CreateParams (var Params: TCreateParams); override;
    function GetPalette: HPALETTE; override;
    procedure Loaded; override;
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    function PaletteChanged (Foreground: Boolean): Boolean; override;
    procedure SetParent (AParent: TWinControl); override;

    { Methods accessible to descendants }
    procedure ReadPositionData (const ReadIntProc: TPositionReadIntProc;
      const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); dynamic;
    procedure DoneReadingPositionData; dynamic;
    procedure WritePositionData (const WriteIntProc: TPositionWriteIntProc;
      const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); dynamic;
    procedure GetParams (var Params: TToolWindowParams); dynamic;
    procedure ResizeBegin (HitTestValue: Integer); dynamic;
    procedure ResizeTrack (var Rect: TRect; const OrigRect: TRect); dynamic;
    procedure ResizeEnd (Accept: Boolean); dynamic;
    procedure GetBarSize (var ASize: Integer; const DockType: TDockType); virtual; abstract;
    procedure GetDockRowSize (var AHeightOrWidth: Integer);
    procedure GetMinimumSize (var AClientWidth, AClientHeight: Integer); virtual; abstract;
    procedure InitializeOrdering; dynamic;
    procedure OrderControls (const CanMoveControls: Boolean;
      const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint); virtual; abstract;
    procedure SizeChanging (const AWidth, AHeight: Integer); virtual;
  public
    property Docked: Boolean read FDocked;

    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds (ALeft, ATop, AWidth, AHeight: Integer); override;

    procedure BeginUpdate;
    procedure EndUpdate;
  published
    property Height stored False;
    property Width stored False;
    property ClientHeight stored True;
    property ClientWidth stored True;
  end;

  { TCustomToolbar97 }

  TCustomToolbar97 = class(TCustomToolWindow97)
  private
    FFloatingRightX: Integer;
    SizeData: Pointer;

    { Lists }
    SlaveInfo,         { List of slave controls. Items are pointers to TSlaveInfo's }
    GroupInfo,         { List of the control "groups". List items are pointers to TGroupInfo's }
    LineSeps,          { List of the Y locations of line separators. Items are casted in TLineSep's }
    OrderList: TList;  { List of the child controls, arranged using the current "OrderIndex" values }

    { Property access methods }
    function GetOrderIndex (Control: TControl): Integer;
    procedure SetOrderIndex (Control: TControl; Value: Integer);

    { Internal }
    function ShouldBeVisible (const Control: TControl; const LeftOrRight: Boolean;
      const SetIt: Boolean): Boolean;
    procedure FreeGroupInfo (const List: TList);
    procedure BuildGroupInfo (const List: TList; const TranslateSlave: Boolean;
      const OldDockType, NewDockType: TDockType);

    { Messages }
    procedure CMControlListChange (var Message: TCMControlListChange); message CM_CONTROLLISTCHANGE;
  protected
    procedure Paint; override;

    procedure ReadPositionData (const ReadIntProc: TPositionReadIntProc;
      const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); override;
    procedure WritePositionData (const WriteIntProc: TPositionWriteIntProc;
      const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); override;
    procedure GetParams (var Params: TToolWindowParams); override;
    procedure ResizeBegin (HitTestValue: Integer); override;
    procedure ResizeTrack (var Rect: TRect; const OrigRect: TRect); override;
    procedure ResizeEnd (Accept: Boolean); override;

    procedure GetBarSize (var ASize: Integer; const DockType: TDockType); override;
    procedure GetMinimumSize (var AClientWidth, AClientHeight: Integer); override;
    procedure InitializeOrdering; override;
    procedure OrderControls (const CanMoveControls: Boolean;
      const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint); override;
  public
    property OrderIndex[Control: TControl]: Integer read GetOrderIndex write SetOrderIndex;
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetSlaveControl (const ATopBottom, ALeftRight: TControl);
  published
    property ClientHeight stored False;
    property ClientWidth stored False;
  end;

  { TToolbar97 }

  TToolbar97 = class(TCustomToolbar97)
  published
    property ActivateParent;
    property Caption;
    property Color;
    property CloseButton;
    property DefaultDock;
    property DockableTo;
    property DockedTo;
    property DockPos;
    property DockRow;
    property DragHandle;
    property FullSize;
    property HideWhenInactive;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property Visible;

    property OnClose;
    property OnDragDrop;
    property OnDragOver;
    property OnRecreated;
    property OnRecreating;
    property OnDockChanged;
    property OnDockChanging;
    property OnResize;
    property OnVisibleChanged;
  end;

  { TToolWindow97 }

  TToolWindow97 = class(TCustomToolWindow97)
  private
    FMinClientWidth, FMinClientHeight: Integer;
    FBarHeight, FBarWidth: Integer;
  protected
    procedure CreateParams (var Params: TCreateParams); override;

    procedure ReadPositionData (const ReadIntProc: TPositionReadIntProc;
      const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); override;
    procedure WritePositionData (const WriteIntProc: TPositionWriteIntProc;
      const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); override;
    procedure GetBarSize (var ASize: Integer; const DockType: TDockType); override;
    procedure GetMinimumSize (var AClientWidth, AClientHeight: Integer); override;
    procedure OrderControls (const CanMoveControls: Boolean;
      const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint); override;
    procedure SizeChanging (const AWidth, AHeight: Integer); override;
  public
    constructor Create (AOwner: TComponent); override;
  published
    property ActivateParent;
    property Caption;
    property Color;
    property CloseButton;
    property DefaultDock;
    property DockableTo;
    property DockedTo;
    property DockPos;
    property DockRow;
    property DragHandle;
    property FullSize;
    property HideWhenInactive;
    property MinClientHeight: Integer read FMinClientHeight write FMinClientHeight default 32;
    property MinClientWidth: Integer read FMinClientWidth write FMinClientWidth default 32;
    property ParentShowHint;
    property PopupMenu;
    property Resizable;
    property ShowHint;
    property TabOrder;
    property Visible;

    property OnClose;
    property OnDragDrop;
    property OnDragOver;
    property OnDockChanged;
    property OnDockChanging;
    property OnRecreated;
    property OnRecreating;
    property OnResize;
    property OnVisibleChanged;
  end;

  { TToolbarSep97 }

  TToolbarSepSize = 1..MaxInt;

  TToolbarSep97 = class(TGraphicControl)
  private
    FBlank: Boolean;
    FSizeHorz, FSizeVert: TToolbarSepSize;
    procedure SetBlank (Value: Boolean);
    procedure SetSizeHorz (Value: TToolbarSepSize);
    procedure SetSizeVert (Value: TToolbarSepSize);
  protected
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
    procedure SetParent (AParent: TWinControl); override;
  public
    constructor Create (AOwner: TComponent); override;
  published
    { These two properties don't need to be stored since it automatically gets
      resized based on the setting of SizeHorz and SizeVert }
    property Width stored False;
    property Height stored False;
    property Blank: Boolean read FBlank write SetBlank default False;
    property SizeHorz: TToolbarSepSize read FSizeHorz write SetSizeHorz default 6;
    property SizeVert: TToolbarSepSize read FSizeVert write SetSizeVert default 6;
  end;

  { TToolbarButton97 }

  TButtonDisplayMode = (dmBoth, dmGlyphOnly, dmTextOnly);
  TButtonState97 = (bsUp, bsDisabled, bsDown, bsExclusive, bsMouseIn);
  TNumGlyphs97 = 1..5;

  TToolbarButton97 = class(TGraphicControl)
  private
    FAllowAllUp: Boolean;
    FDisplayMode: TButtonDisplayMode;
    FDown: Boolean;
    FDropdownArrow: Boolean;
    FDropdownCombo: Boolean;
    FDropdownMenu: TPopupMenu;
    FFlat: Boolean;
    FGlyph: Pointer;
    FGroupIndex: Integer;
    FLayout: TButtonLayout;
    FMargin: Integer;
    FModalResult: TModalResult;
    FNoBorder: Boolean;
    FOldDisabledStyle: Boolean;
    FOpaque: Boolean;
    FRepeating: Boolean;
    FRepeatDelay, FRepeatInterval: Integer;
    FShowBorderWhenInactive: Boolean;
    FSpacing: Integer;
    FWordWrap: Boolean;
    FOnMouseEnter, FOnMouseExit: TNotifyEvent;
    { Internal }
    FInClick: Boolean;
    FMouseInControl: Boolean;
    FMouseIsDown: Boolean;
    FMenuIsDown: Boolean;
    FHooked: Boolean;
    FUsesDropdown: Boolean;
    FRepeatTimer: TTimer;
    procedure GlyphChanged(Sender: TObject);
    procedure UpdateExclusive;
    procedure SetAllowAllUp (Value: Boolean);
    function GetCallDormant: Boolean;
    procedure SetCallDormant (Value: Boolean);
    procedure SetDown (Value: Boolean);
    procedure SetDisplayMode (Value: TButtonDisplayMode);
    procedure SetDropdownArrow (Value: Boolean);
    procedure SetDropdownCombo (Value: Boolean);
    procedure SetDropdownMenu (Value: TPopupMenu);
    procedure SetFlat (Value: Boolean);
    function GetGlyph: TBitmap;
    procedure SetGlyph (Value: TBitmap);
    function GetGlyphMask: TBitmap;
    procedure SetGlyphMask (Value: TBitmap);
    procedure SetGroupIndex (Value: Integer);
    procedure SetLayout (Value: TButtonLayout);
    procedure SetMargin (Value: Integer);
    procedure SetNoBorder (Value: Boolean);
    function GetNumGlyphs: TNumGlyphs97;
    procedure SetNumGlyphs (Value: TNumGlyphs97);
    procedure SetOldDisabledStyle (Value: Boolean);
    procedure SetOpaque (Value: Boolean);
    procedure SetSpacing (Value: Integer);
    procedure SetWordWrap (Value: Boolean);
    procedure UpdateTracking;
    procedure Redraw (const Erase: Boolean);
    function PointInButton (X, Y: Integer): Boolean;
    procedure ButtonMouseTimerHandler (Sender: TObject);
    procedure RepeatTimerHandler (Sender: TObject);
    class function DeactivateHook (var Message: TMessage): Boolean;
    procedure WMLButtonDblClk (var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMButtonPressed (var Message: TMessage); message CM_BUTTONPRESSED;
    procedure CMDialogChar (var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
    procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMCancelMode (var Message: TWMCancelMode); message WM_CANCELMODE;
  protected
    FState: TButtonState97;
    function GetPalette: HPALETTE; override;
    procedure Loaded; override;
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove (Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp (Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Paint; override;
  public
    property CallDormant: Boolean read GetCallDormant write SetCallDormant;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
    procedure MouseEntered;
    procedure MouseLeft;
  published
    property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property DisplayMode: TButtonDisplayMode read FDisplayMode write SetDisplayMode default dmBoth;
    property Down: Boolean read FDown write SetDown default False;
    property DragCursor;
    property DragMode;
    property DropdownArrow: Boolean read FDropdownArrow write SetDropdownArrow default True;
    property DropdownCombo: Boolean read FDropdownCombo write SetDropdownCombo default False;
    property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu;
    property Caption;
    property Enabled;
    property Flat: Boolean read FFlat write SetFlat default True;
    property Font;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property GlyphMask: TBitmap read GetGlyphMask write SetGlyphMask;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property ModalResult: TModalResult read FModalResult write FModalResult default 0;
    property NoBorder: Boolean read FNoBorder write SetNoBorder default False;
    property NumGlyphs: TNumGlyphs97 read GetNumGlyphs write SetNumGlyphs default 1;
    property OldDisabledStyle: Boolean read FOldDisabledStyle write SetOldDisabledStyle default False;
    property Opaque: Boolean read FOpaque write SetOpaque default True;
    property ParentFont;
    property ParentShowHint;
    property Repeating: Boolean read FRepeating write FRepeating default False;
    property RepeatDelay: Integer read FRepeatDelay write FRepeatDelay default 400;
    property RepeatInterval: Integer read FRepeatInterval write FRepeatInterval default 100;
    property ShowBorderWhenInactive: Boolean read FShowBorderWhenInactive write FShowBorderWhenInactive default False;
    property ShowHint;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property Visible;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;

    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseExit: TNotifyEvent read FOnMouseExit write FOnMouseExit;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

  { TEdit97 }

  TEdit97 = class(TCustomEdit)
  private
    MouseInControl: Boolean;
    procedure RedrawBorder (const Clip: HRGN);
    procedure NewAdjustHeight;
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
    procedure CMMouseEnter (var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave (var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMSetFocus (var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus (var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
  protected
    procedure Loaded; override;
  public
    constructor Create (AOwner: TComponent); override;
  published
    property CharCase;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    {$IFDEF TB97Delphi3orHigher}
    property ImeMode;
    property ImeName;
    {$ENDIF}
    property MaxLength;
    property OEMConvert;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

procedure RegLoadToolbarPositions (const Form: TForm; const BaseRegistryKey: String);
procedure RegSaveToolbarPositions (const Form: TForm; const BaseRegistryKey: String);
procedure IniLoadToolbarPositions (const Form: TForm; const Filename: String);
procedure IniSaveToolbarPositions (const Form: TForm; const Filename: String);

procedure CustomLoadToolbarPositions (const Form: TForm;
  const ReadIntProc: TPositionReadIntProc;
  const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
procedure CustomSaveToolbarPositions (const Form: TForm;
  const WriteIntProc: TPositionWriteIntProc;
  const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer);

procedure AddFloatingNCAreaToRect (var R: TRect; const Resizable: Boolean);
function GetDockTypeOf (const Control: TDock97): TDockType;

procedure Register;

var
  ButtonMouseInControl: TToolbarButton97 = nil;

implementation

uses
  CommCtrl, Registry, IniFiles, SysUtils, Consts;

const
  { Exception messages }
  STB97DockNotFormOwner = 'TDock97 must be owned by a form';
  STB97DockParentNotAllowed = 'A TDock97 control cannot be placed inside a tool window or another TDock97';
  STB97DockCannotHide = 'Cannot hide a TDock97';
  STB97DockCannotChangePosition = 'Cannot change Position of a TDock97 if it already contains controls';
  STB97ToolwinNotFormOwner = 'Tool windows must be owned by a form';
  STB97ToolwinNameNotSet = 'Cannot save tool window''s position because Name property is not set';
  STB97ToolwinDockedToNameNotSet = 'Cannot save tool window''s position because DockedTo''s Name property not set';
  STB97ToolwinParentNotAllowed = 'A tool window can only be placed on a TDock97 or directly on the form';
  STB97ToolbarControlNotChildOfToolbar = 'Control is not a child of the toolbar';
  STB97SepParentNotAllowed = 'TToolbarSep97 can only be placed on a TToolbar97';

  { All spacing & margin values are here. It's recommended that you don't
    try changing any of this! }
  LineSpacing = 6;
  DropdownComboWidth = 11;
  TopMarginNotDocked = 2;
  TopMargin: array[Boolean] of Integer = (TopMarginNotDocked, 0);
  BottomMarginNotDocked = 1;
  BottomMargin: array[Boolean] of Integer = (BottomMarginNotDocked, 0);
  LeftMarginNotDocked = 4;
  LeftMargin: array[Boolean] of Integer = (LeftMarginNotDocked, 0);
  RightMarginNotDocked = 4;
  RightMargin: array[Boolean] of Integer = (RightMarginNotDocked, 0);
  DockedBorderSize = 2;
  DockedBorderSize2 = DockedBorderSize*2;
  DragHandleSize = 9;

  DefaultBarWidthHeight = 8;

  ForceDockAtTopRow = 0;
  ForceDockAtLeftPos = -8;

  PositionLeftOrRight = [dpLeft, dpRight];

  { Constants for TCustomToolWindow97 registry values/data.
    Don't localize any of these names! }
  rvRev = 'Rev';
  rdCurrentRev = 2;
  rvVisible = 'Visible';
  rvDockedTo = 'DockedTo';
  rdDockedToFloating = '+';
  rvDockRow = 'DockRow';
  rvDockPos = 'DockPos';
  rvFloatLeft = 'FloatLeft';
  rvFloatTop = 'FloatTop';
  { TCustomToolbar97 specific }
  rvFloatRightX = 'FloatRightX';
  { TToolWindow97 specific }
  rvClientWidth = 'ClientWidth';
  rvClientHeight = 'ClientHeight';

type
  { Used internally by the TCustomToolbar97.Resize* procedures }
  PToolbar97SizeData = ^TToolbar97SizeData;
  TToolbar97SizeData = record
    HitTest: Integer;
    NewSizes: TList;  { List of valid new sizes. Items are casted into TSmallPoints }
    CurRightX: Integer;
    DisableSensCheck, OpSide: Boolean;
    SizeSens: Integer;
  end;

  { Used in TCustomToolbar97.GroupInfo lists }
  PGroupInfo = ^TGroupInfo;
  TGroupInfo = record
    GroupWidth,           { Width in pixels of the group, if all controls were
                            lined up left-to-right }
    GroupHeight: Integer; { Heights in pixels of the group, if all controls were
                            lined up top-to-bottom }
    Members: TList;
  end;

  { Used in TCustomToolbar97.SlaveInfo lists }
  PSlaveInfo = ^TSlaveInfo;
  TSlaveInfo = record
    LeftRight,
    TopBottom: TControl;
  end;

  { Used in TCustomToolbar97.LineSeps lists }
  TLineSep = packed record
    Y: SmallInt;
    Blank: Boolean;
    Unused: Boolean;
  end;

  { Use by CompareControls }
  PCompareExtra = ^TCompareExtra;
  TCompareExtra = record
    Toolbar: TCustomToolbar97;
    ComparePositions: Boolean;
    CurDockType: TDockType;
  end;

  TFloatParent = class(TWinControl)
  protected
    procedure CreateParams (var Params: TCreateParams); override;
  end;

  THookedFormID = (hkParentForm, hkChildForm);
  PHookedFormInfo = ^THookedFormInfo;
  THookedFormInfo = record
    Form: TForm;
    ID: THookedFormID;
    InstalledMainHook: Boolean;
    SaveActiveControl: HWND;
    RefCount: Integer;
  end;
  PMainHookedFormInfo = ^TMainHookedFormInfo;
  TMainHookedFormInfo = record
    Form: TForm;
    RefCount: Integer;
  end;

procedure InstallHooks (const AID: THookedFormID; const AForm: TForm;
  const InstallMainHook: Boolean); forward;
procedure UninstallHooks (const AID: THookedFormID; const AForm: TForm); forward;

var
  HookedForms, MainHookedForms, DoneCreatingList: TList;
  CWPHookHandle: HHOOK;

  ButtonHookRefCount: Longint = 0;

  { See TToolbarButton97.ButtonMouseTimerHandler for info on this }
  ButtonMouseTimer: TTimer = nil;

procedure Register;
begin
  RegisterComponents ('Toolbar97',
    [TDock97, TToolbar97, TToolWindow97, TToolbarButton97, TToolbarSep97, TEdit97]);
end;


{ Misc. functions }

function GetSmallCaptionHeight: Integer;
{ Returns height of the caption of a small window }
begin
  if NewStyleControls then
    Result := GetSystemMetrics(SM_CYSMCAPTION)
  else
    { Win 3.x doesn't support small captions, so, like Office 97, use the size
      of normal captions minus one }
    Result := GetSystemMetrics(SM_CYCAPTION) - 1;
end;
function GetBorderSize (const Resizable: Boolean): TPoint;
{ Returns size of a thick border. Note that, depending on the Windows version,
  this may not be the same as the actual window metrics since it draws its
  own border }
const
  XMetrics: array[Boolean] of Integer = (SM_CXDLGFRAME, SM_CXFRAME);
  YMetrics: array[Boolean] of Integer = (SM_CYDLGFRAME, SM_CYFRAME);
begin
  Result.X := GetSystemMetrics(XMetrics[Resizable]);
  Result.Y := GetSystemMetrics(YMetrics[Resizable]);
end;

procedure AddFloatingNCAreaToRect (var R: TRect; const Resizable: Boolean);
begin
  with GetBorderSize(Resizable) do begin
    Dec (R.Left, X);
    Inc (R.Right, X);
    Inc (R.Bottom, GetSmallCaptionHeight + Y*2);
  end;
end;
procedure AddDockedNCAreaToSize (var S: TPoint; const LeftRight, DragHandle: Boolean);
begin
  if not LeftRight then begin
    Inc (S.X, DockedBorderSize2 + (Ord(DragHandle) * DragHandleSize));
    Inc (S.Y, DockedBorderSize2);
  end
  else begin
    Inc (S.X, DockedBorderSize2);
    Inc (S.Y, DockedBorderSize2 + (Ord(DragHandle) * DragHandleSize));
  end;
end;

(* not currently used
function GetDragFullWindows: Boolean;
var
  S: BOOL;
begin
  Result := False;
  if SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, @S, 0) then
    Result := S;
end;
*)

function GetDesktopArea: TRect;
{ Returns a rectangle of the screen. But, under Win95 and NT 4.0, it excludes
  the area taken up by the taskbar. }
begin
  if not SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0) then
    { SPI_GETWORKAREA is only supported by Win95 and NT 4.0. So it fails under
      Win 3.x. In that case, return a rectangle of the entire screen }
    Result := Rect(0, 0, GetSystemMetrics(SM_CXSCREEN),
      GetSystemMetrics(SM_CYSCREEN));
end;

function GetMDIParent (const Form: TForm): TForm;
{ Returns the parent of the specified MDI child form. But, if Form isn't a
  MDI child, it simply returns Form. }
var
  I, J: Integer;
begin
  Result := Form;
  if Form = nil then Exit;
  if Form.FormStyle = fsMDIChild then
    for I := 0 to Screen.FormCount-1 do
      with Screen.Forms[I] do begin
        if FormStyle <> fsMDIForm then Continue;
        for J := 0 to MDIChildCount-1 do
          if MDIChildren[J] = Form then begin
            Result := Screen.Forms[I];
            Exit;
          end;
      end;
end;

function GetDockTypeOf (const Control: TDock97): TDockType;
begin
  if Control = nil then
    Result := dtNotDocked
  else begin
    if not(Control.Position in PositionLeftOrRight) then
      Result := dtTopBottom
    else
      Result := dtLeftRight;
  end;
end;

procedure ShowHideFloatParents (const Form: TForm; const AppActive: Boolean);
var
  HideFloatingToolbars: Boolean;
  I: Integer;
  ParentForm: TForm;
begin
  { First call ShowHideFloatParent on child forms }
  for I := 0 to Form.MDIChildCount-1 do
    ShowHideFloatParents (Form.MDIChildren[I], AppActive);

  { Hide any child toolbars if: the application is not active or is
    minimized, or the form (or its MDI parent) is not visible or is minimized }
  HideFloatingToolbars := IsIconic(Application.Handle) or
    not IsWindowVisible(Form.Handle) or IsIconic(Form.Handle);
  ParentForm := GetMDIParent(Form);
  if ParentForm <> Form then
    HideFloatingToolbars := HideFloatingToolbars or
      not IsWindowVisible(ParentForm.Handle) or IsIconic(ParentForm.Handle);
  for I := 0 to Form.ComponentCount-1 do
    if Form.Components[I] is TCustomToolWindow97 then
      with TCustomToolWindow97(Form.Components[I]) do begin
        SetNotOnScreen (not Docked and (HideFloatingToolbars or (FHideWhenInactive and not AppActive)));
        SetInactiveCaption (not Docked and (not FHideWhenInactive and not AppActive));
      end;
end;

function FormCallWndProcHook (Code: Integer; WParam: WPARAM; LParam: LPARAM): LRESULT;
stdcall;
var
  I: Integer;
  Wnd: HWND;
  Ctl: TWinControl;
begin
  if Code = HC_ACTION then begin
    case PCWPStruct(LParam).Message of
      WM_DESTROY, WM_SETFOCUS, WM_WINDOWPOSCHANGED: begin
          for I := 0 to HookedForms.Count-1 do
            with PHookedFormInfo(HookedForms.List[I])^ do begin  { uses List property for speed }
              Wnd := PCWPStruct(LParam).hwnd;
              case PCWPStruct(LParam).Message of
                WM_DESTROY:
                  if Wnd = SaveActiveControl then
                    SaveActiveControl := 0;
                WM_SETFOCUS: begin
                    if Form.HandleAllocated and IsChild(Form.Handle, Wnd) then begin
                      SaveActiveControl := 0;
                      while True do begin
                        Ctl := FindControl(Wnd);
                        if Ctl <> nil then begin
                          if (Ctl <> Form) and Ctl.HandleAllocated and
                             (GetParentForm(Ctl) = Form) then
                            SaveActiveControl := Ctl.Handle;
                          Break;
                        end;
                        Wnd := GetParent(Wnd);
                        if Wnd = 0 then Break;
                      end;
                      Break;
                    end;
                  end;
                WM_WINDOWPOSCHANGED:
                  if Form.HandleAllocated and (Wnd = Form.Handle) then
                    ShowHideFloatParents (Form, Application.Active);
              end;
            end;
        end;
    end;
  end;
  Result := CallNextHookEx(CWPHookHandle, Code, WParam, LParam);
end;

procedure InstallHooks (const AID: THookedFormID; const AForm: TForm;
  const InstallMainHook: Boolean);
var
  I: Integer;
  Info: PHookedFormInfo;
  AlreadyExists: Boolean;
  MainInfo: PMainHookedFormInfo;
begin
  for I := 0 to HookedForms.Count-1 do
    with PHookedFormInfo(HookedForms[I])^ do
      { If AForm already exists in list with the same ID, only increment
        the reference count }
      if (ID = AID) and (Form = AForm) then begin
        Inc (RefCount);
        Exit;
      end;
  New (Info);
  try
    with Info^ do begin
      Form := AForm;
      ID := AID;
      InstalledMainHook := InstallMainHook;
      if InstallMainHook then begin
        AlreadyExists := False;
        for I := 0 to MainHookedForms.Count-1 do
          with PMainHookedFormInfo(MainHookedForms[I])^ do
            if (Form = AForm) then begin
              Inc (RefCount);
              AlreadyExists := True;
              Break;
            end;
        if not AlreadyExists then begin
          New (MainInfo);
          with MainInfo^ do begin
            Form := AForm;
            RefCount := 1;
          end;
          MainHookedForms.Add (MainInfo);
          if MainHookedForms.Count = 1 then
            Application.HookMainWindow (TCustomToolWindow97.NewMainWindowHook);
        end;
      end;
      SaveActiveControl := 0;
      RefCount := 1;
    end;
    HookedForms.Add (Info);
    if HookedForms.Count = 1 then
      CWPHookHandle := SetWindowsHookEx(WH_CALLWNDPROC, FormCallWndProcHook, 0, GetCurrentThreadId);
  except
    Dispose (Info);
    raise;
  end;
end;

procedure UninstallHooks (const AID: THookedFormID; const AForm: TForm);
var
  I, J: Integer;
begin
  for I := HookedForms.Count-1 downto 0 do
    with PHookedFormInfo(HookedForms[I])^ do
      if (ID = AID) and (Form = AForm) then begin
        Dec (RefCount);
        if RefCount = 0 then begin
          if InstalledMainHook then begin
            for J := MainHookedForms.Count-1 downto 0 do
              with PMainHookedFormInfo(MainHookedForms[J])^ do
                if (Form = AForm) then begin
                  Dec (RefCount);
                  if RefCount = 0 then begin
                    Dispose (PMainHookedFormInfo(MainHookedForms[J]));
                    MainHookedForms.Delete (J);
                    if MainHookedForms.Count = 0 then
                      Application.UnhookMainWindow (TCustomToolWindow97.NewMainWindowHook);
                  end;
                end;
          end;
          Dispose (PHookedFormInfo(HookedForms[I]));
          HookedForms.Delete (I);
          if HookedForms.Count = 0 then begin
            UnhookWindowsHookEx (CWPHookHandle);
            CWPHookHandle := 0;
          end;
        end;
      end;
end;

type
  TListSortExCompare = function (const Item1, Item2, ExtraData: Pointer): Integer;
procedure ListSortEx (const List: TList; const Compare: TListSortExCompare;
  const ExtraData: Pointer);
{ Similar to TList.Sort, but lets you pass a user-defined ExtraData pointer }
  procedure QuickSortEx (L: Integer; const R: Integer);
  var
    I, J: Integer;
    P: Pointer;
  begin
    repeat
      I := L;
      J := R;
      P := List[(L + R) shr 1];
      repeat
        while Compare(List[I], P, ExtraData) < 0 do Inc(I);
        while Compare(List[J], P, ExtraData) > 0 do Dec(J);
        if I <= J then
        begin
          List.Exchange (I, J);
          Inc (I);
          Dec (J);
        end;
      until I > J;
      if L < J then QuickSortEx (L, J);
      L := I;
    until I >= R;
  end;
begin
  if List.Count > 1 then
    QuickSortEx (0, List.Count-1);
end;

procedure ProcessPaintMessages;
{ Dispatches all pending WM_PAINT messages. In effect, this is like an
  'UpdateWindow' on all visible windows }
var
  Msg: TMsg;
begin
  while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_NOREMOVE) do begin
    case Integer(GetMessage(Msg, 0, WM_PAINT, WM_PAINT)) of
      -1: Break; { if GetMessage failed }
      0: begin
           { Repost WM_QUIT messages }
           PostQuitMessage (Msg.WParam);
           Break;
         end;
    end;
    DispatchMessage (Msg);
  end;
end;

{$IFNDEF TB97Delphi3orHigher}
type
  PMaxLogPalette = ^TMaxLogPalette;
  TMaxLogPalette = packed record
    palVersion: Word;
    palNumEntries: Word;
    palPalEntry: array[Byte] of TPaletteEntry;
  end;
function CopyPalette (Palette: HPALETTE): HPALETTE;
var
  PaletteSize: Integer;
  LogPal: TMaxLogPalette;
begin
  Result := 0;
  if Palette = 0 then Exit;
  PaletteSize := 0;
  if GetObject(Palette, SizeOf(PaletteSize), @PaletteSize) = 0 then Exit;
  if PaletteSize = 0 then Exit;
  with LogPal do begin
    palVersion := $0300;
    palNumEntries := PaletteSize;
    GetPaletteEntries (Palette, 0, PaletteSize, palPalEntry);
  end;
  Result := CreatePalette(PLogPalette(@LogPal)^);
end;
{$ENDIF}


{ TDock97 - internal }

constructor TDock97.Create (AOwner: TComponent);
begin
  inherited;

  if not(AOwner is TForm) then
    raise EInvalidOperation.Create(STB97DockNotFormOwner);
    { because TCustomToolWindow97 depends on docks being in the form's component list }

  FAllowDrag := True;
  FBkgOnToolbars := True;
  DockList := TList.Create;
  RowSizes := TList.Create;

  Inc (DisableArrangeToolbars);
  try
    ControlStyle := ControlStyle +
      [csAcceptsControls, csNoStdEvents] -
      [csClickEvents, csCaptureMouse, csOpaque];
    FBkg := TBitmap.Create;
    FBkg.OnChange := BackgroundChanged;
    Position := dpTop;
    Color := clBtnFace;
  finally
    Dec (DisableArrangeToolbars);
  end;
  { Rearranging was disabled, so manually rearrange it now }
  ArrangeToolbars;
end;

procedure TDock97.CreateParams (var Params: TCreateParams);
begin
  inherited;
  { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker
    and are not necessary for this control at run time }
  if not(csDesigning in ComponentState) then
    with Params.WindowClass do
      Style := Style and not(CS_HREDRAW or CS_VREDRAW);
end;

destructor TDock97.Destroy;
begin
  FBkgCache.Free;
  FBkg.Free;
  FreeRowInfo;
  RowSizes.Free;
  DockList.Free;
  inherited;
end;

procedure TDock97.SetParent (AParent: TWinControl);
begin
  if (AParent is TCustomToolWindow97) or (AParent is TDock97) then
    raise EInvalidOperation.Create(STB97DockParentNotAllowed);

  inherited;
end;

procedure TDock97.VisibleChanging;
begin
  if Visible then
    raise EInvalidOperation.Create(STB97DockCannotHide);
  inherited;
end;

procedure TDock97.FreeRowInfo;
begin
  if Assigned(RowSizes) then
    RowSizes.Clear;
end;

procedure TDock97.BuildRowInfo;
var
  R, I, Size, HighestSize: Integer;
begin
  FreeRowInfo;
  for R := 0 to GetHighestRow do begin
    HighestSize := DefaultBarWidthHeight;
    for I := 0 to DockList.Count-1 do begin
      with TCustomToolWindow97(DockList[I]) do begin
        if FDockRow <> R then Continue;
        GetBarSize (Size, GetDockTypeOf(Self));
        if Size > HighestSize then HighestSize := Size;
      end;
    end;
    RowSizes.Add (Pointer(HighestSize));
  end;
end;

function TDock97.GetRowSize (const Row: Integer;
  const DefaultToolbar: TCustomToolWindow97): Integer;
begin
  if Row < RowSizes.Count then
    Result := Longint(RowSizes[Row])
  else begin
    { If it's out of bounds }
    if DefaultToolbar = nil then
      Result := 0
    else
      DefaultToolbar.GetBarSize (Result, GetDockTypeOf(Self));
  end;
end;

function TDock97.GetRowOf (const XY: Integer; var Before: Boolean): Integer;
{ Returns row number of the specified coordinate. Before is set to True if it
  was close to being in between two rows. }
var
  HighestRow, R, CurY, NextY: Integer;
begin
  Result := 0;  Before := False;
  HighestRow := GetHighestRow;
  CurY := 0;
  for R := 0 to HighestRow+1 do begin
    if R <= HighestRow then
      NextY := CurY + GetRowSize(R, nil) + DockedBorderSize2
    else
      NextY := High(NextY);
    if XY <= CurY+5 then begin
      Result := R;
      Before := True;
      Break;
    end;
    if (XY >= CurY+5) and (XY <= NextY-5) then begin
      Result := R;
      Break;
    end;
    CurY := NextY;
  end;
end;

function TDock97.GetDesignModeRowOf (const XY: Integer): Integer;
{ Similar to GetRowOf, but is a little different to accomidate design mode
  better }
var
  HighestRowPlus1, R, CurY, NextY: Integer;
begin
  Result := 0;
  HighestRowPlus1 := GetHighestRow+1;
  CurY := 0;
  for R := 0 to HighestRowPlus1 do begin
    Result := R;
    if R = HighestRowPlus1 then Break;
    NextY := CurY + GetRowSize(R, nil) + DockedBorderSize2;
    if XY < NextY then
      Break;
    CurY := NextY;
  end;
end;

function TDock97.GetHighestRow: Integer;
{ Returns highest used row number, or -1 if no rows are used }
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to DockList.Count-1 do
    with TCustomToolWindow97(DockList[I]) do
      if FDockRow > Result then
        Result := FDockRow;
end;

function TDock97.GetNumberOfToolbarsOnRow (const Row: Integer;
  const NotIncluding: TCustomToolWindow97): Integer;
{ Returns number of toolbars on the specified row. The toolbar specified by
  "NotIncluding" is not included in the count. }
var
  I: Integer;
begin
  Result := 0;
  for I := 0 to DockList.Count-1 do
    if (TCustomToolWindow97(DockList[I]).FDockRow = Row) and
       (DockList[I] <> NotIncluding) then
      Inc (Result);
end;

procedure TDock97.RemoveBlankRows;
{ Deletes any blank row numbers, adjusting the docked toolbars' FDockRow as
  needed }
var
  HighestRow, R, I: Integer;
  RowIsEmpty: Boolean;
begin
  HighestRow := GetHighestRow;
  R := 0;
  while R <= HighestRow do begin
    RowIsEmpty := True;
    for I := 0 to DockList.Count-1 do
      if TCustomToolWindow97(DockList[I]).FDockRow = R then begin
        RowIsEmpty := False;
        Break;
      end;
    if RowIsEmpty then begin
      { Shift all ones higher than R back one }
      for I := 0 to DockList.Count-1 do
        with TCustomToolWindow97(DockList[I]) do
          if FDockRow > R then
            Dec (FDockRow);
      Dec (HighestRow);
    end;
    Inc (R);
  end;
end;

procedure TDock97.InsertRowBefore (const BeforeRow: Integer);
{ Inserts a blank row before BeforeRow, adjusting all the docked toolbars'
  FDockRow as needed }
var
  I: Integer;
begin
  for I := 0 to DockList.Count-1 do
    with TCustomToolWindow97(DockList[I]) do
      if FDockRow >= BeforeRow then
        Inc (FDockRow);
end;

procedure TDock97.ChangeWidthHeight (const IsClientWidthAndHeight: Boolean;
  NewWidth, NewHeight: Integer);
{ Same as setting Width/Height or ClientWidth/ClientHeight directly, but does
  not lose Align position. }
begin
  if IsClientWidthAndHeight then begin
    Inc (NewWidth, Width-ClientWidth);
    Inc (NewHeight, Height-ClientHeight);
  end;
  case Align of
    alTop, alLeft:
      SetBounds (Left, Top, NewWidth, NewHeight);
    alBottom:
      SetBounds (Left, Top-NewHeight+Height, NewWidth, NewHeight);
    alRight:
      SetBounds (Left-NewWidth+Width, Top, NewWidth, NewHeight);
  end;
end;

procedure TDock97.AlignControls (AControl: TControl; var Rect: TRect);
begin
  ArrangeToolbars;
end;

function CompareDockRowPos (const Item1, Item2, ExtraData: Pointer): Integer; far;
begin
  if TCustomToolWindow97(Item1).FDockRow <> TCustomToolWindow97(Item2).FDockRow then
    Result := TCustomToolWindow97(Item1).FDockRow - TCustomToolWindow97(Item2).FDockRow
  else
    Result := TCustomToolWindow97(Item1).FDockPos - TCustomToolWindow97(Item2).FDockPos;
end;

procedure TDock97.ArrangeToolbars;
{ The main procedure to arrange all the toolbars docked to it }
var
  LeftRight: Boolean;
  EmptySize: Integer;
  HighestRow, R, CurDockPos, CurRowPixel, I, J, K: Integer;
  HighestRowSize, CurRowSize: Integer;
begin
  if (DisableArrangeToolbars > 0) or (csLoading in ComponentState) then
    Exit;

  { Work around VCL alignment bug when docking toolbars taller or wider than
    the client height or width of the form. }
  if not(csDesigning in ComponentState) and HandleAllocated then
    SetWindowPos (Handle, HWND_TOP, 0, 0, 0, 0,
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);

  LeftRight := Position in PositionLeftOrRight;

  if DockList.Count = 0 then begin
    EmptySize := Ord(FFixAlign);
    if csDesigning in ComponentState then
      EmptySize := 9;
    if not LeftRight then
      ChangeWidthHeight (False, Width, EmptySize)
    else
      ChangeWidthHeight (False, EmptySize, Height);
    Exit;
  end;

  { Ensure list is in correct ordering according to DockRow/DockPos }
  ListSortEx (DockList, CompareDockRowPos, nil);

  { If LimitToOneRow is True, only use the first row }
  if FLimitToOneRow then
    for I := 0 to DockList.Count-1 do
      with TCustomToolWindow97(DockList[I]) do
        FDockRow := 0;
  { Remove any blank rows }
  RemoveBlankRows;

  { Find highest row number }
  HighestRow := GetHighestRow;
  { Arrange, first without actually moving the toolbars onscreen }
  R := 0;
  while R <= HighestRow do begin
    CurDockPos := 0;
    for I := 0 to DockList.Count-1 do begin
      with TCustomToolWindow97(DockList[I]) do begin
        if FDockRow <> R then Continue;
        if FullSize then
          { If FullSize, make sure there aren't any other toolbars on the same
            row. If there are, shift them down a row. }
          for J := 0 to DockList.Count-1 do
            if (J <> I) and (TCustomToolWindow97(DockList[J]).FDockRow = R) then begin
              for K := 0 to DockList.Count-1 do
                with TCustomToolWindow97(DockList[K]) do
                  if (K <> I) and (FDockRow >= R) then begin
                    Inc (FDockRow);
                    if FDockRow > HighestRow then
                      HighestRow := FDockRow;
                  end;
              Break;
            end;
        if FDockPos <= CurDockPos then
          FDockPos := CurDockPos
        else
          CurDockPos := FDockPos;
        if not LeftRight then
          Inc (CurDockPos, Width)
        else
          Inc (CurDockPos, Height);
      end;
    end;
    Inc (R);
  end;
  { Rebuild the RowInfo, since rows numbers may have shifted }
  BuildRowInfo;
  { Try to move all the toolbars that are offscreen to a fully visible position }
  for R := 0 to HighestRow do begin
    for I := 0 to DockList.Count-1 do begin
      with TCustomToolWindow97(DockList[I]) do begin
        if FDockRow <> R then Continue;
        if FullSize then
          FDockPos := 0
        else
          for J := DockList.Count-1 downto I do begin
            with TCustomToolWindow97(DockList[J]) do begin
              if FDockRow <> R then Continue;
              if not LeftRight then begin
                if FDockPos+Width > Self.ClientWidth then begin
                  Dec (TCustomToolWindow97(DockList[I]).FDockPos,
                    ((FDockPos+Width) - Self.ClientWidth));
                  Break;
                end;
              end
              else begin
                if FDockPos+Height > Self.ClientHeight then begin
                  Dec (TCustomToolWindow97(DockList[I]).FDockPos,
                    ((FDockPos+Height) - Self.ClientHeight));
                  Break;
                end;
              end;
            end;
          end;
      end;
    end;
  end;
  { Arrange again, this time actually moving the toolbars }
  CurRowPixel := 0;
  for R := 0 to HighestRow do begin
    CurDockPos := 0;
    HighestRowSize := DefaultBarWidthHeight;
    for I := 0 to DockList.Count-1 do begin
      with TCustomToolWindow97(DockList[I]) do begin
        if FDockRow <> R then Continue;
        CurRowSize := DockedBorderSize2 + GetRowSize(FDockRow, TCustomToolWindow97(DockList[I]));
        if CurRowSize > HighestRowSize then
          HighestRowSize := CurRowSize;
        if FDockPos <= CurDockPos then
          FDockPos := CurDockPos
        else
          CurDockPos := FDockPos;
        Inc (FUpdatingBounds);
        try
          if not LeftRight then begin
            J := Width;
            if FullSize then J := Self.ClientWidth;
            SetBounds (CurDockPos, CurRowPixel, J, CurRowSize)
          end
          else begin
            J := Height;
            if FullSize then J := Self.ClientHeight;
            SetBounds (CurRowPixel, CurDockPos, CurRowSize, J);
          end;
        finally
          Dec (FUpdatingBounds);
        end;
        if not LeftRight then
          Inc (CurDockPos, Width)
        else
          Inc (CurDockPos, Height);
      end;
    end;
    Inc (CurRowPixel, HighestRowSize);
  end;

  { Set the size of the dock }
  if not LeftRight then
    ChangeWidthHeight (True, ClientWidth, CurRowPixel)
  else
    ChangeWidthHeight (True, CurRowPixel, ClientHeight);
end;

procedure TDock97.ChangeDockList (const Insert: Boolean;
  const Bar: TCustomToolWindow97; const IsVisible: Boolean);
{ Inserts or removes Bar. It inserts only if IsVisible is True, or is in
  design mode }
var
  Modified: Boolean;
begin
  Modified := False;

  if Insert then begin
    { Delete if already exists }
    if DockList.IndexOf(Bar) <> -1 then
      DockList.Remove (Bar);
    { Only add to dock list if visible }
    if (csDesigning in ComponentState) or IsVisible then begin
      DockList.Add (Bar);
      Modified := True;
    end;
  end
  else begin
    if DockList.IndexOf(Bar) <> -1 then begin
      DockList.Remove (Bar);
      Modified := True;
    end;
  end;

  if Modified then begin
    ArrangeToolbars;
    { This corrects a problem in past versions when toolbar is shown after it
      was initially hidden }
    Bar.ArrangeControls;

    if Assigned(FOnInsertRemoveBar) then
      FOnInsertRemoveBar (Self, Insert, Bar);
  end;
end;

procedure TDock97.Loaded;
begin
  inherited;
  { Rearranging is disabled while the component is loading, so now that it's
    loaded, rearrange it. }
  ArrangeToolbars;
end;

function TDock97.GetPalette: HPALETTE;
begin
  Result := FBkg.Palette;
end;

procedure TDock97.DrawBackground (const DC: HDC;
  const IntersectClippingRect: TRect; const ExcludeClippingRect: PRect;
  const DrawRect: TRect);
var
  UseBmp: TBitmap;
  R2: TRect;
  SaveIndex: Integer;
begin
  UseBmp := FBkg;
  { When FBkgTransparent is True, it keeps a cached copy of the
    background that has the transparent color already translated. Without the
    cache, redraws can be very slow.
    Note: The cache is cleared in the OnChange event of FBkg }
  if FBkgTransparent then begin
    if FBkgCache = nil then begin
      FBkgCache := TBitmap.Create;
      with FBkgCache do begin
        Palette := CopyPalette(FBkg.Palette);
        Width := FBkg.Width;
        Height := FBkg.Height;
        Canvas.Brush.Color := Self.Color;
        Canvas.BrushCopy (Rect(0, 0, Width, Height), FBkg,
          Rect(0, 0, Width, Height), FBkg.Canvas.Pixels[0, Height-1] or $02000000);
      end;
    end;
    UseBmp := FBkgCache;
  end;

  SaveIndex := SaveDC(DC);
  try
    with IntersectClippingRect do
      IntersectClipRect (DC, Left, Top, Right, Bottom);
    if Assigned(ExcludeClippingRect) then
      with ExcludeClippingRect^ do
        ExcludeClipRect (DC, Left, Top, Right, Bottom);
    if UseBmp.Palette <> 0 then begin
      SelectPalette (DC, UseBmp.Palette, True);
      RealizePalette (DC);
    end;
    R2 := DrawRect;
    while R2.Left < R2.Right do begin
      while R2.Top < R2.Bottom do begin
        BitBlt (DC, R2.Left, R2.Top, UseBmp.Width, UseBmp.Height,
          UseBmp.Canvas.Handle, 0, 0, SRCCOPY);

        Inc (R2.Top, UseBmp.Height);
      end;
      R2.Top := DrawRect.Top;
      Inc (R2.Left, UseBmp.Width);
    end;
  finally
    { Restores the clipping region and palette back }
    RestoreDC (DC, SaveIndex);
  end;
end;

procedure TDock97.Paint;
var
  R, R2: TRect;
  P1, P2: TPoint;
begin
  inherited;
  with Canvas do begin
    R := ClientRect;

    { Draw dotted border in design mode }
    if csDesigning in ComponentState then begin
      Pen.Style := psDot;
      Pen.Color := clBtnShadow;
      Brush.Style := bsClear;
      Rectangle (R.Left, R.Top, R.Right, R.Bottom);
      Pen.Style := psSolid;
      InflateRect (R, -1, -1);
    end;

    { Draw the Background }
    if UsingBackground then begin
      R2 := ClientRect;
      { Make up for nonclient area }
      P1 := ClientToScreen(Point(0, 0));
      P2 := Parent.ClientToScreen(BoundsRect.TopLeft);
      Dec (R2.Left, Left + (P1.X-P2.X));
      Dec (R2.Top, Top + (P1.Y-P2.Y));
      DrawBackground (Canvas.Handle, R, nil, R2);
    end;
  end;
end;

procedure TDock97.WMMove (var Message: TWMMove);
begin
  inherited;
  if UsingBackground then
    InvalidateBackgrounds;
end;

procedure TDock97.WMSize (var Message: TWMSize);
begin
  inherited;
  ArrangeToolbars;
  if Assigned(FOnResize) then
    FOnResize (Self);
end;

procedure TDock97.WMNCCalcSize (var Message: TWMNCCalcSize);
begin
  inherited;
  with Message.CalcSize_Params^.rgrc[0] do begin
    { Don't add a border when width or height is zero (or one in case of
      FixAlign=True) }
    if ((Right-Left) <= 1) or ((Bottom-Top) <= 1) then
      Exit;
    if blTop in BoundLines then Inc (Top);
    if blBottom in BoundLines then Dec (Bottom);
    if blLeft in BoundLines then Inc (Left);
    if blRight in BoundLines then Dec (Right);
  end;
end;

procedure TDock97.WMNCPaint (var Message: TMessage);
var
  R, R2: TRect;
  DC: HDC;
  NewClipRgn: HRGN;
  HighlightPen, ShadowPen, SavePen: HPEN;
begin
  { This works around WM_NCPAINT problem described at top of source code }
  {no!  R := Rect(0, 0, Width, Height);}
  GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);

  { Don't draw border when width or height is zero (or one in case of
    FixAlign=True) }
  if ((R.Right-R.Left) <= 1) or ((R.Bottom-R.Top) <= 1) then
    Exit;

  DC := GetWindowDC(Handle);
  try
    { Use update region }
    if (Message.WParam <> 0) and (Message.WParam <> 1) then begin
      GetWindowRect (Handle, R2);
      if SelectClipRgn(DC, Message.WParam) = ERROR then begin
        NewClipRgn := CreateRectRgnIndirect(R2);
        SelectClipRgn (DC, NewClipRgn);
        DeleteObject (NewClipRgn);
      end;
      OffsetClipRgn (DC, -R2.Left, -R2.Top);
    end;

    { Draw BoundLines }
    HighlightPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT));
    ShadowPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW));
    if blTop in BoundLines then begin
      SavePen := SelectObject(DC, ShadowPen);
      MoveToEx (DC, R.Left, R.Top, nil);  LineTo (DC, R.Right, R.Top);
      SelectObject (DC, SavePen);
    end;
    if blLeft in BoundLines then begin
      SavePen := SelectObject(DC, ShadowPen);
      MoveToEx (DC, R.Left, R.Top, nil);  LineTo (DC, R.Left, R.Bottom);
      SelectObject (DC, SavePen);
    end;
    if blBottom in BoundLines then begin
      SavePen := SelectObject(DC, HighlightPen);
      MoveToEx (DC, R.Left, R.Bottom-1, nil);  LineTo (DC, R.Right, R.Bottom-1);
      SelectObject (DC, SavePen);
    end;
    if blRight in BoundLines then begin
      SavePen := SelectObject(DC, HighlightPen);
      MoveToEx (DC, R.Right-1, R.Top, nil);  LineTo (DC, R.Right-1, R.Bottom);
      SelectObject (DC, SavePen);
    end;
    DeleteObject (ShadowPen);
    DeleteObject (HighlightPen);
  finally
    ReleaseDC (Handle, DC);
  end;
end;

procedure TDock97.CMColorChanged (var Message: TMessage);
begin
  if UsingBackground then
    { Erase the cache }
    BackgroundChanged (FBkg);
  inherited;
end;

procedure TDock97.CMSysColorChange (var Message: TMessage);
begin
  inherited;
  if UsingBackground then
    { Erase the cache }
    BackgroundChanged (FBkg);
end;

{ TDock97 - property access methods }

procedure TDock97.SetAllowDrag (Value: Boolean);
var
  I: Integer;
begin
  if FAllowDrag <> Value then begin
    FAllowDrag := Value;
    for I := 0 to ControlCount-1 do
      if (Controls[I] is TCustomToolWindow97) and
         TCustomToolWindow97(Controls[I]).HandleAllocated then
        { Recalculate the non-client area }
        SetWindowPos (TCustomToolWindow97(Controls[I]).Handle, 0, 0, 0, 0, 0,
          SWP_FRAMECHANGED or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
  end;
end;

procedure TDock97.SetBackground (Value: TBitmap);
begin
  FBkg.Assign (Value);
end;

function TDock97.UsingBackground: Boolean;
begin
  Result := (FBkg.Width <> 0) and (FBkg.Height <> 0);
end;

procedure TDock97.InvalidateBackgrounds;
{ Called after background is changed }
var
  I: Integer;
begin
  Invalidate;
  { Synchronize child toolbars also }
  for I := 0 to DockList.Count-1 do
    with TCustomToolWindow97(DockList[I]) do begin
      InvalidateDockedNCArea;
      Invalidate;
    end;
end;

procedure TDock97.BackgroundChanged (Sender: TObject);
begin
  { Erase the cache }
  FBkgCache.Free;
  FBkgCache := nil;
  InvalidateBackgrounds;
end;

procedure TDock97.SetBackgroundOnToolbars (Value: Boolean);
begin
  if FBkgOnToolbars <> Value then begin
    FBkgOnToolbars := Value;
    InvalidateBackgrounds;
  end;
end;

procedure TDock97.SetBackgroundTransparent (Value: Boolean);
begin
  if FBkgTransparent <> Value then begin
    FBkgTransparent := Value;
    if UsingBackground then
      { Erase the cache }
      BackgroundChanged (FBkg);
  end;
end;

procedure TDock97.SetBoundLines (Value: TDockBoundLines);
begin
  if FBoundLines <> Value then begin
    FBoundLines := Value;

    { Recalculate the non-client area }
    SetWindowPos (Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
  end;
end;

procedure TDock97.SetFixAlign (Value: Boolean);
begin
  if FFixAlign <> Value then begin
    FFixAlign := Value;
    ArrangeToolbars;
  end;
end;

procedure TDock97.SetPosition (Value: TDockPosition);
begin
  if ControlCount <> 0 then
    raise EInvalidOperation.Create(STB97DockCannotChangePosition);
  FPosition := Value;
  case Position of
    dpTop: Align := alTop;
    dpBottom: Align := alBottom;
    dpLeft: Align := alLeft;
    dpRight: Align := alRight;
  end;
end;

function TDock97.GetToolbarCount: Integer;
begin
  Result := DockList.Count;
end;

function TDock97.GetToolbars (Index: Integer): TCustomToolWindow97;
begin
  Result := TCustomToolWindow97(DockList[Index]);
end;


{ TFloatParent - Internal }

procedure TFloatParent.CreateParams (var Params: TCreateParams);
begin
  inherited;
  with Params do begin
    Style := WS_CHILD;
    ExStyle := 0;
  end;
end;


{ Global procedures }

procedure CustomLoadToolbarPositions (const Form: TForm;
  const ReadIntProc: TPositionReadIntProc;
  const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);

  function FindDock (AName: String): TDock97;
  var
    I: Integer;
  begin
    Result := nil;
    for I := 0 to Form.ComponentCount-1 do
      if (Form.Components[I] is TDock97) and (Form.Components[I].Name = AName) then begin
        Result := TDock97(Form.Components[I]);
        Break;
      end;
  end;
  procedure ReadValues (const Toolbar: TCustomToolWindow97; const NewDock: TDock97);
  begin
    with Toolbar do begin
      FDockRow := ReadIntProc(Name, rvDockRow, FDockRow, ExtraData);
      FDockPos := ReadIntProc(Name, rvDockPos, FDockPos, ExtraData);
      FFloatingTopLeft.X := ReadIntProc(Name, rvFloatLeft, 0, ExtraData);
      FFloatingTopLeft.Y := ReadIntProc(Name, rvFloatTop, 0, ExtraData);
      ReadPositionData (ReadIntProc, ReadStringProc, ExtraData);
      DockedTo := NewDock;
      DoneReadingPositionData;
    end;
  end;
var
  DocksDisabled: TList;
  I: Integer;
  ADock: TDock97;
  DockedToName: String;
begin
  DocksDisabled := TList.Create;
  try
    with Form do
      for I := 0 to ComponentCount-1 do
        if Components[I] is TDock97 then begin
          Inc (TDock97(Components[I]).DisableArrangeToolbars);
          DocksDisabled.Add (Components[I]);
        end;

    for I := 0 to Form.ComponentCount-1 do
      if Form.Components[I] is TCustomToolWindow97 then
        with TCustomToolWindow97(Form.Components[I]) do begin
          if Name = '' then
            raise Exception.Create (STB97ToolWinNameNotSet);
          if ReadIntProc(Name, rvRev, 0, ExtraData) = rdCurrentRev then begin
            Visible := ReadIntProc(Name, rvVisible, Ord(Visible), ExtraData) <> 0;
            DockedToName := ReadStringProc(Name, rvDockedTo, '', ExtraData);
            if DockedToName <> '' then begin
              if DockedToName <> rdDockedToFloating then begin
                ADock := FindDock(DockedToName);
                if (ADock <> nil) and (ADock.FAllowDrag) then
                  ReadValues (TCustomToolWindow97(Form.Components[I]), ADock);
              end
              else begin
                ReadValues (TCustomToolWindow97(Form.Components[I]), nil);
                MoveOnScreen (True);
              end;
            end;
          end;
        end;
  finally
    for I := DocksDisabled.Count-1 downto 0 do begin
      Dec (TDock97(DocksDisabled[I]).DisableArrangeToolbars);
      TDock97(DocksDisabled[I]).ArrangeToolbars;
    end;
    DocksDisabled.Free;
  end;
end;

procedure CustomSaveToolbarPositions (const Form: TForm;
  const WriteIntProc: TPositionWriteIntProc;
  const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer);
var
  I: Integer;
  N: String;
begin
  for I := 0 to Form.ComponentCount-1 do
    if Form.Components[I] is TCustomToolWindow97 then
      with TCustomToolWindow97(Form.Components[I]) do begin
        if Name = '' then
          raise Exception.Create (STB97ToolwinNameNotSet);
        if not Docked then
          N := rdDockedToFloating
        else begin
          if DockedTo.FAllowDrag then begin
            N := DockedTo.Name;
            if N = '' then
              raise Exception.Create (STB97ToolwinDockedToNameNotSet);
          end
          else
            N := '';
        end;
        WriteIntProc (Name, rvRev, rdCurrentRev, ExtraData);
        WriteIntProc (Name, rvVisible, Ord(Visible), ExtraData);
        with TCustomToolWindow97(Form.Components[I]) do begin
          WriteStringProc (Name, rvDockedTo, N, ExtraData);
          WriteIntProc (Name, rvDockRow, FDockRow, ExtraData);
          WriteIntProc (Name, rvDockPos, FDockPos, ExtraData);
          WriteIntProc (Name, rvFloatLeft, FFloatingTopLeft.X, ExtraData);
          WriteIntProc (Name, rvFloatTop, FFloatingTopLeft.Y, ExtraData);
          WritePositionData (WriteIntProc, WriteStringProc, ExtraData);
        end;
      end;
end;

function IniReadInt (const ToolbarName, Value: String; const Default: Longint;
  const ExtraData: Pointer): Longint; far;
begin
  Result := TIniFile(ExtraData).ReadInteger(ToolbarName, Value, Default);
end;
function IniReadString (const ToolbarName, Value, Default: String;
  const ExtraData: Pointer): String; far;
begin
  Result := TIniFile(ExtraData).ReadString(ToolbarName, Value, Default);
end;
procedure IniWriteInt (const ToolbarName, Value: String; const Data: Longint;
  const ExtraData: Pointer); far;
begin
  TIniFile(ExtraData).WriteInteger (ToolbarName, Value, Data);
end;
procedure IniWriteString (const ToolbarName, Value, Data: String;
  const ExtraData: Pointer); far;
begin
  TIniFile(ExtraData).WriteString (ToolbarName, Value, Data);
end;

procedure IniLoadToolbarPositions (const Form: TForm; const Filename: String);
var
  Ini: TIniFile;
begin
  Ini := TIniFile.Create(Filename);
  try
    CustomLoadToolbarPositions (Form, IniReadInt, IniReadString, Ini);
  finally
    Ini.Free;
  end;
end;

procedure IniSaveToolbarPositions (const Form: TForm; const Filename: String);
var
  Ini: TIniFile;
begin
  Ini := TIniFile.Create(Filename);
  try
    CustomSaveToolbarPositions (Form, IniWriteInt, IniWriteString, Ini);
  finally
    Ini.Free;
  end;
end;

function RegReadInt (const ToolbarName, Value: String; const Default: Longint;
  const ExtraData: Pointer): Longint; far;
begin
  Result := TRegIniFile(ExtraData).ReadInteger(ToolbarName, Value, Default);
end;
function RegReadString (const ToolbarName, Value, Default: String;
  const ExtraData: Pointer): String; far;
begin
  Result := TRegIniFile(ExtraData).ReadString(ToolbarName, Value, Default);
end;
procedure RegWriteInt (const ToolbarName, Value: String; const Data: Longint;
  const ExtraData: Pointer); far;
begin
  TRegIniFile(ExtraData).WriteInteger (ToolbarName, Value, Data);
end;
procedure RegWriteString (const ToolbarName, Value, Data: String;
  const ExtraData: Pointer); far;
begin
  TRegIniFile(ExtraData).WriteString (ToolbarName, Value, Data);
end;

procedure RegLoadToolbarPositions (const Form: TForm; const BaseRegistryKey: String);
var
  Reg: TRegIniFile;
begin
  Reg := TRegIniFile.Create(BaseRegistryKey);
  try
    CustomLoadToolbarPositions (Form, RegReadInt, RegReadString, Reg);
  finally
    Reg.Free;
  end;
end;

procedure RegSaveToolbarPositions (const Form: TForm; const BaseRegistryKey: String);
var
  Reg: TRegIniFile;
begin
  Reg := TRegIniFile.Create(BaseRegistryKey);
  try
    CustomSaveToolbarPositions (Form, RegWriteInt, RegWriteString, Reg);
  finally
    Reg.Free;
  end;
end;


{ TCustomToolWindow97 - Internal }

constructor TCustomToolWindow97.Create (AOwner: TComponent);
begin
  inherited;

  GetParams (FParams);

  if not(AOwner is TForm) then
    raise EInvalidOperation.Create(STB97ToolwinNotFormOwner);
    { because it frequently casts Owner into a TForm }
  MDIParentForm := GetMDIParent(TForm(AOwner));

  Inc (FDisableArrangeControls);
  try
    ControlStyle := ControlStyle +
      [csAcceptsControls, csClickEvents, csDoubleClicks, csSetCaption] -
      [csCaptureMouse{capturing is done manually}, csOpaque];

    if not(csDesigning in ComponentState) then begin
      FloatParent := TFloatParent.Create(TForm(AOwner));
      FloatParent.Parent := MDIParentForm;
      { Set up the hooks for the parent form of the toolbar, and a main
        window hook }
      InstallHooks (hkParentForm, MDIParentForm, True);
      { Add a another hook if it's owner is an MDI child }
      if TForm(AOwner).FormStyle = fsMDIChild then
        InstallHooks (hkChildForm, TForm(AOwner), False);
      { Need to move it offscreen while loading to prevent any flashing as it's
        updating }
      SetNotOnScreen (True);
    end
    else
      FloatParent := TForm(AOwner);

    FInactiveCaption := not Application.Active;
    FActivateParent := True;
    FDockableTo := [dpTop, dpBottom, dpLeft, dpRight];
    FCloseButton := True;
    FDragHandle := True;
    FResizable := True;
    FHideWhenInactive := True;
    FDockPos := -1;
    Color := clBtnFace;
    DockedTo := nil;

    if not(csDesigning in ComponentState) then begin
      { Since SetNotOnScreen(True) was called, it needs to restore the toolbars
        back by posting a message which will be processed once it's done
        loading. }
      if DoneCreatingList.IndexOf(Self) = -1 then  { can't have duplicates }
        DoneCreatingList.Add (Self);
      PostMessage (Application.Handle, WM_TB97DoneCreating,
        WM_TB97DoneCreating_Magic, WM_TB97DoneCreating_Magic);
    end;
  finally
    Dec (FDisableArrangeControls);
  end;
end;

destructor TCustomToolWindow97.Destroy;
begin
  if not(csDesigning in ComponentState) then begin
    DoneCreatingList.Remove (Self);   { just in case }
    UninstallHooks (hkParentForm, MDIParentForm);
    if TForm(Owner).FormStyle = fsMDIChild then
      UninstallHooks (hkChildForm, TForm(Owner));
  end;

  inherited;
end;

procedure TCustomToolWindow97.SetNotOnScreen (const Value: Boolean);
begin
  if NotOnScreen <> Value then begin
    NotOnScreen := Value;
    { Update the actual visibility of the toolbar by sending a
      CM_SHOWINGCHANGED message. CM_SHOWINGCHANGED cannot be sent if the
      handle has not been allocated yet, so check HandleAllocated first }
    if HandleAllocated then
      Perform (CM_SHOWINGCHANGED, 0, 0);
  end;
end;

procedure TCustomToolWindow97.SetInactiveCaption (const Value: Boolean);
begin
  if FInactiveCaption <> Value then begin
    FInactiveCaption := Value;
    DrawFloatingNCArea (0, False, True, False);
  end;
end;

procedure TCustomToolWindow97.WMMove (var Message: TWMMove);
begin
  inherited;
  if Docked and DockedTo.UsingBackground then begin
    { Needs to redraw so that background is lined up with the dock at the
      new position }
    InvalidateDockedNCArea;
    { To minimize flicker, InvalidateRect is called with the Erase parameter
      set to False instead of calling the Invalidate method }
    if HandleAllocated then
      InvalidateRect (Handle, nil, False);
  end;
end;

procedure TCustomToolWindow97.WMSize (var Message: TWMSize);
begin
  inherited;
  if Assigned(FOnResize) then
    FOnResize (Self);
end;

procedure TCustomToolWindow97.WMGetMinMaxInfo (var Message: TWMGetMinMaxInfo);
begin
  inherited;
  { Because the window uses the WS_THICKFRAME style (but not for the usual
    purpose), it must process the WM_GETMINMAXINFO message to remove the
    minimum and maximum size limits it imposes by default. }
  with Message.MinMaxInfo^ do begin
    with ptMinTrackSize do begin
      X := 1;
      Y := 1;
      { Note to self: Don't put GetMinimumSize code here, since
        ClientWidth/Height values are sometimes invalid during a RecreateWnd }
    end;
    with ptMaxTrackSize do begin
      { Because of the 16-bit (signed) size limitations of Windows 95,
        Smallints must be used instead of Integers or Longints }
      X := High(Smallint);
      Y := High(Smallint);
    end;
  end;
end;

procedure TCustomToolWindow97.CMShowingChanged (var Message: TMessage);
const
  ShowFlags: array[Boolean] of UINT = (
    SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW,
    SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW);
begin
  { inherited isn't called since TCustomToolWindow97 handles CM_SHOWINGCHANGED
    itself. For reference, the original TWinControl implementation is:
    const
      ShowFlags: array[Boolean] of Word = (
        SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_HIDEWINDOW,
        SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_SHOWWINDOW);
    begin
      SetWindowPos(FHandle, 0, 0, 0, 0, 0, ShowFlags[FShowing]);
    end;
  }
  SetWindowPos (Handle, 0, 0, 0, 0, 0, ShowFlags[Showing and not NotOnScreen]);
end;

procedure TCustomToolWindow97.CreateParams (var Params: TCreateParams);
begin
  inherited;
  if Parent = FloatParent then
    with Params do begin
      { Note: WS_THICKFRAME and WS_BORDER styles are included to ensure that
        sizing grips are displayed on child controls with scrollbars. The
        thick frame or border is not drawn by Windows; TCustomToolWindow97
        handles all border drawing by itself. }
      if not(csDesigning in ComponentState) then
        Style := WS_POPUP or WS_THICKFRAME or WS_BORDER
      else
        Style := Style or WS_THICKFRAME or WS_BORDER;
      ExStyle := 0;
    end;
end;

procedure TCustomToolWindow97.Notification (AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FDefaultDock) then
    FDefaultDock := nil;
end;

procedure TCustomToolWindow97.MoveOnScreen (const OnlyIfFullyOffscreen: Boolean);
{ Moves the (floating) toolbar so that it is fully (or at least mostly) in
  view on the screen }
var
  R, S, Test: TRect;
begin
  if not Docked then begin
    R := BoundsRect;
    S := GetDesktopArea;

    if OnlyIfFullyOffscreen and IntersectRect(Test, R, S) then
      Exit;

    if R.Right > S.Right then
      OffsetRect (R, S.Right - R.Right, 0);
    if R.Bottom > S.Bottom then
      OffsetRect (R, 0, S.Bottom - R.Bottom);
    if R.Left < S.Left then
      OffsetRect (R, S.Left - R.Left, 0);
    if R.Top < S.Top then
      OffsetRect (R, 0, S.Top - R.Top);
    BoundsRect := R;
  end;
end;

procedure TCustomToolWindow97.ReadPositionData (const ReadIntProc: TPositionReadIntProc;
  const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
begin
end;

procedure TCustomToolWindow97.DoneReadingPositionData;
begin
end;

procedure TCustomToolWindow97.WritePositionData (const WriteIntProc: TPositionWriteIntProc;
  const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer);
begin
end;

procedure TCustomToolWindow97.InitializeOrdering;
begin
end;

procedure TCustomToolWindow97.GetDockRowSize (var AHeightOrWidth: Integer);
begin
  GetBarSize (AHeightOrWidth, GetDockTypeOf(DockedTo));
  if Docked then
    with DockedTo do begin
      BuildRowInfo;
      AHeightOrWidth := DockedTo.GetRowSize(FDockRow, Self);
    end;
end;

procedure TCustomToolWindow97.SizeChanging (const AWidth, AHeight: Integer);
begin
end;

procedure TCustomToolWindow97.Loaded;
var
  R: TRect;
begin
  inherited;
  { Adjust coordinates if it was initially floating }
  if not(csDesigning in ComponentState) and not Docked then begin
    R := BoundsRect;
    MapWindowPoints (TForm(Owner).Handle, 0, R, 2);
    BoundsRect := R;
    MoveOnScreen (False);
  end;
  InitializeOrdering;
  { Arranging of controls is disabled while component was loading, so rearrange
    it now }
  ArrangeControls;
end;

procedure TCustomToolWindow97.BeginUpdate;
begin
  Inc (FDisableArrangeControls);
end;

procedure TCustomToolWindow97.EndUpdate;
begin
  Dec (FDisableArrangeControls);
  if FArrangeNeeded and (FDisableArrangeControls = 0) then
    ArrangeControls;
end;

procedure TCustomToolWindow97.CustomArrangeControls (const ArrangeType: TToolWindowArrangeType;
  const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint);
var
  WH: Integer;
begin
  if (FDisableArrangeControls > 0) or
     { Prevent flicker while loading or destroying }
     (csLoading in ComponentState) or
     { Following line added in 1.53 to stop the access violations that 1.52 was
       causing while destroying. }
     (csDestroying in ComponentState) or
     (Parent = nil) or
     (Parent.HandleAllocated and (csDestroying in Parent.ComponentState)) then begin
    FArrangeNeeded := True;
    Exit;
  end;

  FArrangeNeeded := False;
  NewClientSize.X := 0;
  NewClientSize.Y := 0;

  Inc (FDisableArrangeControls);
  try
    OrderControls (ArrangeType <> atNone, WasDockedTo, DockingTo, NewClientSize);

    if ArrangeType = atMoveControlsAndResize then
      with NewClientSize do begin
        if Docked then begin
          GetDockRowSize (WH);
          if not(DockedTo.Position in PositionLeftOrRight) then begin
            if WH > Y then Y := WH;
            if FullSize then
              X := DockedTo.ClientWidth - (Width-ClientWidth);
          end
          else begin
            if WH > X then X := WH;
            if FullSize then
              Y := DockedTo.ClientHeight - (Height-ClientHeight);
          end;
        end;
        if (ClientWidth <> X) or (ClientHeight <> Y) then begin
          Inc (FUpdatingBounds);
          try
            SetBounds (Left, Top, (Width-ClientWidth) + X, (Height-ClientHeight) + Y);
          finally
            Dec (FUpdatingBounds);
          end;
        end;
      end;
  finally
    Dec (FDisableArrangeControls);
  end;
end;

procedure TCustomToolWindow97.ArrangeControls;
var
  TempSize: TPoint;
begin
  CustomArrangeControls (atMoveControlsAndResize, DockedTo, DockedTo, TempSize);
end;

procedure TCustomToolWindow97.AlignControls (AControl: TControl; var Rect: TRect);
{ VCL calls this whenever any child controls in the toolbar are moved, sized,
  inserted, etc. It doesn't need to make use of the AControl and Rect
  parameters. }
begin
  if Params.CallAlignControls then
    inherited;
  ArrangeControls;
end;

procedure TCustomToolWindow97.SetBounds (ALeft, ATop, AWidth, AHeight: Integer);
begin
  if (FUpdatingBounds = 0) and ((AWidth <> Width) or (AHeight <> Height)) then
    SizeChanging (AWidth, AHeight);
  { This allows you to drag the toolbar around the dock at design time }
  if (csDesigning in ComponentState) and not(csLoading in ComponentState) and
     Docked and (FUpdatingBounds = 0) and ((ALeft <> Left) or (ATop <> Top)) then begin
    if not(DockedTo.Position in PositionLeftOrRight) then begin
      FDockRow := DockedTo.GetDesignModeRowOf(ATop+(Height div 2));
      FDockPos := ALeft;
    end
    else begin
      FDockRow := DockedTo.GetDesignModeRowOf(ALeft+(Width div 2));
      FDockPos := ATop;
    end;
    inherited SetBounds (Left, Top, AWidth, AHeight);  { only pass any size changes }
    DockedTo.ArrangeToolbars;  { let ArrangeToolbars take care of position changes }
  end
  else begin
    inherited;
    if not(csLoading in ComponentState) and not Docked and (FUpdatingBounds = 0) then
      FFloatingTopLeft := BoundsRect.TopLeft;
  end;
end;

procedure TCustomToolWindow97.SetParent (AParent: TWinControl);
begin
  if not(csDesigning in ComponentState) and (AParent = TForm(Owner)) then
    AParent := FloatParent;

  if (AParent <> nil) and not(AParent is TDock97) and
     not(AParent = Owner) and not(AParent is TFloatParent) then
    raise EInvalidOperation.Create(STB97ToolwinParentNotAllowed);

  if not(csDestroying in ComponentState) and Assigned(FOnRecreating) then
    FOnRecreating (Self);

  if Parent is TDock97 then
    TDock97(Parent).ChangeDockList (False, Self, Visible or (FHidden <> 0));

  { Ensure that the handle is destroyed now so that any messages in the queue
    get flushed. This is neccessary since existing messages may reference
    FDockedTo or FDocked, which is changed below. }
  inherited SetParent (nil);
  { ^ Note to self: SetParent is used instead of DestroyHandle because it does
    additional processing }
  if not(AParent is TDock97) then
    FDockedTo := nil
  else
    FDockedTo := TDock97(AParent);
  FDocked := FDockedTo <> nil;
  try
    inherited;
  except
    { Failure is rare, but just in case, restore FDockedTo and FDocked back. }
    if not(Parent is TDock97) then
      FDockedTo := nil
    else
      FDockedTo := TDock97(Parent);
    FDocked := FDockedTo <> nil;
    raise;
  end;

  if Parent is TDock97 then
    TDock97(Parent).ChangeDockList (True, Self, Visible or (FHidden <> 0));

  if not(csDestroying in ComponentState) and Assigned(FOnRecreated) then
    FOnRecreated (Self);
end;

function GetCaptionRect (const Control: TCustomToolWindow97;
  const AdjustForBorder, MinusCloseButton: Boolean): TRect;
begin
  Result := Rect(0, 0, Control.ClientWidth, GetSmallCaptionHeight-1);
  if MinusCloseButton then
    Dec (Result.Right, GetSmallCaptionHeight-1);
  if AdjustForBorder then
    with GetBorderSize(Control.Resizable) do
      OffsetRect (Result, X, Y);
end;

function GetCloseButtonRect (const Control: TCustomToolWindow97;
  const AdjustForBorder: Boolean): TRect;
begin
  Result := Rect(0, 0, Control.ClientWidth, GetSmallCaptionHeight-1);
  if AdjustForBorder then
    with GetBorderSize(Control.Resizable) do
      OffsetRect (Result, X, Y);
  Result.Left := Result.Right - (GetSmallCaptionHeight-1);
end;

procedure TCustomToolWindow97.WMNCCalcSize (var Message: TWMNCCalcSize);
begin
  { Doesn't call inherited since it overrides the normal NC sizes }
  Message.Result := 0;
  with Message.CalcSize_Params^ do begin
    if not Docked then begin
      with GetBorderSize(Resizable) do
        InflateRect (rgrc[0], -X, -Y);
      Inc (rgrc[0].Top, GetSmallCaptionHeight);
    end
    else begin
      InflateRect (rgrc[0], -DockedBorderSize, -DockedBorderSize);
      if DockedTo.FAllowDrag and FDragHandle then begin
        if not(DockedTo.Position in PositionLeftOrRight) then
          Inc (rgrc[0].Left, DragHandleSize)
        else
          Inc (rgrc[0].Top, DragHandleSize);
      end;
    end;
  end;
end;

procedure TCustomToolWindow97.DrawFloatingNCArea (const Clip: HRGN;
  const RedrawBorder, RedrawCaption, RedrawCloseButton: Boolean);
{ Redraws all the non-client area (the border, title bar, and close button) of
  the toolbar when it is floating. }
const
  CaptionBkColors: array[Boolean] of Integer =
    (COLOR_ACTIVECAPTION, COLOR_INACTIVECAPTION);
  CaptionTextColors: array[Boolean] of Integer =
    (COLOR_CAPTIONTEXT, COLOR_INACTIVECAPTIONTEXT);

  procedure Win3DrawCaption (const DC: HDC; const R: TRect);
  { Emulates DrawCaption, which isn't supported in Win 3.x }
  const
    Ellipsis = '...';
  var
    R2: TRect;
    SaveTextColor, SaveBkColor: TColorRef;
    SaveFont: HFONT;
    Cap: String;

    function CaptionTextWidth: Integer;
    var
      Size: TSize;
    begin
      GetTextExtentPoint32 (DC, PChar(Cap), Length(Cap), Size);
      Result := Size.cx;
    end;
  begin
    R2 := R;

    { Fill the rectangle }
    FillRect (DC, R2, GetSysColorBrush(CaptionBkColors[FInactiveCaption]));

    Inc (R2.Left);
    Dec (R2.Right);

    SaveFont := SelectObject(DC, CreateFont(-11, 0, 0, 0, FW_NORMAL, 0, 0, 0, 0, 0, 0, 0, 0, 'MS Sans Serif'));

    { Add ellipsis to caption if necessary }
    Cap := Caption;
    if CaptionTextWidth > R2.Right-R2.Left then begin
      Cap := Cap + Ellipsis;
      while (CaptionTextWidth > R2.Right-R2.Left) and (Length(Cap) > 4) do
        Delete (Cap, Length(Cap)-Length(Ellipsis), 1)
    end;

    { Draw the text }
    SaveBkColor := SetBkColor(DC, GetSysColor(CaptionBkColors[FInactiveCaption]));
    SaveTextColor := SetTextColor(DC, GetSysColor(CaptionTextColors[FInactiveCaption]));
    DrawText (DC, PChar(Cap), Length(Cap), R2, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER);
    SetTextColor (DC, SaveTextColor);
    SetBkColor (DC, SaveBkColor);

    DeleteObject (SelectObject(DC, SaveFont));
  end;
const
  CloseButtonState: array[Boolean] of UINT = (0, DFCS_PUSHED);
  ActiveCaptionFlags: array[Boolean] of UINT = (DC_ACTIVE, 0);
var
  DC: HDC;
  R: TRect;
  NewClipRgn: HRGN;
  NewDrawCaption: function(p1: HWND; p2: HDC; const p3: TRect; p4: UINT): BOOL; stdcall;
  SavePen: HPEN;
  SaveIndex: Integer;
  I: Integer;
begin
  if Docked then Exit;

  DC := GetWindowDC(Handle);
  try
    { Use update region }
    if (Clip <> 0) and (Clip <> 1) then begin
      GetWindowRect (Handle, R);
      if SelectClipRgn(DC, Clip) = ERROR then begin
        NewClipRgn := CreateRectRgnIndirect(R);
        SelectClipRgn (DC, NewClipRgn);
        DeleteObject (NewClipRgn);
      end;
      OffsetClipRgn (DC, -R.Left, -R.Top);
    end;

    { Border }
    if RedrawBorder then begin
      { This works around WM_NCPAINT problem described at top of source code }
      {no!  R := Rect(0, 0, Width, Height);}
      GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
      for I := 1 to GetBorderSize(Resizable).X do
        case I of
          1: DrawEdge (DC, R, EDGE_RAISED, BF_RECT or BF_ADJUST);
          2: ;
        else
          FrameRect (DC, R, GetSysColorBrush(COLOR_BTNFACE));
          InflateRect (R, -1, -1);
        end;
    end;

    if RedrawCaption and FCloseButton and RedrawCloseButton then
      SaveIndex := SaveDC(DC)
    else
      SaveIndex := 0;
    try
      if SaveIndex <> 0 then
        with GetCloseButtonRect(Self, True) do
          { Reduces flicker }
          ExcludeClipRect (DC, Left, Top, Right, Bottom);

      { Caption }
      if RedrawCaption then begin
        R := GetCaptionRect(Self, True, FCloseButton);
        if NewStyleControls then begin
          { Use a dynamic import of DrawCaption since it's Win95/NT 4.0 only.
            Also note that Delphi's Win32 help for DrawCaption is totally wrong!
            I got updated info from www.microsoft.com/msdn/sdk/ }
          NewDrawCaption := GetProcAddress(GetModuleHandle(user32), 'DrawCaption');
          NewDrawCaption (Handle, DC, R, DC_TEXT or DC_SMALLCAP or
            ActiveCaptionFlags[FInactiveCaption]);
        end
        else
          Win3DrawCaption (DC, R);

        { Line below caption }
        R := GetCaptionRect(Self, True, False);
        SavePen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNFACE)));
        MoveToEx (DC, R.Left, R.Bottom, nil);
        LineTo (DC, R.Right, R.Bottom);
        DeleteObject (SelectObject(DC, SavePen));
      end;
    finally
      if SaveIndex <> 0 then
        RestoreDC (DC, SaveIndex);
    end;

    { Close button }
    if FCloseButton then begin
      if RedrawCloseButton then begin
        R := GetCloseButtonRect(Self, True);
        InflateRect (R, -1, -1);
        DrawFrameControl (DC, R, DFC_CAPTION, DFCS_CAPTIONCLOSE or
          CloseButtonState[CloseButtonDown]);
      end;
      if RedrawCaption then begin
        { Caption-colored frame around close button }
        R := GetCloseButtonRect(Self, True);
        FrameRect (DC, R, GetSysColorBrush(CaptionBkColors[FInactiveCaption]));
      end;
    end;
  finally
    ReleaseDC (Handle, DC);
  end;
end;

procedure TCustomToolWindow97.ValidateDockedNCArea;
var
  Msg: TMsg;
begin
  if HandleAllocated then
    while PeekMessage(Msg, Handle, WM_TB97PaintDockedNCArea,
      WM_TB97PaintDockedNCArea, PM_REMOVE or PM_NOYIELD) do ;
end;

procedure TCustomToolWindow97.InvalidateDockedNCArea;
begin
  ValidateDockedNCArea;
  if HandleAllocated then
    PostMessage (Handle, WM_TB97PaintDockedNCArea, 0, 0);
end;

procedure TCustomToolWindow97.WMTB97PaintDockedNCArea (var Message: TMessage);
begin
  DrawDockedNCArea (0);
end;

procedure TCustomToolWindow97.DrawDockedNCArea (const Clip: HRGN);
{ Redraws all the non-client area of the toolbar when it is docked. }
var
  DC: HDC;
  R: TRect;
  NewClipRgn: HRGN;
  DockType: TDockType;
  X, Y: Integer;
  R2, R3, R4: TRect;
  P1, P2: TPoint;
  Brush: HBRUSH;
  Clr: TColorRef;
  UsingBackground: Boolean;
  procedure DrawRaisedEdge (R: TRect; const FillInterior: Boolean);
  const
    FillMiddle: array[Boolean] of UINT = (0, BF_MIDDLE);
  begin
    DrawEdge (DC, R, BDR_RAISEDINNER, BF_RECT or FillMiddle[FillInterior]);
  end;
begin
  ValidateDockedNCArea;
  if not Docked then Exit;

  DC := GetWindowDC(Handle);
  try
    { Use update region }
    if (Clip <> 0) and (Clip <> 1) then begin
      GetWindowRect (Handle, R);
      if SelectClipRgn(DC, Clip) = ERROR then begin
        NewClipRgn := CreateRectRgnIndirect(R);
        SelectClipRgn (DC, NewClipRgn);
        DeleteObject (NewClipRgn);
      end;
      OffsetClipRgn (DC, -R.Left, -R.Top);
    end;

    { This works around WM_NCPAINT problem described at top of source code }
    {no!  R := Rect(0, 0, Width, Height);}
    GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);

    if not(DockedTo.Position in PositionLeftOrRight) then
      DockType := dtTopBottom
    else
      DockType := dtLeftRight;

    Brush := CreateSolidBrush(ColorToRGB(Color));

    { Border }
    DrawRaisedEdge (R, False);
    R2 := R;
    InflateRect (R2, -1, -1);
    FrameRect (DC, R2, Brush);

    UsingBackground := DockedTo.UsingBackground and DockedTo.FBkgOnToolbars;

    { Draw the Background }
    if UsingBackground then begin
      R2 := R;
      P1 := DockedTo.ClientToScreen(Point(0, 0));
      P2 := DockedTo.Parent.ClientToScreen(DockedTo.BoundsRect.TopLeft);
      Dec (R2.Left, Left + DockedTo.Left + (P1.X-P2.X));
      Dec (R2.Top, Top + DockedTo.Top + (P1.Y-P2.Y));
      InflateRect (R, -1, -1);
      GetWindowRect (Handle, R4);
      R3 := ClientRect;
      with ClientToScreen(Point(0, 0)) do
        OffsetRect (R3, X-R4.Left, Y-R4.Top);
      DockedTo.DrawBackground (DC, R, @R3, R2);
    end;

    { The drag handle at the left, or top }
    if DockedTo.FAllowDrag and FDragHandle then begin
      Clr := GetSysColor(COLOR_BTNHIGHLIGHT);
      if DockType <> dtLeftRight then begin
        Y := ClientHeight+2;
        if not UsingBackground then begin
          FillRect (DC, Rect(2, 2, 4, Y), Brush);
          FillRect (DC, Rect(10, 2, 11, Y), Brush);
        end;
        DrawRaisedEdge (Rect(4, 2, 7, Y), True);
        SetPixelV (DC, 4, Y-1, Clr);
        DrawRaisedEdge (Rect(7, 2, 10, Y), True);
        SetPixelV (DC, 7, Y-1, Clr);
      end
      else begin
        X := ClientWidth+2;
        if not UsingBackground then begin
          FillRect (DC, Rect(2, 2, X, 4), Brush);
          FillRect (DC, Rect(2, 10, X, 11), Brush);
        end;
        DrawRaisedEdge (Rect(2, 4, X, 7), True);
        SetPixelV (DC, X-1, 4, Clr);
        DrawRaisedEdge (Rect(2, 7, X, 10), True);
        SetPixelV (DC, X-1, 7, Clr);
      end;
    end;

    DeleteObject (Brush);
  finally
    ReleaseDC (Handle, DC);
  end;
end;

procedure TCustomToolWindow97.WMNCPaint (var Message: TMessage);
begin
  { Don't call inherited because it overrides the default NC painting }
  if Docked then
    DrawDockedNCArea (Message.WParam)
  else
    DrawFloatingNCArea (Message.WParam, True, True, True);
end;

procedure TCustomToolWindow97.Paint;
var
  R, R2, R3: TRect;
  P1, P2: TPoint;
begin
  inherited;

  if Docked and DockedTo.UsingBackground and DockedTo.FBkgOnToolbars then begin
    R := ClientRect;
    R2 := R;
    P1 := DockedTo.ClientToScreen(Point(0, 0));
    P2 := DockedTo.Parent.ClientToScreen(DockedTo.BoundsRect.TopLeft);
    Dec (R2.Left, Left + DockedTo.Left + (P1.X-P2.X));
    Dec (R2.Top, Top + DockedTo.Top + (P1.Y-P2.Y));
    GetWindowRect (Handle, R3);
    with ClientToScreen(Point(0, 0)) do begin
      Inc (R2.Left, R3.Left-X);
      Inc (R2.Top, R3.Top-Y);
    end;
    DockedTo.DrawBackground (Canvas.Handle, R, nil, R2);
  end;
end;

function TCustomToolWindow97.GetPalette: HPALETTE;
begin
  if Docked and DockedTo.UsingBackground then
    Result := DockedTo.FBkg.Palette
  else
    Result := 0;
end;

function TCustomToolWindow97.PaletteChanged (Foreground: Boolean): Boolean;
begin
  Result := inherited PaletteChanged(Foreground);
  if Result and not Foreground then begin
    { There seems to be a bug in Delphi's palette handling. When the form is
      inactive and another window realizes a palette, docked TToolbar97s
      weren't getting redrawn. So this workaround code was added. }
    InvalidateDockedNCArea;
    Invalidate;
  end;
end;

procedure DrawDragRect (const DC: HDC; const NewRect, OldRect: PRect;
  const NewSize, OldSize: TSize; const Brush: HBRUSH; BrushLast: HBRUSH);
{ Draws a dragging outline, hiding the old one if neccessary. This is
  completely flicker free, unlike the old DrawFocusRect method. In case
  you're wondering, I got a lot of ideas from the MFC sources.

  Either NewRect or OldRect can be nil or empty.

  NOTE: If the specific DC had a clipping region, it will be gone when this
  function exits. }
const
  BlankRect: TRect = (Left: 0; Top: 0; Right: 0; Bottom: 0);
var
  rgnNew, rgnOutside, rgnInside, rgnLast, rgnUpdate: HRGN;
  R: TRect;
  SaveBrush: HBRUSH;
begin
  rgnLast := 0;
  rgnUpdate := 0;

  { First, determine the update region and select it }
  if NewRect = nil then begin
    R := BlankRect;
    rgnOutside := CreateRectRgnIndirect(R);
  end
  else begin
    R := NewRect^;
    rgnOutside := CreateRectRgnIndirect(R);
    InflateRect (R, -NewSize.cx, -NewSize.cy);
    IntersectRect (R, R, NewRect^);
  end;
  rgnInside := CreateRectRgnIndirect(R);
  rgnNew := CreateRectRgnIndirect(BlankRect);
  CombineRgn (rgnNew, rgnOutside, rgnInside, RGN_XOR);

  if BrushLast = 0 then
    BrushLast := Brush;

  if OldRect <> nil then begin
    { Find difference between new region and old region }
    rgnLast := CreateRectRgnIndirect(BlankRect);
    with OldRect^ do
      SetRectRgn (rgnOutside, Left, Top, Right, Bottom);
    R := OldRect^;
    InflateRect (R, -OldSize.cx, -OldSize.cy);
    IntersectRect (R, R, OldRect^);
    SetRectRgn (rgnInside, R.Left, R.Top, R.Right, R.Bottom);
    CombineRgn (rgnLast, rgnOutside, rgnInside, RGN_XOR);

    { Only diff them if brushes are the same}
    if Brush = BrushLast then begin
      rgnUpdate := CreateRectRgnIndirect(BlankRect);
      CombineRgn (rgnUpdate, rgnLast, rgnNew, RGN_XOR);
    end;
  end;
  if (Brush <> BrushLast) and (OldRect <> nil) then begin
    { Brushes are different -- erase old region first }
    SelectClipRgn (DC, rgnLast);
    GetClipBox (DC, R);
    SaveBrush := SelectObject(DC, BrushLast);
    PatBlt (DC, R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top, PATINVERT);
    SelectObject (DC, SaveBrush);
  end;

  { Draw into the update/new region }
  if rgnUpdate <> 0 then
    SelectClipRgn (DC, rgnUpdate)
  else
    SelectClipRgn (DC, rgnNew);
  GetClipBox (DC, R);
  SaveBrush := SelectObject(DC, Brush);
  PatBlt (DC, R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top, PATINVERT);
  SelectObject (DC, SaveBrush);

  { Free regions }
  if rgnNew <> 0 then DeleteObject (rgnNew);
  if rgnOutside <> 0 then DeleteObject (rgnOutside);
  if rgnInside <> 0 then DeleteObject (rgnInside);
  if rgnLast <> 0 then DeleteObject (rgnLast);
  if rgnUpdate <> 0 then DeleteObject (rgnUpdate);

  { Clean up DC }
  SelectClipRgn (DC, 0);
end;

procedure TCustomToolWindow97.DrawDraggingOutline (const DC: HDC;
  const NewRect, OldRect: PRect; const NewDocking, OldDocking: Boolean);

  function CreateHalftoneBrush: HBRUSH;
  const
    Patterns: array[Boolean] of Word = ($5555, $AAAA);
  var
    I: Integer;
    GrayPattern: array[0..7] of Word;
    GrayBitmap: HBITMAP;
  begin
    for I := 0 to 7 do
      GrayPattern[I] := Patterns[Odd(I)];
    GrayBitmap := CreateBitmap(8, 8, 1, 1, @GrayPattern);
    Result := CreatePatternBrush(GrayBitmap);
    DeleteObject (GrayBitmap);
  end;
var
  NewSize, OldSize: TSize;
  Brush: HBRUSH;
begin
  Brush := CreateHalftoneBrush;
  try
    with GetBorderSize(Resizable) do begin
      if NewDocking then NewSize.cx := 1 else NewSize.cx := X;
      NewSize.cy := NewSize.cx;
      if OldDocking then OldSize.cx := 1 else OldSize.cx := X;
      OldSize.cy := OldSize.cx;
    end;
    DrawDragRect (DC, NewRect, OldRect, NewSize, OldSize, Brush, Brush);
  finally
    DeleteObject (Brush);
  end;
end;


procedure TCustomToolWindow97.CMColorChanged (var Message: TMessage);
begin
  { Make sure non-client area is redrawn }
  InvalidateDockedNCArea;
  inherited;  { the inherited handler calls Invalidate }
end;

procedure TCustomToolWindow97.CMTextChanged (var Message: TMessage);
begin
  inherited;
  { Update the title bar to use the new Caption }
  DrawFloatingNCArea (0, False, True, False);
end;

procedure TCustomToolWindow97.CMVisibleChanged (var Message: TMessage);
begin
  if (FHidden = 0) and not(csDesigning in ComponentState) and Docked then
    DockedTo.ChangeDockList (Visible, Self, Visible);
  inherited;
  if (FHidden = 0) and Assigned(FOnVisibleChanged) then
    FOnVisibleChanged (Self);
end;

procedure TCustomToolWindow97.WMActivate (var Message: TWMActivate);

  function GetParentToolWindow (Control: TControl): TCustomToolWindow97;
  { Returns the parent toolbar (direct or indirect) of the control, or nil if it
    is not a child of a TCustomToolWindow97 }
  begin
    Result := nil;
    while Control <> nil do begin
      if Control is TCustomToolWindow97 then begin
        Result := TCustomToolWindow97(Control);
        Break;
      end;
      Control := Control.Parent;
    end;
  end;

  function FindFirstFocusableNonToolWindowControl (const ParentControl: TWinControl): TWinControl;
  var
    List: TList;
    I: Integer;
    CurControl: TWinControl;
  begin
    Result := nil;
    List := TList.Create;
    try
      with ParentControl do begin
        GetTabOrderList (List);
        for I := 0 to List.Count-1 do begin
          CurControl := List[I];
          if CurControl.TabStop and CurControl.CanFocus and
             (GetParentToolWindow(CurControl) = nil) then begin
            Result := CurControl;
            Break;
          end;
        end;
      end;
    finally
      List.Free;
    end;
  end;
var
  Ctl: TWinControl;
  I: Integer;
begin
  if Docked then begin
    inherited;
    Exit;
  end;

  SendMessage (MDIParentForm.Handle, WM_NCACTIVATE, Ord(Message.Active <> WA_INACTIVE), 0);

  inherited;

  if Message.Active = WA_INACTIVE then begin
    Ctl := FindFirstFocusableNonToolWindowControl(TForm(Owner));
    for I := 0 to HookedForms.Count-1 do
      with PHookedFormInfo(HookedForms[I])^ do
        if Form = TForm(Owner) then begin
          if SaveActiveControl <> 0 then
            Ctl := FindControl(SaveActiveControl);
          Break;
        end;
    if Ctl = nil then
      { Can't leave Ctl set to nil or the VCL will automatically pick a new
       ActiveControl (which we don't want, because it could be another tool
       window). So just set Ctl to FloatParent, which effectively leaves no
       currently focused control on the form. }
      Ctl := FloatParent;
    TForm(Owner).ActiveControl := Ctl;
  end;
end;

procedure TCustomToolWindow97.WMMouseActivate (var Message: TWMMouseActivate);
begin
  if Docked or (csDesigning in ComponentState) then
    inherited
  else begin
    { When floating, prevent the toolbar from activating when clicked.
      This is so it doesn't take the focus away from the window that had it }
    Message.Result := MA_NOACTIVATE;

    { Similar to calling BringWindowToTop, but doesn't activate it }
    SetWindowPos (Handle, HWND_TOP, 0, 0, 0, 0,
      SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);

    { Since it is returning MA_NOACTIVATE, activate the form instead. }
    if FActivateParent and
       (GetActiveWindow <> Handle) then begin
      { ^ Note to self: That must be in there so that double-clicks work
          properly on controls like Edits }
      SetActiveWindow (MDIParentForm.Handle);
      if MDIParentForm <> TForm(Owner) then   { if it's an MDI child form }
        BringWindowToTop (TForm(Owner).Handle);
    end;
  end;
end;

procedure TCustomToolWindow97.BeginMoving (const InitX, InitY: Integer);
type
  PDockedSize = ^TDockedSize;
  TDockedSize = record
    Dock: TDock97;
    Size: TPoint;
  end;
var
  NewDockedSizes: TList; {items are pointers to TDockedSizes}
  MouseOverDock: TDock97;
  MoveRect: TRect;
  PreventDocking: Boolean;
  ScreenDC: HDC;
  NPoint, DPoint: TPoint;

  procedure Dropped;
  var
    NewDockRow: Integer;
    Before: Boolean;
    MoveRectClient: TRect;
    C: Integer;
  begin
    if MouseOverDock <> nil then begin
      MoveRectClient := MoveRect;
      MapWindowPoints (0, MouseOverDock.Handle, MoveRectClient, 2);
      if not(MouseOverDock.Position in PositionLeftOrRight) then
        C := (MoveRectClient.Top+MoveRectClient.Bottom) div 2
      else
        C := (MoveRectClient.Left+MoveRectClient.Right) div 2;
      NewDockRow := MouseOverDock.GetRowOf(C, Before);
      if Before then
        MouseOverDock.InsertRowBefore (NewDockRow)
      else
        if FullSize and
           (MouseOverDock.GetNumberOfToolbarsOnRow(NewDockRow, Self) <> 0) then begin
          Inc (NewDockRow);
          MouseOverDock.InsertRowBefore (NewDockRow);
        end;
      FDockRow := NewDockRow;
      if not(MouseOverDock.Position in PositionLeftOrRight) then
        FDockPos := MoveRectClient.Left
      else
        FDockPos := MoveRectClient.Top;
      DockedTo := MouseOverDock;
    end
    else begin
      FFloatingTopLeft := MoveRect.TopLeft;
      DockedTo := nil;
    end;

    { Make sure it doesn't go completely off the screen }
    MoveOnScreen (True);
  end;

  procedure MouseMoved;
  var
    OldMouseOverDock: TDock97;
    OldMoveRect: TRect;
    Pos: TPoint;

    function CheckIfCanDockTo (Control: TDock97): Boolean;
    const
      DockSensX = 32;
      DockSensY = 20;
    var
      R, S, Temp: TRect;
      I: Integer;
      Sens: Integer;
    begin
      with Control do begin
        Result := False;

        R := ClientRect;
        MapWindowPoints (Handle, 0, R, 2);
        for I := 0 to NewDockedSizes.Count-1 do
          with PDockedSize(NewDockedSizes[I])^ do begin
            if Dock <> Control then Continue;
            S := Bounds(Pos.X-MulDiv(Size.X-1, NPoint.X, DPoint.X),
              Pos.Y-MulDiv(Size.Y-1, NPoint.Y, DPoint.Y),
              Size.X, Size.Y);
            Break;
          end;
        if (R.Left = R.Right) or (R.Top = R.Bottom) then begin
          if not(Control.Position in PositionLeftOrRight) then
            InflateRect (R, 0, 1)
          else
            InflateRect (R, 1, 0);
        end;

        { Like Office 97, distribute ~32 pixels of extra dock detection area
          to the left side if the toolbar was grabbed at the left, both sides
          if the toolbar was grabbed at the middle, or the right side if
          toolbar was grabbed at the right. If outside, don't try to dock. }
        Sens := MulDiv(DockSensX, NPoint.X, DPoint.X);
        if (Pos.X < R.Left-(DockSensX-Sens)) or (Pos.X > R.Right-1+Sens) then
          Exit;

        { Don't try to dock to the left or right if pointer is above or below
          the boundaries of the dock }
        if (Control.Position in PositionLeftOrRight) and
           ((Pos.Y < R.Top) or (Pos.Y >= R.Bottom)) then
          Exit;

        { And also distribute ~20 pixels of extra dock detection area to
          the top or bottom side }
        Sens := MulDiv(DockSensY, NPoint.Y, DPoint.Y);
        if (Pos.Y < R.Top-(DockSensY-Sens)) or (Pos.Y > R.Bottom-1+Sens) then
          Exit;

        Result := IntersectRect(Temp, R, S);
      end;
    end;
  var
    R: TRect;
    D: TDockPosition;
    I: Integer;
    Accept: Boolean;
  begin
    OldMouseOverDock := MouseOverDock;
    OldMoveRect := MoveRect;

    GetCursorPos (Pos);

    { Check if it can dock }
    MouseOverDock := nil;
    if not PreventDocking then begin
      { Search through the form's controls and see if it can find a
        Dock97. If it finds one, assign it to MouseOverDock. }
      with TForm(Owner) do
        for D := Low(D) to High(D) do
          if D in DockableTo then
            for I := 0 to ComponentCount-1 do
              if (Components[I] is TDock97) and
                 (TDock97(Components[I]).Position = D) and
                 TDock97(Components[I]).FAllowDrag and
                 CheckIfCanDockTo(TDock97(Components[I])) then begin
                MouseOverDock := TDock97(Components[I]);
                Accept := True;
                if Assigned(MouseOverDock.FOnRequestDock) then
                  MouseOverDock.FOnRequestDock (MouseOverDock, Self, Accept);
                if Accept then
                  Break
                else
                  MouseOverDock := nil;
              end;
    end;

    { If not docking, clip the point so it doesn't get dragged under the
      taskbar }
    if MouseOverDock = nil then begin
      R := GetDesktopArea;
      if Pos.X < R.Left then Pos.X := R.Left;
      if Pos.X > R.Right then Pos.X := R.Right;
      if Pos.Y < R.Top then Pos.Y := R.Top;
      if Pos.Y > R.Bottom then Pos.Y := R.Bottom;
    end;

    for I := 0 to NewDockedSizes.Count-1 do
      with PDockedSize(NewDockedSizes[I])^ do begin
        if Dock <> MouseOverDock then Continue;
        MoveRect := Bounds(Pos.X-MulDiv(Size.X-1, NPoint.X, DPoint.X),
          Pos.Y-MulDiv(Size.Y-1, NPoint.Y, DPoint.Y),
          Size.X, Size.Y);
        Break;
      end;

    { Make sure title bar (or at least part of the toolbar) is still accessible
      if it's dragged almost completely off the screen. This prevents the
      problem seen in Office 97 where you drag it offscreen so that only the
      border is visible, sometimes leaving you no way to move it back short of
      resetting the toolbar. }
    if MouseOverDock = nil then begin
      R := GetDesktopArea;
      with GetBorderSize(Resizable) do
        InflateRect (R, -(X+4), -(Y+4));
      if MoveRect.Bottom < R.Top then
        OffsetRect (MoveRect, 0, R.Top-MoveRect.Bottom);
      if MoveRect.Top > R.Bottom then
        OffsetRect (MoveRect, 0, R.Bottom-MoveRect.Top);
      if MoveRect.Right < R.Left then
        OffsetRect (MoveRect, R.Left-MoveRect.Right, 0);
      if MoveRect.Left > R.Right then
        OffsetRect (MoveRect, R.Right-MoveRect.Left, 0);

      I := GetDesktopArea.Top - GetBorderSize(Resizable).Y - GetSmallCaptionHeight + 4;
      if MoveRect.Top < I then
        OffsetRect (MoveRect, 0, I-MoveRect.Top);
    end;

    { Update the dragging outline }
    DrawDraggingOutline (ScreenDC, @MoveRect, @OldMoveRect, MouseOverDock <> nil,
      OldMouseOverDock <> nil);
  end;
var
  Accept: Boolean;
  R: TRect;
  Msg: TMsg;
  NewDockedSize: PDockedSize;
  I: Integer;
begin
  Accept := False;

  NPoint := Point(InitX, InitY);
  { Adjust for non-client area }
  GetWindowRect (Handle, R);
  R.BottomRight := ClientToScreen(Point(0, 0));
  Dec (NPoint.X, R.Left-R.Right);
  Dec (NPoint.Y, R.Top-R.Bottom);

  DPoint := Point(Width-1, Height-1);

  PreventDocking := GetKeyState(VK_CONTROL) < 0;

  { Set up potential sizes for each dock type }
  NewDockedSizes := TList.Create;
  try
    SetRectEmpty (R);
    CustomArrangeControls (atNone, DockedTo, nil, R.BottomRight);
    AddFloatingNCAreaToRect (R, Resizable);
    New (NewDockedSize);
    try
      with NewDockedSize^ do begin
        Dock := nil;
        Size := Point(R.Right-R.Left, R.Bottom-R.Top);
      end;
      NewDockedSizes.Add (NewDockedSize);
    except
      Dispose (NewDockedSize);
      raise;
    end;
    with TForm(Owner) do
      for I := 0 to ComponentCount-1 do begin
        if not(Components[I] is TDock97) then Continue;
        New (NewDockedSize);
        try
          with NewDockedSize^ do begin
            Dock := TDock97(Components[I]);
            if Components[I] <> DockedTo then
              CustomArrangeControls (atNone, DockedTo, TDock97(Components[I]), Size)
            else
              Size := Self.ClientRect.BottomRight;
            AddDockedNCAreaToSize (Size, TDock97(Components[I]).Position in PositionLeftOrRight,
              FDragHandle);
          end;
          NewDockedSizes.Add (NewDockedSize);
        except
          Dispose (NewDockedSize);
          raise;
        end;
      end;

    { Before locking, make sure all pending paint messages are processed }
    ProcessPaintMessages;

    { This uses LockWindowUpdate to suppress all window updating so the
      dragging outlines doesn't sometimes get garbled. (This is safe, and in
      fact, is the main purpose of the LockWindowUpdate function)
      IMPORTANT! While debugging you might want to enable the 'TB97DisableLock'
      conditional define (see top of the source code). }
    {$IFNDEF TB97DisableLock}
    LockWindowUpdate (GetDesktopWindow);
    {$ENDIF}
    { Get a DC of the entire screen. Works around the window update lock
      by specifying DCX_LOCKWINDOWUPDATE. }
    ScreenDC := GetDCEx(GetDesktopWindow, 0,
      DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
    try
      SetCapture (Handle);

      { Initialize }
      MouseOverDock := nil;
      SetRectEmpty (MoveRect);
      MouseMoved;

      { Stay in message loop until capture is lost. Capture is removed either
        by this procedure manually doing it, or by an outside influence (like
        a message box or menu popping up) }
      while GetCapture = Handle do begin
        case Integer(GetMessage(Msg, 0, 0, 0)) of
          -1: Break; { if GetMessage failed }
          0: begin
               { Repost WM_QUIT messages }
               PostQuitMessage (Msg.WParam);
               Break;
             end;
        end;

        case Msg.Message of
          WM_KEYDOWN, WM_KEYUP:
            { Ignore all keystrokes while dragging. But process Ctrl and Escape }
            case Msg.WParam of
              VK_CONTROL:
                if PreventDocking <> (Msg.Message = WM_KEYDOWN) then begin
                  PreventDocking := Msg.Message = WM_KEYDOWN;
                  MouseMoved;
                end;
              VK_ESCAPE:
                Break;
            end;
          WM_MOUSEMOVE:
            { Note to self: WM_MOUSEMOVE messages should never be dispatched
              here to ensure no hints get shown during the drag process }
            MouseMoved;
          WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
            { Make sure it doesn't begin another loop }
            Break;
          WM_LBUTTONUP: begin
              Accept := True;
              Break;
            end;
          WM_RBUTTONDOWN..WM_MBUTTONDBLCLK:
            { Ignore all other mouse up/down messages }
            ;
        else
          TranslateMessage (Msg);
          DispatchMessage (Msg);
        end;
      end;
    finally
      { Since it sometimes breaks out of the loop without capture being
        released }
      if GetCapture = Handle then
        ReleaseCapture;

      { Hide dragging outline and release the DC }
      DrawDraggingOutline (ScreenDC, nil, @MoveRect, False, MouseOverDock <> nil);
      ReleaseDC (GetDesktopWindow, ScreenDC);

      { Release window update lock }
      {$IFNDEF TB97DisableLock}
      LockWindowUpdate (0);
      {$ENDIF}
    end;

    { Move to new position }
    if Accept then
      Dropped;
  finally
    for I := NewDockedSizes.Count-1 downto 0 do
      Dispose (PDockedSize(NewDockedSizes[I]));
    NewDockedSizes.Free;
  end;
end;

procedure TCustomToolWindow97.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

  function ControlExistsAtPos (const P: TPoint): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    for I := 0 to ControlCount-1 do
      if not(Controls[I] is TToolbarSep97) and Controls[I].Visible and
         PtInRect(Controls[I].BoundsRect, P) then begin
        Result := True;
        Break;
      end;
  end;
begin
  inherited;
  if (Button <> mbLeft) or
     { Ignore message if user clicked on a child control that was probably
       disabled }
     ControlExistsAtPos(Point(X, Y)) or
     (Docked and not DockedTo.FAllowDrag) then
    Exit;

  { Handle double click }
  if ssDouble in Shift then begin
    if Docked then
      DockedTo := nil
    else begin
      FDockRow := ForceDockAtTopRow;
      FDockPos := ForceDockAtLeftPos;
      DockedTo := DefaultDock;
    end;
    Exit;
  end;

  BeginMoving (X, Y);
end;

procedure TCustomToolWindow97.WMNCHitTest (var Message: TWMNCHitTest);
var
  P: TPoint;
  BorderSize: TPoint;
  C: Integer;
begin
  inherited;
  with Message do
    if Docked then begin
      if Result = HTNOWHERE then
        Result := HTCLIENT;
    end
    else begin
      P := SmallPointToPoint(Pos);
      Dec (P.X, Left);  Dec (P.Y, Top);
      if Result <> HTCLIENT then begin
        if PtInRect(GetCaptionRect(Self, True, False), P) then begin
          if FCloseButton and PtInRect(GetCloseButtonRect(Self, True), P) then
            Result := HTCLOSE
          else
            Result := HTCLIENT;
        end
        else begin
          if Result in [HTLEFT..HTBOTTOMRIGHT] {set covers all resizing corners} then
            Result := HTNOWHERE;  { handles all resize hit-tests itself }

          if Resizable then begin
            BorderSize := GetBorderSize(Resizable);
            C := BorderSize.X + (GetSmallCaptionHeight-1);
            if not Params.ResizeEightCorner then begin
              if (P.Y >= 0) and (P.Y < BorderSize.Y) then Result := HTTOP else
              if (P.Y < Height) and (P.Y >= Height-BorderSize.Y-1) then Result := HTBOTTOM else
              if (P.X >= 0) and (P.X < BorderSize.X) then Result := HTLEFT else
              if (P.X < Width) and (P.X >= Width-BorderSize.X-1) then Result := HTRIGHT;
            end
            else begin
              if (P.X >= 0) and (P.X < BorderSize.X) then begin
                Result := HTLEFT;
                if (P.Y < C) then Result := HTTOPLEFT else
                if (P.Y >= Height-C) then Result := HTBOTTOMLEFT;
              end
              else
              if (P.X < Width) and (P.X >= Width-BorderSize.X-1) then begin
                Result := HTRIGHT;
                if (P.Y < C) then Result := HTTOPRIGHT else
                if (P.Y >= Height-C) then Result := HTBOTTOMRIGHT;
              end
              else
              if (P.Y >= 0) and (P.Y < BorderSize.Y) then begin
                Result := HTTOP;
                if (P.X < C) then Result := HTTOPLEFT else
                if (P.X >= Width-C) then Result := HTTOPRIGHT;
              end
              else
              if (P.Y < Height) and (P.Y >= Height-BorderSize.Y-1) then begin
                Result := HTBOTTOM;
                if (P.X < C) then Result := HTBOTTOMLEFT else
                if (P.X >= Width-C) then Result := HTBOTTOMRIGHT;
              end;
            end;
          end;
        end;
      end;
    end;
end;

procedure TCustomToolWindow97.WMNCLButtonDown (var Message: TWMNCLButtonDown);
  procedure CloseButtonLoop;
  var
    Accept, NewCloseButtonDown: Boolean;
    P: TPoint;
    Msg: TMsg;
  begin
    Accept := False;

    CloseButtonDown := True;
    DrawFloatingNCArea (0, False, False, True);

    SetCapture (Handle);

    try
      while GetCapture = Handle do begin
        case Integer(GetMessage(Msg, 0, 0, 0)) of
          -1: Break; { if GetMessage failed }
          0: begin
               { Repost WM_QUIT messages }
               PostQuitMessage (Msg.WParam);
               Break;
             end;
        end;

        case Msg.Message of
          WM_KEYDOWN, WM_KEYUP:
            { Ignore all keystrokes while in a close button loop }
            ;
          WM_MOUSEMOVE: begin
              { Note to self: WM_MOUSEMOVE messages should never be dispatched
                here to ensure no hints get shown }
              GetCursorPos (P);
              Dec (P.X, Left);  Dec (P.Y, Top);

              NewCloseButtonDown := PtInRect(GetCloseButtonRect(Self, True), P);
              if CloseButtonDown <> NewCloseButtonDown then begin
                CloseButtonDown := NewCloseButtonDown;
                DrawFloatingNCArea (0, False, False, True);
              end;
            end;
          WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
            { Make sure it doesn't begin another loop }
            Break;
          WM_LBUTTONUP: begin
              if CloseButtonDown then
                Accept := True;
              Break;
            end;
          WM_RBUTTONDOWN..WM_MBUTTONDBLCLK:
            { Ignore all other mouse up/down messages }
            ;
        else
          TranslateMessage (Msg);
          DispatchMessage (Msg);
        end;
      end;
    finally
      if GetCapture = Handle then
        ReleaseCapture;
      if CloseButtonDown <> False then begin
        CloseButtonDown := False;
        DrawFloatingNCArea (0, False, False, True);
      end;
    end;
    if Accept then begin
      { Hide the window after close button is pushed }
      Hide;
      if Assigned(FOnClose) then
        FOnClose (Self);
    end;
  end;
var
  Accept: Boolean;
  NewRect: TRect;
begin
  case Message.HitTest of
    HTLEFT..HTBOTTOMRIGHT:
      if not Docked then begin
        Accept := False;
        SetRectEmpty (NewRect);
        BeginSizing (Message.HitTest, Accept, NewRect);
        if Accept then begin
          Inc (FDisableArrangeControls);
          try
            BoundsRect := NewRect;
          finally
            Dec (FDisableArrangeControls);
          end;
          ArrangeControls;

          { Make sure it doesn't go completely off the screen }
          MoveOnScreen (True);
        end;
      end;
    HTCLOSE:
      if not Docked then
        CloseButtonLoop;
  else
    inherited;
  end;
end;

procedure TCustomToolWindow97.GetParams (var Params: TToolWindowParams);
begin
  with Params do begin
    CallAlignControls := True;
    ResizeEightCorner := True;
    ResizeClipCursor := True;
  end;
end;

procedure TCustomToolWindow97.ResizeBegin;
begin
end;

procedure TCustomToolWindow97.ResizeTrack (var Rect: TRect; const OrigRect: TRect);
begin
end;

procedure TCustomToolWindow97.ResizeEnd;
begin
end;

procedure TCustomToolWindow97.BeginSizing (const HitTestValue: Integer;
  var Accept: Boolean; var NewRect: TRect);
var
  DragX, DragY, ReverseX, ReverseY: Boolean;
  MinWidth, MinHeight: Integer;
  DragRect, OrigDragRect: TRect;
  ScreenDC: HDC;
  OrigPos, OldPos: TPoint;

  procedure MouseMoved;
  var
    Pos: TPoint;
    OldDragRect: TRect;
  begin
    GetCursorPos (Pos);
    { It needs to check if the cursor actually moved since last time. This is
      because a call to LockWindowUpdate (apparently) generates a mouse move
      message even when mouse hasn't moved. }
    if (Pos.X = OldPos.X) and (Pos.Y = OldPos.Y) then Exit;
    OldPos := Pos;

    OldDragRect := DragRect;
    DragRect := OrigDragRect;
    if DragX then begin
      if not ReverseX then Inc (DragRect.Right, Pos.X-OrigPos.X)
      else Inc (DragRect.Left, Pos.X-OrigPos.X);
    end;
    if DragY then begin
      if not ReverseY then Inc (DragRect.Bottom, Pos.Y-OrigPos.Y)
      else Inc (DragRect.Top, Pos.Y-OrigPos.Y);
    end;
    if DragRect.Right-DragRect.Left < MinWidth then begin
      if not ReverseX then DragRect.Right := DragRect.Left + MinWidth
      else DragRect.Left := DragRect.Right - MinWidth;
    end;
    if DragRect.Bottom-DragRect.Top < MinHeight then begin
      if not ReverseY then DragRect.Bottom := DragRect.Top + MinHeight
      else DragRect.Top := DragRect.Bottom - MinHeight;
    end;

    ResizeTrack (DragRect, OrigDragRect);
    DrawDraggingOutline (ScreenDC, @DragRect, @OldDragRect, False, False);
  end;
var
  Msg: TMsg;
  R: TRect;
begin
  Accept := False;

  GetMinimumSize (MinWidth, MinHeight);
  Inc (MinWidth, Width-ClientWidth);
  Inc (MinHeight, Height-ClientHeight);

  DragX := HitTestValue in [HTLEFT, HTRIGHT, HTTOPLEFT, HTTOPRIGHT, HTBOTTOMLEFT, HTBOTTOMRIGHT];
  ReverseX := HitTestValue in [HTLEFT, HTTOPLEFT, HTBOTTOMLEFT];
  DragY := HitTestValue in [HTTOP, HTTOPLEFT, HTTOPRIGHT, HTBOTTOM, HTBOTTOMLEFT, HTBOTTOMRIGHT];
  ReverseY := HitTestValue in [HTTOP, HTTOPLEFT, HTTOPRIGHT];

  ResizeBegin (HitTestValue);
  try
    { Before locking, make sure all pending paint messages are processed }
    ProcessPaintMessages;

    { This uses LockWindowUpdate to suppress all window updating so the
      dragging outlines doesn't sometimes get garbled. (This is safe, and in
      fact, is the main purpose of the LockWindowUpdate function)
      IMPORTANT! While debugging you might want to enable the 'TB97DisableLock'
      conditional define (see top of the source code). }
    {$IFNDEF TB97DisableLock}
    LockWindowUpdate (GetDesktopWindow);
    {$ENDIF}
    { Get a DC of the entire screen. Works around the window update lock
      by specifying DCX_LOCKWINDOWUPDATE. }
    ScreenDC := GetDCEx(GetDesktopWindow, 0,
      DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW);
    try
      SetCapture (Handle);
      if Params.ResizeClipCursor then begin
        R := GetDesktopArea;
        ClipCursor (@R);
      end;

      { Initialize }
      OrigDragRect := BoundsRect;
      DragRect := OrigDragRect;
      DrawDraggingOutline (ScreenDC, @DragRect, nil, False, False);
      GetCursorPos (OrigPos);
      OldPos := OrigPos;

      { Stay in message loop until capture is lost. Capture is removed either
        by this procedure manually doing it, or by an outside influence (like
        a message box or menu popping up) }
      while GetCapture = Handle do begin
        case Integer(GetMessage(Msg, 0, 0, 0)) of
          -1: Break; { if GetMessage failed }
          0: begin
               { Repost WM_QUIT messages }
               PostQuitMessage (Msg.WParam);
               Break;
             end;
        end;

        case Msg.Message of
          WM_KEYDOWN, WM_KEYUP:
            { Ignore all keystrokes while sizing except for Escape }
            if Msg.WParam = VK_ESCAPE then
              Break;
          WM_MOUSEMOVE:
            { Note to self: WM_MOUSEMOVE messages should never be dispatched
              here to ensure no hints get shown during the drag process }
            MouseMoved;
          WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
            { Make sure it doesn't begin another loop }
            Break;
          WM_LBUTTONUP: begin
              Accept := True;
              Break;
            end;
          WM_RBUTTONDOWN..WM_MBUTTONDBLCLK:
            { Ignore all other mouse up/down messages }
            ;
        else
          TranslateMessage (Msg);
          DispatchMessage (Msg);
        end;
      end;
    finally
      { Since it sometimes breaks out of the loop without capture being
        released }
      if GetCapture = Handle then
        ReleaseCapture;
      ClipCursor (nil);

      { Hide dragging outline and release the DC }
      DrawDraggingOutline (ScreenDC, nil, @DragRect, False, False);
      ReleaseDC (GetDesktopWindow, ScreenDC);

      { Release window update lock }
      {$IFNDEF TB97DisableLock}
      LockWindowUpdate (0);
      {$ENDIF}
    end;
  finally
    ResizeEnd (Accept);
  end;

  if Accept then
    NewRect := DragRect;
end;

procedure TCustomToolWindow97.WMClose (var Message: TWMClose);
begin
  { A floating toolbar does not use WM_CLOSE messages when its close button
    is clicked, but Windows still sends a WM_CLOSE message if the user
    presses Alt+F4 while one of the toolbar's controls is focused. Inherited
    is not called since we do not want Windows' default processing - which
    destroys the window. Instead, relay the message to the parent form. }
  SendMessage (MDIParentForm.Handle, WM_CLOSE, 0, 0);
  { Note to self: MDIParentForm is used instead of TForm(Owner) since MDI
    childs don't process Alt+F4 as Close }
end;

class function TCustomToolWindow97.NewMainWindowHook (var Message: TMessage): Boolean;
var
  I: Integer;
begin
  Result := False;
  case Message.Msg of
    CM_ACTIVATE, CM_DEACTIVATE:
      for I := 0 to MainHookedForms.Count-1 do
        { Hide or restore toolbars when application is deactivated or activated }
        ShowHideFloatParents (GetMDIParent(PMainHookedFormInfo(MainHookedForms[I]).Form),
          Message.Msg = CM_ACTIVATE);
    WM_TB97DoneCreating:
      if (Message.WParam = WM_TB97DoneCreating_Magic) and
         (Message.LParam = WM_TB97DoneCreating_Magic) then
        for I := DoneCreatingList.Count-1 downto 0 do begin
          ShowHideFloatParents (TCustomToolWindow97(DoneCreatingList[I]).MDIParentForm, Application.Active);
          DoneCreatingList.Delete (I);
        end;
  end;
end;

{ TCustomToolWindow97 - property access methods }

procedure TCustomToolWindow97.SetCloseButton (Value: Boolean);
begin
  if FCloseButton <> Value then begin
    FCloseButton := Value;

    { Update the close button's visibility }
    DrawFloatingNCArea (0, False, True, True);
  end;
end;

procedure TCustomToolWindow97.SetDefaultDock (Value: TDock97);
begin
  if FDefaultDock <> Value then begin
    FDefaultDock := Value;
    if Assigned(Value) then
      Value.FreeNotification (Self);
  end;
end;

procedure TCustomToolWindow97.SetDockedTo (Value: TDock97);
var
  OldDockedTo: TDock97;
  HiddenInced: Boolean;
  TempSize: TPoint;
begin
  OldDockedTo := DockedTo;

  if Assigned(FOnDockChanging) and (Value <> OldDockedTo) then
    FOnDockChanging (Self);

  Inc (FUpdatingBounds);
  try
    if Assigned(Value) then
      Inc (Value.DisableArrangeToolbars);
    try
      { Before changing between docked and floating state (and vice-versa)
        or between docks, hide the toolbar. This prevents any flashing while
        it's being moved }
      HiddenInced := False;
      if not(csDesigning in ComponentState) and (Value <> OldDockedTo) and (Visible) then begin
        Inc (FHidden);
        HiddenInced := True;
        if Assigned(OldDockedTo) then
          { Need to disable arranging of current dock so it doesn't lose it's
            FDockRow/FDockPos it's going to set later }
          Inc (OldDockedTo.DisableArrangeToolbars);
        try
          Hide; {must Hide AFTER incing Hidden}
        finally
          if Assigned(OldDockedTo) then
            Dec (OldDockedTo.DisableArrangeToolbars);
        end;
      end;
      try
        if Value <> nil then begin
          { Must pre-arrange controls in new dock orientation before changing
            the Parent }
          if Parent <> nil then
            CustomArrangeControls (atMoveControls, OldDockedTo, Value, TempSize);
          if Parent <> Value then begin
            Inc (FDisableArrangeControls);
            try
              Parent := Value;
            finally
              Dec (FDisableArrangeControls);
            end;
          end;
          ArrangeControls;
          { Temporarily put it off the edge of the parent window when changing
            parents so that no momentary "flicker" occurs when it shows the
            toolbar again before it gets positioned }
          if Value <> OldDockedTo then
            SetBounds (-Width, -Height, Width, Height);
        end
        else begin
          { Must pre-arrange controls in new dock orientation before changing
            the Parent }
          if Parent <> nil then
            CustomArrangeControls (atMoveControls, OldDockedTo, Value, TempSize);
          Inc (FDisableArrangeControls);
          try
            if Parent <> FloatParent then
              Parent := FloatParent;
            SetBounds (FFloatingTopLeft.X, FFloatingTopLeft.Y, Width, Height);
            MoveOnScreen (True);
          finally
            Dec (FDisableArrangeControls);
          end;
          ArrangeControls;
        end;
      finally
        if HiddenInced then begin
          Dec (FHidden);
          Show;
        end;
      end;
    finally
      if Assigned(Value) then
        Dec (Value.DisableArrangeToolbars);
    end;
  finally
    Dec (FUpdatingBounds);
  end;
  if Assigned(Value) then
    Value.ArrangeToolbars;

  if Assigned(FOnDockChanged) and (Value <> OldDockedTo) then
    FOnDockChanged (Self);
end;

procedure TCustomToolWindow97.SetDockPos (Value: Integer);
begin
  FDockPos := Value;
  if Docked then
    DockedTo.ArrangeToolbars;
end;

procedure TCustomToolWindow97.SetDockRow (Value: Integer);
begin
  FDockRow := Value;
  if Docked then
    DockedTo.ArrangeToolbars;
end;

procedure TCustomToolWindow97.SetDragHandle (Value: Boolean);
begin
  if FDragHandle <> Value then begin
    FDragHandle := Value;
    if Docked and HandleAllocated then
      SetWindowPos (Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or
        SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
  end;
end;

procedure TCustomToolWindow97.SetFullSize (Value: Boolean);
begin
  if FFullSize <> Value then begin
    FFullSize := Value;
    ArrangeControls;
  end;
end;

procedure TCustomToolWindow97.SetResizable (Value: Boolean);
begin
  if FResizable <> Value then begin
    FResizable := Value;
    if not Docked then begin
      { Recalculate the non-client area }
      SetWindowPos (Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or
        SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
      { The VCL does not automatically realign child controls when the
        non-client size changes, so do it manually }
      Realign;
    end;
  end;
end;


{ TCustomToolbar97 }

constructor TCustomToolbar97.Create (AOwner: TComponent);
begin
  inherited;
  GroupInfo := TList.Create;
  SlaveInfo := TList.Create;
  LineSeps := TList.Create;
  OrderList := TList.Create;
  { There hasn't been any child controls added yet, but call ArrangeControls
    to initialize the toolbar's size }
  ArrangeControls;
end;

destructor TCustomToolbar97.Destroy;
var
  I: Integer;
begin
  OrderList.Free;
  LineSeps.Free;
  if Assigned(SlaveInfo) then begin
    for I := SlaveInfo.Count-1 downto 0 do 
      FreeMem (SlaveInfo.Items[I]);
    SlaveInfo.Free;
  end;
  FreeGroupInfo (GroupInfo);
  GroupInfo.Free;
  inherited;
end;

procedure TCustomToolbar97.ReadPositionData (const ReadIntProc: TPositionReadIntProc;
  const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
begin
  inherited;
  FFloatingRightX := ReadIntProc(Name, rvFloatRightX, 0, ExtraData);
end;

procedure TCustomToolbar97.WritePositionData (const WriteIntProc: TPositionWriteIntProc;
  const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer);
begin
  inherited;
  WriteIntProc (Name, rvFloatRightX, FFloatingRightX, ExtraData);
end;

procedure TCustomToolbar97.GetMinimumSize (var AClientWidth, AClientHeight: Integer);
begin
  AClientWidth := 0;
  AClientHeight := 0;
end;

function CompareControls (const Item1, Item2, ExtraData: Pointer): Integer; far;
begin
  with PCompareExtra(ExtraData)^ do
    if ComparePositions then begin
      if CurDockType <> dtLeftRight then
        Result := TControl(Item1).Left - TControl(Item2).Left
      else
        Result := TControl(Item1).Top - TControl(Item2).Top;
    end
    else
      with Toolbar.OrderList do
        Result := IndexOf(Item1) - IndexOf(Item2);
end;

procedure TCustomToolbar97.InitializeOrdering;
var
  Extra: TCompareExtra;
begin
  inherited;
  { Initialize order of items in OrderList }
  if not(csDesigning in ComponentState) then begin
    with Extra do begin
      Toolbar := Self;
      ComparePositions := True;
      CurDockType := GetDockTypeOf(DockedTo);
    end;
    ListSortEx (OrderList, CompareControls, @Extra);
  end;
end;

procedure TCustomToolbar97.GetBarSize (var ASize: Integer; const DockType: TDockType);
var
  I: Integer;
begin
  ASize := DefaultBarWidthHeight;
  for I := 0 to ControlCount-1 do 
    if not(Controls[I] is TToolbarSep97) then
      with Controls[I] do begin
        if ShouldBeVisible(Controls[I], DockType = dtLeftRight, False) then begin
          if DockType = dtLeftRight then begin
            if Width > ASize then ASize := Width;
          end
          else begin
            if Height > ASize then ASize := Height;
          end;
        end;
      end;
end;

procedure TCustomToolbar97.GetParams (var Params: TToolWindowParams);
begin
  inherited;
  with Params do begin
    CallAlignControls := False;
    ResizeEightCorner := False;
    ResizeClipCursor := False;
  end;
end;

procedure TCustomToolbar97.Paint;
var
  S: Integer;
begin
  inherited;
  { Long separators when not docked }
  if not Docked then
    for S := 0 to LineSeps.Count-1 do begin
      with TLineSep(LineSeps[S]) do begin
        if Blank then Continue;
        Canvas.Pen.Color := clBtnShadow;
        Canvas.MoveTo (1, Y-4);  Canvas.LineTo (ClientWidth-1, Y-4);
        Canvas.Pen.Color := clBtnHighlight;
        Canvas.MoveTo (1, Y-3);  Canvas.LineTo (ClientWidth-1, Y-3);
      end;
    end;
end;

function TCustomToolbar97.ShouldBeVisible (const Control: TControl;
  const LeftOrRight: Boolean; const SetIt: Boolean): Boolean;
{ If Control is a master or slave control, it returns the appropriate visibility
  setting based on the value of LeftOrRight, otherwise it simply returns the
  current Visible setting. If SetIt is True, it automatically adjusts the
  Visible properties of both the master and slave control. }
var
  I: Integer;
begin
  for I := 0 to SlaveInfo.Count-1 do
    with PSlaveInfo(SlaveInfo[I])^ do
      if TopBottom = Control then begin
        Result := not LeftOrRight;
        if SetIt then begin
          TopBottom.Visible := Result;
          LeftRight.Visible := not Result;
        end;
        Exit;
      end
      else
      if LeftRight = Control then begin
        Result := LeftOrRight;
        if SetIt then begin
          TopBottom.Visible := not Result;
          LeftRight.Visible := Result;
        end;
        Exit;
      end;
  Result := Control.Visible;
end;

procedure TCustomToolbar97.FreeGroupInfo (const List: TList);
var
  I: Integer;
  L: PGroupInfo;
begin
  if List = nil then Exit;
  for I := List.Count-1 downto 0 do begin
    L := List.Items[I];
    if Assigned(L) then begin
      L^.Members.Free;
      FreeMem (L);
    end;
    List.Delete (I);
  end;
end;

procedure TCustomToolbar97.BuildGroupInfo (const List: TList;
  const TranslateSlave: Boolean; const OldDockType, NewDockType: TDockType);
var
  I: Integer;
  GI: PGroupInfo;
  Children: TList; {items casted into TControls}
  NewGroup: Boolean;
  Extra: TCompareExtra;
begin
  FreeGroupInfo (List);
  if ControlCount = 0 then Exit;

  Children := TList.Create;
  try
    for I := 0 to ControlCount-1 do
      if (not TranslateSlave and Controls[I].Visible) or
         (TranslateSlave and ShouldBeVisible(Controls[I], NewDockType = dtLeftRight, False)) then
        Children.Add (Controls[I]);

    with Extra do begin
      Toolbar := Self;
      CurDockType := OldDockType;
    end;
    if csDesigning in ComponentState then begin
      Extra.ComparePositions := True;
      ListSortEx (OrderList, CompareControls, @Extra);
    end;
    Extra.ComparePositions := csDesigning in ComponentState;
    ListSortEx (Children, CompareControls, @Extra);

    GI := nil;
    NewGroup := True;         
    for I := 0 to Children.Count-1 do begin
      if NewGroup then begin
        NewGroup := False;
        List.Add (AllocMem(SizeOf(TGroupInfo)));
        { Note: AllocMem initializes the newly allocated data to zero }
        GI := List.Last;
        GI^.Members := TList.Create;
      end;
      GI^.Members.Add (Children[I]);
      if TControl(Children[I]) is TToolbarSep97 then
        NewGroup := True
      else begin
        with TControl(Children[I]) do begin
          Inc (GI^.GroupWidth, Width);
          Inc (GI^.GroupHeight, Height);
        end;
      end;
    end;
  finally
    Children.Free;
  end;
end;

procedure TCustomToolbar97.OrderControls (const CanMoveControls: Boolean;
  const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint);
{ This arranges the controls on the toolbar }
var
  OldDockType, NewDockType: TDockType;
  NewDocked: Boolean;
  RightX, I: Integer;
  CurBarSize, DockRowSize: Integer;
  GInfo: TList;
  AllowWrap: Boolean;
  BarPosSize, MinPosPixels, MinRowPixels, CurPosPixel, CurLinePixel, G: Integer;
  NewLine, Prec1Line: Boolean;
  GI: PGroupInfo;
  Member: TControl;
  MemberIsSep: Boolean;
  GroupPosSize, MemberPosSize: Integer;
  PreviousSep: TToolbarSep97;  PrevMinPosPixels: Integer;
  NewLineSep: TLineSep;
label 1;
begin
  OldDockType := GetDockTypeOf(WasDockedTo);
  NewDockType := GetDockTypeOf(DockingTo);
  NewDocked := Assigned(DockingTo);

  RightX := FFloatingRightX;
  if (NewDockType <> dtNotDocked) or (RightX = 0) then
    RightX := High(RightX)
  else begin
    { Make sure RightX isn't less than the smallest sized control + margins,
      in case one of the *LoadToolbarPositions functions happened to read
      a value too small. }
    for I := 0 to ControlCount-1 do
      if not(Controls[I] is TToolbarSep97) then
        with Controls[I] do
          if Width + (LeftMarginNotDocked+RightMarginNotDocked) > RightX then
            RightX := Width + (LeftMarginNotDocked+RightMarginNotDocked);
  end;

  if CanMoveControls then
    for I := 0 to ControlCount-1 do
      if not(Controls[I] is TToolbarSep97) then
        ShouldBeVisible (Controls[I], NewDockType = dtLeftRight, True);

  GetBarSize (CurBarSize, NewDockType);
  DockRowSize := CurBarSize;
  if (DockingTo <> nil) and (DockingTo = DockedTo) then
    GetDockRowSize (DockRowSize);

  if CanMoveControls then
    GInfo := GroupInfo
  else
    GInfo := TList.Create;
  try
    BuildGroupInfo (GInfo, not CanMoveControls, OldDockType, NewDockType);

    if CanMoveControls then
      LineSeps.Clear;

    AllowWrap := not NewDocked;
    if GInfo.Count <> 0 then begin
      BarPosSize := CurBarSize;
      MinPosPixels := 0;
      CurPosPixel := 0;
      CurLinePixel := TopMargin[NewDocked];
      Prec1Line := True;  NewLine := True;
      PreviousSep := nil;  PrevMinPosPixels := 0;
      for G := 0 to GInfo.Count-1 do begin
        GI := PGroupInfo(GInfo[G]);

        if NewDockType <> dtLeftRight then
          GroupPosSize := GI^.GroupWidth
        else
          GroupPosSize := GI^.GroupHeight;
        if (not AllowWrap) or (Prec1Line) then begin
          if NewLine then begin
            NewLine := False;
            Inc (CurPosPixel, LeftMargin[NewDocked])
          end;
          if CurPosPixel+GroupPosSize+RightMargin[NewDocked] > RightX then
            goto 1;  { I know it's sloppy to use a goto. But it's fast }
          if CurPosPixel > MinPosPixels then MinPosPixels := CurPosPixel;
        end
        else begin
        1:CurPosPixel := LeftMargin[NewDocked];
          if CurPosPixel > MinPosPixels then MinPosPixels := CurPosPixel;
          if (G <> 0) and (PGroupInfo(GInfo[G-1])^.Members.Count <> 0) then begin
            Inc (CurLinePixel, BarPosSize+LineSpacing);
            if Assigned(PreviousSep) then begin
              MinPosPixels := PrevMinPosPixels;
              if CanMoveControls then begin
                PreviousSep.Width := 0;

                LongInt(NewLineSep) := 0;
                NewLineSep.Y := CurLinePixel;
                NewLineSep.Blank := PreviousSep.Blank;
                LineSeps.Add (Pointer(NewLineSep));
              end;
            end;
          end;
        end;
        Prec1Line := True;
        for I := 0 to GI^.Members.Count-1 do begin
          Member := TControl(GI^.Members[I]);
          MemberIsSep := Member is TToolbarSep97;
          with Member do begin
            if not MemberIsSep then begin
              if NewDockType <> dtLeftRight then
                MemberPosSize := Width
              else
                MemberPosSize := Height;
            end
            else begin
              if NewDockType <> dtLeftRight then
                MemberPosSize := TToolbarSep97(Member).SizeHorz
              else
                MemberPosSize := TToolbarSep97(Member).SizeVert;
            end;
            { If RightX is passed, proceed to next line }
            if not MemberIsSep and
               (CurPosPixel+MemberPosSize+RightMargin[NewDocked] > RightX) then begin
              CurPosPixel := LeftMargin[NewDocked];
              if CurPosPixel > MinPosPixels then MinPosPixels := CurPosPixel;
              Inc (CurLinePixel, CurBarSize);
              Prec1Line := False;
            end;
            if NewDockType <> dtLeftRight then begin
              if not MemberIsSep then begin
                if CanMoveControls then
                  SetBounds (CurPosPixel, CurLinePixel+((DockRowSize-Height) div 2), Width, Height);
                Inc (CurPosPixel, Width);
              end
              else begin
                if CanMoveControls then
                  SetBounds (CurPosPixel, CurLinePixel, TToolbarSep97(Member).SizeHorz, DockRowSize);
                Inc (CurPosPixel, TToolbarSep97(Member).SizeHorz);
              end;
            end
            else begin
              if not MemberIsSep then begin
                if CanMoveControls then
                  SetBounds (CurLinePixel+((DockRowSize-Width) div 2), CurPosPixel, Width, Height);
                Inc (CurPosPixel, Height);
              end
              else begin
                if CanMoveControls then
                  SetBounds (CurLinePixel, CurPosPixel, DockRowSize, TToolbarSep97(Member).SizeVert);
                Inc (CurPosPixel, TToolbarSep97(Member).SizeVert);
              end;
            end;
            PrevMinPosPixels := MinPosPixels;
            if not MemberIsSep then
              PreviousSep := nil
            else
              PreviousSep := TToolbarSep97(Member);
            if CurPosPixel > MinPosPixels then MinPosPixels := CurPosPixel;
          end;
        end;
      end;
    end
    else begin
      if Docked then begin
        MinPosPixels := LeftMargin[NewDocked];
        CurLinePixel := TopMargin[NewDocked];
        Inc (MinPosPixels, DefaultBarWidthHeight);
        BarPosSize := DockedTo.GetRowSize(FDockRow, Self);
      end
      else begin
        MinPosPixels := LeftMargin[NewDocked] + DefaultBarWidthHeight;
        CurLinePixel := TopMargin[NewDocked];
        BarPosSize := DefaultBarWidthHeight;
      end;
    end;

    if csDesigning in ComponentState then
      Invalidate;
  finally
    if not CanMoveControls then begin
      FreeGroupInfo (GInfo);
      GInfo.Free;
    end;
  end;

  Inc (MinPosPixels, RightMargin[NewDocked]);
  MinRowPixels := CurLinePixel + BarPosSize + BottomMargin[NewDocked];
  if NewDockType <> dtLeftRight then begin
    NewClientSize.X := MinPosPixels;
    NewClientSize.Y := MinRowPixels;
  end
  else begin
    NewClientSize.X := MinRowPixels;
    NewClientSize.Y := MinPosPixels;
  end;
end;

procedure TCustomToolbar97.CMControlListChange (var Message: TCMControlListChange);
{ The VCL sends this message is sent whenever a child control is inserted into
  or deleted from the toolbar }
var
  I: Integer;
begin
  inherited;
  with Message, OrderList do begin
    { Delete any previous occurances of Control in OrderList. There shouldn't
      be any if Inserting=True, but just to be safe, check anyway. }
    while True do begin
      I := IndexOf(Control);
      if I = -1 then Break;
      Delete (I);
    end;
    if Inserting then
      Add (Control);
  end;
end;

function CompareNewSizes (const Item1, Item2, ExtraData: Pointer): Integer; far;
begin
  { Sorts in descending order }
  if ExtraData = nil then
    Result := TSmallPoint(Item2).X - TSmallPoint(Item1).X
  else
    Result := TSmallPoint(Item2).Y - TSmallPoint(Item1).Y;
end;

procedure TCustomToolbar97.ResizeBegin (HitTestValue: Integer);
var
  CurBarSize: Integer;

  procedure BuildNewSizes (const YOrdering: Boolean);
  { Adds items to the NewSizes list. The list must be empty when this is called }
    function AddNCAreaToSize (const P: TPoint): TPoint;
    var
      R: TRect;
    begin
      with R do begin
        Top := 0;  Left := 0;
        BottomRight := P;
      end;
      AddFloatingNCAreaToRect (R, Resizable);
      OffsetRect (R, -R.Left, -R.Top);
      Result := R.BottomRight;
    end;
  var
    SaveFloatingRightX: Integer;
    Max, X, LastY, SkipTo: Integer;
    S: TPoint;
    S2: TSmallPoint;
  begin
    with PToolbar97SizeData(SizeData)^ do begin
      SaveFloatingRightX := FFloatingRightX;
      try
        FFloatingRightX := 0;
        CustomArrangeControls (atNone, nil, nil, S);
        S2 := PointToSmallPoint(AddNCAreaToSize(S));
        NewSizes.Add (Pointer(S2));
        LastY := S.Y;
        Max := S.X;
        SkipTo := High(SkipTo);
        for X := Max-1 downto LeftMarginNotDocked+CurBarSize+RightMarginNotDocked do begin
          if X > SkipTo then Continue;
          FFloatingRightX := X;
          CustomArrangeControls (atNone, nil, nil, S);
          if X = S.X then begin
            if S.Y = LastY then
              NewSizes.Delete (NewSizes.Count-1);
            S2 := PointToSmallPoint(AddNCAreaToSize(S));
            if NewSizes.IndexOf(Pointer(S2)) = -1 then
              NewSizes.Add (Pointer(S2));
            LastY := S.Y;
          end
          else
            SkipTo := S.X;
        end;
      finally
        FFloatingRightX := SaveFloatingRightX;
      end;
      ListSortEx (NewSizes, CompareNewSizes, Pointer(Longint(YOrdering)));
    end;
  end;
const
  MaxSizeSens = 12;
var
  I, NewSize: Integer;
  S, N: TSmallPoint;
begin
  inherited;

  SizeData := AllocMem(SizeOf(TToolbar97SizeData));

  with PToolbar97SizeData(SizeData)^ do begin
    HitTest := HitTestValue;
    CurRightX := FFloatingRightX;
    DisableSensCheck := False;
    OpSide := False;
    GetBarSize (CurBarSize, dtNotDocked);
    NewSizes := TList.Create;

    BuildNewSizes (HitTestValue in [HTTOP, HTBOTTOM]);

    SizeSens := MaxSizeSens;
    { Adjust sensitivity if it's too high }
    for I := 0 to NewSizes.Count-1 do begin
      Pointer(S) := NewSizes[I];
      if (S.X = Width) and (S.Y = Height) then begin
        if I > 0 then begin
          Pointer(N) := NewSizes[I-1];
          if HitTestValue in [HTLEFT, HTRIGHT] then
            NewSize := N.X - S.X - 1
          else
            NewSize := N.Y - S.Y - 1;
          if NewSize < SizeSens then SizeSens := NewSize;
        end;
        if I < NewSizes.Count-1 then begin
          Pointer(N) := NewSizes[I+1];
          if HitTestValue in [HTLEFT, HTRIGHT] then
            NewSize := S.X - N.X - 1
          else
            NewSize := S.Y - N.Y - 1;
          if NewSize < SizeSens then SizeSens := NewSize;
        end;
        Break;
      end;
    end;
    if SizeSens < 0 then SizeSens := 0;
  end;
end;

procedure TCustomToolbar97.ResizeTrack (var Rect: TRect; const OrigRect: TRect);
var
  Pos: TPoint;
  NCXDiff: Integer;
  NewOpSide: Boolean;
  Reverse: Boolean;
  I: Integer;
  P: TSmallPoint;
begin
  inherited;

  with PToolbar97SizeData(SizeData)^ do begin
    GetCursorPos (Pos);

    NCXDiff := ClientToScreen(Point(0, 0)).X - Left;
    Dec (Pos.X, Left);  Dec (Pos.Y, Top);
    if HitTest = HTLEFT then
      Pos.X := Width-Pos.X
    else
    if HitTest = HTTOP then
      Pos.Y := Height-Pos.Y;

    { Adjust Pos to make up for the "sizing sensitivity", as seen in Office 97 }
    if HitTest in [HTLEFT, HTRIGHT] then
      NewOpSide := Pos.X < Width
    else
      NewOpSide := Pos.Y < Height;
    if (not DisableSensCheck) or (OpSide <> NewOpSide) then begin
      DisableSensCheck := False;
      OpSide := NewOpSide;
      if HitTest in [HTLEFT, HTRIGHT] then begin
        if (Pos.X >= Width-SizeSens) and (Pos.X < Width+SizeSens) then
          Pos.X := Width;
      end
      else begin
        if (Pos.Y >= Height-SizeSens) and (Pos.Y < Height+SizeSens) then
          Pos.Y := Height;
      end;
    end;

    Rect := OrigRect;

    if HitTest in [HTLEFT, HTRIGHT] then
      Reverse := Pos.X > Width
    else
      Reverse := Pos.Y > Height;
    if not Reverse then
      I := NewSizes.Count-1
    else
      I := 0;
    while True do begin
      if (not Reverse and (I < 0)) or
         (Reverse and (I >= NewSizes.Count)) then
        Break;
      Pointer(P) := NewSizes[I];
      if HitTest in [HTLEFT, HTRIGHT] then begin
        if (not Reverse and ((I = NewSizes.Count-1) or (Pos.X >= P.X))) or
           (Reverse and ((I = 0) or (Pos.X < P.X))) then begin
          if I = 0 then
            CurRightX := 0
          else
            CurRightX := P.X - NCXDiff*2;
          if HitTest = HTRIGHT then
            Rect.Right := Rect.Left + P.X
          else
            Rect.Left := Rect.Right - P.X;
          Rect.Bottom := Rect.Top + P.Y;
          DisableSensCheck := not EqualRect(Rect, OrigRect);
        end;
      end
      else begin
        if (not Reverse and ((I = NewSizes.Count-1) or (Pos.Y >= P.Y))) or
           (Reverse and ((I = 0) or (Pos.Y < P.Y))) then begin
          if I = NewSizes.Count-1 then
            CurRightX := 0
          else
            CurRightX := P.X - NCXDiff*2;
          if HitTest = HTBOTTOM then
            Rect.Bottom := Rect.Top + P.Y
          else
            Rect.Top := Rect.Bottom - P.Y;
          Rect.Right := Rect.Left + P.X;
          DisableSensCheck := not EqualRect(Rect, OrigRect);
        end;
      end;
      if not Reverse then
        Dec (I)
      else
        Inc (I);
    end;
  end;
end;

procedure TCustomToolbar97.ResizeEnd (Accept: Boolean);
begin
  inherited;
  if Assigned(SizeData) then begin
    with PToolbar97SizeData(SizeData)^ do begin
      if Accept then
        FFloatingRightX := CurRightX;
      NewSizes.Free;
    end;
    FreeMem (SizeData);
  end;
end;

function TCustomToolbar97.GetOrderIndex (Control: TControl): Integer;
begin
  Result := OrderList.IndexOf(Control);
  if Result = -1 then
    raise EInvalidOperation.Create(STB97ToolbarControlNotChildOfToolbar);
end;

procedure TCustomToolbar97.SetOrderIndex (Control: TControl; Value: Integer);
var
  OldIndex: Integer;
begin
  with OrderList do begin
    OldIndex := IndexOf(Control);
    if OldIndex = -1 then
      raise EInvalidOperation.Create(STB97ToolbarControlNotChildOfToolbar);
    if Value < 0 then Value := 0;
    if Value >= Count then Value := Count-1;
    if Value <> OldIndex then begin
      Delete (OldIndex);
      Insert (Value, Control);
      ArrangeControls;
    end;
  end;
end;

procedure TCustomToolbar97.SetSlaveControl (const ATopBottom, ALeftRight: TControl);
var
  NewVersion: PSlaveInfo;
begin
  GetMem (NewVersion, SizeOf(TSlaveInfo));
  with NewVersion^ do begin
    TopBottom := ATopBottom;
    LeftRight := ALeftRight;
  end;
  SlaveInfo.Add (NewVersion);
  ArrangeControls;
end;


{ TDockableWindow - internal }

constructor TToolWindow97.Create (AOwner: TComponent);
var
  R: TRect;
begin
  inherited;
  FMinClientWidth := 32;
  FMinClientHeight := 32;
  { Initialize the client size to 32x32 }
  R := GetClientRect;
  SetBounds (Left, Top, Width - R.Right + 32, Height - R.Bottom + 32);
end;

procedure TToolWindow97.CreateParams (var Params: TCreateParams);
begin
  inherited;
  { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker
    and are not necessary for this control at run time }
  if not(csDesigning in ComponentState) then
    with Params.WindowClass do
      Style := Style and not(CS_HREDRAW or CS_VREDRAW);
end;

procedure TToolWindow97.ReadPositionData (const ReadIntProc: TPositionReadIntProc;
  const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
begin
  inherited;
  { Restore FBarWidth/FBarHeight variables }
  if Resizable then begin
    FBarWidth := ReadIntProc(Name, rvClientWidth, FBarWidth, ExtraData);
    FBarHeight := ReadIntProc(Name, rvClientHeight, FBarHeight, ExtraData);
  end;
end;

procedure TToolWindow97.WritePositionData (const WriteIntProc: TPositionWriteIntProc;
  const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer);
begin
  inherited;
  { Write values of FBarWidth/FBarHeight }
  WriteIntProc (Name, rvClientWidth, FBarWidth, ExtraData);
  WriteIntProc (Name, rvClientHeight, FBarHeight, ExtraData);
end;

procedure TToolWindow97.GetMinimumSize (var AClientWidth, AClientHeight: Integer);
begin
  AClientWidth := FMinClientWidth;
  AClientHeight := FMinClientHeight;
end;

procedure TToolWindow97.SizeChanging (const AWidth, AHeight: Integer);
begin
  FBarWidth := AWidth - (Width-ClientWidth);
  FBarHeight := AHeight - (Height-ClientHeight);
end;

procedure TToolWindow97.GetBarSize (var ASize: Integer; const DockType: TDockType);
begin
  if DockType <> dtLeftRight then
    ASize := FBarHeight
  else
    ASize := FBarWidth;
end;

procedure TToolWindow97.OrderControls (const CanMoveControls: Boolean;
  const WasDockedTo, DockingTo: TDock97; var NewClientSize: TPoint);
begin
  NewClientSize.X := FBarWidth;
  NewClientSize.Y := FBarHeight;
end;


{ TToolbarSep97 - internal }

constructor TToolbarSep97.Create (AOwner: TComponent);
begin
  inherited;
  FSizeHorz := 6;
  FSizeVert := 6;
  ControlStyle := ControlStyle - [csOpaque, csCaptureMouse];
end;

procedure TToolbarSep97.SetParent (AParent: TWinControl);
begin
  if (AParent <> nil) and not(AParent is TCustomToolbar97) then
    raise EInvalidOperation.Create(STB97SepParentNotAllowed);
  inherited;
end;

procedure TToolbarSep97.SetBlank (Value: Boolean);
begin
  if FBlank <> Value then begin
    FBlank := Value;
    Invalidate;
  end;
end;

procedure TToolbarSep97.SetSizeHorz (Value: TToolbarSepSize);
begin
  if FSizeHorz <> Value then begin
    FSizeHorz := Value;
    if Parent is TCustomToolbar97 then
      TCustomToolbar97(Parent).ArrangeControls;
  end;
end;

procedure TToolbarSep97.SetSizeVert (Value: TToolbarSepSize);
begin
  if FSizeVert <> Value then begin
    FSizeVert := Value;
    if Parent is TCustomToolbar97 then
      TCustomToolbar97(Parent).ArrangeControls;
  end;
end;

procedure TToolbarSep97.Paint;
var
  R: TRect;
  Z: Integer;
begin
  inherited;
  if not(Parent is TCustomToolbar97) then Exit;

  with Canvas do begin
    { Draw dotted border in design mode }
    if csDesigning in ComponentState then begin
      Pen.Style := psDot;
      Pen.Color := clBtnShadow;
      Brush.Style := bsClear;
      R := ClientRect;
      Rectangle (R.Left, R.Top, R.Right, R.Bottom);
      Pen.Style := psSolid;
    end;

    if not FBlank then
      if GetDockTypeOf(TCustomToolbar97(Parent).DockedTo) <> dtLeftRight then begin
        Z := Width div 2;
        Pen.Color := clBtnShadow;
        MoveTo (Z-1, 0);  LineTo (Z-1, Height);
        Pen.Color := clBtnHighlight;
        MoveTo (Z, 0);  LineTo (Z, Height);
      end
      else begin
        Z := Height div 2;
        Pen.Color := clBtnShadow;
        MoveTo (0, Z-1);  LineTo (Width, Z-1);
        Pen.Color := clBtnHighlight;
        MoveTo (0, Z);  LineTo (Width, Z);
      end;
  end;
end;

procedure TToolbarSep97.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  inherited;
  if not(Parent is TCustomToolbar97) then Exit;

  { Relay the message to the parent toolbar }
  P := Parent.ScreenToClient(ClientToScreen(Point(X, Y)));
  TCustomToolbar97(Parent).MouseDown (Button, Shift, P.X, P.Y);
end;


{ TToolbarButton97 - internal }

type
  TGlyphList = class(TImageList)
  private
    Used: TBits;
    FCount: Integer;
    function AllocateIndex: Integer;
  public
    constructor CreateSize (AWidth, AHeight: Integer);
    destructor Destroy; override; 
    function Add (Image, Mask: TBitmap): Integer;
    function AddMasked (Image: TBitmap; MaskColor: TColor): Integer;
    procedure Delete (Index: Integer);
    property Count: Integer read FCount;
  end;

  TGlyphCache = class
  private
    GlyphLists: TList;
  public
    constructor Create;
    destructor Destroy; override;
    function GetList(AWidth, AHeight: Integer): TGlyphList;
    procedure ReturnList(List: TGlyphList);
    function Empty: Boolean;
  end;

  TBoolInt = record
    B: Boolean;
    I: Integer;
  end;

  TButtonGlyph = class
  private
    FOriginal, FOriginalMask: TBitmap;
    FCallDormant: Boolean;
    FGlyphList: array[Boolean] of TGlyphList;
    FIndexs: array[Boolean, TButtonState97] of Integer;
    FTransparentColor: TColor;
    FNumGlyphs: TNumGlyphs97;
    FOnChange: TNotifyEvent;
    FOldDisabledStyle: Boolean;
    procedure GlyphChanged (Sender: TObject);
    procedure SetGlyph (Value: TBitmap);
    procedure SetGlyphMask (Value: TBitmap);
    procedure SetNumGlyphs (Value: TNumGlyphs97);
    procedure Invalidate;
    function CreateButtonGlyph (State: TButtonState97): TBoolInt;
    procedure DrawButtonGlyph (Canvas: TCanvas; const GlyphPos: TPoint;
      State: TButtonState97);
    procedure DrawButtonText (Canvas: TCanvas;
      const Caption: string; TextBounds: TRect;
      WordWrap: Boolean; State: TButtonState97);
    procedure CalcButtonLayout (Canvas: TCanvas; const Client: TRect;
      const Offset: TPoint; DrawGlyph, DrawCaption: Boolean;
      const Caption: string; WordWrap: Boolean;
      Layout: TButtonLayout; Margin, Spacing: Integer; DropArrow: Boolean;
      var GlyphPos, ArrowPos: TPoint; var TextBounds: TRect);
  public
    constructor Create;
    destructor Destroy; override;
    { returns the text rectangle }
    function Draw (Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
      DrawGlyph, DrawCaption: Boolean; const Caption: string; WordWrap: Boolean;
      Layout: TButtonLayout; Margin, Spacing: Integer; DropArrow: Boolean;
      State: TButtonState97): TRect;
    procedure DrawButtonDropArrow (Canvas: TCanvas;
      const X, Y: Integer; State: TButtonState97);
    property Glyph: TBitmap read FOriginal write SetGlyph;
    property GlyphMask: TBitmap read FOriginalMask write SetGlyphMask;
    property NumGlyphs: TNumGlyphs97 read FNumGlyphs write SetNumGlyphs;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;


{ TGlyphList }

constructor TGlyphList.CreateSize(AWidth, AHeight: Integer);
begin
  inherited CreateSize (AWidth, AHeight);
  Used := TBits.Create;
end;

destructor TGlyphList.Destroy;
begin
  Used.Free;
  inherited;
end;

function TGlyphList.AllocateIndex: Integer;
begin
  Result := Used.OpenBit;
  if Result >= Used.Size then
  begin
    Result := inherited Add(nil, nil);
    Used.Size := Result + 1;
  end;
  Used[Result] := True;
end;

function TGlyphList.Add (Image, Mask: TBitmap): Integer;
begin
  Result := AllocateIndex;
  Replace (Result, Image, Mask);
  Inc (FCount);
end;

function TGlyphList.AddMasked (Image: TBitmap; MaskColor: TColor): Integer;
  procedure BugfreeReplaceMasked (Index: Integer; NewImage: TBitmap; MaskColor: TColor);
    procedure CheckImage (Image: TGraphic);
    begin
      if Image = nil then Exit;
      if (Image.Height < Height) or (Image.Width < Width) then
        raise EInvalidOperation.Create({$IFNDEF TB97Delphi3orHigher}LoadStr{$ENDIF}(SInvalidImageSize));
    end;
  var
    TempIndex: Integer;
    Image, Mask: TBitmap;
  begin
    if HandleAllocated then begin
      CheckImage(NewImage);
      TempIndex := inherited AddMasked(NewImage, MaskColor);
      if TempIndex <> -1 then
        try
          Image := TBitmap.Create;
          Mask := TBitmap.Create;
          try
            Image.Height := Height;
            Image.Width := Width;
            Mask.Monochrome := True;
            { ^ Prevents the "invisible glyph" problem when used with certain
                color schemes. (Fixed in Delphi 3.01) }
            Mask.Height := Height;
            Mask.Width := Width;
            ImageList_Draw (Handle, TempIndex, Image.Canvas.Handle, 0, 0, ILD_NORMAL);
            ImageList_Draw (Handle, TempIndex, Mask.Canvas.Handle, 0, 0, ILD_MASK);
            if not ImageList_Replace(Handle, Index, Image.Handle, Mask.Handle) then
              raise EInvalidOperation.Create({$IFNDEF TB97Delphi3orHigher}LoadStr{$ENDIF}(SReplaceImage));
          finally
            Image.Free;
            Mask.Free;
          end;
        finally
          inherited Delete(TempIndex);
        end
      else
        raise EInvalidOperation.Create({$IFNDEF TB97Delphi3orHigher}LoadStr{$ENDIF}(SReplaceImage));
    end;
    Change;
  end;
begin
  Result := AllocateIndex;
  { This works two very serious bugs in the Delphi 2/BCB and Delphi 3
    implementations of the ReplaceMasked method. In the Delphi 2 and BCB
    versions of the ReplaceMasked method, it incorrectly uses ILD_NORMAL as
    the last parameter for the second ImageList_Draw call, in effect causing
    all white colors to be considered transparent also. And in the Delphi 2/3
    and BCB versions it doesn't set Monochrome to True on the Mask bitmap,
    causing the bitmaps to be invisible on certain color schemes. }
  BugfreeReplaceMasked (Result, Image, MaskColor);
  Inc (FCount);
end;

procedure TGlyphList.Delete (Index: Integer);
begin
  if Used[Index] then begin
    Dec(FCount);
    Used[Index] := False;
  end;
end;

{ TGlyphCache }

constructor TGlyphCache.Create;
begin
  inherited;
  GlyphLists := TList.Create;
end;

destructor TGlyphCache.Destroy;
begin
  GlyphLists.Free;
  inherited;
end;

function TGlyphCache.GetList(AWidth, AHeight: Integer): TGlyphList;
var
  I: Integer;
begin
  for I := GlyphLists.Count - 1 downto 0 do begin
    Result := GlyphLists[I];
    with Result do
      if (AWidth = Width) and (AHeight = Height) then Exit;
  end;
  Result := TGlyphList.CreateSize(AWidth, AHeight);
  GlyphLists.Add(Result);
end;

procedure TGlyphCache.ReturnList(List: TGlyphList);
begin
  if List = nil then Exit;
  if List.Count = 0 then begin
    GlyphLists.Remove(List);
    List.Free;
  end;
end;

function TGlyphCache.Empty: Boolean;
begin
  Result := GlyphLists.Count = 0;
end;

var
  GlyphCache: TGlyphCache = nil;
  Pattern: TBitmap = nil;
  PatternBtnFace, PatternBtnHighlight: TColor;
  ButtonCount: Integer = 0;

procedure CreateBrushPattern;
var
  X, Y: Integer;
begin
  PatternBtnFace := GetSysColor(COLOR_BTNFACE);
  PatternBtnHighlight := GetSysColor(COLOR_BTNHIGHLIGHT);
  Pattern := TBitmap.Create;
  with Pattern do begin
    Width := 8;
    Height := 8;
    with Canvas do begin
      Brush.Style := bsSolid;
      Brush.Color := clBtnFace;
      FillRect (Rect(0, 0, Width, Height));
      for Y := 0 to 7 do
        for X := 0 to 7 do
          if Odd(Y) = Odd(X) then  { toggles between even/odd pixels }
            Pixels[X, Y] := clBtnHighlight;     { on even/odd rows }
    end;
  end;
end;


{ TButtonGlyph }

constructor TButtonGlyph.Create;
var
  B: Boolean;
  I: TButtonState97;
begin
  inherited;
  FCallDormant := True;
  FOriginal := TBitmap.Create;
  FOriginal.OnChange := GlyphChanged;
  FOriginalMask := TBitmap.Create;
  FOriginalMask.OnChange := GlyphChanged;
  FNumGlyphs := 1;
  for B := False to True do
    for I := Low(I) to High(I) do
      FIndexs[B, I] := -1;
  if GlyphCache = nil then
    GlyphCache := TGlyphCache.Create;
end;

destructor TButtonGlyph.Destroy;
begin
  FOriginalMask.Free;
  FOriginal.Free;
  Invalidate;
  if Assigned(GlyphCache) and GlyphCache.Empty then begin
    GlyphCache.Free;
    GlyphCache := nil;
  end;
  inherited;
end;

procedure TButtonGlyph.Invalidate;
var
  B: Boolean;
  I: TButtonState97;
begin
  for B := False to True do begin
    for I := Low(I) to High(I) do begin
      if FIndexs[B, I] <> -1 then FGlyphList[B].Delete (FIndexs[B, I]);
      FIndexs[B, I] := -1;
    end;
    GlyphCache.ReturnList (FGlyphList[B]);
    FGlyphList[B] := nil;
  end;
end;

procedure TButtonGlyph.GlyphChanged (Sender: TObject);
begin
  if (Sender = FOriginal) or (Sender = FOriginalMask) then begin
    if (FOriginal.Width <> 0) and (FOriginal.Height <> 0) then
      FTransparentColor := FOriginal.Canvas.Pixels[0, FOriginal.Height-1] or $02000000;
    Invalidate;
    if Assigned(FOnChange) then FOnChange (Self);
  end;
end;

procedure TButtonGlyph.SetGlyph (Value: TBitmap);
var
  Glyphs: Integer;
begin
  Invalidate;
  FOriginal.Assign (Value);
  if (Value <> nil) and (Value.Height <> 0) then begin
    if Value.Width mod Value.Height = 0 then begin
      Glyphs := Value.Width div Value.Height;
      if Glyphs > High(TNumGlyphs97) then Glyphs := 1;
      SetNumGlyphs (Glyphs);
    end;
  end;
end;

procedure TButtonGlyph.SetGlyphMask (Value: TBitmap);
begin
  Invalidate;
  FOriginalMask.Assign (Value);
end;

procedure TButtonGlyph.SetNumGlyphs (Value: TNumGlyphs97);
begin
  Invalidate;
  FNumGlyphs := Value;
  GlyphChanged (Glyph);
end;

function TButtonGlyph.CreateButtonGlyph (State: TButtonState97): TBoolInt;
const
  ROP_DSPDxax = $00E20746;
  ROP_PSDPxax = $00B8074A;
  ROP_DSna = $00220326;  { D & ~S }

  procedure GenerateMaskBitmapFromDIB (const MaskBitmap, SourceBitmap: TBitmap;
    const SourceOffset, SourceSize: TPoint; TransColors: array of TColor);
  { This a special procedure meant for generating monochrome masks from
    >4 bpp color DIB sections. Because each video driver seems to sport its own
    interpretation of how to handle DIB sections, a workaround procedure like
    this was necessary. }
  type
    TColorArray = array[0..536870910] of TColorRef;
  var
    Info: packed record
      Header: TBitmapInfoHeader;
      Colors: array[0..1] of TColorRef;
    end;
    W, H: Integer;
    I, Y, X: Integer;
    Pixels: ^TColorArray;
    Pixel: ^TColorRef;
    MonoPixels: Pointer;
    MonoPixel, StartMonoPixel: ^Byte;
    MonoScanLineSize, CurBit: Integer;
    DC: HDC;
    MaskBmp: HBITMAP;
  begin
    W := SourceBitmap.Width;
    H := SourceBitmap.Height;
    MonoScanLineSize := SourceSize.X div 8;
    if MonoScanLineSize mod 4 <> 0 then  { Compensate for scan line boundary }
      Inc (MonoScanLineSize, 4 - (MonoScanLineSize mod 4));
    MonoPixels := AllocMem(MonoScanLineSize * SourceSize.Y);  { AllocMem is used because it initializes to zero }
    try
      GetMem (Pixels, W * H * 4);
      try
        FillChar (Info, SizeOf(Info), 0);
        with Info do begin
          with Header do begin
            biSize := SizeOf(TBitmapInfoHeader);
            biWidth := W;
            biHeight := -H;  { negative number makes it a top-down DIB }
            biPlanes := 1;
            biBitCount := 32;
            {biCompression := BI_RGB;}  { implied due to the FillChar zeroing }
          end;
          {Colors[0] := clBlack;}  { implied due to the FillChar zeroing }
          Colors[1] := clWhite;
        end;
        DC := CreateCompatibleDC(0);
        GetDIBits (DC, SourceBitmap.Handle, 0, H, Pixels, PBitmapInfo(@Info)^,
          DIB_RGB_COLORS);
        DeleteDC (DC);

        for I := 0 to High(TransColors) do
          if TransColors[I] = -1 then
            TransColors[I] := Pixels[W * (H-1)] and $FFFFFF;
              { ^ 'and' operation is necessary because the high byte is undefined }

        MonoPixel := MonoPixels;
        for Y := SourceOffset.Y to SourceOffset.Y+SourceSize.Y-1 do begin
          StartMonoPixel := MonoPixel;
          CurBit := 7;
          Pixel := @Pixels[(Y * W) + SourceOffset.X];
          for X := 0 to SourceSize.X-1 do begin
            for I := 0 to High(TransColors) do
              if Pixel^ and $FFFFFF = Cardinal(TransColors[I]) then begin
                { ^ 'and' operation is necessary because the high byte is undefined }
                MonoPixel^ := MonoPixel^ or (1 shl CurBit);
                Break;
              end;
            Dec (CurBit);
            if CurBit < 0 then begin
              Inc (Integer(MonoPixel));
              CurBit := 7;
            end;
            Inc (Integer(Pixel), SizeOf(Longint));  { proceed to the next pixel }
          end;
          Integer(MonoPixel) := Integer(StartMonoPixel) + MonoScanLineSize;
        end;
      finally
        FreeMem (Pixels);
      end;

      { Write new bits into a new HBITMAP, and assign this handle to MaskBitmap }
      MaskBmp := CreateBitmap(SourceSize.X, SourceSize.Y, 1, 1, nil);
      with Info.Header do begin
        biWidth := SourceSize.X;
        biHeight := -SourceSize.Y;  { negative number makes it a top-down DIB }
        biPlanes := 1;
        biBitCount := 1;
      end;
      DC := CreateCompatibleDC(0);
      SetDIBits (DC, MaskBmp, 0, SourceSize.Y, MonoPixels, PBitmapInfo(@Info)^,
        DIB_RGB_COLORS);
      DeleteDC (DC);
    finally
      FreeMem (MonoPixels);
    end;

    MaskBitmap.Handle := MaskBmp;
  end;
  procedure GenerateMaskBitmap (const MaskBitmap, SourceBitmap: TBitmap;
    const SourceOffset, SourceSize: TPoint; const TransColors: array of TColor);
  { Returns handle of a monochrome bitmap, with pixels in SourceBitmap of color
    TransColor set to white in the resulting bitmap. All other colors of
    SourceBitmap are set to black in the resulting bitmap. This uses the
    regular ROP_DSPDxax BitBlt method. }
  var
    CanvasHandle: HDC;
    SaveBkColor: TColorRef;
    DC: HDC;
    MaskBmp, SaveBmp: HBITMAP;
    I: Integer;
  const
    ROP: array[Boolean] of DWORD = (SRCPAINT, SRCCOPY);
  begin
    CanvasHandle := SourceBitmap.Canvas.Handle;

    MaskBmp := CreateBitmap(SourceSize.X, SourceSize.Y, 1, 1, nil);
    DC := CreateCompatibleDC(0);
    SaveBmp := SelectObject(DC, MaskBmp);
    SaveBkColor := GetBkColor(CanvasHandle);
    for I := 0 to High(TransColors) do begin
      SetBkColor (CanvasHandle, ColorToRGB(TransColors[I]));
      BitBlt (DC, 0, 0, SourceSize.X, SourceSize.Y, CanvasHandle,
        SourceOffset.X, SourceOffset.Y, ROP[I = 0]);
    end;
    SetBkColor (CanvasHandle, SaveBkColor);
    SelectObject (DC, SaveBmp);
    DeleteDC (DC);

    MaskBitmap.Handle := MaskBmp;
  end;
  procedure ReplaceBitmapColorsFromMask (const MaskBitmap, DestBitmap: TBitmap;
    const DestOffset, DestSize: TPoint; const ReplaceColor: TColor);
  var
    DestDC: HDC;
    SaveBrush: HBRUSH;
    SaveTextColor, SaveBkColor: TColorRef;
  begin
    DestDC := DestBitmap.Canvas.Handle;

    SaveBrush := SelectObject(DestDC, CreateSolidBrush(ColorToRGB(ReplaceColor)));
    SaveTextColor := SetTextColor(DestDC, clBlack);
    SaveBkColor := SetBkColor(DestDC, clWhite);
    BitBlt (DestDC, DestOffset.X, DestOffset.Y, DestSize.X, DestSize.Y,
      MaskBitmap.Canvas.Handle, 0, 0, ROP_DSPDxax);
    SetBkColor (DestDC, SaveBkColor);
    SetTextColor (DestDC, SaveTextColor);
    DeleteObject (SelectObject(DestDC, SaveBrush));
  end;
  function CopyBitmapToDDB (const SourceBitmap: TBitmap): TBitmap;
  { Makes a device-dependent duplicate of SourceBitmap. The color palette,
    if any, is preserved. }
  var
    SB: HBITMAP;
    SavePalette: HPALETTE;
    DC: HDC;
    BitmapInfo: packed record
      Header: TBitmapInfoHeader;
      Colors: array[0..255] of TColorRef;
    end;
    Bits: Pointer;
  begin
    Result := TBitmap.Create;
    try
      Result.Palette := CopyPalette(SourceBitmap.Palette);
      Result.Width := SourceBitmap.Width;
      Result.Height := SourceBitmap.Height;
      SB := SourceBitmap.Handle;
      if SB = 0 then Exit;  { it would have a null handle if its width or height was zero }
      SavePalette := 0;
      DC := CreateCompatibleDC(0);
      try
        if Result.Palette <> 0 then begin
          SavePalette := SelectPalette(DC, Result.Palette, False);
          RealizePalette (DC);
        end;
        BitmapInfo.Header.biSize := SizeOf(TBitmapInfoHeader);
        BitmapInfo.Header.biBitCount := 0;  { instructs GetDIBits not to fill in the color table }
        { First retrieve the BitmapInfo header only }
        if GetDIBits(DC, SB, 0, 0, nil, PBitmapInfo(@BitmapInfo)^, DIB_RGB_COLORS) <> 0 then begin
          GetMem (Bits, BitmapInfo.Header.biSizeImage);
          try
            { Then read the actual bits }
            if GetDIBits(DC, SB, 0, SourceBitmap.Height, Bits, PBitmapInfo(@BitmapInfo)^, DIB_RGB_COLORS) <> 0 then
              { And copy them to the resulting bitmap }
              SetDIBits (DC, Result.Handle, 0, SourceBitmap.Height, Bits, PBitmapInfo(@BitmapInfo)^, DIB_RGB_COLORS);
          finally
            FreeMem (Bits);
          end;
        end;
      finally
        if SavePalette <> 0 then SelectPalette (DC, SavePalette, False);
        DeleteDC (DC);
      end;
    except
      Result.Free;
      raise;
    end;
  end;
const
  ROPs: array[Boolean] of DWORD = (ROP_PSDPxax, ROP_DSPDxax);
var
  TmpImage, DDB, MonoBmp: TBitmap;
  I: TButtonState97;
  B: Boolean;
  AddPixels, IWidth, IHeight, IWidthA, IHeightA: Integer;
  IRect, IRectA, SourceRect, R: TRect;
  DC: HDC;
  UsesMask: Boolean;
{$IFDEF TB97Delphi3orHigher}
  IsHighColorDIB: Boolean;
{$ELSE}
const
  IsHighColorDIB = False;
{$ENDIF}
begin
  if (State <> bsDisabled) and (Ord(State) >= NumGlyphs) then
    State := bsUp;
  Result.B := True;
  Result.I := FIndexs[True, State];
  if Result.I = -1 then begin
    Result.B := False;
    Result.I := FIndexs[False, State];
  end;
  if Result.I <> -1 then Exit;
  if (FOriginal.Width or FOriginal.Height) = 0 then Exit;
  UsesMask := (FOriginalMask.Width <> 0) and (FOriginalMask.Height <> 0);
  B := State <> bsDisabled;
  { + AddPixels is to make sure the highlight color on generated disabled glyphs
    doesn't get cut off }
  AddPixels := Ord(State = bsDisabled);
  IWidth := FOriginal.Width div FNumGlyphs + AddPixels;
  IHeight := FOriginal.Height + AddPixels;
  IRect := Rect(0, 0, IWidth, IHeight);
  IWidthA := IWidth - AddPixels;
  IHeightA := IHeight - AddPixels;
  IRectA := Rect(0, 0, IWidthA, IHeightA);
  if FGlyphList[B] = nil then begin
    if GlyphCache = nil then
      GlyphCache := TGlyphCache.Create;
    FGlyphList[B] := GlyphCache.GetList(IWidth, IHeight);
  end;
  {$IFDEF TB97Delphi3orHigher}
  IsHighColorDIB := FOriginal.PixelFormat > pf4bit;
  {$ENDIF}
  TmpImage := TBitmap.Create;
  try
    TmpImage.Width := IWidth;
    TmpImage.Height := IHeight;
    TmpImage.Canvas.Brush.Color := clBtnFace;
    TmpImage.Palette := CopyPalette(FOriginal.Palette);
    I := State;
    if Ord(I) >= NumGlyphs then I := bsUp;
    SourceRect := Bounds(Ord(I) * IWidthA, 0, IWidthA, IHeightA);
    if State <> bsDisabled then begin
      TmpImage.Canvas.CopyRect (IRectA, FOriginal.Canvas, SourceRect);
      if not UsesMask then begin
        {$IFDEF TB97Delphi3orHigher}
        { Use clDefault instead of FTransparentColor whereever possible to
          ensure compatibility with all video drivers when using high-color
          (> 4 bpp) DIB glyphs }
        FIndexs[B, State] := FGlyphList[B].AddMasked(TmpImage, clDefault);
        {$ELSE}
        FIndexs[B, State] := FGlyphList[B].AddMasked(TmpImage, FTransparentColor);
        {$ENDIF}
      end
      else begin
        MonoBmp := TBitmap.Create;
        try
          MonoBmp.Monochrome := True;
          MonoBmp.Width := IWidth;
          MonoBmp.Height := IHeight;
          MonoBmp.Canvas.CopyRect (IRectA, FOriginalMask.Canvas, SourceRect);
          FIndexs[B, State] := FGlyphList[B].Add(TmpImage, MonoBmp);
        finally
          MonoBmp.Free;
        end;
      end;
    end
    else begin
      MonoBmp := TBitmap.Create;
      try
        { Uses the CopyBitmapToDDB to work around a Delphi 3 flaw. If you copy
          a DIB to a second bitmap via Assign, change the HandleType of the
          second bitmap to bmDDB, then try to read the Handle property, Delphi
          converts it back to a DIB. }
        DDB := CopyBitmapToDDB(FOriginal);
        try
          if NumGlyphs > 1 then
            with TmpImage.Canvas do begin
              CopyRect (IRectA, DDB.Canvas, SourceRect);

              { Convert white to clBtnHighlight }
              if not IsHighColorDIB then
                GenerateMaskBitmap (MonoBmp, DDB, SourceRect.TopLeft,
                  IRectA.BottomRight, [GetNearestColor(FOriginal.Canvas.Handle, clWhite)])
              else
                GenerateMaskBitmapFromDIB (MonoBmp, FOriginal, SourceRect.TopLeft,
                  IRectA.BottomRight, [clWhite]);
              ReplaceBitmapColorsFromMask (MonoBmp, TmpImage, IRectA.TopLeft,
                IRectA.BottomRight, clBtnHighlight);

              { Convert gray to clBtnShadow }
              if not IsHighColorDIB then
                GenerateMaskBitmap (MonoBmp, DDB, SourceRect.TopLeft,
                  IRectA.BottomRight, [GetNearestColor(FOriginal.Canvas.Handle, clGray)])
              else
                GenerateMaskBitmapFromDIB (MonoBmp, FOriginal, SourceRect.TopLeft,
                  IRectA.BottomRight, [clGray]);
              ReplaceBitmapColorsFromMask (MonoBmp, TmpImage, IRectA.TopLeft,
                IRectA.BottomRight, clBtnShadow);

              if not UsesMask then begin
                { Generate the transparent mask in MonoBmp. The reason why
                  it doesn't just use a mask color is because the mask needs
                  to be of the glyph -before- the clBtnHighlight/Shadow were
                  translated }
                if not IsHighColorDIB then
                  GenerateMaskBitmap (MonoBmp, DDB,
                    SourceRect.TopLeft, IRectA.BottomRight, FTransparentColor)
                else
                  GenerateMaskBitmapFromDIB (MonoBmp, FOriginal,
                    SourceRect.TopLeft, IRectA.BottomRight, [-1]);
              end
              else
                MonoBmp.Canvas.CopyRect (IRectA, FOriginalMask.Canvas, SourceRect);
              with MonoBmp do begin
                Width := Width + AddPixels;
                Height := Height + AddPixels;
                { Set the additional bottom and right row on disabled glyph
                  masks to white so that it always shines through, since the
                  bottom and right row on TmpImage was left uninitialized }
                Canvas.Pen.Color := clWhite;
                Canvas.PolyLine ([Point(0, Height-1), Point(Width-1, Height-1),
                  Point(Width-1, -1)]);
              end;

              FIndexs[B, State] := FGlyphList[B].Add(TmpImage, MonoBmp);
            end
          else begin
            { Create a disabled version }
            if FOldDisabledStyle then begin
              { "Old" TSpeedButton style }
              if not UsesMask then begin
                if IsHighColorDIB then
                  GenerateMaskBitmapFromDIB (MonoBmp, FOriginal,
                    SourceRect.TopLeft, IRectA.BottomRight, [clBlack])
                else begin
                  with MonoBmp do begin
                    Assign (DDB);  { must be a DDB for this to work right }
                    Canvas.Brush.Color := clBlack;
                    Monochrome := True;
                  end;
                end;
              end
              else begin
                MonoBmp.Assign (DDB);  { must be a DDB for this to work right }
                with TBitmap.Create do
                  try
                    Monochrome := True;
                    Width := FOriginalMask.Width;
                    Height := FOriginalMask.Height;
                    R := Rect(0, 0, Width, Height);
                    Canvas.CopyRect (R, FOriginalMask.Canvas, R);
                    DC := Canvas.Handle;
                    with MonoBmp.Canvas do begin
                      BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC,
                        SourceRect.Left, SourceRect.Top, ROP_DSna);
                      BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC,
                        SourceRect.Left, SourceRect.Top, SRCPAINT);
                    end;
                  finally
                    Free;
                  end;
                MonoBmp.Canvas.Brush.Color := clBlack;
                MonoBmp.Monochrome := True;
              end;
            end
            else begin
              { The new Office 97 / MFC look }
              if not UsesMask then begin
                with TmpImage.Canvas do begin
                  if not IsHighColorDIB then
                    GenerateMaskBitmap (MonoBmp, DDB, IRectA.TopLeft,
                      IRectA.BottomRight, [FTransparentColor, clWhite, clSilver])
                  else
                    GenerateMaskBitmapFromDIB (MonoBmp, FOriginal,
                      SourceRect.TopLeft, IRectA.BottomRight, [-1, clWhite, clSilver]);
                end;
              end
              else begin
                { Generate the mask in MonoBmp. Make clWhite and clSilver transparent. }
                if not IsHighColorDIB then
                  GenerateMaskBitmap (MonoBmp, DDB, SourceRect.TopLeft,
                    IRectA.BottomRight, [clWhite, clSilver])
                else
                  GenerateMaskBitmapFromDIB (MonoBmp, FOriginal, SourceRect.TopLeft,
                    IRectA.BottomRight, [clWhite, clSilver]);
                { and all the white colors in FOriginalMask }
                with TBitmap.Create do
                  try
                    Monochrome := True;
                    Width := FOriginalMask.Width;
                    Height := FOriginalMask.Height;
                    R := Rect(0, 0, Width, Height);
                    Canvas.CopyRect (R, FOriginalMask.Canvas, R);
                    DC := Canvas.Handle;
                    with MonoBmp.Canvas do begin
                      BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC,
                        SourceRect.Left, SourceRect.Top, ROP_DSna);
                      BitBlt (Handle, 0, 0, IWidthA, IHeightA, DC,
                        SourceRect.Left, SourceRect.Top, SRCPAINT);
                    end;
                  finally
                    Free;
                  end;
              end;
            end;

            with TmpImage.Canvas do begin
              Brush.Color := clBtnFace;
              FillRect (IRect);
              Brush.Color := clBtnHighlight;
              DC := Handle;
              SetTextColor (DC, clBlack);
              SetBkColor (DC, clWhite);
              BitBlt (DC, 1, 1, IWidthA, IHeightA,
                MonoBmp.Canvas.Handle, 0, 0, ROPs[FOldDisabledStyle]);
              Brush.Color := clBtnShadow;
              DC := Handle;
              SetTextColor (DC, clBlack);
              SetBkColor (DC, clWhite);
              BitBlt (DC, 0, 0, IWidthA, IHeightA,
                MonoBmp.Canvas.Handle, 0, 0, ROPs[FOldDisabledStyle]);
            end;

            FIndexs[B, State] := FGlyphList[B].AddMasked(TmpImage, clBtnFace);
          end;
        finally
          DDB.Free;
        end;
      finally
        MonoBmp.Free;
      end;
    end;
  finally
    TmpImage.Free;
  end;
  Result.B := B;
  Result.I := FIndexs[B, State];
  { Note: Due to a bug in graphics.pas, Delphi 2's VCL crashes if Dormant is
    called on an empty bitmap, so to prevent this it must check Handle first }
  if {$IFNDEF TB97Delphi3orHigher} (FOriginal.Handle <> 0) and {$ENDIF}
     FCallDormant then
    FOriginal.Dormant;
  {$IFNDEF TB97Delphi3orHigher} if FOriginalMask.Handle <> 0 then {$ENDIF}
    FOriginalMask.Dormant;
end;

procedure TButtonGlyph.DrawButtonGlyph (Canvas: TCanvas; const GlyphPos: TPoint;
  State: TButtonState97);
var
  Index: TBoolInt;
begin
  if (FOriginal = nil) or (FOriginal.Width = 0) or (FOriginal.Height = 0) then
    Exit;
  Index := CreateButtonGlyph(State);
  ImageList_DrawEx (FGlyphList[Index.B].Handle, Index.I, Canvas.Handle,
    GlyphPos.X, GlyphPos.Y, 0, 0, CLR_NONE, CLR_NONE, ILD_TRANSPARENT);
end;

procedure TButtonGlyph.DrawButtonText (Canvas: TCanvas; const Caption: string;
  TextBounds: TRect; WordWrap: Boolean; State: TButtonState97);
var
  Format: UINT;
begin
  Format := DT_CENTER or DT_VCENTER;
  if not WordWrap then
    Format := Format or DT_SINGLELINE
  else
    Format := Format or DT_WORDBREAK;
  with Canvas do begin
    Brush.Style := bsClear;
    if State = bsDisabled then begin
      OffsetRect (TextBounds, 1, 1);
      Font.Color := clBtnHighlight;
      DrawText (Handle, PChar(Caption), Length(Caption), TextBounds, Format);
      OffsetRect (TextBounds, -1, -1);
      Font.Color := clBtnShadow;
      DrawText (Handle, PChar(Caption), Length(Caption), TextBounds, Format);
    end
    else
      DrawText (Handle, PChar(Caption), Length(Caption), TextBounds, Format);
  end;
end;

procedure TButtonGlyph.DrawButtonDropArrow (Canvas: TCanvas;
  const X, Y: Integer; State: TButtonState97);
begin
  with Canvas do begin
    if State = bsDisabled then begin
      Pen.Color := clBtnHighlight;
      Brush.Color := clBtnHighlight;
      Polygon ([Point(X+5, Y+1), Point(X+9, Y+1), Point(X+7, Y+3)]);
      Pen.Color := clBtnShadow;
      Brush.Color := clBtnShadow;
      Polygon ([Point(X+4, Y), Point(X+8, Y), Point(X+6, Y+2)]);
    end
    else begin
      Pen.Color := Font.Color;
      Brush.Color := Font.Color;
      Polygon ([Point(X+4, Y), Point(X+8, Y), Point(X+6, Y+2)]);
    end;
  end;
end;

procedure TButtonGlyph.CalcButtonLayout (Canvas: TCanvas; const Client: TRect;
  const Offset: TPoint; DrawGlyph, DrawCaption: Boolean; const Caption: string;
  WordWrap: Boolean; Layout: TButtonLayout; Margin, Spacing: Integer;
  DropArrow: Boolean; var GlyphPos, ArrowPos: TPoint; var TextBounds: TRect);
var
  TextPos: TPoint;
  ClientSize, GlyphSize, TextSize, ArrowSize: TPoint;
  TotalSize: TPoint;
  Format: UINT;
  Margin1, Spacing1: Integer;
  LayoutLeftOrRight: Boolean;
begin
  { calculate the item sizes }
  ClientSize := Point(Client.Right-Client.Left, Client.Bottom-Client.Top);

  if DrawGlyph and (FOriginal <> nil) then
    GlyphSize := Point(FOriginal.Width div FNumGlyphs, FOriginal.Height)
  else
    GlyphSize := Point(0, 0);

  if DropArrow then
    ArrowSize := Point(9, 3)
  else
    ArrowSize := Point(0, 0);

  LayoutLeftOrRight := Layout in [blGlyphLeft, blGlyphRight];
  if not LayoutLeftOrRight and ((GlyphSize.X = 0) or (GlyphSize.Y = 0)) then begin
    Layout := blGlyphLeft;
    LayoutLeftOrRight := True;
  end;

  if DrawCaption and (Caption <> '') then begin
    TextBounds := Rect(0, 0, Client.Right-Client.Left, 0);
    if LayoutLeftOrRight then
      Dec (TextBounds.Right, ArrowSize.X);
    Format := DT_CALCRECT;
    if WordWrap then begin
      Format := Format or DT_WORDBREAK;
      Margin1 := 4;
      if LayoutLeftOrRight and (GlyphSize.X <> 0) and (GlyphSize.Y <> 0) then begin
        if Spacing = -1 then
          Spacing1 := 4
        else
          Spacing1 := Spacing;
        Dec (TextBounds.Right, GlyphSize.X + Spacing1);
        if Margin <> -1 then
          Margin1 := Margin
        else
        if Spacing <> -1 then
          Margin1 := Spacing;
      end;
      Dec (TextBounds.Right, Margin1 * 2);
    end;
    DrawText (Canvas.Handle, PChar(Caption), Length(Caption), TextBounds, Format);
    TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
      TextBounds.Top);
  end
  else begin
    TextBounds := Rect(0, 0, 0, 0);
    TextSize := Point(0,0);
  end;

  { If the layout has the glyph on the right or the left, then both the
    text and the glyph are centered vertically.  If the glyph is on the top
    or the bottom, then both the text and the glyph are centered horizontally.}
  if LayoutLeftOrRight then begin
    GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
    TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
  end
  else begin
    GlyphPos.X := (ClientSize.X - GlyphSize.X - ArrowSize.X + 1) div 2;
    TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
    if (GlyphSize.X = 0) or (GlyphSize.Y = 0) then
      ArrowPos.X := TextPos.X + TextSize.X
    else
      ArrowPos.X := GlyphPos.X + GlyphSize.X;
  end;

  { if there is no text or no bitmap, then Spacing is irrelevant }
  if (TextSize.X = 0) or (TextSize.Y = 0) or
     (GlyphSize.X = 0) or (GlyphSize.Y = 0) then
    Spacing := 0;

  { adjust Margin and Spacing }
  if Margin = -1 then begin
    if Spacing = -1 then begin
      TotalSize := Point(GlyphSize.X + TextSize.X + ArrowSize.X,
        GlyphSize.Y + TextSize.Y);
      if LayoutLeftOrRight then
        Margin := (ClientSize.X - TotalSize.X) div 3
      else
        Margin := (ClientSize.Y - TotalSize.Y) div 3;
      Spacing := Margin;
    end
    else begin
      TotalSize := Point(GlyphSize.X + Spacing + TextSize.X + ArrowSize.X,
        GlyphSize.Y + Spacing + TextSize.Y);
      if LayoutLeftOrRight then
        Margin := (ClientSize.X - TotalSize.X + 1) div 2
      else
        Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
    end;
  end
  else begin
    if Spacing = -1 then begin
      TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X + ArrowSize.X),
        ClientSize.Y - (Margin + GlyphSize.Y));
      if LayoutLeftOrRight then
        Spacing := (TotalSize.X - TextSize.X) div 2
      else
        Spacing := (TotalSize.Y - TextSize.Y) div 2;
    end;
  end;

  case Layout of
    blGlyphLeft: begin
        GlyphPos.X := Margin;
        TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
        ArrowPos.X := TextPos.X + TextSize.X;
      end;
    blGlyphRight: begin
        ArrowPos.X := ClientSize.X - Margin - ArrowSize.X;
        GlyphPos.X := ArrowPos.X - GlyphSize.X;
        TextPos.X := GlyphPos.X - Spacing - TextSize.X;
      end;
    blGlyphTop: begin
        GlyphPos.Y := Margin;
        TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
      end;
    blGlyphBottom: begin
        GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
        TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
      end;
  end;
  if (GlyphSize.X = 0) or (GlyphSize.Y = 0) then
    ArrowPos.Y := TextPos.Y + (TextSize.Y - ArrowSize.Y) div 2
  else
    ArrowPos.Y := GlyphPos.Y + (GlyphSize.Y - ArrowSize.Y) div 2;

  { fixup the result variables }
  with GlyphPos do begin
    Inc (X, Client.Left + Offset.X);
    Inc (Y, Client.Top + Offset.Y);
  end;
  with ArrowPos do begin
    Inc (X, Client.Left + Offset.X);
    Inc (Y, Client.Top + Offset.Y);
  end;
  OffsetRect (TextBounds, TextPos.X + Client.Left + Offset.X,
    TextPos.Y + Client.Top + Offset.X);
end;

function TButtonGlyph.Draw (Canvas: TCanvas; const Client: TRect;
  const Offset: TPoint; DrawGlyph, DrawCaption: Boolean; const Caption: string;
  WordWrap: Boolean; Layout: TButtonLayout; Margin, Spacing: Integer;
  DropArrow: Boolean; State: TButtonState97): TRect;
var
  GlyphPos, ArrowPos: TPoint;
begin
  CalcButtonLayout (Canvas, Client, Offset, DrawGlyph, DrawCaption, Caption,
    WordWrap, Layout, Margin, Spacing, DropArrow, GlyphPos, ArrowPos, Result);
  if DrawGlyph then
    DrawButtonGlyph (Canvas, GlyphPos, State);
  if DrawCaption then
    DrawButtonText (Canvas, Caption, Result, WordWrap, State);
  if DropArrow then
    DrawButtonDropArrow (Canvas, ArrowPos.X, ArrowPos.Y, State);
end;


{ TDropdownList }

type
  TDropdownList = class(TComponent)
  private
    List: TList;
    Window: HWND;
    procedure WndProc (var Message: TMessage);
  protected
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AddMenu (Menu: TPopupMenu);
  end;
var
  DropdownList: TDropdownList;

constructor TDropdownList.Create (AOwner: TComponent);
begin
  inherited;
  List := TList.Create;
end;

destructor TDropdownList.Destroy;
begin
  List.Free;
  inherited;
end;

procedure TDropdownList.WndProc (var Message: TMessage);
{ This procedure is based on code from TPopupList.WndProc (menus.pas) }
var
  I: Integer;
  MenuItem: TMenuItem;
  FindKind: TFindItemKind;
  ContextID: Integer;
begin
  try
    with List do
      case Message.Msg of
        WM_COMMAND:
          for I := 0 to Count-1 do
            if TPopupMenu(Items[I]).DispatchCommand(TWMCommand(Message).ItemID) then
              Exit;
        WM_INITMENUPOPUP:
          for I := 0 to Count-1 do
            if TPopupMenu(Items[I]).DispatchPopup(TWMInitMenuPopup(Message).MenuPopup) then
              Exit;
        WM_MENUSELECT:
          with TWMMenuSelect(Message) do begin
            FindKind := fkCommand;
            if MenuFlag and MF_POPUP <> 0 then
              FindKind := fkHandle;
            for I := 0 to Count-1 do begin
              MenuItem := TPopupMenu(Items[I]).FindItem(IDItem, FindKind);
              if MenuItem <> nil then begin
                Application.Hint := MenuItem.Hint;
                Exit;
              end;
            end;
            Application.Hint := '';
          end;
        WM_HELP:
          with TWMHelp(Message).HelpInfo^ do begin
            for I := 0 to Count-1 do
              if TPopupMenu(Items[I]).Handle = hItemHandle then begin
                ContextID := TPopupMenu(Items[I]).GetHelpContext(iCtrlID, True);
                if ContextID = 0 then
                  ContextID := TPopupMenu(Items[I]).GetHelpContext(hItemHandle, False);
                if Screen.ActiveForm = nil then Exit;
                if (biHelp in Screen.ActiveForm.BorderIcons) then
                  Application.HelpCommand (HELP_CONTEXTPOPUP, ContextID)
                else
                  Application.HelpContext (ContextID);
                Exit;
              end;
          end;
      end;
    with Message do
      Result := DefWindowProc(Window, Msg, wParam, lParam);
  except
    Application.HandleException (Self);
  end;
end;

procedure TDropdownList.AddMenu (Menu: TPopupMenu);
begin
  if List.IndexOf(Menu) = -1 then begin
    if List.Count = 0 then
      Window := AllocateHWnd(WndProc);
    Menu.FreeNotification (DropdownList);
    List.Add (Menu);
  end;
end;

procedure TDropdownList.Notification (AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then begin
    List.Remove (AComponent);
    if List.Count = 0 then
      DeallocateHWnd (Window);
  end;
end;


{ TToolbarButton97 }

constructor TToolbarButton97.Create (AOwner: TComponent);
begin
  inherited;

  if not(csDesigning in ComponentState) then begin
    if ButtonHookRefCount = 0 then
      Application.HookMainWindow (TToolbarButton97.DeactivateHook);
    Inc (ButtonHookRefCount);
    FHooked := True;
  end;

  SetBounds (Left, Top, 23, 22);
  ControlStyle := [csCaptureMouse, csDoubleClicks, csOpaque];
  FGlyph := TButtonGlyph.Create;
  TButtonGlyph(FGlyph).OnChange := GlyphChanged;
  ParentFont := True;
  FFlat := True;
  FOpaque := True;
  FSpacing := 4;
  FMargin := -1;
  FLayout := blGlyphLeft;
  FDropdownArrow := True;
  FRepeatDelay := 400;
  FRepeatInterval := 100;
  Inc (ButtonCount);
end;

destructor TToolbarButton97.Destroy;
begin
  if ButtonMouseInControl = Self then begin
    ButtonMouseTimer.Enabled := False;
    ButtonMouseInControl := nil;
  end;
  TButtonGlyph(FGlyph).Free;
  Dec (ButtonCount);
  if ButtonCount = 0 then begin
    Pattern.Free;
    Pattern := nil;
  end;
  if FHooked then begin
    Dec (ButtonHookRefCount);
    if ButtonHookRefCount = 0 then
      Application.UnhookMainWindow (TToolbarButton97.DeactivateHook);
  end;
  inherited;
end;

procedure TToolbarButton97.Paint;
const
  EdgeStyles: array[Boolean, Boolean] of UINT = (
    (EDGE_RAISED, EDGE_SUNKEN),
    (BDR_RAISEDINNER, BDR_SUNKENOUTER));
  FlagStyles: array[Boolean] of UINT = (BF_RECT or BF_SOFT or BF_MIDDLE, BF_RECT);
var
  Bmp: TBitmap;
  DrawCanvas: TCanvas;
  PaintRect, R: TRect;
  Offset: TPoint;
begin
  if FOpaque or not FFlat then
    Bmp := TBitmap.Create
  else
    Bmp := nil;
  try
    if FOpaque or not FFlat then begin
      Bmp.Width := Width;
      Bmp.Height := Height;
      DrawCanvas := Bmp.Canvas;
      with DrawCanvas do begin
        Brush.Color := Self.Color;
        FillRect (ClientRect);
      end;
    end
    else
      DrawCanvas := Canvas;
    if not Enabled then begin
      FState := bsDisabled;
      FMouseIsDown := False;
    end
    else
    if FState = bsDisabled then
      if FDown and (GroupIndex <> 0) then
        FState := bsExclusive
      else
        FState := bsUp;
    DrawCanvas.Font := Self.Font;
    PaintRect := Rect(0, 0, Width, Height);

    if ((not FNoBorder) and
        ((not FFlat) or (FState in [bsDown, bsExclusive]) or
        (FMouseInControl and (FState <> bsDisabled)))) or
       (csDesigning in ComponentState) then begin
      if DropdownCombo and FUsesDropdown then begin
        R := PaintRect;
        R.Left := R.Right - DropdownComboWidth;
        Dec (R.Right, 2);
        DrawEdge (DrawCanvas.Handle, R,
          EdgeStyles[FFlat, (FState in [bsDown, bsExclusive]) and FMenuIsDown],
          FlagStyles[FFlat]);
        Dec (PaintRect.Right, DropdownComboWidth);
      end;
      DrawEdge (DrawCanvas.Handle, PaintRect,
        EdgeStyles[FFlat, (FState in [bsDown, bsExclusive]) and (not(DropdownCombo and FUsesDropdown) or not FMenuIsDown)],
        FlagStyles[FFlat]);
    end
    else
      if DropdownCombo and FUsesDropdown then
        Dec (PaintRect.Right, DropdownComboWidth);
    if not FNoBorder then begin
      if FFlat then
        InflateRect (PaintRect, -1, -1)
      else
        InflateRect (PaintRect, -2, -2);
    end;

    if (FState in [bsDown, bsExclusive]) and (not(DropdownCombo and FUsesDropdown) or not FMenuIsDown) then begin
      if (FState = bsExclusive) and (not FFlat or not FMouseInControl) then begin
        if Pattern = nil then CreateBrushPattern;
        DrawCanvas.Brush.Bitmap := Pattern;
        DrawCanvas.FillRect(PaintRect);
      end;
      Offset.X := 1;
      Offset.Y := 1;
    end
    else begin
      Offset.X := 0;
      Offset.Y := 0;
    end;

    TButtonGlyph(FGlyph).Draw (DrawCanvas, PaintRect, Offset,
      FDisplayMode <> dmTextOnly, FDisplayMode <> dmGlyphOnly,
      Caption, FWordWrap, FLayout, FMargin, FSpacing,
      FDropdownArrow and not FDropdownCombo and FUsesDropdown, FState);
    if FDropdownCombo and FUsesDropdown then
      TButtonGlyph(FGlyph).DrawButtonDropArrow (DrawCanvas, Width-DropdownComboWidth-2,
        Height div 2 - 1, FState);

    if FOpaque or not FFlat then
      Canvas.Draw (0, 0, Bmp);
  finally
    if FOpaque or not FFlat then
      Bmp.Free;
  end;
end;

procedure TToolbarButton97.UpdateTracking;
var
  P: TPoint;
begin
  if Enabled then begin
    GetCursorPos (P);
    { Use FindDragTarget instead of PtInRect since we want to check based on
      the Z order }
    FMouseInControl := not (FindDragTarget(P, True) = Self);
    if FMouseInControl then
      MouseLeft
    else
      MouseEntered;
  end;
end;

procedure TToolbarButton97.Loaded;
var
  State: TButtonState97;
begin
  inherited;
  if Enabled then
    State := bsUp
  else
    State := bsDisabled;
  TButtonGlyph(FGlyph).CreateButtonGlyph (State);
end;

procedure TToolbarButton97.Notification (AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (AComponent = FDropdownMenu) and (Operation = opRemove) then
    FDropdownMenu := nil;
end;

function TToolbarButton97.PointInButton (X, Y: Integer): Boolean;
begin
  Result := (X >= 0) and (X < ClientWidth-(DropdownComboWidth * Ord(FDropdownCombo and FUsesDropdown))) and
    (Y >= 0) and (Y < ClientHeight);
end;

procedure TToolbarButton97.MouseDown (Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if not Enabled then begin
    inherited;
    Exit;
  end;
  if Button <> mbLeft then begin
    MouseEntered;
    inherited;
  end
  else begin
    { We know mouse has to be over the control if the mouse went down. }
    if not FMouseInControl then begin
      { Doesn't call MouseEntered since the redrawing it does is unnecessary
        here }
      FMouseInControl := True;
      if Assigned(FOnMouseEnter) then
        FOnMouseEnter (Self);
    end;
    FMenuIsDown := FUsesDropdown and (not FDropdownCombo or (X >= Width-DropdownComboWidth));
    try
      if not FDown then begin
        FState := bsDown;
        Redraw (True);
      end
      else
        if FAllowAllUp then
          Redraw (True);
      if not FMenuIsDown then
        FMouseIsDown := True;
      inherited;
      if FMenuIsDown then
        Click
      else
        if FRepeating then begin
          inherited Click;
          if not Assigned(FRepeatTimer) then
            FRepeatTimer := TTimer.Create(Self);
          FRepeatTimer.Enabled := False;
          FRepeatTimer.Interval := FRepeatDelay;
          FRepeatTimer.OnTimer := RepeatTimerHandler;
          FRepeatTimer.Enabled := True;
        end;
    finally
      FMenuIsDown := False;
    end;
  end;
end;

procedure TToolbarButton97.MouseMove (Shift: TShiftState; X, Y: Integer);

  function GetActiveForm: {$IFDEF TB97Delphi3orHigher} TCustomForm {$ELSE} TForm {$ENDIF};
  { Returns the active top-level form }
  var
    Ctl: TWinControl;
  begin
    Result := nil;
    Ctl := FindControl(GetActiveWindow);
    if Assigned(Ctl) then begin
      Result := GetParentForm(Ctl);
      if Result is TForm then
        Result := GetMDIParent(TForm(Result));
    end;
  end;
var
  P: TPoint;
  NewState: TButtonState97;
  PtInButton: Boolean;
begin
  inherited;

  { Check if mouse just entered the control. It works better to check this
    in MouseMove rather than using CM_MOUSEENTER, since the VCL doesn't send
    a CM_MOUSEENTER in all cases
    Use FindDragTarget instead of PtInRect since we want to check based on
    the Z order }
  P := ClientToScreen(Point(X, Y));
  if (ButtonMouseInControl <> Self) and (FindDragTarget(P, True) = Self) then begin
    if Assigned(ButtonMouseInControl) then
      ButtonMouseInControl.MouseLeft;
    { Like Office 97, only draw the active borders when the application is active }
    if FShowBorderWhenInactive or Application.Active then begin
      ButtonMouseInControl := Self;
      ButtonMouseTimer.OnTimer := ButtonMouseTimerHandler;
      ButtonMouseTimer.Enabled := True;
      MouseEntered;
    end;
  end;

  if FMouseIsDown then begin
    PtInButton := PointInButton(X, Y);
    if PtInButton and Assigned(FRepeatTimer) then
      FRepeatTimer.Enabled := True;
    if FDown then
      NewState := bsExclusive
    else begin
      if PtInButton then
        NewState := bsDown
      else
        NewState := bsUp;
    end;
    if NewState <> FState then begin
      FState := NewState;
      Redraw (True);
    end;
  end;
end;

procedure TToolbarButton97.RepeatTimerHandler (Sender: TObject);
var
  P: TPoint;
begin
  FRepeatTimer.Interval := FRepeatInterval;
  GetCursorPos (P);
  P := ScreenToClient(P);
  if Repeating and FMouseIsDown and MouseCapture and PointInButton(P.X, P.Y) then
    inherited Click
  else
    FRepeatTimer.Enabled := False;
end;

procedure TToolbarButton97.WMCancelMode (var Message: TWMCancelMode);
begin
  FRepeatTimer.Free;
  FRepeatTimer := nil;
  if FMouseIsDown then begin
    FMouseIsDown := False;
    if FGroupIndex <> 0 then begin
      if FDown then
        FState := bsExclusive;
    end;
    MouseLeft;
  end;
  { Delphi's default processing of WM_CANCELMODE sends a "fake" WM_LBUTTONUP
    message to the control, so inherited must only be called after setting
    FMouseIsDown to False }
  inherited;
end;

procedure TToolbarButton97.MouseUp (Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  DoClick: Boolean;
begin
  FRepeatTimer.Free;
  FRepeatTimer := nil;
  { Remove active border when right button is clicked }
  if (Button = mbRight) and Enabled then begin
    FMouseIsDown := False;
    MouseLeft;
  end;
  inherited;
  if (Button = mbLeft) and FMouseIsDown then begin
    FMouseIsDown := False;
    DoClick := PointInButton(X, Y);
    if FGroupIndex <> 0 then begin
      if DoClick then
        SetDown (not FDown)
      else begin
        if FDown then
          FState := bsExclusive;
      end;
    end;
    if DoClick and not FRepeating then
      Click
    else begin
      if FState = bsDown then
        FState := bsUp;
      UpdateTracking;
    end;
  end;
end;

procedure TToolbarButton97.Click;
const
  { TPM_RIGHTBUTTON works better on Windows 3.x }
  ButtonFlags: array[Boolean] of UINT = (TPM_RIGHTBUTTON, TPM_LEFTBUTTON);
  AlignFlags: array[TPopupAlignment] of UINT = (TPM_LEFTALIGN, TPM_RIGHTALIGN,
    TPM_CENTERALIGN);
var
  SaveAlignment: TPopupAlignment;
  PopupPoint: TPoint;
  RepostList: TList; {pointers to TMsg's}
  Msg: TMsg;
  Repost: Boolean;
  I: Integer;
  P: TPoint;
  Form: {$IFDEF TB97Delphi3orHigher} TCustomForm {$ELSE} TForm {$ENDIF};
begin
  FInClick := True;
  try
    if FState in [bsUp, bsMouseIn] then begin
      FState := bsDown;
      Redraw (True);
    end;

    { Stop tracking }
    MouseLeft;
    if (not FUsesDropdown) or (FDropdownCombo and not FMenuIsDown) then begin
      Form := GetParentForm(Self);
      if Form <> nil then Form.ModalResult := ModalResult;
      inherited;
    end
    else begin
      { It must release its capture before displaying the popup menu since
        this control uses csCaptureMouse. If it doesn't, the VCL seems to
        get confused and think the mouse is still captured even after the
        popup menu is displayed, causing mouse problems after the menu is
        dismissed. }
      MouseCapture := False;
      try
        SaveAlignment := DropdownMenu.Alignment;
        try
          DropdownMenu.Alignment := paLeft;
          PopupPoint := Point(0, Height);
          if (Parent is TCustomToolWindow97) and
             (GetDockTypeOf(TCustomToolWindow97(Parent).DockedTo) = dtLeftRight) then begin
            { Drop out right or left side }
            if TCustomToolWindow97(Parent).DockedTo.Position = dpLeft then
              PopupPoint := Point(Width, 0)
            else begin
              PopupPoint := Point(0, 0);
              DropdownMenu.Alignment := paRight;
            end;
          end;
          PopupPoint := ClientToScreen(PopupPoint);
          with DropdownMenu do begin
            PopupComponent := Self;
            { Starting with version 1.54, this avoids using the Popup method
              of TPopupMenu because it uses the "track right button" flag
              (which disallowed the "click and drag" selecting motion many
              people are accustomed to). }
            if Assigned(OnPopup) then
              OnPopup (DropdownMenu);
            TrackPopupMenu (Handle, AlignFlags[Alignment] or ButtonFlags[NewStyleControls],
              PopupPoint.X, PopupPoint.Y, 0, DropdownList.Window, nil);
          end;
        finally
          DropdownMenu.Alignment := SaveAlignment;
        end;
      finally
        { To prevent a mouse click from redisplaying the menu, filter all
          mouse up/down messages, and repost the ones that don't need
          removing. This is sort of bulky, but it's the only way I could
          find that works perfectly and like Office 97. }
        RepostList := TList.Create;
        try
          while PeekMessage(Msg, 0, WM_LBUTTONDOWN, WM_MBUTTONDBLCLK,
             PM_REMOVE or PM_NOYIELD) do
             { ^ The WM_LBUTTONDOWN to WM_MBUTTONDBLCLK range encompasses all
               of the DOWN and DBLCLK messages for the three buttons }
            with Msg do begin
              Repost := True;
              case Message of
                WM_LBUTTONDOWN, WM_LBUTTONDBLCLK,
                WM_RBUTTONDOWN, WM_RBUTTONDBLCLK,
                WM_MBUTTONDOWN, WM_MBUTTONDBLCLK: begin
                    P := SmallPointToPoint(TSmallPoint(lParam));
                    Windows.ClientToScreen (hwnd, P);
                    if FindDragTarget(P, True) = Self then
                      Repost := False;
                  end;
              end;
              if Repost then begin
                RepostList.Add (AllocMem(SizeOf(TMsg)));
                PMsg(RepostList.Last)^ := Msg;
              end;
            end;
        finally
          for I := 0 to RepostList.Count-1 do begin
            with PMsg(RepostList[I])^ do
              PostMessage (hwnd, message, wParam, lParam);
            FreeMem (RepostList[I]);
          end;
          RepostList.Free;
        end;
      end;
    end;
  finally
    FInClick := False;
    if FState = bsDown then
      FState := bsUp;
    { Need to check if it's destroying in case the OnClick handler freed
      the button. If it doesn't check this here, it can sometimes cause an
      access violation }
    if not(csDestroying in ComponentState) then begin
      Redraw (True);
      UpdateTracking;
    end;
  end;
end;

function TToolbarButton97.GetPalette: HPALETTE;
begin
  Result := Glyph.Palette;
end;

function TToolbarButton97.GetGlyph: TBitmap;
begin
  Result := TButtonGlyph(FGlyph).Glyph;
end;

procedure TToolbarButton97.SetGlyph (Value: TBitmap);
begin
  TButtonGlyph(FGlyph).Glyph := Value;
  Redraw (True);
end;

function TToolbarButton97.GetGlyphMask: TBitmap;
begin
  Result := TButtonGlyph(FGlyph).GlyphMask;
end;

procedure TToolbarButton97.SetGlyphMask (Value: TBitmap);
begin
  TButtonGlyph(FGlyph).GlyphMask := Value;
  Redraw (True);
end;

function TToolbarButton97.GetNumGlyphs: TNumGlyphs97;
begin
  Result := TButtonGlyph(FGlyph).NumGlyphs;
end;

procedure TToolbarButton97.SetNumGlyphs (Value: TNumGlyphs97);
begin
  if Value < Low(TNumGlyphs97) then
    Value := Low(TNumGlyphs97)
  else
  if Value > High(TNumGlyphs97) then
    Value := High(TNumGlyphs97);
  if Value <> TButtonGlyph(FGlyph).NumGlyphs then begin
    TButtonGlyph(FGlyph).NumGlyphs := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.GlyphChanged(Sender: TObject);
begin
  Redraw (True);
end;

procedure TToolbarButton97.UpdateExclusive;
var
  Msg: TMessage;
begin
  if (FGroupIndex <> 0) and (Parent <> nil) then begin
    Msg.Msg := CM_BUTTONPRESSED;
    Msg.WParam := FGroupIndex;
    Msg.LParam := Longint(Self);
    Msg.Result := 0;
    Parent.Broadcast (Msg);
  end;
end;

procedure TToolbarButton97.SetDown (Value: Boolean);
begin
  if FGroupIndex = 0 then
    Value := False;
  if Value <> FDown then begin
    if FDown and (not FAllowAllUp) then Exit;
    FDown := Value;
    if Value then
      FState := bsExclusive
    else
      FState := bsUp;
    Redraw (True);
    if Value then UpdateExclusive;
  end;
end;

procedure TToolbarButton97.SetFlat (Value: Boolean);
begin
  if FFlat <> Value then begin
    FFlat := Value;
    if FOpaque or not FFlat then
      ControlStyle := ControlStyle + [csOpaque]
    else
      ControlStyle := ControlStyle - [csOpaque];
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetGroupIndex (Value: Integer);
begin
  if FGroupIndex <> Value then begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;

procedure TToolbarButton97.SetLayout (Value: TButtonLayout);
begin
  if FLayout <> Value then begin
    FLayout := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetMargin (Value: Integer);
begin
  if (FMargin <> Value) and (Value >= -1) then begin
    FMargin := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetNoBorder (Value: Boolean);
begin
  if FNoBorder <> Value then begin
    FNoBorder := Value;
    Invalidate;
  end;
end;

procedure TToolbarButton97.SetOldDisabledStyle (Value: Boolean);
begin
  if FOldDisabledStyle <> Value then begin
    FOldDisabledStyle := Value;
    with TButtonGlyph(FGlyph) do begin
      FOldDisabledStyle := Value;
      Invalidate;
    end;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetOpaque (Value: Boolean);
begin
  if FOpaque <> Value then begin
    FOpaque := Value;
    if FOpaque or not FFlat then
      ControlStyle := ControlStyle + [csOpaque]
    else
      ControlStyle := ControlStyle - [csOpaque];
    Invalidate;
  end;
end;

procedure TToolbarButton97.Redraw (const Erase: Boolean);
var
  AddedOpaque: Boolean;
begin
  if FOpaque or not FFlat or not Erase then begin
    { Temporarily add csOpaque to the style. This prevents Invalidate from
      erasing, which isn't needed when Erase is false. }
    AddedOpaque := False;
    if not(csOpaque in ControlStyle) then begin
      AddedOpaque := True;
      ControlStyle := ControlStyle + [csOpaque];
    end;
    try
      Invalidate;
    finally
      if AddedOpaque then
        ControlStyle := ControlStyle - [csOpaque];
    end;
  end
  else
  if not(FOpaque or not FFlat) then
    Invalidate;
end;

procedure TToolbarButton97.SetSpacing (Value: Integer);
begin
  if Value <> FSpacing then begin
    FSpacing := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetAllowAllUp (Value: Boolean);
begin
  if FAllowAllUp <> Value then begin
    FAllowAllUp := Value;
    UpdateExclusive;
  end;
end;

procedure TToolbarButton97.SetDropdownMenu (Value: TPopupMenu);
begin
  if FDropdownMenu <> Value then begin
    FDropdownMenu := Value;
    FUsesDropdown := Assigned(Value);
    if Assigned(Value) then begin
      Value.FreeNotification (Self);
      DropdownList.AddMenu (Value);
    end;
    if FDropdownArrow then
      Redraw (True);
  end;
end;

procedure TToolbarButton97.SetWordWrap (Value: Boolean);
begin
  if FWordWrap <> Value then begin
    FWordWrap := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetDropdownArrow (Value: Boolean);
begin
  if FDropdownArrow <> Value then begin
    FDropdownArrow := Value;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetDropdownCombo (Value: Boolean);
var
  W: Integer;
begin
  if FDropdownCombo <> Value then begin
    FDropdownCombo := Value;
    if not(csLoading in ComponentState) then begin
      if Value then
        Width := Width + DropdownComboWidth
      else begin
        W := Width - DropdownComboWidth;
        if W < 1 then W := 1;
        Width := W;
      end;
    end;
    Redraw (True);
  end;
end;

procedure TToolbarButton97.SetDisplayMode (Value: TButtonDisplayMode);
begin
  if FDisplayMode <> Value then begin
    FDisplayMode := Value;
    Redraw (True);
  end;
end;

function TToolbarButton97.GetCallDormant: Boolean;
begin
  Result := TButtonGlyph(FGlyph).FCallDormant;
end;

procedure TToolbarButton97.SetCallDormant (Value: Boolean);
begin
  TButtonGlyph(FGlyph).FCallDormant := Value;
end;

procedure TToolbarButton97.WMLButtonDblClk (var Message: TWMLButtonDblClk);
begin
  inherited;
  if FDown then DblClick;
end;

procedure TToolbarButton97.CMEnabledChanged (var Message: TMessage);
const
  NewState: array[Boolean] of TButtonState97 = (bsDisabled, bsUp);
begin
  TButtonGlyph(FGlyph).CreateButtonGlyph (NewState[Enabled]);
  UpdateTracking;
  Redraw (True);
end;

procedure TToolbarButton97.CMButtonPressed (var Message: TMessage);
var
  Sender: TToolbarButton97;
begin
  { UpdateExclusive broadcasts these messages }
  if Message.WParam = FGroupIndex then begin
    Sender := TToolbarButton97(Message.LParam);
    if Sender <> Self then begin
      if Sender.Down and FDown then begin
        FDown := False;
        FState := bsUp;
        Redraw (True);
      end;
      FAllowAllUp := Sender.AllowAllUp;
    end;
  end;
end;

procedure TToolbarButton97.CMDialogChar (var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and Enabled and Visible then begin
      { NOTE: There is a bug in TSpeedButton where accelerator keys are still
        processed even when the button is not visible. The 'and Visible'
        corrects it, so TToolbarButton97 doesn't have this problem. }
      Click;
      Result := 1;
    end
    else
      inherited;
end;

procedure TToolbarButton97.CMFontChanged (var Message: TMessage);
begin
  Redraw (True);
end;

procedure TToolbarButton97.CMTextChanged (var Message: TMessage);
begin
  Redraw (True);
end;

procedure TToolbarButton97.CMSysColorChange (var Message: TMessage);
begin
  inherited;
  if Assigned(Pattern) and
     ((PatternBtnFace <> TColor(GetSysColor(COLOR_BTNFACE))) or
      (PatternBtnHighlight <> TColor(GetSysColor(COLOR_BTNHIGHLIGHT)))) then begin
    Pattern.Free;
    Pattern := nil;
  end;
  with TButtonGlyph(FGlyph) do begin
    Invalidate;
    CreateButtonGlyph (FState);
  end;
end;

procedure TToolbarButton97.MouseEntered;
begin
  if Enabled and not FMouseInControl then begin
    FMouseInControl := True;
    if FState = bsUp then
      FState := bsMouseIn;
    Redraw (FDown);
    if Assigned(FOnMouseEnter) then
      FOnMouseEnter (Self);
  end;
end;

procedure TToolbarButton97.MouseLeft;
begin
  if Enabled and FMouseInControl and not FMouseIsDown then begin
    if (FState = bsMouseIn) or (not FInClick and (FState = bsDown)) then
      FState := bsUp;
    FMouseInControl := False;
    Redraw (True);
    if ButtonMouseInControl = Self then begin
      ButtonMouseTimer.Enabled := False;
      ButtonMouseInControl := nil;
    end;
    if Assigned(FOnMouseExit) then
      FOnMouseExit (Self);
  end;
end;

procedure TToolbarButton97.CMMouseLeave (var Message: TMessage);
begin
  inherited;
  MouseLeft;
end;

procedure TToolbarButton97.ButtonMouseTimerHandler (Sender: TObject);
var
  P: TPoint;
begin
  { The button mouse timer is used to periodically check if mouse has left.
    Normally it receives a CM_MOUSELEAVE, but the VCL does not send a
    CM_MOUSELEAVE if the mouse is moved quickly from the button to another
    application's window. For some reason, this problem doesn't seem to occur
    on Windows NT 4 -- only 95 and 3.x.

    The timer (which ticks 8 times a second) is only enabled when the
    application is active and the mouse is over a button, so it uses virtually
    no processing power.

    For something interesting to try: If you want to know just how often this
    is called, try putting a Beep call in here }

  GetCursorPos (P);
  if FindDragTarget(P, True) <> Self then
    MouseLeft;
end;

class function TToolbarButton97.DeactivateHook (var Message: TMessage): Boolean;
begin
  Result := False;
  { Hide any active border when application is deactivated }
  if (Message.Msg = CM_DEACTIVATE) and Assigned(ButtonMouseInControl) and
     not ButtonMouseInControl.FShowBorderWhenInactive then
    ButtonMouseInControl.MouseLeft;
end;


{ TEdit97 - internal }

constructor TEdit97.Create (AOwner: TComponent);
begin
  inherited;
  AutoSize := False;
  Ctl3D := False;
  BorderStyle := bsNone;
  ControlStyle := ControlStyle - [csFramed]; {fixes a VCL bug with Win 3.x}
  Height := 19;
end;

procedure TEdit97.CMMouseEnter (var Message: TMessage);
begin
  inherited;
  MouseInControl := True;
  RedrawBorder (0);
end;

procedure TEdit97.CMMouseLeave (var Message: TMessage);
begin
  inherited;
  MouseInControl := False;
  RedrawBorder (0);
end;

procedure TEdit97.NewAdjustHeight;
var
  DC: HDC;
  SaveFont: HFONT;
  Metrics: TTextMetric;
begin
  DC := GetDC(0);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics (DC, Metrics);
  SelectObject (DC, SaveFont);
  ReleaseDC (0, DC);

  Height := Metrics.tmHeight + 6;
end;

procedure TEdit97.Loaded;
begin
  inherited;
  if not(csDesigning in ComponentState) then
    NewAdjustHeight;
end;

procedure TEdit97.CMEnabledChanged (var Message: TMessage);
const
  EnableColors: array[Boolean] of TColor = (clBtnFace, clWindow);
begin
  inherited;
  Color := EnableColors[Enabled];
end;

procedure TEdit97.CMFontChanged (var Message: TMessage);
begin
  inherited;
  if not((csDesigning in ComponentState) and (csLoading in ComponentState)) then
    NewAdjustHeight;
end;

procedure TEdit97.WMSetFocus (var Message: TWMSetFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) then
    RedrawBorder (0);
end;

procedure TEdit97.WMKillFocus (var Message: TWMKillFocus);
begin
  inherited;
  if not(csDesigning in ComponentState) then
    RedrawBorder (0);
end;

procedure TEdit97.WMNCCalcSize (var Message: TWMNCCalcSize);
begin
  inherited;
  InflateRect (Message.CalcSize_Params^.rgrc[0], -3, -3);
end;

procedure TEdit97.WMNCPaint (var Message: TMessage);
begin
  inherited;
  RedrawBorder (Message.WParam);
end;

procedure TEdit97.RedrawBorder (const Clip: HRGN);
var
  DC: HDC;
  R: TRect;
  NewClipRgn: HRGN;
  BtnFaceBrush, WindowBrush: HBRUSH;
begin
  DC := GetWindowDC(Handle);
  try
    { Use update region }
    if (Clip <> 0) and (Clip <> 1) then begin
      GetWindowRect (Handle, R);
      if SelectClipRgn(DC, Clip) = ERROR then begin
        NewClipRgn := CreateRectRgnIndirect(R);
        SelectClipRgn (DC, NewClipRgn);
        DeleteObject (NewClipRgn);
      end;
      OffsetClipRgn (DC, -R.Left, -R.Top);
    end;

    { This works around WM_NCPAINT problem described at top of source code }
    {no!  R := Rect(0, 0, Width, Height);}
    GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
    BtnFaceBrush := GetSysColorBrush(COLOR_BTNFACE);
    WindowBrush := GetSysColorBrush(COLOR_WINDOW);
    if ((csDesigning in ComponentState) and Enabled) or
       (not(csDesigning in ComponentState) and
        (Focused or (MouseInControl and not(Screen.ActiveControl is TEdit97)))) then begin
      DrawEdge (DC, R, BDR_SUNKENOUTER, BF_RECT or BF_ADJUST);
      with R do begin
        FillRect (DC, Rect(Left, Top, Left+1, Bottom-1), BtnFaceBrush);
        FillRect (DC, Rect(Left, Top, Right-1, Top+1), BtnFaceBrush);
      end;
      DrawEdge (DC, R, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
      InflateRect (R, -1, -1);
      FrameRect (DC, R, WindowBrush);
    end
    else begin
      FrameRect (DC, R, BtnFaceBrush);
      InflateRect (R, -1, -1);
      FrameRect (DC, R, BtnFaceBrush);
      InflateRect (R, -1, -1);
      FrameRect (DC, R, WindowBrush);
    end;
  finally
    ReleaseDC (Handle, DC);
  end;
end;


const
  Sig: PChar = '- Toolbar97 version ' + Toolbar97Version +
    {$IFDEF VER90}  '/D2'+ {$ENDIF} {$IFDEF VER93}  '/CB1'+ {$ENDIF}
    {$IFDEF VER100} '/D3'+ {$ENDIF} {$IFDEF VER110} '/CB3'+ {$ENDIF}
    ' by Jordan Russell -';

initialization
  Sig := Sig;

  HookedForms := TList.Create;
  MainHookedForms := TList.Create;
  DoneCreatingList := TList.Create;
  DropdownList := TDropdownList.Create(nil);

  ButtonMouseTimer := TTimer.Create(nil);
  ButtonMouseTimer.Enabled := False;
  ButtonMouseTimer.Interval := 125;  { 8 times a second }
finalization
  ButtonMouseTimer.Free;
  DropdownList.Free;
  DoneCreatingList.Free;
  MainHookedForms.Free;
  HookedForms.Free;
end.
