winscp/source/packages/tb2k/TB2Toolbar.pas

unit TB2Toolbar;

{
  Toolbar2000
  Copyright (C) 1998-2005 by Jordan Russell
  All rights reserved.

  The contents of this file are subject to the "Toolbar2000 License"; you may
  not use or distribute this file except in compliance with the
  "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in
  TB2k-LICENSE.txt or at:
    https://jrsoftware.org/files/tb2k/TB2k-LICENSE.txt

  Alternatively, the contents of this file may be used under the terms of the
  GNU General Public License (the "GPL"), in which case the provisions of the
  GPL are applicable instead of those in the "Toolbar2000 License". A copy of
  the GPL may be found in GPL-LICENSE.txt or at:
    https://jrsoftware.org/files/tb2k/GPL-LICENSE.txt
  If you wish to allow use of your version of this file only under the terms of
  the GPL and not to allow others to use your version of this file under the
  "Toolbar2000 License", indicate your decision by deleting the provisions
  above and replace them with the notice and other provisions required by the
  GPL. If you do not delete the provisions above, a recipient may use your
  version of this file under either the "Toolbar2000 License" or the GPL.

  $jrsoftware: tb2k/Source/TB2Toolbar.pas,v 1.108 2005/07/30 18:17:20 jr Exp $
}

interface

{$I TB2Ver.inc}

uses
  Types,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ImgList,
  Menus, ActnList,
  TB2Item, TB2Dock;

type
  TTBCustomToolbar = class;
  TTBChevronItem = class;
  TTBChevronItemClass = class of TTBChevronItem;

  TTBToolbarViewClass = class of TTBToolbarView;
  TTBToolbarView = class(TTBView)
  private
    FToolbar: TTBCustomToolbar;
  protected
    procedure AutoSize(AWidth, AHeight: Integer); override;
    procedure DoUpdatePositions(var ASize: TPoint); override;
    function GetChevronItem: TTBCustomItem; override;
    function GetMDIButtonsItem: TTBCustomItem; override;
    function GetMDISystemMenuItem: TTBCustomItem; override;
  public
    constructor Create(AOwner: TComponent); override;
    function GetFont: TFont; override;
    procedure InvalidatePositions; override;
    procedure EnterToolbarLoop(Options: TTBEnterToolbarLoopOptions); override;
  end;

  TTBChevronPriorityForNewItems = (tbcpHighest, tbcpLowest);

  { MP }
  TToolbarGetBaseSizeEvent = procedure(Toolbar: TTBCustomToolbar; var ASize: TPoint) of object;

  TTBCustomToolbar = class(TTBCustomDockableWindow, ITBItems)
  private
    FBaseSize: TPoint;
    FChevronItem: TTBChevronItem;
    FChevronMoveItems: Boolean;
    FChevronMenu: Boolean;
    FChevronPriorityForNewItems: TTBChevronPriorityForNewItems;
    FDisableAlignArrange: Integer;
    FFloatingWidth: Integer;
    FIgnoreMouseLeave: Boolean;
    FItem: TTBRootItem;
    FLastWrappedLines: Integer;
    FMenuBar: Boolean;
    FOnShortCut: TShortCutEvent;
    FProcessShortCuts: Boolean;
    FMainWindowHookInstalled: Boolean;
    FShrinkMode: TTBShrinkMode;
    FSizeData: Pointer;
    FSystemFont: Boolean;
    FUpdateActions: Boolean;
    { MP }
    FOnGetBaseSize: TToolbarGetBaseSizeEvent;
    FOnEndModal: TNotifyEvent;

    procedure CancelHover;
    function CalcChevronOffset(const ADock: TTBDock;
      const AOrientation: TTBViewOrientation): Integer;
    function CalcWrapOffset(const ADock: TTBDock): Integer;
    function CreateWrapper(Index: Integer; Ctl: TControl): TTBControlItem;
    function FindWrapper(Ctl: TControl): TTBControlItem;
    function GetChevronHint: String;
    function GetImages: TCustomImageList;
    function GetItems: TTBCustomItem;
    function GetLinkSubitems: TTBCustomItem;
    function GetOptions: TTBItemOptions;
    procedure InstallMainWindowHook;
    function IsChevronHintStored: Boolean;
    class function MainWindowHook(var Message: TMessage): Boolean;
    procedure SetChevronHint(const Value: String);
    procedure SetChevronMoveItems(Value: Boolean);
    procedure SetChevronPriorityForNewItems(Value: TTBChevronPriorityForNewItems);
    procedure SetFloatingWidth(Value: Integer);
    procedure SetImages(Value: TCustomImageList);
    procedure SetLinkSubitems(Value: TTBCustomItem);
    procedure SetMainWindowHook;
    procedure SetMenuBar(Value: Boolean);
    procedure SetOptions(Value: TTBItemOptions);
    procedure SetProcessShortCuts(Value: Boolean);
    procedure SetShrinkMode(Value: TTBShrinkMode);
    procedure SetSystemFont(Value: Boolean);
    procedure UninstallMainWindowHook;
    procedure UpdateViewProperties;

    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure CMControlChange(var Message: TCMControlChange); message CM_CONTROLCHANGE;
    procedure CMControlListChange(var Message: TCMControlListChange); message CM_CONTROLLISTCHANGE;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMShowHintChanged(var Message: TMessage); message CM_SHOWHINTCHANGED;
    procedure CMWinIniChange(var Message: TWMSettingChange); message CM_WININICHANGE;
    procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;
    procedure WMGetObject(var Message: TMessage); message WM_GETOBJECT;
    procedure WMMouseLeave(var Message: TMessage); message WM_MOUSELEAVE;
    procedure WMNCMouseMove(var Message: TWMNCMouseMove); message WM_NCMOUSEMOVE;
    procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
  protected
    FMDIButtonsItem: TTBCustomItem;
    FMDISystemMenuItem: TTBCustomItem;
    FView: TTBToolbarView;
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    procedure BuildPotentialSizesList(SizesList: TList); dynamic;
    procedure ControlExistsAtPos(const P: TPoint; var ControlExists: Boolean);
      override;
    function DoArrange(CanMoveControls: Boolean; PreviousDockType: TTBDockType;
      NewFloating: Boolean; NewDock: TTBDock): TPoint; override;
    procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
    procedure GetBaseSize(var ASize: TPoint); override;
    procedure GetMinBarSize(var MinimumSize: TPoint);
    procedure GetMinShrinkSize(var AMinimumSize: Integer); override;
    function GetShrinkMode: TTBShrinkMode; override;
    function GetChevronItemClass: TTBChevronItemClass; dynamic;
    function GetItemClass: TTBRootItemClass; dynamic;
    function GetViewClass: TTBToolbarViewClass; dynamic;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
    procedure ResizeBegin(ASizeHandle: TTBSizeHandle); override;
    procedure ResizeTrack(var Rect: TRect; const OrigRect: TRect); override;
    procedure ResizeTrackAccept; override;
    procedure ResizeEnd; override;
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
    procedure ChangeScale(M, D: Integer; isDpiChange: Boolean); override;

    property SystemFont: Boolean read FSystemFont write SetSystemFont default True;
    property OnShortCut: TShortCutEvent read FOnShortCut write FOnShortCut;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure CreateWrappersForAllControls;
    procedure GetTabOrderList(List: TList); override;
    procedure InitiateAction; override;
    function IsShortCut(var Message: TWMKey): Boolean;
    function KeyboardOpen(Key: Char; RequirePrimaryAccel: Boolean): Boolean;
    procedure ReadPositionData(var S: string); override;
    function WritePositionData: string; override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure Idle;

    property ChevronHint: String read GetChevronHint write SetChevronHint stored IsChevronHintStored;
    property ChevronMoveItems: Boolean read FChevronMoveItems write SetChevronMoveItems default True;
    property ChevronMenu: Boolean read FChevronMenu write FChevronMenu default False;
    property ChevronPriorityForNewItems: TTBChevronPriorityForNewItems read FChevronPriorityForNewItems
      write SetChevronPriorityForNewItems default tbcpHighest;
    property FloatingWidth: Integer read FFloatingWidth write SetFloatingWidth default 0;
    property Images: TCustomImageList read GetImages write SetImages;
    property Items: TTBRootItem read FItem;
    property LinkSubitems: TTBCustomItem read GetLinkSubitems write SetLinkSubitems;
    property Options: TTBItemOptions read GetOptions write SetOptions default [];
    property MenuBar: Boolean read FMenuBar write SetMenuBar default False;
    property ProcessShortCuts: Boolean read FProcessShortCuts write SetProcessShortCuts default False;
    property ShrinkMode: TTBShrinkMode read FShrinkMode write SetShrinkMode default tbsmChevron;
    property UpdateActions: Boolean read FUpdateActions write FUpdateActions default True;
    property View: TTBToolbarView read FView;
    { MP }
    property OnGetBaseSize: TToolbarGetBaseSizeEvent read FOnGetBaseSize write FOnGetBaseSize;
    property OnEndModal: TNotifyEvent read FOnEndModal write FOnEndModal;
  published
    property Hint stored False;  { Hint is set dynamically; don't save it }
  end;

  TTBToolbar = class(TTBCustomToolbar)
  published
    property ActivateParent;
    property Align;
    property Anchors;
    property AutoResize;
    property BorderStyle;
    property Caption;
    property ChevronHint;
    property ChevronMoveItems;
    property ChevronMenu;
    property ChevronPriorityForNewItems;
    property CloseButton;
    property CloseButtonWhenDocked;
    property Color;
    property CurrentDock;
    property DefaultDock;
    property DockableTo;
    property DockMode;
    property DockPos;
    property DockRow;
    property DragHandleStyle;
    property FloatingMode;
    property FloatingWidth;
    property Font;
    property FullSize;
    property HideWhenInactive;
    property Images;
    property Items;
    property LastDock;
    property LinkSubitems;
    property MenuBar;
    property Options;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ProcessShortCuts;
    property Resizable;
    property ShowCaption;
    property ShowHint;
    property ShrinkMode;
    property SmoothDrag;
    property Stretch;
    property SystemFont;
    property TabOrder;
    property UpdateActions;
    property UseLastDock;
    property Visible;

    property OnClose;
    property OnCloseQuery;
    {$IFDEF JR_D5}
    property OnContextPopup;
    {$ENDIF}
    property OnDragDrop;
    property OnDragOver;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMove;
    property OnRecreated;
    property OnRecreating;
    property OnDockChanged;
    property OnDockChanging;
    property OnDockChangingHidden;
    property OnResize;
    property OnShortCut;
    property OnVisibleChanged;
    { MP }
    property OnGetBaseSize;
    property OnEndModal;
  end;

{ TTBChevronItem & TTBChevronItemViewer }

  TTBChevronItem = class(TTBCustomItem)
  private
    FToolbar: TTBCustomToolbar;
    function GetDefaultHint: String;
  public
    constructor Create(AOwner: TComponent); override;
    function GetChevronParentView: TTBView; override;
    function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
  end;

  TTBChevronItemViewer = class(TTBItemViewer)
  protected
    procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect;
      IsSelected, IsPushed, UseDisabledShadow: Boolean); override;
    function CaptionShown: Boolean; override;
  end;

