{*
 * TBX Package
 * Copyright 2001-2013 Alex A. Denisov and contributors. All rights reserved.
 *
 * The MIT License (MIT)
 *
 * Permission is hereby granted, free of charge, to any person obtaining
 * a copy of this software and associated documentation files (the "Software"),
 * to deal in the Software without restriction, including without limitation
 * the rights to use, copy, modify, merge, publish, distribute, sublicense,
 * and/or sell copies of the Software, and to permit persons to whom
 * the Software is furnished to do so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be included
 * in all copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 * OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
 * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
 * IN THE SOFTWARE.
 *}

unit TBX;

interface

{$I TB2Ver.inc}
{$I TBX.inc}

{x$DEFINE TBX_NO_ANIMATION}
  { Enabling the above define disables all menu animation. For debugging
    purpose only. }

uses
  Windows, Messages, Classes, SysUtils, Controls, Graphics, ImgList, Forms,
  {$IFDEF JR_D17} UITypes,{$ENDIF}
  TB2Item, TB2Dock, TB2Toolbar, TB2ToolWindow, TB2Anim, TBXUtils, TBXThemes;

const
  TBXVersion = 2.5;
  TBXVersionString = '2.5';
  TBXVersionText = 'TBX version ' + TBXVersionString;

{ TBX Messages }
const
  TBM_THEMECHANGE = WM_USER + 314;
  TBM_GETVIEWTYPE = WM_USER + 237;
  TBM_GETEFFECTIVECOLOR = WM_USER + 238;

function GetViewType(View: TTBView): Integer;
function GetWinViewType(Window: TControl): Integer;
function IsFloating(ViewType: Integer): Boolean;

type
  TTextWrapping = (twNone, twEndEllipsis, twPathEllipsis, twWrap);
  TTextTruncation = twNone..twPathEllipsis;
  TTriState = (tsDefault, tsTrue, tsFalse);
  TFontSize = 25..1000;

  TFontSettings = class(TPersistent)
  private
    FBold: TTriState;
    FItalic: TTriState;
    FUnderline: TTriState;
    FStrikeOut: TTriState;
    FSize: TFontSize;
    FColor: TColor;
    FName: TFontName;
    FOnChange: TNotifyEvent;
    procedure SetBold(Value: TTriState);
    procedure SetColor(Value: TColor);
    procedure SetItalic(Value: TTriState);
    procedure SetName(const Value: TFontName);
    procedure SetSize(Value: TFontSize);
    procedure SetStrikeOut(Value: TTriState);
    procedure SetUnderline(Value: TTriState);
  protected
    procedure Modified;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  public
    constructor Create;
    procedure Apply(Font: TFont); overload;
    procedure Apply(var LF: TLogFont; var FontColor: TColor); overload;
    procedure Assign(Src: TPersistent); override;
    function  CreateTransformedFont(Src: HFont; var FontColor: TColor): HFont;
  published
    property Bold: TTriState read FBold write SetBold default tsDefault;
    property Italic: TTriState read FItalic write SetItalic default tsDefault;
    property Underline: TTriState read FUnderline write SetUnderline default tsDefault;
    property StrikeOut: TTriState read FStrikeOut write SetStrikeOut default tsDefault;
    property Size: TFontSize read FSize write SetSize default 100;  // percent
    property Color: TColor read FColor write SetColor default clNone;
    property Name: TFontName read FName write SetName;   // default ''
  end;

  TTBXPopupPositionInfo = record
    Item: TTBCustomItem;         // this is a tentative type, it will be changed
    ParentView: TTBView;         // or removed in future versions
    ParentViewer: TTBItemViewer;
    PositionAsSubmenu: Boolean;
    APopupPoint: TPoint;
    Alignment: TTBPopupAlignment;
    PopupWindow: TTBPopupWindow;
    X, Y: Integer;
    ParentItemRect: TRect;
    AppFlags: Integer;           // reserved for extensions
    AppData: Integer;
  end;

  TTBXThemeClass = class of TTBXTheme;

function GetStateFlags(const ItemInfo: TTBXItemInfo): Integer;
function GetTBXTextColor(StateFlags: Integer): TColor;
procedure DrawTBXCaption(Canvas: TCanvas; const Rect: TRect; const Text: string;
  Format: Cardinal; StateFlags: Integer);
procedure DrawTBXImage(Canvas: TCanvas; const Rect: TRect;
  ImageList: TCustomImageList; ImageIndex: Integer; StateFlags: Integer);


type
  { TTBXItem }

  TAdjustFontEvent = procedure(Item: TTBCustomItem; Viewer: TTBItemViewer;
    Font: TFont; StateFlags: Integer) of object; // state flags are the combination of ISF_* constants
  TDrawImageEvent = procedure(Item: TTBCustomItem; Viewer: TTBItemViewer;
    Canvas: TCanvas; ImageRect: TRect; ImageOffset: TPoint; StateFlags: Integer) of object;
  TTBXAdvancedDrawImageEvent = procedure(Item: TTBCustomItem; Viewer: TTBItemViewer;
    Canvas: TCanvas; ImageRect: TRect; ImageOffset: TPoint; StateFlags: Integer;
    var DefaultDraw: Boolean) of object;
  TTBXClosePopupEvent = procedure(Item, ClickedItem: TTBCustomItem) of object;

  TTBXCustomItem = class(TTBCustomItem)
  private
    FAlwaysSelectFirst: Boolean;
    FFontSettings: TFontSettings;
    FLayout: TTBXItemLayout;
    FMinHeight: Integer;
    FMinWidth: Integer;
    FToolBoxPopup: Boolean;
    FOnAdjustFont: TAdjustFontEvent;
    FOnAdvancedDrawImage: TTBXAdvancedDrawImageEvent;
    FOnClosePopup: TTBXClosePopupEvent;
    FOnDrawImage: TDrawImageEvent;
    procedure FontSettingsChanged(Sender: TObject);
    function  GetStretch: Boolean;
    procedure SetFontSettings(Value: TFontSettings);
    procedure SetLayout(Value: TTBXItemLayout);
    procedure SetMinHeight(Value: Integer);
    procedure SetMinWidth(Value: Integer);
    procedure SetStretch(Value: Boolean);
  protected
    function CreatePopup(const ParentView: TTBView; const ParentViewer: TTBItemViewer;
      const PositionAsSubmenu, SelectFirstItem, Customizing: Boolean;
      const APopupPoint: TPoint; const Alignment: TTBPopupAlignment): TTBPopupWindow; override;
    procedure DoClosePopup(ClickedItem: TTBCustomItem); virtual;
    function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
    procedure GetPopupPosition(ParentView: TTBView; PopupWindow: TTBPopupWindow;
      var PopupPositionRec: TTBPopupPositionRec); override;
    function GetPopupWindowClass: TTBPopupWindowClass; override;
    property ToolBoxPopup: Boolean read FToolBoxPopup write FToolBoxPopup default False;
    property OnAdjustFont: TAdjustFontEvent read FOnAdjustFont write FOnAdjustFont;
    property OnAdvancedDrawImage: TTBXAdvancedDrawImageEvent read FOnAdvancedDrawImage write FOnAdvancedDrawImage;
    property OnDrawImage: TDrawImageEvent read FOnDrawImage write FOnDrawImage;
    property OnClosePopup: TTBXClosePopupEvent read FOnClosePopup write FOnClosePopup;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Invalidate;
    property AlwaysSelectFirst: Boolean read FAlwaysSelectFirst write FAlwaysSelectFirst default False;
    property FontSettings: TFontSettings read FFontSettings write SetFontSettings;
    property Layout: TTBXItemLayout read FLayout write SetLayout default tbxlAuto;
    property MinHeight: Integer read FMinHeight write SetMinHeight default 0;
    property MinWidth: Integer read FMinWidth write SetMinWidth default 0;
    property Stretch: Boolean read GetStretch write SetStretch default False;
  end;

  TTBXItem = class(TTBXCustomItem)
    property Action;
    property AutoCheck;
    property Caption;
    property Checked;
    property DisplayMode;
    property Enabled;
    property FontSettings;
    property GroupIndex;
    property HelpContext;
    property Hint;
    property ImageIndex;
    property Images;
    property InheritOptions;
    property Layout;
    property MaskOptions;
    property MinHeight;
    property MinWidth;
    property Options;
    property PopupMenu;
    property RadioItem;
    property ShortCut;
    property Stretch;
    property Visible;
    property OnAdjustFont;
    property OnAdjustImageIndex;
    property OnAdvancedDrawImage;
    property OnDrawImage;
    property OnClick;
    property OnSelect;
  end;

  TTBXItemViewer = class(TTBItemViewer)
  private
    FWide: Boolean;
  protected
    procedure DoPaintCaption(Canvas: TCanvas; const ClientAreaRect: TRect;
      var CaptionRect: TRect; IsTextRotated: Boolean; var PaintDefault: Boolean); virtual;
    function  GetAccRole: Integer; override;
    function  GetImageSize: TSize; dynamic;
    function  GetItemType: Integer; virtual;
    function  GetTextFlags: Cardinal; dynamic;
    function  GetTextSize(Canvas: TCanvas; const Text: string; TextFlags: Cardinal; Rotated: Boolean; StateFlags: Integer): TSize; dynamic;
    function  IsToolbarSize: Boolean; override;
    procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override;
    procedure DrawItemImage(Canvas: TCanvas; ARect: TRect; ItemInfo: TTBXItemInfo); virtual;
    procedure DoAdjustFont(AFont: TFont; StateFlags: Integer); virtual;
    function  GetImageShown: Boolean; virtual;
    function  IsPtInButtonPart(X, Y: Integer): Boolean; override;
    procedure MouseUp(X, Y: Integer; MouseWasDownOnMenu: Boolean); override;
    procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsHoverItem, IsPushed, UseDisabledShadow: Boolean); override;
    property Wide: Boolean read FWide write FWide default True;
  public
    constructor Create(AView: TTBView; AItem: TTBCustomItem; AGroupLevel: Integer); override;
    function  IsToolbarStyle: Boolean; override;
  end;

  { TTBXSubmenuItem }

  TTBXSubmenuItem = class(TTBXCustomItem)
  private
    FAutoEmptyItem: Boolean;
    FAutoEmptyItemCaption: String;
    function GetAutoEmptyItemCaption: String;
    function GetDropdownCombo: Boolean;
    procedure SetDropdownCombo(Value: Boolean);
    procedure SetAutoEmptyItemCaption(const Value: String);
    function IsAutoEmptyItemCaptionStored: Boolean;
  protected
    procedure DoPopup(Sender: TTBCustomItem; FromLink: Boolean); override;
    procedure DoClosePopup(ClickedItem: TTBCustomItem); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Action;
    property AlwaysSelectFirst;
    property AutoCheck;
    property AutoEmptyItem: Boolean read FAutoEmptyItem write FAutoEmptyItem default True;
    property AutoEmptyItemCaption: String read GetAutoEmptyItemCaption write SetAutoEmptyItemCaption stored IsAutoEmptyItemCaptionStored;
    property Caption;
    property Checked;
    property DisplayMode;
    property DropdownCombo: Boolean read GetDropdownCombo write SetDropdownCombo default False;
    property Enabled;
    property FontSettings;
    property GroupIndex;
    property HelpContext;
    property Hint;
    property ImageIndex;
    property Images;
    property InheritOptions;
    property Layout;
    property LinkSubitems;
    property MaskOptions;
    property MinHeight;
    property MinWidth;
    property Options;
    property PopupMenu;
    property RadioItem;
    property ShortCut;
    property Stretch;
    property SubitemsPopupMenu;
    property SubMenuImages;
    property ToolBoxPopup;
    property Visible;
    property OnAdjustFont;
    property OnAdjustImageIndex;
    property OnAdvancedDrawImage;
    property OnDrawImage;
    property OnClick;
    property OnClosePopup;
    property OnPopup;
    property OnSelect;
  end;

  { TTBXSeparatorItem }

  TTBXSeparatorItem = class(TTBSeparatorItem)
  private
    FSize: Integer;
    procedure SetSize(Value: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
  published
    property Size: Integer read FSize write SetSize default -1;
    property MaskOptions;
    property Options;
  end;

  TTBXSeparatorItemViewer = class(TTBSeparatorItemViewer)
  protected
    procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override;
    procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect;
      IsHoverItem, IsPushed, UseDisabledShadow: Boolean); override;
    function IsToolbarSize: Boolean; override;
  public
    function IsToolbarStyle: Boolean; override;
  end;

  TTBXVisibilityToggleItem = class(TTBXCustomItem)
  private
    FControl: TControl;
    procedure SetControl (Value: TControl);
    procedure UpdateProps;
  protected
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
  public
    procedure Click; override;
    procedure InitiateAction; override;
  published
    property Caption;
    property Control: TControl read FControl write SetControl;
    property DisplayMode;
    property Enabled;
    property FontSettings;
    property HelpContext;
    property Hint;
    property ImageIndex;
    property Images;
    property InheritOptions;
    property Layout;
    property MaskOptions;
    property MinHeight;
    property MinWidth;
    property Options;
    property PopupMenu;
    property ShortCut;
    property Stretch;
    property Visible;
    property OnAdjustFont;
    property OnAdjustImageIndex;
    property OnAdvancedDrawImage;
    property OnClick;
    property OnDrawImage;
    property OnSelect;
  end;

  { TTBXPopupWindow }

  TTBXPopupWindow = class(TTBPopupWindow)
  private
    FControlRect: TRect;
    FShadows: TShadows;
    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure TBMGetViewType(var Message: TMessage); message TBM_GETVIEWTYPE;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
    procedure WMPrint(var Message: TMessage); message WM_PRINT;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
    procedure WMTB2kPopupShowing(var Message: TMessage); message WM_TB2K_POPUPSHOWING;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateShadow; virtual;
    procedure DestroyShadow; virtual;
    function  GetNCSize: TPoint; override;
    function  GetShowShadow: Boolean; virtual;
    function  GetViewClass: TTBViewClass; override;
    procedure PaintScrollArrows; override;
  public
    destructor Destroy; override;
    function GetFillColor: TColor;
  end;

  TTBXPopupView = class(TTBPopupView);

  { TTBXToolbarView }

  TTBXToolbarView = class(TTBToolbarView)
  protected
    procedure GetMargins(AOrientation: TTBViewOrientation; var Margins: TRect); override;
  end;

{ TTBXChevronPopupSettings }

const
  cpsDefHorzWrapOffset = 200; { Like in MS Office }

type
  TTBXChevronPopupSettings = class(TPersistent)
  private
    FHorzHideSeparators: Boolean;
    FHorzWrapOffset: Integer;
    FPopupOrientation: TTBOrientation;
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create;
  published
    property HorzHideSeparators: Boolean read FHorzHideSeparators write FHorzHideSeparators default True;
    property HorzWrapOffset: Integer read FHorzWrapOffset write FHorzWrapOffset default cpsDefHorzWrapOffset;
    property PopupOrientation: TTBOrientation read FPopupOrientation write FPopupOrientation default tboVertical;
  end;

  { TTBXToolbar }

  TTBXItemTransparency = (itAuto, itEnable, itDisable);

  TTBXToolbar = class(TTBCustomToolbar)
  private
    FChevronPopupSettings: TTBXChevronPopupSettings;
    FEffectiveColor: TColor;
    FItemTransparency: TTBXItemTransparency;
    FSnapDistance: Integer;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure CMControlChange(var Message: TCMControlChange); message CM_CONTROLCHANGE;
    procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
    procedure SetChevronPopupSettings(Value: TTBXChevronPopupSettings);
    procedure SetItemTransparency(const Value: TTBXItemTransparency);
    procedure SetSnapDistance(Value: Integer);
    procedure TBMGetViewType(var Message: TMessage); message TBM_GETVIEWTYPE;
    procedure TBMGetEffectiveColor(var Message: TMessage); message TBM_GETEFFECTIVECOLOR;
    procedure TBMThemeChange(var Message: TMessage); message TBM_THEMECHANGE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); override;
    function  GetChevronItemClass: TTBChevronItemClass; override;
    function  GetFloatingWindowParentClass: TTBFloatingWindowParentClass; override;
    procedure GetToolbarInfo(out ToolbarInfo: TTBXToolbarInfo); virtual;
    function  GetViewClass: TTBToolbarViewClass; override;
    procedure Loaded; override;
    procedure RedrawAll;
    procedure SetParent(AParent: TWinControl); override;
    procedure UpdateEffectiveColor;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function  Embedded: Boolean;
    function  GetFloatingBorderSize: TPoint; override;
    procedure UpdateChildColors;
    property EffectiveColor: TColor read FEffectiveColor;
  published
    property ActivateParent;
    property Align;
    property AutoResize;
    property BorderStyle;
    property Caption;
    property ChevronHint;
    property ChevronMoveItems;
    property ChevronPopupSettings: TTBXChevronPopupSettings read FChevronPopupSettings write SetChevronPopupSettings;
    property ChevronPriorityForNewItems;
    property CloseButton;
    property CloseButtonWhenDocked;
    property CurrentDock;
    property DblClickUndock default False;
    property DefaultDock;
    property DockableTo;
    property DockMode;
    property DockPos;
    property DockRow;
    property DragHandleStyle;
    property FloatingMode;
    property Font;
    property FullSize;
    property HideWhenInactive;
    property Images;
    property Items;
    property ItemsPopupMenu;
    property ItemTransparency: TTBXItemTransparency read FItemTransparency write SetItemTransparency default itAuto;
    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 SnapDistance: Integer read FSnapDistance write SetSnapDistance default 0;
    property Stretch;
    property SystemFont;
    property TabOrder;
    property TabStop;
    property UpdateActions;
    property UseLastDock;
    property Visible;
    property Color default clNone;
    property OnClose;
    property OnCloseQuery;
    {$IFDEF JR_D5}
    property OnContextPopup;
    {$ENDIF}
    property OnDragDrop;
    property OnDragOver;
    {$IFDEF JR_D9}
    property OnMouseActivate;
    {$ENDIF}
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMove;
    property OnRecreated;
    property OnRecreating;
    property OnDockChanged;
    property OnDockChanging;
    property OnDockChangingHidden;
    property OnResize;
    property OnShortCut;
    property OnVisibleChanged;
  end;

  { TTBXChevronItem }

  TTBXChevronItem = class(TTBChevronItem)
  public
    function GetChevronPopupPosition(
      var PopupPositionRec: TTBPopupPositionRec): Boolean; override;
    procedure GetPopupPosition(ParentView: TTBView;
      PopupWindow: TTBPopupWindow; var PopupPositionRec: TTBPopupPositionRec); override;
    function GetPopupWindowClass: TTBPopupWindowClass; override;
    function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override;
  end;

  TTBXChevronItemViewer = class(TTBItemViewer)
  protected
    procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect;
      IsHoverItem, IsPushed, UseDisabledShadow: Boolean); override;
  end;

  TTBXChevronPopupWindow = class(TTBXPopupWindow);

  { TTBXPopupMenu }

  TTBXRootItem = class(TTBRootItem)
  private
    FPopupControlRect: TRect;
  protected
    function CreatePopupEx(SelectFirstItem: Boolean; const AControlRect: TRect;
      Alignment: TTBPopupAlignment): TTBPopupWindow; virtual;
    function GetPopupWindowClass: TTBPopupWindowClass; override;
    procedure GetPopupPosition(ParentView: TTBView; PopupWindow: TTBPopupWindow;
      var PopupPositionRec: TTBPopupPositionRec); override;
    function OpenPopupEx(const SelectFirstItem, TrackRightButton: Boolean;
      const ControlRect: TRect; const Alignment: TTBPopupAlignment;
      const ReturnClickedItemOnly: Boolean): TTBCustomItem;
    function PopupEx(const ControlRect: TRect; TrackRightButton: Boolean;
      Alignment: TTBPopupAlignment = tbpaLeft;
      ReturnClickedItemOnly: Boolean = False): TTBCustomItem;
  end;

  TTBXPopupMenu = class(TTBPopupMenu)
  private
    FToolBoxPopup: Boolean;
    procedure TBMGetViewType(var Message: TMessage); message TBM_GETVIEWTYPE;
  protected
    function GetRootItemClass: TTBRootItemClass; override;
  public
    function PopupEx(const ControlRect: TRect;
      ReturnClickedItemOnly: Boolean = False): TTBCustomItem;
    property ToolBoxPopup: Boolean read FToolBoxPopup write FToolBoxPopup default False;
  end;

  TTBXFloatingWindowParent = class(TTBFloatingWindowParent)
  private
    FCloseButtonHover: Boolean;
    FSnapDistance: Integer;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    {$IFDEF JR_D10}
    procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED;
    {$ENDIF}
    procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
    procedure WMNCMouseLeave(var Message: TMessage); message $2A2 {WM_NCMOUSELEAVE};
    procedure WMNCMouseMove(var Message: TWMNCMouseMove); message WM_NCMOUSEMOVE;
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
  protected
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    procedure CancelNCHover;
    procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC;
      const Clip: HRGN; RedrawWhat: TTBToolWindowNCRedrawWhat); override;
    property CloseButtonHover: Boolean read FCloseButtonHover;
  public
    property SnapDistance: Integer read FSnapDistance write FSnapDistance default 0;
  end;

  TTBXToolWindow = class(TTBToolWindow)
  private
    FEffectiveColor: TColor;
    FSnapDistance: Integer;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure CMControlChange(var Message: TCMControlChange); message CM_CONTROLCHANGE;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure SetSnapDistance(Value: Integer);
    procedure TBMGetEffectiveColor(var Message: TMessage); message TBM_GETEFFECTIVECOLOR;
    procedure TBMGetViewType(var Message: TMessage); message TBM_GETVIEWTYPE;
    procedure TBMThemeChange(var Message: TMessage); message TBM_THEMECHANGE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); override;
    function  GetFloatingWindowParentClass: TTBFloatingWindowParentClass; override;
    procedure GetToolbarInfo(out ToolbarInfo: TTBXToolbarInfo); virtual;
    procedure SetParent(AParent: TWinControl); override;
    procedure UpdateEffectiveColor;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function  GetFloatingBorderSize: TPoint; override;
    procedure UpdateChildColors;
    property EffectiveColor: TColor read FEffectiveColor;
  published
    property Color default clNone;
    property DblClickUndock default False;
    property SnapDistance: Integer read FSnapDistance write SetSnapDistance default 0;
  end;

  TTBXDock = class(TTBDock)
  private
    FEffectiveColor: TColor;
    FMoving: Boolean;
    FResizing: Boolean;
    FUseParentBackground: Boolean;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure TBMGetEffectiveColor(var Message: TMessage); message TBM_GETEFFECTIVECOLOR;
    procedure TBMThemeChange(var Message: TMessage); message TBM_THEMECHANGE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    function  ThemedBackground: Boolean; virtual;
    procedure DrawBackground(DC: HDC; const DrawRect: TRect); override;
    procedure Resize; override;
    procedure SetUseParentBackground(Value: Boolean);
    procedure UpdateEffectiveColor;
    function  UsingBackground: Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property EffectiveColor: TColor read FEffectiveColor;
  published
    property Color default clNone;
    property UseParentBackground: Boolean read FUseParentBackground write SetUseParentBackground default False;
  end;

  { TTBXMenuAnimation }

  TAnimationMode = (amNone, amSysDefault, amRandom, amUnfold, amSlide, amFade);
  TAnimationModes = set of TAnimationMode;

  TTBXMenuAnimation = class
  private
    FAnimationMode: TAnimationMode;
    FAvailableModes: TAnimationModes;
    procedure InitAvailableModes;
    function  GetAnimation: TAnimationMode;
    procedure SetAnimationMode(Value: TAnimationMode);
  public
    constructor Create;
    property AnimationMode: TAnimationMode read FAnimationMode write SetAnimationMode;
    property AvailableModes: TAnimationModes read FAvailableModes;
  end;

var
  CurrentTheme: TTBXTheme;
  TBXMenuAnimation: TTBXMenuAnimation;

{$IFNDEF JR_D6}
var
  clMoneyGreen: TColor = TColor($C0DCC0);
  clSkyBlue: TColor = TColor($F0CAA6);
  clCream: TColor = TColor($F0FBFF);
  clMedGray: TColor = TColor($A4A0A0);
{$ENDIF}

procedure TBXSetTheme(const AThemeName: string);
function TBXCurrentTheme: string;

procedure AddThemeNotification(AObject: TObject);
procedure RemoveThemeNotification(AObject: TObject);

{ Additional system colors }
procedure AddTBXColor(var AColor: TColor; const AName: string);
function  TBXIdentToColor(const Ident: string; var Color: Longint): Boolean;
function  TBXColorToString(Color: TColor): string;
function  TBXStringToColor(S: string): TColor;
procedure TBXGetColorValues(Proc: TGetStrProc);

{ Internal routines - do not use }
function GetPopupMargin(ItemViewer: TTBItemViewer): Integer;
function GetEffectiveColor(C: TControl): TColor;
procedure DrawParentBackground(Control: TControl; DC: HDC; const R: TRect);
procedure AddToList(var List: TList; Item: Pointer);
procedure RemoveFromList(var List: TList; Item: Pointer);

implementation

{$R TBX_Glyphs.res}

uses
  TBXExtItems, TBXLists, TB2Common, TBXUxThemes, MultiMon, TBXDefaultTheme,
  ComCtrls, Menus, MMSystem, {$IFDEF JR_D7}UxTheme, Themes,{$ENDIF}
  {$IFDEF JR_D9} Types, {$ENDIF} Math, TBXConsts;

type
  TTBItemAccess = class(TTBCustomItem);
  TTBViewAccess = class(TTBView);
  TTBItemViewerAccess = class(TTBItemViewer);
  TTBFloatingWindowParentAccess = class(TTBFloatingWindowParent);
  TTBCustomDockableWindowAccess = class(TTBCustomDockableWindow);
  TTBXToolbarAccess = class(TTBXToolbar);
  TTBBackgroundAccess = class(TTBBackground);
  TControlAccess = class(TControl);
  TTBXThemeAccess = class(TTBXTheme);
  TDockAccess = class(TTBDock);
  TTBPopupWindowAccess = class(TTBPopupWindow);

  { TTBNexus }
  TTBXNexus = class
  private
    FNotifies: TList;
    procedure TBXSysCommand(var Message: TMessage); message TBX_SYSCOMMAND;
  protected
    procedure Broadcast(Msg: Cardinal; Param1, Param2: Integer);
  public
    constructor Create(const DefaultTheme: string);
    destructor Destroy; override;
    procedure SetTheme(const AThemeName: string);
    function  GetTheme: string;
    procedure AddNotifie(AObject: TObject);
    procedure RemoveNotifie(AObject: TObject);
  end;

var
  TBXNexus: TTBXNexus;

procedure AddThemeNotification(AObject: TObject);
begin
  TBXNexus.AddNotifie(AObject);
end;

procedure RemoveThemeNotification(AObject: TObject);
begin
  TBXNexus.RemoveNotifie(AObject);
end;

function GetEffectiveColor(C: TControl): TColor;
var
  Message: TMessage;
begin
  if C = nil then Result := clBtnFace
  else
  begin
    Message.Msg := TBM_GETEFFECTIVECOLOR;
    Message.WParam := 0;
    Message.LParam := 0;
    Message.Result := 0;
    C.Dispatch(Message);
    if Message.Result <> 0 then Result := Message.WParam
    else if (C is TForm) and (TForm(C).FormStyle = fsMDIForm) then
      Result := clBtnFace
    else
      Result := TControlAccess(C).Color;
  end;
end;

procedure DrawParentBackground(Control: TControl; DC: HDC; const R: TRect);
label
  DrawTabSheet;
var
  Parent: TWinControl;
  R2: TRect;
  BufDC: HDC;
  BufDCRec: TBufDCRec;
  ResultOK: Boolean;
  {$IFDEF JR_D7}
  IsThemesEnabled: Boolean;
  {$ENDIF}
begin
  if Control = nil then Exit;
  {$IFDEF JR_D7}
  IsThemesEnabled :=
    {$IF  CompilerVersion >= 33}
    StyleServices.Enabled;
    {$ELSE}
    ThemeServices.ThemesEnabled;
    {$IFEND}
  {$ENDIF}
  Parent := Control.Parent;
  if (Parent <> nil) and Parent.HandleAllocated then
  begin
    if {$IFDEF JR_D7}(IsThemesEnabled or USE_THEMES){$ELSE}USE_THEMES{$ENDIF} and
      (Parent is TTabSheet){special case} then goto DrawTabSheet;

    SetPoint(R2.TopLeft, 0, 0);
    R2.TopLeft := Parent.ScreenToClient(Control.ClientToScreen(R2.TopLeft));
    OffsetWindowOrgEx(DC, R2.Left, R2.Top, R2.TopLeft);
    ResultOK := Parent.Perform(WM_ERASEBKGND, WPARAM(DC), LPARAM(DC)) <> 0;
    SetWindowOrgEx(DC, R2.Left, R2.Top, nil);
    if ResultOK then Exit;

    if {$IFDEF JR_D7}(IsThemesEnabled or USE_THEMES){$ELSE}USE_THEMES{$ENDIF} and
      (Control is TWinControl) then
    begin
      DrawTabSheet:
      R2 := R;
      OffsetRect(R2, -R2.Left, -R2.Top);
      BufDC := CreateBufDC(DC, R2.Right, R2.Bottom, BufDCRec);
      { Fortunately, DrawThemeParentBackground has no problems if DC is memory DC }
      {$IFDEF JR_D7}
      if IsThemesEnabled then
        ResultOK := UxTheme.DrawThemeParentBackground(TWinControl(Control).Handle, BufDC, @R2) = S_OK
      else
        ResultOK := TBXUxThemes.DrawThemeParentBackground(TWinControl(Control).Handle, BufDC, @R2) = S_OK;
      {$ELSE}
      ResultOK := TBXUxThemes.DrawThemeParentBackground(TWinControl(Control).Handle, BufDC, @R2) = S_OK;
      {$ENDIF}
      if ResultOK then
        BitBlt(DC, R.Left, R.Top, R2.Right, R2.Bottom, BufDC, 0, 0, SRCCOPY);
      DeleteBufDC(BufDCRec);
      if ResultOK then Exit;
    end;

    FillRectEx(DC, R, GetEffectiveColor(Parent));
  end
  else FillRectEx(DC, R, clBtnFace);
end;

function GetViewType(View: TTBView): Integer;
var
  Message: TMessage;
begin
  Result := VT_UNKNOWN;
  if (View <> nil) and (View.Owner <> nil) then
  begin
    Message.Msg := TBM_GETVIEWTYPE;
    Message.WParam := 0;
    Message.LParam := 0;
    Message.Result := VT_UNKNOWN;
    View.Window.Dispatch(Message);
    Result := Message.Result;
  end;
end;

function GetWinViewType(Window: TControl): Integer;
var
  Message: TMessage;
begin
  Result := VT_UNKNOWN;
  if Window <> nil then
  begin
    Message.Msg := TBM_GETVIEWTYPE;
    Message.WParam := 0;
    Message.LParam := 0;
    Message.Result := VT_UNKNOWN;
    Window.Dispatch(Message);
    Result := Message.Result;
  end;
end;

function IsFloating(ViewType: Integer): Boolean;
begin
  Result := ViewType and TVT_FLOATING <> 0;
end;

procedure UpdateNCArea(Control: TWinControl; ViewType: Integer);
begin
  with Control do
  begin
    ClientWidth := ClientWidth;
    ClientHeight := ClientHeight;
  end;
  SetWindowPos(Control.Handle, 0, 0, 0, 0, 0,
    SWP_FRAMECHANGED or SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE);
  Control.Invalidate;
end;

function GetPopupMargin(ItemViewer: TTBItemViewer): Integer;
var
  ImgList: TCustomImageList;
  Sz: TSize;
  TextMetric: TTextMetric;
  H, M2: Integer;
  Margins: TTBXMargins;
begin
  Sz.Cx := 0;
  Sz.Cy := 0;
  if ItemViewer is TTBXItemViewer then
    Sz := TTBXItemViewer(ItemViewer).GetImageSize;
  if (Sz.Cx = 0) or (Sz.Cy = 0) then
  begin
    ImgList := TTBItemViewerAccess(ItemViewer).GetImageList;
    if ImgList <> nil then
    begin
      Sz.Cx := ImgList.Width;
      Sz.Cy := ImgList.Height;
    end;
    if (Sz.Cx = 0) or (Sz.Cy = 0) then
    begin
      Sz.Cx := 16;
      Sz.Cy := 16;
    end;
  end;
  StockBitmap1.Canvas.Font := TTBViewAccess(ItemViewer.View).GetFont;
  GetTextMetrics(StockBitmap1.Canvas.Handle, TextMetric);

  CurrentTheme.GetMargins(MID_MENUITEM, Margins);
  M2 := Margins.TopHeight + Margins.BottomHeight;
  Result := TextMetric.tmHeight + TextMetric.tmExternalLeading + M2;
  H := Sz.CY + M2;
  if H > Result then Result := H;
  Result := (Sz.Cx + M2) * Result div H;
end;

procedure GetOfficeXPPopupPosition1(var PopupPositionRec: TTBPopupPositionRec);
begin
  with PopupPositionRec do
  begin
    if not PositionAsSubmenu then
    begin
      NCSizeX := 0;
      NCSizeY := 0;
      Dec(ParentItemRect.Right);
      if X = ParentItemRect.Right + 1 then Dec(X);
      if X + W <= ParentItemRect.Left then Inc(X);
      Dec(ParentItemRect.Bottom);
      if Y = ParentItemRect.Bottom + 1 then Dec(Y);
      if Y + H <= ParentItemRect.Top then Inc(Y);
      Dec(W);
      Dec(H);
    end
    else
    begin
      Inc(X, NCSizeX);
      Inc(Y, NCSizeY);
      NCSizeX := 0;
      NCSizeY := 0;
    end;
  end;
end;

procedure GetOfficeXPPopupPosition2(var PopupPositionRec: TTBPopupPositionRec);
begin
  with PopupPositionRec do if not PositionAsSubmenu then
  begin
    Inc(W);
    Inc(H);
  end;
end;

procedure AddToList(var List: TList; Item: Pointer);
begin
  if List = nil then List := TList.Create;
  List.Add(Item)
end;


procedure RemoveFromList(var List: TList; Item: Pointer);
begin
  if List <> nil then
  begin
    List.Remove(Item);
    if List.Count = 0 then
    begin
      List.Free;
      List := nil;
    end;
  end;
end;

{ common case for the toolbar and toolwindow }
procedure DockableWindowDrawNCArea(const DrawToDC: Boolean; const ADC: HDC;
  Clip: HRGN; Window: TTBCustomDockableWindow; EffectiveColor: TColor;
    ToolbarInfo: TTBXToolbarInfo);
var
  CurrentDock: TTBDock;
  UsingBackground, DoubleBuffered: Boolean;
  WndDC, DC: HDC;
  BufDCRec: TBufDCRec;
  R, R2: TRect;
  Canvas: TCanvas;