const
  tbChevronSize = 12;


implementation

uses
  TB2Consts, TB2Common, TB2Hook, PasTools;

const
  { Constants for TTBCustomToolbar-specific registry values. Do not localize! }
  rvFloatRightX = 'FloatRightX';
  DockTypeToOrientation: array[TTBDockType] of TTBViewOrientation =
    (tbvoHorizontal, tbvoFloating, tbvoHorizontal, tbvoVertical);

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


procedure HookProc(Code: THookProcCode; Wnd: HWND; WParam: WPARAM;
  LParam: LPARAM);
var
  Msg: PMsg;
  MainForm: TForm;
begin
  { Work around an annoying Windows or VCL bug. If you close all MDI child
    windows, the MDI client window gets the focus, and when it has the focus,
    pressing Alt+[char] doesn't send a WM_SYSCOMMAND message to the form for
    some reason. It seems silly to have to use a hook for this, but I don't
    see a better workaround.
    Also, route Alt+- to the main form so that when an MDI child form is
    maximized, Alt+- brings up the TB2k MDI system menu instead of the
    system's. }
  if (Code = hpGetMessage) and (WParam = PM_REMOVE) then begin
    Msg := PMsg(LParam);
    if (Msg.message = WM_SYSCHAR) and (Msg.hwnd <> 0) then begin
      { Note: On Windows NT/2000/XP, even though we install the hook using
        SetWindowsHookExW, Msg.wParam may either be an ANSI character or a
        Unicode character, due to an apparent bug on these platforms. It is
        an ANSI character when the message passes through a separate
        SetWindowsHookExA-installed WH_GETMESSAGE hook first, and that hook
        calls us via CallNextHookEx. Windows apparently "forgets" to convert
        the character from ANSI back to Unicode in this case.
        We can't convert the character code because there seems to be no way
        to detect whether it is ANSI or Unicode. So we can't really do much
        with Msg.wParam, apart from comparing it against character codes that
        are the same between ANSI and Unicode, such as '-'. }
      MainForm := Application.MainForm;
      if Assigned(MainForm) and MainForm.HandleAllocated and (GetCapture = 0) and
         ((Msg.hwnd = MainForm.ClientHandle) or
          ((Msg.wParam = Ord('-')) and (MainForm.ClientHandle <> 0) and
           IsChild(MainForm.ClientHandle, Msg.hwnd))) then begin
        { Redirect the message to the main form.
          Note: Unfortunately, due to a bug in Windows NT 4.0 (and not
          2000/XP/9x/Me), modifications to the message don't take effect if
          another WH_GETMESSAGE hook has been installed above this one.
          (The bug is that CallNextHookEx copies lParam^ to a local buffer, but
          does not propogate the changes made by the hook back to lParam^ when
          it returns.) I don't know of any clean workaround, other than to
          ensure other WH_GETMESSAGE hooks are installed *before*
          Toolbar2000's. }
        Msg.hwnd := MainForm.Handle;
      end;
    end;
  end;
end;

constructor TTBChevronItem.Create(AOwner: TComponent);
begin
  inherited;
  FToolbar := AOwner as TTBCustomToolbar;
  ItemStyle := ItemStyle + [tbisSubMenu, tbisNoAutoOpen];
  Hint := GetDefaultHint;
  Caption := EscapeAmpersands(GetShortHint(Hint));
end;

function TTBChevronItem.GetChevronParentView: TTBView;
begin
  Result := FToolbar.FView;
end;

function TTBChevronItem.GetDefaultHint: String;
begin
  Result := STBChevronItemMoreButtonsHint;
end;

function TTBChevronItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
begin
  Result := TTBChevronItemViewer;
end;

procedure TTBChevronItemViewer.Paint(const Canvas: TCanvas;
  const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean);
const
  Pattern: array[Boolean, 0..15] of Byte = (
    ($CC, 0, $66, 0, $33, 0, $66, 0, $CC, 0, 0, 0, 0, 0, 0, 0),
    ($88, 0, $D8, 0, $70, 0, $20, 0, $88, 0, $D8, 0, $70, 0, $20, 0));
var
  DC: HDC;
  R2: TRect;
  TempBmp: TBitmap;

  procedure DrawPattern(const Color, Offset: Integer);
  begin
    SelectObject(DC, GetSysColorBrush(Color));
    BitBlt(DC, R2.Left, R2.Top + Offset, R2.Right - R2.Left,
      R2.Bottom - R2.Top, TempBmp.Canvas.Handle, 0, 0, $00E20746 {ROP_DSPDxax});
  end;

begin
  DC := Canvas.Handle;
  R2 := ClientAreaRect;
  if Item.Enabled then begin
    if IsPushed then
      DrawEdge(DC, R2, BDR_SUNKENOUTER, BF_RECT)
    else if IsSelected and not(csDesigning in Item.ComponentState) then
      DrawEdge(DC, R2, BDR_RAISEDINNER, BF_RECT);
  end;

  if View.Orientation <> tbvoVertical then begin
    R2.Top := 4;
    R2.Bottom := R2.Top + 5;
    Inc(R2.Left, 2);
    R2.Right := R2.Left + 8;
  end
  else begin
    R2.Left := R2.Right - 9;
    R2.Right := R2.Left + 5;
    Inc(R2.Top, 2);
    R2.Bottom := R2.Top + 8;
  end;
  if IsPushed then
    OffsetRect(R2, 1, 1);
  TempBmp := TBitmap.Create;
  try
    TempBmp.Handle := CreateBitmap(8, 8, 1, 1,
      @Pattern[View.Orientation = tbvoVertical]);
    SetTextColor(DC, clBlack);
    SetBkColor(DC, clWhite);
    if Item.Enabled then
      DrawPattern(COLOR_BTNTEXT, 0)
    else begin
      DrawPattern(COLOR_BTNHIGHLIGHT, 1);
      DrawPattern(COLOR_BTNSHADOW, 0);
    end;
  finally
    TempBmp.Free;
  end;
end;

function TTBChevronItemViewer.CaptionShown: Boolean;
begin
  Result := False;
end;

{ TTBToolbarView }

constructor TTBToolbarView.Create(AOwner: TComponent);
begin
  FToolbar := AOwner as TTBCustomToolbar;
  inherited;
end;

procedure TTBToolbarView.AutoSize(AWidth, AHeight: Integer);
begin
  FToolbar.FBaseSize := BaseSize;
  if FToolbar.IsAutoResized then
    FToolbar.ChangeSize(AWidth, AHeight);
end;

procedure TTBToolbarView.DoUpdatePositions(var ASize: TPoint);
begin
  { Reset CurrentSize because it probably won't be valid after positions
    are recalculated [2001-06-24] }
  FToolbar.CurrentSize := 0;
  FToolbar.GetMinBarSize(ASize);
  { On FullSize toolbars, increase ASize.X/Y to WrapOffset so that
    right-aligned items always appear at the right edge even when the toolbar
    isn't wrapping }
  if FToolbar.FullSize then begin
    if (Orientation = tbvoHorizontal) and (ASize.X < WrapOffset) then
      ASize.X := WrapOffset
    else if (Orientation = tbvoVertical) and (ASize.Y < WrapOffset) then
      ASize.Y := WrapOffset;
  end;
  { Increment FDisableAlignArrange so that we don't recursively arrange when
    CalculatePositions moves controls }
  Inc(FToolbar.FDisableAlignArrange);
  try
    inherited;
  finally
    Dec(FToolbar.FDisableAlignArrange);
  end;
end;

procedure TTBToolbarView.InvalidatePositions;
begin
  { Reset CurrentSize because it probably won't be valid after positions
    are recalculated [2001-06-04] }
  FToolbar.CurrentSize := 0;
  inherited;
end;

function TTBToolbarView.GetFont: TFont;
begin
  if not FToolbar.SystemFont then
    Result := FToolbar.Font
  else
    Result := inherited GetFont;
end;

function TTBToolbarView.GetChevronItem: TTBCustomItem;
begin
  Result := FToolbar.FChevronItem;
end;

function TTBToolbarView.GetMDIButtonsItem: TTBCustomItem;
begin
  Result := FToolbar.FMDIButtonsItem;
end;

function TTBToolbarView.GetMDISystemMenuItem: TTBCustomItem;
begin
  Result := FToolbar.FMDISystemMenuItem;
end;

procedure TTBToolbarView.EnterToolbarLoop(Options: TTBEnterToolbarLoopOptions);
begin
  inherited;
  if Assigned(FToolbar.OnEndModal) then
    FToolbar.OnEndModal(FToolbar);
end;

{ TTBCustomToolbar }

type
  {}TTBCustomItemAccess = class(TTBCustomItem);
  TTBItemViewerAccess = class(TTBItemViewer);

constructor TTBCustomToolbar.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csAcceptsControls, csActionClient] -
    [csCaptureMouse];
  DockableWindowStyles := DockableWindowStyles - [tbdsResizeEightCorner,
    tbdsResizeClipCursor];
  FItem := GetItemClass.Create(Self);
  FItem.ParentComponent := Self;
  FChevronItem := GetChevronItemClass.Create(Self);
  FChevronItem.LinkSubitems := FItem;
  FChevronMoveItems := True;
  FChevronMenu := False;
  FView := GetViewClass.CreateView(Self, nil, FItem, Self, True, False,
    not(csDesigning in ComponentState));
  // This might as well go to TTBToolbarView.Create
  FView.Style := FView.Style + [vsUseHiddenAccels];
  FView.BackgroundColor := clBtnFace;
  FUpdateActions := True;
  FShrinkMode := tbsmChevron;
  FSystemFont := True;
  Color := clBtnFace;
  SetBounds(Left, Top, 23, 22);{}
  { MP }
  FOnGetBaseSize := nil;
  FOnEndModal := nil;
end;

destructor TTBCustomToolbar.Destroy;
begin
  { Call Destroying to ensure csDestroying is in ComponentState now. Only
    needed for Delphi 4 and earlier since Delphi 5 calls Destroying in
    TComponent.BeforeDestruction }
  Destroying;
  UninstallHookProc(Self, HookProc);
  UninstallMainWindowHook;
  FreeAndNil(FView);
  FreeAndNil(FChevronItem);
  FreeAndNil(FItem);
  inherited;
end;

function TTBCustomToolbar.GetItems: TTBCustomItem;
begin
  Result := FItem;
end;

function TTBCustomToolbar.GetItemClass: TTBRootItemClass;
begin
  Result := TTBRootItem;
end;

function TTBCustomToolbar.GetViewClass: TTBToolbarViewClass;
begin
  Result := TTBToolbarView;
end;

function TTBCustomToolbar.GetChevronItemClass: TTBChevronItemClass;
begin
  Result := TTBChevronItem;
end;

procedure TTBCustomToolbar.CreateWrappersForAllControls;
{ Create wrappers for any controls that don't already have them }
var
  L: TList;
  I, J, C: Integer;
begin
  if ControlCount = 0 then
    Exit;
  L := TList.Create;
  try
    L.Capacity := ControlCount;
    for I := 0 to ControlCount-1 do
      L.Add(Controls[I]);
    C := FItem.Count-1;
    for I := 0 to C do
      if FItem[I] is TTBControlItem then begin
        J := L.IndexOf(TTBControlItem(FItem[I]).Control);
        if J <> -1 then
          L[J] := nil;
      end;
    for I := 0 to L.Count-1 do
      if Assigned(L[I]) then
        CreateWrapper(FItem.Count, L[I]);
  finally
    L.Free;
  end;
end;

procedure TTBCustomToolbar.Loaded;
begin
  CreateWrappersForAllControls;
  inherited;
end;

procedure TTBCustomToolbar.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
  TTBCustomItemAccess(FItem).GetChildren(Proc, Root);
  inherited;
end;

procedure TTBCustomToolbar.SetChildOrder(Child: TComponent; Order: Integer);
begin
  if Child is TTBCustomItem then
    TTBCustomItemAccess(FItem).SetChildOrder(Child, Order);
end;

procedure TTBCustomToolbar.AlignControls(AControl: TControl; var Rect: TRect);
{ VCL calls this whenever any child controls in the toolbar are moved, sized,
  inserted, etc., and also when the toolbar is resized. }
begin
  if FDisableAlignArrange = 0 then
    Arrange;
end;

procedure TTBCustomToolbar.InitiateAction;
begin
  inherited;
  {}{ also add this to popupmenu(?) }
  { Update visible top-level items }
  if FUpdateActions then
    FView.InitiateActions;
end;

procedure TTBCustomToolbar.CMColorChanged(var Message: TMessage);
begin
  { Synchronize FView.BackgroundColor with the new color }
  if Assigned(FView) then
    FView.BackgroundColor := Color;
  inherited;
end;

function TTBCustomToolbar.CreateWrapper(Index: Integer;
  Ctl: TControl): TTBControlItem;
var
  I: Integer;
  S: String;
begin
  Result := TTBControlItem.CreateControlItem(Owner, Ctl);
  if (csDesigning in ComponentState) and Assigned(Owner) then begin
    { Needs a name for compatibility with form inheritance }
    I := 1;
    while True do begin
      S := Format('TBControlItem%d', [I]);
      if Owner.FindComponent(S) = nil then
        Break;
      Inc(I);
    end;
    Result.Name := S;
  end;
  FItem.Insert(Index, Result);
end;

function TTBCustomToolbar.FindWrapper(Ctl: TControl): TTBControlItem;
var
  I: Integer;
  Item: TTBCustomItem;
begin
  Result := nil;
  for I := 0 to FItem.Count-1 do begin
    Item := FItem[I];
    if (Item is TTBControlItem) and
       (TTBControlItem(Item).Control = Ctl) then begin
      Result := TTBControlItem(Item);
      Break;
    end;
  end;
end;

procedure TTBCustomToolbar.CMControlChange(var Message: TCMControlChange);
{ A CM_CONTROLCHANGE handler must be used instead of a CM_CONTROLLISTCHANGE
  handler because when a CM_CONTROLLISTCHANGE message is sent it is relayed to
  *all* parents. CM_CONTROLCHANGE messages are only sent to the immediate
  parent. }
begin
  inherited;
  { Don't automatically create TTBControlItem wrappers if the component
    is loading or being updated to reflect changes in an ancestor form,
    because wrappers will be streamed in }
  if Message.Inserting and not(csLoading in ComponentState) and
     not(csUpdating in ComponentState) and
     (FindWrapper(Message.Control) = nil) then
    CreateWrapper(FItem.Count, Message.Control);
end;

procedure TTBCustomToolbar.CMControlListChange(var Message: TCMControlListChange);
{ Don't handle deletions inside CM_CONTROLCHANGE because CM_CONTROLCHANGE is
  sent *before* a control begins removing itself from its parent. (It used
  to handle both insertions and deletions inside CM_CONTROLCHANGE but this
  caused AV's.) }
var
  Item: TTBControlItem;
begin
  inherited;
  if not Message.Inserting and Assigned(FItem) then begin
    while True do begin
      Item := FindWrapper(Message.Control);
      if Item = nil then Break;
      { The control is being removed the control, not necessarily destroyed,
        so set DontFreeControl to True }
      Item.DontFreeControl := True;
      Item.Free;
    end;
  end;
end;

procedure TTBCustomToolbar.CMHintShow(var Message: TCMHintShow);
{ Since the items on a toolbar aren't "real" controls, it needs a CM_HINTSHOW
  handler for their hints to be displayed. }
var
  V: TTBItemViewer;
begin
  with Message.HintInfo^ do begin
    HintStr := '';
    V := FView.ViewerFromPoint(CursorPos);
    if Assigned(V) then begin
      if not IsRectEmpty(V.BoundsRect) then begin
        CursorRect := V.BoundsRect;
        HintStr := V.GetHintText;
      end;
    end;
  end;
end;

procedure TTBCustomToolbar.CMShowHintChanged(var Message: TMessage);
begin
  inherited;
  if ShowHint then
    FView.Style := FView.Style + [vsAlwaysShowHints]
  else
    FView.Style := FView.Style - [vsAlwaysShowHints];
end;

procedure TTBCustomToolbar.WMGetObject(var Message: TMessage);
begin
  if not FView.HandleWMGetObject(Message) then
    inherited;
end;

procedure TTBCustomToolbar.WMSetCursor(var Message: TWMSetCursor);
var
  P: TPoint;
  Cursor: HCURSOR;
  R: TRect;
begin
  if not(csDesigning in ComponentState) and
     (Message.CursorWnd = WindowHandle) and
     (Smallint(Message.HitTest) = HTCLIENT) then begin
    GetCursorPos(P);
    FView.UpdateSelection(@P, True);
    if Assigned(FView.Selected) then begin
      Cursor := 0;
      R := FView.Selected.BoundsRect;
      P := ScreenToClient(P);
      Dec(P.X, R.Left);
      Dec(P.Y, R.Top);
      TTBItemViewerAccess(FView.Selected).GetCursor(P, Cursor);
      if Cursor <> 0 then begin
        SetCursor(Cursor);
        Message.Result := 1;
        Exit;
      end;
    end;
  end;
  inherited;
end;

procedure TTBCustomToolbar.WMSysCommand(var Message: TWMSysCommand);
begin
  if FMenuBar and Enabled and Showing then
    with Message do
      if (CmdType and $FFF0 = SC_KEYMENU) and (Key <> VK_SPACE) and
         (GetCapture = 0) then begin
        if not KeyboardOpen(Char(Key), False) then begin
          if Key = Ord('-') then Exit;
          MessageBeep(0);
        end;
        Result := 1;
      end;
end;

procedure TTBCustomToolbar.Paint;
var
  R: TRect;
begin
  { Draw dotted border in design mode on undocked toolbars }
  if not Docked and (csDesigning in ComponentState) then
    with Canvas do begin
      R := ClientRect;
      Pen.Style := psDot;
      Pen.Color := clBtnShadow;
      Brush.Style := bsClear;
      Rectangle(R.Left, R.Top, R.Right, R.Bottom);
      Pen.Style := psSolid;
    end;
  FView.DrawSubitems(Canvas);
end;

procedure TTBCustomToolbar.CMDialogKey(var Message: TCMDialogKey);
begin
  if (Message.CharCode = VK_MENU) and FMenuBar then
    FView.SetAccelsVisibility(True);
  inherited;
end;

procedure TTBCustomToolbar.Idle;
begin
  if FMenuBar and
     (not (vsModal in FView.State)) and
     ((GetAsyncKeyState(VK_MENU) and $8000) = 0) then
  begin
    FView.SetAccelsVisibility(False);
  end;
end;

procedure TTBCustomToolbar.CMDialogChar(var Message: TCMDialogChar);
begin
  { On toolbars that aren't menu bars, handle CM_DIALOGCHAR instead of
    WM_SYSCOMMAND }
  if not FMenuBar and Enabled and Showing and (Message.CharCode <> 0) then
    if KeyboardOpen(Chr(Message.CharCode), True) then begin
      Message.Result := 1;
      Exit;
    end;
  inherited;
end;

procedure TTBCustomToolbar.CancelHover;
begin
  if not MouseCapture then
    FView.UpdateSelection(nil, True);
end;

procedure TTBCustomToolbar.CMMouseLeave(var Message: TMessage);
begin
  CancelHover;
  inherited;
end;

procedure TTBCustomToolbar.DoContextPopup(MousePos: TPoint;
  var Handled: Boolean);
begin
  CancelHover;
  inherited;
end;

procedure TTBCustomToolbar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
  Item: TTBCustomItem;
begin
  if not(csDesigning in ComponentState) then begin
    P := ClientToScreen(Point(X, Y));
    FView.UpdateSelection(@P, True);
    if Assigned(FView.Selected) then begin
      Item := FView.Selected.Item;
      if not(tboLongHintInMenuOnly in Item.EffectiveOptions) then
        Hint := Item.Hint
      else
        Hint := '';

      with TTBItemViewerAccess(FView.Find(Item)) do
      begin
        MouseMove(X - BoundsRect.Left, Y - BoundsRect.Top);
      end;
    end
    else
      Hint := '';
  end;
  { Call TrackMouseEvent to be sure that we are notified when the mouse leaves
    the window. We won't get a CM_MOUSELEAVE message if the mouse moves
    directly from the toolbar to another application's window }
  CallTrackMouseEvent(Handle, TME_LEAVE);
  inherited;
end;

procedure TTBCustomToolbar.WMCancelMode(var Message: TWMCancelMode);
begin
  inherited;
  { We can receive a WM_CANCELMODE message during a modal loop if a dialog
    pops up. Respond by hiding menus to make it look like the modal loop
    has returned, even though it really hasn't yet.
    Note: Similar code in TTBModalHandler.WndProc. }
  if vsModal in FView.State then
    FView.CancelMode;
end;

procedure TTBCustomToolbar.WMMouseLeave(var Message: TMessage);
begin
  { A WM_MOUSELEAVE handler is necessary because the control won't get a
    CM_MOUSELEAVE message if the user presses Alt+Space. Also, CM_MOUSELEAVE
    messages are also not sent if the application is in a
    Application.ProcessMessages loop. }
  if not FIgnoreMouseLeave then
    CancelHover;
  inherited;
end;

procedure TTBCustomToolbar.WMNCMouseMove(var Message: TWMNCMouseMove);
begin
  Hint := '';
  CancelHover;
  inherited;
end;

function TTBCustomToolbar.KeyboardOpen(Key: Char;
  RequirePrimaryAccel: Boolean): Boolean;
var
  I: TTBItemViewer;
  IsOnlyItemWithAccel: Boolean;
begin
  I := nil;
  FView.SetAccelsVisibility(True);
  try
    Result := False;
    if Key = #0 then begin
      I := FView.FirstSelectable;
      if I = nil then Exit;
      FView.Selected := I;
      FView.EnterToolbarLoop([]);
    end
    else begin
      I := FView.NextSelectableWithAccel(nil, Key, RequirePrimaryAccel,
        IsOnlyItemWithAccel);
      if (I = nil) or not I.Item.Enabled then
        Exit;
      if IsOnlyItemWithAccel then begin
        FView.Selected := I;
        FView.EnterToolbarLoop([tbetExecuteSelected]);
      end
      else if FMenuBar then begin
        FView.Selected := I;
        FView.EnterToolbarLoop([]);
      end
      else
        Exit;
    end;
    Result := True;
  finally
    if Assigned(I) then
      FView.SetAccelsVisibility(False);
  end;
end;

procedure TTBCustomToolbar.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  OldParent: TWinControl;
  P: TPoint;
  Item: TTBCustomItem;
begin
  OldParent := Parent;
  inherited;
  if Parent <> OldParent then
    { if the inherited handler (TTBDockableWindow.MouseDown) changed the Parent
      (due to the toolbar moving between docks), nothing else should be done }
    Exit;
  if not(csDesigning in ComponentState) and (Button = mbLeft) then begin
    P := ClientToScreen(Point(X, Y));
    FView.UpdateSelection(@P, True);
    if Assigned(FView.Selected) then begin
      Item := FView.Selected.Item;
      if not(tbisClicksTransparent in TTBCustomItemAccess(Item).ItemStyle) then begin
        FIgnoreMouseLeave := True;
        try
          FView.EnterToolbarLoop([tbetMouseDown]);
        finally
          FIgnoreMouseLeave := False;
        end;
      end;
    end;
  end;
end;

procedure TTBCustomToolbar.CMFontChanged(var Message: TMessage);
begin
  inherited;
  if not FSystemFont then
    Arrange;
end;

function TTBCustomToolbar.GetChevronHint: String;
begin
  Result := FChevronItem.Hint;
end;

procedure TTBCustomToolbar.SetChevronHint(const Value: String);
begin
  FChevronItem.Hint := Value;
  FChevronItem.Caption := EscapeAmpersands(GetShortHint(Value));
end;

procedure TTBCustomToolbar.SetChevronMoveItems(Value: Boolean);
begin
  if FChevronMoveItems <> Value then begin
    FChevronMoveItems := Value;
    FView.UsePriorityList := Value and not(csDesigning in ComponentState);
  end;
end;

procedure TTBCustomToolbar.SetChevronPriorityForNewItems(Value: TTBChevronPriorityForNewItems);
begin
  FChevronPriorityForNewItems := Value;
  FView.NewViewersGetHighestPriority := (Value = tbcpHighest);
end;

function TTBCustomToolbar.IsChevronHintStored: Boolean;
begin
  Result := (FChevronItem.Hint <> FChevronItem.GetDefaultHint);
end;

function TTBCustomToolbar.GetImages: TCustomImageList;
begin
  Result := FItem.SubMenuImages;
end;

procedure TTBCustomToolbar.SetImages(Value: TCustomImageList);
begin
  FItem.SubMenuImages := Value;
end;

function TTBCustomToolbar.GetLinkSubitems: TTBCustomItem;
begin
  Result := FItem.LinkSubitems;
end;

procedure TTBCustomToolbar.SetLinkSubitems(Value: TTBCustomItem);
begin
  FItem.LinkSubitems := Value;
end;

procedure TTBCustomToolbar.SetMenuBar(Value: Boolean);
begin
  if FMenuBar <> Value then begin
    FMenuBar := Value;
    if Value then begin
      ControlStyle := ControlStyle + [csMenuEvents];
      FView.Style := FView.Style + [vsMenuBar];
    end
    else begin
      ControlStyle := ControlStyle - [csMenuEvents];
      FView.Style := FView.Style - [vsMenuBar];
    end;
    if not(csLoading in ComponentState) then begin
      FullSize := Value;
      if Value then
        ShrinkMode := tbsmWrap
      else
        ShrinkMode := tbsmChevron;
      CloseButton := not Value;
      ProcessShortCuts := Value;
    end;
    if Value and not(csDesigning in ComponentState) then
      InstallHookProc(Self, HookProc, [hpGetMessage])
    else
      UninstallHookProc(Self, HookProc);
    SetMainWindowHook;
  end;
end;

function TTBCustomToolbar.GetOptions: TTBItemOptions;
begin
  Result := FItem.Options;
end;

procedure TTBCustomToolbar.SetOptions(Value: TTBItemOptions);
begin
  FItem.Options := Value;
end;

procedure TTBCustomToolbar.SetProcessShortCuts(Value: Boolean);
begin
  if FProcessShortCuts <> Value then begin
    FProcessShortCuts := Value;
    SetMainWindowHook;
  end;
end;

procedure TTBCustomToolbar.SetSystemFont(Value: Boolean);
begin
  if FSystemFont <> Value then begin
    FSystemFont := Value;
    Arrange;
  end;
end;

procedure TTBCustomToolbar.SetShrinkMode(Value: TTBShrinkMode);
begin
  if FShrinkMode <> Value then begin
    FShrinkMode := Value;
    if Docked then
      CurrentDock.ArrangeToolbars
    else if not Floating then
      Arrange;
  end;
end;

procedure TTBCustomToolbar.SetFloatingWidth(Value: Integer);
begin
  if FFloatingWidth <> Value then begin
    FFloatingWidth := Value;
    if Floating then begin
      UpdateViewProperties;
      Arrange;
    end;
  end;
end;

function TTBCustomToolbar.CalcWrapOffset(const ADock: TTBDock): Integer;
begin
  if ADock = nil then
    Result := FFloatingWidth
  else begin
    if FShrinkMode = tbsmWrap then begin
      if not(ADock.Position in [dpLeft, dpRight]) then
        Result := ADock.Width - ADock.NonClientWidth - NonClientWidth
      else
        Result := ADock.Height - ADock.NonClientHeight - NonClientHeight;
    end
    else
      Result := 0;
  end;
end;

function TTBCustomToolbar.CalcChevronOffset(const ADock: TTBDock;
  const AOrientation: TTBViewOrientation): Integer;
begin
  if (FShrinkMode = tbsmChevron) and Docked and (ADock = CurrentDock) then begin
    Result := CurrentSize;
    { Subtract non-client size }
    if AOrientation <> tbvoVertical then
      Dec(Result, NonClientWidth)
    else
      Dec(Result, NonClientHeight);
    if Result < 0 then
      Result := 0;  { in case CurrentSize wasn't properly initialized yet }
  end
  else
    Result := 0;
end;

procedure TTBCustomToolbar.UpdateViewProperties;
var
  DT: TTBDockType;
begin
  DT := TBGetDockTypeOf(CurrentDock, Floating);
  FView.Orientation := DockTypeToOrientation[DT];
  FView.ChevronSize := tbChevronSize;
  if Assigned(CurrentDock) or Floating then begin
    FView.ChevronOffset := CalcChevronOffset(CurrentDock, FView.Orientation);
    FView.WrapOffset := CalcWrapOffset(CurrentDock);
  end
  else begin
    FView.ChevronOffset := 0;
    FView.WrapOffset := 0;
    { Only enable chevron/wrapping when the width of the toolbar is fixed }
    if not AutoResize or ((akLeft in Anchors) and (akRight in Anchors)) then begin
      if FShrinkMode = tbsmChevron then
        FView.ChevronOffset := Width - NonClientWidth
      else if FShrinkMode = tbsmWrap then
        FView.WrapOffset := Width - NonClientWidth;
    end;
  end;
end;

{}{DOCKING STUFF}

procedure TTBCustomToolbar.ReadPositionData(var S: string);
begin
  inherited;
  if Floating then
    FloatingWidth := StrToIntDef(CutToChar(S, ':', true), 0);
end;

function TTBCustomToolbar.WritePositionData: string;
begin
  Result := inherited;
  if Floating then
    Result := Result + ':' + IntToStr(FFloatingWidth);
end;

procedure TTBCustomToolbar.GetMinBarSize(var MinimumSize: TPoint);
var
  WH: Integer;
begin
  MinimumSize.X := 0;
  MinimumSize.Y := 0;
  if Docked then begin
    WH := CurrentDock.GetMinRowSize(EffectiveDockRow, Self);
    if not(CurrentDock.Position in [dpLeft, dpRight]) then
      MinimumSize.Y := WH
    else
      MinimumSize.X := WH;
  end;
end;

procedure TTBCustomToolbar.GetBaseSize(var ASize: TPoint);
begin
  FView.ValidatePositions;
  ASize := FBaseSize;
  { MP }
  if Assigned(FOnGetBaseSize) then FOnGetBaseSize(Self, ASize);
end;

function TTBCustomToolbar.DoArrange(CanMoveControls: Boolean;
  PreviousDockType: TTBDockType; NewFloating: Boolean; NewDock: TTBDock): TPoint;
var
  DT: TTBDockType;
  O: TTBViewOrientation;
  TempBaseSize: TPoint;
begin
  //outputdebugstring (pchar(format('%s.DoArrange(%d)', [Name, Ord(CanMoveControls)])));
  if CanMoveControls then begin
    UpdateViewProperties;
    Result := FView.UpdatePositions;
  end
  else begin
    DT := TBGetDockTypeOf(NewDock, NewFloating);
    O := DockTypeToOrientation[DT];
    Result.X := 0;
    Result.Y := 0;
    FView.CalculatePositions(False, O, CalcWrapOffset(NewDock),
      CalcChevronOffset(NewDock, O), tbChevronSize, TempBaseSize, Result,
      FLastWrappedLines);
  end;
end;

procedure TTBCustomToolbar.ControlExistsAtPos(const P: TPoint;
  var ControlExists: Boolean);
var
  P2: TPoint;
begin
  inherited;
  if not ControlExists and not(csDesigning in ComponentState) then begin
    P2 := ClientToScreen(P);
    FView.UpdateSelection(@P2, True);
    if Assigned(FView.Selected) and
       not(tbisClicksTransparent in TTBCustomItemAccess(FView.Selected.Item).ItemStyle) then
      ControlExists := True;
  end;
end;

procedure TTBCustomToolbar.BuildPotentialSizesList(SizesList: TList);
var
  Margins: TRect;
  MinX, SaveWrapX: Integer;
  X, PrevWrappedLines: Integer;
  S: TPoint;
  S2: TSmallPoint;
begin
  View.GetMargins(tbvoFloating, Margins);
  MinX := Margins.Left + Margins.Right;
  SaveWrapX := FFloatingWidth;
  try
    { Add the widest size to the list }
    FFloatingWidth := 0;
    S := DoArrange(False, dtNotDocked, True, nil);
    SizesList.Add(Pointer(PointToSmallPoint(S)));
    { Calculate and add rest of sizes to the list }
    PrevWrappedLines := 1;
    X := S.X-1;
    while X >= MinX do begin
      FFloatingWidth := X;
      S := DoArrange(False, dtNotDocked, True, nil);
      if S.X > X then  { if it refuses to go any smaller }
        Break
      else
      if X = S.X then begin
        S2 := PointToSmallPoint(S);
        if FLastWrappedLines <> PrevWrappedLines then
          SizesList.Add(Pointer(S2))
        else
          SizesList[SizesList.Count-1] := Pointer(S2);
        PrevWrappedLines := FLastWrappedLines;
        Dec(X);
      end
      else
        X := S.X;
    end;
  finally
    FFloatingWidth := SaveWrapX;
  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 TTBCustomToolbar.ResizeBegin(ASizeHandle: TTBSizeHandle);
const
  MaxSizeSens = 12;
var
  I, NewSize: Integer;
  S, N: TSmallPoint;
  P: TPoint;
begin
  inherited;

  FSizeData := AllocMem(SizeOf(TToolbar97SizeData));

  with PToolbar97SizeData(FSizeData)^ do begin
    SizeHandle := ASizeHandle;
    OrigLeft := Parent.Left;
    OrigTop := Parent.Top;
    OrigWidth := Parent.Width;
    OrigHeight := Parent.Height;
    NCXDiff := ClientToScreen(Point(0, 0)).X - OrigLeft;
    CurRightX := FFloatingWidth;
    DisableSensCheck := False;
    OpSide := False;

    NewSizes := TList.Create;
    BuildPotentialSizesList(NewSizes);
    for I := 0 to NewSizes.Count-1 do begin
      P := SmallPointToPoint(TSmallPoint(NewSizes.List[I]));
      AddFloatingNCAreaToSize(P);
      NewSizes.List[I] := Pointer(PointToSmallPoint(P));
    end;
    ListSortEx(NewSizes, CompareNewSizes,
      Pointer(Ord(ASizeHandle in [twshTop, twshBottom])));

    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 ASizeHandle in [twshLeft, twshRight] 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 ASizeHandle in [twshLeft, twshRight] 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 TTBCustomToolbar.ResizeTrack(var Rect: TRect; const OrigRect: TRect);
var
  Pos: TPoint;
  NewOpSide: Boolean;
  Reverse: Boolean;
  I: Integer;
  P: TSmallPoint;
begin
  inherited;

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

    Dec(Pos.X, OrigLeft);  Dec(Pos.Y, OrigTop);
    if SizeHandle = twshLeft then
      Pos.X := OrigWidth-Pos.X
    else
    if SizeHandle = twshTop then
      Pos.Y := OrigHeight-Pos.Y;

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

    Rect := OrigRect;

    if SizeHandle in [twshLeft, twshRight] then
      Reverse := Pos.X > OrigWidth
    else
      Reverse := Pos.Y > OrigHeight;
    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 SizeHandle in [twshLeft, twshRight] 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 SizeHandle = twshRight 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 SizeHandle = twshBottom 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 TTBCustomToolbar.ResizeTrackAccept;
begin
  inherited;
  FloatingWidth := PToolbar97SizeData(FSizeData)^.CurRightX;
end;

procedure TTBCustomToolbar.ResizeEnd;
begin
  inherited;
  if Assigned(FSizeData) then begin
    PToolbar97SizeData(FSizeData)^.NewSizes.Free;
    FreeMem(FSizeData);
    FSizeData := nil;
  end;
end;

function TTBCustomToolbar.GetShrinkMode: TTBShrinkMode;
begin
  Result := FShrinkMode;
end;

procedure TTBCustomToolbar.GetMinShrinkSize(var AMinimumSize: Integer);
var
  I: TTBItemViewer;
begin
  I := FView.HighestPriorityViewer;
  if Assigned(I) then begin
    if not(CurrentDock.Position in [dpLeft, dpRight]) then
      AMinimumSize := I.BoundsRect.Right - I.BoundsRect.Left
    else
      AMinimumSize := I.BoundsRect.Bottom - I.BoundsRect.Top;
  end;
  if not(CurrentDock.Position in [dpLeft, dpRight]) then
    Inc(AMinimumSize, NonClientWidth)
  else
    Inc(AMinimumSize, NonClientHeight);
  Inc(AMinimumSize, tbChevronSize);
end;

procedure TTBCustomToolbar.BeginUpdate;
begin
  FView.BeginUpdate;
end;

procedure TTBCustomToolbar.EndUpdate;
begin
  FView.EndUpdate;
end;

procedure TTBCustomToolbar.GetTabOrderList(List: TList);
var
  CtlList: TList;
  I, J: Integer;
  CtlI, CtlJ: TWinControl;
begin
  inherited;
  { Remove off-edge items and their children from List }
  CtlList := TList.Create;
  try
    FView.GetOffEdgeControlList(CtlList);
    for I := 0 to CtlList.Count-1 do begin
      CtlI := CtlList[I];
      J := 0;
      while J < List.Count do begin
        CtlJ := List[J];
        if (CtlJ = CtlI) or CtlI.ContainsControl(CtlJ) then
          List.Delete(J)
        else
          Inc(J);
      end;
    end;
  finally
    CtlList.Free;
  end;
end;

procedure TTBCustomToolbar.CMWinIniChange(var Message: TWMSettingChange);
begin
  inherited;
  if Message.Flag = SPI_SETNONCLIENTMETRICS then begin
    TBInitToolbarSystemFont;
    Arrange;
  end;
end;

function TTBCustomToolbar.IsShortCut(var Message: TWMKey): Boolean;
begin
  Result := False;
  if Assigned(FOnShortCut) then
    FOnShortCut(Message, Result);
  Result := Result or FItem.IsShortCut(Message);
end;

var
  HookCount: Integer;
  HookList: TList;

class function TTBCustomToolbar.MainWindowHook(var Message: TMessage): Boolean;

  function GetActiveForm: TCustomForm;
  var
    Wnd: HWND;
    Ctl: TWinControl;
  begin
    { Note: We don't use Screen.ActiveCustomForm because when an EXE calls a
      DLL that shows a modal form, Screen.ActiveCustomForm doesn't change in
      the EXE; it remains set to the last form that was active in the EXE.
      Use FindControl(GetActiveWindow) instead to avoid this problem; it will
      return nil when a form in another module is active. }
    Result := nil;
    Wnd := GetActiveWindow;
    if Wnd <> 0 then begin
      Ctl := FindControl(Wnd);
      if Assigned(Ctl) and (Ctl is TCustomForm) then
        Result := TCustomForm(Ctl);
    end;
  end;

  function HandleShortCutOnForm(const Form: TCustomForm): Boolean;
  var
    I: Integer;
    Toolbar: TTBCustomToolbar;
  begin
    Result := False;
    if Form = nil then
      Exit;
    for I := 0 to HookList.Count-1 do begin
      Toolbar := HookList[I];
      if Toolbar.ProcessShortCuts and
         (TBGetToolWindowParentForm(Toolbar) = Form) and
         IsWindowEnabled(Form.Handle) and
         Toolbar.IsShortCut(TWMKey(Message)) then begin
        Message.Result := 1;
        Result := True;
        Exit;
      end;
    end;
  end;

  function TraverseControls(Container: TWinControl): Boolean;
  var
    I: Integer;
    Control: TControl;
  begin
    Result := False;
    if Container.Showing then
      for I := 0 to Container.ControlCount - 1 do begin
        Control := Container.Controls[I];
        if Control.Visible and Control.Enabled then begin
          if (csMenuEvents in Control.ControlStyle) and
             ((Control is TTBDock) or (Control is TTBCustomToolbar)) and
             (Control.Perform(WM_SYSCOMMAND, TMessage(Message).WParam,
               TMessage(Message).LParam) <> 0) or (Control is TWinControl) and
             TraverseControls(TWinControl(Control)) then begin
            Result := True;
            Exit;
          end;
        end;
      end;
  end;

var
  ActiveForm: TCustomForm;
  ActiveMDIChild: TForm;
begin
  Result := False;
  if (Message.Msg = CM_APPKEYDOWN) and Assigned(HookList) then begin
    { Process shortcuts on toolbars. Search forms in this order:
      1. If the active form is an MDI parent form, the active MDI child form
         if it has the focus.
      2. The active form.
      3. The main form. }
    ActiveForm := GetActiveForm;
    if Assigned(ActiveForm) and (ActiveForm is TForm) and
       (TForm(ActiveForm).FormStyle = fsMDIForm) then begin
      ActiveMDIChild := TForm(ActiveForm).ActiveMDIChild;
      { Don't search the child form if a control on the MDI parent form is
        currently focused (i.e. Screen.ActiveCustomForm <> ActiveMDIChild) }
      if Assigned(ActiveMDIChild) and
         (Screen.ActiveCustomForm = ActiveMDIChild) and
         HandleShortCutOnForm(ActiveMDIChild) then begin
        Result := True;
        Exit;
      end;
    end;
    if HandleShortCutOnForm(ActiveForm) then
      Result := True
    else begin
      if (Application.MainForm <> ActiveForm) and
         HandleShortCutOnForm(Application.MainForm) then
        Result := True;
    end;
  end
  else if Message.Msg = CM_APPSYSCOMMAND then begin
    { Handle "Alt or Alt+[key] pressed on secondary form" case. If there's a
      menu bar on the active form we want the keypress to go to it instead of
      to the main form (the VCL's default handling). }
    ActiveForm := GetActiveForm;
    if Assigned(ActiveForm) and IsWindowEnabled(ActiveForm.Handle) and
       IsWindowVisible(ActiveForm.Handle) and TraverseControls(ActiveForm) then begin
      Message.Result := 1;
      Result := True;
    end;
  end;
end;

procedure TTBCustomToolbar.SetMainWindowHook;
begin
  if (ProcessShortCuts or MenuBar) and not(csDesigning in ComponentState) then
    InstallMainWindowHook
  else
    UninstallMainWindowHook;
end;

procedure TTBCustomToolbar.InstallMainWindowHook;
begin
  if FMainWindowHookInstalled then
    Exit;
  if HookCount = 0 then
    Application.HookMainWindow(MainWindowHook);
  Inc(HookCount);
  AddToList(HookList, Self);
  FMainWindowHookInstalled := True;
end;

procedure TTBCustomToolbar.UninstallMainWindowHook;
begin
  if not FMainWindowHookInstalled then
    Exit;
  FMainWindowHookInstalled := False;
  RemoveFromList(HookList, Self);
  Dec(HookCount);
  if HookCount = 0 then
    Application.UnhookMainWindow(MainWindowHook);
end;

procedure TTBCustomToolbar.ChangeScale(M, D: Integer; isDpiChange: Boolean);
begin
  inherited;
  Items.ChangeScale(M, D);
  View.RecreateAllViewers;
end;

end.