begin
  CurrentDock := Window.CurrentDock;
  UsingBackground := TDockAccess(CurrentDock).UsingBackground;
  DoubleBuffered := not DrawToDC and UsingBackground;
  GetWindowRect(Window.Handle, R);

  WndDC := 0;
  try
    if not DrawToDC then
    begin
      WndDC := GetWindowDC(Window.Handle);
      if DoubleBuffered
        then DC := CreateBufDC(WndDC, R.Right-R.Left, R.Bottom-R.Top, BufDCRec)
        else DC := WndDC;
    end
    else DC := ADC;

    if not DrawToDC then
    begin
      SelectNCUpdateRgn(Window.Handle, WndDC, Clip);
      R2 := Window.ClientRect;
      MapWindowPoints(Window.Handle, 0, R2.TopLeft, 2);
      OffsetRect(R2, -R.Left, -R.Top);
      with R2 do
        ExcludeClipRect(WndDC, Left, Top, Right, Bottom);
    end;
    OffsetRect(R, -R.Left, -R.Top);

    Canvas := TCanvas.Create;
    try
      Canvas.Handle := DC;
      if CurrentTheme.SolidToolbarNCArea then
      begin
        Canvas.Brush.Color := EffectiveColor;
        Canvas.Brush.Style := bsSolid;
      end
      else if UsingBackground then
      begin
        Canvas.Brush.Color := EffectiveColor;
        R2 := CurrentDock.ClientRect;
        OffsetRect(R2, -Window.Left, -Window.Top);
        TDockAccess(CurrentDock).DrawBackground(DC, R2);
        if (TControlAccess(Window).Color = clNone) and
          CurrentDock.BackgroundOnToolbars then
            Canvas.Brush.Style := bsClear;
      end
      else begin
        FillRectEx(DC, R, GetEffectiveColor(CurrentDock));
        Canvas.Brush.Color := EffectiveColor;
        Canvas.Brush.Style := bsSolid;
      end;
      CurrentTheme.PaintToolbarNCArea(Canvas, R, ToolbarInfo);
    finally
      Canvas.Free;
    end;
    if DoubleBuffered then
      with R do BitBlt(WndDC, Left, Top, Right, Bottom, DC, 0, 0, SRCCOPY);
  finally
    if DoubleBuffered then
      DeleteBufDC(BufDCRec);
    if WndDC <> 0 then
      ReleaseDC(Window.Handle, WndDC);
  end;
end;

{ common case for the toolbar and toolwindow }
procedure DockableWindowDrawBackground(DC: HDC; Window: TTBCustomDockableWindow;
  Embedded: Boolean; EffectiveColor: TColor);
var
  CurrentDock: TTBDock;
  Canvas: TCanvas;
  Transparent: Boolean;
  CR, DockR, DockPosR: TRect;
begin
  if Window.HandleAllocated and IsWindowVisible(Window.Handle) then
  begin
    CR := Window.ClientRect;
    Transparent := TControlAccess(Window).Color = clNone;

    if Window.Docked then
    begin
      CurrentDock := Window.CurrentDock;
      DockR := CurrentDock.ClientRect;
      MapWindowPoints(CurrentDock.Handle, Window.Handle, DockR.TopLeft, 2);
      DockPosR := CurrentDock.BoundsRect;
      Transparent := Transparent and TDockAccess(CurrentDock).UsingBackground and
        CurrentDock.BackgroundOnToolbars and not CurrentTheme.SolidToolbarClientArea;
      if Transparent then
        TDockAccess(CurrentDock).DrawBackground(DC, DockR);
    end
    else begin
      SetRectEmpty(DockR);
      DockPosR := CR;
      Transparent := Transparent and Embedded;
      if Transparent then
        DrawParentBackground(Window, DC, CR);
    end;

    Canvas := TCanvas.Create;
    try
      Canvas.Handle := DC;
      { Pass to theme the dock positition through PenPos }
      Canvas.MoveTo(Integer(PointToSmallPoint(DockPosR.TopLeft)),
        Integer(PointToSmallPoint(DockPosR.BottomRight)));
      CurrentTheme.PaintBackgnd(Canvas, DockR, CR, CR, EffectiveColor,
        Transparent, GetWinViewType(Window));
    finally
      Canvas.Free;
    end;
  end;
end;

//============================================================================//

{ Misc. Routines }

procedure InvalidateAll(const Ctl: TWinControl);
begin
  if Ctl.HandleAllocated then
    RedrawWindow(Ctl.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or
      RDW_ERASE);
end;

function GetStateFlags(const ItemInfo: TTBXItemInfo): Integer;
const
  CEnabledStates: array [Boolean] of Integer = (ISF_DISABLED, 0);
  CHotStates: array [Boolean] of Integer = (0, ISF_HOT);
  CPushedStates: array [Boolean] of Integer = (0, ISF_PUSHED);
  CSelectedStates: array [Boolean] of Integer = (0, ISF_SELECTED);
begin
  with ItemInfo do
    Result := CEnabledStates[ItemInfo.Enabled] or CPushedStates[ItemInfo.Pushed] or
      CHotStates[ItemInfo.HoverKind = hkMouseHover] or CSelectedStates[ItemInfo.Selected];
end;

function GetTBXTextColor(StateFlags: Integer): TColor;
const
  HoverKinds: array [Boolean] of TTBXHoverKind = (hkNone, hkMouseHover);
var
  ItemInfo: TTBXItemInfo;
begin
  FillChar(ItemInfo, SizeOf(ItemInfo), 0);
  case StateFlags and ISF_LOCATIONMASK of
    ISF_TOOLBARCOLOR:
      begin
        ItemInfo.ViewType := VT_TOOLBAR;
        ItemInfo.ItemOptions := IO_TOOLBARSTYLE;
      end;
    ISF_MENUCOLOR:
      begin
        ItemInfo.ViewType := VT_DOCKPANEL;
      end;
    ISF_STATUSCOLOR:
      begin
        ItemInfo.ViewType := VT_STATUSBAR;
      end;
  else
    ItemInfo.ViewType := VT_UNKNOWN;
  end;
  ItemInfo.Enabled := StateFlags and ISF_DISABLED = 0;
  ItemInfo.Pushed := StateFlags and ISF_PUSHED <> 0;
  ItemInfo.HoverKind := HoverKinds[StateFlags and ISF_HOT <> 0];
  ItemInfo.Selected := StateFlags and ISF_SELECTED <> 0;
  Result := CurrentTheme.GetItemTextColor(ItemInfo);
end;

procedure DrawTBXCaption(Canvas: TCanvas; const Rect: TRect; const Text: string;
  Format: Cardinal; StateFlags: Integer);
const
  HoverKinds: array [Boolean] of TTBXHoverKind = (hkNone, hkMouseHover);
var
  ItemInfo: TTBXItemInfo;
begin
  FillChar(ItemInfo, SizeOf(ItemInfo), 0);
  case StateFlags and ISF_LOCATIONMASK of
    ISF_TOOLBARCOLOR:
      begin
        ItemInfo.ViewType := VT_TOOLBAR;
        ItemInfo.ItemOptions := IO_TOOLBARSTYLE;
      end;
    ISF_MENUCOLOR:
      begin
        ItemInfo.ViewType := VT_DOCKPANEL;
      end;
    ISF_STATUSCOLOR:
      begin
        ItemInfo.ViewType := VT_STATUSBAR;
      end;
  end;
  ItemInfo.Enabled := StateFlags and ISF_DISABLED = 0;
  ItemInfo.Pushed := StateFlags and ISF_PUSHED <> 0;
  ItemInfo.HoverKind := HoverKinds[StateFlags and ISF_HOT <> 0];
  ItemInfo.Selected := StateFlags and ISF_SELECTED <> 0;
  CurrentTheme.PaintCaption(Canvas, Rect, ItemInfo, Text, Format, False);
end;

procedure DrawTBXImage(Canvas: TCanvas; const Rect: TRect;
  ImageList: TCustomImageList; ImageIndex: Integer; StateFlags: Integer);
const
  HoverKinds: array [Boolean] of TTBXHoverKind = (hkNone, hkMouseHover);
var
  ItemInfo: TTBXItemInfo;
begin
  FillChar(ItemInfo, SizeOf(ItemInfo), 0);
  case StateFlags and ISF_LOCATIONMASK of
    ISF_TOOLBARCOLOR:
      begin
        ItemInfo.ViewType := VT_TOOLBAR;
        ItemInfo.ItemOptions := IO_TOOLBARSTYLE;
      end;
    ISF_MENUCOLOR:
      begin
        ItemInfo.ViewType := VT_DOCKPANEL;
      end;
    ISF_STATUSCOLOR:
      begin
        ItemInfo.ViewType := VT_STATUSBAR;
      end;
  end;
  ItemInfo.Enabled := not Boolean(StateFlags and ISF_DISABLED);
  ItemInfo.Pushed := Boolean(StateFlags and ISF_PUSHED);
  ItemInfo.HoverKind := HoverKinds[Boolean(StateFlags and ISF_HOT)];
  ItemInfo.Selected := Boolean(StateFlags and ISF_SELECTED);
  CurrentTheme.PaintImage(Canvas, Rect, ItemInfo, ImageList, ImageIndex);
end;

//============================================================================//

{ TFontSettings }

procedure TFontSettings.Apply(Font: TFont);
var
  FS: TFontStyles;
begin
  if Size <> 100 then Font.Size := (Font.Size * FSize + 50) div 100;
  if Color <> clNone then Font.Color := Color;
  if Name <> '' then Font.Name := Name;
  FS := Font.Style;
  if Bold = tsTrue then Include(FS, fsBold)
  else if Bold = tsFalse then Exclude(FS, fsBold);
  if Italic = tsTrue then Include(FS, fsItalic)
  else if Italic = tsFalse then Exclude(FS, fsItalic);
  if Underline = tsTrue then Include(FS, fsUnderline)
  else if Underline = tsFalse then Exclude(FS, fsUnderline);
  if StrikeOut = tsTrue then Include(FS, fsStrikeOut)
  else if StrikeOut = tsFalse then Exclude(FS, fsStrikeOut);
  Font.Style := FS;
end;

procedure TFontSettings.Apply(var LF: TLogFont; var FontColor: TColor);
begin
  if Size <> 100 then LF.lfHeight := (LF.lfHeight * Size + 50) div 100;
  if Color <> clNone then FontColor := Color;
  if Name <> '' then StrPLCopy(LF.lfFaceName, Name, 31);
  if Bold = tsTrue then LF.lfWeight := FW_BOLD
  else if Bold = tsFalse then LF.lfWeight := FW_NORMAL;
  if Italic = tsTrue then LF.lfItalic := 1
  else if Italic = tsFalse then LF.lfItalic := 0;
  if Underline = tsTrue then LF.lfUnderline := 1
  else if Underline = tsFalse then LF.lfUnderline := 0;
  if StrikeOut = tsTrue then LF.lfStrikeOut := 1
  else if StrikeOut = tsFalse then LF.lfStrikeOut := 0;
end;

procedure TFontSettings.Assign(Src: TPersistent);
var
  F: TFontSettings;
begin
  if Src is TPersistent then
  begin
    F := TFontSettings(Src);
    if (FBold <> F.Bold) or (FItalic <> F.Italic) or (FUnderline <> F.Underline) or
      (FStrikeOut <> F.StrikeOut) or (FSize <> F.Size) or (FColor <> F.Color) or
      (FName <> F.Name) then
    begin
      FBold := F.Bold;
      FItalic := F.Italic;
      FUnderline := F.Underline;
      FStrikeOut := F.StrikeOut;
      FSize := F.Size;
      FColor := F.Color;
      FName := F.Name;
      Modified;
    end;
  end
  else inherited;
end;

constructor TFontSettings.Create;
begin
  FSize := 100;
  FColor := clNone;
end;

function TFontSettings.CreateTransformedFont(Src: HFont; var FontColor: TColor): HFont;
var
  LF: TLogFont;
begin
  GetObject(Src, SizeOf(LF), @LF);
  Apply(LF, FontColor);
  Result := CreateFontIndirect(LF);
end;

procedure TFontSettings.Modified;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TFontSettings.SetBold(Value: TTriState);
begin
  if FBold <> Value then
  begin
    FBold := Value;
    Modified;
  end;
end;

procedure TFontSettings.SetColor(Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Modified;
  end;
end;

procedure TFontSettings.SetItalic(Value: TTriState);
begin
  if FItalic <> Value then
  begin
    FItalic := Value;
    Modified;
  end;
end;

procedure TFontSettings.SetName(const Value: TFontName);
begin
  if FName <> Value then
  begin
    FName := Value;
    Modified;
  end;
end;

procedure TFontSettings.SetSize(Value: TFontSize);
begin
  if FSize <> Value then
  begin
    FSize := Value;
    Modified;
  end;
end;

procedure TFontSettings.SetStrikeOut(Value: TTriState);
begin
  if FStrikeOut <> Value then
  begin
    FStrikeOut := Value;
    Modified;
  end;
end;

procedure TFontSettings.SetUnderline(Value: TTriState);
begin
  if FUnderline <> Value then
  begin
    FUnderline := Value;
    Modified;
  end;
end;

//============================================================================//

{ TTBXCustomItem }

constructor TTBXCustomItem.Create(AOwner: TComponent);
begin
  inherited;
  FFontSettings := TFontSettings.Create;
  FFontSettings.OnChange := FontSettingsChanged;
end;

function TTBXCustomItem.CreatePopup(const ParentView: TTBView;
  const ParentViewer: TTBItemViewer; const PositionAsSubmenu,
  SelectFirstItem, Customizing: Boolean; const APopupPoint: TPoint;
  const Alignment: TTBPopupAlignment): TTBPopupWindow;
var
  DoSelectFirstItem: Boolean;
begin
  if AlwaysSelectFirst then DoSelectFirstItem := True
  else DoSelectFirstItem := SelectFirstItem;
  Result := inherited CreatePopup(ParentView, ParentViewer, PositionAsSubmenu,
    DoSelectFirstItem, Customizing, APopupPoint, Alignment);
end;

destructor TTBXCustomItem.Destroy;
begin
  FFontSettings.Free;
  inherited;
end;

procedure TTBXCustomItem.DoClosePopup(ClickedItem: TTBCustomItem);
begin
  if Assigned(FOnClosePopup) then FOnClosePopup(Self, ClickedItem);
end;

procedure TTBXCustomItem.FontSettingsChanged(Sender: TObject);
begin
  Change(True);
end;

function TTBXCustomItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
begin
  Result := TTBXItemViewer;
end;

procedure TTBXCustomItem.GetPopupPosition(ParentView: TTBView;
  PopupWindow: TTBPopupWindow; var PopupPositionRec: TTBPopupPositionRec);
var
  VT: Integer;
begin
  if CurrentTheme.OfficeXPPopupAlignment then with PopupPositionRec do
  begin
    GetOfficeXPPopupPosition1(PopupPositionRec);
    inherited GetPopupPosition(ParentView, PopupWindow, PopupPositionRec);
    GetOfficeXPPopupPosition2(PopupPositionRec);
    VT := GetWinViewType(PopupWindow);
    PopupPositionRec.PlaySound := not (VT and PVT_LISTBOX = PVT_LISTBOX);
  end
  else inherited;
end;

function TTBXCustomItem.GetPopupWindowClass: TTBPopupWindowClass;
begin
  Result := TTBXPopupWindow;
end;

function TTBXCustomItem.GetStretch: Boolean;
begin
  Result := tbisStretch in ItemStyle;
end;

procedure TTBXCustomItem.Invalidate;
begin
  Change(False);
end;

procedure TTBXCustomItem.SetFontSettings(Value: TFontSettings);
begin
  FFontSettings.Assign(Value);
end;

procedure TTBXCustomItem.SetLayout(Value: TTBXItemLayout);
begin
  if Value <> FLayout then
  begin
    FLayout := Value;
    Change(True);
  end;
end;

procedure TTBXCustomItem.SetMinHeight(Value: Integer);
begin
  if Value <> FMinHeight then
  begin
    FMinHeight := Value;
    Change(True);
  end;
end;

procedure TTBXCustomItem.SetMinWidth(Value: Integer);
begin
  if Value <> FMinWidth then
  begin
    FMinWidth := Value;
    Change(True);
  end;
end;

procedure TTBXCustomItem.SetStretch(Value: Boolean);
begin
  if Value xor (tbisStretch in ItemStyle) then
  begin
    if Value then ItemStyle := ItemStyle + [tbisStretch]
    else ItemStyle := ItemStyle - [tbisStretch];
    Change(True);
  end;
end;


//============================================================================//

{ TTBXItemViewer }

procedure TTBXItemViewer.CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer);
const
  CMarginIDs: array [Boolean] of Integer = (MID_MENUITEM, MID_TOOLBARITEM);
  CStartSize: array [Boolean] of Integer = (0, 6);
var
  W, H: Integer;
  ImgSize: TSize;
  Item: TTBCustomItem;
  ItemLayout, SaveLayout: TTBXItemLayout;
  IsCaptionShown: Boolean;
  IsTextRotated: Boolean;
  ToolbarStyle: Boolean;
  S: string;
  TextFlags: Cardinal;
  TextMetric: TTextMetric;
  TextSize: TSize;
  Margins: TTBXMargins;
begin
  Item := TTBCustomItem(Self.Item);
  ToolbarStyle := IsToolbarStyle;
  ImgSize := GetImageSize;
  if (ImgSize.CX <= 0) or (ImgSize.CY <= 0) then
  begin
    ImgSize.CX := 0;
    ImgSize.CY := 0;
  end;

  if Item is TTBXCustomItem then ItemLayout := TTBXCustomItem(Item).Layout
  else ItemLayout := tbxlAuto;
  SaveLayout := ItemLayout;
  if ItemLayout = tbxlAuto then
  begin
    if tboImageAboveCaption in Item.EffectiveOptions then ItemLayout := tbxlGlyphTop
    else
    begin
      if View.Orientation <> tbvoVertical then ItemLayout := tbxlGlyphLeft
      else ItemLayout := tbxlGlyphTop;
    end;
  end;

  { Setup font }
  TextFlags := 0;
  IsCaptionShown := CaptionShown;
  IsTextRotated := (View.Orientation = tbvoVertical) and ToolbarStyle and
    not (tboNoRotation in Item.EffectiveOptions);
  if IsCaptionShown then
  begin
    S := GetCaptionText;
    if not (SaveLayout = tbxlAuto) or (tboImageAboveCaption in Item.EffectiveOptions) then IsTextRotated := False;
    if IsTextRotated or not ToolbarStyle then TextFlags := DT_SINGLELINE;
    TextSize := GetTextSize(Canvas, S, TextFlags, IsTextRotated, 0);
  end
  else
  begin
    SetLength(S, 0);
    TextSize.CX := 0;
    TextSize.CY := 0;
    IsTextRotated := False;
  end;

  { Measure size }
  if ToolbarStyle then
  begin
    AWidth := 6;
    AHeight := 6;

    if CaptionShown then
    begin
      Inc(AWidth, TextSize.CX);
      Inc(AHeight, TextSize.CY);
      if not IsTextRotated then Inc(AWidth, 4)
      else Inc(AHeight, 4);
    end;

    if GetImageShown and (ImgSize.CX > 0) and (ImgSize.CY > 0) then
    begin
      if ItemLayout = tbxlGlyphLeft then
      begin
        Inc(AWidth, ImgSize.CX);
        if Wide then Inc(AWidth);
        if AHeight < ImgSize.CY + 6 then AHeight := ImgSize.CY + 6;
      end
      else
      begin
        Inc(AHeight, ImgSize.CY);
        if AWidth < ImgSize.CX + 7 then AWidth := ImgSize.CX + 7;
      end;
    end;

    if tbisSubmenu in TTBItemAccess(Item).ItemStyle then with CurrentTheme do
    begin
      if tbisCombo in TTBItemAccess(Item).ItemStyle then Inc(AWidth, SplitBtnArrowWidth)
      else if tboDropdownArrow in Item.EffectiveOptions then
      begin
        if (ItemLayout <> tbxlGlyphTop) or (ImgSize.CX = 0) or IsTextRotated then
        begin
          if View.Orientation <> tbvoVertical then Inc(AWidth, DropdownArrowWidth)
          else Inc(AHeight, DropdownArrowWidth);
        end
        else
        begin
          if (ItemLayout = tbxlGlyphTop) and (IsTextRotated xor (View.Orientation <> tbvoVertical)) then
          begin
            W := ImgSize.CX + DropDownArrowWidth + 2;
            if W > AWidth - 7 then AWidth := W + 7;
          end
          else
          begin
            H := ImgSize.CY + DropDownArrowWidth + 2;
            if H > AHeight - 7 then AHeight := H + 7;
          end;
        end
      end;
    end;
  end
  else // Not a ToolbarStyle
    with CurrentTheme do
    begin
      GetTextMetrics(Canvas.Handle, TextMetric);
      Inc(TextSize.CY, TextMetric.tmExternalLeading);

      AWidth := TextSize.CX;
      AHeight := TextSize.CY;

      if ImgSize.CY = 0 then ImgSize.CY := 16;
      if AHeight < ImgSize.CY then AHeight := ImgSize.CY;

      GetMargins(MID_MENUITEM, Margins);
      Inc(AWidth, Margins.LeftWidth + Margins.RightWidth);
      Inc(AHeight, Margins.TopHeight + Margins.BottomHeight);

      Inc(AWidth, GetPopupMargin(Self) + MenuImageTextSpace + MenuLeftCaptionMargin + MenuRightCaptionMargin);
      S := Item.GetShortCutText;
      if Length(S) > 0 then Inc(AWidth, (AHeight - 6) + GetTextWidth(Canvas.Handle, S, True));
      Inc(AWidth, AHeight); { Note: maybe this should be controlled by the theme }
    end;

  if Item is TTBXCustomItem then with TTBXCustomItem(Item) do
  begin
    if AWidth < MinWidth then AWidth := MinWidth;
    if AHeight < MinHeight then AHeight := MinHeight;
  end;
end;

constructor TTBXItemViewer.Create(AView: TTBView; AItem: TTBCustomItem; AGroupLevel: Integer);
begin
  inherited;
  FWide := True;
end;

procedure TTBXItemViewer.DoAdjustFont(AFont: TFont; StateFlags: Integer);
begin
  if tboDefault in Item.EffectiveOptions then with AFont do Style := Style + [fsBold];
  if Item is TTBXCustomItem then
    with TTBXCustomItem(Item) do
    begin
      FontSettings.Apply(AFont);
      if Assigned(FOnAdjustFont) then FOnAdjustFont(Item, Self, AFont, StateFlags);
    end
  else if Item is TTBXEditItem then
    with TTBXEditItem(Item) do
    begin
      FontSettings.Apply(AFont);
    end;
end;

procedure TTBXItemViewer.DoPaintCaption(Canvas: TCanvas; const ClientAreaRect: TRect;
  var CaptionRect: TRect; IsTextRotated: Boolean; var PaintDefault: Boolean);
begin
  // do nothing
end;

procedure TTBXItemViewer.DrawItemImage(Canvas: TCanvas; ARect: TRect; ItemInfo: TTBXItemInfo);
var
  ImgList: TCustomImageList;
  I: TTBXCustomItem;
  DefaultDraw: Boolean;
begin
  ImgList := GetImageList;
  if (ImgList <> nil) and (Item.ImageIndex >= 0) and (Item.ImageIndex < ImgList.Count) then
  begin
    if Item is TTBXCustomItem then I := TTBXCustomItem(Item)
    else I := nil;
    if Assigned(I) and Assigned(I.FOnAdvancedDrawImage) then
    begin
      DefaultDraw := True;
      I.FOnAdvancedDrawImage(I, Self, Canvas, ARect,
        CurrentTheme.GetImageOffset(Canvas, ItemInfo, ImgList),
          GetStateFlags(ItemInfo), DefaultDraw);
      if not DefaultDraw then Exit;
    end;
    CurrentTheme.PaintImage(Canvas, ARect, ItemInfo, ImgList, Item.ImageIndex);
    if Assigned(I) and Assigned(I.FOnDrawImage) then
      I.FOnDrawImage(I, Self, Canvas, ARect,
        CurrentTheme.GetImageOffset(Canvas, ItemInfo, ImgList), GetStateFlags(ItemInfo));
  end;
end;

function TTBXItemViewer.GetAccRole: Integer;
{ Returns the MSAA "role" of the viewer. }
const
  { Constants from OleAcc.h }
  ROLE_SYSTEM_BUTTONDROPDOWNGRID = $3A;
begin
  Result := inherited GetAccRole;
  if (Item is TTBXCustomItem) and TTBXCustomItem(Item).ToolBoxPopup and
    (tbisSubmenu in TTBXCustomItem(Item).ItemStyle) then
    Result := ROLE_SYSTEM_BUTTONDROPDOWNGRID;
end;

function TTBXItemViewer.GetImageShown: Boolean;
begin
  Result := (Item.ImageIndex >= 0) and
    ((Item.DisplayMode in [nbdmDefault, nbdmImageAndText]) or
    (IsToolbarStyle and (Item.DisplayMode = nbdmTextOnlyInMenus)));
end;

function TTBXItemViewer.GetImageSize: TSize;
var
  ImgList: TCustomImageList;
begin
  ImgList := GetImageList;
  with Result do if ImgList <> nil then
  begin
    CX := ImgList.Width;
    CY := ImgList.Height;
  end
  else
  begin
    CX := 0;
    CY := 0;
  end;
end;

function TTBXItemViewer.GetItemType: Integer;
begin
  if IsToolbarStyle then Result := IT_TOOLBARBUTTON
  else Result := IT_MENUITEM;
end;

function TTBXItemViewer.GetTextFlags: Cardinal;
begin
  Result := 0;
  if not AreKeyboardCuesEnabled and (vsUseHiddenAccels in View.Style) and
    not (vsShowAccels in View.State) then Result := DT_HIDEPREFIX;
end;

function TTBXItemViewer.GetTextSize(Canvas: TCanvas; const Text: string;
  TextFlags: Cardinal; Rotated: Boolean; StateFlags: Integer): TSize;
var
  DC: HDC;
  R: TRect;
  RotatedFont, SaveFont: HFONT;
  TextMetric: TTextMetric;
begin
  { note: rotated font size is consistent only for single-line captions! }
  if Length(Text) = 0 then with Result do
  begin
    CX := 0;
    CY := 0;
    Exit;
  end;

  { Select proper font }
  Canvas.Font := TTBViewAccess(View).GetFont;
  DoAdjustFont(Canvas.Font, StateFlags);

  if not Rotated then with R, Result do
  begin
    Left := 0; Right := 1;
    Top := 0; Bottom := 0;
    DrawText(Canvas.Handle, PChar(Text), Length(Text), R, TextFlags or DT_CALCRECT);
    CX := Right;
    CY := Bottom;
  end
  else
  begin
    DC := Canvas.Handle;
    RotatedFont := CreateRotatedFont(DC);
    SaveFont := SelectObject(DC, RotatedFont);
    GetTextMetrics(DC, TextMetric);
    Result.CX := TextMetric.tmHeight;
    Result.CY := GetTextWidth(DC, Text, True);
    SelectObject(DC, SaveFont);
    DeleteObject(RotatedFont);
  end;
end;

function TTBXItemViewer.IsPtInButtonPart(X, Y: Integer): Boolean;
var
  W: Integer;
begin
  Result := not (tbisSubmenu in TTBItemAccess(Item).ItemStyle);
  if (tbisCombo in TTBItemAccess(Item).ItemStyle) then
  begin
    if IsToolbarStyle then W := CurrentTheme.SplitBtnArrowWidth
    else W := GetSystemMetrics(SM_CXMENUCHECK);
    Result := X < (BoundsRect.Right - BoundsRect.Left) - W;
  end;
end;

function TTBXItemViewer.IsToolbarSize: Boolean;
begin
  Result := inherited IsToolbarSize;
  Result := Result or ((GetViewType(View) and PVT_TOOLBOX) = PVT_TOOLBOX);
end;

function TTBXItemViewer.IsToolbarStyle: Boolean;
begin
  Result := inherited IsToolbarStyle;
  Result := Result or ((GetViewType(View) and PVT_TOOLBOX) = PVT_TOOLBOX);
end;

procedure TTBXItemViewer.MouseUp(X, Y: Integer; MouseWasDownOnMenu: Boolean);
begin
  inherited;
  { Force the item to behave as a 'normal' menu item
    That is make it respond to mouse as an item with IsToolbarStyle = False }
  if Item.Enabled and not ((tbisSubmenu in TTBItemAccess(Item).ItemStyle) and
    not IsPtInButtonPart(X, Y)) then
  begin
    if View.MouseOverSelected then
    begin
      Execute(True);
    end;
  end;
end;

procedure TTBXItemViewer.Paint(const Canvas: TCanvas;
  const ClientAreaRect: TRect; IsHoverItem, IsPushed, UseDisabledShadow: Boolean);
const
  CToolbarStyle: array [Boolean] of Integer = (0, IO_TOOLBARSTYLE);
  CCombo: array [Boolean] of Integer = (0, IO_COMBO);
  CSubmenuItem: array [Boolean] of Integer = (0, IO_SUBMENUITEM);
  CDesigning: array [Boolean] of Integer = (0, IO_DESIGNING);
  CAppActive: array [Boolean] of Integer = (0, IO_APPACTIVE);
var
  Item: TTBXCustomItem;
  View: TTBViewAccess;
  ItemInfo: TTBXItemInfo;

  R: TRect;
  ComboRect: TRect;
  CaptionRect: TRect;
  ImageRect: TRect;
  C: TColor;

  ToolbarStyle: Boolean;
  HasArrow: Boolean;
  IsSplit: Boolean;
  ImageIsShown: Boolean;
  ImageOrCheckShown: Boolean;
  ImgAndArrowWidth: Integer;
  ImgSize: TSize;
  IsComboPushed: Boolean;
  IsCaptionShown: Boolean;
  IsTextRotated: Boolean;
  ItemLayout: TTBXItemLayout;
  PaintDefault: Boolean;
  S: string;
  StateFlags: Integer;
  IsSpecialDropDown: Boolean;
  TextFlags: Cardinal;
  TextMetrics: TTextMetric;
  TextSize: TSize;
  Margins: TTBXMargins;
begin
  Item := TTBXCustomItem(Self.Item);
  View := TTBViewAccess(Self.View);

  ToolbarStyle := IsToolbarStyle;
  IsSplit := tbisCombo in Item.ItemStyle;
  IsComboPushed := IsSplit and IsPushed and not View.Capture;
  if IsComboPushed then IsPushed := False;

  if GetImageShown then
  begin
    ImgSize := GetImageSize;
    with ImgSize do if (CX <= 0) or (CY <= 0) then
    begin
      CX := 0;
      CY := 0;
      ImageIsShown := False;
    end
    else ImageIsShown := True;
  end
  else
  begin
    ImgSize.CX := 0;
    ImgSize.CY := 0;
    ImageIsShown := False;
  end;
  IsSplit := tbisCombo in Item.ItemStyle;

  FillChar(ItemInfo, SizeOf(ItemInfo), 0);
  ItemInfo.ViewType := GetViewType(View);
  ItemInfo.ItemOptions := CToolbarStyle[ToolbarStyle] or CCombo[IsSplit] or
    CDesigning[csDesigning in Item.ComponentState] or CSubmenuItem[tbisSubmenu in Item.ItemStyle] or
    CAppActive[Application.Active];
  ItemInfo.Enabled := Item.Enabled or View.Customizing;
  ItemInfo.Pushed := IsPushed;
  ItemInfo.Selected := Item.Checked;
  ItemInfo.ImageShown := ImageIsShown;
  ItemInfo.ImageWidth := ImgSize.CX;
  ItemInfo.ImageHeight := ImgSize.CY;
  if IsHoverItem then
  begin
    if not ItemInfo.Enabled and not View.MouseOverSelected then ItemInfo.HoverKind := hkKeyboardHover
    else if ItemInfo.Enabled then ItemInfo.HoverKind := hkMouseHover;
  end
  else ItemInfo.HoverKind := hkNone;
  ItemInfo.IsPopupParent := ToolbarStyle and
    (((vsModal in View.State) and Assigned(View.OpenViewer)) or (tbisSubmenu in Item.ItemStyle)) and
    ((IsSplit and IsComboPushed) or (not IsSplit and IsPushed));
  ItemInfo.IsVertical := (View.Orientation = tbvoVertical) and not IsSplit;
  ItemInfo.PopupMargin := GetPopupMargin(Self);

  ItemLayout := Item.Layout;
  if ItemLayout = tbxlAuto then
  begin
    if tboImageAboveCaption in Item.EffectiveOptions then ItemLayout := tbxlGlyphTop
    else if View.Orientation <> tbvoVertical then ItemLayout := tbxlGlyphLeft
    else ItemLayout := tbxlGlyphTop;
  end;

  HasArrow := (tbisSubmenu in Item.ItemStyle) and
    ((tbisCombo in Item.ItemStyle) or (tboDropdownArrow in Item.EffectiveOptions));

  if GetImageShown then
  begin
    ImgSize := GetImageSize;
    with ImgSize do if (CX <= 0) or (CY <= 0) then
    begin
      CX := 0;
      CY := 0;
      ImageIsShown := False;
    end
    else ImageIsShown := True;
  end
  else
  begin
    ImgSize.CX := 0;
    ImgSize.CY := 0;
    ImageIsShown := False;
  end;
  ImageOrCheckShown := ImageIsShown or (not ToolbarStyle and Item.Checked);

  StateFlags := GetStateFlags(ItemInfo);

  Canvas.Font := TTBViewAccess(View).GetFont;
  Canvas.Font.Color := CurrentTheme.GetItemTextColor(ItemInfo);
  DoAdjustFont(Canvas.Font, StateFlags);
  C := Canvas.Font.Color;

  { Setup font }
  TextFlags := GetTextFlags;
  IsCaptionShown := CaptionShown;

  IsTextRotated := (View.Orientation = tbvoVertical) and ToolbarStyle and
    not (tboNoRotation in Item.EffectiveOptions);
  if IsCaptionShown then
  begin
    S := GetCaptionText;
    if (Item.Layout <> tbxlAuto) or (tboImageAboveCaption in Item.EffectiveOptions) then
      IsTextRotated := False;
    if IsTextRotated or not ToolbarStyle then TextFlags := TextFlags or DT_SINGLELINE;
    TextSize := GetTextSize(Canvas, S, TextFlags, IsTextRotated, StateFlags);
  end
  else
  begin
    SetLength(S, 0);
    IsTextRotated := False;
    TextSize.CX := 0;
    TextSize.CY := 0;
  end;

  IsSpecialDropDown := HasArrow and not IsSplit and ToolbarStyle and
    ((Item.Layout = tbxlGlyphTop) or (Item.Layout = tbxlAuto) and (tboImageAboveCaption in Item.EffectiveOptions)) and
    (ImgSize.CX > 0) and not (IsTextRotated) and (TextSize.CX > 0);

  { Border & Arrows }
  R := ClientAreaRect;
  with CurrentTheme do if ToolbarStyle then
  begin
    GetMargins(MID_TOOLBARITEM, Margins);
    if HasArrow then with R do
    begin
      ItemInfo.ComboPart := cpCombo;
      if IsSplit then
      begin
        ItemInfo.ComboPart := cpSplitLeft;
        ComboRect := R;
        Dec(Right, SplitBtnArrowWidth);
        ComboRect.Left := Right;
      end
      else if not IsSpecialDropDown then
      begin
        if View.Orientation <> tbvoVertical then
          ComboRect := Rect(Right - DropdownArrowWidth - DropdownArrowMargin, 0,
            Right - DropdownArrowMargin, Bottom)
        else
          ComboRect := Rect(0, Bottom - DropdownArrowWidth - DropdownArrowMargin,
            Right, Bottom - DropdownArrowMargin);
      end
      else
      begin
        ImgAndArrowWidth := ImgSize.CX + DropdownArrowWidth + 2;
        ComboRect.Right := (R.Left + R.Right + ImgAndArrowWidth + 2) div 2;
        ComboRect.Left := ComboRect.Right - DropdownArrowWidth;
        ComboRect.Top := (R.Top + R.Bottom - ImgSize.cy - 2 - TextSize.CY) div 2;
        ComboRect.Bottom := ComboRect.Top + ImgSize.CY;
      end;
    end
    else SetRectEmpty(ComboRect);

    if not IsSplit then
    begin
      PaintButton(Canvas, R, ItemInfo);
      if HasArrow then
      begin
        PaintDropDownArrow(Canvas, ComboRect, ItemInfo);
        if not IsSpecialDropDown then
        begin
          if View.Orientation <> tbvoVertical then Dec(R.Right, DropdownArrowWidth)
          else Dec(R.Bottom, DropdownArrowWidth);
        end;
      end;
    end
    else // IsSplit
    begin
      CurrentTheme.PaintButton(Canvas, R, ItemInfo);
      ItemInfo.Pushed := IsComboPushed;
      ItemInfo.Selected := False;
      ItemInfo.ComboPart := cpSplitRight;
      CurrentTheme.PaintButton(Canvas, ComboRect, ItemInfo);
      ItemInfo.ComboPart := cpSplitLeft;
      ItemInfo.Pushed := IsPushed;
      ItemInfo.Selected := Item.Checked;
    end;
  end
  else // not toolbar style
  begin
    GetMargins(MID_MENUITEM, Margins);
    PaintMenuItem(Canvas, R, ItemInfo);
  end;
  Inc(R.Left, Margins.LeftWidth);
  Dec(R.Right, Margins.RightWidth);
  Inc(R.Top, Margins.TopHeight);
  Dec(R.Bottom, Margins.BottomHeight);

  { Caption }
  if IsCaptionShown then
  begin
    if ToolbarStyle then
    begin
      CaptionRect := R;
      TextFlags := TextFlags or DT_CENTER or DT_VCENTER;
      if ImageIsShown then with CaptionRect do
        case ItemLayout of
        tbxlGlyphLeft:
          begin
            Inc(Left, ImgSize.CX + 3);
            Top := (Top + Bottom  - TextSize.CY) div 2;
            Bottom := Top + TextSize.CY;
            Left := (Left + Right - TextSize.CX) div 2;
            Right := Left + TextSize.CX;
            TextFlags := TextFlags and not DT_CENTER;
          end;
        tbxlGlyphTop:
          begin
            Inc(Top, ImgSize.CY + 1);
            if IsTextRotated then Inc(CaptionRect.Top, 3);
            Top := (Top + Bottom  - TextSize.CY) div 2;
            Bottom := Top + TextSize.CY;
            Left := (Left + Right - TextSize.CX) div 2;
            Right := Left + TextSize.CX;
            TextFlags := TextFlags and not DT_VCENTER;
          end;
        end
      else
      begin
        with CaptionRect, TextSize do
        begin
          Left := (Left + R.Right - CX) div 2;
          Top := (Top + R.Bottom - CY) div 2;
          Right := Left + CX;
          Bottom := Top + CY;
        end;
      end;

      Canvas.Font.Color := C;
      PaintDefault := True;
      DoPaintCaption(Canvas, ClientAreaRect, CaptionRect, IsTextRotated, PaintDefault);
      if PaintDefault then
        CurrentTheme.PaintCaption(Canvas, CaptionRect, ItemInfo, S, TextFlags, IsTextRotated);
    end
    else with CurrentTheme do
    begin
      TextFlags := DT_LEFT or DT_VCENTER or TextFlags;
      GetTextMetrics(Canvas.Handle, TextMetrics);

      CaptionRect := R;
      Inc(CaptionRect.Left, ItemInfo.PopupMargin + MenuImageTextSpace + MenuLeftCaptionMargin);
      with TextMetrics, CaptionRect do
        if (Bottom - Top) - (tmHeight + tmExternalLeading) = Margins.BottomHeight then Dec(Bottom);
      Inc(CaptionRect.Top, TextMetrics.tmExternalLeading);

      CaptionRect.Right := CaptionRect.Left + TextSize.CX;

      Canvas.Font.Color := C;
      PaintDefault := True;
      DoPaintCaption(Canvas, ClientAreaRect, CaptionRect, IsTextRotated, PaintDefault);
      if PaintDefault then
        CurrentTheme.PaintCaption(Canvas, CaptionRect, ItemInfo, S, TextFlags, IsTextRotated);
    end;
  end;

  { Shortcut and/or submenu arrow (menus only) }
  if not ToolbarStyle then
  begin
    S := Item.GetShortCutText;
    if Length(S) > 0 then
    begin
      CaptionRect := R;
      with CaptionRect, TextMetrics do
      begin
        Left := Right - (Bottom - Top) - GetTextWidth(Canvas.Handle, S, True);
        if (Bottom - Top) - (tmHeight + tmExternalLeading) = Margins.BottomHeight then Dec(Bottom);
        Inc(Top, TextMetrics.tmExternalLeading);
      end;
      Canvas.Font.Color := C;
      PaintDefault := True;
      DoPaintCaption(Canvas, ClientAreaRect, CaptionRect, IsTextRotated, PaintDefault);
      if PaintDefault then
        CurrentTheme.PaintCaption(Canvas, CaptionRect, ItemInfo, S, TextFlags, False);
    end;
  end;

  { Image, or check box }
  if ImageOrCheckShown then
  begin
    ImageRect := R;

    if ToolBarStyle then
    begin
      if IsSpecialDropDown then
        OffsetRect(ImageRect, (-CurrentTheme.DropdownArrowWidth + 1) div 2, 0);
      if ItemLayout = tbxlGlyphLeft then
        ImageRect.Right := ImageRect.Left + ImgSize.CX + Margins.LeftWidth
      else
      begin
        ImageRect.Top := (ImageRect.Top + ImageRect.Bottom - ImgSize.cy - 2 - TextSize.cy) div 2;
        ImageRect.Bottom := ImageRect.Top + ImgSize.cy + Margins.TopHeight;
      end;
    end
    else ImageRect.Right := ImageRect.Left + ClientAreaRect.Bottom - ClientAreaRect.Top;

    if ImageIsShown then with ImageRect, ImgSize do
    begin
      Left := Left + ((Right - Left) - CX) div 2;
      ImageRect.Top := Top + ((Bottom - Top) - CY) div 2;
      Right := Left + CX;
      Bottom := Top + CY;
      DrawItemImage(Canvas, ImageRect, ItemInfo);
    end
    else if not ToolbarStyle and Item.Checked then
    begin
      if Item.RadioItem then
        with ItemInfo do ItemOptions := ItemOptions or IO_RADIO;
      CurrentTheme.PaintCheckMark(Canvas, ImageRect, ItemInfo);
    end;
  end;
end;


//============================================================================//

{ TTBXSubmenuItem }

type
  TTBXEmptyItem = class(TTBXCustomItem);

constructor TTBXSubmenuItem.Create(AOwner: TComponent);
begin
  inherited;
  ItemStyle := ItemStyle + [tbisSubMenu, tbisSubitemsEditable];
  FAutoEmptyItem := True;
end;

procedure TTBXSubmenuItem.DoClosePopup(ClickedItem: TTBCustomItem);
begin
  if (Count > 0) and (Items[0] is TTBXEmptyItem) then
    Items[0].Free;
  inherited;
end;

procedure TTBXSubmenuItem.DoPopup(Sender: TTBCustomItem; FromLink: Boolean);
begin
  inherited;
  if (Count = 0) and FAutoEmptyItem then
  begin
    Add(TTBXEmptyItem.Create(Self));
    with Items[0] do
    begin
      Caption := GetAutoEmptyItemCaption;
      Enabled := False;
    end;
  end;
end;

function TTBXSubmenuItem.GetAutoEmptyItemCaption: String;
begin
  if FAutoEmptyItemCaption <> ''
    then Result := FAutoEmptyItemCaption
    else Result := STBXAutoEmptyItemCaption;
end;

function TTBXSubmenuItem.GetDropdownCombo: Boolean;
begin
  Result := tbisCombo in ItemStyle;
end;

procedure TTBXSubmenuItem.SetAutoEmptyItemCaption(const Value: String);
begin
  if Value <> STBXAutoEmptyItemCaption then FAutoEmptyItemCaption := Value
  else FAutoEmptyItemCaption := '';
end;

function TTBXSubmenuItem.IsAutoEmptyItemCaptionStored: Boolean;
begin
  Result := FAutoEmptyItemCaption <> '';
end;

procedure TTBXSubmenuItem.SetDropdownCombo(Value: Boolean);
begin
  if (tbisCombo in ItemStyle) <> Value then
  begin
    if Value then ItemStyle := ItemStyle + [tbisCombo]
    else ItemStyle := ItemStyle - [tbisCombo];
    Change(True);
  end;
end;



//============================================================================//

{ TTBXSeparatorItem }

constructor TTBXSeparatorItem.Create(AOwner: TComponent);
begin
  inherited;
  FSize := -1;  // use default from as in TTBSeparatorItem
end;

function TTBXSeparatorItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
begin
  Result := TTBXSeparatorItemViewer;
end;

procedure TTBXSeparatorItem.SetSize(Value: Integer);
begin
  if Value < -1 then Value := -1;
  if Value <> FSize then
  begin
    FSize := Value;
    Change(True);
  end;
end;


//============================================================================//

{ TTBXSeparatorItemViewer }

procedure TTBXSeparatorItemViewer.CalcSize(const Canvas: TCanvas;
  var AWidth, AHeight: Integer);
var
  SZ: Integer;
begin
  SZ := TTBXSeparatorItem(Item).Size;
  if SZ < 0 then
  begin
    if not IsToolbarStyle then SZ := CurrentTheme.MenuSeparatorSize
    else SZ := CurrentTheme.TlbrSeparatorSize;
    if SZ < 0 then inherited CalcSize(Canvas, AWidth, AHeight)
    else
    begin
      AWidth := SZ;
      AHeight := SZ;
    end;
  end
  else if not IsToolbarStyle then
  begin
    AHeight := SZ;
    AWidth := 0;
  end
  else
  begin
    AWidth := SZ;
    AHeight := SZ;
  end;
end;

function TTBXSeparatorItemViewer.IsToolbarSize: Boolean;
begin
  Result := inherited IsToolbarSize;
  Result := Result or ((GetViewType(View) and PVT_TOOLBOX) = PVT_TOOLBOX);
end;

function TTBXSeparatorItemViewer.IsToolbarStyle: Boolean;
begin
  Result := inherited IsToolbarStyle;
  Result := Result or ((GetViewType(View) and PVT_TOOLBOX) = PVT_TOOLBOX);
end;

procedure TTBXSeparatorItemViewer.Paint(const Canvas: TCanvas;
  const ClientAreaRect: TRect; IsHoverItem, IsPushed, UseDisabledShadow: Boolean);
const
  CToolbarStyle: array [Boolean] of Integer = (0, IO_TOOLBARSTYLE);
  CDesigning: array [Boolean] of Integer = (0, IO_DESIGNING);
var
  Item: TTBXSeparatorItem;
  ItemInfo: TTBXItemInfo;
  R: TRect;
  LineSep, HorzLine: Boolean;
begin
  Item := TTBXSeparatorItem(Self.Item);
  if Item.Size = 0 then Exit;

  FillChar(ItemInfo, SizeOf(TTBXItemInfo), 0);
  ItemInfo.ViewType := GetViewType(View);
  ItemInfo.ItemOptions := CToolbarStyle[IsToolbarStyle] or
    CDesigning[csDesigning in Item.ComponentState];
  ItemInfo.Enabled := not Item.Blank;
  ItemInfo.Pushed := IsPushed;
  ItemInfo.Selected := False;
  ItemInfo.ImageShown := False;
  ItemInfo.ImageWidth := 0;
  ItemInfo.ImageHeight := 0;
  ItemInfo.IsVertical := View.Orientation = tbvoVertical;
  if not IsToolbarStyle then ItemInfo.PopupMargin := GetPopupMargin(Self);

  R := ClientAreaRect;
  LineSep := tbisLineSep in State;
  with ItemInfo do
  begin
    HorzLine := (IsVertical xor LineSep) or View.IsPopup;
    if (((ViewType and VT_POPUP) = VT_POPUP) and
      ((ViewType and PVT_CHEVRONMENU) = PVT_CHEVRONMENU)) then
      HorzLine := (HorzLine and LineSep);
  end;
  CurrentTheme.PaintSeparator(Canvas, R, ItemInfo, HorzLine, LineSep);
end;

//============================================================================//

{ TTBXVisibilityToggleItem }

procedure TTBXVisibilityToggleItem.Click;
begin
  if Assigned(FControl) then FControl.Visible := not FControl.Visible;
  inherited;
end;

procedure TTBXVisibilityToggleItem.InitiateAction;
begin
  UpdateProps;
end;

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

procedure TTBXVisibilityToggleItem.SetControl(Value: TControl);
begin
  if FControl <> Value then
  begin
    FControl := Value;
    if Assigned(Value) then
    begin
      Value.FreeNotification(Self);
      if (Length(Caption) = 0) and not (csLoading in ComponentState) then
        Caption := TControlAccess(Value).Caption;
    end;
    UpdateProps;
  end;
end;

procedure TTBXVisibilityToggleItem.UpdateProps;
begin
  if (ComponentState * [csDesigning, csLoading, csDestroying] = []) then
    Checked := Assigned(FControl) and FControl.Visible;
end;

//============================================================================//

{ TTBXPopupWindow }

procedure TTBXPopupWindow.CMHintShow(var Message: TCMHintShow);
begin
  with Message.HintInfo^ do
  begin
    HintStr := '';
    if Assigned(View.Selected) then
    begin
      CursorRect := View.Selected.BoundsRect;
      HintStr := View.Selected.GetHintText;
      View.Selected.Dispatch(Message);
    end;
  end;
end;

procedure TTBXPopupWindow.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);
var
  AniMode: TAnimationMode;
  AniDir: TTBAnimationDirection;
begin
  { Must override TCustomForm/TForm's CM_SHOWINGCHANGED handler so that the
    form doesn't get activated when Visible is set to True. }

  { Handle animation. NOTE: I do not recommend trying to enable animation on
    Windows 95 and NT 4.0 because there's a difference in the way the
    SetWindowPos works on those versions. See the comment in the
    TBStartAnimation function of TB2Anim.pas. }
  {$IFNDEF TBX_NO_ANIMATION}
  if ((View.ParentView = nil) or not(vsNoAnimation in View.ParentView.State)) and
     Showing and (View.Selected = nil) and not IsWindowVisible(WindowHandle) and
     (TBXMenuAnimation.AnimationMode <> amNone) then
  begin
    AniMode := TBXMenuAnimation.GetAnimation;
    if (AniMode <> amNone) and
      (SendMessage(WindowHandle, WM_TB2K_POPUPSHOWING, TPS_ANIMSTART, 0) = 0) then
      { ^ Start animation only if WM_TB2K_POPUPSHOWING returns zero (or not handled) }
    begin
      AniDir := TTBPopupWindowAccess(Self).AnimationDirection;
      if AniMode = amUnfold then
        if [tbadDown, tbadUp] * AniDir <> []
          then Include(AniDir, tbadRight)
          else Include(AniDir, tbadDown);
      TBStartAnimation(WindowHandle, AniMode = amFade, AniDir);
      Exit;
    end;
  end;
  {$ENDIF}

  { No animation... }
  if not Showing then begin
    { Call TBEndAnimation to ensure WS_EX_LAYERED style is removed before
      hiding, otherwise windows under the popup window aren't repainted
      properly. }
    TBEndAnimation(WindowHandle);
    DestroyShadow;
  end;
  SetWindowPos(WindowHandle, 0, 0, 0, 0, 0, ShowFlags[Showing]);
  if Showing then SendNotifyMessage(WindowHandle, WM_TB2K_POPUPSHOWING, TPS_NOANIM, 0);
end;

procedure TTBXPopupWindow.CreateParams(var Params: TCreateParams);
const
  CS_DROPSHADOW = $00020000;
begin
  inherited CreateParams(Params);
  with Params do
  begin
    WindowClass.Style := WindowClass.Style and not (CS_DROPSHADOW or CS_DBLCLKS);
    if GetShowShadow and (CurrentTheme.GetPopupShadowType = PST_WINDOWSXP) and IsWindowsXP then
    begin
      WindowClass.Style := WindowClass.Style or CS_DROPSHADOW;
      StrPCopy(WinClassName, ClassName + 'S');
    end;
  end;
end;

procedure TTBXPopupWindow.CreateShadow;
var
  PR: TRect;
  ParentViewer: TTBItemViewer;
  VT: Integer;
  ChevronParent: Boolean;
begin
  if (CurrentTheme.GetPopupShadowType = PST_WINDOWS2K) and not
    ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5)) then Exit;

  SetRectEmpty(PR);
  if CurrentTheme.GetPopupShadowType = PST_OFFICEXP then
  begin
    if (View <> nil) and (View.ParentView <> nil) then
    begin
      ParentViewer := TTBViewAccess(View.ParentView).OpenViewer;
      ChevronParent := Self is TTBXChevronPopupWindow;
      if ((ParentViewer is TTBXItemViewer) or ChevronParent) then
      begin
        VT := GetViewType(ParentViewer.View);
        if ((VT and PVT_POPUPMENU) <> PVT_POPUPMENU) or ChevronParent then
        begin
          PR := ParentViewer.BoundsRect;
          PR.TopLeft := View.ParentView.Window.ClientToScreen(PR.TopLeft);
          PR.BottomRight := View.ParentView.Window.ClientToScreen(PR.BottomRight);
        end;
      end;
    end
    else if not IsRectEmpty(FControlRect) then
    begin
      PR := FControlRect;
    end;
  end;
  FShadows := TShadows.Create(PR, BoundsRect, 4, 61, TBXLoColor);
  FShadows.Show(Handle);
end;

destructor TTBXPopupWindow.Destroy;
var
  ParentItem, ClickedItem: TTBCustomItem;
  ParentView: TTBView;
begin
  DestroyShadow;
  Hide;

  if Assigned(View) then
  begin
    ParentItem := View.ParentItem;
    if ParentItem is TTBXCustomItem then
    begin
      ClickedItem := nil;
      ParentView := View.ParentView;
      if Assigned(ParentView) then
        with TTBViewAccess(ParentView).DoneActionData do
          if DoneAction = tbdaClickItem then
            ClickedItem := ClickItem;
      TTBXCustomItem(ParentItem).DoClosePopup(ClickedItem);
    end;
  end;

  inherited;
end;

procedure TTBXPopupWindow.DestroyShadow;
begin
  FreeAndNil(FShadows);
end;

function TTBXPopupWindow.GetFillColor: TColor;
begin
  Result := CurrentTheme.GetViewColor(GetViewType(View));
  View.BackgroundColor := Result;
end;

function TTBXPopupWindow.GetNCSize: TPoint;
begin
  Result := inherited GetNCSize;
  CurrentTheme.GetViewBorder(GetViewType(View), Result);
end;

function TTBXPopupWindow.GetShowShadow: Boolean;
begin
  Result := ((GetViewType(View) and PVT_LISTBOX) <> PVT_LISTBOX );
end;

function TTBXPopupWindow.GetViewClass: TTBViewClass;
begin
  Result := TTBXPopupView;
end;

procedure TTBXPopupWindow.PaintScrollArrows;

  function _GetPopupMargin: Integer;
  begin
    if View.ParentView <> nil then
      Result := GetPopupMargin(TTBViewAccess(View.ParentView).OpenViewer)
    else if View.ViewerCount > 0 then
      Result := GetPopupMargin(View.Viewers[0])
    else Result := -1;
  end;

  procedure DrawMargins;
  var
    I: Integer;
    ItemInfo: TTBXItemInfo;
  begin
    I := _GetPopupMargin;
    if I > 0 then
    begin
      FillChar(ItemInfo, SizeOf(ItemInfo), 0);
      ItemInfo.ViewType := PVT_POPUPMENU;
      ItemInfo.Enabled := True;
      ItemInfo.PopupMargin := I;
      if TTBViewAccess(View).ShowUpArrow then
        for I := 0 to View.ViewerCount- 1 do
          if View.Viewers[I].Show then
          begin
            CurrentTheme.PaintMenuItemFrame(Canvas, Rect(0, 0, ClientWidth,
              View.Viewers[I].BoundsRect.Top), ItemInfo);
            Break;
          end;
      if TTBViewAccess(View).ShowDownArrow then
        for I := View.ViewerCount- 1 downto 0 do
          if View.Viewers[I].Show then
          begin
            CurrentTheme.PaintMenuItemFrame(Canvas, Rect(0,
              View.Viewers[I].BoundsRect.Bottom, ClientWidth,
                ClientHeight), ItemInfo);
            Break;
          end;
    end;
  end;

begin
  with TTBViewAccess(View) do
    if ShowUpArrow or ShowDownArrow then
      DrawMargins;
  inherited;
end;

procedure TTBXPopupWindow.TBMGetViewType(var Message: TMessage);
var
  PI: TTBCustomItem;
begin
  Message.Result := PVT_POPUPMENU;
  if View <> nil then
    if (Self is TTBXChevronPopupWindow) and View.IsToolbar then
      Message.Result := PVT_CHEVRONMENU
    else
    begin
      PI := View.ParentItem;
      if PI <> nil then
      begin
        if (PI.Count = 1) and (PI.Items[0] is TTBXCustomList) and
          not TTBXCustomItem(PI).ToolBoxPopup then
            Message.Result := PVT_LISTBOX
        else if PI is TTBXEditItem then
        begin
          Message.Result := PVT_TOOLBOX;
        end
        else if (PI is TTBXCustomItem) and (TTBXCustomItem(PI).ToolBoxPopup) then
          Message.Result := PVT_TOOLBOX
      end;
    end;
end;

procedure TTBXPopupWindow.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  Canvas: TCanvas;
  R: TRect;
begin
  TBEndAnimation(WindowHandle);
  R := ClientRect;
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := Message.DC;
    CurrentTheme.PaintBackgnd(Canvas, R, R, R, GetFillColor, False, GetViewType(View));
  finally
    Canvas.Free;
  end;
  Message.Result := 1;
end;

procedure TTBXPopupWindow.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  Sz: TPoint;
begin
  CurrentTheme.GetViewBorder(GetViewType(View), Sz);
  with Message.CalcSize_Params^.rgrc[0], Sz do
  begin
    Inc(Left, X);
    Inc(Top, Y);
    Dec(Right, X);
    Dec(Bottom, Y);
  end;
  Message.Result := 1;
end;

procedure TBXPopupNCPaintProc(Wnd: HWND; DC: HDC; AppData: TObject);
var
  R, R2: TRect;
  Canvas: TCanvas;
  View: TTBPopupView;
  PopupInfo: TTBXPopupInfo;
  ParentViewer: TTBItemViewer;
begin
  Assert(DC <> 0, 'TBXPopupNCPaintProc');
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := DC;
    FillChar(PopupInfo, SizeOf(PopupInfo), 0);
    View := TTBPopupView(AppData);
    PopupInfo.WindowHandle := View.Window.Handle;
    PopupInfo.ViewType := GetViewType(View);
    if View.ParentView <> nil then
    begin
      ParentViewer := TTBViewAccess(View.ParentView).OpenViewer;
      if ((ParentViewer is TTBXItemViewer) or (View.Window is TTBXChevronPopupWindow))
        and TTBItemViewerAccess(ParentViewer).IsToolbarStyle then
      begin
        R := ParentViewer.BoundsRect;
        R.TopLeft := View.ParentView.Window.ClientToScreen(R.TopLeft);
        R.BottomRight := View.ParentView.Window.ClientToScreen(R.BottomRight);
        GetWindowRect(Wnd, R2);
        OffsetRect(R, -R2.Left, -R2.Top);
        PopupInfo.ParentRect := R;
      end;
    end
    else if View.ParentItem is TTBXRootItem then
    begin
      R := TTBXRootItem(View.ParentItem).FPopupControlRect;
      if not IsRectEmpty(R) then
      begin
        GetWindowRect(Wnd, R2);
        OffsetRect(R, -R2.Left, -R2.Top);
        PopupInfo.ParentRect := R;
      end;
    end;
    GetWindowRect(Wnd, R);
    OffsetRect(R, -R.Left, -R.Top);
    CurrentTheme.GetViewBorder(PopupInfo.ViewType, PopupInfo.BorderSize);
    R2 := R;
    with PopupInfo.BorderSize do InflateRect(R2, -X, -Y);
    with R2 do ExcludeClipRect(Canvas.Handle, Left, Top, Right, Bottom);
    CurrentTheme.PaintPopupNCArea(Canvas, R, PopupInfo);
  finally
    Canvas.Handle := 0;
    Canvas.Free;
  end;
end;

procedure TTBXPopupWindow.WMNCPaint(var Message: TMessage);
var
  DC: HDC;
begin
  DC := GetWindowDC(Handle);
  try
    Assert(DC <> 0, 'TTBXPopupWindow.WMNCPaint');
    SelectNCUpdateRgn(Handle, DC, HRGN(Message.WParam));
    TBXPopupNCPaintProc(Handle, DC, Self.View);
  finally
    ReleaseDC(Handle, DC);
  end;
end;

procedure TTBXPopupWindow.WMPrint(var Message: TMessage);
begin
  HandleWMPrint(Handle, Message, TBXPopupNCPaintProc, Self.View);
end;

procedure TTBXPopupWindow.WMTB2kPopupShowing(var Message: TMessage);
begin
  if Message.WParam in [TPS_ANIMFINISHED, TPS_NOANIM] then
  begin
    if not (csDestroying in ComponentState) and GetShowShadow and
      (CurrentTheme.GetPopupShadowType in [PST_OFFICEXP, PST_WINDOWS2K]) then CreateShadow;
  end;
end;

procedure TTBXPopupWindow.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
  inherited;
  with Message.WindowPos^ do
    if ((flags and SWP_SHOWWINDOW) = 0) and ((flags and SWP_HIDEWINDOW) = 0) then
    begin
      if FShadows <> nil then
      begin
        DestroyShadow;
        CreateShadow;
      end;
    end;
end;


//============================================================================//

{ TTBXToolbarView }

procedure TTBXToolbarView.GetMargins(AOrientation: TTBViewOrientation; var Margins: TRect);
var
  VT: Integer;
  M: TTBXMargins;
begin
  VT := GetWinViewType(TTBXToolbar(Owner));
  if (VT and VT_TOOLBAR) = VT_TOOLBAR then
  begin
    if AOrientation = tbvoFloating then VT := VT or TVT_FLOATING
    else VT := VT and not TVT_FLOATING
  end
  else if (VT and VT_DOCKPANEL) = VT_DOCKPANEL then
  begin
    if AOrientation = tbvoFloating then VT := VT or DPVT_FLOATING
    else VT := VT and not DPVT_FLOATING
  end;
  CurrentTheme.GetViewMargins(VT, M);
  Margins.Left := M.LeftWidth;
  Margins.Top := M.TopHeight;
  Margins.Right := M.RightWidth;
  Margins.Bottom := M.BottomHeight;
end;


//============================================================================//

{ TTBXChevronPopupSettings }

constructor TTBXChevronPopupSettings.Create;
begin
  FHorzHideSeparators := True;
  FHorzWrapOffset := cpsDefHorzWrapOffset;
  FPopupOrientation := tboVertical;
end;

procedure TTBXChevronPopupSettings.AssignTo(Dest: TPersistent);
begin
  if Dest is TTBXChevronPopupSettings then
    with TTBXChevronPopupSettings(Dest) do
    begin
      FHorzHideSeparators := Self.FHorzHideSeparators;
      FHorzWrapOffset := Self.FHorzWrapOffset;
      FPopupOrientation := Self.FPopupOrientation;
    end
  else
    inherited;
end;

//============================================================================//

{ TTBXToolbar }

procedure TTBXToolbar.CMColorChanged(var Message: TMessage);
begin
  UpdateEffectiveColor;
  if Docked and HandleAllocated then
  begin
    RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or
      RDW_ERASE or RDW_UPDATENOW or RDW_ALLCHILDREN);
  end;
  UpdateChildColors;
  Invalidate;
end;

procedure TTBXToolbar.CMControlChange(var Message: TCMControlChange);
begin
  inherited;
  if Message.Inserting and (Color = clNone) then
    Message.Control.Perform(CM_PARENTCOLORCHANGED, 1, EffectiveColor);
end;

procedure TTBXToolbar.CMParentColorChanged(var Message: TMessage);
begin
  if Embedded and (Color = clNone) then
  begin
    UpdateEffectiveColor;
    if (Message.WParam = 0) then
    begin
      Message.WParam := 1;
      Message.LParam := EffectiveColor;
    end;
  end;
  inherited;
  Invalidate;
end;

constructor TTBXToolbar.Create(AOwner: TComponent);
begin
  inherited;
  AddThemeNotification(Self);
  FChevronPopupSettings := TTBXChevronPopupSettings.Create;
  FEffectiveColor := Color;
  Color := clNone;
  ControlStyle := ControlStyle - [csOpaque];
  DblClickUndock := False;
end;

destructor TTBXToolbar.Destroy;
begin
  RemoveThemeNotification(Self);
  FChevronPopupSettings.Free;
  inherited;
end;

procedure TTBXToolbar.DrawNCArea(const DrawToDC: Boolean; const ADC: HDC;
  const Clip: HRGN);
var
  ToolbarInfo: TTBXToolbarInfo;
begin
  if Docked and HandleAllocated then
  begin
    GetToolbarInfo(ToolbarInfo);
    DockableWindowDrawNCArea(DrawToDC, ADC, Clip, Self, EffectiveColor, ToolbarInfo);
  end;
end;

function TTBXToolbar.Embedded: Boolean;
begin
  Result := not (Floating or Docked);
end;

function TTBXToolbar.GetChevronItemClass: TTBChevronItemClass;
begin
  Result := TTBXChevronItem;
end;

function TTBXToolbar.GetFloatingBorderSize: TPoint;
begin
  CurrentTheme.GetViewBorder(GetViewType(View) or TVT_FLOATING, Result);
end;

function TTBXToolbar.GetFloatingWindowParentClass: TTBFloatingWindowParentClass;
begin
  Result := TTBXFloatingWindowParent;
end;

procedure TTBXToolbar.GetToolbarInfo(out ToolbarInfo: TTBXToolbarInfo);
begin
  FillChar(ToolbarInfo, SizeOf(ToolbarInfo), 0);
  ToolbarInfo.WindowHandle := Handle;
  ToolbarInfo.ViewType := GetWinViewType(Self);
  if CurrentDock <> nil then
    ToolbarInfo.IsVertical := CurrentDock.Position in [dpLeft,dpRight];
  ToolbarInfo.AllowDrag := CurrentDock.AllowDrag;
  ToolbarInfo.DragHandleStyle := Ord(DragHandleStyle);
  ToolbarInfo.ClientWidth := ClientWidth;
  ToolbarInfo.ClientHeight := ClientHeight;
  if ToolbarInfo.AllowDrag and CloseButtonWhenDocked then
  begin
    ToolbarInfo.CloseButtonState := CDBS_VISIBLE;
    if CloseButtonDown then ToolbarInfo.CloseButtonState := ToolbarInfo.CloseButtonState or CDBS_PRESSED
    else if CloseButtonHover then ToolbarInfo.CloseButtonState := ToolbarInfo.CloseButtonState or CDBS_HOT;
  end;
  ToolbarInfo.BorderStyle := BorderStyle;
  CurrentTheme.GetViewBorder(ToolbarInfo.ViewType, ToolbarInfo.BorderSize);
  ToolbarInfo.EffectiveColor := EffectiveColor;
end;

function TTBXToolbar.GetViewClass: TTBToolbarViewClass;
begin
  Result := TTBXToolbarView;
end;

procedure TTBXToolbar.SetChevronPopupSettings(Value: TTBXChevronPopupSettings);
begin
  FChevronPopupSettings.Assign(Value);
end;

procedure TTBXToolbar.SetItemTransparency(const Value: TTBXItemTransparency);
begin
  FItemTransparency := Value;
  Invalidate;
end;

procedure TTBXToolbar.Loaded;
begin
  inherited;
  UpdateEffectiveColor;
end;

procedure TTBXToolbar.RedrawAll;
var
  I: Integer;
  V: TTBItemViewer;
begin
  if HandleAllocated then
  begin
    for I := 0 to View.ViewerCount- 1 do
      View.Invalidate(View.Viewers[I]);
    UpdateWindow(Handle);
    InvalidateRect(Handle, nil, True);
    for I := 0 to View.ViewerCount- 1 do
    begin
      V := View.Viewers[I];
      if V.Show and not IsRectEmpty(V.BoundsRect) and
        not (V.Item is TTBControlItem) and not (tbisInvalidated in V.State) then
          ValidateRect(Handle, @V.BoundsRect);
    end;
  end;
end;

procedure TTBXToolbar.SetParent(AParent: TWinControl);
begin
  inherited;
  if AParent is TTBXFloatingWindowParent then
    TTBXFloatingWindowParent(AParent).SnapDistance := SnapDistance;
end;

procedure TTBXToolbar.SetSnapDistance(Value: Integer);
begin
  if Value < 0 then Value := 0;
  FSnapDistance := Value;
  if (Parent <> nil) and (Parent is TTBXFloatingWindowParent) then
    TTBXFloatingWindowParent(Parent).SnapDistance := Value;
end;

procedure TTBXToolbar.TBMGetEffectiveColor(var Message: TMessage);
begin
  Message.WParam := EffectiveColor;
  Message.Result := 1;
end;

procedure TTBXToolbar.TBMGetViewType(var Message: TMessage);
begin
  if MenuBar then Message.Result := TVT_MENUBAR
  else Message.Result := TVT_NORMALTOOLBAR;
  if Floating then Message.Result := Message.Result or TVT_FLOATING;
  if Resizable then Message.Result := Message.Result or TVT_RESIZABLE;
  case ItemTransparency of
    itAuto:
      if not (Floating or Docked) then Message.Result := Message.Result or TVT_EMBEDDED;
    itDisable:
      Message.Result := Message.Result or TVT_EMBEDDED;
  end;
end;

procedure TTBXToolbar.TBMThemeChange(var Message: TMessage);
begin
  case Message.WParam of
    TSC_BEFOREVIEWCHANGE: BeginUpdate;
    TSC_AFTERVIEWCHANGE:
      begin
        EndUpdate;
        UpdateEffectiveColor;
        if Floating then UpdateNCArea(TTBXFloatingWindowParent(Parent), GetWinViewType(Self))
        else UpdateNCArea(Self, GetWinViewType(Self));
        Invalidate;
        Arrange;
        UpdateChildColors;
      end;
    TSC_APPACTIVATE, TSC_APPDEACTIVATE:
      if MenuBar then Invalidate;
  end;
end;

procedure TTBXToolbar.UpdateChildColors;
var
  M: TMessage;
begin
  M.Msg := CM_PARENTCOLORCHANGED;
  M.WParam := 1;
  M.LParam := EffectiveColor;
  M.Result := 0;
  Broadcast(M);
end;

procedure TTBXToolbar.UpdateEffectiveColor;
begin
  if Color = clNone then
  begin
    if Embedded and (Parent <> nil) then
      FEffectiveColor := GetEffectiveColor(Parent)
    else
      FEffectiveColor := CurrentTheme.GetViewColor(GetViewType(View));
  end
  else FEffectiveColor := Color;
end;

procedure TTBXToolbar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  DockableWindowDrawBackground(Message.DC, Self, Embedded, EffectiveColor);
  Message.Result := 1;
end;

procedure TTBXToolbar.WMSize(var Message: TWMSize);
begin
  inherited;
  if Docked and TDockAccess(CurrentDock).UsingBackground and
    TDockAccess(CurrentDock).BackgroundOnToolbars and not (csLoading in ComponentState) and
    ((CurrentDock is TTBXDock) and not TTBXDock(CurrentDock).FResizing) then
  begin
    Self.RedrawAll;
  end;
end;

//============================================================================//

{ TTBXChevronItem }

function TTBXChevronItem.GetChevronPopupPosition(
  var PopupPositionRec: TTBPopupPositionRec): Boolean;
begin
  Result := Toolbar is TTBXToolbar;
  if Result then
    with TTBXToolbar(Toolbar).FChevronPopupSettings do
    begin
      PopupPositionRec.HorzHideSeparators := FHorzHideSeparators;
      PopupPositionRec.HorzWrapOffset := FHorzWrapOffset;
      PopupPositionRec.PopupOrientation := FPopupOrientation;
    end;
end;

function TTBXChevronItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass;
begin
  Result := TTBXChevronItemViewer;
end;

procedure TTBXChevronItem.GetPopupPosition(ParentView: TTBView;
  PopupWindow: TTBPopupWindow; var PopupPositionRec: TTBPopupPositionRec);
begin
  if CurrentTheme.OfficeXPPopupAlignment then with PopupPositionRec do
  begin
    GetOfficeXPPopupPosition1(PopupPositionRec);
    inherited GetPopupPosition(ParentView, PopupWindow, PopupPositionRec);
    GetOfficeXPPopupPosition2(PopupPositionRec);
  end
  else inherited;
end;

function TTBXChevronItem.GetPopupWindowClass: TTBPopupWindowClass;
begin
  Result := TTBXChevronPopupWindow;
end;


//============================================================================//

{ TTBXChevronItemViewer }

procedure TTBXChevronItemViewer.Paint(const Canvas: TCanvas;
  const ClientAreaRect: TRect; IsHoverItem, IsPushed, UseDisabledShadow: Boolean);
const
  CDesigning: array [Boolean] of Integer = (0, IO_DESIGNING);
var
  ItemInfo: TTBXItemInfo;
begin
  FillChar(ItemInfo, SizeOf(TTBXItemInfo), 0);
  ItemInfo.ViewType := GetViewType(View);
  ItemInfo.ItemOptions := IO_TOOLBARSTYLE or CDesigning[csDesigning in Item.ComponentState];
  ItemInfo.Enabled := Item.Enabled or View.Customizing;
  ItemInfo.Pushed := IsPushed;
  ItemInfo.Selected := False;
  ItemInfo.ImageShown := False;
  ItemInfo.ImageWidth := 0;
  ItemInfo.ImageHeight := 0;
  ItemInfo.IsPopupParent := IsPushed;
  if IsHoverItem then
  begin
    if not ItemInfo.Enabled and not TTBViewAccess(View).MouseOverSelected then ItemInfo.HoverKind := hkKeyboardHover
    else if ItemInfo.Enabled then ItemInfo.HoverKind := hkMouseHover;
  end
  else ItemInfo.HoverKind := hkNone;
  ItemInfo.IsVertical := View.Orientation = tbvoVertical;
  CurrentTheme.PaintChevron(Canvas, ClientAreaRect, ItemInfo);
end;


//============================================================================//

{ TTBXRootItem }

function TTBXRootItem.CreatePopupEx(SelectFirstItem: Boolean;
  const AControlRect: TRect; Alignment: TTBPopupAlignment): TTBPopupWindow;
var
  SavePopupRect: TRect;
  Pt: TPoint;
begin
  SavePopupRect := FPopupControlRect;
  try
    FPopupControlRect := AControlRect;
    Pt.X := AControlRect.Left;
    Pt.Y := AControlRect.Bottom;
    Result := inherited CreatePopup(nil, nil, False, SelectFirstItem, False, Pt, Alignment);
    if Result is TTBXPopupWindow then TTBXPopupWindow(Result).FControlRect := FPopupControlRect;
  finally
    FPopupControlRect := SavePopupRect;
  end;
end;

procedure TTBXRootItem.GetPopupPosition(ParentView: TTBView;
  PopupWindow: TTBPopupWindow; var PopupPositionRec: TTBPopupPositionRec);
var
  Y2: Integer;
  VT: Integer;
begin
  if IsRectEmpty(FPopupControlRect) then inherited
  else with PopupPositionRec do
  begin
    ParentItemRect := FPopupControlRect;
    if Y + H > MonitorRect.Bottom then
    begin
      Y2 := FPopupControlRect.Top - H;
      if Y2 >= MonitorRect.Top then Y := Y2;
    end;
    if Y < MonitorRect.Top then Y := MonitorRect.Top
    else if Y + H > MonitorRect.Bottom then Y := MonitorRect.Bottom - H;

    if Alignment = tbpaRight then X := FPopupControlRect.Right - W;

    if X + W > MonitorRect.Right then X := MonitorRect.Right - W;
    if X < MonitorRect.Left then X := MonitorRect.Left;
  end;
  if CurrentTheme.OfficeXPPopupAlignment then with PopupPositionRec do
  begin
    GetOfficeXPPopupPosition1(PopupPositionRec);
    inherited GetPopupPosition(ParentView, PopupWindow, PopupPositionRec);
    GetOfficeXPPopupPosition2(PopupPositionRec);
    VT := GetWinViewType(PopupWindow);
    PopupPositionRec.PlaySound := not (VT and PVT_LISTBOX = PVT_LISTBOX);
  end
  else inherited;
end;

function TTBXRootItem.GetPopupWindowClass: TTBPopupWindowClass;
begin
  Result := TTBXPopupWindow;
end;

function TTBXRootItem.OpenPopupEx(const SelectFirstItem, TrackRightButton: Boolean;
  const ControlRect: TRect; const Alignment: TTBPopupAlignment;
  const ReturnClickedItemOnly: Boolean): TTBCustomItem;
var
  ModalHandler: TTBModalHandler;
  Popup: TTBPopupWindow;
  DoneActionData: TTBDoneActionData;
  State: TTBViewState;
begin
  ModalHandler := TTBModalHandler.Create(0);
  try
    Popup := CreatePopupEx(SelectFirstItem, ControlRect, Alignment);
    try
      State := Popup.View.State;
      Include(State, vsIgnoreFirstMouseUp);
      TTBViewAccess(Popup.View).SetState(State);
      ModalHandler.RootPopup := Popup;
      ModalHandler.Loop(Popup.View, False, False, False, TrackRightButton);
      DoneActionData := TTBViewAccess(Popup.View).DoneActionData;
    finally
      ModalHandler.RootPopup := nil;
      { Remove vsModal state from the root view before any TTBView.Destroy
        methods get called, so that NotifyFocusEvent becomes a no-op }
      State := Popup.View.State;
      Exclude(State, vsModal);
      TTBViewAccess(Popup.View).SetState(State);
      Popup.Free;
    end;
  finally
    ModalHandler.Free;
  end;
  Result := ProcessDoneAction(DoneActionData, ReturnClickedItemOnly);
end;

function TTBXRootItem.PopupEx(const ControlRect: TRect;
  TrackRightButton: Boolean; Alignment: TTBPopupAlignment = tbpaLeft;
  ReturnClickedItemOnly: Boolean = False): TTBCustomItem;
begin
  Result := OpenPopupEx(False, TrackRightButton, ControlRect,
    Alignment, ReturnClickedItemOnly);
end;


//============================================================================//

{ TTBXPopupMenu }

function TTBXPopupMenu.GetRootItemClass: TTBRootItemClass;
begin
  Result := TTBXRootItem;
end;

function TTBXPopupMenu.PopupEx(const ControlRect: TRect;
  ReturnClickedItemOnly: Boolean = False): TTBCustomItem;
begin
  {$IFDEF JR_D9}
  SetPopupPoint(Point(ControlRect.Left, ControlRect.Bottom));
  {$ELSE}
    {$IFDEF JR_D5}
    PPoint(@PopupPoint)^ := Point(ControlRect.Left, ControlRect.Bottom);
    {$ENDIF}
  {$ENDIF}
  Result := TTBXRootItem(Items).PopupEx(ControlRect, TrackButton = tbRightButton,
    TTBPopupAlignment(Alignment), ReturnClickedItemOnly);
end;

procedure TTBXPopupMenu.TBMGetViewType(var Message: TMessage);
begin
  Message.Result := PVT_POPUPMENU;
end;


//============================================================================//

{ TTBXFloatingWindowParent }

procedure TTBXFloatingWindowParent.AlignControls(AControl: TControl;
  var Rect: TRect);
var
  I: Integer;
begin
  if Assigned(DockableWindow) and (DockableWindow is TTBToolWindow) then
  begin
    { force controls redrawing on toolwindow }
    for I := 0 to ControlCount - 1 do
      with Controls[I] do
        if Visible then Update;
    RedrawWindow(Handle, @Rect, 0, RDW_ERASE or RDW_INVALIDATE); { background }
  end;
end;

procedure TTBXFloatingWindowParent.CancelNCHover;
begin
  if FCloseButtonHover then
  begin
    FCloseButtonHover := False;
    if HandleAllocated and IsWindowVisible(Handle) then
      DrawNCArea(False, 0, 0, [twrdCloseButton]);
  end;
end;

procedure TTBXFloatingWindowParent.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  CancelNCHover;
end;

procedure TTBXFloatingWindowParent.DrawNCArea(const DrawToDC: Boolean;
  const ADC: HDC; const Clip: HRGN; RedrawWhat: TTBToolWindowNCRedrawWhat);
const
  CBord: array [Boolean] of Byte = (0, WRP_BORDER);
  CCapt: array [Boolean] of Byte = (0, WRP_CAPTION);
  CBtn: array [Boolean] of Byte = (0, WRP_CLOSEBTN);
var
  WndDC, DC: HDC;
  BufDCRec: TBufDCRec;
  R, R2: TRect;
  Canvas: TCanvas;
  WindowInfo: TTBXWindowInfo;
  DockWindow: TTBCustomDockableWindowAccess;
begin
  if not HandleAllocated then Exit;

  GetWindowRect(Handle, R);
  WndDC := 0;
  try
    if not DrawToDC then
    begin
      WndDC := GetWindowDC(Handle);
      DC := CreateBufDC(WndDC, R.Right-R.Left, R.Bottom-R.Top, BufDCRec);

      SelectNCUpdateRgn(Handle, WndDC, Clip);
      R2 := ClientRect;
      MapWindowPoints(Handle, 0, R2.TopLeft, 2);
      OffsetRect(R2, -R.Left, -R.Top);
      OffsetRect(R, -R.Left, -R.Top);
      with R2 do
        ExcludeClipRect(WndDC, Left, Top, Right, Bottom);
      with R do
        BitBlt(DC, 0, 0, Right, Bottom, WndDC, 0, 0, SRCCOPY);
    end
    else begin
      DC := ADC;
      OffsetRect(R, -R.Left, -R.Top);
      with R do IntersectClipRect(DC, Left, Top, Right, Bottom);
    end;

    DockWindow := TTBCustomDockableWindowAccess(DockableWindow);

    FillChar(WindowInfo, SizeOf(WindowInfo), 0);
    WindowInfo.ParentHandle := Handle;
    WindowInfo.WindowHandle := DockWindow.Handle;
    WindowInfo.ViewType := GetWinViewType(DockWindow);
    WindowInfo.ClientWidth := ClientWidth;
    WindowInfo.ClientHeight := ClientHeight;
    WindowInfo.ShowCaption := DockWindow.ShowCaption;
    WindowInfo.FloatingBorderSize := DockWindow.GetFloatingBorderSize;
    if DockWindow.CloseButton and DockWindow.ShowCaption then
    begin
      WindowInfo.CloseButtonState := CDBS_VISIBLE;
      if CloseButtonDown then WindowInfo.CloseButtonState := WindowInfo.CloseButtonState or CDBS_PRESSED
      else if CloseButtonHover then WindowInfo.CloseButtonState := WindowInfo.CloseButtonState or CDBS_HOT;
    end;
    WindowInfo.RedrawPart :=
      CBord[twrdBorder in RedrawWhat] or
      CCapt[twrdCaption in RedrawWhat] or
      CBtn[twrdCloseButton in RedrawWhat];
    WindowInfo.Caption := PChar(Caption);
    WindowInfo.EffectiveColor := GetEffectiveColor(DockWindow);
    WindowInfo.Active := not DockWindow.InactiveCaption;

    Canvas := TCanvas.Create;
    try
      Canvas.Handle := DC;
      Canvas.Brush.Color := WindowInfo.EffectiveColor;
      CurrentTheme.PaintFloatingBorder(Canvas, R, WindowInfo);
    finally
      Canvas.Free;
    end;
    if not DrawToDC then
      with R do BitBlt(WndDC, Left, Top, Right, Bottom, DC, 0, 0, SRCCOPY);
  finally
    if not DrawToDC then
    begin
      DeleteBufDC(BufDCRec);
      ReleaseDC(Handle, WndDC);
    end;
  end;
end;

{$IFDEF JR_D10}
procedure TTBXFloatingWindowParent.WMCaptureChanged(var Message: TMessage);
begin
  CancelNCHover;
  inherited;
end;
{$ENDIF}

procedure TTBXFloatingWindowParent.WMEraseBkgnd(var Message: TMessage);
begin
  Message.Result := 1;
end;

procedure TTBXFloatingWindowParent.WMNCMouseLeave(var Message: TMessage);
begin
  if not MouseCapture then CancelNCHover;
  inherited;
end;

procedure TTBXFloatingWindowParent.WMNCMouseMove(var Message: TWMNCMouseMove);
var
  InArea: Boolean;
begin
  inherited;
  { Note: TME_NONCLIENT was introduced in Windows 98 and 2000 }
  if (Win32MajorVersion >= 5) or
     (Win32MajorVersion = 4) and (Win32MinorVersion >= 10) then
    CallTrackMouseEvent (Handle, TME_LEAVE or $10 {TME_NONCLIENT});
  InArea := Message.HitTest = 2001; {HT_TB2k_Close}
  if FCloseButtonHover <> InArea then
  begin
    FCloseButtonHover := InArea;
    if HandleAllocated and IsWindowVisible(Handle) then
      DrawNCArea(False, 0, 0, [twrdCloseButton]);
  end;
end;

procedure TTBXFloatingWindowParent.WMWindowPosChanging(var Message: TWMWindowPosChanging);
var
  R: TRect;
  MonInfo: TMonitorInfo;
begin
  if SnapDistance > 0 then with Message.WindowPos^ do
  begin
    if (cx = Width) and (cy = Height) then
    begin
      MonInfo.cbSize := SizeOf(MonInfo);
      GetMonitorInfo(Monitor.Handle, @MonInfo);
      R := MonInfo.rcWork;
      if Abs(x + Width - R.Right) < SnapDistance then x := R.Right - Width;
      if Abs(y + Height - R.Bottom) < SnapDistance then y := R.Bottom - Height;
      if Abs(x - R.Left) < SnapDistance then x := R.Left;
      if Abs(y - R.Top) < SnapDistance then y := R.Top;
    end;
  end;
  inherited;
end;


//============================================================================//

{ TTBXToolWindow }

procedure TTBXToolWindow.CMColorChanged(var Message: TMessage);
begin
  UpdateEffectiveColor;
  if Docked and HandleAllocated then
    RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or
      RDW_ERASE or RDW_UPDATENOW or RDW_ALLCHILDREN);
  UpdateChildColors;
  Invalidate;
end;

procedure TTBXToolWindow.CMControlChange(var Message: TCMControlChange);
begin
  inherited;
  if Message.Inserting and (Color = clNone) then
    Message.Control.Perform(CM_PARENTCOLORCHANGED, 1, EffectiveColor);
end;

procedure TTBXToolWindow.CMTextChanged(var Message: TMessage);
begin
  inherited;
  if HandleAllocated then
  begin
    if Docked then RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE)
    else RedrawWindow(TTBXFloatingWindowParent(Parent).Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE);
  end;
end;

constructor TTBXToolWindow.Create(AOwner: TComponent);
begin
  inherited;
  AddThemeNotification(Self);
  DblClickUndock := False;
  FEffectiveColor := Color;
  Color := clNone;
end;

destructor TTBXToolWindow.Destroy;
begin
  RemoveThemeNotification(Self);
  inherited;
end;

procedure TTBXToolWindow.DrawNCArea(const DrawToDC: Boolean; const ADC: HDC;
  const Clip: HRGN);
var
  ToolbarInfo: TTBXToolbarInfo;
begin
  if Docked and HandleAllocated then
  begin
    GetToolbarInfo(ToolbarInfo);
    DockableWindowDrawNCArea(DrawToDC, ADC, Clip, Self, EffectiveColor, ToolbarInfo);
  end;
end;

function TTBXToolWindow.GetFloatingBorderSize: TPoint;
begin
  CurrentTheme.GetViewBorder(GetWinViewType(Self) or TVT_FLOATING, Result);
end;

function TTBXToolWindow.GetFloatingWindowParentClass: TTBFloatingWindowParentClass;
begin
  Result := TTBXFloatingWindowParent;
end;

procedure TTBXToolWindow.GetToolbarInfo(out ToolbarInfo: TTBXToolbarInfo);
begin
  FillChar(ToolbarInfo, SizeOf(ToolbarInfo), 0);
  ToolbarInfo.WindowHandle := WindowHandle;
  ToolbarInfo.ViewType := GetWinViewType(Self);
  if CurrentDock <> nil then
    ToolbarInfo.IsVertical := CurrentDock.Position in [dpLeft,dpRight];
  ToolbarInfo.AllowDrag := CurrentDock.AllowDrag;
  ToolbarInfo.DragHandleStyle := Ord(DragHandleStyle);
  ToolbarInfo.ClientWidth := ClientWidth;
  ToolbarInfo.ClientHeight := ClientHeight;
  if ToolbarInfo.AllowDrag and CloseButtonWhenDocked then
  begin
    ToolbarInfo.CloseButtonState := CDBS_VISIBLE;
    if CloseButtonDown then ToolbarInfo.CloseButtonState := ToolbarInfo.CloseButtonState or CDBS_PRESSED;
    if CloseButtonHover then ToolbarInfo.CloseButtonState := ToolbarInfo.CloseButtonState or CDBS_HOT;
  end;
  ToolbarInfo.BorderStyle := BorderStyle;
  ToolbarInfo.EffectiveColor := EffectiveColor;
  CurrentTheme.GetViewBorder(ToolbarInfo.ViewType, ToolbarInfo.BorderSize);
end;

procedure TTBXToolWindow.SetParent(AParent: TWinControl);
begin
  inherited;
  if AParent is TTBXFloatingWindowParent then
    TTBXFloatingWindowParent(AParent).SnapDistance := SnapDistance;
end;

procedure TTBXToolWindow.SetSnapDistance(Value: Integer);
begin
  if Value < 0 then Value := 0;
  FSnapDistance := Value;
  if (Parent <> nil) and (Parent is TTBXFloatingWindowParent) then
    TTBXFloatingWindowParent(Parent).SnapDistance := Value;
end;

procedure TTBXToolWindow.TBMGetEffectiveColor(var Message: TMessage);
begin
  Message.WParam := EffectiveColor;
  Message.Result := 1;
end;

procedure TTBXToolWindow.TBMGetViewType(var Message: TMessage);
begin
  Message.Result := TVT_TOOLWINDOW;
  if Floating then Message.Result := Message.Result or TVT_FLOATING;
  if Resizable then Message.Result := Message.Result or TVT_RESIZABLE;
end;

procedure TTBXToolWindow.TBMThemeChange(var Message: TMessage);
begin
  case Message.WParam of
    TSC_BEFOREVIEWCHANGE: BeginUpdate;
    TSC_AFTERVIEWCHANGE:
      begin
        EndUpdate;
        UpdateEffectiveColor;
        if HandleAllocated and not (csDestroying in ComponentState) then
          if Parent is TTBXFloatingWindowParent then
            UpdateNCArea(TTBXFloatingWindowParent(Parent), GetWinViewType(Self))
          else
            UpdateNCArea(Self, GetWinViewType(Self));
        UpdateChildColors;
        Invalidate;
      end;
  end;
end;

procedure TTBXToolWindow.UpdateChildColors;
var
  M: TMessage;
begin
  M.Msg := CM_PARENTCOLORCHANGED;
  M.WParam := 1;
  M.LParam := EffectiveColor;
  M.Result := 0;
  Broadcast(M);
end;

procedure TTBXToolWindow.UpdateEffectiveColor;
begin
  if Color = clNone then FEffectiveColor := CurrentTheme.GetViewColor(GetWinViewType(Self))
  else FEffectiveColor := Color;
end;

procedure TTBXToolWindow.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  DockableWindowDrawBackground(Message.DC, Self, False, EffectiveColor);
  Message.Result := 1;
end;

//============================================================================//

{ Additional system colors }

type
  TColorEntry = packed record
    ColorPtr: ^TColor;
    Name: string;
  end;

var
  ColorRegistry: array of TColorEntry;

procedure AddTBXColor(var AColor: TColor; const AName: string);
var
  L: Integer;
begin
  L := Length(ColorRegistry);
  SetLength(ColorRegistry, L + 1);
  with ColorRegistry[L] do
  begin
    ColorPtr := @AColor;
    Name := AName;
  end;
end;

function TBXColorToString(Color: TColor): string;
var
  I: Integer;
begin
  if not ColorToIdent(Color, Result) then
  begin
    for I := 0 to Length(ColorRegistry) - 1 do
      if ColorRegistry[I].ColorPtr^ = Color then
      begin
        Result := ColorRegistry[I].Name;
        Exit;
      end;
    FmtStr(Result, '%s%.8x', [HexDisplayPrefix, Color]);
  end;
end;

function TBXIdentToColor(const Ident: string; var Color: Longint): Boolean;
var
  I: Integer;
begin
  for I := 0 to Length(ColorRegistry) - 1 do
    if CompareText(ColorRegistry[I].Name, Ident) = 0 then
    begin
      Color := ColorRegistry[I].ColorPtr^;
      Result := True;
      Exit;
    end;
  Result := IdentToColor(Ident, Color);
end;

function TBXStringToColor(S: string): TColor;
begin
  if not TBXIdentToColor(S, Longint(Result)) then Result := StringToColor(S);
end;

procedure TBXGetColorValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  GetColorValues(Proc);
  for I := 0 to Length(ColorRegistry) - 1 do Proc(ColorRegistry[I].Name);
end;

procedure TBXSetTheme(const AThemeName: string);
begin
  TBXNexus.SetTheme(AThemeName);
end;

function TBXCurrentTheme: string;
begin
  Result := TBXNexus.GetTheme;
end;


//============================================================================//


{ TTBXNexus }

procedure TTBXNexus.AddNotifie(AObject: TObject);
begin
  if FNotifies.IndexOf(AObject) < 0 then FNotifies.Add(AObject);
end;

procedure TTBXNexus.Broadcast(Msg: Cardinal; Param1, Param2: Integer);
var
  M: TMessage;
  I: Integer;
begin
  if FNotifies.Count > 0 then
  begin
    M.Msg := Msg;
    M.WParam := WPARAM(Param1);
    M.LParam := LPARAM(Param2);
    M.Result := 0;
    for I := 0 to FNotifies.Count - 1 do TObject(FNotifies[I]).Dispatch(M);
  end;
end;

constructor TTBXNexus.Create(const DefaultTheme: string);
begin
  FNotifies := TList.Create;
  CurrentTheme := GetTBXTheme(DefaultTheme);
  AddTBXSysChangeNotification(Self);
end;

destructor TTBXNexus.Destroy;
begin
  RemoveTBXSysChangeNotification(Self);
  ReleaseTBXTheme(CurrentTheme);
  FNotifies.Free;
  inherited;
end;

function TTBXNexus.GetTheme: string;
begin
  Result := CurrentTheme.Name;
end;

procedure TTBXNexus.RemoveNotifie(AObject: TObject);
begin
  FNotifies.Remove(AObject);
end;

procedure TTBXNexus.SetTheme(const AThemeName: string);
begin
  if IsTBXThemeAvailable(AThemeName) then
  begin
    ReleaseTBXTheme(CurrentTheme);
    CurrentTheme := GetTBXTheme(AThemeName);
    Broadcast(TBM_THEMECHANGE, TSC_BEFOREVIEWCHANGE, 1);
    Broadcast(TBM_THEMECHANGE, TSC_VIEWCHANGE, 1);
    Broadcast(TBM_THEMECHANGE, TSC_AFTERVIEWCHANGE, 1);
  end;
end;

procedure TTBXNexus.TBXSysCommand(var Message: TMessage);
begin
  { Retranslate TBX_SYSCOMMAND to TBM_THEMECHANGE }
  if Message.Msg = TBX_SYSCOMMAND then
    Broadcast(TBM_THEMECHANGE, Message.WParam, 0);
end;

procedure InitAdditionalSysColors;
begin
  AddTBXColor(clHotLight, 'clHotLight');
{$IFNDEF JR_D6}
  AddTBXColor(clMoneyGreen, 'clMoneyGreen');
  AddTBXColor(clSkyBlue, 'clSkyBlue');
  AddTBXColor(clCream, 'clCream');
  AddTBXColor(clMedGray, 'clMedGray');
{$ENDIF}
end;

{ TTBXDock }

procedure TTBXDock.CMColorChanged(var Message: TMessage);
var
  I: Integer;
begin
  inherited;
  UpdateEffectiveColor;
  for I := 0 to Self.ControlCount - 1 do
    if Controls[I] is TWinControl then
      InvalidateAll(TWinControl(Controls[I]));
end;

constructor TTBXDock.Create(AOwner: TComponent);
begin
  inherited;
  FEffectiveColor := Color;
  Color := clNone;
  AddThemeNotification(Self);
end;

destructor TTBXDock.Destroy;
begin
  RemoveThemeNotification(Self);
  inherited;
end;

procedure TTBXDock.DrawBackground(DC: HDC; const DrawRect: TRect);
const
  DOCK_POSITIONS: array[TTBDockPosition] of Integer = (DP_TOP, DP_BOTTOM, DP_LEFT, DP_RIGHT);
var
  Canvas: TCanvas;
  R: TRect;
begin
  if UseParentBackground then
    DrawParentBackground(Self, DC, ClientRect)
  else if ThemedBackground then
  begin
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := DC;
      R := Self.BoundsRect;
      { Pass to theme the dock positition through PenPos }
      Canvas.MoveTo(Integer(PointToSmallPoint(R.TopLeft)),
        Integer(PointToSmallPoint(R.BottomRight)));
      CurrentTheme.PaintDock(Canvas, ClientRect, DrawRect, DOCK_POSITIONS[Position]);
    finally
      Canvas.Free;
    end;
  end
  else inherited;
end;

procedure TTBXDock.Resize;
var
  DC: HDC;
  Res, I: Integer;
  ClipR: TRect;
  DW: TTBCustomDockableWindow;
begin
  inherited Resize;
  if UsingBackground and HandleAllocated then
  begin
    DC := GetDC(Handle);
    Res := GetClipBox(DC, ClipR);
    ReleaseDC(Handle, DC);
    if not (Res in [SIMPLEREGION, COMPLEXREGION]) then Exit;
    Invalidate;
    for I := 0 to ToolbarCount- 1 do
    begin
      DW := Toolbars[I];
      { Let's redraw only changed Toolbars/ToolWindows }
      if not RectsIntersect(DW.BoundsRect, ClipR) then
        Continue;
      if DW is TTBXToolbar
        then TTBXToolbar(DW).RedrawAll
        else if DW is TTBXToolWindow then InvalidateAll(DW);
    end;
  end;
end;

procedure TTBXDock.SetUseParentBackground(Value: Boolean);
begin
  if Value <> FUseParentBackground then
  begin
    FUseParentBackground := Value;
    if HandleAllocated then
      RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or
        RDW_ERASE or RDW_ALLCHILDREN);
  end;
end;

procedure TTBXDock.UpdateEffectiveColor;
begin
  if Color <> clNone then FEffectiveColor := Color
  else if Parent <> nil then FEffectiveColor := GetEffectiveColor(Parent)
  else FEffectiveColor := clBtnFace;
end;

procedure TTBXDock.TBMGetEffectiveColor(var Message: TMessage);
begin
  Message.wParam := FEffectiveColor;
  Message.Result := 1;
end;

procedure TTBXDock.TBMThemeChange(var Message: TMessage);
begin
  if Message.wParam = TSC_AFTERVIEWCHANGE then
  begin
    UpdateEffectiveColor;
    if HandleAllocated then Invalidate;
  end;
end;

function TTBXDock.ThemedBackground: Boolean;
begin
  Result := (Background = nil) and (Color = clNone) and CurrentTheme.PaintDockBackground;
end;

function TTBXDock.UsingBackground: Boolean;
begin
  Result := UseParentBackground or (ThemedBackground and not FMoving) or
    inherited UsingBackground;
end;

procedure TTBXDock.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  CR: TRect;
begin
  CR := ClientRect;
  if UsingBackground
    then DrawBackground(Message.DC, CR)
    else FillRectEx(Message.DC, CR, EffectiveColor);
  Message.Result := 1;
end;

procedure TTBXDock.WMMove(var Message: TWMMove);
begin
  FMoving := True;
  inherited;
  { invalidate themed background (for example gradient in the Office2003 theme) }
  if ThemedBackground and HandleAllocated then
    InvalidateRect(Handle, nil, False);
  FMoving := False;
end;

procedure TTBXDock.WMSize(var Message: TWMSize);
begin
  FResizing := True;
  inherited;
  FResizing := False;
end;

{ TTBXMenuAnimation }

constructor TTBXMenuAnimation.Create;
begin
  InitAvailableModes;
  AnimationMode := amSysDefault;
end;

procedure TTBXMenuAnimation.InitAvailableModes;
const
  Win2KMajor = 5;
  Win98Major = 4;
  Win98Minor = 10;
begin
  if (Win32Platform = VER_PLATFORM_WIN32_NT) and
    CheckWin32Version(Win2KMajor) then
      FAvailableModes := [amNone..amFade]
  else if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
    CheckWin32Version(Win98Major, Win98Minor) then
      FAvailableModes := [amNone..amSlide]
  else FAvailableModes := [amNone];
end;

function TTBXMenuAnimation.GetAnimation: TAnimationMode;

  function GetSysDefault: TAnimationMode;
  const
    SPI_GETMENUFADE = $1012;
    SysDefAni: array[Boolean] of TAnimationMode = (amSlide, amFade);
  begin
    if GetSystemParametersInfoBool(SPI_GETMENUANIMATION, False)
      then Result := SysDefAni[GetSystemParametersInfoBool(SPI_GETMENUFADE, False)]
      else Result := amNone;
  end;

  function GetRandom: TAnimationMode;
  var Max: Integer;
  begin
    Max := Ord(amFade)- Integer(not(amFade in FAvailableModes))- Ord(amRandom);
    Result := Succ(TAnimationMode(Random(Max)+ Ord(amRandom)));
  end;

begin
  case FAnimationMode of
    amSysDefault: Result := GetSysDefault;
    amRandom: Result := GetRandom;
  else
    Result := FAnimationMode;
  end;
end;

procedure TTBXMenuAnimation.SetAnimationMode(Value: TAnimationMode);
begin
  Assert(Value in [Low(TAnimationMode)..High(TAnimationMode)],
    'TTBXMenuAnimation.SetAnimationMode');
  while not (Value in FAvailableModes) do
    Value := Pred(Value);
  FAnimationMode := Value;
end;

{ Workaround first delayed menu showing in the Windows 2000+ on slow comps. }

procedure FixFirstPlaySoundDelayThreadProc(Param: Pointer); stdcall;
begin
  SetEvent(THandle(Param));
  PlaySound(nil, 0, 0);
end;

procedure FixFirstPlaySoundDelay;
const
  Win2KMajor = 5;
var
  EventHandle: THandle;
  ThreadHandle: THandle;
  ThreadId: Cardinal;
begin
  { Before the first menu showing, preload dlls related to the sound (in background). }
  if (Win32Platform = VER_PLATFORM_WIN32_NT) and CheckWin32Version(Win2KMajor) then
  begin
    EventHandle := CreateEvent(nil, False, False, nil);
    if EventHandle <> 0 then
    begin
      ThreadHandle := CreateThread(nil, 0, @FixFirstPlaySoundDelayThreadProc,
        Pointer(EventHandle), CREATE_SUSPENDED, ThreadId);
      if ThreadHandle <> 0 then
      begin
        SetThreadPriority(ThreadHandle, THREAD_PRIORITY_LOWEST);
        ResumeThread(ThreadHandle);
        if WaitForSingleObject(EventHandle, 100) <> WAIT_OBJECT_0 then
          TerminateThread(ThreadHandle, 0);
        CloseHandle(ThreadHandle);
      end;
      CloseHandle(EventHandle);
    end;
  end;
end;

initialization
  if not IsLibrary then
    FixFirstPlaySoundDelay;
  RegisterTBXTheme('Default', TTBXDefaultTheme);
  TBXNexus := TTBXNexus.Create('Default');
  TBXMenuAnimation := TTBXMenuAnimation.Create;
  {$IFNDEF JR_D7}
  InitAdditionalSysColors;
  {$ENDIF}

finalization
  FreeAndNil(TBXMenuAnimation);
  FreeAndNil(TBXNexus);
  ColorRegistry := nil;

end.
