unit SpTBXItem; {============================================================================== Version 2.4.4 The contents of this file are subject to the SpTBXLib License; you may not use or distribute this file except in compliance with the SpTBXLib License. A copy of the SpTBXLib License may be found in SpTBXLib-LICENSE.txt or at: http://www.silverpointdevelopment.com/sptbxlib/SpTBXLib-LICENSE.htm Alternatively, the contents of this file may be used under the terms of the Mozilla Public License Version 1.1 (the "MPL v1.1"), in which case the provisions of the MPL v1.1 are applicable instead of those in the SpTBXLib License. A copy of the MPL v1.1 may be found in MPL-LICENSE.txt or at: http://www.mozilla.org/MPL/ If you wish to allow use of your version of this file only under the terms of the MPL v1.1 and not to allow others to use your version of this file under the SpTBXLib License, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the MPL v1.1. If you do not delete the provisions above, a recipient may use your version of this file under either the SpTBXLib License or the MPL v1.1. Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The initial developer of this code is Robert Lee. Requirements: For Delphi/C++Builder 2009 or newer: - Jordan Russell's Toolbar 2000 http://www.jrsoftware.org For Delphi/C++Builder 7-2007: - Jordan Russell's Toolbar 2000 http://www.jrsoftware.org - Troy Wolbrink's TNT Unicode Controls http://www.tntware.com/delphicontrols/unicode/ Wish list for TB2K: - tboSameHeight option for toolbar items, used to stretch the item to the highest possible size. - It would be nice to have a way to get the TTBItemViewer width and height even when the Item is not visible (TTBItemViewer.BoundsRect is not valid when the item is not visible). As a workaround we should use TTBItemViewer.CalcSize method. - It would be nice to allow component writers to override TTBCustomToolbar.CreateWrapper so they can create custom TTBControlItem items descendants as the dropped control wrappers. - It would be nice to have access to the TTBPopupMenu Viewer before the popup is showed to initialize the items, for example to set the focus on a TTBEditItem. Development notes: - All the Windows and Delphi bugs fixes are marked with '[Bugfix]'. - All the theme changes and adjustments are marked with '[Theme-Change]'. - All the compatibility changes are marked with '[Backward-Compatibility]'. - TSpTBXCompoundItemsControl is used as the base class for TB2K items enabled Controls, it uses the ITBItems interface and streams the items to the DFM. - When a control is dropped on the toolbar a TTBControlItem is created by TTBCustomToolbar.CreateWrapper, unfortunately it is created with the Toolbar.Owner instead of the Form (Owner.Owner for TSpTBXCompoundItemsControl like the TSpTBXTabSet or TSpTBXStatusBar). The workaround is to handle the CM_CONTROLCHANGE message in the compound toolbar, stream all the TTBControlItem.Control to the DFM (the TSpTBXCompoundItemsControl must be the parent in the DFM), and finally reset the TTBControlItem.Control parentship to the Toolbar in TSpTBXCompoundItemsControl.Loaded. To Do: - History: 2 December 2009 - version 2.4.4 - Fixed bug in SpSetFormWindowState utility function, the Form was not restored correctly, thanks to Alex Yagolnik for reporting this. - Fixed incorrect TSpTBXPopupWindow items margins, thanks to Pedro Vugluskra for reporting this. 13 September 2009 - version 2.4.3 - Fixed incorrect menu items painting on Vista, thanks to Maël Hörz and Sertac Akyuz for reporting this. - Fixed TSpTBXToolbar flicker when adding/deleting items. - Fixed incorrect TSpTBXStatusBar painting when XP theming was disabled, thanks to Warren Postma for reporting this. - Fixed incorrect TSpTBXDock painting when the Background property was used. - Made the NC area of the TSpTBXTitleBar clickeable when the form is maximized. 8 May 2009 - version 2.4.2 - Added Dutch translation for the Customizer demo, thanks to Alfred Vink. - Added Tooltips Vista theming. 15 March 2009 - version 2.4.1 - Fixed incorrect TntAction checking, thanks to Costas Stergiou for reporting this. 17 January 2009 - version 2.4 - Replaced the default Windows taskbar PopupMenu with a skninned PopupMenu when TSpTBXTitleBar is used on the Main form. - Fixed incorrect menu separator painting when it was used on a ToolBoxPopup submenu, thanks to Yury Plashenkov for reporting this. - Fixed incorrect menu item margins, thanks to Eduardo Mauro for reporting this. 26 September 2008 - version 2.3 - New Toolbar item added, TSpTBXColorItem. - Fixed incorrect Alt-Space handling on TSpTBXTitleBar, the System PopupMenu was still showed even when SystemMenu was setted to False, thanks to Ilya Zaytsev for reporting this. - Fixed incorrect items text sizing when SystemFont was setted to False, thanks to Minoru Yoshida for reporting this. - Fixed a Delphi 7 bug, D7 hints didn't support multi-monitors, thanks to Costas Stergiou for reporting this. 29 July 2008 - version 2.2 - Fixed AV raised when Screen.MonitorFromWindow failed, thanks to Andrew Denton for reporting this. - Added OnClosePopup event to TSpTBXPopupMenu. 26 June 2008 - version 2.1 - Added Turkish translation for the Customizer demo, thanks to Zylar. - Fixed incorrect keyboard handling on TSpTBXTitleBar, Alt+Space didn't popup the system menu, thanks to Costas Stergiou for reporting this. 3 May 2008 - version 2.0 - SpTBXLib is now decoupled from TBX and uses the latest version of TB2K, with NO PATCHES REQUIRED. - Added HideEmptyPopup property to TSpTBXSubmenuItem, when the submenu has no items and this property is set the popup window will not be showed. - Added Swedish translation for the Customizer demo, thanks to Mattias Andersson. 2 April 2008 - version 1.9.5 - Fixed incorrect item stretching when the toolbar was vertical and tboImageAboveCaption was set, thanks to John for reporting this. - Fixed incorrect item painting when no themes were used, thanks to Denis for reporting this. - Fixed incorrect TSpTBXToolPalette.Images handling, thanks to Minoru Yoshida for reporting this. - Fixed incorrect menu gutter painting when hints were showed, thanks to Michele and Beta Xiong for reporting this. - Fixed incorrect floating border painting when the default size was changed thanks to Costas Stergiou and Serge for reporting this. - Fixed incorrect floating border painting on Vista, the borders should not be transparent, thanks to Costas Stergiou for reporting this. 3 February 2008 - version 1.9.4 - No changes. 19 January 2008 - version 1.9.3 - Completed the Brazilian Portuguese translation of the Customizer demo, thanks to Mauricio Magnani. - Added TSpTBXToolWindow component. - Fixed incorrect gutter painting on the popup menus. - Fixed item stretching problems 26 December 2007 - version 1.9.2 - New component added: TSpTBXToolWindow, a fully customizable ToolWindow with unicode support. - Added State parameter to the toolbar items OnDrawCaption event. - Fixed AV on Delphi 2005, Margins and Paddings were introduced on Delphi 2006, thanks to Stefan for reporting this. - Minor bug fixes. 1 December 2007 - version 1.9.1 - Added Invalidate method to TSpTBXItem. - Added OnClosePopup event to TSpTBXSubmenuItem. - Fixed tboNoRotation use on vertical toolbar items, when tboImageAboveCaption is not set the glyph should appear aligned with the caption. 20 November 2007 - version 1.9 - New theme engine. - Added SpTBXHintWindowClass global variable, it specifies which THintWindow class is used to show the hints. - Added TSpTBXToolPalette and TSpTBXColorPalette items. - Added TSpTBXToolWindow component. - Removed TSpTBXComboBoxItem, TSpTBXDropDownItem, TSpTBXStringList and TSpTBXUndoList. 8 February 2007 - version 1.8.3 - No changes. 17 December 2006 - version 1.8.2 - Added Toolbar public property to TSpTBXStatusBar. 24 November 2006 - version 1.8.1 - Added properties to TSpTBXRightAlignSpacer: ImageIndex, Images, OnAdjustFont, OnClick, OnDrawHint, OnDrawImage, OnDrawItem. - Added unicode shortcut-text support for menu items, thanks Steve for reporting this. - Fixed incorrect TSpTBXTitleBar positioning when the taskbar is moved around the screen, thanks to Costas Stergiou for reporting this. - Fixed incorrect TSpTBXStatusBar size grip painting when Windows XP themes are disabled, thanks to Alexey Naumov for reporting this. 27 August 2006 - version 1.8 - Fixed incorrect DropdownCombo item painting, thanks to François Rivierre for reporting this. - Fixed incorrect TSpTBXTitleBar SystemMenu painting, GetMenuStringW doesn't work correctly on Win2K/WinXP, when a DBCS code page is active (e.g. Japanese), thanks to Jordan Russell for reporting this. http://news.jrsoftware.org/read/article.php?id=12268&group=jrsoftware.toolbar2000.thirdparty - Fixed bug in TSpTBXLabelItem, clicking a TSpTBXLabelItem on a popup menu causes the menu to close, thanks to Piotr Janus for reporting this. 15 June 2006 - version 1.7 - Added vertical caption painting to toolbar items. - Added CaptionGlow and CaptionGlowColor properties to toolbar Items. - Added Margins property to toolbar items. - Fixed incorrect TSpTBXTitleBar resizing when the form is maximized and the titlebar is activated and deactivated multiple times, thanks to Costas Stergiou for reporting this. 4 May 2006 - version 1.6 - Fixed incorrect TSpTBXStatusBar behavior, the size grip disappeared when the parent was a TSpTBXTitleBar, thanks to Costas Stergiou for reporting this. - Fixed incorrect TSpTBXStatusBar's size grip painting when the Default theme was used. - Fixed incorrect TSpTBXLabelItem painting when the label was used in a submenu, thanks to Costas Stergiou for reporting this. - Added OnSystemMenuPopup event to TSpTBXTitleBar. 12 April 2006 - version 1.5 - Fixed incorrect TSpTBXStatusBar behavior, it didn't resized the form if the mouse click was on the non-client area of the status bar, thanks to Frank de Groot for reporting this. - Fixed incorrect mouse handling in TSpTBXTitlebar, thanks to Marten Pape for reporting this. - Fixed incorrect TSpTBXLabelItem alignment on menus, thanks to Costas Stergiou for reporting this. - Added ClickedItem parameter to TSpTBXSubmenuItem.OnClosePopup event. 27 February 2006 - version 1.4 - Added SizeGrip property to TSpTBXStatusBar. - Added FullScreenMaximize property to TSpTBXTitleBar. 10 February 2006 - version 1.3 - Fixed AV in TSpTBXTitleBar at designtime, thanks to Alexey Naumov for reporting this. - Fixed incorrect system popupmenu visibility in TSpTBXTitleBar. - Added Active property to TSpTBXTitleBar. - Added OnDrawBackground event to TSpTBXTitleBar. - Added OnClosePopup event to TSpTBXSubmenuItem. 28 December 2005 - version 1.2 - Fixed incorrect items anchoring. - Fixed range check errrors. 18 October 2005 - version 1.1 - Fixed incorrect TSpTBXStatusBar margins when the form is maximazed. - Fixed incorrect accel char handling in TSpTBXToolbar. - Fixed incorrect TntAction support, the previous version of TntActions didn't supported unicode enabled ActionLinks. - Fixed incorrect tab stop chars handling in TSpTBXItem. - Added MaxSize property to TSpTBXToolbar, determines the maximum height the toolbar can have. - Added TBX themes support to TSpTBXTitleBar's system menu. - Added radio item painting support. 18 August 2005 - version 1.0 - Added DisplayOptions property to TSpTBXToolbar, determines whether the item's image is to be displayed. - Added Customizable property to TSpTBXToolbar, determines whether the toolbar is customizable or not. - Added TitleBarSize property to the Options of the TSpTBXTitlebar. 10 June 2005 - version 0.9 - SpTBXLib may now alternatively, at your option, be used and/or distributed under the terms of the SpTBXLib License. Please see the updated LICENSE.TXT file for more information. 20 May 2005 - version 0.8 - Fixed incorrect caption centering in TSpTBXItem. - Fixed incorrect TSpTBXItem hint when accessing TntApplication, thanks to Erik Maly for reporting this. - Changed the Options property of TSpTBXTitleBar to use a base class for default buttons. - Added ChevronVertical property to TSpTBXToolbar, it changes the layout of the chevron popup to be vertical. - Added Wrapping property to TSpTBXItem, it determines the wrapping type of the item's caption. - Added FixedSize property to TSpTBXTitleBar, it determines if the TitleBar can be resized. 16 February 2005 - version 0.7 - Fixed TSpTBXThemeGroupItem theme sync bug, it now correctly selects the current TBX theme. - Fixed unicode support in W9x. - Fixed TSpTBXTitleBar painting flicker. - Fixed TSpTBXStatusBar right align margin. - Added TBXStyleBackground property to TSpTBXTitleBar, when setted to true it paints a TBX style background. - Added AutoCheck property to TSpTBXItem. 23 December 2004 - version 0.6 - Fixed hint bug, ampersands were not removed in auto-generated hints. - Fixed incorrect caption painting when the font is italic, this bug is present in TBX items, TLabel, TBitBtn, TSpeedButton, TGroupBox, TRadioGroup, and any other control that uses DrawText to draw the caption. To reproduce this, drop a TBitBtn, change the caption to 'WWW' and the font to italic, the last W is cropped. - Fixed incorrect caption painting when the Default theme is used, the caption was not painted in a down state when the toolbarstyle item was pushed, thanks Daniel Rikowski for reporting this. - Changed the default value of DisplayMode to nbdmDefault. - New component added, TSpTBXTitleBar: a fully customizable TitleBar with Unicode text and TBX themes support. - New component added, TSpTBXPopupMenu: a TTBXPopupMenu descendant with an OnPopupMenuInit event to setup the items before the popup is showed, it could be used for example to set the focus to an EditItem. - Added SpChangeThemeType utility function, this makes it easier to switch the theme type of any given control and its children. 30 August 2004 - version 0.5 - Reworked the hint show event of the items. 21 July 2004 - version 0.4 - Fixed TTBControlItem.Control streaming bug on TSpTBXStatusBar. - Fixed bad sync of the items unicode caption and hint properties when an Action was assigned. 12 July 2004 - version 0.3.1 - Unchanged. 9 July 2004 - version 0.3 - Fixed incorrect TSpTBXItem caption painting when DisplayMode was nbdmDefault, thanks to Cyril for reporting this. - Added anchors support for TTBControlItem items, if the associated Control is client aligned or has akRight in its Anchors property. - The theme items in TSpTBXThemeGroupItem are now sorted. - Added OnUpdate event to TSpTBXThemeGroupItem, this event is fired every time the theme items list is recreated, use this event to sort or change the items properties. 27 June 2004 - version 0.2 - Fixed Toolbar custom painting event. - Fixed incorrect Shortcut painting in submenus. - Fixed incorrect Shortcut hint painting. - Removed thtBitmapSkin from TSpTBXThemeType. - Published more properties for TSpTBXLabelItem. - New Toolbar item added, TSpTBXSeparator. - New component added, TSpTBXStatusBar: a fully customizable StatusBar with Unicode text and TBX themes support. 22 June 2004 - version 0.1 - Initial release. ==============================================================================} interface {$BOOLEVAL OFF} // Unit depends on short-circuit boolean evaluation {$I TB2Ver.inc} uses Windows, Messages, Classes, SysUtils, Forms, Controls, Graphics, ImgList, Menus, StdCtrls, ActnList, {$IFNDEF UNICODE} TntClasses, TntControls, {$ENDIF} TB2Item, TB2Dock, TB2Toolbar, TB2ToolWindow, SpTBXSkins; {$IFDEF UNICODE} type TTntStringList = TStringList; {$ENDIF} const C_SpTBXRadioGroupIndex = 8888; // Default GroupItem of TSpTBXRadioGroupItem CM_SPPOPUPCLOSE = CM_BASE + 1111; // Message sent to the PopupControl to update its state after the Popup is closed rvSpTBXDisplayMode = 'DisplayMode'; // Constant used to save the Toolbar DisplayMode with the Customizer. Do not localize! CPDefaultCols = 8; // ColorPalette constant CPDefaultRows = 5; // ColorPalette constant type TSpTBXCustomItem = class; TSpTBXToolbar = class; TSpTBXStatusToolbar = class; TSpTBXPopupMenu = class; TSpTBXPaintStage = ( pstPrePaint, // Pre paint stage pstPostPaint // Post paint stage ); TSpTBXToolbarDisplayMode = ( tbdmSelectiveCaption, // The caption is displayed if the Item.DisplayMode = nbdmImageAndText tbdmImageOnly, // Only the images are displayed tbdmImageAboveCaption, // The images are displayed above the caption tbdmTextOnly // Show the caption only ); TSpTBXToolbarState = ( tstResizing, // The toolbar is being resized tstRightAligning, // The toolbar items are being right aligned tstAnchoring // The toolbar items are being anchored ); TSpTBXToolbarStates = set of TSpTBXToolbarState; TSpBorderIcon = ( briSystemMenu, // SystemMenu item on the title bar briMinimize, // Minimize item on the title bar briMaximize, // Maximize item on the title bar briClose // Close item on the title bar ); TSpBorderIcons = set of TSpBorderIcon; TTextWrapping = ( twNone, // No wrapping twEndEllipsis, // End ellipsis '...' twPathEllipsis, // Path ellipsis '\..\..' twWrap // Word wrap ); TSpTBXSearchItemViewerType = ( sivtNormal, // Normal search sivtInmediate, // Search for the inmediate ItemViewer sivtInmediateSkipNonVisible// Search for the next inmediate ItemViewer, skipping non visible ones ); TSpTBXGetImageIndexEvent = procedure(Sender: TObject; var AImageList: TCustomImageList; var AItemIndex: Integer) of object; TSpTBXDrawEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean) of object; TSpTBXDrawImageEvent = procedure(Sender: TObject; ACanvas: TCanvas; State: TSpTBXSkinStatesType; const PaintStage: TSpTBXPaintStage; var AImageList: TCustomImageList; var AImageIndex: Integer; var ARect: TRect; var PaintDefault: Boolean) of object; TSpTBXDrawItemEvent = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean) of object; TSpTBXDrawPosEvent = procedure(Sender: TObject; ACanvas: TCanvas; X, Y: Integer; var PaintDefault: Boolean) of object; TSpTBXDrawTextEvent = procedure(Sender: TObject; ACanvas: TCanvas; ClientAreaRect: TRect; State: TSpTBXSkinStatesType; var ACaption: WideString; var CaptionRect: TRect; var CaptionFormat: Cardinal; IsTextRotated: Boolean; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean) of object; TSpTBXDrawHintEvent = procedure(Sender: TObject; AHintBitmap: TBitmap; var AHint: WideString; var PaintDefault: Boolean) of object; TSpTBXItemNotificationEvent = procedure(Sender: TObject; Ancestor: TTBCustomItem; Relayed: Boolean; Action: TTBItemChangedAction; Index: Integer; Item: TTBCustomItem) of object; TSpTBXRadioGroupFillStringsEvent = procedure(Sender: TObject; Strings: TTntStringList) of object; TSpTBXPopupEvent = procedure(Sender: TObject; PopupView: TTBView) of object; { TSpTBXFontSettings } TSpTBXFontSize = 25..1000; TSpTBXFontSettings = class(TPersistent) private FColor: TColor; FName: TFontName; FSize: TSpTBXFontSize; FStyle: TFontStyles; FOnChange: TNotifyEvent; procedure SetColor(Value: TColor); procedure SetName(const Value: TFontName); procedure SetSize(Value: TSpTBXFontSize); procedure SetStyle(const Value: TFontStyles); protected procedure Modified; property OnChange: TNotifyEvent read FOnChange write FOnChange; public constructor Create; procedure Apply(AFont: TFont); procedure Assign(Src: TPersistent); override; published property Color: TColor read FColor write SetColor default clNone; property Name: TFontName read FName write SetName; // default '' property Size: TSpTBXFontSize read FSize write SetSize default 100; // Size Percent property Style: TFontStyles read FStyle write SetStyle default []; end; { TSpTBXCustomDragObject } TSpTBXCustomDragObject = class(TDragObjectEx) private FDragCursorAccept: TCursor; FDragCursorCancel: TCursor; FSourceControl: TControl; FSourceItem: TTBCustomItem; protected function GetDragCursor(Accepted: Boolean; X: Integer; Y: Integer): TCursor; override; procedure Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); override; public constructor Create(ASourceControl: TControl; AItem: TTBCustomItem); virtual; property DragCursorAccept: TCursor read FDragCursorAccept write FDragCursorAccept; property DragCursorCancel: TCursor read FDragCursorCancel write FDragCursorCancel; property SouceItem: TTBCustomItem read FSourceItem; property SourceControl: TControl read FSourceControl; end; { TSpTBXItemDragObject } TSpTBXItemDragObject = class(TSpTBXCustomDragObject); { TSpTBXCustomItemActionLink } {$IFNDEF UNICODE} TSpTBXCustomItemActionLink = class(TTBCustomItemActionLink) protected FUnicodeClient: TSpTBXCustomItem; procedure AssignClient(AClient: TObject); override; function IsCaptionLinked: Boolean; override; function IsHintLinked: Boolean; override; procedure SetCaption(const Value: string); override; procedure SetHint(const Value: string); override; end; {$ELSE} TSpTBXCustomItemActionLink = class(TTBCustomItemActionLink); {$ENDIF} { TSpTBXCustomControl } {$IFNDEF UNICODE} TSpTBXCustomControl = class(TCustomControl) private function IsCaptionStored: Boolean; function IsHintStored: Boolean; function GetCaption: TWideCaption; function GetHint: WideString; procedure SetCaption(const Value: TWideCaption); procedure SetHint(const Value: WideString); protected procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override; procedure CreateWindowHandle(const Params: TCreateParams); override; procedure DefineProperties(Filer: TFiler); override; // Don't let the streaming system store the WideStrings, use DefineProperties instead property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored; // Hides the inherited Caption property Hint: WideString read GetHint write SetHint stored IsHintStored; // Hides the inherited Hint end; {$ELSE} TSpTBXCustomControl = class(TCustomControl); {$ENDIF} { TSpTBXItem } TSpTBXCustomItem = class(TTBCustomItem) private {$IFNDEF UNICODE} FCaption: WideString; FHint: WideString; {$ENDIF} FCaptionGlow: TSpGlowDirection; FCaptionGlowColor: TColor; FAlignment: TAlignment; FAnchored: Boolean; FControl: TControl; FCustomWidth: Integer; FCustomHeight: Integer; FFontSettings: TSpTBXFontSettings; FMargins: Integer; FMinHeight: Integer; FMinWidth: Integer; FStretch: Boolean; FToolbarStylePopup: Boolean; FToolBoxPopup: Boolean; FWrapping: TTextWrapping; FOnClosePopup: TNotifyEvent; FOnInitPopup: TSpTBXPopupEvent; FOnDrawCaption: TSpTBXDrawTextEvent; FOnDrawHint: TSpTBXDrawHintEvent; FOnDrawItem: TSpTBXDrawItemEvent; FOnDrawImage: TSpTBXDrawImageEvent; {$IFNDEF UNICODE} function IsCaptionStored: Boolean; function IsHintStored: Boolean; procedure SetCaption(const Value: WideString); procedure SetHint(const Value: WideString); {$ENDIF} procedure FontSettingsChanged(Sender: TObject); procedure SetAlignment(const Value: TAlignment); procedure SetAnchored(const Value: Boolean); procedure SetCaptionGlow(const Value: TSpGlowDirection); procedure SetCaptionGlowColor(const Value: TColor); procedure SetControl(const Value: TControl); procedure SetCustomWidth(Value: Integer); procedure SetCustomHeight(Value: Integer); procedure SetFontSettings(const Value: TSpTBXFontSettings); procedure SetMargins(Value: Integer); procedure SetMinHeight(const Value: Integer); procedure SetMinWidth(const Value: Integer); procedure SetStretch(const Value: Boolean); procedure SetToolBoxPopup(const Value: Boolean); procedure SetWrapping(const Value: TTextWrapping); protected procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override; function DialogChar(CharCode: Word): Boolean; virtual; procedure DefineProperties(Filer: TFiler); override; procedure DoDrawAdjustFont(AFont: TFont; State: TSpTBXSkinStatesType); virtual; procedure DoDrawHint(AHintBitmap: TBitmap; var AHint: Widestring; var PaintDefault: Boolean); virtual; procedure DoDrawButton(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual; procedure DoDrawCaption(ACanvas: TCanvas; ClientAreaRect: TRect; State: TSpTBXSkinStatesType; var ACaption: WideString; var CaptionRect: TRect; var CaptionFormat: Cardinal; IsTextRotated: Boolean; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual; procedure DoDrawImage(ACanvas: TCanvas; State: TSpTBXSkinStatesType; const PaintStage: TSpTBXPaintStage; var AImageList: TCustomImageList; var AImageIndex: Integer; var ARect: TRect; var PaintDefault: Boolean); virtual; procedure DoPopupShowingChanged(APopupWindow: TTBPopupWindow; IsVisible: Boolean); virtual; function GetActionLinkClass: TTBCustomItemActionLinkClass; override; function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override; function GetPopupWindowClass: TTBPopupWindowClass; override; procedure ToggleControl; virtual; procedure UpdateProps; virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; property Alignment: TAlignment read FAlignment write SetAlignment default taCenter; property Anchored: Boolean read FAnchored write SetAnchored default False; property CaptionGlow: TSpGlowDirection read FCaptionGlow write SetCaptionGlow default gldNone; property CaptionGlowColor: TColor read FCaptionGlowColor write SetCaptionGlowColor default clYellow; property Control: TControl read FControl write SetControl; property CustomWidth: Integer read FCustomWidth write SetCustomWidth default -1; property CustomHeight: Integer read FCustomHeight write SetCustomHeight default -1; property FontSettings: TSpTBXFontSettings read FFontSettings write SetFontSettings; property Margins: Integer read FMargins write SetMargins default 0; property MinHeight: Integer read FMinHeight write SetMinHeight default 0; property MinWidth: Integer read FMinWidth write SetMinWidth default 0; property ToolbarStylePopup: Boolean read FToolbarStylePopup write FToolbarStylePopup default False; // Used on submenus property ToolBoxPopup: Boolean read FToolBoxPopup write SetToolBoxPopup default False; // Used on submenus property Stretch: Boolean read FStretch write SetStretch default True; // Hidden, all items are stretched by default property OnClosePopup: TNotifyEvent read FOnClosePopup write FOnClosePopup; property OnInitPopup: TSpTBXPopupEvent read FOnInitPopup write FOnInitPopup; property OnDrawCaption: TSpTBXDrawTextEvent read FOnDrawCaption write FOnDrawCaption; property OnDrawHint: TSpTBXDrawHintEvent read FOnDrawHint write FOnDrawHint; property OnDrawImage: TSpTBXDrawImageEvent read FOnDrawImage write FOnDrawImage; property OnDrawItem: TSpTBXDrawItemEvent read FOnDrawItem write FOnDrawItem; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Click; override; function GetShortCutText: WideString; // Reintroduce to support unicode shortcut text procedure InitiateAction; override; procedure Invalidate; published {$IFNDEF UNICODE} // Don't let the streaming system store the WideStrings, use DefineProperties instead property Caption: WideString read FCaption write SetCaption stored IsCaptionStored; // Hides the inherited Caption property Hint: WideString read FHint write SetHint stored IsHintStored; // Hides the inherited Hint {$ELSE} property Caption; property Hint; {$ENDIF} property Wrapping: TTextWrapping read FWrapping write SetWrapping default twWrap; end; TSpTBXItemViewer = class(TTBItemViewer) private function GetItem: TSpTBXCustomItem; procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW; procedure InternalCalcSize(const Canvas: TCanvas; CalcStretch: Boolean; var AWidth, AHeight: Integer); protected FAnchorSize: TPoint; FAnchorDelta: Integer; function IsOnToolBoxPopup: Boolean; // Custom Painting methods procedure DoDrawAdjustFont(AFont: TFont; State: TSpTBXSkinStatesType); virtual; procedure DoDrawButton(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual; procedure DoDrawCaption(ACanvas: TCanvas; ClientAreaRect: TRect; State: TSpTBXSkinStatesType; var ACaption: WideString; var CaptionRect: TRect; var CaptionFormat: Cardinal; IsTextRotated: Boolean; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual; procedure DoDrawImage(ACanvas: TCanvas; State: TSpTBXSkinStatesType; const PaintStage: TSpTBXPaintStage; var AImageList: TCustomImageList; var AImageIndex: Integer; var ARect: TRect; var PaintDefault: Boolean); virtual; procedure DoDrawHint(AHintBitmap: TBitmap; CursorPos: TPoint; var CursorRect: TRect; var AHint: Widestring; var PaintDefault: Boolean); virtual; // Painting methods function CaptionShown: Boolean; override; function GetImageShown: Boolean; virtual; function GetImageSize: TSize; virtual; function GetRightImageSize: TSize; virtual; function GetTextColor(State: TSpTBXSkinStatesType): TColor; virtual; procedure DrawItemImage(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; ImgIndex: Integer); virtual; procedure DrawItemRightImage(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo); virtual; procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override; procedure GetTextInfo(ACanvas: TCanvas; State: TSpTBXSkinStatesType; out TextInfo: TSpTBXTextInfo); procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); override; // Hints procedure Entering; override; procedure InternalMouseMove(Shift: TShiftState; X, Y: Integer); virtual; public function GetCaptionText: WideString; reintroduce; virtual; // Hides the inherited TB2K GetCaptionText function function GetHintText: Widestring; reintroduce; virtual; // Hides the inherited TB2K GetHintText function function IsToolbarStyle: Boolean; // Hides the inherited TB2K IsToolbarStyle function property Item: TSpTBXCustomItem read GetItem; // Hides the inherited TB2K Item property end; TSpTBXItem = class(TSpTBXCustomItem) published property Action; property AutoCheck; property Checked; property DisplayMode; property Enabled; property GroupIndex; property HelpContext; property ImageIndex; property Images; property InheritOptions; property MaskOptions; property Options; property RadioItem; property ShortCut; property Visible; // property OnDrawImage; use custom OnDrawImage property OnClick; property OnSelect; // TSpTBXCustomItem properties property Alignment; property Anchored; property CaptionGlow; property CaptionGlowColor; property Control; property CustomWidth; property CustomHeight; property FontSettings; property Margins; property MinHeight; property MinWidth; property OnDrawCaption; property OnDrawHint; property OnDrawImage; property OnDrawItem; end; { TSpTBXRootItem } TSpTBXRootItem = class(TTBRootItem) private FToolBoxPopup: Boolean; FOnInitPopup: TSpTBXPopupEvent; FOnClosePopup: TNotifyEvent; procedure SetToolBoxPopup(const Value: Boolean); protected procedure DoPopupShowingChanged(APopupWindow: TTBPopupWindow; IsVisible: Boolean); virtual; function GetPopupWindowClass: TTBPopupWindowClass; override; property ToolBoxPopup: Boolean read FToolBoxPopup write SetToolBoxPopup default False; public property OnInitPopup: TSpTBXPopupEvent read FOnInitPopup write FOnInitPopup; property OnClosePopup: TNotifyEvent read FOnClosePopup write FOnClosePopup; end; { TSpTBXSubmenuItem } TSpTBXSubmenuItem = class(TSpTBXItem) private FHideEmptyPopup: Boolean; function GetDropdownCombo: Boolean; procedure SetDropdownCombo(Value: Boolean); public constructor Create(AOwner: TComponent); override; published property DropdownCombo: Boolean read GetDropdownCombo write SetDropdownCombo default False; property HideEmptyPopup: Boolean read FHideEmptyPopup write FHideEmptyPopup default False; property LinkSubitems; property SubMenuImages; property ToolbarStylePopup; property ToolBoxPopup; property OnPopup; property OnClosePopup; property OnInitPopup; end; { TSpTBXColorItem } TSpTBXColorItem = class(TSpTBXCustomItem) private FColor: TColor; procedure SetColor(Value: TColor); protected function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override; public constructor Create(AOwner: TComponent); override; published property Action; property AutoCheck; property Checked; property DisplayMode; property Enabled; property GroupIndex; property HelpContext; property InheritOptions; property MaskOptions; property Options; property ShortCut; property Visible; property OnClick; property OnSelect; // TSpTBXCustomItem properties property Alignment; property Anchored; property CaptionGlow; property CaptionGlowColor; property Control; property CustomWidth; property CustomHeight; property FontSettings; property Margins; property MinHeight; property MinWidth; property OnDrawCaption; property OnDrawHint; property OnDrawImage; property OnDrawItem; // TSpTBXColorItem properties property Color: TColor read FColor write SetColor default clWhite; end; TSpTBXColorItemViewer = class(TSpTBXItemViewer) protected procedure DoDrawImage(ACanvas: TCanvas; State: TSpTBXSkinStatesType; const PaintStage: TSpTBXPaintStage; var AImageList: TCustomImageList; var AImageIndex: Integer; var ARect: TRect; var PaintDefault: Boolean); override; function GetImageShown: Boolean; override; function GetImageSize: TSize; override; end; { TSpTBXLabelItem } TSpTBXCustomLabelItem = class(TSpTBXCustomItem) protected function DialogChar(CharCode: Word): Boolean; override; procedure DoDrawButton(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); override; function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override; procedure ToggleControl; override; procedure UpdateProps; override; property Alignment default taLeftJustify; public constructor Create(AOwner: TComponent); override; end; TSpTBXLabelItemViewer = class(TSpTBXItemViewer) protected procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override; function DoExecute: Boolean; override; end; TSpTBXLabelItem = class(TSpTBXCustomLabelItem) published property Enabled; property ImageIndex; property Images; property InheritOptions; property MaskOptions; property Options; property Visible; property OnClick; // TSpTBXCustomItem properties property Alignment; property Anchored; property CaptionGlow; property CaptionGlowColor; property Control; property CustomWidth; property CustomHeight; property FontSettings; property Margins; property MinHeight; property MinWidth; property OnDrawCaption; property OnDrawHint; property OnDrawImage; property OnDrawItem; end; { TSpTBXSeparatorItem } TSpTBXSeparatorItem = class(TTBSeparatorItem) protected function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override; end; TSpTBXSeparatorItemViewer = class(TTBSeparatorItemViewer) protected procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override; function IsStatusBarSeparator: Boolean; procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); override; end; { TSpTBXRightAlignSpacerItem } TSpTBXRightAlignSpacerItem = class(TSpTBXCustomLabelItem) published property ImageIndex; property Images; property MaskOptions; property Options; property OnClick; // TSpTBXCustomItem properties property Alignment; property CaptionGlow; property CaptionGlowColor; property CustomWidth; property CustomHeight; property FontSettings; property OnDrawCaption; property OnDrawHint; property OnDrawImage; property OnDrawItem; end; { TSpTBXRadioGroupItem } TSpTBXRadioGroupItem = class(TTBGroupItem) private FDefaultIndex: Integer; FLastClickedIndex: Integer; FOnClick: TNotifyEvent; FOnFillStrings: TSpTBXRadioGroupFillStringsEvent; FOnUpdate: TNotifyEvent; protected FStrings: TTntStringList; procedure Loaded; override; procedure ItemClickEvent(Sender: TObject); virtual; procedure DoClick(AItem: TSpTBXItem); virtual; procedure DoFillStrings; virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Recreate; property DefaultIndex: Integer read FDefaultIndex write FDefaultIndex; property LastClickedIndex: Integer read FLastClickedIndex; published property OnClick: TNotifyEvent read FOnClick write FOnClick; property OnFillStrings: TSpTBXRadioGroupFillStringsEvent read FOnFillStrings write FOnFillStrings; property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate; end; { TSpTBXSkinGroupItem } TSpTBXSkinGroupItem = class(TSpTBXRadioGroupItem) private FOnSkinChange: TNotifyEvent; procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE; protected procedure DoClick(AItem: TSpTBXItem); override; procedure DoSkinChange; virtual; procedure DoFillStrings; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property OnSkinChange: TNotifyEvent read FOnSkinChange write FOnSkinChange; end; { TSpTBXSystemMenuItem } TSpTBXSystemMenuItem = class(TSpTBXCustomItem) private FMDISystemMenu: Boolean; FShowSize: Boolean; procedure CommandClick(Sender: TObject); protected function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override; function GetSystemMenuParentForm: TCustomForm; public constructor Create(AOwner: TComponent); override; procedure Click; override; published property MDISystemMenu: Boolean read FMDISystemMenu write FMDISystemMenu default False; property ShowSize: Boolean read FShowSize write FShowSize default True; end; TSpTBXSystemMenuItemViewer = class(TSpTBXItemViewer) protected procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override; procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); override; end; { TSpTBXToolPalette } TSpTBXRowColCount = 1..100; TSpTBXTPGetCellHint = procedure(Sender: TObject; ACol, ARow: Integer; var AHint: WideString) of object; TSpTBXTPDrawCellImage = procedure(Sender: TObject; ACanvas: TCanvas; ARect: TRect; ACol, ARow: Integer; Selected, HotTrack, Enabled: Boolean) of object; TSpTBXTPCellClick = procedure(Sender: TObject; ACol, ARow: Integer; var Allow: Boolean) of object; TSpTBXCPGetColorInfo = procedure(Sender: TObject; ACol, ARow: Integer; var Color: TColor; var Name: WideString) of object; TSpTBXCustomToolPalette = class(TSpTBXCustomItem) private FCustomImages: Boolean; FColCount: TSpTBXRowColCount; FRowCount: TSpTBXRowColCount; FSelectedCell: TPoint; FOnChange: TNotifyEvent; FOnCellClick: TSpTBXTPCellClick; FOnDrawCellImage: TSpTBXTPDrawCellImage; FOnGetCellHint: TSpTBXTPGetCellHint; procedure SetSelectedCell(Value: TPoint); protected function DoCellClick(ACol, ARow: Integer): Boolean; virtual; procedure DoChange; virtual; procedure DoDrawCellImage(ACanvas: TCanvas; const ARect: TRect; ACol, ARow: Integer; ItemInfo: TSpTBXMenuItemInfo); virtual; procedure DoGetCellHint(ACol, ARow: Integer; var AHint: WideString); virtual; function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override; procedure HandleClickCell(ACol, ARow: Integer); virtual; procedure SetColCount(Value: TSpTBXRowColCount); virtual; procedure SetRowCount(Value: TSpTBXRowColCount); virtual; property CustomImages: Boolean read FCustomImages write FCustomImages; property ColCount: TSpTBXRowColCount read FColCount write SetColCount default 1; property RowCount: TSpTBXRowColCount read FRowCount write SetRowCount default 1; property SelectedCell: TPoint read FSelectedCell write SetSelectedCell; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnCellClick: TSpTBXTPCellClick read FOnCellClick write FOnCellClick; property OnDrawCellImage: TSpTBXTPDrawCellImage read FOnDrawCellImage write FOnDrawCellImage; property OnGetCellHint: TSpTBXTPGetCellHint read FOnGetCellHint write FOnGetCellHint; public constructor Create(AOwner: TComponent); override; end; TSpTBXToolPalette = class(TSpTBXCustomToolPalette) public property SelectedCell; published property ColCount; property HelpContext; property Images; property Options; property RowCount; property Visible; property OnChange; property OnCellClick; property OnDrawCellImage; property OnGetCellHint; end; TSpTBXToolViewer = class(TSpTBXItemViewer) private FCellHeight: Integer; FCellWidth: Integer; FColCount: Integer; FRowCount: Integer; FHotCell: TPoint; function GetItem: TSpTBXCustomToolPalette; protected FIndent: Integer; FMouseIsDown: Boolean; procedure CalcCellSize(ACanvas: TCanvas; var AWidth, AHeight: Integer); virtual; procedure CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); override; function GetImageIndex(Col, Row: Integer): Integer; function GetImageSize: TSize; override; function GetImageShown: Boolean; override; function GetCellAt(X, Y: Integer; out Col, Row: Integer): Boolean; function GetCellRect(ClientAreaRect: TRect; Col, Row: Integer): TRect; virtual; function GetCellHint(Col, Row: Integer): WideString; procedure DoDrawHint(AHintBitmap: TBitmap; CursorPos: TPoint; var CursorRect: TRect; var AHint: Widestring; var PaintDefault: Boolean); override; procedure DrawCellImage(ACanvas: TCanvas; const ARect: TRect; Col, Row: Integer; ItemInfo: TSpTBXMenuItemInfo); virtual; procedure Entering; override; procedure InvalidateCell(ACol, ARow: Integer); function IsCellVisible(Cell: TPoint): Boolean; virtual; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseDown(Shift: TShiftState; X, Y: Integer;var MouseDownOnMenu: Boolean); override; procedure MouseMove(X, Y: Integer); override; procedure MouseUp(X, Y: Integer; MouseWasDownOnMenu: Boolean); override; procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); override; public constructor Create(AView: TTBView; AItem: TTBCustomItem; AGroupLevel: Integer); override; property Item: TSpTBXCustomToolPalette read GetItem; // Hides the inherited TB2K Item property end; { TSpTBXColorPalette } TSpTBXColorPalette = class(TSpTBXCustomToolPalette) private FColor: TColor; FCustomColors: Boolean; FOnGetColor: TSpTBXCPGetColorInfo; procedure SetColor(Value: TColor); procedure SetCustomColors(const Value: Boolean); protected procedure DoChange; override; procedure DoGetCellHint(ACol, ARow: Integer; var AHint: WideString); override; procedure DoDrawCellImage(ACanvas: TCanvas; const ARect: TRect; ACol, ARow: Integer; ItemInfo: TSpTBXMenuItemInfo); override; function GetCellColor(ACol, ARow: Integer): TColor; procedure GetCellInfo(ACol, ARow: Integer; out AColor: TColor; out AName: WideString); procedure SetColCount(Value: TSpTBXRowColCount); override; procedure SetRowCount(Value: TSpTBXRowColCount); override; public constructor Create(AOwner: TComponent); override; function FindCell(AColor: TColor): TPoint; published property CustomColors: Boolean read FCustomColors write SetCustomColors default False; // Must be published before ColCount property ColCount default CPDefaultCols; property Color: TColor read FColor write SetColor default clNone; property HelpContext; property InheritOptions; property MaskOptions; property Options default [tboShowHint]; property RowCount default CPDefaultRows; property Visible; property OnChange; property OnCellClick; property OnGetCellHint; property OnGetColor: TSpTBXCPGetColorInfo read FOnGetColor write FOnGetColor; end; { TSpTBXItemCacheList } TSpTBXItemCache = class(TCollectionItem) private FDock: TTBDock; FName: TComponentName; FItem: TTBCustomItem; FWidth, FHeight: Integer; FParentWidth, FParentHeight: Integer; function GetName: TComponentName; public procedure Assign(Source: TPersistent); override; property Item: TTBCustomItem read FItem write FItem; published property Dock: TTBDock read FDock write FDock; property Name: TComponentName read GetName write FName; property Width: Integer read FWidth write FWidth default 0; property Height: Integer read FHeight write FHeight default 0; property ParentWidth: Integer read FParentWidth write FParentWidth default 0; property ParentHeight: Integer read FParentHeight write FParentHeight default 0; end; TSpTBXItemCacheCollection = class(TCollection) private function GetItem(Index: Integer): TSpTBXItemCache; procedure SetItem(Index: Integer; const Value: TSpTBXItemCache); public function Add(AItem: TTBCustomItem): Integer; virtual; function IndexOf(AItem: TTBCustomItem): Integer; property Items[Index: Integer]: TSpTBXItemCache read GetItem write SetItem; default; end; { TSpTBXDock } TSpTBXDock = class(TTBDock) private FMoving: Boolean; FResizing: Boolean; FPrevWidth: Integer; FPrevHeight: Integer; FOnDrawBackground: TSpTBXDrawEvent; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMMove(var Message: TWMMove); message WM_MOVE; procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE; protected function CanResize(var NewWidth: Integer; var NewHeight: Integer): Boolean; override; procedure DrawBackground(DC: HDC; const DrawRect: TRect); override; procedure DoDrawBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual; procedure Resize; override; function UsingBackground: Boolean; override; function UsingBitmap: Boolean; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property PrevWidth: Integer read FPrevWidth; property PrevHeight: Integer read FPrevHeight; published property Color default clNone; property OnCanResize; property OnDrawBackground: TSpTBXDrawEvent read FOnDrawBackground write FOnDrawBackground; end; TSpTBXDockClass = class of TSpTBXDock; { TSpTBXToolbar } TSpTBXToolbarView = class(TTBToolbarView) private FMaxSize: Integer; procedure SetMaxSize(const Value: Integer); protected FTallestItemSize: Integer; FUpdating: Integer; procedure DoUpdatePositions(var ASize: TPoint); override; public constructor Create(AOwner: TComponent; AParentView: TTBView; AParentItem: TTBCustomItem; AWindow: TWinControl; AIsToolbar, ACustomizing, AUsePriorityList: Boolean); override; procedure BeginUpdate; virtual; // Hides inherited BeginUpdate procedure EndUpdate; virtual; // Hides inherited EndUpdate function IsUpdating: Boolean; property MaxSize: Integer read FMaxSize write SetMaxSize; end; TSpTBXToolbar = class(TTBCustomToolbar) private FChevronVertical: Boolean; FCompoundToolbar: Boolean; FCustomizable: Boolean; FCustomizingCount: Integer; FItemMovingCount: Integer; FDisplayMode: TSpTBXToolbarDisplayMode; FLastDropMark: TRect; FLastSelectableWidth: Integer; FMenuBar: Boolean; FOnDrawBackground: TSpTBXDrawEvent; FOnItemNotification: TSpTBXItemNotificationEvent; {$IFNDEF UNICODE} function IsCaptionStored: Boolean; function GetCaption: TWideCaption; procedure SetCaption(const Value: TWideCaption); function GetHint: WideString; procedure SetHint(const Value: WideString); {$ENDIF} procedure SetDisplayMode(const Value: TSpTBXToolbarDisplayMode); function GetMaxSize: Integer; procedure SetMaxSize(const Value: Integer); procedure SetMenuBar(const Value: Boolean); function CreateWrapper(Index: Integer; Ctl: TControl): TTBControlItem; function IsAnchoredControlItem(Item: TTBCustomItem): TTBControlItem; procedure CMControlChange(var Message: TCMControlChange); message CM_CONTROLCHANGE; procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; procedure CMMouseleave(var Message: TMessage); message CM_MOUSELEAVE; procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE; procedure SetCustomizable(const Value: Boolean); protected FBeginDragIV: TTBItemViewer; FAnchoredControlItems: TSpTBXItemCacheCollection; FState: TSpTBXToolbarStates; FDefaultToolbarBorderSize: Integer; // Component procedure CreateWindowHandle(const Params: TCreateParams); override; procedure DefineProperties(Filer: TFiler); override; procedure Resize; override; procedure AnchorItems(UpdateControlItems: Boolean = True); virtual; procedure RightAlignItems; virtual; // Painting procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); override; function GetItemsTextColor(State: TSpTBXSkinStatesType): TColor; virtual; procedure InternalDrawBackground(ACanvas: TCanvas; ARect: TRect; PaintOnNCArea: Boolean; PaintBorders: Boolean = True); virtual; procedure DoDrawBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual; // Get class function GetChevronItemClass: TTBChevronItemClass; override; function GetFloatingWindowParentClass: TTBFloatingWindowParentClass; override; function GetRightAlignMargin: Integer; virtual; function GetViewClass: TTBToolbarViewClass; override; // Hints procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; // Customizer procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override; function CanDragCustomize(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean; virtual; procedure DoStartDrag(var DragObject: TDragObject); override; procedure DragOver(Source: TObject; X: Integer; Y: Integer; State: TDragState; var Accept: Boolean); override; // Misc function CanItemClick(Item: TTBCustomItem; Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean; virtual; procedure DoItemClick(Item: TTBCustomItem; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual; procedure DoItemNotification(Ancestor: TTBCustomItem; Relayed: Boolean; Action: TTBItemChangedAction; Index: Integer; Item: TTBCustomItem); virtual; property CompoundToolbar: Boolean read FCompoundToolbar write FCompoundToolbar; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure DragDrop(Source: TObject; X: Integer; Y: Integer); override; procedure ReadPositionData(const Data: TTBReadPositionData); override; procedure WritePositionData(const Data: TTBWritePositionData); override; procedure BeginUpdate; // Hides inherited BeginUpdate procedure EndUpdate; // Hides inherited EndUpdate function IsUpdating: Boolean; procedure BeginCustomize; procedure EndCustomize; procedure BeginItemMove; procedure EndItemMove; function GetFloatingBorderSize: TPoint; override; function IsCustomizing: Boolean; function IsItemMoving: Boolean; function IsVertical: Boolean; property DefaultToolbarBorderSize: Integer read FDefaultToolbarBorderSize; property MaxSize: Integer read GetMaxSize write SetMaxSize default -1; published property ActivateParent; property Align; property AutoResize; property BorderStyle; property ChevronHint; property ChevronMoveItems; property ChevronPriorityForNewItems; property CloseButton; property CloseButtonWhenDocked; property CurrentDock; 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 LastDock; property LinkSubitems; property Options; property ParentFont; property ParentShowHint; property PopupMenu; property ProcessShortCuts; property Resizable; property ShowCaption; property ShowHint; property ShrinkMode; property SmoothDrag; property Stretch; property SystemFont; property TabOrder; property TabStop; property UpdateActions; property UseLastDock; property Visible; property Color default clNone; property OnClose; property OnCloseQuery; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMove; property OnRecreated; property OnRecreating; property OnDockChanged; property OnDockChanging; property OnDockChangingHidden; property OnResize; property OnShortCut; property OnVisibleChanged; {$IFNDEF UNICODE} // Don't let the streaming system store the WideStrings, use DefineProperties instead property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored; // Hides the inherited Caption property Hint: WideString read GetHint write SetHint stored False; // Hint is set dynamically in MouseMove, don't save it {$ELSE} property Caption; property Hint; {$ENDIF} property ChevronVertical: Boolean read FChevronVertical write FChevronVertical default True; property Customizable: Boolean read FCustomizable write SetCustomizable default True; property DisplayMode: TSpTBXToolbarDisplayMode read FDisplayMode write SetDisplayMode default tbdmSelectiveCaption; property MenuBar: Boolean read FMenuBar write SetMenuBar default False; // Hides the inherited MenuBar property OnDrawBackground: TSpTBXDrawEvent read FOnDrawBackground write FOnDrawBackground; property OnItemNotification: TSpTBXItemNotificationEvent read FOnItemNotification write FOnItemNotification; end; TSpTBXToolbarClass = class of TSpTBXToolbar; { TSpTBXToolWindow } TSpTBXCustomToolWindow = class(TTBCustomDockableWindow) private FMinClientWidth, FMinClientHeight, FMaxClientWidth, FMaxClientHeight: Integer; FOnDrawBackground: TSpTBXDrawEvent; {$IFNDEF UNICODE} function IsCaptionStored: Boolean; function GetCaption: TWideCaption; procedure SetCaption(const Value: TWideCaption); {$ENDIF} function GetClientAreaWidth: Integer; procedure SetClientAreaWidth(Value: Integer); function GetClientAreaHeight: Integer; procedure SetClientAreaHeight(Value: Integer); procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE; procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; protected FBarSize: TSize; FDefaultToolbarBorderSize: Integer; procedure CreateWindowHandle(const Params: TCreateParams); override; procedure DefineProperties(Filer: TFiler); override; function GetFloatingWindowParentClass: TTBFloatingWindowParentClass; override; // Sizing function CalcSize(ADock: TTBDock): TPoint; virtual; function DoArrange(CanMoveControls: Boolean; PreviousDockType: TTBDockType; NewFloating: Boolean; NewDock: TTBDock): TPoint; override; procedure GetBaseSize(var ASize: TPoint); override; procedure GetMinMaxSize(var AMinClientWidth, AMinClientHeight, AMaxClientWidth, AMaxClientHeight: Integer); override; procedure SetClientAreaSize(AWidth, AHeight: Integer); virtual; procedure SizeChanging(const AWidth, AHeight: Integer); override; // Painting procedure Paint; override; procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); override; procedure InternalDrawBackground(ACanvas: TCanvas; ARect: TRect; PaintOnNCArea: Boolean; PaintBorders: Boolean = True); virtual; procedure DoDrawBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual; property ClientAreaHeight: Integer read GetClientAreaHeight write SetClientAreaHeight; property ClientAreaWidth: Integer read GetClientAreaWidth write SetClientAreaWidth; property MaxClientHeight: Integer read FMaxClientHeight write FMaxClientHeight default 0; property MaxClientWidth: Integer read FMaxClientWidth write FMaxClientWidth default 0; property MinClientHeight: Integer read FMinClientHeight write FMinClientHeight default 32; property MinClientWidth: Integer read FMinClientWidth write FMinClientWidth default 32; property OnDrawBackground: TSpTBXDrawEvent read FOnDrawBackground write FOnDrawBackground; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetFloatingBorderSize: TPoint; override; procedure InvalidateBackground(InvalidateChildren: Boolean = True); virtual; function IsVertical: Boolean; procedure ReadPositionData(const Data: TTBReadPositionData); override; procedure WritePositionData(const Data: TTBWritePositionData); override; property DefaultToolbarBorderSize: Integer read FDefaultToolbarBorderSize; published {$IFNDEF UNICODE} // Don't let the streaming system store the WideStrings, use DefineProperties instead property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored; // Hides the inherited Caption {$ELSE} property Caption; {$ENDIF} property Color default clNone; end; TSpTBXToolWindow = class(TSpTBXCustomToolWindow) published property ActivateParent; property Align; property Anchors; property BorderStyle; property Caption; property Color; property CloseButton; property CloseButtonWhenDocked; property CurrentDock; property DefaultDock; property DockableTo; property DockMode; property DockPos; property DockRow; property DragHandleStyle; property FloatingMode; property Font; property FullSize; property HideWhenInactive; property LastDock; property ParentFont; property ParentShowHint; property PopupMenu; property Resizable; property ShowCaption; property ShowHint; property Stretch; property SmoothDrag; property TabOrder; property UseLastDock; property Visible; property OnClose; property OnCloseQuery; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnDockChanged; property OnDockChanging; property OnDockChangingHidden; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMove; property OnRecreated; property OnRecreating; property OnResize; property OnVisibleChanged; // TSpTBXCustomToolWindow properties property ClientAreaHeight; property ClientAreaWidth; property MaxClientHeight; property MaxClientWidth; property MinClientHeight; property MinClientWidth; property OnDrawBackground; end; { TSpTBXFloatingWindowParent } TSpTBXFloatingWindowParent = class(TTBFloatingWindowParent) private FCloseButtonHover: Boolean; FCloseOnAltF4: Boolean; procedure UpdateDwmNCSize; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; procedure WMActivateApp(var Message: TWMActivateApp); message WM_ACTIVATEAPP; procedure WMClose(var Message: TWMClose); message WM_CLOSE; procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND; procedure WMNCMouseLeave(var Message: TMessage); message WM_NCMOUSELEAVE; procedure WMNCMouseMove(var Message: TWMNCMouseMove); message WM_NCMOUSEMOVE; procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE; protected procedure CancelNCHover; procedure CreateWnd; override; procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN; RedrawWhat: TTBToolWindowNCRedrawWhat); override; procedure RedrawCloseButton; procedure VisibleChanging; override; property CloseButtonHover: Boolean read FCloseButtonHover; public constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override; destructor Destroy; override; property CloseOnAltF4: Boolean read FCloseOnAltF4 write FCloseOnAltF4; end; { TSpTBXPopupWindow } TSpTBXPopupWindow = class(TTBPopupWindow) private FPaintingClientArea: Boolean; FMaximumImageSize: TSize; function CanDrawGutter: Boolean; procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; procedure CMShowingchanged(var Message: TMessage); message CM_SHOWINGCHANGED; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; procedure WMPrint(var Message: TMessage); message WM_PRINT; protected function GetViewClass: TTBViewClass; override; procedure DoPopupShowingChanged(IsVisible: Boolean); virtual; procedure PaintBackground(ACanvas: TCanvas; ARect: TRect); virtual; public constructor CreatePopupWindow(AOwner: TComponent; const AParentView: TTBView; const AItem: TTBCustomItem; const ACustomizing: Boolean); override; destructor Destroy; override; property MaximumImageSize: TSize read FMaximumImageSize; end; TSpTBXPopupWindowView = class(TTBPopupView) protected procedure AutoSize(AWidth, AHeight: Integer); override; public procedure SetIsToolbar(const Value: Boolean); published property IsToolbar; end; { TSpTBXChevronItem } TSpTBXChevronItem = class(TTBChevronItem) protected function GetPopupWindowClass: TTBPopupWindowClass; override; public function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override; end; TSpTBXChevronItemViewer = class(TTBItemViewer) protected procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); override; public function GetTextColor(State: TSpTBXSkinStatesType): TColor; virtual; end; TSpTBXChevronPopupWindow = class(TSpTBXPopupWindow) private procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED; end; { TSpTBXPopupMenu } ISpTBXPopupMenu = interface ['{C576A225-6E42-49F6-96E5-712510C5D85C}'] function InternalPopup(X, Y: Integer; ForceFocus: Boolean; PopupControl: TControl = nil): Boolean; end; TSpTBXPopupMenu = class(TTBPopupMenu, ISpTBXPopupMenu) private FClickedItem: TTBCustomItem; FReturnClickedItemOnly: Boolean; FToolBoxPopup: Boolean; function GetOnInitPopup: TSpTBXPopupEvent; procedure SetOnInitPopup(const Value: TSpTBXPopupEvent); function GetOnClosePopup: TNotifyEvent; procedure SetOnClosePopup(const Value: TNotifyEvent); protected function InternalPopup(X, Y: Integer; ForceFocus: Boolean; PopupControl: TControl = nil): Boolean; virtual; function GetRootItemClass: TTBRootItemClass; override; public procedure Popup(X: Integer; Y: Integer); override; function PopupEx(X, Y: Integer; PopupControl: TControl = nil; ReturnClickedItemOnly: Boolean = False): TTBCustomItem; virtual; published property ToolBoxPopup: Boolean read FToolBoxPopup write FToolBoxPopup default False; property OnInitPopup: TSpTBXPopupEvent read GetOnInitPopup write SetOnInitPopup; property OnClosePopup: TNotifyEvent read GetOnClosePopup write SetOnClosePopup; end; { TSpTBXCompoundItemsControl } TSpTBXCompoundItemsControl = class(TSpTBXCustomControl, ITBItems) private FSkinType: TSpTBXSkinType; procedure DockRequestDock(Sender: TObject; Bar: TTBCustomDockableWindow; var Accept: Boolean); function GetRootItems: TTBRootItem; function GetView: TSpTBXToolbarView; function GetImages: TCustomImageList; procedure SetImages(const Value: TCustomImageList); procedure SetSkinType(const Value: TSpTBXSkinType); procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE; protected FDock: TSpTBXDock; FToolbar: TSpTBXToolbar; procedure CreateParams(var Params: TCreateParams); override; function GetDockClass: TSpTBXDockClass; virtual; function GetToolbarClass: TSpTBXToolbarClass; virtual; function GetItems: TTBCustomItem; virtual; // For ITBItems interface procedure Loaded; override; procedure SetName(const Value: TComponentName); override; property Images: TCustomImageList read GetImages write SetImages; property SkinType: TSpTBXSkinType read FSkinType write SetSkinType default sknSkin; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; // For ITBItems interface procedure InvalidateBackground(InvalidateChildren: Boolean = True); virtual; property View: TSpTBXToolbarView read GetView; published property Items: TTBRootItem read GetRootItems; end; { TSpTBXCompoundBar } TSpTBXCompoundBar = class(TSpTBXCompoundItemsControl) private FOnDrawDockBackground: TSpTBXDrawEvent; procedure DrawDockBackground(Sender: TObject; ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); procedure DrawToolbarBackground(Sender: TObject; ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); procedure DockResize(Sender: TObject); protected procedure DoDrawDockBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual; property OnDrawDockBackground: TSpTBXDrawEvent read FOnDrawDockBackground write FOnDrawDockBackground; public constructor Create(AOwner: TComponent); override; end; { TSpTBXButtonOptions } TSpTBXButtonOptions = class(TPersistent) private FEditableItems: TTBGroupItem; FCloseButton: TSpTBXItem; FMinimizeButton: TSpTBXItem; FMaximizeButton: TSpTBXItem; FRightAlignSpacer: TSpTBXRightAlignSpacerItem; FCaptionImageIndex: Integer; FCloseImageIndex: Integer; FMinimizeImageIndex: Integer; FMaximizeImageIndex: Integer; FRestoreImageIndex: Integer; FCaptionLabel: WideString; FCaption: Boolean; FClose: Boolean; FMinimize: Boolean; FMaximize: Boolean; FButtonBorders: Boolean; FTitleBarMaxSize: Integer; procedure SetCaptionImageIndex(Value: Integer); procedure SetCloseImageIndex(Value: Integer); procedure SetCaptionLabel(const Value: WideString); procedure SetMaximizeImageIndex(Value: Integer); procedure SetRestoreImageIndex(Value: Integer); procedure SetMinimizeImageIndex(Value: Integer); procedure SetCaption(const Value: Boolean); procedure SetClose(const Value: Boolean); procedure SetMaximize(const Value: Boolean); procedure SetMinimize(const Value: Boolean); procedure SetTitleBarMaxSize(const Value: Integer); protected FParentControl: TWinControl; FToolbar: TSpTBXToolbar; procedure ButtonsDrawImage(Sender: TObject; ACanvas: TCanvas; State: TSpTBXSkinStatesType; const PaintStage: TSpTBXPaintStage; var AImageList: TCustomImageList; var AImageIndex: Integer; var ARect: TRect; var PaintDefault: Boolean); virtual; procedure ButtonsDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual; procedure ButtonsClick(Sender: TObject); virtual; abstract; procedure CreateButtons; virtual; procedure UpdateButtonsVisibility; virtual; procedure SetupButton(B: TSpTBXCustomItem); virtual; function Restoring(B: TSpTBXCustomItem): Boolean; virtual; abstract; public constructor Create(AParent: TWinControl); virtual; procedure SetupButtonIcon(B: TSpTBXCustomItem); virtual; procedure MoveItemToTheLeft(B: TTBCustomItem); property EditableItems: TTBGroupItem read FEditableItems; property RightAlignSpacer: TSpTBXRightAlignSpacerItem read FRightAlignSpacer; property MinimizeButton: TSpTBXItem read FMinimizeButton; property MaximizeButton: TSpTBXItem read FMaximizeButton; property CloseButton: TSpTBXItem read FCloseButton; property CaptionLabel: WideString read FCaptionLabel write SetCaptionLabel; published property ButtonBorders: Boolean read FButtonBorders write FButtonBorders default True; property Caption: Boolean read FCaption write SetCaption default True; property Close: Boolean read FClose write SetClose default True; property Minimize: Boolean read FMinimize write SetMinimize default True; property Maximize: Boolean read FMaximize write SetMaximize default True; property CaptionImageIndex: Integer read FCaptionImageIndex write SetCaptionImageIndex default -1; property CloseImageIndex: Integer read FCloseImageIndex write SetCloseImageIndex default -1; property MinimizeImageIndex: Integer read FMinimizeImageIndex write SetMinimizeImageIndex default -1; property MaximizeImageIndex: Integer read FMaximizeImageIndex write SetMaximizeImageIndex default -1; property RestoreImageIndex: Integer read FRestoreImageIndex write SetRestoreImageIndex default -1; property TitleBarMaxSize: Integer read FTitleBarMaxSize write SetTitleBarMaxSize default 21; end; { TSpTBXStatusBar } TSpTBXStatusToolbar = class(TSpTBXToolbar) private FSizeGrip: Boolean; FSkinType: TSpTBXSkinType; procedure SetSizeGrip(const Value: Boolean); procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN; procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; protected FParentForm: TCustomForm; procedure DoItemNotification(Ancestor: TTBCustomItem; Relayed: Boolean; Action: TTBItemChangedAction; Index: Integer; Item: TTBCustomItem); override; function GetItemsTextColor(State: TSpTBXSkinStatesType): TColor; override; function GetRightAlignMargin: Integer; override; function GetParentFormWindowState: TWindowState; function IsPointInGrip(P: TPoint): Boolean; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetGripRect: TRect; function NeedsSeparatorRepaint: Boolean; published property SizeGrip: Boolean read FSizeGrip write SetSizeGrip default True; end; TSpTBXCustomStatusBar = class(TSpTBXCompoundBar) private function GetSizeGrip: Boolean; procedure SetSizeGrip(const Value: Boolean); function GetStatusToolbar: TSpTBXStatusToolbar; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; protected FPrevState: TWindowState; function CanResize(var NewWidth: Integer; var NewHeight: Integer): Boolean; override; procedure DoDrawDockBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); override; procedure DrawSeparators(ACanvas: TCanvas; ARect: TRect); virtual; function GetToolbarClass: TSpTBXToolbarClass; override; property Align default alBottom; property SizeGrip: Boolean read GetSizeGrip write SetSizeGrip default True; public constructor Create(AOwner: TComponent); override; property Toolbar: TSpTBXStatusToolbar read GetStatusToolbar; end; TSpTBXStatusBar = class(TSpTBXCustomStatusBar) published property Align; property Anchors; property BiDiMode; property DragCursor; property DragKind; property DragMode; property Enabled; property Font; property ParentColor; property ParentBiDiMode; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property Visible; property OnCanResize; property OnContextPopup; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnResize; property OnStartDock; property OnStartDrag; // TSpTBXCustomStatusBar properties property Images; property SizeGrip; property SkinType; property OnDrawDockBackground; end; { TSpTBXTitleBar } TSpTBXCustomTitleBar = class; TSpTBXTitleToolbar = class(TSpTBXToolbar) private procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; protected function GetItemsTextColor(State: TSpTBXSkinStatesType): TColor; override; function GetTitleBar: TSpTBXCustomTitleBar; function GetRightAlignMargin: Integer; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override; end; TSpTBXTitleBarButtonOptions = class(TSpTBXButtonOptions) private FSystemMenu: Boolean; FSystemButton: TSpTBXSystemMenuItem; procedure SetSystemMenu(const Value: Boolean); protected FTitleBar: TSpTBXCustomTitleBar; procedure ButtonsDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); override; procedure ButtonsClick(Sender: TObject); override; procedure CreateButtons; override; function Restoring(B: TSpTBXCustomItem): Boolean; override; public constructor Create(AParent: TWinControl); override; property SystemButton: TSpTBXSystemMenuItem read FSystemButton; published property SystemMenu: Boolean read FSystemMenu write SetSystemMenu default True; end; TSpTBXCustomTitleBar = class(TSpTBXCompoundBar) private FActive: Boolean; FFixedSize: Boolean; FFullScreenMaximize: Boolean; FMouseActive: Boolean; FOptions: TSpTBXTitleBarButtonOptions; FOldAppWndProc: Pointer; FNewAppWndProc: Pointer; FOnDrawBackground: TSpTBXDrawEvent; FOnSystemMenuPopup: TSpTBXPopupEvent; FOldParentFormWndProc: TWndMethod; procedure AppWndProc(var Msg: TMessage); procedure NewParentFormWndProc(var Message: TMessage); procedure SetActive(const Value: Boolean); procedure SetMouseActive(const Value: Boolean); procedure SetFullScreenMaximize(const Value: Boolean); function GetWindowState: TWindowState; procedure SetWindowState(const Value: TWindowState); procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND; procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; procedure WMSpSkinChange(var Message: TMessage); message WM_SPSKINCHANGE; procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; protected FParentForm: TCustomForm; // Component procedure Loaded; override; function GetFloatingBorderSize: TPoint; function GetItems: TTBCustomItem; override; // For ITBItems interface function GetToolbarClass: TSpTBXToolbarClass; override; procedure ChangeTitleBarState(Activate: Boolean); procedure UpdateSkinMetrics; // Painting procedure DoDrawDockBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); override; procedure DoDrawBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); virtual; // Sizing procedure AdjustClientRect(var Rect: TRect); override; procedure GetSizeCursor(MousePos: TPoint; var SizeCursor, SizeCode: Integer); procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override; property Active: Boolean read FActive write SetActive default True; property Align default alClient; property FixedSize: Boolean read FFixedSize write FFixedSize default False; property FullScreenMaximize: Boolean read FFullScreenMaximize write SetFullScreenMaximize default False; property Options: TSpTBXTitleBarButtonOptions read FOptions write FOptions; property WindowState: TWindowState read GetWindowState write SetWindowState; property OnDrawBackground: TSpTBXDrawEvent read FOnDrawBackground write FOnDrawBackground; property OnSystemMenuPopup: TSpTBXPopupEvent read FOnSystemMenuPopup write FOnSystemMenuPopup; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetClientAreaRect: TRect; function IsActive: Boolean; property MouseActive: Boolean read FMouseActive write SetMouseActive default True; property Toolbar: TSpTBXToolbar read FToolbar; published property Caption; end; TSpTBXTitleBar = class(TSpTBXCustomTitleBar) published property Align; property Anchors; property Color; property BiDiMode; property Constraints; property DockSite; property DragCursor; property DragKind; property DragMode; property Enabled; property Font; property ParentColor; property ParentBiDiMode; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property Visible; property OnCanResize; property OnContextPopup; property OnDockDrop; property OnDockOver; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnGetSiteInfo; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnResize; property OnStartDock; property OnStartDrag; property OnUnDock; // TSpTBXCustomTitleBar properties property Active; property FixedSize; property FullScreenMaximize; property Images; property Options; property OnDrawBackground; property OnDrawDockBackground; property OnSystemMenuPopup; end; { TBitmapHint } TBitmapHint = class(THintWindow) private FHintBitmap: TBitmap; FActivating: Boolean; procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; protected procedure Paint; override; public property Activating: Boolean read FActivating; procedure ActivateHint(Rect: TRect; const AHint: string); override; procedure ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer); override; end; { Item helpers } procedure SpFillItemInfo(ACanvas: TCanvas; IV: TTBItemViewer; out ItemInfo: TSpTBXMenuItemInfo); function SpGetBoundsRect(IV: TTBItemViewer; Root: TTBRootItem): TRect; procedure SpGetAllItems(AParentItem: TTBCustomItem; ItemsList: TTntStringList; ClearFirst: Boolean = True); function SpGetMenuMaximumImageSize(View: TTBView): TSize; function SpGetItemViewerFromPoint(Root: TTBRootItem; View: TTBView; P: TPoint; ProcessGroupItems: Boolean = True): TTBItemViewer; function SpGetNextItemSameEdge(View: TTBView; IV: TTBItemViewer; GoForward: Boolean; SearchType: TSpTBXSearchItemViewerType): TTBItemViewer; function SpGetFirstRightAlignSpacer(View: TTBView): TSpTBXItemViewer; function SpGetRightAlignedItems(View: TTBView; RightAlignedList: TList; IsRotated: Boolean; out VisibleTotalWidth, RightAlignedTotalWidth: Integer): TSpTBXItemViewer; procedure SpInvalidateItem(View: TTBView; Item: TTBCustomItem); function SpFindItemViewer(View: TTBView; Item: TTBCustomItem): TTBItemViewer; function SpFindControlItem(Item: TTBCustomItem; Ctl: TControl; Recurse: Boolean = True): TTBControlItem; procedure SpGetDropPosItemViewer(Root: TTBRootItem; View: TTBView; P: TPoint; out DestIV: TTBItemViewer; out DestItemPos: Integer; out DropMark: TRect); overload; procedure SpGetDropPosItemViewer(Root: TTBRootItem; View: TTBView; P: TPoint; SourceItemPos: Integer; out DestIV: TTBItemViewer; out DestItemPos: Integer); overload; function SpGetDragHandleSize(Toolbar: TTBCustomDockableWindow): Integer; function SpIsVerticalToolbar(Toolbar: TTBCustomDockableWindow): Boolean; function SpIsDockUsingBitmap(Dock: TTBDock): Boolean; { Painting helpers } procedure SpDrawXPToolbarButton(ACanvas: TCanvas; ARect: TRect; State: TSpTBXSkinStatesType; SkinType: TSpTBXSkinType; ComboPart: TSpTBXComboPart = cpNone); procedure SpDrawXPMenuItem(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo); procedure SpDrawXPMenuSeparator(ACanvas: TCanvas; ARect: TRect; MenuItemStyle, Vertical: Boolean); procedure SpDrawXPMenuItemImage(ACanvas: TCanvas; ARect: TRect; const ItemInfo: TSpTBXMenuItemInfo; ImageList: TCustomImageList; ImageIndex: Integer); procedure SpDrawXPMenuGutter(ACanvas: TCanvas; ARect: TRect; SkinType: TSpTBXSkinType); procedure SpDrawXPMenuPopupWindow(ACanvas: TCanvas; ARect, OpenIVRect: TRect; DrawGutter: Boolean; ImageSize: Integer; SkinType: TSpTBXSkinType); procedure SpDrawXPStatusBar(ACanvas: TCanvas; ARect, AGripRect: TRect; SkinType: TSpTBXSkinType); procedure SpDrawXPTitleBar(ACanvas: TCanvas; ARect: TRect; IsActive: Boolean; DrawBorders: Boolean = True); procedure SpDrawXPTitleBarBody(ACanvas: TCanvas; ARect: TRect; IsActive: Boolean; BorderSize: TPoint; DrawBody: Boolean = True); procedure SpDrawXPDock(ACanvas: TCanvas; ARect: TRect; SkinType: TSpTBXSkinType; Vertical: Boolean = False); procedure SpDrawXPToolbar(ACanvas: TCanvas; ARect: TRect; SkinType: TSpTBXSkinType; Docked, Floating, Vertical, PaintSkinBackground, PaintBorders: Boolean; SkinComponent: TSpTBXSkinComponentsType = skncToolbar); overload; procedure SpDrawXPToolbar(W: TTBCustomDockableWindow; ACanvas: TCanvas; ARect: TRect; PaintOnNCArea: Boolean; PaintBorders: Boolean = True; SkinComponent: TSpTBXSkinComponentsType = skncToolbar); overload; procedure SpDrawXPToolbarGrip(W: TTBCustomDockableWindow; ACanvas: TCanvas; ARect: TRect); procedure SpDrawXPTooltipBackground(ACanvas: TCanvas; ARect: TRect); { Menu helpers } function SpCalcPopupPosition(const X, Y, Width, Height: Integer; PopupControl: TControl = nil; IsVertical: Boolean = False): TPoint; function SpHMenuGetCaption(Menu: HMenu; Index: Integer): WideString; function SpHMenuToTBMenuItem(Menu: HMenu; ParentItem: TTBCustomItem): Boolean; function SpShowSystemPopupMenu(ParentForm: TCustomForm; ScreenPos: TPoint; DoDefault: Boolean = True): Integer; function SpFillSystemSpTBXPopup(ParentForm: TCustomForm; ParentItem: TTBCustomItem; ShowSize, ShowMinimize, ShowMaximize, ShowClose: Boolean; ClickEvent: TNotifyEvent = nil): Boolean; function SpShowSystemSpTBXPopupMenu(ParentForm: TCustomForm; ScreenPos: TPoint; ShowSize, ShowMinimize, ShowMaximize, ShowClose: Boolean; PopupEvent: TSpTBXPopupEvent; DoDefault: Boolean = True): Integer; { Misc helpers } procedure SpActivateDwmNC(WinControl: TWinControl; Activate: Boolean); function SpIsDwmCompositionEnabled: Boolean; function SpCanFocus(WinControl: TWinControl): Boolean; function SpIsFocused(WinControl: TWinControl; out FocusedChild: TWinControl): Boolean; function SpFocusFirstChild(WinControl: TWinControl): TWinControl; function SpFindControl(Parent: TWinControl; Child: TControl): Integer; function SpFindParent(Control: TControl; ParentClass: TClass): TWinControl; function SpHasBorders(WinControl: TWinControl): Boolean; function SpGetFormWindowState(F: TCustomForm; out RestoreBoundsRect: TRect): TWindowState; procedure SpSetFormWindowState(F: TCustomForm; WindowState: TWindowState; RestoreBoundsRect: TRect); function SpGetTaskBar(out State, Edge: Cardinal; out Bounds: TRect): Boolean; procedure SpRecalcNCArea(WinControl: TWinControl); { Customizer helpers } procedure SpCustomizeAllToolbars(AParentComponent: TComponent; Reset: Boolean); procedure SpBeginUpdateAllToolbars(AParentComponent: TComponent); procedure SpEndUpdateAllToolbars(AParentComponent: TComponent); { Unicode helpers } procedure SpPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent); var SmCaptionFont: TFont; SpStockHintBitmap: TBitmap; MDIButtonsImgList: TImageList = nil; SpTBXHintWindowClass: THintWindowClass = TBitmapHint; const CDefaultToolbarBorderSize = 2; // Default size of Floating Toolbar borders crSpTBXNewHandPoint = 100; // Cursor ID to replace crHandPoint for IDC_HAND crSpTBXCustomization = 101; // Cursor ID used for item D&D customization accepted crSpTBXCustomizationCancel = 102; // Cursor ID used for item D&D customization cancelled implementation {$R SpTBXGlyphs.res} uses Themes, UxTheme, TypInfo, Types, ComCtrls, CommCtrl, ShellApi, {$IFDEF JR_D11} DwmApi, {$ENDIF} {$IFNDEF UNICODE} TntWindows, TntSysUtils, TntActnList, TntForms, {$ENDIF} TB2Anim, TB2Common; const ROP_DSPDxax = $00E20746; // Constants for TSpTBXToolWindow registry values. Do not localize! rvClientWidth = 'ClientWidth'; rvClientHeight = 'ClientHeight'; // ColorPalette constants: CPDefaultColors: array[0..CPDefaultCols * CPDefaultRows - 1] of TIdentMapEntry = ( (Value: $000000; Name: 'Black'), (Value: $003399; Name: 'Brown'), (Value: $003333; Name: 'Olive Green'), (Value: $003300; Name: 'Dark Green'), (Value: $663300; Name: 'Dark Teal'), (Value: $800000; Name: 'Dark blue'), (Value: $993333; Name: 'Indigo'), (Value: $333333; Name: 'Gray-80%'), (Value: $000080; Name: 'Dark Red'), (Value: $0066FF; Name: 'Orange'), (Value: $008080; Name: 'Dark Yellow'), (Value: $008000; Name: 'Green'), (Value: $808000; Name: 'Teal'), (Value: $FF0000; Name: 'Blue'), (Value: $996666; Name: 'Blue-Gray'), (Value: $808080; Name: 'Gray-50%'), (Value: $0000FF; Name: 'Red'), (Value: $0099FF; Name: 'Light Orange'), (Value: $00CC99; Name: 'Lime'), (Value: $669933; Name: 'Sea Green'), (Value: $CCCC33; Name: 'Aqua'), (Value: $FF6633; Name: 'Light Blue'), (Value: $800080; Name: 'Violet'), (Value: $969696; Name: 'Gray-40%'), (Value: $FF00FF; Name: 'Pink'), (Value: $00CCFF; Name: 'Gold'), (Value: $00FFFF; Name: 'Yellow'), (Value: $00FF00; Name: 'Bright Green'), (Value: $FFFF00; Name: 'Turquoise'), (Value: $FFCC00; Name: 'Sky Blue'), (Value: $663399; Name: 'Plum'), (Value: $C0C0C0; Name: 'Gray-25%'), (Value: $CC99FF; Name: 'Rose'), (Value: $99CCFF; Name: 'Tan'), (Value: $99FFFF; Name: 'Light Yellow'), (Value: $CCFFCC; Name: 'Light Green'), (Value: $FFFFCC; Name: 'Light Turquoise'), (Value: $FFCC99; Name: 'Pale Blue'), (Value: $FF99CC; Name: 'Lavender'), (Value: $FFFFFF; Name: 'White')); type TTBCustomItemAccess = class(TTBCustomItem); TTBItemViewerAccess = class(TTBItemViewer); TTBViewAccess = class(TTBView); TTBDockAccess = class(TTBDock); TTBCustomDockableWindowAccess = class(TTBCustomDockableWindow); TTBBasicBackgroundAccess = class(TTBBasicBackground); TControlAccess = class(TControl); TWinControlAccess = class(TWinControl); TCustomFormAccess = class(TCustomForm); TActionLinkAccess = class(TActionLink); //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { Item Helpers } procedure SpFillItemInfo(ACanvas: TCanvas; IV: TTBItemViewer; out ItemInfo: TSpTBXMenuItemInfo); var Item: TTBCustomItemAccess; View: TTBViewAccess; IsHoverItem, IsOpen, IsPushed: Boolean; IsSplit, IsComboPushed: Boolean; IsToolbarStyle, ImageIsShown: Boolean; ImgSize, RightImageSize: TSize; begin Item := TTBCustomItemAccess(IV.Item); View := TTBViewAccess(IV.View); if IV is TSpTBXItemViewer then IsToolbarStyle := TSpTBXItemViewer(IV).IsToolbarStyle else IsToolbarStyle := IV.IsToolbarStyle; IsOpen := IV = View.OpenViewer; IsHoverItem := IV = View.Selected; IsPushed := IsHoverItem and (IsOpen or (View.MouseOverSelected and View.Capture and IsToolbarStyle)); IsSplit := tbisCombo in Item.ItemStyle; IsComboPushed := IsSplit and IsPushed and not View.Capture; if IsComboPushed then IsPushed := False; ImgSize.cx := 0; ImgSize.cy := 0; RightImageSize.cx := 0; RightImageSize.cy := 0; ImageIsShown := False; if IV is TSpTBXItemViewer then begin if TSpTBXItemViewer(IV).GetImageShown then begin ImgSize := TSpTBXItemViewer(IV).GetImageSize; if (ImgSize.cx > 0) and (ImgSize.cy > 0) then ImageIsShown := True; end; RightImageSize := TSpTBXItemViewer(IV).GetRightImageSize; end; FillChar(ItemInfo, SizeOf(ItemInfo), 0); ItemInfo.Enabled := Item.Enabled or View.Customizing; ItemInfo.Pushed := IsPushed; ItemInfo.Checked := Item.Checked; ItemInfo.HotTrack := IsHoverItem; ItemInfo.ImageShown := ImageIsShown; ItemInfo.ImageOrCheckShown := ImageIsShown or (not IsToolbarStyle and Item.Checked); ItemInfo.ImageSize := ImgSize; ItemInfo.RightImageSize := RightImageSize; ItemInfo.IsDesigning := csDesigning in View.ComponentState; ItemInfo.IsOnMenuBar := vsMenuBar in View.Style; ItemInfo.IsVertical := (View.Orientation = tbvoVertical) and not IsSplit; ItemInfo.IsOnToolbox := False; if IV is TSpTBXItemViewer then ItemInfo.IsOnToolbox := TSpTBXItemViewer(IV).IsOnToolBoxPopup; ItemInfo.IsOpen := IsOpen; ItemInfo.IsSplit := IsSplit; ItemInfo.ComboRect := Rect(0, 0, 0, 0); // HasArrow = tboDropdownArrow or (Submenu and Combo) ItemInfo.HasArrow := (tboDropdownArrow in Item.Options) or ((tbisSubmenu in Item.ItemStyle) and (tbisCombo in Item.ItemStyle)); ItemInfo.ToolbarStyle := IsToolbarStyle; if ItemInfo.ToolbarStyle then begin if ItemInfo.HasArrow then ItemInfo.ComboPart := cpCombo; if ItemInfo.IsSplit then ItemInfo.ComboPart := cpSplitLeft; end else begin // Only for menu items if View.Window is TSpTBXPopupWindow then CurrentSkin.GetMenuItemMargins(ACanvas, TSpTBXPopupWindow(View.Window).MaximumImageSize.cx, ItemInfo.MenuMargins) else CurrentSkin.GetMenuItemMargins(ACanvas, ImgSize.cx, ItemInfo.MenuMargins); end; if tbisClicksTransparent in Item.ItemStyle then ItemInfo.State := CurrentSkin.GetState(ItemInfo.Enabled, False, False, False) else ItemInfo.State := CurrentSkin.GetState(ItemInfo.Enabled, ItemInfo.Pushed, ItemInfo.HotTrack, ItemInfo.Checked); ItemInfo.ComboState := sknsNormal; if IsSplit then begin ItemInfo.ComboState := ItemInfo.State; if IsComboPushed then ItemInfo.ComboState := sknsPushed else case ItemInfo.State of sknsPushed: ItemInfo.ComboState := sknsHotTrack; sknsChecked: ItemInfo.ComboState := sknsNormal; sknsCheckedAndHotTrack: ItemInfo.ComboState := sknsHotTrack; end; end; ItemInfo.SkinType := SkinManager.GetSkinType; // [Theme-Change] // The Default theme paints the caption of the pushed button in a down // state, this only happens when the Item is on a toolbar and: // 1) Windows themes are enabled and the item is not on a menubar // 2) Windows themes are disabled ItemInfo.IsSunkenCaption := False; if (ItemInfo.Pushed or ItemInfo.Checked) and ItemInfo.ToolbarStyle then ItemInfo.IsSunkenCaption := (not ItemInfo.IsOnMenuBar and (ItemInfo.SkinType = sknWindows)) or (ItemInfo.SkinType = sknNone); end; function SpGetBoundsRect(IV: TTBItemViewer; Root: TTBRootItem): TRect; // Returns the Bounds Rect of an ItemViewer. // If the ItemViewer is a GroupItemViewer then it returns the sum // of all the ItemViewers inside it. var G: TTBItemViewer; V: TTBView; I, J: Integer; R: TRect; FirstItemFound: Boolean; begin Result := Rect(0, 0, 0, 0); if Assigned(IV) then if IV.Item is TTBGroupItem then begin // Sum all the ItemViewers of the GroupItem V := IV.View; J := IV.Index + 1; FirstItemFound := False; for I := J to V.ViewerCount - 1 do begin G := V.Viewers[I]; if (G.Item.Parent = Root) then Break else if G.Item.Visible and not (G.Item is TTBGroupItem) then if not FirstItemFound then begin FirstItemFound := True; Result := G.BoundsRect; end else begin R := G.BoundsRect; Result.Left := Min(Result.Left, R.Left); Result.Top := Min(Result.Top, R.Top); Result.Right := Max(Result.Right, R.Right); Result.Bottom := Max(Result.Bottom, R.Bottom); end; end; end else Result := IV.BoundsRect; end; procedure SpGetAllItems(AParentItem: TTBCustomItem; ItemsList: TTntStringList; ClearFirst: Boolean = True); // Returns a StringList with all the items, subitems and linked items from AParentItem. // The ItemsList.Strings[] contains the items name // The ItemsList.Objects[] contains the items reference procedure Iterate(AParentItem: TTBCustomItem; LinkDepth: Integer); var I: Integer; NewParentItem, Item: TTBCustomItem; begin NewParentItem := AParentItem; if Assigned(NewParentItem.LinkSubitems) then begin NewParentItem := NewParentItem.LinkSubitems; Inc(LinkDepth); if LinkDepth > 25 then Exit; { prevent infinite link recursion } end; for I := 0 to NewParentItem.Count - 1 do begin Item := NewParentItem.Items[I]; ItemsList.AddObject(Item.Name, Item); Iterate(Item, LinkDepth); end; end; begin if ClearFirst then ItemsList.Clear; Iterate(AParentItem, 0); end; function SpGetMenuMaximumImageSize(View: TTBView): TSize; // Iterates the viewers and returns the maximum image size var I: Integer; IV: TTBItemViewer; IL: TCustomImageList; ImageShown: Boolean; begin Result.cx := 0; Result.cy := 0; for I := 0 to View.ViewerCount - 1 do begin IV := View.Viewers[I]; if IV is TSpTBXItemViewer then ImageShown := TSpTBXItemViewer(IV).GetImageShown else ImageShown := TTBItemViewerAccess(IV).ImageShown; if ImageShown then begin IL := TTBItemViewerAccess(IV).GetImageList; if Assigned(IL) then begin if IL.Width > Result.cx then Result.cx := IL.Width; if IL.Height > Result.cy then Result.cy := IL.Height; end; end; end; end; function SpGetItemViewerFromPoint(Root: TTBRootItem; View: TTBView; P: TPoint; ProcessGroupItems: Boolean = True): TTBItemViewer; // Returns the ItemViewer at the given position // If ProcessGroupItems is true and the ItemViewer is on a GroupItem return // the GroupItem's ItemViewer instead. var IV: TTBItemViewer; I, X: Integer; G: TTBItemViewer; begin Result := nil; if Assigned(Root) and Assigned(View) then begin IV := View.ViewerFromPoint(P); // If the Item is not on the Root it must be part of a GroupItem if ProcessGroupItems and Assigned(IV) and not (IV.Item is TTBChevronItem) and (IV.Item.Parent <> Root) then begin // Get the parent GroupItem ItemViewer X := IV.Index; for I := X downto 0 do begin G := IV.View.Viewers[I]; if G.Item is TTBGroupItem then begin Result := G; Break; end; end; end else Result := IV; end; end; function SpGetNextItemSameEdge(View: TTBView; IV: TTBItemViewer; GoForward: Boolean; SearchType: TSpTBXSearchItemViewerType): TTBItemViewer; // Returns the left or right Tab item depending on GoForward // SearchType can be: // sivtNormal: Normal search // sivtInmediate: Search for the inmediate ItemViewer // sivtInmediateSkipNonVisible: Search for the next inmediate ItemViewer, skipping non visible ones var Temp: TTBItemViewer; I: Integer; begin Result := nil; if IV = nil then Result := View.NextSelectable(nil, GoForward) else begin View.ValidatePositions; I := View.IndexOf(IV); while not Assigned(Result) do begin if GoForward then Inc(I) else Dec(I); if (I > View.ViewerCount - 1) or (I < 0) then Break else begin Temp := View.Viewers[I]; // Skip non visible items, search for same edge items if Temp.Item.Visible and (Temp.OffEdge = IV.OffEdge) and (Temp.BoundsRect.Top = IV.BoundsRect.Top) then begin Result := Temp; // Found IV Break; end else begin case SearchType of sivtInmediate: Break; // Inmediate not found, exit sivtInmediateSkipNonVisible: if Temp.Item.Visible then Break; // Inmediate not found and visible, exit end; end; end; end; end; end; function SpGetFirstRightAlignSpacer(View: TTBView): TSpTBXItemViewer; var I: Integer; IV: TTBItemViewer; begin Result := nil; for I := 0 to View.ViewerCount - 1 do begin IV := View.Viewers[I]; if IV.Item.Visible and (IV.Item is TSpTBXRightAlignSpacerItem) then Result := IV as TSpTBXItemViewer; end; end; function SpGetRightAlignedItems(View: TTBView; RightAlignedList: TList; IsRotated: Boolean; out VisibleTotalWidth, RightAlignedTotalWidth: Integer): TSpTBXItemViewer; function GetWidth(R: TRect): Integer; begin if IsRotated then Result := R.Bottom - R.Top else Result := R.Right - R.Left; end; var I: Integer; IV: TTBItemViewer; begin Result := nil; if Assigned(RightAlignedList) then RightAlignedList.Clear; VisibleTotalWidth := 0; RightAlignedTotalWidth := 0; for I := 0 to View.ViewerCount - 1 do begin IV := View.Viewers[I]; if IV.Item.Visible then VisibleTotalWidth := VisibleTotalWidth + GetWidth(IV.BoundsRect); if not Assigned(Result) and (IV.Item.Visible) and (IV.Item is TSpTBXRightAlignSpacerItem) then Result := IV as TSpTBXItemViewer; if Assigned(Result) then begin if Assigned(RightAlignedList) then RightAlignedList.Add(IV); RightAlignedTotalWidth := RightAlignedTotalWidth + GetWidth(IV.BoundsRect); end; end; end; procedure SpInvalidateItem(View: TTBView; Item: TTBCustomItem); var IV: TTBItemViewer; begin IV := View.Find(Item); if Assigned(IV) then View.Invalidate(IV); end; function SpFindItemViewer(View: TTBView; Item: TTBCustomItem): TTBItemViewer; var I: Integer; begin Result := nil; if Assigned(Item) then for I := 0 to View.ViewerCount - 1 do if View.Viewers[I].Item = Item then begin Result := View.Viewers[I]; Exit; end; end; function SpFindControlItem(Item: TTBCustomItem; Ctl: TControl; Recurse: Boolean): TTBControlItem; var I: Integer; begin Result := nil; for I := 0 to Item.Count - 1 do begin if Recurse and (Item[I] is TTBGroupItem) then begin Result := SpFindControlItem(Item[I], Ctl, True); if Assigned(Result) then Break; end; if (Item[I] is TTBControlItem) and (TTBControlItem(Item[I]).Control = Ctl) then begin Result := TTBControlItem(Item[I]); Break; end; end; end; procedure SpGetDropPosItemViewer(Root: TTBRootItem; View: TTBView; P: TPoint; out DestIV: TTBItemViewer; out DestItemPos: Integer; out DropMark: TRect); // Returns the ItemViewer and Item index at the given position for Drag & Drop // operations that needs a DropMark rect. // Use this when the items are dropped when the drag operation is finished. var DestR: TRect; const DropMarkSize = 4; begin DestItemPos := -1; DestIV := SpGetItemViewerFromPoint(Root, View, P); DropMark := Rect(0, 0, 0, 0); if Assigned(DestIV) then begin // Get the destination item position DestItemPos := Root.IndexOf(DestIV.Item); DestR := SpGetBoundsRect(DestIV, Root); if View.Orientation = tbvoVertical then begin if P.Y > ((DestR.Bottom - DestR.Top) div 2) + DestR.Top then begin Inc(DestItemPos); DropMark := Rect(0, DestR.Bottom, View.BaseSize.X, DestR.Bottom + DropMarkSize); end else DropMark := Rect(0, DestR.Top, View.BaseSize.X, DestR.Top + DropMarkSize); end else if P.X > ((DestR.Right - DestR.Left) div 2) + DestR.Left then begin Inc(DestItemPos); DropMark := Rect(DestR.Right, 0, DestR.Right + DropMarkSize, View.BaseSize.Y); end else DropMark := Rect(DestR.Left, 0, DestR.Left + DropMarkSize, View.BaseSize.Y); end; end; procedure SpGetDropPosItemViewer(Root: TTBRootItem; View: TTBView; P: TPoint; SourceItemPos: Integer; out DestIV: TTBItemViewer; out DestItemPos: Integer); // Returns the ItemViewer and Item index at the given position for inmediate // Drag & Drop operations without a DropMark. // Use this when the items are moved while the mouse is being dragged. var DestR: TRect; begin DestItemPos := -1; DestIV := SpGetItemViewerFromPoint(Root, View, P); if Assigned(DestIV) then begin // Get the destination item position DestItemPos := Root.IndexOf(DestIV.Item); DestR := SpGetBoundsRect(DestIV, Root); if View.Orientation = tbvoVertical then begin if P.Y > ((DestR.Bottom - DestR.Top) div 2) + DestR.Top then begin if DestItemPos - 1 <> SourceItemPos then Inc(DestItemPos); end else begin if DestItemPos - 1 = SourceItemPos then Dec(DestItemPos); end; end else if P.X > ((DestR.Right - DestR.Left) div 2) + DestR.Left then begin if DestItemPos - 1 <> SourceItemPos then Inc(DestItemPos); end else begin if DestItemPos - 1 = SourceItemPos then Dec(DestItemPos); end; end; end; function SpGetDragHandleSize(Toolbar: TTBCustomDockableWindow): Integer; const DragHandleSizes: array [Boolean, 0..2] of Integer = ((9, 0, 6), (14, 14, 14)); var T: TTBCustomDockableWindowAccess; begin Result := 0; if Assigned(Toolbar.CurrentDock) then if Toolbar.CurrentDock.AllowDrag then begin T := TTBCustomDockableWindowAccess(Toolbar); Result := DragHandleSizes[T.CloseButtonWhenDocked, Ord(T.DragHandleStyle)] end; end; function SpIsVerticalToolbar(Toolbar: TTBCustomDockableWindow): Boolean; begin if Assigned(Toolbar.CurrentDock) then Result := Toolbar.CurrentDock.Position in [dpLeft, dpRight] else Result := False; end; function SpIsDockUsingBitmap(Dock: TTBDock): Boolean; var Background: TTBBasicBackgroundAccess; begin Background := TTBBasicBackgroundAccess(Dock.Background); Result := Assigned(Background) and Background.UsingBackground; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { Painting helpers } procedure SpDrawXPToolbarButton(ACanvas: TCanvas; ARect: TRect; State: TSpTBXSkinStatesType; SkinType: TSpTBXSkinType; ComboPart: TSpTBXComboPart = cpNone); // Paints a toolbar button depending on the State and SkinType var Flags: Integer; ForceRectBorders: TAnchors; const XPPart: array [TSpTBXComboPart] of Integer = (TP_BUTTON, TP_DROPDOWNBUTTON, TP_SPLITBUTTON, TP_SPLITBUTTONDROPDOWN); begin case SkinType of sknNone: begin case State of sknsNormal, sknsDisabled: ; // Do nothing sknsHotTrack: Windows.DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_RECT); sknsPushed, sknsCheckedAndHotTrack: Windows.DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER, BF_RECT); sknsChecked: begin ACanvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);; ACanvas.Brush.Bitmap.HandleType := bmDDB; // Needed for Win95, or else brush is solid white ACanvas.FillRect(ARect); ACanvas.Brush.Style := bsClear; Windows.DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER, BF_RECT); end; end; end; sknWindows: begin Flags := TS_NORMAL; case State of sknsDisabled: Flags := TS_DISABLED; sknsHotTrack: Flags := TS_HOT; sknsPushed: Flags := TS_PRESSED; sknsChecked: Flags := TS_CHECKED; sknsCheckedAndHotTrack: Flags := TS_HOTCHECKED; end; DrawThemeBackground(ThemeServices.Theme[teToolBar], ACanvas.Handle, XPPart[ComboPart], Flags, ARect, nil); end; sknSkin: begin ForceRectBorders := []; if ComboPart = cpSplitLeft then ForceRectBorders := [akRight] else if ComboPart = cpSplitRight then ForceRectBorders := [akLeft]; CurrentSkin.PaintBackground(ACanvas, ARect, skncToolbarItem, State, True, True, False, ForceRectBorders); end; end; end; procedure SpDrawXPMenuItem(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo); // Paints a menu or toolbar item depending on the ItemInfo procedure ToolbarItemDraw(ARect: TRect); var ForceRectBorders: TAnchors; Flags: Integer; begin ForceRectBorders := []; if ItemInfo.IsSplit then if ItemInfo.ComboPart = cpSplitLeft then ForceRectBorders := [akRight] else if ItemInfo.ComboPart = cpSplitRight then ForceRectBorders := [akLeft]; case ItemInfo.SkinType of sknNone: begin if ItemInfo.Checked then if not ItemInfo.HotTrack or (not ItemInfo.Enabled and ItemInfo.ToolbarStyle) then ItemInfo.State := sknsChecked; // Paint Disabled&Checked as Checked if ItemInfo.State = sknsNormal then begin if ItemInfo.IsDesigning then Windows.DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_RECT); end else SpDrawXPToolbarButton(ACanvas, ARect, ItemInfo.State, ItemInfo.SkinType, ItemInfo.ComboPart); end; sknWindows: if ItemInfo.IsDesigning then SpDrawRectangle(ACanvas, ARect, 2, clBtnShadow, clBtnShadow, clNone, clNone, ForceRectBorders) else if ItemInfo.IsOnMenuBar then begin if SpIsWinVistaOrUp then begin // Use the new API on Windows Vista Flags := MBI_NORMAL; case ItemInfo.State of sknsDisabled: Flags := MBI_DISABLED; sknsHotTrack: Flags := MBI_HOT; sknsPushed: Flags := MBI_PUSHED; end; DrawThemeBackground(ThemeServices.Theme[teMenu], ACanvas.Handle, MENU_BARITEM, Flags, ARect, nil); end else if ItemInfo.State in [sknsHotTrack, sknsPushed, sknsChecked, sknsCheckedAndHotTrack] then SpFillRect(ACanvas, ARect, clHighlight); end else SpDrawXPToolbarButton(ACanvas, ARect, ItemInfo.State, ItemInfo.SkinType, ItemInfo.ComboPart); sknSkin: if ItemInfo.IsOpen and CurrentSkin.OfficePopup then begin // Paints skncOpenToolbarItem skin, hide the bottom border ARect.Bottom := ARect.Bottom + 2; CurrentSkin.PaintBackground(ACanvas, ARect, skncOpenToolbarItem, sknsNormal, True, True) end else if ItemInfo.IsDesigning then SpDrawRectangle(ACanvas, ARect, 2, clBtnShadow, clBtnShadow, clNone, clNone, ForceRectBorders) else if ItemInfo.IsOnMenuBar then CurrentSkin.PaintBackground(ACanvas, ARect, skncMenuBarItem, ItemInfo.State, True, True, False, ForceRectBorders) else SpDrawXPToolbarButton(ACanvas, ARect, ItemInfo.State, ItemInfo.SkinType, ItemInfo.ComboPart); end; end; procedure MenuItemDraw(ARect: TRect); var Flags: Integer; begin case ItemInfo.SkinType of sknNone: SpFillRect(ACanvas, ARect, clHighlight); sknWindows: if SpIsWinVistaOrUp then begin // Use the new API on Windows Vista if ItemInfo.Enabled then Flags := MPI_HOT else Flags := MPI_DISABLEDHOT; DrawThemeBackground(ThemeServices.Theme[teMenu], ACanvas.Handle, MENU_POPUPITEM, Flags, ARect, nil); end else SpFillRect(ACanvas, ARect, clHighlight); sknSkin: CurrentSkin.PaintBackground(ACanvas, ARect, skncMenuItem, sknsHotTrack, True, True); end; end; var R: TRect; DrawCheckBoxFrame: Boolean; C: TColor; SelectionDelta: Integer; Flags: Integer; begin if ItemInfo.ToolbarStyle then begin // Toolbar Item if ItemInfo.IsSplit then begin if ItemInfo.IsOpen and CurrentSkin.OfficePopup then begin // If it's Split, Open and OfficePopup paint the skncOpenToolbarItem skin ARect.Right := ItemInfo.ComboRect.Right; ToolbarItemDraw(ARect); end else begin // Draw the left side button if (ItemInfo.SkinType = sknSkin) or ItemInfo.IsDesigning then Inc(ARect.Right, 2); ItemInfo.ComboPart := cpSplitLeft; ToolbarItemDraw(ARect); // Draw the right side button ItemInfo.ComboPart := cpSplitRight; ItemInfo.State := ItemInfo.ComboState; ToolbarItemDraw(ItemInfo.ComboRect); end; end else ToolbarItemDraw(ARect); end else begin // Menu item // DrawCheckBoxFrame is true when the item is checked if (ItemInfo.SkinType = sknSkin) or (SpIsWinVistaOrUp and (ItemInfo.SkinType = sknWindows)) then DrawCheckBoxFrame := ItemInfo.Enabled and ItemInfo.Checked else begin if ItemInfo.SkinType = sknNone then DrawCheckBoxFrame := ItemInfo.Checked or ItemInfo.ImageOrCheckShown else DrawCheckBoxFrame := ItemInfo.Enabled and (ItemInfo.Checked or ItemInfo.ImageOrCheckShown); end; R := ARect; // Draw the item selection rectangle hottrack // Office doesn't draw the hottrack when the item is disabled, check // if OfficeMenu is set. if ItemInfo.Enabled or not CurrentSkin.OfficeMenu then if ItemInfo.HotTrack then begin if DrawCheckBoxFrame then begin SelectionDelta := 0; case ItemInfo.SkinType of sknNone: SelectionDelta := ItemInfo.MenuMargins.GutterSize + 1; // Don't draw the hottrack selection behind the checkbox sknWindows: if not SpIsWinVistaOrUp then SelectionDelta := ItemInfo.MenuMargins.GutterSize + 1; // Don't draw the hottrack selection behind the checkbox sknSkin: SelectionDelta := 3; // Don't draw the hottrack selection behind the checkbox left borders end; Inc(R.Left, SelectionDelta); end; MenuItemDraw(R); end; // Draw the checkbox frame (the checkbox glyph is painted in the ItemViewer.Paint method) if DrawCheckBoxFrame then begin R := ARect; R.Right := R.Left + ItemInfo.MenuMargins.GutterSize; if SpIsWinVistaOrUp and (ItemInfo.SkinType = sknWindows) then begin // Use the new API on Windows Vista // The checkbox frame is not painted if ItemInfo.State = sknsDisabled then Flags := MCB_DISABLED else if ItemInfo.ImageShown then Flags := MCB_BITMAP else Flags := MCB_NORMAL; DrawThemeBackground(ThemeServices.Theme[teMenu], ACanvas.Handle, MENU_POPUPCHECKBACKGROUND, Flags, R, nil); end else if ItemInfo.SkinType = sknSkin then CurrentSkin.PaintBackground(ACanvas, R, skncMenuItem, ItemInfo.State, True, True) else ToolbarItemDraw(R); end; // Draw the combo item separator if ItemInfo.IsSplit then begin if ItemInfo.SkinType = sknSkin then begin C := SkinManager.CurrentSkin.Options(skncMenuItem, ItemInfo.State).Borders.Color1; if C = clNone then C := clBtnShadow; end else C := clBtnShadow; R := ARect; R.Left := ARect.Right - 10 - 4; SpDrawLine(ACanvas, R.Left, R.Top + 1, R.Left, R.Bottom - 1, C); end; end; end; procedure SpDrawXPMenuSeparator(ACanvas: TCanvas; ARect: TRect; MenuItemStyle, Vertical: Boolean); const ToolbarXPFlags: array [Boolean] of Integer = (TP_SEPARATORVERT, TP_SEPARATOR); var R: TRect; C: TColor; D: Integer; VistaSeparatorSize: tagSize; begin R := ARect; case SkinManager.GetSkinType of sknNone: if not Vertical then begin R.Top := (R.Top + R.Bottom) div 2 - 1; DrawEdge(ACanvas.Handle, R, EDGE_ETCHED, BF_TOP); end else begin R.Left := (R.Left + R.Right) div 2 - 1; DrawEdge(ACanvas.Handle, R, EDGE_ETCHED, BF_LEFT); end; sknWindows: if MenuItemStyle and SpIsWinVistaOrUp then begin // Use the new API in Windows Vista GetThemePartSize(ThemeServices.Theme[teMenu], 0, MENU_POPUPSEPARATOR, 0, nil, TS_TRUE, VistaSeparatorSize); R := SpCenterRectVert(R, VistaSeparatorSize.cy); DrawThemeBackground(ThemeServices.Theme[teMenu], ACanvas.Handle, MENU_POPUPSEPARATOR, 0, R, nil); end else begin if MenuItemStyle then begin D := 0; if Vertical then begin R.Left := (R.Left + R.Right) div 2 - 1; Inc(R.Top, D); Dec(R.Bottom, D); Windows.DrawEdge(ACanvas.Handle, R, EDGE_ETCHED, BF_LEFT); end else begin R.Top := (R.Top + R.Bottom) div 2 - 1; Inc(R.Left, D); Dec(R.Right, D); Windows.DrawEdge(ACanvas.Handle, R, EDGE_ETCHED, BF_TOP); end; end else DrawThemeBackground(ThemeServices.Theme[teToolbar], ACanvas.Handle, ToolbarXPFlags[Vertical], TS_NORMAL, R, nil); end; sknSkin: if not Vertical then begin // ??? what happens when 2 items have different imagelist sizes? how is the gutter measured? R.Top := (R.Bottom + R.Top) div 2 - 1; R.Bottom := R.Top; C := SkinManager.CurrentSkin.Options(skncSeparator, sknsNormal).Body.Color1; SpDrawLine(ACanvas, R.Left, R.Top, R.Right, R.Bottom, C); OffsetRect(R, 0, 1); C := SkinManager.CurrentSkin.Options(skncSeparator, sknsNormal).Body.Color2; SpDrawLine(ACanvas, R.Left, R.Top, R.Right, R.Bottom, C); end else begin R.Left := (R.Right + R.Left) div 2 - 1; R.Right := R.Left; InflateRect(R, 0, -3); C := SkinManager.CurrentSkin.Options(skncSeparator, sknsNormal).Body.Color1; SpDrawLine(ACanvas, R.Left, R.Top, R.Right, R.Bottom, C); OffsetRect(R, 1, 0); C := SkinManager.CurrentSkin.Options(skncSeparator, sknsNormal).Body.Color2; SpDrawLine(ACanvas, R.Left, R.Top, R.Right, R.Bottom, C); end; end; end; procedure SpDrawXPMenuItemImage(ACanvas: TCanvas; ARect: TRect; const ItemInfo: TSpTBXMenuItemInfo; ImageList: TCustomImageList; ImageIndex: Integer); begin if ImageList is TTBCustomImageList then begin if ItemInfo.IsSunkenCaption then OffsetRect(ARect, 1, 1); TTBCustomImageList(ImageList).DrawState(ACanvas, ARect.Left, ARect.Top, ImageIndex, ItemInfo.Enabled, ItemInfo.HotTrack, ItemInfo.Checked); Exit; end; if ItemInfo.Enabled and SkinManager.CurrentSkin.OfficeIcons then begin // Draw icon shadow if ItemInfo.HotTrack and not ItemInfo.Pushed then begin OffsetRect(ARect, 1, 1); SpDrawIconShadow(ACanvas, ARect, ImageList, ImageIndex); OffsetRect(ARect, -2, -2); end; SpDrawImageList(ACanvas, ARect, ImageList, ImageIndex, ItemInfo.Enabled, True); end else begin if ItemInfo.IsSunkenCaption then OffsetRect(ARect, 1, 1); SpDrawImageList(ACanvas, ARect, ImageList, ImageIndex, ItemInfo.Enabled, True); end; end; procedure SpDrawXPMenuGutter(ACanvas: TCanvas; ARect: TRect; SkinType: TSpTBXSkinType); var Op: TSpTBXSkinOptionCategory; C: TColor; begin SkinType := SpTBXSkinType(SkinType); // If it's Windows theme and we're not on Vista do default painting if (SkinType = sknWindows) and not SpIsWinVistaOrUp then SkinType := sknNone; case SkinType of sknNone:; // No gutter on Windows 9x, 2000 sknWindows: begin // Only Windows Vista painting, XP just fills the background if SpIsWinVistaOrUp then DrawThemeBackground(ThemeServices.Theme[teMenu], ACanvas.Handle, MENU_POPUPGUTTER, 0, ARect, nil); end; sknSkin: begin Op := CurrentSkin.Options(skncGutter, sknsNormal); if not Op.Body.IsEmpty then SpPaintSkinBackground(ACanvas, ARect, Op, False); // Paint only the right side border, like a Separator line ARect.Left := ARect.Right; C := Op.Borders.Color2; if C <> clNone then begin SpDrawLine(ACanvas, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, C); OffsetRect(ARect, -1, 0); end; C := Op.Borders.Color1; if C <> clNone then SpDrawLine(ACanvas, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, C); end; end; end; procedure SpDrawXPMenuPopupWindow(ACanvas: TCanvas; ARect, OpenIVRect: TRect; DrawGutter: Boolean; ImageSize: Integer; SkinType: TSpTBXSkinType); var GutterR: TRect; MarginsInfo: TSpTBXMenuItemMarginsInfo; SaveIndex: Integer; begin SkinType := SpTBXSkinType(SkinType); // If it's Windows theme and we're not on Vista do default painting if (SkinType = sknWindows) and not SpIsWinVistaOrUp then SkinType := sknNone; case SkinType of sknNone: // Windows 9x, 2000 and XP if not AreFlatMenusEnabled then begin DrawEdge(ACanvas.Handle, ARect, EDGE_RAISED, BF_RECT or BF_ADJUST); SpFillRect(ACanvas, ARect, clBtnFace); end else SpFillRect(ACanvas, ARect, clMenu, clBtnShadow); sknWindows: // Only Windows Vista painting, XP just fills the background begin // Use the new API in Windows Vista DrawThemeBackground(ThemeServices.Theme[teMenu], ACanvas.Handle, MENU_POPUPBACKGROUND, 0, ARect, nil); // Now paint the borders, clip the background SaveIndex := SaveDC(ACanvas.Handle); try ExcludeClipRect(ACanvas.Handle, ARect.Left + 2, ARect.Top + 2, ARect.Right - 2, ARect.Bottom - 2); DrawThemeBackground(ThemeServices.Theme[teMenu], ACanvas.Handle, MENU_POPUPBORDERS, 0, ARect, nil); finally RestoreDC(ACanvas.Handle, SaveIndex); end; // Paint the gutter if DrawGutter then begin CurrentSkin.GetMenuItemMargins(ACanvas, ImageSize, MarginsInfo); GutterR := ARect; InflateRect(GutterR, -1, -4); GutterR.Right := GutterR.Left + MarginsInfo.GutterSize + MarginsInfo.LeftCaptionMargin + 1 + 4; // +1 because the popup has 2 pixel border, and +4 gutter separator has 4 pixel spacing SpDrawXPMenuGutter(ACanvas, GutterR, SkinType); end; end; sknSkin: begin // Paint the background, if OfficePopup is true just clip the top // border corresponding to the Open ItemViewer Rect if OpenIVRect.Top < 0 then begin OpenIVRect.Top := ARect.Top; OpenIVRect.Bottom := ARect.Top + 1; InflateRect(OpenIVRect, -1, 0); // First paint the background CurrentSkin.PaintBackground(ACanvas, ARect, skncPopup, sknsNormal, True, False); // Now paint the borders, clip the top border SaveIndex := SaveDC(ACanvas.Handle); try ExcludeClipRect(ACanvas.Handle, OpenIVRect.Left, OpenIVRect.Top, OpenIVRect.Right, OpenIVRect.Bottom); CurrentSkin.PaintBackground(ACanvas, ARect, skncPopup, sknsNormal, False, True); finally RestoreDC(ACanvas.Handle, SaveIndex); end; end else CurrentSkin.PaintBackground(ACanvas, ARect, skncPopup, sknsNormal, True, True); // Paint the gutter if DrawGutter and not CurrentSkin.Options(skncGutter, sknsNormal).IsEmpty then begin if ImageSize <= 0 then ImageSize := 16; CurrentSkin.GetMenuItemMargins(ACanvas, ImageSize, MarginsInfo); GutterR := ARect; InflateRect(GutterR, -1, -1); GutterR.Right := GutterR.Left + MarginsInfo.GutterSize + MarginsInfo.LeftCaptionMargin + 1; // +1 because the popup has 2 pixel border SpDrawXPMenuGutter(ACanvas, GutterR, SkinType); end; end; end; end; procedure SpDrawXPStatusBar(ACanvas: TCanvas; ARect, AGripRect: TRect; SkinType: TSpTBXSkinType); var R: TRect; C1, C2: TColor; begin case SpTBXSkinType(SkinType) of sknNone: begin if not IsRectEmpty(ARect) then begin SpFillRect(ACanvas, ARect, clBtnFace); SpDrawRectangle(ACanvas, ARect, 0, clBtnShadow, clWindow); end; if not IsRectEmpty(AGripRect) then begin InflateRect(AGripRect, 0, -1); DrawFrameControl(ACanvas.Handle, AGripRect, DFC_SCROLL, DFCS_SCROLLSIZEGRIP); end; end; sknWindows: begin if not IsRectEmpty(ARect) then DrawThemeBackground(ThemeServices.Theme[teStatus], ACanvas.Handle, 0, 0, ARect, nil); if not IsRectEmpty(AGripRect) then DrawThemeBackground(ThemeServices.Theme[teStatus], ACanvas.Handle, SP_GRIPPER, 0, AGripRect, nil) end; sknSkin: begin if not IsRectEmpty(ARect) then CurrentSkin.PaintBackground(ACanvas, ARect, skncStatusBar, sknsNormal, True, True); if not IsRectEmpty(AGripRect) then begin R := AGripRect; C1 := SkinManager.CurrentSkin.Options(skncStatusBarGrip).Body.Color1; C2 := SkinManager.CurrentSkin.Options(skncStatusBarGrip).Body.Color2; // Draw 3 cells at the bottom R.Left := R.Right - 12; R.Top := R.Bottom - 4; SpDrawXPGrip(ACanvas, R, C1, C2); // Draw 2 cells at the top R.Bottom := R.Top; R.Top := R.Bottom - 4; R.Left := R.Left + 4; SpDrawXPGrip(ACanvas, R, C1, C2); // Draw 1 cell at the top R.Bottom := R.Top; R.Top := R.Bottom - 4; R.Left := R.Left + 4; SpDrawXPGrip(ACanvas, R, C1, C2); end; end; end; end; procedure SpDrawXPTitleBar(ACanvas: TCanvas; ARect: TRect; IsActive: Boolean; DrawBorders: Boolean = True); const XpFlags: array [Boolean] of Integer = (FS_INACTIVE, FS_ACTIVE); W9xFlags: array [Boolean] of Integer = (0, DC_ACTIVE); W9xGradientFlag: array [Boolean] of Integer = (0, DC_GRADIENT); var Gradient: Boolean; B: BOOL; begin case SkinManager.GetSkinType of sknNone: begin Gradient := SystemParametersInfo(SPI_GETGRADIENTCAPTIONS, 0, @B, 0) and B; Windows.DrawCaption(GetDesktopWindow, ACanvas.Handle, ARect, DC_TEXT or W9xFlags[IsActive] or W9xGradientFlag[Gradient]); end; sknWindows: // If WP_CAPTION is used instead of WP_SMALLCAPTION the top borders are rounded DrawThemeBackground(ThemeServices.Theme[teWindow], ACanvas.Handle, WP_SMALLCAPTION, XpFlags[IsActive], ARect, nil); sknSkin: CurrentSkin.PaintBackground(ACanvas, ARect, skncWindowTitleBar, sknsNormal, True, DrawBorders); end; end; procedure SpDrawXPTitleBarBody(ACanvas: TCanvas; ARect: TRect; IsActive: Boolean; BorderSize: TPoint; DrawBody: Boolean = True); var R, MirrorR: TRect; SaveIndex, Flags: Integer; B: TBitmap; begin case SkinManager.GetSkinType of sknNone: begin if DrawBody then ACanvas.FillRect(ARect); SaveIndex := SaveDC(ACanvas.Handle); try R := ARect; InflateRect(R, -BorderSize.X, -BorderSize.Y); ExcludeClipRect(ACanvas.Handle, R.Left, R.Top, R.Right, R.Bottom); if not DrawBody then ACanvas.FillRect(ARect); Windows.DrawEdge(ACanvas.Handle, ARect, EDGE_RAISED, BF_RECT); finally RestoreDC(ACanvas.Handle, SaveIndex); end; end; sknWindows: begin if IsActive then Flags := FS_ACTIVE else Flags := FS_INACTIVE; R := ARect; R.Top := R.Bottom - BorderSize.Y; DrawThemeBackground(ThemeServices.Theme[teWindow], ACanvas.Handle, WP_SMALLFRAMEBOTTOM, Flags, R, nil); R.Top := ARect.Top + BorderSize.Y; R.Bottom := ARect.Bottom - BorderSize.Y; R.Right := R.Left + BorderSize.X; DrawThemeBackground(ThemeServices.Theme[teWindow], ACanvas.Handle, WP_SMALLFRAMELEFT, Flags, R, nil); R.Right := ARect.Right; R.Left := R.Right - BorderSize.X; DrawThemeBackground(ThemeServices.Theme[teWindow], ACanvas.Handle, WP_SMALLFRAMERIGHT, Flags, R, nil); // Don't know how to paint a captionless window frame // We have to mirror the bottom frame and paint it on the top B := TBitmap.Create; try R := ARect; R.Bottom := R.Top + BorderSize.Y; B.Width := R.Right - R.Left; B.Height := R.Bottom - R.Top; DrawThemeBackground(ThemeServices.Theme[teWindow], B.Canvas.Handle, WP_SMALLFRAMEBOTTOM, Flags, R, nil); // Mirror MirrorR := Rect(0, B.Height - 1, B.Width, -1); ACanvas.CopyRect(R, B.Canvas, MirrorR); finally B.Free; end; end; sknSkin: begin CurrentSkin.PaintWindowFrame(ACanvas, ARect, IsActive, DrawBody, BorderSize.X); end; end; end; procedure SpDrawXPDock(ACanvas: TCanvas; ARect: TRect; SkinType: TSpTBXSkinType; Vertical: Boolean = False); begin SkinType := SpTBXSkinType(SkinType); case SkinType of sknNone: begin ACanvas.Brush.Color := clBtnFace; ACanvas.FillRect(ARect); end; sknWindows: begin if Vertical then Inc(ARect.Bottom, 1); // Fix WindowsXP bug DrawThemeBackground(ThemeServices.Theme[teRebar], ACanvas.Handle, 0, 0, ARect, nil); end; sknSkin: CurrentSkin.PaintBackground(ACanvas, ARect, skncDock, sknsNormal, True, True, Vertical); end; end; procedure SpDrawXPToolbar(ACanvas: TCanvas; ARect: TRect; SkinType: TSpTBXSkinType; Docked, Floating, Vertical, PaintSkinBackground, PaintBorders: Boolean; SkinComponent: TSpTBXSkinComponentsType = skncToolbar); begin SkinType := SpTBXSkinType(SkinType); case SkinType of sknNone: if PaintBorders and Docked then Windows.DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_RECT or BF_ADJUST); sknWindows: if PaintBorders and Docked then SpDrawRectangle(ACanvas, ARect, 0, SpLighten(clBtnFace, 24), SpLighten(clBtnFace, -32)); sknSkin: if Docked or Floating then begin if Floating and CurrentSkin.Options(SkinComponent, sknsNormal).Body.IsEmpty then // Floating and doesn't have a Body CurrentSkin.PaintBackground(ACanvas, ARect, skncDock, sknsNormal, True, False) else begin if Floating then PaintBorders := False; CurrentSkin.PaintBackground(ACanvas, ARect, SkinComponent, sknsNormal, PaintSkinBackground, PaintBorders, Vertical); end; end; end; end; procedure SpDrawXPToolbar(W: TTBCustomDockableWindow; ACanvas: TCanvas; ARect: TRect; PaintOnNCArea: Boolean; PaintBorders: Boolean = True; SkinComponent: TSpTBXSkinComponentsType = skncToolbar); var R: TRect; PaintDefault, DrawSkinBody: Boolean; Toolbar: TTBCustomDockableWindowAccess; IsVertical: Boolean; begin if CurrentSkin.Options(SkinComponent, sknsNormal).Body.IsEmpty then SkinComponent := skncToolbar; Toolbar := TTBCustomDockableWindowAccess(W); IsVertical := SpIsVerticalToolbar(Toolbar); DrawSkinBody := True; if Toolbar.Docked then begin // Prepare R R := Toolbar.CurrentDock.ClientRect; OffsetRect(R, -Toolbar.Left, -Toolbar.Top); if not PaintOnNCArea then begin if W is TSpTBXToolbar then OffsetRect(R, -TSpTBXToolbar(W).DefaultToolbarBorderSize, -TSpTBXToolbar(W).DefaultToolbarBorderSize) else OffsetRect(R, -CDefaultToolbarBorderSize, -CDefaultToolbarBorderSize); if IsVertical then Dec(R.Top, SpGetDragHandleSize(Toolbar)) else Dec(R.Left, SpGetDragHandleSize(Toolbar)); end; // Draw the Dock background if Toolbar.CurrentDock is TSpTBXDock then TSpTBXDock(Toolbar.CurrentDock).DrawBackground(ACanvas.Handle, R); DrawSkinBody := not (Toolbar.CurrentDock.BackgroundOnToolbars and SpIsDockUsingBitmap(Toolbar.CurrentDock)); end else begin if Toolbar.Floating then begin if SkinManager.GetSkinType <> sknSkin then begin if Toolbar.Color = clNone then ACanvas.Brush.Color := clBtnFace else ACanvas.Brush.Color := Toolbar.Color; ACanvas.FillRect(ARect); end; end else begin // Draw the parent background if the toolbar is not docked nor floating // SpDrawParentBackground doesn't seem to work correctly here // (when a toolbar is inside a toolwindow), use PerformEraseBackground instead Controls.PerformEraseBackground(Toolbar, ACanvas.Handle); end; end; // Default painting PaintDefault := True; if W is TSpTBXToolbar then begin if TSpTBXToolbar(W).MenuBar then SkinComponent := skncMenuBar; TSpTBXToolbar(W).DoDrawBackground(ACanvas, ARect, pstPrePaint, PaintDefault); end else if W is TSpTBXCustomToolWindow then TSpTBXCustomToolWindow(W).DoDrawBackground(ACanvas, ARect, pstPrePaint, PaintDefault); if PaintDefault then begin R := ARect; if Toolbar.Color <> clNone then begin ACanvas.Brush.Color := Toolbar.Color; ACanvas.FillRect(R); end else SpDrawXPToolbar(ACanvas, R, SkinManager.GetSkinType, Toolbar.Docked, Toolbar.Floating, IsVertical, DrawSkinBody, PaintBorders, SkinComponent); end; PaintDefault := True; if W is TSpTBXToolbar then TSpTBXToolbar(W).DoDrawBackground(ACanvas, ARect, pstPostPaint, PaintDefault) else if W is TSpTBXCustomToolWindow then TSpTBXCustomToolWindow(W).DoDrawBackground(ACanvas, ARect, pstPostPaint, PaintDefault); end; procedure SpDrawXPToolbarGrip(W: TTBCustomDockableWindow; ACanvas: TCanvas; ARect: TRect); const GripperPart: array [Boolean] of Cardinal = (RP_GRIPPER, RP_GRIPPERVERT); Pattern: array [0..15] of Byte = (0, 0, $CC, 0, $78, 0, $30, 0, $78, 0, $CC, 0, 0, 0, 0, 0); var GripR, CloseR: TRect; GripSize, Z: Integer; Vertical: Boolean; C1, C2, PatternColor: TColor; Flags: Integer; Toolbar: TTBCustomDockableWindowAccess; State: TSpTBXSkinStatesType; begin Toolbar := TTBCustomDockableWindowAccess(W); GripSize := SpGetDragHandleSize(Toolbar); if GripSize <= 0 then Exit; Vertical := SpIsVerticalToolbar(Toolbar); GripR := ARect; if Vertical then begin GripR.Bottom := GripR.Top + GripSize; InflateRect(GripR, -2, 0); end else begin GripR.Right := GripR.Left + GripSize; InflateRect(GripR, 0, -2); end; if Toolbar.DragHandleStyle <> dhNone then begin if Toolbar.CloseButtonWhenDocked then begin if Vertical then begin CloseR.Left := ARect.Right - GripSize; CloseR.Right := CloseR.Left + GripSize - 2; CloseR.Top := ARect.Top + 2; CloseR.Bottom := CloseR.Top + GripSize - 2; Dec(GripR.Right, GripSize - 1); end else begin CloseR.Left := ARect.Left + 2; CloseR.Right := CloseR.Left + GripSize - 2; CloseR.Top := ARect.Top + 2; CloseR.Bottom := CloseR.Top + GripSize - 2; Inc(GripR.Top, GripSize - 1); end; end; case SkinManager.GetSkinType of sknNone: begin OffsetRect(CloseR, -1, -1); if Vertical then begin if Toolbar.CloseButtonWhenDocked then if Toolbar.DragHandleStyle = dhDouble then Inc(GripR.Top, 1) else Inc(GripR.Top, 3); Inc(GripR.Top, 3); GripR.Bottom := GripR.Top + 3; end else begin if Toolbar.CloseButtonWhenDocked then if Toolbar.DragHandleStyle = dhDouble then Inc(GripR.Left, 1) else Inc(GripR.Left, 3); Inc(GripR.Left, 3); GripR.Right := GripR.Left + 3; end; Windows.DrawEdge(ACanvas.Handle, GripR, BDR_RAISEDINNER, BF_RECT); ACanvas.Pixels[GripR.Left, GripR.Bottom - 1] := clBtnHighlight; if Toolbar.DragHandleStyle = dhDouble then begin if Vertical then OffsetRect(GripR, 0, 3) else OffsetRect(GripR, 3, 0); Windows.DrawEdge(ACanvas.Handle, GripR, BDR_RAISEDINNER, BF_RECT); ACanvas.Pixels[GripR.Left, GripR.Bottom - 1] := clBtnHighlight; end; // Close button if Toolbar.CloseButtonWhenDocked then begin if Toolbar.CloseButtonDown then Windows.DrawEdge(ACanvas.Handle, CloseR, BDR_SUNKENOUTER, BF_RECT) else if Toolbar. CloseButtonHover then Windows.DrawEdge(ACanvas.Handle, CloseR, BDR_RAISEDINNER, BF_RECT); if Toolbar.CloseButtonDown then OffsetRect(CloseR, 1, 1); SpDrawGlyphPattern(ACanvas.Handle, CloseR, 7, 7, Pattern[0], clBtnText); end; end; sknWindows: begin // Since GetThemePartSize does not seem to work properly, assume we use default // WindowsXP themes where the gripper pattern repeats itself every 4 pixels if Vertical then begin OffsetRect(GripR, -1, 0); GripR := SpCenterRectVert(GripR, 6); Z := GripR.Right - GripR.Left; GripR.Left := GripR.Left - 1 + (Z and $3) shr 1; GripR.Right := GripR.Left + Z and not $3 + 2; end else begin OffsetRect(GripR, 0, -1); GripR := SpCenterRectHoriz(GripR, 6); Z := GripR.Bottom - GripR.Top; GripR.Top := GripR.Top - 1 + (Z and $3) shr 1; GripR.Bottom := GripR.Top + Z and not $3 + 1; end; DrawThemeBackground(ThemeServices.Theme[teRebar], ACanvas.Handle, GripperPart[Vertical], 0, GripR, nil); // Close button if Toolbar.CloseButtonWhenDocked then begin Flags := TS_NORMAL; if Toolbar.CloseButtonDown then Flags := TS_PRESSED else if Toolbar.CloseButtonHover then Flags := TS_HOT; DrawThemeBackground(ThemeServices.Theme[teToolbar], ACanvas.Handle, TP_BUTTON, Flags, CloseR, nil); if Toolbar.CloseButtonDown then OffsetRect(CloseR, 1, 1); SpDrawGlyphPattern(ACanvas.Handle, CloseR, 7, 7, Pattern[0], clBtnText); end; end; sknSkin: begin if Vertical then begin InflateRect(GripR, -3, 0); OffsetRect(GripR, 0, 2); GripR := SpCenterRectVert(GripR, 4); end else begin InflateRect(GripR, 0, -3); OffsetRect(GripR, 2, 0); GripR := SpCenterRectHoriz(GripR, 4); end; C1 := SkinManager.CurrentSkin.Options(skncToolbarGrip).Body.Color1; C2 := SkinManager.CurrentSkin.Options(skncToolbarGrip).Body.Color2; SpDrawXPGrip(ACanvas, GripR, C1, C2); // Close button if Toolbar.CloseButtonWhenDocked then begin State := sknsNormal; if Toolbar.CloseButtonDown then State := sknsPushed else if Toolbar.CloseButtonHover then State := sknsHotTrack; CurrentSkin.PaintBackground(ACanvas, CloseR, skncToolbarItem, State, True, True); if Toolbar.CloseButtonDown then OffsetRect(CloseR, 1, 1); PatternColor := CurrentSkin.GetTextColor(skncToolbarItem, State); SpDrawGlyphPattern(ACanvas.Handle, CloseR, 7, 7, Pattern[0], PatternColor); end; end; end; end; end; procedure SpDrawXPTooltipBackground(ACanvas: TCanvas; ARect: TRect); var ClipRect: TRect; begin if SpIsWinVistaOrUp and ThemeServices.ThemesEnabled then begin // Paint Vista gradient background if themes enabled ClipRect := ARect; InflateRect(ARect, 4, 4); DrawThemeBackground(ThemeServices.Theme[teToolTip], ACanvas.Handle, TTP_STANDARD, TTSS_NORMAL, ARect, @ClipRect); end else ACanvas.FillRect(ARect); end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { Menu helpers } function SpCalcPopupPosition(const X, Y, Width, Height: Integer; PopupControl: TControl = nil; IsVertical: Boolean = False): TPoint; var R, MonitorR: TRect; begin if Assigned(PopupControl) then begin Result := Point(0, 0); if PopupControl.Parent = nil then Exit; R := PopupControl.BoundsRect; R.TopLeft := PopupControl.Parent.ClientToScreen(R.TopLeft); R.BottomRight := PopupControl.Parent.ClientToScreen(R.BottomRight); if IsVertical then Result := Point(R.Right, R.Top) else Result := Point(R.Left, R.Bottom); MonitorR := GetRectOfMonitorContainingPoint(Result, True); if IsVertical then begin if Result.X + Width > MonitorR.Right then Result.X := R.Left - Width; if Result.Y + Height > MonitorR.Bottom then if R.Bottom > MonitorR.Bottom then Result.Y := MonitorR.Bottom - Height else Result.Y := R.Bottom - Height; end else begin if Result.X + Width > MonitorR.Right then if R.Right > MonitorR.Right then Result.X := MonitorR.Right - Width else Result.X := R.Right - Width; if Result.Y + Height > MonitorR.Bottom then Result.Y := R.Top - Height; end; end else begin Result := Point(X, Y); MonitorR := GetRectOfMonitorContainingPoint(Result, True); if X + Width > MonitorR.Right then Result.X := X - Width; if Y + Height > MonitorR.Bottom then Result.Y := Y - Height; end; end; function SpHMenuGetCaption(Menu: HMenu; Index: Integer): WideString; var AnsiBuf: array[0..MAX_PATH] of AnsiChar; WideBuf: array[0..MAX_PATH] of WideChar; Size: Integer; begin Result := ''; if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then begin FillChar(AnsiBuf, MAX_PATH, #0); GetMenuStringA(Menu, Index, @AnsiBuf, MAX_PATH, MF_BYPOSITION); Size := lstrlenA(@AnsiBuf); Result := WideString(AnsiBuf); SetLength(Result, Size); end else begin // [Bugfix] Windows bug: // GetMenuStringW when a DBCS code page is active (e.g. Japanese) // the result of the function is incorrect (it returns Size * 2) // http://news.jrsoftware.org/read/article.php?id=12268&group=jrsoftware.toolbar2000.thirdparty FillChar(WideBuf, MAX_PATH, #0); GetMenuStringW(Menu, Index, @WideBuf, MAX_PATH, MF_BYPOSITION); Size := lstrlenW(@WideBuf); Result := WideBuf; SetLength(Result, Size); end; end; function SpHMenuToTBMenuItem(Menu: HMenu; ParentItem: TTBCustomItem): Boolean; var MenuInfo: TMenuItemInfo; I, C: Integer; Item: TSpTBXItem; HasSubMenu: Boolean; begin Result := False; if not Assigned(ParentItem) or not IsMenu(Menu) then Exit; C := GetMenuItemCount(Menu); for I := 0 to C - 1 do begin FillChar(MenuInfo, SizeOf(MenuInfo), #0); MenuInfo.cbSize := SizeOf(MenuInfo); MenuInfo.fMask := MIIM_TYPE or MIIM_STATE or MIIM_ID or MIIM_SUBMENU; GetMenuItemInfo(Menu, I, True, MenuInfo); if MenuInfo.fType and MFT_SEPARATOR <> 0 then ParentItem.Add(TSpTBXSeparatorItem.Create(nil)) else begin HasSubmenu := IsMenu(MenuInfo.hSubMenu); if HasSubmenu then Item := TSpTBXSubmenuItem.Create(nil) else Item := TSpTBXItem.Create(nil); Item.Caption := SpHMenuGetCaption(Menu, I); Item.Tag := MenuInfo.wID; if MenuInfo.fState and MFS_DISABLED <> 0 then Item.Enabled := False; if MenuInfo.fState and MFS_CHECKED <> 0 then Item.Checked := True; if MenuInfo.fState and MFS_DEFAULT <> 0 then Item.Options := Item.Options + [tboDefault]; ParentItem.Add(Item); end; end; Result := True; end; function SpShowSystemPopupMenu(ParentForm: TCustomForm; ScreenPos: TPoint; DoDefault: Boolean = True): Integer; var SysMenu: HMENU; begin ReleaseCapture; SysMenu := GetSystemMenu(ParentForm.Handle, False); case ParentForm.WindowState of wsMaximized: begin EnableMenuItem(SysMenu, SC_RESTORE, MF_ENABLED); EnableMenuItem(SysMenu, SC_MAXIMIZE, MF_GRAYED); EnableMenuItem(SysMenu, SC_MOVE, MF_GRAYED); EnableMenuItem(SysMenu, SC_SIZE, MF_GRAYED); end; wsNormal: begin EnableMenuItem(SysMenu, SC_RESTORE, MF_GRAYED); EnableMenuItem(SysMenu, SC_MAXIMIZE, MF_ENABLED); EnableMenuItem(SysMenu, SC_MOVE, MF_ENABLED); EnableMenuItem(SysMenu, SC_SIZE, MF_ENABLED); end; end; Result := Integer(TrackPopupMenuEx(SysMenu, TPM_LEFTALIGN or TPM_RETURNCMD or TPM_RIGHTBUTTON or TPM_HORIZONTAL or TPM_VERTICAL, ScreenPos.X, ScreenPos.Y, ParentForm.Handle, nil)); if DoDefault then case Result of SC_MAXIMIZE: ParentForm.WindowState := wsMaximized; SC_RESTORE: ParentForm.WindowState := wsNormal; else // WindowState := wsMinimized will not minimize the app correctly SendMessage(ParentForm.Handle, WM_SYSCOMMAND, Result, 0); end; end; function SpFillSystemSpTBXPopup(ParentForm: TCustomForm; ParentItem: TTBCustomItem; ShowSize, ShowMinimize, ShowMaximize, ShowClose: Boolean; ClickEvent: TNotifyEvent = nil): Boolean; var Menu: HMENU; I: Integer; Item: TTBCustomItem; begin Result := False; Menu := GetSystemMenu(ParentForm.Handle, False); if SpHMenuToTBMenuItem(Menu, ParentItem) then begin for I := 0 to ParentItem.Count - 1 do begin Item := ParentItem.Items[I]; Item.OnClick := ClickEvent; case Item.Tag of SC_MINIMIZE: begin Item.Visible := ShowMinimize; Item.Enabled := ParentForm.WindowState <> wsMinimized; Item.Images := MDIButtonsImgList; Item.ImageIndex := 2; end; SC_RESTORE: begin Item.Visible := ShowMaximize; Item.Enabled := ParentForm.WindowState <> wsNormal; Item.Images := MDIButtonsImgList; Item.ImageIndex := 3; end; SC_MAXIMIZE: begin Item.Visible := ShowMaximize; Item.Enabled := ParentForm.WindowState <> wsMaximized; Item.Images := MDIButtonsImgList; Item.ImageIndex := 1; end; SC_CLOSE: begin Item.Visible := ShowClose; Item.Options := Item.Options + [tboDefault]; Item.Images := MDIButtonsImgList; Item.ImageIndex := 0; end; SC_MOVE: begin Item.Enabled := ParentForm.WindowState <> wsMaximized; end; SC_SIZE: begin Item.Visible := ShowSize; Item.Enabled := ParentForm.WindowState <> wsMaximized; end; end; end; Result := True; end; end; function SpShowSystemSpTBXPopupMenu(ParentForm: TCustomForm; ScreenPos: TPoint; ShowSize, ShowMinimize, ShowMaximize, ShowClose: Boolean; PopupEvent: TSpTBXPopupEvent; DoDefault: Boolean = True): Integer; var Popup: TSpTBXPopupMenu; ClickedItem: TTBCustomItem; begin Result := 0; ReleaseCapture; Popup := TSpTBXPopupMenu.Create(ParentForm); try if SpFillSystemSpTBXPopup(ParentForm, Popup.Items, ShowSize, ShowMinimize, ShowMaximize, ShowClose) then begin if Assigned(PopupEvent) then Popup.OnInitPopup := PopupEvent; Popup.PopupComponent := ParentForm; ClickedItem := Popup.PopupEx(ScreenPos.X, ScreenPos.Y, nil, True); if Assigned(ClickedItem) then begin Result := ClickedItem.Tag; // If it's not a SystemMenu item fire the OnClick event of the item // We can't use PostClick because the Item will be destroyed by the // time the message is handled. if (Result < SC_SIZE) or (Result > SC_CONTEXTHELP) then ClickedItem.Click; end; end; finally Popup.Free; end; if DoDefault and (Result > 0) then case Result of SC_MAXIMIZE: ParentForm.WindowState := wsMaximized; SC_RESTORE: ParentForm.WindowState := wsNormal; SC_SIZE, SC_MOVE, SC_MINIMIZE, SC_CLOSE: begin // WindowState := wsMinimized will not minimize the app correctly SendMessage(ParentForm.Handle, WM_SYSCOMMAND, Result, 0); end; end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { Misc helpers } procedure SpActivateDwmNC(WinControl: TWinControl; Activate: Boolean); {$IFDEF JR_D11} var ncrp: Cardinal; {$ENDIF} begin {$IFDEF JR_D11} // Use the new API on Windows Vista if DwmCompositionEnabled and WinControl.HandleAllocated then begin if Activate then ncrp := DWMNCRP_USEWINDOWSTYLE else ncrp := DWMNCRP_DISABLED; DwmSetWindowAttribute(WinControl.Handle, DWMWA_NCRENDERING_POLICY, @ncrp, SizeOf(ncrp)); end; {$ENDIF} end; function SpIsDwmCompositionEnabled: Boolean; begin {$IFDEF JR_D11} // Use the new API on Windows Vista Result := DwmCompositionEnabled; {$ELSE} Result := False; {$ENDIF} end; function SpCanFocus(WinControl: TWinControl): Boolean; var Form: TCustomForm; begin Result := False; if Assigned(WinControl) and not WinControl.Focused then begin Form := GetParentForm(WinControl); if Assigned(Form) and Form.Enabled and Form.Visible then Result := WinControl.CanFocus; end; end; function SpIsFocused(WinControl: TWinControl; out FocusedChild: TWinControl): Boolean; var Form: TCustomForm; begin Result := False; FocusedChild := nil; if WinControl.Focused then Result := True else begin Form := GetParentForm(WinControl); if Assigned(Form) and Form.Enabled and Form.Visible then if Assigned(Form.ActiveControl) and Form.ActiveControl.Focused then if IsChild(WinControl.Handle, Form.ActiveControl.Handle) then begin Result := True; FocusedChild := Form.ActiveControl; end; end; end; function SpFocusFirstChild(WinControl: TWinControl): TWinControl; var Form: TCustomForm; begin Result := nil; Form := GetParentForm(WinControl); if Assigned(Form) and Form.Enabled and Form.Visible then begin TWinControlAccess(WinControl).SelectFirst; Result := Form.ActiveControl; end; end; function SpFindControl(Parent: TWinControl; Child: TControl): Integer; var I: Integer; begin Result := -1; for I := 0 to Parent.ControlCount - 1 do if Parent.Controls[I] = Child then begin Result := I; Break; end; end; function SpFindParent(Control: TControl; ParentClass: TClass): TWinControl; var P: TWinControl; begin Result := nil; if Assigned(Control) then begin P := Control.Parent; while Assigned(P) do if P is ParentClass then begin Result := P; Break; end else P := P.Parent; end; end; function SpHasBorders(WinControl: TWinControl): Boolean; var Style, ExStyle: Integer; begin Result := False; Style := GetWindowLong(WinControl.Handle, GWL_STYLE); ExStyle := GetWindowLong(WinControl.Handle, GWL_EXSTYLE); if (Style and WS_BORDER <> 0) or (ExStyle and WS_EX_CLIENTEDGE <> 0) then Result := True; end; function SpGetFormWindowState(F: TCustomForm; out RestoreBoundsRect: TRect): TWindowState; // This method is more accurate than Form.WindowState var P: TWindowPlacement; begin Result := wsNormal; RestoreBoundsRect := Rect(0, 0, 0, 0); if Assigned(F) and (F.HandleAllocated) then begin P.Length := SizeOf(TWindowPlacement); if GetWindowPlacement(F.Handle, @P) then begin case P.showCmd of SW_SHOWMINIMIZED: Result := wsMinimized; SW_SHOWMAXIMIZED: Result := wsMaximized; end; // rcNormalPosition contains the window's coordinates when the window is in the restored position with P.rcNormalPosition do RestoreBoundsRect := Rect(Left, Top, Right - Left, Bottom - Top); end; end; end; procedure SpSetFormWindowState(F: TCustomForm; WindowState: TWindowState; RestoreBoundsRect: TRect); // This method is more accurate than Form.WindowState var P: TWindowPlacement; R: TRect; begin if Assigned(F) and (F.HandleAllocated) then begin P.Length := SizeOf(TWindowPlacement); case WindowState of wsMinimized: P.showCmd := SW_SHOWMINIMIZED; wsMaximized: P.showCmd := SW_SHOWMAXIMIZED; else P.showCmd := SW_SHOWNORMAL; end; with RestoreBoundsRect do R := Bounds(Left, Top, Right, Bottom); // rcNormalPosition contains the window's coordinates when the window is in the restored position if not IsRectEmpty(R) then P.rcNormalPosition := R; SetWindowPlacement(F.Handle, @P); end; end; function SpGetTaskBar(out State, Edge: Cardinal; out Bounds: TRect): Boolean; // Returns the TaskBar state and bounds // State can be: 0, ABS_ALWAYSONTOP, ABS_AUTOHIDE // Edge can be: ABE_LEFT, ABE_RIGHT, ABE_TOP, ABE_BOTTOM // ABM_GETSTATE var AppData: TAppBarData; begin Result := False; State := 0; Edge := 0; Bounds := Rect(0, 0, 0, 0); // 'Shell_TrayWnd' is the name of the task bar's window AppData.Hwnd := FindWindow('Shell_TrayWnd', nil); if AppData.Hwnd <> 0 then begin AppData.cbSize := SizeOf(TAppBarData); if SHAppBarMessage(ABM_GETTASKBARPOS, AppData) <> 0 then begin Edge := AppData.uEdge; Bounds := AppData.rc; AppData.cbSize := SizeOf(TAppBarData); State := SHAppBarMessage(ABM_GETSTATE, AppData); Result := True; end; end; end; procedure SpRecalcNCArea(WinControl: TWinControl); begin if WinControl.HandleAllocated then SetWindowPos(WinControl.Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER); end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { Customizer helpers } procedure SpCustomizeAllToolbars(AParentComponent: TComponent; Reset: Boolean); var I: Integer; TB: TSpTBXToolbar; begin if Assigned(AParentComponent) then begin for I := 0 to AParentComponent.ComponentCount - 1 do if AParentComponent.Components[I] is TSpTBXToolbar then begin TB := AParentComponent.Components[I] as TSpTBXToolbar; if Reset then TB.EndCustomize else TB.BeginCustomize; end; end; end; procedure SpBeginUpdateAllToolbars(AParentComponent: TComponent); var I: Integer; TB: TTBCustomToolbar; begin if Assigned(AParentComponent) then begin for I := 0 to AParentComponent.ComponentCount - 1 do if AParentComponent.Components[I] is TTBCustomToolbar then begin TB := AParentComponent.Components[I] as TTBCustomToolbar; TB.BeginUpdate; end; end; end; procedure SpEndUpdateAllToolbars(AParentComponent: TComponent); var I: Integer; TB: TTBCustomToolbar; begin if Assigned(AParentComponent) then begin for I := 0 to AParentComponent.ComponentCount - 1 do if AParentComponent.Components[I] is TTBCustomToolbar then begin TB := AParentComponent.Components[I] as TTBCustomToolbar; TB.View.UpdatePositions; TB.EndUpdate; TB.Invalidate; end; end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { Unicode helpers } procedure SpPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent); begin {$IFNDEF UNICODE} // Don't let the streaming system store the WideStrings, // we need to store them manually TntPersistent_AfterInherited_DefineProperties(Filer, Instance); {$ENDIF} end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXFontSettings } constructor TSpTBXFontSettings.Create; begin FSize := 100; FColor := clNone; end; procedure TSpTBXFontSettings.Apply(AFont: TFont); begin AFont.Charset := DEFAULT_CHARSET; AFont.Color := FColor; if FSize <> 100 then AFont.Size := (AFont.Size * FSize + 50) div 100; if FName <> '' then AFont.Name := Name; if FStyle <> [] then AFont.Style := FStyle; end; procedure TSpTBXFontSettings.Assign(Src: TPersistent); var F: TSpTBXFontSettings; begin if Src is TPersistent then begin F := TSpTBXFontSettings(Src); FColor := F.Color; FName := F.Name; FSize := F.Size; FStyle := F.Style; Modified; end else inherited; end; procedure TSpTBXFontSettings.Modified; begin if Assigned(FOnChange) then FOnChange(Self); end; procedure TSpTBXFontSettings.SetColor(Value: TColor); begin if FColor <> Value then begin FColor := Value; Modified; end; end; procedure TSpTBXFontSettings.SetName(const Value: TFontName); begin if FName <> Value then begin FName := Value; Modified; end; end; procedure TSpTBXFontSettings.SetSize(Value: TSpTBXFontSize); begin if FSize <> Value then begin FSize := Value; Modified; end; end; procedure TSpTBXFontSettings.SetStyle(const Value: TFontStyles); begin if FStyle <> Value then begin FStyle := Value; Modified; end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXCustomDragObject } constructor TSpTBXCustomDragObject.Create(ASourceControl: TControl; AItem: TTBCustomItem); begin FSourceControl := ASourceControl; FSourceItem := AItem; FDragCursorAccept := crSpTBXCustomization; FDragCursorCancel := crNo; end; procedure TSpTBXCustomDragObject.Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); begin inherited; if not Accepted then begin if Assigned(FSourceControl) then TControlAccess(FSourceControl).DragCanceled; Target := nil; end; if Assigned(FSourceControl) then TControlAccess(FSourceControl).DoEndDrag(Target, X, Y); end; function TSpTBXCustomDragObject.GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; begin if Accepted then Result := FDragCursorAccept else Result := FDragCursorCancel; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXCustomItemActionLink } {$IFNDEF UNICODE} procedure TSpTBXCustomItemActionLink.AssignClient(AClient: TObject); begin inherited AssignClient(AClient); FUnicodeClient := AClient as TSpTBXCustomItem; end; function TSpTBXCustomItemActionLink.IsCaptionLinked: Boolean; begin if (Action is TCustomAction) and Supports(Action, ITntAction) then Result := FUnicodeClient.Caption = TntActnList.TntAction_GetCaption(Action as TCustomAction) else Result := inherited IsCaptionLinked; end; function TSpTBXCustomItemActionLink.IsHintLinked: Boolean; begin if (Action is TCustomAction) and Supports(Action, ITntAction) then Result := FUnicodeClient.Hint = TntActnList.TntAction_GetHint(Action as TCustomAction) else Result := inherited IsCaptionLinked; end; procedure TSpTBXCustomItemActionLink.SetCaption(const Value: String); begin if IsCaptionLinked then if (Action is TCustomAction) and Supports(Action, ITntAction) then FUnicodeClient.Caption := TntActnList.TntAction_GetNewCaption(Action as TCustomAction, Value) else FUnicodeClient.Caption := Value; end; procedure TSpTBXCustomItemActionLink.SetHint(const Value: String); begin if IsHintLinked then if (Action is TCustomAction) and Supports(Action, ITntAction) then FUnicodeClient.Hint := TntActnList.TntAction_GetNewHint(Action as TCustomAction, Value) else FUnicodeClient.Hint := Value; end; {$ENDIF} //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXCustomControl } {$IFNDEF UNICODE} procedure TSpTBXCustomControl.CreateWindowHandle(const Params: TCreateParams); begin CreateUnicodeHandle(Self, Params, ''); end; procedure TSpTBXCustomControl.DefineProperties(Filer: TFiler); begin inherited; // Don't let the streaming system store the WideStrings, // we need to store them manually SpPersistent_AfterInherited_DefineProperties(Filer, Self); end; procedure TSpTBXCustomControl.ActionChange(Sender: TObject; CheckDefaults: Boolean); begin if (Action is TCustomAction) and Supports(Action, ITntAction) then begin if not CheckDefaults or (Self.Caption = '') then Self.Caption := TntActnList.TntAction_GetCaption(Action as TCustomAction); if not CheckDefaults or (Self.Hint = '') then Self.Hint := TntActnList.TntAction_GetHint(Action as TCustomAction); end; // Call inherited after we changed the unicode Caption and Hint inherited; end; function TSpTBXCustomControl.IsCaptionStored: Boolean; begin Result := TntControl_IsCaptionStored(Self); end; function TSpTBXCustomControl.IsHintStored: Boolean; begin Result := TntControl_IsHintStored(Self); end; function TSpTBXCustomControl.GetCaption: TWideCaption; begin Result := TntControl_GetText(Self); end; function TSpTBXCustomControl.GetHint: WideString; begin Result := TntControl_GetHint(Self); end; procedure TSpTBXCustomControl.SetCaption(const Value: TWideCaption); begin TntControl_SetText(Self, Value); end; procedure TSpTBXCustomControl.SetHint(const Value: WideString); begin TntControl_SetHint(Self, Value); end; {$ENDIF} //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXCustomItem } constructor TSpTBXCustomItem.Create(AOwner: TComponent); begin inherited; FFontSettings := TSpTBXFontSettings.Create; FFontSettings.OnChange := FontSettingsChanged; {$IFNDEF UNICODE} FCaption := ''; {$ENDIF} FAlignment := taCenter; FCaptionGlowColor := clYellow; FCustomWidth := -1; FCustomHeight := -1; FMargins := 0; SetStretch(True); FWrapping := twWrap; end; destructor TSpTBXCustomItem.Destroy; begin FreeAndNil(FFontSettings); inherited; end; procedure TSpTBXCustomItem.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = Control) then Control := nil; end; procedure TSpTBXCustomItem.DefineProperties(Filer: TFiler); begin inherited; // Don't let the streaming system store the WideStrings, // we need to store them manually SpPersistent_AfterInherited_DefineProperties(Filer, Self); end; procedure TSpTBXCustomItem.ActionChange(Sender: TObject; CheckDefaults: Boolean); begin {$IFNDEF UNICODE} if (Action is TCustomAction) and Supports(Action, ITntAction) then begin if not CheckDefaults or (Self.Caption = '') then Self.Caption := TntActnList.TntAction_GetCaption(Action as TCustomAction); if not CheckDefaults or (Self.Hint = '') then Self.Hint := TntActnList.TntAction_GetHint(Action as TCustomAction); inherited; Exit; end; {$ENDIF} if Action is TCustomAction then with TCustomAction(Sender) do begin if not CheckDefaults or (Self.Caption = '') then Self.Caption := Caption; if not CheckDefaults or (Self.Hint = '') then Self.Hint := Hint; end; inherited; end; function TSpTBXCustomItem.DialogChar(CharCode: Word): Boolean; begin Result := False; end; procedure TSpTBXCustomItem.DoDrawAdjustFont(AFont: TFont; State: TSpTBXSkinStatesType); begin // Do nothing end; procedure TSpTBXCustomItem.DoDrawHint(AHintBitmap: TBitmap; var AHint: Widestring; var PaintDefault: Boolean); begin if Assigned(FOnDrawHint) then FOnDrawHint(Self, AHintBitmap, AHint, PaintDefault); end; procedure TSpTBXCustomItem.DoDrawButton(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin if Assigned(FOnDrawItem) then FOnDrawItem(Self, ACanvas, ARect, ItemInfo, PaintStage, PaintDefault); end; procedure TSpTBXCustomItem.DoDrawCaption(ACanvas: TCanvas; ClientAreaRect: TRect; State: TSpTBXSkinStatesType; var ACaption: WideString; var CaptionRect: TRect; var CaptionFormat: Cardinal; IsTextRotated: Boolean; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin if Assigned(FOnDrawCaption) then FOnDrawCaption(Self, ACanvas, ClientAreaRect, State, ACaption, CaptionRect, CaptionFormat, IsTextRotated, PaintStage, PaintDefault); end; procedure TSpTBXCustomItem.DoDrawImage(ACanvas: TCanvas; State: TSpTBXSkinStatesType; const PaintStage: TSpTBXPaintStage; var AImageList: TCustomImageList; var AImageIndex: Integer; var ARect: TRect; var PaintDefault: Boolean); begin if Assigned(FOnDrawImage) then FOnDrawImage(Self, ACanvas, State, PaintStage, AImageList, AImageIndex, ARect, PaintDefault); end; procedure TSpTBXCustomItem.DoPopupShowingChanged(APopupWindow: TTBPopupWindow; IsVisible: Boolean); // This method is called by TSpTBXPopupWindow when the popup is Opened and Closed begin if Assigned(APopupWindow) then begin if IsVisible then begin if Assigned(FOnInitPopup) then FOnInitPopup(Self, APopupWindow.View); end else begin if Assigned(FOnClosePopup) then FOnClosePopup(Self); end; end; end; procedure TSpTBXCustomItem.FontSettingsChanged(Sender: TObject); begin Change(True); end; function TSpTBXCustomItem.GetActionLinkClass: TTBCustomItemActionLinkClass; begin Result := TSpTBXCustomItemActionLink; end; function TSpTBXCustomItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass; begin Result := TSpTBXItemViewer; end; function TSpTBXCustomItem.GetPopupWindowClass: TTBPopupWindowClass; begin Result := TSpTBXPopupWindow; end; function TSpTBXCustomItem.GetShortCutText: WideString; var P: Integer; begin P := Pos(#9, Caption); if (P = 0) or (P = Length(Caption)) then begin if ShortCut <> 0 then Result := ShortCutToText(ShortCut) else Result := ''; end else Result := Copy(Caption, P+1, Maxint); end; procedure TSpTBXCustomItem.Click; begin if Assigned(FControl) then ToggleControl; inherited; end; procedure TSpTBXCustomItem.InitiateAction; begin inherited; UpdateProps; end; procedure TSpTBXCustomItem.Invalidate; begin Change(False); end; {$IFNDEF UNICODE} function TSpTBXCustomItem.IsCaptionStored: Boolean; begin Result := (ActionLink = nil) or not TActionLinkAccess(ActionLink).IsCaptionLinked; end; function TSpTBXCustomItem.IsHintStored: Boolean; begin Result := (ActionLink = nil) or not TActionLinkAccess(ActionLink).IsHintLinked; end; procedure TSpTBXCustomItem.SetCaption(const Value: WideString); var S, PrevS: string; begin if FCaption <> Value then begin FCaption := Value; // We need to compare the Ansi inherited Caption // to force the change. // Sometimes '???' = '???' and the change is not executed. S := inherited Caption; PrevS := Value; if S <> PrevS then inherited Caption := Value else Change(True); end; end; procedure TSpTBXCustomItem.SetHint(const Value: WideString); begin if FHint <> Value then begin FHint := Value; inherited Hint := Value; end; end; {$ENDIF} procedure TSpTBXCustomItem.SetAlignment(const Value: TAlignment); begin if FAlignment <> Value then begin FAlignment := Value; Change(False); end; end; procedure TSpTBXCustomItem.SetAnchored(const Value: Boolean); begin if FAnchored <> Value then begin FAnchored := Value; end; end; procedure TSpTBXCustomItem.SetCaptionGlow(const Value: TSpGlowDirection); begin if FCaptionGlow <> Value then begin FCaptionGlow := Value; Change(False); end; end; procedure TSpTBXCustomItem.SetCaptionGlowColor(const Value: TColor); begin if FCaptionGlowColor <> Value then begin FCaptionGlowColor := Value; Change(False); end; end; procedure TSpTBXCustomItem.SetControl(const Value: TControl); begin if FControl <> Value then begin FControl := Value; if Assigned(Value) then Value.FreeNotification(Self); UpdateProps; end; end; procedure TSpTBXCustomItem.SetCustomWidth(Value: Integer); begin if Value < -1 then Value := -1; if FCustomWidth <> Value then begin FCustomWidth := Value; Change(True); end; end; procedure TSpTBXCustomItem.SetCustomHeight(Value: Integer); begin if Value < -1 then Value := -1; if FCustomHeight <> Value then begin FCustomHeight := Value; Change(True); end; end; procedure TSpTBXCustomItem.SetFontSettings(const Value: TSpTBXFontSettings); begin FFontSettings.Assign(Value); end; procedure TSpTBXCustomItem.SetMargins(Value: Integer); begin if FMargins <> Value then begin FMargins := Value; Change(True); end; end; procedure TSpTBXCustomItem.SetMinHeight(const Value: Integer); begin if Value <> FMinHeight then begin FMinHeight := Value; Change(True); end; end; procedure TSpTBXCustomItem.SetMinWidth(const Value: Integer); begin if Value <> FMinWidth then begin FMinWidth := Value; Change(True); end; end; procedure TSpTBXCustomItem.SetStretch(const Value: Boolean); begin if FStretch <> Value then begin FStretch := Value; Change(True); end; end; procedure TSpTBXCustomItem.SetToolBoxPopup(const Value: Boolean); begin FToolBoxPopup := Value; if FToolBoxPopup then Options := Options + [tboToolbarStyle] else Options := Options - [tboToolbarStyle]; end; procedure TSpTBXCustomItem.SetWrapping(const Value: TTextWrapping); begin if FWrapping <> Value then begin FWrapping := Value; Change(False); end; end; procedure TSpTBXCustomItem.ToggleControl; begin FControl.Visible := not FControl.Visible; end; procedure TSpTBXCustomItem.UpdateProps; begin if Assigned(Control) then if (ComponentState * [csDesigning, csLoading, csDestroying] = []) then Checked := Control.Visible; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXItemViewer } function TSpTBXItemViewer.CaptionShown: Boolean; var T: TSpTBXToolbar; begin Result := inherited CaptionShown; if Assigned(View) and Assigned(View.Owner) and (View.Owner is TSpTBXToolbar) then begin T := View.Owner as TSpTBXToolbar; case T.DisplayMode of tbdmImageOnly: if GetImageShown then Result := False; tbdmTextOnly: Result := True; end; end; end; function TSpTBXItemViewer.GetImageShown: Boolean; begin Result := (Item.ImageIndex >= 0) and ((Item.DisplayMode in [nbdmDefault, nbdmImageAndText]) or (IsToolbarStyle and (Item.DisplayMode = nbdmTextOnlyInMenus))); if Assigned(View) and Assigned(View.Owner) and (View.Owner is TSpTBXToolbar) then if TSpTBXToolbar(View.Owner).DisplayMode = tbdmTextOnly then Result := False; end; function TSpTBXItemViewer.GetImageSize: TSize; var IL: TCustomImageList; begin IL := GetImageList; if Assigned(IL) then begin Result.cx := IL.Width; Result.cy := IL.Height; end else begin Result.cx := 0; Result.cy := 0; end; end; function TSpTBXItemViewer.GetRightImageSize: TSize; begin Result.cx := 0; Result.cy := 0; end; procedure TSpTBXItemViewer.DoDrawButton(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin Item.DoDrawButton(ACanvas, ARect, ItemInfo, PaintStage, PaintDefault); end; procedure TSpTBXItemViewer.DoDrawCaption(ACanvas: TCanvas; ClientAreaRect: TRect; State: TSpTBXSkinStatesType; var ACaption: WideString; var CaptionRect: TRect; var CaptionFormat: Cardinal; IsTextRotated: Boolean; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin Item.DoDrawCaption(ACanvas, ClientAreaRect, State, ACaption, CaptionRect, CaptionFormat, IsTextRotated, PaintStage, PaintDefault); end; procedure TSpTBXItemViewer.DoDrawHint(AHintBitmap: TBitmap; CursorPos: TPoint; var CursorRect: TRect; var AHint: Widestring; var PaintDefault: Boolean); begin Item.DoDrawHint(AHintBitmap, AHint, PaintDefault); end; procedure TSpTBXItemViewer.DoDrawImage(ACanvas: TCanvas; State: TSpTBXSkinStatesType; const PaintStage: TSpTBXPaintStage; var AImageList: TCustomImageList; var AImageIndex: Integer; var ARect: TRect; var PaintDefault: Boolean); begin Item.DoDrawImage(ACanvas, State, PaintStage, AImageList, AImageIndex, ARect, PaintDefault); end; procedure TSpTBXItemViewer.DoDrawAdjustFont(AFont: TFont; State: TSpTBXSkinStatesType); begin Item.FontSettings.Apply(AFont); if tboDefault in Item.EffectiveOptions then AFont.Style := AFont.Style + [fsBold]; if AFont.Color = clNone then AFont.Color := GetTextColor(State); Item.DoDrawAdjustFont(AFont, State); end; procedure TSpTBXItemViewer.DrawItemImage(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; ImgIndex: Integer); var PaintDefault: Boolean; ImgList: TCustomImageList; PatternColor: TColor; begin ImgList := GetImageList; PaintDefault := True; DoDrawImage(ACanvas, ItemInfo.State, pstPrePaint, ImgList, ImgIndex, ARect, PaintDefault); if PaintDefault and Assigned(ImgList) then if ImgList = MDIButtonsImgList then begin if (Item.Enabled) and not IsToolbarStyle and (SkinManager.GetSkinType <> sknSkin) then PatternColor := clMenuText else PatternColor := GetTextColor(ItemInfo.State); SpDrawGlyphPattern(ACanvas, ARect, ImgIndex, PatternColor); end else if (ImgIndex >= 0) and (ImgIndex < ImgList.Count) then SpDrawXPMenuItemImage(ACanvas, ARect, ItemInfo, ImgList, ImgIndex); PaintDefault := True; DoDrawImage(ACanvas, ItemInfo.State, pstPostPaint, ImgList, ImgIndex, ARect, PaintDefault); end; procedure TSpTBXItemViewer.DrawItemRightImage(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo); begin // Do nothing end; procedure TSpTBXItemViewer.InternalCalcSize(const Canvas: TCanvas; CalcStretch: Boolean; var AWidth, AHeight: Integer); var I, W, H: Integer; DropDownArrowSize, DropDownArrowMargin, SplitBtnArrowSize: Integer; ImgSize, RightImgSize: TSize; GlyphTop, ToolbarStyle: Boolean; WS: WideString; TextMetric: TTextMetric; MenuMargins: TSpTBXMenuItemMarginsInfo; State: TSpTBXSkinStatesType; IsHoverItem, IsOpen, IsPushed: Boolean; TextInfo: TSpTBXTextInfo; TB: TSpTBXToolbar; begin CurrentSkin.GetDropDownArrowSize(DropDownArrowSize, DropDownArrowMargin, SplitBtnArrowSize); ToolbarStyle := IsToolbarStyle; ImgSize := GetImageSize; if (ImgSize.CX <= 0) or (ImgSize.CY <= 0) then begin ImgSize.CX := 0; ImgSize.CY := 0; end; RightImgSize := GetRightImageSize; if (RightImgSize.CX <= 0) or (RightImgSize.CY <= 0) then begin RightImgSize.CX := 0; RightImgSize.CY := 0; end; GlyphTop := False; if tboImageAboveCaption in Item.EffectiveOptions then GlyphTop := True; // Setup font and get the text info IsOpen := Self = View.OpenViewer; IsHoverItem := Self = View.Selected; IsPushed := IsHoverItem and (IsOpen or (View.MouseOverSelected and View.Capture)); State := CurrentSkin.GetState(Item.Enabled, IsPushed, IsHoverItem, Item.Checked); GetTextInfo(Canvas, State, TextInfo); // Measure size if ToolbarStyle then begin AWidth := 6; AHeight := 6; if CaptionShown then begin Inc(AWidth, TextInfo.TextSize.CX); Inc(AHeight, TextInfo.TextSize.CY); if not TextInfo.IsTextRotated then Inc(AWidth, 4) else Inc(AHeight, 4); end; if GetImageShown and (ImgSize.CX > 0) and (ImgSize.CY > 0) then begin if not GlyphTop then begin if not TextInfo.IsTextRotated then begin Inc(AWidth, ImgSize.CX); Inc(AWidth); if AHeight < ImgSize.CY + 6 then AHeight := ImgSize.CY + 6; end else begin Inc(AHeight, ImgSize.CY); Inc(AHeight); if AWidth < ImgSize.CX + 6 then AWidth := ImgSize.CX + 6; end; end else begin Inc(AHeight, ImgSize.CY); if AWidth < ImgSize.CX + 7 then AWidth := ImgSize.CX + 7; end; end; if (RightImgSize.cx > 0) and (RightImgSize.cy > 0) then begin if View.Orientation = tbvoVertical then Inc(AHeight, 4 + RightImgSize.cy) else Inc(AWidth, 4 + RightImgSize.cx); end; if (tbisSubmenu in Item.ItemStyle) and (tbisCombo in Item.ItemStyle) then Inc(AWidth, SplitBtnArrowSize) else begin if tboDropdownArrow in Item.Options then if not GlyphTop or (ImgSize.CX = 0) or TextInfo.IsTextRotated then begin if View.Orientation = tbvoVertical then Inc(AHeight, DropDownArrowSize) else Inc(AWidth, DropDownArrowSize); end else if GlyphTop and (TextInfo.IsTextRotated xor (View.Orientation <> tbvoVertical)) then begin W := ImgSize.CX + DropDownArrowSize + 2; if W > AWidth - 7 then AWidth := W + 7; end else begin H := ImgSize.CY + DropDownArrowSize + 2; if H > AHeight - 7 then AHeight := H + 7; end; end; // Widen MenuBar SubMenuItems if (tbisSubmenu in Item.ItemStyle) and (vsMenuBar in View.Style) then Inc(AWidth, 6); // Toolbar.Stretch property doesn't work correctly, I don't know how to fix // it without changing the TB2K source. // http://news.jrsoftware.org/read/article.php?id=8176&group=jrsoftware.toolbar2000#8176 if CalcStretch and Item.Stretch and (View is TSpTBXToolbarView) and (View.ViewerCount > 2) then begin if View.Orientation = tbvoVertical then begin if AWidth < TSpTBXToolbarView(View).FTallestItemSize then AWidth := TSpTBXToolbarView(View).FTallestItemSize; end else if AHeight < TSpTBXToolbarView(View).FTallestItemSize then AHeight := TSpTBXToolbarView(View).FTallestItemSize; end; end else begin // Menu Item GetTextMetrics(Canvas.Handle, TextMetric); Inc(TextInfo.TextSize.cy, TextMetric.tmExternalLeading); AWidth := TextInfo.TextSize.cx; AHeight := TextInfo.TextSize.cy; if ImgSize.cy = 0 then ImgSize.cy := 16; if AHeight < ImgSize.cy then AHeight := ImgSize.cy; if View.Window is TSpTBXPopupWindow then CurrentSkin.GetMenuItemMargins(Canvas, TSpTBXPopupWindow(View.Window).MaximumImageSize.cx, MenuMargins) else CurrentSkin.GetMenuItemMargins(Canvas, ImgSize.cx, MenuMargins); Inc(AWidth, MenuMargins.Margins.Left + MenuMargins.Margins.Right); Inc(AHeight, MenuMargins.Margins.Top + MenuMargins.Margins.Bottom); Inc(AWidth, MenuMargins.GutterSize + MenuMargins.ImageTextSpace + MenuMargins.LeftCaptionMargin + MenuMargins.RightCaptionMargin); WS := Item.GetShortCutText; if Length(WS) > 0 then Inc(AWidth, (AHeight - 6) + SpGetTextSize(Canvas.Handle, WS, True).cx); Inc(AWidth, AHeight); { Note: maybe this should be controlled by the theme } end; if AWidth < Item.MinWidth then AWidth := Item.MinWidth; if AHeight < Item.MinHeight then AHeight := Item.MinHeight; // Handle Custom size and anchors if IsRotated then begin // Reverse H := AWidth + Item.Margins; W := AHeight; end else begin W := AWidth + Item.Margins; H := AHeight; end; if Item.CustomWidth > -1 then W := Item.CustomWidth; if Item.CustomHeight > -1 then H := Item.CustomHeight; if IsToolbarStyle and Item.Anchored then W := W + FAnchorDelta; if W < Item.MinWidth then W := Item.MinWidth; if H < Item.MinHeight then H := Item.MinHeight; // Apply View.MaxSize to the height of the item if View.Window is TSpTBXToolbar then begin TB := View.Window as TSpTBXToolbar; I := TB.MaxSize - TB.NonClientHeight; if (I > -1) and (H > I) then H := I; end; if IsRotated then begin // Reverse AWidth := H; AHeight := W; end else begin AWidth := W; AHeight := H; end; end; procedure TSpTBXItemViewer.InternalMouseMove(Shift: TShiftState; X, Y: Integer); begin // Do nothing end; function TSpTBXItemViewer.IsOnToolBoxPopup: Boolean; // Returns True if the item is on a submenu with ToolBoxPopup set to True. begin Result := False; if Assigned(View) and Assigned(View.ParentItem) then if View.ParentItem is TSpTBXCustomItem then Result := TSpTBXCustomItem(View.ParentItem).ToolBoxPopup else if View.ParentItem is TSpTBXRootItem then Result := TSpTBXRootItem(View.ParentItem).ToolBoxPopup; end; function TSpTBXItemViewer.IsToolbarStyle: Boolean; // Returns True if the item is on a toolbar or has tboToolbarStyle. // We should return False if the item is a ToolBoxPopup and the parent doesn't have tboToolbarStyle, // the main ToolBoxPopup should be painted as a menu item on submenus/popups. begin Result := inherited IsToolbarStyle; // if ToolBoxPopup and tboToolbarStyle is set see if the item is the parent // ToolBox submenu. if Result and Item.ToolBoxPopup and not View.IsToolbar and Assigned(View) and Assigned(View.ParentItem) then if not (tboToolbarStyle in View.ParentItem.EffectiveOptions) then begin // The parent item doesn't have tboToolbarStyle, so the current item // is the main ToolBoxPopup submenu. Result := False; end; end; procedure TSpTBXItemViewer.CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); begin InternalCalcSize(Canvas, True, AWidth, AHeight); end; function TSpTBXItemViewer.GetCaptionText: WideString; begin Result := SpStripShortcut(Item.Caption); end; function TSpTBXItemViewer.GetTextColor(State: TSpTBXSkinStatesType): TColor; begin Result := Item.FontSettings.Color; if Result = clNone then begin if IsToolbarStyle then begin if View.Window is TSpTBXToolbar then Result := TSpTBXToolbar(View.Window).GetItemsTextColor(State); if Result = clNone then Result := CurrentSkin.GetTextColor(skncToolbarItem, State); end else Result := CurrentSkin.GetTextColor(skncMenuItem, State); end; end; procedure TSpTBXItemViewer.GetTextInfo(ACanvas: TCanvas; State: TSpTBXSkinStatesType; out TextInfo: TSpTBXTextInfo); var ToolbarStyle: Boolean; I: Integer; const WordWraps: array [TTextWrapping] of Cardinal = (0, DT_SINGLELINE or DT_END_ELLIPSIS, DT_SINGLELINE or DT_PATH_ELLIPSIS, DT_WORDBREAK); function GetRealTextSize(TextFlags: Cardinal): TSize; var R, CaptionRect: TRect; begin TextFlags := TextFlags and not DT_SINGLELINE; TextFlags := TextFlags and not (DT_WORDBREAK or DT_END_ELLIPSIS or DT_PATH_ELLIPSIS); if (TextFlags and (DT_WORDBREAK or DT_END_ELLIPSIS or DT_PATH_ELLIPSIS)) <> 0 then begin // will never get here, TextFlags doesn't have wrapping CaptionRect := BoundsRect; R := Rect(0, 0, CaptionRect.Right - CaptionRect.Left, 80); end else R := Rect(0, 0, 1, 1); SpDrawXPText(ACanvas, TextInfo.Text, R, TextFlags or DT_CALCRECT, gldNone, clYellow, TextInfo.TextAngle); Result.CX := R.Right; Result.CY := R.Bottom; end; begin ToolbarStyle := IsToolbarStyle; FillChar(TextInfo, SizeOf(TextInfo), 0); // Setup Font ACanvas.Font.Assign(View.GetFont); DoDrawAdjustFont(ACanvas.Font, State); // Let the Item adjust the font // Text Flags TextInfo.TextFlags := 0; if not AreKeyboardCuesEnabled and (vsUseHiddenAccels in View.Style) and not (vsShowAccels in View.State) then TextInfo.TextFlags := DT_HIDEPREFIX; TextInfo.TextFlags := TextInfo.TextFlags or DT_VCENTER or WordWraps[Item.Wrapping]; TextInfo.IsCaptionShown := CaptionShown; if TextInfo.IsCaptionShown then begin TextInfo.Text := GetCaptionText; TextInfo.IsTextRotated := IsRotated; if TextInfo.IsTextRotated or not ToolbarStyle then TextInfo.TextFlags := TextInfo.TextFlags or DT_SINGLELINE; TextInfo.TextSize := GetRealTextSize(TextInfo.TextFlags); if TextInfo.IsTextRotated then begin I := TextInfo.TextSize.cx; TextInfo.TextSize.cx := TextInfo.TextSize.cy; TextInfo.TextSize.cy := I; end; end else begin TextInfo.Text := ''; TextInfo.IsTextRotated := False; TextInfo.TextSize.cx := 0; TextInfo.TextSize.cy := 0; end; if TextInfo.IsTextRotated then TextInfo.TextAngle := tra270 else TextInfo.TextAngle := tra0; end; procedure TSpTBXItemViewer.Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); var View: TTBViewAccess; ItemInfo: TSpTBXMenuItemInfo; TextInfo: TSpTBXTextInfo; TextAlignment: TAlignment; TextMetrics: TTextMetric; PaintDefault, IsSpecialDropDown: Boolean; R, CaptionRect, ImageRect, RightImageRect: TRect; P: TPoint; DropDownArrowSize, DropDownArrowMargin, SplitBtnArrowSize, ImgAndArrowWidth: Integer; WS: WideString; TextC, DropDownC: TColor; GlyphLayout: TSpGlyphLayout; const WordWraps: array [TTextWrapping] of Cardinal = (0, DT_SINGLELINE or DT_END_ELLIPSIS, DT_SINGLELINE or DT_PATH_ELLIPSIS, DT_WORDBREAK); begin CaptionRect := Rect(0, 0, 0, 0); ImageRect := Rect(0, 0, 0, 0); RightImageRect := Rect(0, 0, 0, 0); CurrentSkin.GetDropDownArrowSize(DropDownArrowSize, DropDownArrowMargin, SplitBtnArrowSize); View := TTBViewAccess(Self.View); SpFillItemInfo(Canvas, Self, ItemInfo); GlyphLayout := ghlGlyphLeft; if tboImageAboveCaption in Item.EffectiveOptions then GlyphLayout := ghlGlyphTop; { Setup font and get the text info } GetTextInfo(Canvas, ItemInfo.State, TextInfo); TextC := Canvas.Font.Color; TextAlignment := Item.Alignment; // Special DropDown, toolbar item with arrow, image and text. The Image is above the caption // the arrow must be aligned with the image, above the text IsSpecialDropDown := ItemInfo.HasArrow and not ItemInfo.IsSplit and ItemInfo.ToolbarStyle and (tboImageAboveCaption in Item.EffectiveOptions) and (ItemInfo.ImageSize.cx > 0) and not (TextInfo.IsTextRotated) and (Length(Item.Caption) > 0); { Border & Arrows } R := ClientAreaRect; if ItemInfo.ToolbarStyle then begin if ItemInfo.HasArrow then begin if ItemInfo.IsSplit then begin ItemInfo.ComboRect := R; Dec(R.Right, SplitBtnArrowSize); ItemInfo.ComboRect.Left := R.Right; end else if not IsSpecialDropDown then begin if View.Orientation <> tbvoVertical then ItemInfo.ComboRect := Rect(R.Right - DropDownArrowSize - DropDownArrowMargin, 0, R.Right - DropDownArrowMargin, R.Bottom) else ItemInfo.ComboRect := Rect(0, R.Bottom - DropDownArrowSize - DropDownArrowMargin, R.Right, R.Bottom - DropDownArrowMargin); end else begin // Special DropDown, toolbar item with arrow, image and text. The Image is above the caption // the arrow must be aligned with the image, above the text ImgAndArrowWidth := ItemInfo.ImageSize.cx + DropDownArrowSize + 2; ItemInfo.ComboRect.Right := (R.Left + R.Right + ImgAndArrowWidth + 2) div 2; ItemInfo.ComboRect.Left := ItemInfo.ComboRect.Right - DropDownArrowSize; ItemInfo.ComboRect.Top := (R.Top + R.Bottom - ItemInfo.ImageSize.cy - 2 - TextInfo.TextSize.CY) div 2; ItemInfo.ComboRect.Bottom := ItemInfo.ComboRect.Top + ItemInfo.ImageSize.cy; end; end; PaintDefault := True; DoDrawButton(Canvas, R, ItemInfo, pstPrePaint, PaintDefault); if PaintDefault then SpDrawXPMenuItem(Canvas, R, ItemInfo); PaintDefault := True; DoDrawButton(Canvas, R, ItemInfo, pstPostPaint, PaintDefault); // Draw dropdown arrow if PaintDefault and ItemInfo.HasArrow then begin P.X := (ItemInfo.ComboRect.Left + ItemInfo.ComboRect.Right) div 2 - 1; P.Y := (ItemInfo.ComboRect.Top + ItemInfo.ComboRect.Bottom) div 2 - 1; // Don't draw the arrow if is a split button in Windows XP, it's // painted by the Windows theme. if not (ItemInfo.IsSplit and (ItemInfo.SkinType = sknWindows)) then begin DropDownC := TextC; if ItemInfo.IsSplit and ItemInfo.Enabled then DropDownC := GetTextColor(ItemInfo.ComboState); if ItemInfo.IsSunkenCaption then P := Point(P.X + 1, P.Y + 1); SpDrawArrow(Canvas, P.X, P.Y, DropDownC, not ItemInfo.IsVertical, False, 2); end; if not ItemInfo.IsSplit and not IsSpecialDropDown then begin if View.Orientation <> tbvoVertical then Dec(R.Right, DropDownArrowSize) else Dec(R.Bottom, DropDownArrowSize); end; end; InflateRect(R, -4, -4); // Adjust end else begin // Menu items PaintDefault := True; DoDrawButton(Canvas, R, ItemInfo, pstPrePaint, PaintDefault); if PaintDefault then SpDrawXPMenuItem(Canvas, R, ItemInfo); PaintDefault := True; DoDrawButton(Canvas, R, ItemInfo, pstPostPaint, PaintDefault); // Draw the submenu arrows if PaintDefault and (tbisSubmenu in Item.ItemStyle) then SpDrawArrow(Canvas, R.Right - 10, R.Bottom div 2, TextC, False, False, 3); // Don't apply the margins if the menu item has // tbisClicksTransparent itemstyle (like a SpTBXLabelItem) // the caption will be automatically centered. if not (tbisClicksTransparent in Item.ItemStyle) then begin Inc(R.Left, ItemInfo.MenuMargins.Margins.Left); Dec(R.Right, ItemInfo.MenuMargins.Margins.Right); Inc(R.Top, ItemInfo.MenuMargins.Margins.Top); Dec(R.Bottom, ItemInfo.MenuMargins.Margins.Bottom); end; end; { Caption } if TextInfo.IsCaptionShown then begin WS := GetCaptionText; if ItemInfo.ToolbarStyle then begin TextInfo.TextFlags := TextInfo.TextFlags and not DT_VCENTER; // When ItemInfo.RightImageSize is valid use taLeftJustify if (ItemInfo.RightImageSize.cx > 0) and (ItemInfo.RightImageSize.cy > 0) then TextAlignment := taLeftJustify; case TextAlignment of taCenter: if GlyphLayout = ghlGlyphTop then TextInfo.TextFlags := TextInfo.TextFlags or DT_CENTER; taRightJustify: TextInfo.TextFlags := TextInfo.TextFlags or DT_RIGHT; end; SpCalcXPText(Canvas, R, WS, TextAlignment, TextInfo.TextFlags, ItemInfo.ImageSize, ItemInfo.RightImageSize, GlyphLayout, False, CaptionRect, ImageRect, RightImageRect, TextInfo.TextAngle); if ItemInfo.IsSunkenCaption then OffsetRect(CaptionRect, 1, 1); end else begin if tbisClicksTransparent in Item.ItemStyle then begin // The caption should be centered on the menu popup if the item has // tbisClicksTransparent itemstyle (SpTBXLabelItem) TextInfo.TextFlags := TextInfo.TextFlags or DT_CENTER; CaptionRect := R; end else begin TextInfo.TextFlags := TextInfo.TextFlags or DT_LEFT or DT_VCENTER; GetTextMetrics(Canvas.Handle, TextMetrics); CaptionRect := R; Inc(CaptionRect.Left, ItemInfo.MenuMargins.GutterSize + ItemInfo.MenuMargins.ImageTextSpace + ItemInfo.MenuMargins.LeftCaptionMargin); if (CaptionRect.Bottom - CaptionRect.Top) - (TextMetrics.tmHeight + TextMetrics.tmExternalLeading) = ItemInfo.MenuMargins.Margins.Bottom then Dec(CaptionRect.Bottom); Inc(CaptionRect.Top, TextMetrics.tmExternalLeading); CaptionRect.Right := CaptionRect.Left + TextInfo.TextSize.CX; end; end; Canvas.Font.Color := TextC; PaintDefault := True; DoDrawCaption(Canvas, ClientAreaRect, ItemInfo.State, WS, CaptionRect, TextInfo.TextFlags, TextInfo.IsTextRotated, pstPrePaint, PaintDefault); if PaintDefault then begin if (not IsSelected or ItemInfo.ToolbarStyle) and (ItemInfo.State = sknsDisabled) and (ItemInfo.SkinType = sknNone) then begin OffsetRect(CaptionRect, 1, 1); Canvas.Font.Color := clBtnHighlight; SpDrawXPText(Canvas, WS, CaptionRect, TextInfo.TextFlags, Item.CaptionGlow, Item.CaptionGlowColor, TextInfo.TextAngle); OffsetRect(CaptionRect, -1, -1); Canvas.Font.Color := clGrayText; end; SpDrawXPText(Canvas, WS, CaptionRect, TextInfo.TextFlags, Item.CaptionGlow, Item.CaptionGlowColor, TextInfo.TextAngle); end; PaintDefault := True; DoDrawCaption(Canvas, ClientAreaRect, ItemInfo.State, WS, CaptionRect, TextInfo.TextFlags, TextInfo.IsTextRotated, pstPostPaint, PaintDefault); end; { Shortcut } if not ItemInfo.ToolbarStyle then begin WS := Item.GetShortCutText; if Length(WS) > 0 then begin CaptionRect := R; CaptionRect.Left := CaptionRect.Right - (CaptionRect.Bottom - CaptionRect.Top) - SpGetTextSize(Canvas.Handle, WS, True).cx; if (CaptionRect.Bottom - CaptionRect.Top) - (TextMetrics.tmHeight + TextMetrics.tmExternalLeading) = ItemInfo.MenuMargins.Margins.Bottom then Dec(CaptionRect.Bottom); Inc(CaptionRect.Top, TextMetrics.tmExternalLeading); Canvas.Font.Color := TextC; PaintDefault := True; DoDrawCaption(Canvas, ClientAreaRect, ItemInfo.State, WS, CaptionRect, TextInfo.TextFlags, TextInfo.IsTextRotated, pstPrePaint, PaintDefault); if PaintDefault then SpDrawXPText(Canvas, WS, CaptionRect, TextInfo.TextFlags, Item.CaptionGlow, Item.CaptionGlowColor, TextInfo.TextAngle); PaintDefault := True; DoDrawCaption(Canvas, ClientAreaRect, ItemInfo.State, WS, CaptionRect, TextInfo.TextFlags, TextInfo.IsTextRotated, pstPostPaint, PaintDefault); end; end; { Image, or check box } if ItemInfo.ImageOrCheckShown then begin if ItemInfo.ToolBarStyle then begin if IsRectEmpty(ImageRect) then ImageRect := R; if IsSpecialDropDown then OffsetRect(ImageRect, (-DropDownArrowSize + 1) div 2, 0); end else begin ImageRect := R; ImageRect.Right := ImageRect.Left + ItemInfo.MenuMargins.GutterSize; end; if ItemInfo.ImageShown then begin ImageRect := SpCenterRect(ImageRect, ItemInfo.ImageSize.cx, ItemInfo.ImageSize.cy); DrawItemImage(Canvas, ImageRect, ItemInfo, Item.ImageIndex); end else begin if not ItemInfo.ToolbarStyle and Item.Checked then begin if Item.RadioItem then CurrentSkin.PaintMenuRadioMark(Canvas, ImageRect, True, True, ItemInfo.State) else CurrentSkin.PaintMenuCheckMark(Canvas, ImageRect, True, False, True, ItemInfo.State); end; end; end; { Right Image } if ItemInfo.ToolbarStyle and (ItemInfo.RightImageSize.cx > 0) and (ItemInfo.RightImageSize.cy > 0) then begin if IsRectEmpty(RightImageRect) then begin RightImageRect.Left := R.Right - ItemInfo.RightImageSize.cx; RightImageRect.Right := RightImageRect.Left + ItemInfo.RightImageSize.cx; RightImageRect.Top := R.Top + (R.Bottom - R.Top - ItemInfo.RightImageSize.cy) div 2; RightImageRect.Bottom := RightImageRect.Top + ItemInfo.RightImageSize.cy; end; DrawItemRightImage(Canvas, RightImageRect, ItemInfo); end; end; function TSpTBXItemViewer.GetItem: TSpTBXCustomItem; var TBItem: TTBCustomItem; begin TBItem := inherited Item; if Assigned(TBItem) then Result := TBItem as TSpTBXCustomItem else Result := nil; end; function TSpTBXItemViewer.GetHintText: Widestring; var I: Integer; S: string; begin // Get the short hint I := Pos('|', Item.Hint); if I = 0 then Result := Item.Hint else Result := Copy(Item.Hint, 1, I - 1); // Use the caption if there is no hint if (Result = '') and not(tboNoAutoHint in Item.EffectiveOptions) and (not(tbisSubmenu in Item.ItemStyle) or (tbisCombo in Item.ItemStyle) or not CaptionShown) then begin Result := SpStripAccelChars(SpStripTrailingPunctuation(Item.Caption)); end; // Call associated action's OnHint event handler to post-process the hint if Assigned(Item.ActionLink) and (Item.ActionLink.Action is TCustomAction) and Assigned(TCustomAction(Item.ActionLink.Action).OnHint) then begin S := Result; if TCustomAction(Item.ActionLink.Action).DoHint(S) then Result := S else Result := ''; // Note: TControlActionLink.DoShowHint actually misinterprets the result of DoHint, but we get it right... end; // Add shortcut text if (Result <> '') and Application.HintShortCuts and (Item.ShortCut <> scNone) then Result := Result + ' (' + ShortCutToText(Item.ShortCut) + ')'; end; procedure TSpTBXItemViewer.Entering; begin // When a Popupmenu is opened the TB2K modal handler will reset // the TApplication.Hint in UpdateAppHint subprocedure of // TTBModalHandler.Create, this in turn sets TTntApplication.Hint // to AnsiString: // ... // if Assigned(View.FSelected) then // Application.Hint := GetLongHint(View.FSelected.Item.Hint) // else // Application.Hint := ''; // ... // We need to set TTntApplication.Hint before TB2K. // TTntStatusBar uses TTntApplication.Hint when AutoHint is true. inherited; {$IFNDEF UNICODE} if View.IsPopup then TntApplication.Hint := Item.Hint; {$ENDIF} end; procedure TSpTBXItemViewer.CMHintShow(var Message: TMessage); // Handle the CM_HINTSHOW message to show unicode hints using // a custom THintWindow. var HintInfo: PHintInfo; WideHint, PrevWideHint: Widestring; R, TextR, CursorR: TRect; PaintDefault: Boolean; begin HintInfo := TCMHintShow(Message).HintInfo; WideHint := GetHintText; CursorR := BoundsRect; // Prepare the HintInfo HintInfo.HintStr := WideHint; HintInfo.CursorRect := CursorR; HintInfo.HintWindowClass := SpTBXHintWindowClass; // Custom HintWindow class HintInfo.HintData := SpStockHintBitmap; // TApplication.ActivateHint will pass the data to the HintWindow HintInfo.HideTimeout := 60000; // 1 minute // Prepare the HintBitmap SpStockHintBitmap.Canvas.Font.Assign(Screen.HintFont); SpStockHintBitmap.Canvas.Font.Color := clInfoText; SpStockHintBitmap.Canvas.Pen.Color := clBlack; SpStockHintBitmap.Canvas.Brush.Color := clInfoBk; TextR := Rect(0, 0, 1, 1); SpDrawXPText(SpStockHintBitmap.Canvas, WideHint, TextR, DT_NOPREFIX or DT_CALCRECT); SpStockHintBitmap.Width := TextR.Right + 8; SpStockHintBitmap.Height := TextR.Bottom + 4; R := Rect(0, 0, SpStockHintBitmap.Width, SpStockHintBitmap.Height); SpDrawXPTooltipBackground(SpStockHintBitmap.Canvas, R); // Draw the hint in the HintBitmap PrevWideHint := WideHint; PaintDefault := True; DoDrawHint(SpStockHintBitmap, HintInfo.CursorPos, CursorR, WideHint, PaintDefault); if PaintDefault then begin HintInfo.HintStr := WideHint; HintInfo.CursorRect := CursorR; // Adjust the bounds and repaint the background if it's needed if WideHint <> PrevWideHint then begin TextR := Rect(0, 0, 1, 1); SpDrawXPText(SpStockHintBitmap.Canvas, WideHint, TextR, DT_NOPREFIX or DT_CALCRECT); SpStockHintBitmap.Width := TextR.Right + 8; SpStockHintBitmap.Height := TextR.Bottom + 4; R := Rect(0, 0, SpStockHintBitmap.Width, SpStockHintBitmap.Height); SpDrawXPTooltipBackground(SpStockHintBitmap.Canvas, R); end else R := Rect(0, 0, SpStockHintBitmap.Width, SpStockHintBitmap.Height); // Draw the hint OffsetRect(TextR, ((R.Right - TextR.Right) div 2) - 2, (R.Bottom - TextR.Bottom) div 2); SpDrawXPText(SpStockHintBitmap.Canvas, WideHint, TextR, DT_NOPREFIX); end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXRootItem } procedure TSpTBXRootItem.DoPopupShowingChanged(APopupWindow: TTBPopupWindow; IsVisible: Boolean); // This method is called by TSpTBXPopupWindow when the popup is Opened begin if Assigned(APopupWindow) then begin if IsVisible then begin if Assigned(FOnInitPopup) then FOnInitPopup(Self, APopupWindow.View); end else begin if Assigned(FOnClosePopup) then FOnClosePopup(Self); end; end; end; function TSpTBXRootItem.GetPopupWindowClass: TTBPopupWindowClass; begin Result := TSpTBXPopupWindow; end; procedure TSpTBXRootItem.SetToolBoxPopup(const Value: Boolean); begin FToolBoxPopup := Value; if FToolBoxPopup then Options := Options + [tboToolbarStyle] else Options := Options - [tboToolbarStyle]; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXSubmenuItem } constructor TSpTBXSubmenuItem.Create(AOwner: TComponent); begin inherited; ItemStyle := ItemStyle + [tbisSubMenu, tbisSubitemsEditable]; end; function TSpTBXSubmenuItem.GetDropdownCombo: Boolean; begin Result := tbisCombo in ItemStyle; end; procedure TSpTBXSubmenuItem.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; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXColorItem } constructor TSpTBXColorItem.Create(AOwner: TComponent); begin inherited; FColor := clWhite; end; function TSpTBXColorItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass; begin Result := TSpTBXColorItemViewer; end; procedure TSpTBXColorItem.SetColor(Value: TColor); begin if FColor <> Value then begin FColor := Value; Change(False); end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXColorItemViewer } procedure TSpTBXColorItemViewer.DoDrawImage(ACanvas: TCanvas; State: TSpTBXSkinStatesType; const PaintStage: TSpTBXPaintStage; var AImageList: TCustomImageList; var AImageIndex: Integer; var ARect: TRect; var PaintDefault: Boolean); var C: TColor; begin if PaintStage = pstPrePaint then begin if State = sknsDisabled then begin Inc(ARect.Right); Inc(ARect.Bottom); DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER or BDR_RAISEDINNER, BF_RECT); end else begin if not IsToolbarStyle then InflateRect(ARect, -2, -2); C := TSpTBXColorItem(Item).Color; if C <> clNone then begin ACanvas.Brush.Color := clBtnShadow; ACanvas.FrameRect(ARect); InflateRect(ARect, -1, -1); ACanvas.Brush.Color := C; ACanvas.FillRect(ARect); end; end; end; inherited; end; function TSpTBXColorItemViewer.GetImageShown: Boolean; begin Result := ((Item.DisplayMode in [nbdmDefault, nbdmImageAndText]) or (IsToolbarStyle and (Item.DisplayMode = nbdmTextOnlyInMenus))); end; function TSpTBXColorItemViewer.GetImageSize: TSize; begin if IsToolbarStyle then begin Result.cx := 12; Result.cy := 12; end else begin Result.cx := 16; Result.cy := 16; end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXCustomLabelItem } constructor TSpTBXCustomLabelItem.Create(AOwner: TComponent); begin inherited; ItemStyle := ItemStyle - [tbisSelectable, tbisRedrawOnSelChange, tbisRedrawOnMouseOverChange] + [tbisClicksTransparent]; Alignment := taLeftJustify; Stretch := False; DisplayMode := nbdmImageAndText; end; function TSpTBXCustomLabelItem.DialogChar(CharCode: Word): Boolean; begin Result := inherited DialogChar(CharCode); if Enabled and Visible and Assigned(Control) and (Control is TWinControl) and IsAccel(CharCode, Caption) and SpCanFocus(TWinControl(Control)) then begin TWinControl(Control).SetFocus; Result := True; end; end; procedure TSpTBXCustomLabelItem.DoDrawButton(ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin PaintDefault := True; inherited DoDrawButton(ACanvas, ARect, ItemInfo, PaintStage, PaintDefault); PaintDefault := False; end; function TSpTBXCustomLabelItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass; begin Result := TSpTBXLabelItemViewer; end; procedure TSpTBXCustomLabelItem.ToggleControl; begin // Do nothing, the Control property is not valid end; procedure TSpTBXCustomLabelItem.UpdateProps; begin // Do nothing, the Control property is not valid end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXLabelItemViewer } procedure TSpTBXLabelItemViewer.CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); var TextMetrics: TTextMetric; begin inherited CalcSize(Canvas, AWidth, AHeight); if not IsToolbarStyle and (Length(GetCaptionText) > 0) and (Item.CustomHeight <= -1) then begin GetTextMetrics(Canvas.Handle, TextMetrics); AHeight := TextMetrics.tmHeight; end; end; function TSpTBXLabelItemViewer.DoExecute: Boolean; begin // Clicking a TSpTBXLabelItem on a popup menu causes the menu to close. // This is caused by TTBXItemViewer.MouseUp, which calls // TTBItemViewer.DoExecute // The TBXLabelItem doesn't fire the click because the ItemViewer descends // from TTBItemViewer instead of TTBXItemViewer. // TTBXItemViewer.MouseUp is the culprit of firing the DoExecute Result := False; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXSeparatorItem } function TSpTBXSeparatorItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass; begin Result := TSpTBXSeparatorItemViewer; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXSeparatorItemViewer } procedure TSpTBXSeparatorItemViewer.CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); begin if not IsToolbarStyle then begin if CurrentSkin.OfficeMenu then AHeight := 4 // For Office XP, 2003, 2007 else AHeight := 10; end else begin AWidth := 6; AHeight := 6; end; end; function TSpTBXSeparatorItemViewer.IsStatusBarSeparator: Boolean; var C: TComponent; begin Result := False; C := Item.GetParentComponent; if Assigned(C) and (C is TSpTBXStatusToolbar) then Result := TSpTBXStatusToolbar(C).NeedsSeparatorRepaint; end; procedure TSpTBXSeparatorItemViewer.Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); var Vertical, MenuItemStyle: Boolean; MarginsInfo: TSpTBXMenuItemMarginsInfo; R: TRect; begin if TTBSeparatorItem(Item).Blank or IsStatusBarSeparator then Exit; R := ClientAreaRect; MenuItemStyle := View.IsPopup; if MenuItemStyle then begin Vertical := False; case SkinManager.GetSkinType of sknNone: begin // Add separator spacing when it's not on a ToolBoxPopup if not (tboToolbarStyle in Item.EffectiveOptions) then InflateRect(R, -tbMenuSeparatorOffset, 0); end; sknWindows, sknSkin: begin // Draw the separator from the gutter end if the separator is not on // a ToolBoxPopup and we are using the default Vista theme or the // skin has a gutter specified. if not (tboToolbarStyle in Item.EffectiveOptions) then if SpIsWinVistaOrUp or not CurrentSkin.Options(skncGutter, sknsNormal).IsEmpty then begin if View.Window is TSpTBXPopupWindow then CurrentSkin.GetMenuItemMargins(Canvas, TSpTBXPopupWindow(View.Window).MaximumImageSize.cx, MarginsInfo) else CurrentSkin.GetMenuItemMargins(Canvas, 0, MarginsInfo); if SpIsWinVistaOrUp then R.Left := MarginsInfo.GutterSize + MarginsInfo.ImageTextSpace else R.Left := MarginsInfo.GutterSize + MarginsInfo.ImageTextSpace + MarginsInfo.LeftCaptionMargin; end; end; end; end else Vertical := View.Orientation <> tbvoVertical; SpDrawXPMenuSeparator(Canvas, R, MenuItemStyle, Vertical); end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXRadioGroupItem } constructor TSpTBXRadioGroupItem.Create(AOwner: TComponent); begin inherited; FDefaultIndex := 0; FLastClickedIndex := 0; FStrings := TTntStringList.Create; end; destructor TSpTBXRadioGroupItem.Destroy; begin FStrings.Free; inherited; end; procedure TSpTBXRadioGroupItem.DoClick(AItem: TSpTBXItem); begin if Assigned(FOnClick) then FOnClick(AItem); end; procedure TSpTBXRadioGroupItem.DoFillStrings; begin if Assigned(FOnFillStrings) then FOnFillStrings(Self, FStrings); end; procedure TSpTBXRadioGroupItem.ItemClickEvent(Sender: TObject); var Item: TSpTBXItem; begin Item := Sender as TSpTBXItem; if not Item.Checked and (Item.Tag > -1) and (Item.Tag < FStrings.Count) then begin Item.Checked := True; FLastClickedIndex := IndexOf(Item); DoClick(Item); end; end; procedure TSpTBXRadioGroupItem.Loaded; begin inherited; if not (csDesigning in ComponentState) then Recreate; end; procedure TSpTBXRadioGroupItem.Recreate; var I: Integer; A: TSpTBXItem; begin // Delete FStrings items FStrings.Clear; for I := Count - 1 downto 0 do if Items[I].GroupIndex = C_SpTBXRadioGroupIndex then Delete(I); DoFillStrings; // Create group items for I := 0 to FStrings.Count - 1 do begin A := TSpTBXItem.Create(Self); A.Caption := FStrings[I]; A.AutoCheck := False; A.GroupIndex := C_SpTBXRadioGroupIndex; A.Tag := I; A.OnClick := ItemClickEvent; Insert(I, A); if I = FDefaultIndex then A.Click; end; if Assigned(FOnUpdate) then FOnUpdate(Self); end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXSkinGroupItem } constructor TSpTBXSkinGroupItem.Create(AOwner: TComponent); begin inherited; SkinManager.AddSkinNotification(Self); end; destructor TSpTBXSkinGroupItem.Destroy; begin SkinManager.RemoveSkinNotification(Self); inherited; end; procedure TSpTBXSkinGroupItem.DoClick(AItem: TSpTBXItem); begin SkinManager.SetSkin(FStrings[AItem.Tag]); inherited; end; procedure TSpTBXSkinGroupItem.DoSkinChange; var I: Integer; begin I := FStrings.IndexOf(SkinManager.CurrentSkinName); if I > -1 then Items[I].Click; if Assigned(FOnSkinChange) then FOnSkinChange(Self); end; procedure TSpTBXSkinGroupItem.DoFillStrings; var I: Integer; begin {$IFNDEF UNICODE} SkinManager.SkinsList.GetSkinNames(FStrings.AnsiStrings); {$ELSE} SkinManager.SkinsList.GetSkinNames(FStrings); {$ENDIF} // Sort the list and move the Default skin to the top FStrings.Sort; I := FStrings.IndexOf('Default'); if I > -1 then FStrings.Move(I, 0); inherited; FDefaultIndex := FStrings.IndexOf(SkinManager.CurrentSkinName); end; procedure TSpTBXSkinGroupItem.WMSpSkinChange(var Message: TMessage); begin DoSkinChange; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXSystemMenuItem } constructor TSpTBXSystemMenuItem.Create(AOwner: TComponent); begin inherited; ItemStyle := ItemStyle + [tbisSubMenu, tbisDontSelectFirst] - [tbisRedrawOnSelChange, tbisRedrawOnMouseOverChange]; Caption := '&-'; FShowSize := True; end; function TSpTBXSystemMenuItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass; begin Result := TSpTBXSystemMenuItemViewer; end; function TSpTBXSystemMenuItem.GetSystemMenuParentForm: TCustomForm; var C: TComponent; begin Result := nil; C := GetParentComponent; if Assigned(C) and (C is TControl) then Result := GetParentForm(TControl(C)); if not Assigned(Result) and Assigned(Application.MainForm) then begin if FMDISystemMenu then Result := Application.MainForm.ActiveMDIChild else Result := Application.MainForm; end; end; procedure TSpTBXSystemMenuItem.Click; var Form: TCustomForm; begin inherited; Clear; Form := GetSystemMenuParentForm; if Assigned(Form) then SpFillSystemSpTBXPopup(Form, Self, True, True, True, True, CommandClick); end; procedure TSpTBXSystemMenuItem.CommandClick(Sender: TObject); var Form: TCustomForm; I: Integer; begin Form := GetSystemMenuParentForm; if Assigned(Form) and Assigned(Sender) then begin I := TComponent(Sender).Tag; if I = SC_MAXIMIZE then Form.WindowState := wsMaximized else SendMessage(Form.Handle, WM_SYSCOMMAND, I, GetMessagePos); end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXSystemMenuItemViewer } procedure TSpTBXSystemMenuItemViewer.CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); begin AWidth := GetSystemMetrics(SM_CXSMICON) + 2; AHeight := GetSystemMetrics(SM_CYSMICON) + 2; end; procedure TSpTBXSystemMenuItemViewer.Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); function GetIconHandle: HICON; var Form: TForm; begin Result := 0; if Assigned(Application.MainForm) then begin if TSpTBXSystemMenuItem(Item).MDISystemMenu then Form := Application.MainForm.ActiveMDIChild else Form := Application.MainForm; if Assigned(Form) then Result := Form.Icon.Handle; end; if Result = 0 then Result := Application.Icon.Handle; if Result = 0 then Result := LoadIcon(0, IDI_APPLICATION); end; var R: TRect; TempIcon: HICON; begin R := ClientAreaRect; InflateRect(R, -1, -1); TempIcon := CopyImage(GetIconHandle, IMAGE_ICON, R.Right - R.Left, R.Bottom - R.Top, LR_COPYFROMRESOURCE); try DrawIconEx(Canvas.Handle, R.Left, R.Top, TempIcon, 0, 0, 0, 0, DI_NORMAL); finally DestroyIcon(TempIcon); end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXCustomToolPalette } constructor TSpTBXCustomToolPalette.Create(AOwner: TComponent); begin inherited; FColCount := 1; FRowCount := 1; FSelectedCell.X := -1; end; function TSpTBXCustomToolPalette.DoCellClick(ACol, ARow: Integer): Boolean; begin Result := True; if Assigned(FOnCellClick) then FOnCellClick(Self, ACol, ARow, Result); end; procedure TSpTBXCustomToolPalette.DoChange; begin if Assigned(FOnChange) then FOnChange(Self); end; procedure TSpTBXCustomToolPalette.DoDrawCellImage(ACanvas: TCanvas; const ARect: TRect; ACol, ARow: Integer; ItemInfo: TSpTBXMenuItemInfo); begin if Assigned(FOnDrawCellImage) then FOnDrawCellImage(Self, ACanvas, ARect, ACol, ARow, ItemInfo.Checked, ItemInfo.HotTrack, ItemInfo.Enabled); end; procedure TSpTBXCustomToolPalette.DoGetCellHint(ACol, ARow: Integer; var AHint: WideString); begin if Assigned(FOnGetCellHint) then FOnGetCellHint(Self, ACol, ARow, AHint); end; function TSpTBXCustomToolPalette.GetItemViewerClass(AView: TTBView): TTBItemViewerClass; begin Result := TSpTBXToolViewer; end; procedure TSpTBXCustomToolPalette.HandleClickCell(ACol, ARow: Integer); begin if DoCellClick(ACol, ARow) then SetSelectedCell(Point(ACol, ARow)); end; procedure TSpTBXCustomToolPalette.SetColCount(Value: TSpTBXRowColCount); begin if FColCount <> Value then begin FColCount := Value; Change(True); end; end; procedure TSpTBXCustomToolPalette.SetRowCount(Value: TSpTBXRowColCount); begin if FRowCount <> Value then begin FRowCount := Value; Change(True); end; end; procedure TSpTBXCustomToolPalette.SetSelectedCell(Value: TPoint); begin FSelectedCell := Value; Change(True); DoChange; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXToolViewer } constructor TSpTBXToolViewer.Create(AView: TTBView; AItem: TTBCustomItem; AGroupLevel: Integer); begin inherited; FColCount := TSpTBXCustomToolPalette(AItem).ColCount; FRowCount := TSpTBXCustomToolPalette(AItem).RowCount; end; procedure TSpTBXToolViewer.CalcCellSize(ACanvas: TCanvas; var AWidth, AHeight: Integer); var ImageSize: TSize; begin ImageSize := GetImageSize; AWidth := ImageSize.cx + 6; AHeight := ImageSize.cy + 6; end; procedure TSpTBXToolViewer.CalcSize(const Canvas: TCanvas; var AWidth, AHeight: Integer); var W, H: Integer; MarginsInfo: TSpTBXMenuItemMarginsInfo; begin if IsToolbarStyle then FIndent := 0 else begin if View.Window is TSpTBXPopupWindow then CurrentSkin.GetMenuItemMargins(Canvas, TSpTBXPopupWindow(View.Window).MaximumImageSize.cx, MarginsInfo) else CurrentSkin.GetMenuItemMargins(Canvas, 0, MarginsInfo); FIndent := MarginsInfo.GutterSize + MarginsInfo.ImageTextSpace + MarginsInfo.LeftCaptionMargin - 3; end; FColCount := Item.ColCount; FRowCount := Item.RowCount; CalcCellSize(Canvas, W, H); AWidth := FIndent + W * FColCount; if not IsToolbarStyle then Inc(AWidth, MarginsInfo.RightCaptionMargin); AHeight := H * FRowCount; if AWidth < 8 then AWidth := 8; if AHeight < 8 then AHeight := 8; end; procedure TSpTBXToolViewer.DoDrawHint(AHintBitmap: TBitmap; CursorPos: TPoint; var CursorRect: TRect; var AHint: Widestring; var PaintDefault: Boolean); var Col, Row: Integer; begin if GetCellAt(CursorPos.X - BoundsRect.Left, CursorPos.Y - BoundsRect.Top, Col, Row) then begin AHint := GetCellHint(Col, Row); CursorRect := GetCellRect(CursorRect, Col, Row); inherited DoDrawHint(AHintBitmap, CursorPos, CursorRect, AHint, PaintDefault); end else PaintDefault := False; end; procedure TSpTBXToolViewer.DrawCellImage(ACanvas: TCanvas; const ARect: TRect; Col, Row: Integer; ItemInfo: TSpTBXMenuItemInfo); var I: Integer; IL: TCustomImageList; begin if not Item.CustomImages then begin I := GetImageIndex(Col, Row); IL := Item.Images; SpDrawImageList(ACanvas, ARect, IL, I, ItemInfo.Enabled, True); end; Item.DoDrawCellImage(ACanvas, ARect, Col, Row, ItemInfo); end; procedure TSpTBXToolViewer.Entering; begin FHotCell := Point(-1, 0); if (View is TSpTBXPopupWindowView) and Assigned(View.Selected) then begin if View.Selected.Index > Index then begin FHotCell := Point(FColCount - 1, FRowCount - 1); while (FHotCell.X > 0) and not IsCellVisible(FHotCell) do Dec(FHotCell.X); end else if View.Selected.Index < Index then FHotCell := Point(0, 0); end; inherited; end; function TSpTBXToolViewer.GetCellAt(X, Y: Integer; out Col, Row: Integer): Boolean; begin if (FCellWidth = 0) or (FCellHeight = 0) then begin Col := 0; Row := 0; end else begin Col := (X - FIndent) div FCellWidth; Row := Y div FCellHeight; end; Result := (Col >= 0) and (Row >= 0) and (Col < FColCount) and (Row < FRowCount); end; function TSpTBXToolViewer.GetCellHint(Col, Row: Integer): WideString; begin Result := ''; Item.DoGetCellHint(Col, Row, Result); end; function TSpTBXToolViewer.GetCellRect(ClientAreaRect: TRect; Col, Row: Integer): TRect; begin Result := Bounds(ClientAreaRect.Left + FIndent + Col * FCellWidth, ClientAreaRect.Top + Row * FCellHeight, FCellWidth, FCellHeight); end; function TSpTBXToolViewer.GetImageIndex(Col, Row: Integer): Integer; begin Result := Col + Row * FColCount; end; function TSpTBXToolViewer.GetImageShown: Boolean; begin Result := True; end; function TSpTBXToolViewer.GetImageSize: TSize; var IL: TCustomImageList; begin if Item.CustomImages then IL := nil else IL := Item.Images; if Assigned(IL) then begin Result.cx := IL.Width; Result.cy := IL.Height; end else begin Result.cx := 12; Result.cy := 12; end; end; function TSpTBXToolViewer.GetItem: TSpTBXCustomToolPalette; var TBItem: TTBCustomItem; begin TBItem := inherited Item; if Assigned(TBItem) then Result := TBItem as TSpTBXCustomToolPalette else Result := nil; end; procedure TSpTBXToolViewer.InvalidateCell(ACol, ARow: Integer); var R: TRect; begin R := GetCellRect(BoundsRect, ACol, ARow); InvalidateRect(View.Window.Handle, @R, False); end; function TSpTBXToolViewer.IsCellVisible(Cell: TPoint): Boolean; var IL: TCustomImageList; begin Result := (Cell.X >= 0) and (Cell.Y >= 0) and (Cell.X < FColCount) and (Cell.Y < FRowCount); if Result and not Item.CustomImages then begin IL := Item.Images; if Assigned(IL) then Result := (Cell.X + Cell.Y * FColCount) < IL.Count; end; end; procedure TSpTBXToolViewer.KeyDown(var Key: Word; Shift: TShiftState); var OldPos, Pos: TPoint; begin if IsCellVisible(FHotCell) then OldPos := FHotCell else if IsCellVisible(Item.SelectedCell) then OldPos := Item.SelectedCell else OldPos.X := -1; if OldPos.X >= 0 then begin Pos := OldPos; case Key of VK_LEFT: begin Dec(Pos.X); if Pos.X < 0 then begin Pos.X := FColCount - 1; Dec(Pos.Y); end; end; VK_UP: Dec(Pos.Y); VK_RIGHT: begin Inc(Pos.X); if Pos.X >= FColCount then begin Pos.X := 0; Inc(Pos.Y); end; end; VK_DOWN: Inc(Pos.Y); VK_PRIOR: Pos.Y := 0; VK_NEXT: Pos.Y := FRowCount - 1; VK_HOME: Pos.X := 0; VK_END: Pos.Y := FColCount - 1; VK_RETURN: if IsCellVisible(FHotCell) then begin Item.HandleClickCell(FHotCell.X, FHotCell.Y); Exit; end; else inherited; Exit; end; end else begin OldPos := Point(-1, 0); Pos := Point(0, 0); end; if ((OldPos.X <> Pos.X) or (OldPos.Y <> Pos.Y)) and IsCellVisible(Pos) then begin Key := 0; FHotCell := Pos; Item.Change(False); end; end; procedure TSpTBXToolViewer.MouseDown(Shift: TShiftState; X, Y: Integer; var MouseDownOnMenu: Boolean); begin FMouseIsDown := True; MouseMove(X, Y); inherited; View.SetCapture; end; procedure TSpTBXToolViewer.MouseMove(X, Y: Integer); var OldHotCell: TPoint; begin OldHotCell := FHotCell; if not GetCellAt(X, Y, FHotCell.X, FHotCell.Y) then FHotCell := Point(-1, 0); if (FHotCell.X <> OldHotCell.X) or (FHotCell.Y <> OldHotCell.Y) then if Show and not IsRectEmpty(BoundsRect) {and not (Item is TTBControlItem)} then begin Include(State, tbisInvalidated); InvalidateCell(OldHotCell.X, OldHotCell.Y); InvalidateCell(FHotCell.X, FHotCell.Y); end; end; procedure TSpTBXToolViewer.MouseUp(X, Y: Integer; MouseWasDownOnMenu: Boolean); var Col, Row: Integer; begin FMouseIsDown := False; if GetCellAt(X, Y, Col, Row) then Item.HandleClickCell(Col, Row); View.EndModalWithClick(Self); inherited; end; procedure TSpTBXToolViewer.Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); var I, J: Integer; ItemInfo: TSpTBXMenuItemInfo; CellRect: TRect; ItemHotTrack: Boolean; ImageSize: TSize; begin CalcCellSize(Canvas, FCellWidth, FCellHeight); SpFillItemInfo(Canvas, Self, ItemInfo); ItemInfo.ToolbarStyle := True; ItemHotTrack := False; if IsSelected then if not ItemInfo.Enabled and not View.MouseOverSelected then ItemHotTrack := True else if ItemInfo.Enabled then ItemHotTrack := True; for J := 0 to FRowCount - 1 do for I := 0 to FColCount - 1 do if IsCellVisible(Point(I, J)) then begin ItemInfo.HotTrack := False; ItemInfo.Pushed := False; if ItemHotTrack and (FHotCell.X = I) and (FHotCell.Y = J) then begin ItemInfo.HotTrack := True; if IsPushed then ItemInfo.Pushed := True end; if (Item.SelectedCell.X = I) and (Item.SelectedCell.Y = J) then ItemInfo.Checked := True else ItemInfo.Checked := False; ItemInfo.State := CurrentSkin.GetState(ItemInfo.Enabled, ItemInfo.Pushed, ItemInfo.HotTrack, ItemInfo.Checked); CellRect := GetCellRect(ClientAreaRect, I, J); // Paint the cell SpDrawXPMenuItem(Canvas, CellRect, ItemInfo); ImageSize := GetImageSize; CellRect := SpCenterRect(CellRect, ImageSize.cx, ImageSize.cy); DrawCellImage(Canvas, CellRect, I, J, ItemInfo); end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXColorPalette } constructor TSpTBXColorPalette.Create(AOwner: TComponent); begin inherited; CustomImages := True; FCustomColors := False; ColCount := CPDefaultCols; RowCount := CPDefaultRows; // 40 Default Colors Options := Options + [tboShowHint]; FColor := clNone; end; procedure TSpTBXColorPalette.DoChange; begin if SelectedCell.X >= 0 then FColor := GetCellColor(SelectedCell.X, SelectedCell.Y); inherited; end; procedure TSpTBXColorPalette.DoDrawCellImage(ACanvas: TCanvas; const ARect: TRect; ACol, ARow: Integer; ItemInfo: TSpTBXMenuItemInfo); var R: TRect; begin R := ARect; ACanvas.Brush.Color := clBtnShadow; ACanvas.FrameRect(R); InflateRect(R, -1, -1); if ItemInfo.Enabled then begin ACanvas.Brush.Color := GetCellColor(ACol, ARow); ACanvas.FillRect(R); end; end; procedure TSpTBXColorPalette.DoGetCellHint(ACol, ARow: Integer; var AHint: WideString); var C: TColor; begin GetCellInfo(ACol, ARow, C, AHint); end; function TSpTBXColorPalette.FindCell(AColor: TColor): TPoint; var I, J: Integer; C: TColor; begin if AColor <> clNone then AColor := ColorToRGB(AColor); for J := 0 to RowCount - 1 do for I := 0 to ColCount - 1 do begin C := GetCellColor(I, J); if C <> clNone then C := ColorToRGB(C); if C = AColor then begin Result.X := I; Result.Y := J; Exit; end; end; Result.X := -1; Result.Y := 0; end; function TSpTBXColorPalette.GetCellColor(ACol, ARow: Integer): TColor; var W: WideString; begin GetCellInfo(ACol, ARow, Result, W); end; procedure TSpTBXColorPalette.GetCellInfo(ACol, ARow: Integer; out AColor: TColor; out AName: WideString); var I: Integer; begin AColor := clNone; AName := ''; if not FCustomColors then begin I := ACol + ARow * ColCount; if (I > -1) and (I < CPDefaultCols * CPDefaultRows) then begin AColor := CPDefaultColors[I].Value; AName := CPDefaultColors[I].Name; end; end; if Assigned(FOnGetColor) then FOnGetColor(Self, ACol, ARow, AColor, AName); end; procedure TSpTBXColorPalette.SetColor(Value: TColor); begin FColor := Value; SelectedCell := FindCell(Value); end; procedure TSpTBXColorPalette.SetCustomColors(const Value: Boolean); begin if FCustomColors <> Value then begin FCustomColors := Value; if not Value then begin RowCount := CPDefaultCols; ColCount := CPDefaultRows; end; Change(True); end; end; procedure TSpTBXColorPalette.SetColCount(Value: TSpTBXRowColCount); begin if FCustomColors then inherited SetColCount(Value) else inherited SetColCount(CPDefaultCols); end; procedure TSpTBXColorPalette.SetRowCount(Value: TSpTBXRowColCount); begin if FCustomColors then inherited SetRowCount(Value) else inherited SetRowCount(CPDefaultRows); end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXItemCache } procedure TSpTBXItemCache.Assign(Source: TPersistent); var C: TSpTBXItemCache; begin if Source is TSpTBXItemCache then begin C := Source as TSpTBXItemCache; Dock := C.Dock; Item := C.Item; Width := C.Width; Height := C.Height; ParentWidth := C.ParentWidth; ParentHeight := C.ParentHeight; end else inherited Assign(Source); end; function TSpTBXItemCache.GetName: TComponentName; begin if Assigned(FItem) then Result := FItem.Name else Result := FName; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXItemCacheCollection } function TSpTBXItemCacheCollection.Add(AItem: TTBCustomItem): Integer; var F: TSpTBXItemCache; begin F := TSpTBXItemCache(inherited Add); F.Item := AItem; Result := F.Index; end; function TSpTBXItemCacheCollection.GetItem(Index: Integer): TSpTBXItemCache; begin Result := TSpTBXItemCache(inherited Items[Index]); end; function TSpTBXItemCacheCollection.IndexOf(AItem: TTBCustomItem): Integer; var I: Integer; begin Result := -1; if Assigned(AItem) then for I := 0 to Count - 1 do if Items[I].Item = AItem then begin Result := I; Break; end; end; procedure TSpTBXItemCacheCollection.SetItem(Index: Integer; const Value: TSpTBXItemCache); begin inherited Items[Index] := Value; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXDock } constructor TSpTBXDock.Create(AOwner: TComponent); begin inherited; Color := clNone; SkinManager.AddSkinNotification(Self); end; destructor TSpTBXDock.Destroy; begin SkinManager.RemoveSkinNotification(Self); inherited; end; function TSpTBXDock.CanResize(var NewWidth, NewHeight: Integer): Boolean; begin FPrevWidth := Width; FPrevHeight := Height; Result := inherited CanResize(NewWidth, NewHeight); end; procedure TSpTBXDock.DoDrawBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin if Assigned(FOnDrawBackground) then FOnDrawBackground(Self, ACanvas, ARect, PaintStage, PaintDefault); end; procedure TSpTBXDock.DrawBackground(DC: HDC; const DrawRect: TRect); var ACanvas: TCanvas; PaintDefault: Boolean; begin // OnDrawBackground should be used to paint all the toolbars + dock, it is // used by TSpTBXStatusBar and TSpTBXDockablePanel to paint the whole client // area with custom painting. // OnDrawBackground is triggered by the Dock and by the docked Toolbar. if (csDestroying in ComponentState) then Exit; ACanvas := TCanvas.Create; try ACanvas.Handle := DC; ACanvas.Lock; PaintDefault := True; DoDrawBackground(ACanvas, DrawRect, pstPrePaint, PaintDefault); if PaintDefault then begin // Paint the Bitmap if it's assigned, or use the skin or the Color if UsingBitmap then inherited else if Color = clNone then SpDrawXPDock(ACanvas, DrawRect, SkinManager.GetSkinType, Position in [dpLeft, dpRight]) else begin ACanvas.Brush.Color := Color; ACanvas.FillRect(DrawRect); end; end; PaintDefault := True; DoDrawBackground(ACanvas, DrawRect, pstPostPaint, PaintDefault); finally ACanvas.Unlock; ACanvas.Handle := 0; ACanvas.Free; end; end; procedure TSpTBXDock.Resize; var I, J: Integer; ResizeToolbars: Boolean; V: TTBItemViewer; R: TRect; begin inherited Resize; // For anchored and right aligned items if Position in [dpLeft, dpRight] then ResizeToolbars := Height < FPrevHeight else ResizeToolbars := Width < FPrevWidth; if ResizeToolbars then for I := 0 to ToolbarCount - 1 do if Toolbars[I] is TSpTBXToolbar then TSpTBXToolbar(Toolbars[I]).Resize; // Invalidate the dock and the toolbars for J := 0 to ToolbarCount - 1 do begin Invalidate; if Toolbars[J] is TSpTBXToolbar then begin with TSpTBXToolbar(Toolbars[J]) do begin // Invalidate Control Items 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) then View.Invalidate(V); end; // Invalidate Toolbar Update; if HandleAllocated then RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE); // Invalidate Items 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) then begin R := V.BoundsRect; ValidateRect(Handle, @R); end; end; end; end else if Toolbars[J] is TSpTBXCustomToolWindow then with TSpTBXCustomToolWindow(Toolbars[J]) do begin if HandleAllocated then RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE); end; end; end; function TSpTBXDock.UsingBackground: Boolean; begin // UsingBackground is used by TTB2Dock to repaint the Dock and Toolbars // To check if the Dock is using a Bitmap use SpIsDockUsingBitmap instead Result := True; end; function TSpTBXDock.UsingBitmap: Boolean; begin Result := SpIsDockUsingBitmap(Self); end; procedure TSpTBXDock.WMEraseBkgnd(var Message: TWMEraseBkgnd); begin DrawBackground(Message.DC, ClientRect); Message.Result := 1; end; procedure TSpTBXDock.WMMove(var Message: TWMMove); begin FMoving := True; inherited; FMoving := False; end; procedure TSpTBXDock.WMSize(var Message: TWMSize); begin FResizing := True; inherited; FResizing := False; end; procedure TSpTBXDock.WMSpSkinChange(var Message: TMessage); begin Invalidate; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXToolbarView } constructor TSpTBXToolbarView.Create(AOwner: TComponent; AParentView: TTBView; AParentItem: TTBCustomItem; AWindow: TWinControl; AIsToolbar, ACustomizing, AUsePriorityList: Boolean); begin inherited; FMaxSize := -1; end; procedure TSpTBXToolbarView.DoUpdatePositions(var ASize: TPoint); var I, W, H: Integer; CtlCanvas: TControlCanvas; begin // Find the tallest item size so we can stretch the items // vertically (if Toolbar.Stretch is true) FTallestItemSize := 0; if Assigned(Window) and Window.HandleAllocated and (Window.ClientWidth > 0) and (Window.ClientHeight > 0) and (ViewerCount > 2) and not IsUpdating then begin CtlCanvas := TControlCanvas.Create; try CtlCanvas.Control := Window; for I := 0 to ViewerCount - 1 do begin W := 0; H := 0; if TTBCustomItem(Viewers[I].Item).Visible then if Viewers[I] is TSpTBXItemViewer then TSpTBXItemViewer(Viewers[I]).InternalCalcSize(CtlCanvas, False, W, H) else TTBItemViewerAccess(Viewers[I]).CalcSize(CtlCanvas, W, H); if Orientation = tbvoVertical then begin if W > FTallestItemSize then FTallestItemSize := W; end else if H > FTallestItemSize then FTallestItemSize := H; end; finally CtlCanvas.Free; end; end; inherited DoUpdatePositions(ASize); end; procedure TSpTBXToolbarView.BeginUpdate; begin Inc(FUpdating); inherited BeginUpdate; end; procedure TSpTBXToolbarView.EndUpdate; begin Dec(FUpdating); inherited EndUpdate; if FUpdating = 0 then if Assigned(Owner) and (Owner is TSpTBXToolbar) then begin TSpTBXToolbar(Owner).RightAlignItems; TSpTBXToolbar(Owner).AnchorItems; end; end; function TSpTBXToolbarView.IsUpdating: Boolean; begin Result := FUpdating > 0; end; procedure TSpTBXToolbarView.SetMaxSize(const Value: Integer); begin if FMaxSize <> Value then begin FMaxSize := Value; UpdatePositions; end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXToolbar } constructor TSpTBXToolbar.Create(AOwner: TComponent); begin inherited; ControlStyle := ControlStyle - [csOpaque]; Color := clNone; Items.RegisterNotification(DoItemNotification); FAnchoredControlItems := TSpTBXItemCacheCollection.Create(TSpTBXItemCache); FChevronVertical := True; FCustomizable := True; FDefaultToolbarBorderSize := CDefaultToolbarBorderSize; FDisplayMode := tbdmSelectiveCaption; SkinManager.AddSkinNotification(Self); end; destructor TSpTBXToolbar.Destroy; begin SkinManager.RemoveSkinNotification(Self); Items.UnRegisterNotification(DoItemNotification); FAnchoredControlItems.Free; inherited; end; procedure TSpTBXToolbar.CreateWindowHandle(const Params: TCreateParams); begin {$IFNDEF UNICODE} CreateUnicodeHandle(Self, Params, ''); {$ELSE} inherited; {$ENDIF} end; procedure TSpTBXToolbar.DefineProperties(Filer: TFiler); begin inherited; // Don't let the streaming system store the WideStrings, // we need to store them manually SpPersistent_AfterInherited_DefineProperties(Filer, Self); end; procedure TSpTBXToolbar.DoDrawBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin if Assigned(FOnDrawBackground) then FOnDrawBackground(Self, ACanvas, ARect, PaintStage, PaintDefault); end; procedure TSpTBXToolbar.DoItemClick(Item: TTBCustomItem; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin // Force OnClick event, by default tbisClicksTransparent Items doesn't get executed if (Button = mbLeft) and Item.Enabled then if (tbisClicksTransparent in TTBCustomItemAccess(Item).ItemStyle) then if Assigned(Item.OnClick) then Item.OnClick(Item); end; procedure TSpTBXToolbar.DoItemNotification(Ancestor: TTBCustomItem; Relayed: Boolean; Action: TTBItemChangedAction; Index: Integer; Item: TTBCustomItem); var I: Integer; begin if (csDestroying in ComponentState) or (csReading in ComponentState) then Exit; if not (tstResizing in FState) and not IsItemMoving then begin if Assigned(FOnItemNotification) then FOnItemNotification(Self, Ancestor, Relayed, Action, Index, Item); case Action of tbicInserted: begin RightAlignItems; AnchorItems(True); end; tbicDeleting: begin I := FAnchoredControlItems.IndexOf(Item); if I > -1 then FAnchoredControlItems.Delete(I); RightAlignItems; AnchorItems(True); end; tbicInvalidateAndResize: begin RightAlignItems; end; end; end; end; procedure TSpTBXToolbar.Resize; begin FState := FState + [tstResizing]; try RightAlignItems; AnchorItems; finally FState := FState - [tstResizing]; end; inherited; end; procedure TSpTBXToolbar.AnchorItems(UpdateControlItems: Boolean); var I, J, UpdatedDelta: Integer; SpIV: TSpTBXItemViewer; Size: TPoint; CI: TTBControlItem; IV: TTBItemViewer; IsRotated: Boolean; begin if (csDestroying in ComponentState) or (tstAnchoring in FState) or not Assigned(CurrentDock) or (CurrentDock.Width = 0) or (CurrentDock.Height = 0) or not Stretch or (ShrinkMode <> tbsmNone) or IsUpdating then Exit; FState := FState + [tstAnchoring]; View.BeginUpdate; try View.ValidatePositions; IsRotated := IsVertical; // Adjust the delta, only used when inserting/deleting an item on the toolbar UpdatedDelta := 0; if (FLastSelectableWidth > 0) and UpdateControlItems then begin IV := View.NextSelectable(nil, False); if Assigned(IV) then if IsRotated then UpdatedDelta := FLastSelectableWidth - IV.BoundsRect.Bottom else UpdatedDelta := FLastSelectableWidth - IV.BoundsRect.Right; end; // Calculate the Toolbar size Size := Point(CurrentDock.Width, CurrentDock.Height); // Resize the anchored items for I := 0 to View.ViewerCount - 1 do if View.Viewers[I] is TSpTBXItemViewer then begin SpIV := View.Viewers[I] as TSpTBXItemViewer; if SpIV.Item.Anchored then begin // Revalidate FAnchorSize and set FAnchorDelta if (SpIV.FAnchorSize.X = 0) and (SpIV.FAnchorSize.Y = 0) then SpIV.FAnchorSize := Size; // Adjust the delta, only used when inserting/deleting an item on // the toolbar and resize if IsRotated then begin SpIV.FAnchorSize.Y := SpIV.FAnchorSize.Y - UpdatedDelta; SpIV.FAnchorDelta := Size.Y - SpIV.FAnchorSize.Y; end else begin SpIV.FAnchorSize.X := SpIV.FAnchorSize.X - UpdatedDelta; SpIV.FAnchorDelta := Size.X - SpIV.FAnchorSize.X; end; end; end else begin // Client align TTBControlItem items if the associated Control is client // aligned or has akRight in its Anchors property. CI := IsAnchoredControlItem(View.Viewers[I].Item); J := FAnchoredControlItems.IndexOf(View.Viewers[I].Item); if Assigned(CI) then begin // Add the TTBControlItem item to the list if its not there if J = -1 then begin J := FAnchoredControlItems.Add(CI); FAnchoredControlItems[J].Width := CI.Control.Width; FAnchoredControlItems[J].Height := CI.Control.Height; FAnchoredControlItems[J].ParentWidth := Size.X; FAnchoredControlItems[J].ParentHeight := Size.Y; FAnchoredControlItems[J].Dock := CurrentDock; end; // Resize if FAnchoredControlItems[J].Dock = CurrentDock then begin FAnchoredControlItems[J].Width := FAnchoredControlItems[J].Width + UpdatedDelta; CI.Control.Width := FAnchoredControlItems[J].Width + (Size.X - FAnchoredControlItems[J].ParentWidth); end; end else // If ControlItem is not valid delete it from the list if J > -1 then FAnchoredControlItems.Delete(J); end; View.UpdatePositions; finally View.EndUpdate; FState := FState - [tstAnchoring]; end; // We can't calculate the delta based on the IV.BoundsRect because // the IV is nil on tbicDeleting notification. // We have to keep track of the sum of the selectable items width IV := View.NextSelectable(nil, False); if Assigned(IV) then begin if IsRotated then FLastSelectableWidth := IV.BoundsRect.Bottom else FLastSelectableWidth := IV.BoundsRect.Right; end else FLastSelectableWidth := 0; end; function TSpTBXToolbar.IsAnchoredControlItem(Item: TTBCustomItem): TTBControlItem; var CI: TTBControlItem; begin Result := nil; if Assigned(CurrentDock) and (Item is TTBControlItem) then begin CI := Item as TTBControlItem; if Assigned(CI.Control) and ((CI.Control.Align = alClient) or (akRight in CI.Control.Anchors)) then begin Result := CI; end else Result := nil; end; end; procedure TSpTBXToolbar.RightAlignItems; var I, VisibleWidth, RightAlignedWidth: Integer; Spacer: TSpTBXItemViewer; IsRotated: Boolean; begin if (csDestroying in ComponentState) or (tstRightAligning in FState) or not Assigned(CurrentDock) or (Items.Count <= 0) or not Stretch or (ShrinkMode <> tbsmNone) or ((CurrentDock.Width <= 0) and (CurrentDock.Height <= 0)) or IsUpdating then Exit; FState := FState + [tstRightAligning]; View.ValidatePositions; View.BeginUpdate; try // Find the spacer and the right aligned items IsRotated := IsVertical; Spacer := SpGetRightAlignedItems(View, nil, IsRotated, VisibleWidth, RightAlignedWidth); if Assigned(Spacer) then begin // Resize the spacer if IsRotated then I := CurrentDock.Height - GetRightAlignMargin - (VisibleWidth - (Spacer.BoundsRect.Bottom - Spacer.BoundsRect.Top)) else I := CurrentDock.Width - GetRightAlignMargin - (VisibleWidth - (Spacer.BoundsRect.Right - Spacer.BoundsRect.Left)); if I < 0 then I := 0; Spacer.Item.CustomWidth := I; end; View.UpdatePositions; finally View.EndUpdate; FState := FState - [tstRightAligning]; end; end; function TSpTBXToolbar.GetChevronItemClass: TTBChevronItemClass; begin Result := TSpTBXChevronItem; end; function TSpTBXToolbar.GetFloatingBorderSize: TPoint; begin if SkinManager.GetSkinType = sknSkin then Result := Point(CurrentSkin.FloatingWindowBorderSize, CurrentSkin.FloatingWindowBorderSize) else Result := inherited GetFloatingBorderSize; end; function TSpTBXToolbar.GetFloatingWindowParentClass: TTBFloatingWindowParentClass; begin Result := TSpTBXFloatingWindowParent; end; function TSpTBXToolbar.GetRightAlignMargin: Integer; begin if IsVertical then Result := NonClientHeight else Result := NonClientWidth; end; function TSpTBXToolbar.GetViewClass: TTBToolbarViewClass; begin Result := TSpTBXToolbarView; end; function TSpTBXToolbar.GetItemsTextColor(State: TSpTBXSkinStatesType): TColor; begin if vsMenuBar in View.Style then Result := CurrentSkin.GetTextColor(skncMenuBarItem, State) else Result := CurrentSkin.GetTextColor(skncToolbarItem, State); end; function TSpTBXToolbar.IsVertical: Boolean; begin Result := SpIsVerticalToolbar(Self); end; procedure TSpTBXToolbar.InternalDrawBackground(ACanvas: TCanvas; ARect: TRect; PaintOnNCArea: Boolean; PaintBorders: Boolean = True); begin SpDrawXPToolbar(Self, ACanvas, ARect, PaintOnNCArea, PaintBorders and (BorderStyle <> bsNone)); end; procedure TSpTBXToolbar.DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); var DC: HDC; R, ExcludeR: TRect; GripSize: Integer; ACanvas: TCanvas; begin if (csDestroying in ComponentState) or not Docked or not HandleAllocated then Exit; if not DrawToDC then DC := GetWindowDC(Handle) else DC := ADC; try GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top); GripSize := SpGetDragHandleSize(Self); if not DrawToDC then begin SelectNCUpdateRgn(Handle, DC, Clip); ExcludeR := R; InflateRect(ExcludeR, -DefaultToolbarBorderSize, -DefaultToolbarBorderSize); if IsVertical then Inc(ExcludeR.Top, GripSize) else Inc(ExcludeR.Left, GripSize); ExcludeClipRect(DC, ExcludeR.Left, ExcludeR.Top, ExcludeR.Right, ExcludeR.Bottom); end; ACanvas := TCanvas.Create; try ACanvas.Handle := DC; // Paint the background and borders InternalDrawBackground(ACanvas, R, True); // Paint the grip and close button SpDrawXPToolbarGrip(Self, ACanvas, R); finally ACanvas.Handle := 0; ACanvas.Free; end; finally if not DrawToDC then ReleaseDC(Handle, DC); end; end; procedure TSpTBXToolbar.CMHintShow(var Message: TCMHintShow); // Dispatch the message to the Item Viewer. // TSpTBXItemViewer will handle CM_HINTSHOW message to show unicode hints using // a custom THintWindow. 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 TSpTBXToolbar.CMControlChange(var Message: TCMControlChange); begin // When a control is dropped on the toolbar a TTBControlItem is created by // TTBCustomToolbar.CreateWrapper, unfortunately it is created with the // Self.Owner instead of the Form (Owner.Owner for CompoundToolbars like // the TabToolbar or StatusToolbar). if CompoundToolbar and Message.Inserting and not(csLoading in ComponentState) and not (csUpdating in ComponentState) then begin CreateWrapper(Items.Count, Message.Control); end else inherited; end; function TSpTBXToolbar.CreateWrapper(Index: Integer; Ctl: TControl): TTBControlItem; // CreateWrapper is used only when CompoundToolbar is true, otherwise the // wrapper is created by TB2K var I: Integer; S: String; C: TComponent; ItemsInterface: ITBItems; begin Result := nil; if SpFindControlItem(Items, Ctl) <> nil then Exit; C := Owner.Owner; // The Form Result := TTBControlItem.Create(C); Result.Control := Ctl; if (csDesigning in ComponentState) and Assigned(C) then begin { Needs a name for compatibility with form inheritance } I := 1; while True do begin S := Format('TBControlItem%d', [I]); if C.FindComponent(S) = nil then Break; Inc(I); end; Result.Name := S; end; if CompoundToolbar then begin if Assigned(Owner) and Owner.GetInterface(ITBItems, ItemsInterface) then begin if Index > ItemsInterface.GetItems.Count then Index := 0; ItemsInterface.GetItems.Insert(Index, Result) end; end else Items.Insert(Index, Result); end; procedure TSpTBXToolbar.CMDialogChar(var Message: TCMDialogChar); var I: Integer; begin if Enabled and Visible then for I := 0 to Items.Count - 1 do if Items[I] is TSpTBXCustomItem then if TSpTBXCustomItem(Items[I]).DialogChar(Message.CharCode) then begin Message.Result := 1; Exit; end; inherited; end; procedure TSpTBXToolbar.CMMouseleave(var Message: TMessage); begin inherited; if IsCustomizing and FCustomizable then begin // Clear the last DropMark InvalidateRect(Handle, @FLastDropMark, True); end; end; procedure TSpTBXToolbar.CMTextChanged(var Message: TMessage); begin inherited; if HandleAllocated then begin if Floating then RedrawWindow(TSpTBXFloatingWindowParent(Parent).Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE) else RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE) end; end; procedure TSpTBXToolbar.WMSpSkinChange(var Message: TMessage); begin if HandleAllocated and not Floating then RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN or RDW_FRAME); end; procedure TSpTBXToolbar.WMEraseBkgnd(var Message: TWMEraseBkgnd); // Same as TSpTBXToolWindow.WMEraseBkgnd var ACanvas: TCanvas; R: TRect; begin if (csDestroying in ComponentState) then Exit; Message.Result := 1; ACanvas := TCanvas.Create; ACanvas.Handle := Message.DC; try R := ClientRect; if Docked then begin InflateRect(R, DefaultToolbarBorderSize, DefaultToolbarBorderSize); if IsVertical then Dec(R.Top, SpGetDragHandleSize(Self)) else Dec(R.Left, SpGetDragHandleSize(Self)); end; InternalDrawBackground(ACanvas, R, False); finally ACanvas.Handle := 0; ACanvas.Free; end; end; procedure TSpTBXToolbar.WMSize(var Message: TWMSize); var I: Integer; V: TTBItemViewer; R: TRect; begin inherited; if Docked and ((CurrentDock is TSpTBXDock) and not TSpTBXDock(CurrentDock).FResizing) then begin 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) then View.Invalidate(V); end; Self.Update; 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) then begin R := V.BoundsRect; ValidateRect(Handle, @R); end; end; end; end; {$IFNDEF UNICODE} function TSpTBXToolbar.IsCaptionStored: Boolean; begin Result := TntControl_IsCaptionStored(Self); end; function TSpTBXToolbar.GetCaption: TWideCaption; begin Result := TntControl_GetText(Self); end; procedure TSpTBXToolbar.SetCaption(const Value: TWideCaption); begin TntControl_SetText(Self, Value); end; function TSpTBXToolbar.GetHint: WideString; begin Result := TntControl_GetHint(Self); end; procedure TSpTBXToolbar.SetHint(const Value: WideString); begin TntControl_SetHint(Self, Value); end; {$ENDIF} procedure TSpTBXToolbar.SetCustomizable(const Value: Boolean); begin if FCustomizable <> Value then begin if FMenuBar then FCustomizable := False else FCustomizable := Value; end; end; procedure TSpTBXToolbar.SetDisplayMode(const Value: TSpTBXToolbarDisplayMode); begin if FDisplayMode <> Value then begin FDisplayMode := Value; if Value = tbdmImageAboveCaption then Options := Options + [tboImageAboveCaption, tboSameWidth] else Options := Options - [tboImageAboveCaption, tboSameWidth]; View.UpdatePositions; end; end; function TSpTBXToolbar.GetMaxSize: Integer; begin if Assigned(View) then Result := TSpTBXToolbarView(View).MaxSize else Result := -1; end; procedure TSpTBXToolbar.SetMaxSize(const Value: Integer); begin if Assigned(View) then TSpTBXToolbarView(View).MaxSize := Value; end; procedure TSpTBXToolbar.SetMenuBar(const Value: Boolean); begin inherited MenuBar := Value; FMenuBar := inherited MenuBar; FCustomizable := not FMenuBar; end; procedure TSpTBXToolbar.BeginUpdate; begin TSpTBXToolbarView(View).BeginUpdate; end; procedure TSpTBXToolbar.EndUpdate; begin TSpTBXToolbarView(View).EndUpdate; end; function TSpTBXToolbar.IsUpdating: Boolean; begin Result := TSpTBXToolbarView(View).IsUpdating; end; procedure TSpTBXToolbar.BeginItemMove; begin Inc(FItemMovingCount); end; procedure TSpTBXToolbar.EndItemMove; begin Dec(FItemMovingCount); if FItemMovingCount < 0 then FItemMovingCount := 0; end; function TSpTBXToolbar.IsItemMoving: Boolean; begin Result := FItemMovingCount > 0; end; procedure TSpTBXToolbar.BeginCustomize; begin Inc(FCustomizingCount); end; procedure TSpTBXToolbar.EndCustomize; begin Dec(FCustomizingCount); if FCustomizingCount < 0 then FCustomizingCount := 0; end; function TSpTBXToolbar.IsCustomizing: Boolean; begin Result := FCustomizingCount > 0; end; function TSpTBXToolbar.CanDragCustomize(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean; var IV: TTBItemViewer; begin Result := False; FBeginDragIV := nil; if not (csDesigning in ComponentState) and IsCustomizing then begin Result := True; if FCustomizable then begin IV := SpGetItemViewerFromPoint(Items, View, Point(X, Y)); if Assigned(IV) and Assigned(IV.Item) and not (IV.Item is TTBChevronItem) then begin FBeginDragIV := IV; BeginDrag(True); end; end; end; end; function TSpTBXToolbar.CanItemClick(Item: TTBCustomItem; Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean; begin Result := True; end; procedure TSpTBXToolbar.MouseMove(Shift: TShiftState; X, Y: Integer); var Item: TTBCustomItem; begin inherited; // Handle the Toolbar items hints // Set the Toolbar.Hint to change the Application.Hint when the // mouse is over the Item. // From TB2Toolbar.MouseMove if not (csDesigning in ComponentState) then begin if Assigned(View.Selected) then begin Item := View.Selected.Item; if not (tboLongHintInMenuOnly in Item.EffectiveOptions) then if Item is TSpTBXCustomItem then Hint := TSpTBXCustomItem(Item).Hint else Hint := Item.Hint; // Send MouseMove to the selected viewer (with TB2K MouseMove is only // called when the modal handler is active, we need this on the toolbar // for the tab close button) if View.Selected is TSpTBXItemViewer then TSpTBXItemViewer(View.Selected).InternalMouseMove(Shift, X, Y); end; end; end; procedure TSpTBXToolbar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var OldParent: TWinControl; CurrentPos, OldPos: TPoint; Item: TTBCustomItem; begin if not (csDesigning in ComponentState) and not CanDragCustomize(Button, Shift, X, Y) then begin OldParent := Parent; OldPos := ClientToScreen(Point(Left, Top)); if Assigned(View.Selected) then Item := View.Selected.Item else Item := nil; if CanItemClick(Item, Button, Shift, X, Y) then inherited; // Check if the Parent was changed due to the toolbar moving between docks if (Parent = OldParent) and Assigned(View.Selected) then begin // Check if the toolbar was moved across the screen CurrentPos := ClientToScreen(Point(Left, Top)); if (CurrentPos.X = OldPos.X) and (CurrentPos.Y = OldPos.Y) then DoItemClick(View.Selected.Item, Button, Shift, X, Y); // Extra click processing end; end; end; procedure TSpTBXToolbar.DoStartDrag(var DragObject: TDragObject); begin if IsCustomizing and FCustomizable and Assigned(FBeginDragIV) and Assigned(FBeginDragIV.Item) then begin // TSpTBXItemDragObject will be automatically destroyed since it's // a descendant of TDragObjectEx. // It's destroyed on Controls.DragDone DragObject := TSpTBXItemDragObject.Create(Self, FBeginDragIV.Item); inherited DoStartDrag(DragObject); end; end; procedure TSpTBXToolbar.DragOver(Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var DestIV: TTBItemViewer; DestPos: Integer; DropMark: TRect; begin inherited DragOver(Source, X, Y, State, Accept); if IsCustomizing and FCustomizable then begin Accept := True; SpGetDropPosItemViewer(Items, View, Point(X, Y), DestIV, DestPos, DropMark); if not EqualRect(DropMark, FLastDropMark) then begin // Clear the last DropMark InvalidateRect(Handle, @FLastDropMark, True); // Draw the new DropMark SpDrawDropMark(Canvas, DropMark); FLastDropMark := DropMark; end; end; end; procedure TSpTBXToolbar.DragDrop(Source: TObject; X, Y: Integer); var D: TSpTBXItemDragObject; DestIV: TTBItemViewer; OrigItem: TTBCustomItem; OrigPos, DestPos: Integer; DropMark: TRect; begin if Assigned(Source) and (Source is TSpTBXItemDragObject) then begin D := Source as TSpTBXItemDragObject; OrigItem := D.SouceItem; OrigPos := OrigItem.Parent.IndexOf(OrigItem); // Get the destination item position if X < 0 then X := 0; if Y < 0 then Y := 0; SpGetDropPosItemViewer(Items, View, Point(X, Y), DestIV, DestPos, DropMark); if OrigItem.Parent = Items then begin if DestPos > OrigPos then dec(DestPos); if (OrigPos = DestPos) then begin // Clear the last DropMark InvalidateRect(Handle, @FLastDropMark, True); Exit; end; end; if Assigned(DestIV) and (DestPos < 0) then Exit; // Insert the dragging item to the destination toolbar OrigItem.Parent.Remove(OrigItem); try if Assigned(DestIV) then Items.Insert(DestPos, OrigItem) else Items.Add(OrigItem); if OrigItem is TTBControlItem then if D.SourceControl <> Self then TTBControlItem(OrigItem).Control.Parent := Self; OrigItem.Visible := True; FLastDropMark := Rect(0, 0, 0, 0); except OrigItem.Parent.Insert(OrigPos, OrigItem); end; end; inherited; end; procedure TSpTBXToolbar.ReadPositionData(const Data: TTBReadPositionData); begin inherited; with Data do DisplayMode := TSpTBXToolbarDisplayMode(ReadIntProc(Name, rvSpTBXDisplayMode, 0, ExtraData)); end; procedure TSpTBXToolbar.WritePositionData(const Data: TTBWritePositionData); begin inherited; with Data do WriteIntProc(Name, rvSpTBXDisplayMode, Integer(DisplayMode), ExtraData); end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXCustomToolWindow } constructor TSpTBXCustomToolWindow.Create(AOwner: TComponent); begin inherited; FDefaultToolbarBorderSize := CDefaultToolbarBorderSize; FMinClientWidth := 32; FMinClientHeight := 32; SetBounds(Left, Top, FMinClientWidth, FMinClientHeight); Color := clNone; SkinManager.AddSkinNotification(Self); end; destructor TSpTBXCustomToolWindow.Destroy; begin SkinManager.RemoveSkinNotification(Self); inherited; end; procedure TSpTBXCustomToolWindow.CreateWindowHandle(const Params: TCreateParams); begin {$IFNDEF UNICODE} CreateUnicodeHandle(Self, Params, ''); {$ELSE} inherited; {$ENDIF} end; procedure TSpTBXCustomToolWindow.DefineProperties(Filer: TFiler); begin inherited; // Don't let the streaming system store the WideStrings, // we need to store them manually SpPersistent_AfterInherited_DefineProperties(Filer, Self); end; function TSpTBXCustomToolWindow.CalcSize(ADock: TTBDock): TPoint; begin Result.X := FBarSize.cx; Result.Y := FBarSize.cy; if Assigned(ADock) and (FullSize or Stretch) then begin // If docked and stretching, return the minimum size so that the // toolbar can shrink below FBarSize if SpIsVerticalToolbar(Self) then Result.Y := FMinClientHeight else Result.X := FMinClientWidth; end; end; function TSpTBXCustomToolWindow.DoArrange(CanMoveControls: Boolean; PreviousDockType: TTBDockType; NewFloating: Boolean; NewDock: TTBDock): TPoint; begin Result := CalcSize(NewDock); end; procedure TSpTBXCustomToolWindow.GetBaseSize(var ASize: TPoint); begin ASize := CalcSize(CurrentDock); end; procedure TSpTBXCustomToolWindow.GetMinMaxSize(var AMinClientWidth, AMinClientHeight, AMaxClientWidth, AMaxClientHeight: Integer); begin // GetMinMaxSize is used only when the window is floating AMinClientWidth := FMinClientWidth; AMinClientHeight := FMinClientHeight; AMaxClientWidth := FMaxClientWidth; AMaxClientHeight := FMaxClientHeight; end; function TSpTBXCustomToolWindow.IsVertical: Boolean; begin Result := SpIsVerticalToolbar(Self); end; procedure TSpTBXCustomToolWindow.SizeChanging(const AWidth, AHeight: Integer); begin FBarSize.cx := AWidth; FBarSize.cy := AHeight; if Assigned(Parent) then begin Dec(FBarSize.cx, Width - ClientWidth); Dec(FBarSize.cy, Height - ClientHeight); end; end; procedure TSpTBXCustomToolWindow.SetClientAreaSize(AWidth, AHeight: Integer); var R: TRect; begin if Assigned(Parent) then begin Windows.GetClientRect(Handle, R); SetBounds(Left, Top, Width - R.Right + AWidth, Height - R.Bottom + AHeight); end else SetBounds(Left, Top, AWidth, AHeight); end; procedure TSpTBXCustomToolWindow.Paint; var R: TRect; begin // Dotted border in design mode if csDesigning in ComponentState then begin R := ClientRect; Canvas.Pen.Style := psDot; Canvas.Pen.Color := clBtnShadow; Canvas.Brush.Style := bsClear; Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom); Canvas.Pen.Style := psSolid; end; end; procedure TSpTBXCustomToolWindow.InternalDrawBackground(ACanvas: TCanvas; ARect: TRect; PaintOnNCArea, PaintBorders: Boolean); begin SpDrawXPToolbar(Self, ACanvas, ARect, PaintOnNCArea, PaintBorders and (BorderStyle <> bsNone)); end; procedure TSpTBXCustomToolWindow.InvalidateBackground(InvalidateChildren: Boolean); begin // Force background repaint if not (csDestroying in ComponentState) and HandleAllocated then if InvalidateChildren then RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN) else RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE); end; procedure TSpTBXCustomToolWindow.DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); var DC: HDC; R, ExcludeR: TRect; GripSize: Integer; ACanvas: TCanvas; begin if (csDestroying in ComponentState) or not Docked or not HandleAllocated then Exit; if not DrawToDC then DC := GetWindowDC(Handle) else DC := ADC; try GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top); GripSize := SpGetDragHandleSize(Self); if not DrawToDC then begin SelectNCUpdateRgn(Handle, DC, Clip); ExcludeR := R; InflateRect(ExcludeR, -DefaultToolbarBorderSize, -DefaultToolbarBorderSize); if IsVertical then Inc(ExcludeR.Top, GripSize) else Inc(ExcludeR.Left, GripSize); ExcludeClipRect(DC, ExcludeR.Left, ExcludeR.Top, ExcludeR.Right, ExcludeR.Bottom); end; ACanvas := TCanvas.Create; try ACanvas.Handle := DC; // Paint the background and borders InternalDrawBackground(ACanvas, R, True); // Paint the grip and close button SpDrawXPToolbarGrip(Self, ACanvas, R); finally ACanvas.Handle := 0; ACanvas.Free; end; finally if not DrawToDC then ReleaseDC(Handle, DC); end; end; procedure TSpTBXCustomToolWindow.DoDrawBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin if Assigned(FOnDrawBackground) then FOnDrawBackground(Self, ACanvas, ARect, PaintStage, PaintDefault); end; procedure TSpTBXCustomToolWindow.ReadPositionData(const Data: TTBReadPositionData); var W, H: Integer; begin inherited; // Load ClientAreaWidth/ClientAreaHeight if Resizable then with Data do begin W := ReadIntProc(Name, rvClientWidth, FBarSize.cx, ExtraData); H := ReadIntProc(Name, rvClientHeight, FBarSize.cy, ExtraData); SetClientAreaSize(W, H); end; end; procedure TSpTBXCustomToolWindow.WritePositionData(const Data: TTBWritePositionData); begin inherited; // Save ClientAreaWidth/ClientAreaHeight with Data do begin WriteIntProc(Name, rvClientWidth, ClientAreaWidth, ExtraData); WriteIntProc(Name, rvClientHeight, ClientAreaHeight, ExtraData); end; end; function TSpTBXCustomToolWindow.GetFloatingBorderSize: TPoint; begin if SkinManager.GetSkinType = sknSkin then Result := Point(CurrentSkin.FloatingWindowBorderSize, CurrentSkin.FloatingWindowBorderSize) else Result := inherited GetFloatingBorderSize; end; function TSpTBXCustomToolWindow.GetFloatingWindowParentClass: TTBFloatingWindowParentClass; begin Result := TSpTBXFloatingWindowParent; end; {$IFNDEF UNICODE} function TSpTBXCustomToolWindow.IsCaptionStored: Boolean; begin Result := TntControl_IsCaptionStored(Self); end; function TSpTBXCustomToolWindow.GetCaption: TWideCaption; begin Result := TntControl_GetText(Self); end; procedure TSpTBXCustomToolWindow.SetCaption(const Value: TWideCaption); begin TntControl_SetText(Self, Value); end; {$ENDIF} function TSpTBXCustomToolWindow.GetClientAreaWidth: Integer; begin if Assigned(Parent) then Result := ClientWidth else Result := Width; end; procedure TSpTBXCustomToolWindow.SetClientAreaWidth(Value: Integer); begin SetClientAreaSize(Value, ClientAreaHeight); end; function TSpTBXCustomToolWindow.GetClientAreaHeight: Integer; begin if Assigned(Parent) then Result := ClientHeight else Result := Height; end; procedure TSpTBXCustomToolWindow.SetClientAreaHeight(Value: Integer); begin SetClientAreaSize(ClientAreaWidth, Value); end; procedure TSpTBXCustomToolWindow.CMTextChanged(var Message: TMessage); begin inherited; if HandleAllocated then begin if Floating then RedrawWindow(TSpTBXFloatingWindowParent(Parent).Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE) else RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE) end; end; procedure TSpTBXCustomToolWindow.WMEraseBkgnd(var Message: TWMEraseBkgnd); // Same as TSpTBXToolbar.WMEraseBkgnd var ACanvas: TCanvas; R: TRect; begin if (csDestroying in ComponentState) then Exit; Message.Result := 1; ACanvas := TCanvas.Create; ACanvas.Handle := Message.DC; try R := ClientRect; if Docked then begin InflateRect(R, DefaultToolbarBorderSize, DefaultToolbarBorderSize); if IsVertical then Dec(R.Top, SpGetDragHandleSize(Self)) else Dec(R.Left, SpGetDragHandleSize(Self)); end; InternalDrawBackground(ACanvas, R, False); finally ACanvas.Handle := 0; ACanvas.Free; end; end; procedure TSpTBXCustomToolWindow.WMSpSkinChange(var Message: TMessage); begin if HandleAllocated and not Floating then RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN or RDW_FRAME); end; procedure TSpTBXCustomToolWindow.WMWindowPosChanged(var Message: TWMWindowPosChanged); begin inherited; InvalidateBackground; if (Message.WindowPos.flags and SWP_NOSIZE) = 0 then begin Realign; Update; end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXFloatingWindowParent } constructor TSpTBXFloatingWindowParent.CreateNew(AOwner: TComponent; Dummy: Integer); begin inherited; ScreenSnap := True; SkinManager.AddSkinNotification(Self); end; procedure TSpTBXFloatingWindowParent.CreateWnd; begin inherited; UpdateDwmNCSize; end; destructor TSpTBXFloatingWindowParent.Destroy; begin SkinManager.RemoveSkinNotification(Self); inherited; end; procedure TSpTBXFloatingWindowParent.DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN; RedrawWhat: TTBToolWindowNCRedrawWhat); const Pattern: array [0..15] of Byte = ($C6, 0, $EE, 0, $7C, 0, $38, 0, $7C, 0, $EE, 0, $C6, 0, 0, 0); var DC: HDC; R, CaptionR, CloseR: TRect; ACanvas: TCanvas; DockWindow: TTBCustomDockableWindowAccess; FloatingBorderSize: TPoint; WideCaption: WideString; IsActive: Boolean; Flags: Integer; CloseButtonWidth: Integer; SkinState: TSpTBXSkinStatesType; PatternColor: TColor; begin if not HandleAllocated then Exit; if not DrawToDC then DC := GetWindowDC(Handle) else DC := ADC; try if not DrawToDC then SelectNCUpdateRgn(Handle, DC, Clip); GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top); with R do IntersectClipRect(DC, Left, Top, Right, Bottom); ACanvas := TCanvas.Create; try ACanvas.Handle := DC; ACanvas.Brush.Color := Color; // SpDrawXPTitleBarBody needs it to paint the background GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top); DockWindow := TTBCustomDockableWindowAccess(DockableWindow); FloatingBorderSize := DockWindow.GetFloatingBorderSize; IsActive := not DockWindow.InactiveCaption; // Borders if twrdBorder in RedrawWhat then SpDrawXPTitleBarBody(ACanvas, R, IsActive, FloatingBorderSize, False); // Caption if DockWindow.ShowCaption then begin R.Bottom := R.Top + FloatingBorderSize.Y + GetSystemMetrics(SM_CYSMCAPTION); if SkinManager.GetSkinType = sknWindows then begin if twrdBorder in RedrawWhat then SpDrawXPTitleBar(ACanvas, R, IsActive, False); InflateRect(R, -FloatingBorderSize.X, 0); R.Top := R.Top + FloatingBorderSize.Y; end else begin InflateRect(R, -FloatingBorderSize.X, 0); R.Top := R.Top + FloatingBorderSize.Y; if twrdBorder in RedrawWhat then SpDrawXPTitleBar(ACanvas, R, IsActive, False); end; // Text if twrdCaption in RedrawWhat then begin CaptionR := R; OffsetRect(CaptionR, 2, 0); if DockWindow.CloseButton then Dec(CaptionR.Right, GetSystemMetrics(SM_CYSMCAPTION) + 2); ACanvas.Brush.Style := bsClear; try ACanvas.Font.Assign(SmCaptionFont); if IsActive then ACanvas.Font.Color := CurrentSkin.GetTextColor(skncWindowTitleBar, sknsNormal) else ACanvas.Font.Color := CurrentSkin.GetTextColor(skncWindowTitleBar, sknsDisabled); if DockableWindow is TSpTBXToolbar then WideCaption := TSpTBXToolbar(DockWindow).Caption else if DockableWindow is TSpTBXCustomToolWindow then WideCaption := TSpTBXCustomToolWindow(DockWindow).Caption else WideCaption := ''; SpDrawXPText(ACanvas, WideCaption, CaptionR, DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS or DT_HIDEPREFIX); finally ACanvas.Brush.Style := bsSolid; end; end; // Close button if (twrdCloseButton in RedrawWhat) and DockWindow.CloseButton then begin CloseR := R; Dec(CloseR.Bottom); CloseButtonWidth := (CloseR.Bottom - CloseR.Top) - 2 - 2; CloseR.Left := CloseR.Right - CloseButtonWidth - 2; // TB2Dock.GetCloseButtonRect CloseR.Right := CloseR.Left + CloseButtonWidth; CloseR.Top := CloseR.Top + 2; CloseR.Bottom := CloseR.Top + CloseButtonWidth; case SkinManager.GetSkinType of sknNone: begin if CloseButtonDown then DrawFrameControl(ACanvas.Handle, CloseR, DFC_CAPTION, DFCS_CAPTIONCLOSE or DFCS_PUSHED) else DrawFrameControl(ACanvas.Handle, CloseR, DFC_CAPTION, DFCS_CAPTIONCLOSE); end; sknWindows: begin if CloseButtonDown then Flags := CBS_PUSHED else if FCloseButtonHover then Flags := CBS_HOT else Flags := CBS_NORMAL; DrawThemeBackground(ThemeServices.Theme[teWindow], ACanvas.Handle, WP_SMALLCLOSEBUTTON, Flags, CloseR, nil); end; sknSkin: begin SkinState := CurrentSkin.GetState(True, CloseButtonDown, FCloseButtonHover, False); PatternColor := CurrentSkin.GetTextColor(skncWindowTitleBar, SkinState); if PatternColor = clNone then PatternColor := CurrentSkin.GetTextColor(skncToolbarItem, SkinState); CurrentSkin.PaintBackground(ACanvas, CloseR, skncToolbarItem, SkinState, True, True); SpDrawGlyphPattern(ACanvas, CloseR, 0, PatternColor); end; end; end; end; finally ACanvas.Handle := 0; ACanvas.Free; end; finally if not DrawToDC then ReleaseDC(Handle, DC); end; end; procedure TSpTBXFloatingWindowParent.RedrawCloseButton; begin if HandleAllocated and IsWindowVisible(Handle) then if SkinManager.GetSkinType <> sknNone then DrawNCArea(False, 0, 0, [twrdBorder, twrdCaption, twrdCloseButton]); end; procedure TSpTBXFloatingWindowParent.UpdateDwmNCSize; var Style: Integer; begin if HandleAllocated then begin // Make sure WS_THICKFRAME is setted only when Windows themes are used with // DwmComposition, otherwise borders are incorrectly painted on Vista Style := GetWindowLong(Handle, GWL_STYLE); if SpIsDwmCompositionEnabled and (SkinManager.GetSkinType = sknWindows) then Style := Style or WS_THICKFRAME else Style := Style and not WS_THICKFRAME; SetWindowLong(Handle, GWL_STYLE, Style); // Update the NC area size, CurrentSkin.FloatingWindowBorderSize could have changed // Make sure to resize the toolbar SpRecalcNCArea(Self); if Assigned(DockableWindow) then TTBCustomDockableWindowAccess(DockableWindow).Arrange; RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN or RDW_FRAME); SpActivateDwmNC(Self, SkinManager.GetSkinType <> sknSkin); end; end; procedure TSpTBXFloatingWindowParent.CancelNCHover; begin if FCloseButtonHover then begin FCloseButtonHover := False; RedrawCloseButton; end; end; procedure TSpTBXFloatingWindowParent.VisibleChanging; begin inherited; Caption := ''; end; procedure TSpTBXFloatingWindowParent.CMMouseLeave(var Message: TMessage); begin inherited; CancelNCHover; end; procedure TSpTBXFloatingWindowParent.WMActivateApp(var Message: TWMActivateApp); var DockWindow: TTBCustomDockableWindowAccess; begin inherited; // The floating window is not repainted correctly if HideWhenInactive is // false and the application is deactivated/activated. if HandleAllocated then begin DockWindow := TTBCustomDockableWindowAccess(DockableWindow); if not DockWindow.HideWhenInactive then RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN); end; end; procedure TSpTBXFloatingWindowParent.WMClose(var Message: TWMClose); begin if FCloseOnAltF4 then begin if Assigned(DockableWindow) then TTBCustomDockableWindowAccess(DockableWindow).Close; end else inherited; end; procedure TSpTBXFloatingWindowParent.WMEraseBkgnd(var Message: TMessage); begin Message.Result := 1; end; procedure TSpTBXFloatingWindowParent.WMNCMouseLeave(var Message: TMessage); begin if not MouseCapture then CancelNCHover; inherited; end; procedure TSpTBXFloatingWindowParent.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; RedrawCloseButton; end; end; procedure TSpTBXFloatingWindowParent.WMSpSkinChange(var Message: TMessage); begin UpdateDwmNCSize; inherited; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXPopupWindow } constructor TSpTBXPopupWindow.CreatePopupWindow(AOwner: TComponent; const AParentView: TTBView; const AItem: TTBCustomItem; const ACustomizing: Boolean); begin inherited; if AItem is TSpTBXCustomItem then if Assigned(View) and (View is TSpTBXPopupWindowView) then begin if TSpTBXCustomItem(AItem).ToolbarStylePopup then TSpTBXPopupWindowView(View).SetIsToolbar(True); end; FMaximumImageSize := SpGetMenuMaximumImageSize(View); end; destructor TSpTBXPopupWindow.Destroy; begin DoPopupShowingChanged(False); inherited; end; procedure TSpTBXPopupWindow.DoPopupShowingChanged(IsVisible: Boolean); begin if View.ParentItem is TSpTBXCustomItem then TSpTBXCustomItem(View.ParentItem).DoPopupShowingChanged(Self, IsVisible) else if View.ParentItem is TSpTBXRootItem then TSpTBXRootItem(View.ParentItem).DoPopupShowingChanged(Self, IsVisible); end; function TSpTBXPopupWindow.GetViewClass: TTBViewClass; begin Result := TSpTBXPopupWindowView; end; function TSpTBXPopupWindow.CanDrawGutter: Boolean; begin if View.IsToolbar then Result := False else begin Result := True; // Is it a toolbox? if Assigned(View) and Assigned(View.ParentItem) then begin if View.ParentItem is TSpTBXCustomItem then Result := not TSpTBXCustomItem(View.ParentItem).ToolBoxPopup else if View.ParentItem is TSpTBXRootItem then Result := not TSpTBXRootItem(View.ParentItem).ToolBoxPopup; end; end; end; procedure PopupWindowNCPaintProc(Wnd: HWND; DC: HDC; AppData: TObject); // Paints the NC area and the client background, used by WMEraseBkgnd, WMNCPaint, WMPrint var ACanvas: TCanvas; R: TRect; PopupWindow: TSpTBXPopupWindow; begin ACanvas := TCanvas.Create; try ACanvas.Handle := DC; GetWindowRect(Wnd, R); OffsetRect(R, -R.Left, -R.Top); PopupWindow := TSpTBXPopupWindow(AppData); // If it's used by WM_ERASEBKGND offset the rect if PopupWindow.FPaintingClientArea then begin PopupWindow.FPaintingClientArea := False; OffsetRect(R, -3, -3); end; PopupWindow.PaintBackground(ACanvas, R); finally ACanvas.Handle := 0; ACanvas.Free; end; end; procedure TSpTBXPopupWindow.PaintBackground(ACanvas: TCanvas; ARect: TRect); // Paints the NC area and the client background, used by WMEraseBkgnd, WMNCPaint, WMPrint var DrawGutter: Boolean; OpenIVRect: TRect; OpenIV: TTBItemViewer; OpenIVSize: Integer; begin OpenIVRect := Rect(0, 0, 0, 0); DrawGutter := False; if Assigned(View) then begin ACanvas.Font.Assign(ToolbarFont); DrawGutter := CanDrawGutter; if Assigned(View.ParentView) and CurrentSkin.OfficePopup then begin OpenIV := TTBViewAccess(View.ParentView).OpenViewer; if Assigned(OpenIV) and OpenIV.IsToolbarStyle and ((OpenIV is TSpTBXItemViewer) or (OpenIV is TSpTBXChevronItemViewer)) then begin // Get the OpenIVRect in window coordinates OpenIVRect := OpenIV.BoundsRect; OpenIVRect.TopLeft := View.ParentView.Window.ClientToScreen(OpenIVRect.TopLeft); OpenIVRect.BottomRight := View.ParentView.Window.ClientToScreen(OpenIVRect.BottomRight); OpenIVRect.TopLeft := ScreenToClient(OpenIVRect.TopLeft); OpenIVRect.BottomRight := ScreenToClient(OpenIVRect.BottomRight); OffsetRect(OpenIVRect, 3, 3); // Offset to get it on window coordinates OpenIVSize := OpenIVRect.Right - OpenIVRect.Left; // Get the Clip rect based on OpenIVRect OpenIVRect.Left := OpenIVRect.Left + ARect.Left; // ARect.Left is -3 when called by WMEraseBkgnd and is 0 when called by WMNCPaint and WMPrint OpenIVRect.Right := OpenIVRect.Left + OpenIVSize; end; end; end; SpDrawXPMenuPopupWindow(ACanvas, ARect, OpenIVRect, DrawGutter, MaximumImageSize.cx, sknSkin); end; procedure TSpTBXPopupWindow.CMHintShow(var Message: TCMHintShow); // Dispatch the message to the Item Viewer. // TSpTBXItemViewer will handle CM_HINTSHOW message to show unicode hints using // a custom THintWindow. 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 TSpTBXPopupWindow.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 HideEmptyPopup: Boolean; begin if View.ParentItem is TSpTBXSubmenuItem then HideEmptyPopup := TSpTBXSubmenuItem(View.ParentItem).HideEmptyPopup else HideEmptyPopup := False; // When the View is empty the size is set to 0 on TSpTBXPopupWindowView.AutoSize // We should disable the animation because it can't animate an empty window if HideEmptyPopup and Showing and (View.ViewerCount = 0) then begin SetWindowPos(WindowHandle, 0, 0, 0, 0, 0, ShowFlags[Showing]); end else inherited; if Visible then DoPopupShowingChanged(True); end; procedure TSpTBXPopupWindow.WMEraseBkgnd(var Message: TWMEraseBkgnd); begin case SkinManager.GetSkinType of sknNone: inherited; sknWindows: // If it's Windows theme and we're not on Vista do default painting if not SpIsWinVistaOrUp then inherited else begin Message.Result := 1; FPaintingClientArea := True; TBEndAnimation(WindowHandle); PopupWindowNCPaintProc(Handle, Message.DC, Self); end; sknSkin: begin Message.Result := 1; FPaintingClientArea := True; TBEndAnimation(WindowHandle); PopupWindowNCPaintProc(Handle, Message.DC, Self); end; end; end; procedure TSpTBXPopupWindow.WMNCPaint(var Message: TMessage); var DC: HDC; begin DC := GetWindowDC(Handle); try FPaintingClientArea := False; SelectNCUpdateRgn(Handle, DC, HRGN(Message.WParam)); PopupWindowNCPaintProc(Handle, DC, Self); finally ReleaseDC(Handle, DC); end; end; procedure TSpTBXPopupWindow.WMPrint(var Message: TMessage); begin FPaintingClientArea := False; HandleWMPrint(Handle, Message, PopupWindowNCPaintProc, Self); end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXPopupWindowView } procedure TSpTBXPopupWindowView.AutoSize(AWidth, AHeight: Integer); begin // When the View is empty the size should be 0 if (ViewerCount = 0) and (ParentItem is TSpTBXSubmenuItem) then if TSpTBXSubmenuItem(ParentItem).HideEmptyPopup then begin AWidth := -(PopupMenuWindowNCSize * 2); AHeight := -(PopupMenuWindowNCSize * 2); end; inherited AutoSize(AWidth, AHeight); end; procedure TSpTBXPopupWindowView.SetIsToolbar(const Value: Boolean); begin // Change the readonly IsToolbar property using RTTI, the property must // be published. // Tip from: http://hallvards.blogspot.com/2004/05/hack-1-write-access-to-read-only.html PBoolean(Integer(Self) + (Integer(GetPropInfo(TSpTBXPopupWindowView, 'IsToolbar').GetProc) and $00FFFFFF))^ := Value; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXChevronItem } function TSpTBXChevronItem.GetItemViewerClass(AView: TTBView): TTBItemViewerClass; begin Result := TSpTBXChevronItemViewer; end; function TSpTBXChevronItem.GetPopupWindowClass: TTBPopupWindowClass; begin Result := TSpTBXChevronPopupWindow; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXChevronItemViewer } function TSpTBXChevronItemViewer.GetTextColor(State: TSpTBXSkinStatesType): TColor; begin Result := clNone; if IsToolbarStyle then begin if View.Window is TSpTBXToolbar then Result := TSpTBXToolbar(View.Window).GetItemsTextColor(State); if Result = clNone then Result := CurrentSkin.GetTextColor(skncToolbarItem, State); end else Result := CurrentSkin.GetTextColor(skncMenuItem, State); end; procedure TSpTBXChevronItemViewer.Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsSelected, IsPushed, UseDisabledShadow: Boolean); const Pattern: array[Boolean, 0..15] of Byte = ( ($CC, 0, $66, 0, $33, 0, $66, 0, $CC, 0, 0, 0, 0, 0, 0, 0), ($88, 0, $D8, 0, $70, 0, $20, 0, $88, 0, $D8, 0, $70, 0, $20, 0)); var ItemInfo: TSpTBXMenuItemInfo; R2: TRect; P: PByte; W, H: Integer; DC: HDC; PatternColor: TColor; begin DC := Canvas.Handle; SpFillItemInfo(Canvas, Self, ItemInfo); SpDrawXPMenuItem(Canvas, ClientAreaRect, ItemInfo); // Chevron glyph R2 := ClientAreaRect; if not ItemInfo.IsVertical then begin Inc(R2.Top, 4); R2.Bottom := R2.Top + 5; W := 8; H := 5; end else begin R2.Left := R2.Right - 9; R2.Right := R2.Left + 5; W := 5; H := 8; end; if ItemInfo.Pushed then OffsetRect(R2, 1, 1); if SkinManager.GetSkinType = sknSkin then PatternColor := GetTextColor(ItemInfo.State) else PatternColor := clBtnText; P := @Pattern[ItemInfo.IsVertical][0]; if ItemInfo.Enabled then SpDrawGlyphPattern(DC, R2, W, H, P^, PatternColor) else begin OffsetRect(R2, 1, 1); SpDrawGlyphPattern(DC, R2, W, H, P^, clBtnHighlight); OffsetRect(R2, -1, -1); SpDrawGlyphPattern(DC, R2, W, H, P^, clBtnShadow); end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXChevronPopupWindow } procedure TSpTBXChevronPopupWindow.CMColorChanged(var Message: TMessage); var V: TSpTBXPopupWindowView; PV: TTBView; begin // The private FIsToolbar field of the ChevronItem is setted to True // in TTBCustomItem.CreatePopup, we need to reset it to False before // the Popup is showed. // TTBCustomItem.CreatePopup changes the PopupWindow color to clBtnFace // after it changes the FIsToolbar value (and before it is visible), // that's why we are trapping CM_COLORCHANGED to reset the field. inherited; if Assigned(View) and (View is TSpTBXPopupWindowView) then begin V := TSpTBXPopupWindowView(View); PV := V.ParentView; // Do we really need to change it? if (Color = clBtnFace) and V.IsToolbar and Assigned(PV) and Assigned(PV.Owner) and (PV.Owner is TSpTBXToolbar) and (TSpTBXToolbar(PV.Owner).ChevronVertical) then begin V.SetIsToolbar(False); Color := clMenu; end; end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXPopupMenu } function TSpTBXPopupMenu.GetOnClosePopup: TNotifyEvent; begin Result := TSpTBXRootItem(Items).OnClosePopup; end; function TSpTBXPopupMenu.GetOnInitPopup: TSpTBXPopupEvent; begin Result := TSpTBXRootItem(Items).OnInitPopup; end; function TSpTBXPopupMenu.GetRootItemClass: TTBRootItemClass; begin Result := TSpTBXRootItem; end; function TSpTBXPopupMenu.InternalPopup(X, Y: Integer; ForceFocus: Boolean; PopupControl: TControl = nil): Boolean; var P: TPoint; PopupControlRect: TRect; WinPopupControl: TWinControl; Msg: TMessage; begin Result := True; FClickedItem := nil; P := Point(X, Y); {$IFDEF JR_D9} SetPopupPoint(P); {$ELSE} PPoint(@PopupPoint)^ := P; {$ENDIF} WinPopupControl := nil; if Assigned(PopupControl) and Assigned(PopupControl.Parent) then begin PopupControlRect := PopupControl.BoundsRect; PopupControlRect.TopLeft := PopupControl.Parent.ClientToScreen(PopupControlRect.TopLeft); PopupControlRect.BottomRight := PopupControl.Parent.ClientToScreen(PopupControlRect.BottomRight); if PopupControl is TWinControl then WinPopupControl := PopupControl as TWinControl; end else PopupControlRect := Rect(X, Y, X, Y); P.X := PopupControlRect.Left; P.Y := PopupControlRect.Bottom; TSpTBXRootItem(Items).ToolBoxPopup := ToolBoxPopup; FClickedItem := Items.Popup(P.X, P.Y, TrackButton = tbRightButton, TTBPopupAlignment(Alignment), FReturnClickedItemOnly); if Assigned(WinPopupControl) then begin // Send a message to the PopupControl and it's children controls // to inform that the Popup is closed. Msg.Msg := CM_SPPOPUPCLOSE; Msg.WParam := Integer(Self); Msg.LParam := 0; Msg.Result := 0; PostMessage(WinPopupControl.Handle, Msg.Msg, Msg.WParam, Msg.LParam); WinPopupControl.Broadcast(Msg); end; end; procedure TSpTBXPopupMenu.Popup(X, Y: Integer); begin PopupEx(X, Y); end; function TSpTBXPopupMenu.PopupEx(X, Y: Integer; PopupControl: TControl = nil; ReturnClickedItemOnly: Boolean = False): TTBCustomItem; begin FReturnClickedItemOnly := ReturnClickedItemOnly; try InternalPopup(X, Y, False, PopupControl); Result := FClickedItem; finally FReturnClickedItemOnly := False; end; end; procedure TSpTBXPopupMenu.SetOnClosePopup(const Value: TNotifyEvent); begin TSpTBXRootItem(Items).OnClosePopup := Value; end; procedure TSpTBXPopupMenu.SetOnInitPopup(const Value: TSpTBXPopupEvent); begin TSpTBXRootItem(Items).OnInitPopup := Value; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXCompoundItemsControl } constructor TSpTBXCompoundItemsControl.Create(AOwner: TComponent); begin inherited; FDock := GetDockClass.Create(Self); FDock.Parent := Self; FDock.OnRequestDock := DockRequestDock; FToolbar := GetToolbarClass.Create(Self); FToolbar.CompoundToolbar := True; FToolbar.Parent := FDock; FToolbar.CurrentDock := FDock; FToolbar.Name := Name + 'Toolbar'; FToolbar.Customizable := False; FToolbar.BorderStyle := bsNone; FToolbar.DockMode := dmCannotFloatOrChangeDocks; FToolbar.DragHandleStyle := dhNone; FToolbar.Stretch := True; FToolbar.ShrinkMode := tbsmNone; FToolbar.ShowCaption := False; FSkinType := sknSkin; SkinManager.AddSkinNotification(Self); end; procedure TSpTBXCompoundItemsControl.CreateParams(var Params: TCreateParams); begin // Disable complete redraws when size changes. CS_HREDRAW and CS_VREDRAW // cause flicker and are not necessary for this control at run time // Invalidate in WMWindowPosChanged message instead. inherited CreateParams(Params); if not (csDesigning in ComponentState) then begin with Params do Style := Style or WS_CLIPCHILDREN; with Params do WindowClass.Style := WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW); end; end; destructor TSpTBXCompoundItemsControl.Destroy; begin SkinManager.RemoveSkinNotification(Self); FToolbar.Free; FDock.Free; inherited; end; procedure TSpTBXCompoundItemsControl.Loaded; var I: Integer; C: TControl; DesignerRootItem: TTBCustomItem; begin inherited; // The parent of TTBControlItem.Control should be the toolbar, not Self // (as setted in GetChildren for dfm streaming). DesignerRootItem := GetItems; for I := 0 to DesignerRootItem.Count - 1 do if DesignerRootItem[I] is TTBControlItem then begin C := TTBControlItem(DesignerRootItem[I]).Control; if Assigned(C) and (C.Parent <> FToolbar) then C.Parent := FToolbar; end; end; procedure TSpTBXCompoundItemsControl.DockRequestDock(Sender: TObject; Bar: TTBCustomDockableWindow; var Accept: Boolean); begin if Assigned(FToolbar) then Accept := Bar = FToolbar; end; procedure TSpTBXCompoundItemsControl.GetChildren(Proc: TGetChildProc; Root: TComponent); var I: Integer; C: TControl; DesignerRootItem: TTBCustomItem; begin // Needed to fake the DFM streaming system because the owner of the items // is the Form and not the Toolbar nor Self. // But the parent must be the Toolbar. // GetChildren is used to pass the children components of Self to the DFM // streaming system. // We also need to do the same with the controls of TTBControlItems. // More info on the Delphi help or Classes.TWriter.WriteData // Same as TSpTBXCompoundItemsControl and TSpTBXCustomDockablePanel DesignerRootItem := GetItems; TTBCustomItemAccess(DesignerRootItem).GetChildren(Proc, Root); for I := 0 to DesignerRootItem.Count - 1 do if (DesignerRootItem[I] is TTBControlItem) then begin C := TTBControlItem(DesignerRootItem[I]).Control; if Assigned(C) then if SpFindControl(Self, C) = -1 then Proc(C); end; inherited; end; function TSpTBXCompoundItemsControl.GetItems: TTBCustomItem; begin Result := FToolbar.Items; end; function TSpTBXCompoundItemsControl.GetRootItems: TTBRootItem; begin Result := FToolbar.Items; end; function TSpTBXCompoundItemsControl.GetDockClass: TSpTBXDockClass; begin Result := TSpTBXDock; end; function TSpTBXCompoundItemsControl.GetToolbarClass: TSpTBXToolbarClass; begin Result := TSpTBXToolbar; end; function TSpTBXCompoundItemsControl.GetView: TSpTBXToolbarView; begin Result := FToolbar.View as TSpTBXToolbarView; end; function TSpTBXCompoundItemsControl.GetImages: TCustomImageList; begin if Assigned(FToolbar) then Result := FToolbar.Images else Result := nil; end; procedure TSpTBXCompoundItemsControl.InvalidateBackground(InvalidateChildren: Boolean); begin // Invalidate will not fire WM_ERASEBKGND, because csOpaque is setted if not (csDestroying in ComponentState) and HandleAllocated then if InvalidateChildren then RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN) else RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE); end; procedure TSpTBXCompoundItemsControl.SetImages(const Value: TCustomImageList); begin if Assigned(FToolbar) then FToolbar.Images := Value; end; procedure TSpTBXCompoundItemsControl.SetName(const Value: TComponentName); begin inherited; if Name = Value then if Assigned(FToolbar) then FToolbar.Name := Name + 'Toolbar'; end; procedure TSpTBXCompoundItemsControl.SetSkinType(const Value: TSpTBXSkinType); begin if FSkinType <> Value then begin FSkinType := Value; InvalidateBackground; end; end; procedure TSpTBXCompoundItemsControl.WMSpSkinChange(var Message: TMessage); begin InvalidateBackground; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXCompoundBar } constructor TSpTBXCompoundBar.Create(AOwner: TComponent); begin inherited; Height := FDock.Height; FDock.OnDrawBackground := DrawDockBackground; FDock.OnResize := DockResize; FToolbar.OnDrawBackground := DrawToolbarBackground; end; procedure TSpTBXCompoundBar.DockResize(Sender: TObject); begin if Assigned(FDock) then if Height <> FDock.Height then Height := FDock.Height; end; procedure TSpTBXCompoundBar.DoDrawDockBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin if Assigned(FOnDrawDockBackground) then FOnDrawDockBackground(Self, ACanvas, ARect, PaintStage, PaintDefault); end; procedure TSpTBXCompoundBar.DrawDockBackground(Sender: TObject; ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); var InternalPaintDefault: Boolean; begin if PaintStage = pstPrePaint then begin // OnDrawBackground is triggered by the Dock and by the docked Toolbar. // The Toolbar triggers it only if Dock.ThemedBackground is true, which depends // on CurrentTheme.PaintDockBackground, this is done in // TTBXToolbar.WMEraseBkgnd. ACanvas.Brush.Color := clBtnFace; InternalPaintDefault := True; DoDrawDockBackground(ACanvas, ARect, pstPrePaint, InternalPaintDefault); PaintDefault := InternalPaintDefault; InternalPaintDefault := True; DoDrawDockBackground(ACanvas, ARect, pstPostPaint, InternalPaintDefault); end; end; procedure TSpTBXCompoundBar.DrawToolbarBackground(Sender: TObject; ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin // Let the background be painted by the Dock if PaintStage = pstPrePaint then PaintDefault := False; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXButtonOptions } constructor TSpTBXButtonOptions.Create(AParent: TWinControl); begin inherited Create; FToolbar := nil; if AParent is TSpTBXCompoundItemsControl then FToolbar := TSpTBXCompoundItemsControl(AParent).FToolbar; FParentControl := AParent; FCaption := True; FClose := True; FMinimize := True; FMaximize := True; FCaptionImageIndex := -1; FCloseImageIndex := -1; FMinimizeImageIndex := -1; FMaximizeImageIndex := -1; FRestoreImageIndex := -1; FTitleBarMaxSize := 21; FButtonBorders := True; CreateButtons; end; procedure TSpTBXButtonOptions.CreateButtons; begin FRightAlignSpacer := TSpTBXRightAlignSpacerItem.Create(nil); FRightAlignSpacer.FontSettings.Style := FRightAlignSpacer.FontSettings.Style + [fsBold]; FRightAlignSpacer.Wrapping := twEndEllipsis; FToolbar.Items.Add(FRightAlignSpacer); FEditableItems := TTBGroupItem.Create(nil); FToolbar.Items.Add(FEditableItems); FMinimizeButton := TSpTBXItem.Create(nil); SetupButton(FMinimizeButton); FMinimizeButton.Visible := FMinimize; FMaximizeButton := TSpTBXItem.Create(nil); SetupButton(FMaximizeButton); FMaximizeButton.Visible := FMaximize; FCloseButton := TSpTBXItem.Create(nil); SetupButton(FCloseButton); FCloseButton.Visible := FClose; SetTitleBarMaxSize(FTitleBarMaxSize); end; procedure TSpTBXButtonOptions.MoveItemToTheLeft(B: TTBCustomItem); var I: Integer; begin I := EditableItems.IndexOf(B); if I > -1 then begin EditableItems.Delete(I); I := FToolbar.Items.IndexOf(RightAlignSpacer); FToolbar.Items.Insert(I, B); end; end; procedure TSpTBXButtonOptions.SetupButton(B: TSpTBXCustomItem); begin B.CustomWidth := 17; B.CustomHeight := FTitleBarMaxSize; B.DisplayMode := nbdmImageAndText; B.OnDrawImage := ButtonsDrawImage; B.OnDrawItem := ButtonsDrawItem; B.OnClick := ButtonsClick; FToolbar.Items.Add(B); B.Visible := False; SetupButtonIcon(B); end; procedure TSpTBXButtonOptions.SetupButtonIcon(B: TSpTBXCustomItem); var Index, GlyphIndex: Integer; begin if Assigned(B) then begin Index := -1; GlyphIndex := -1; if B = FRightAlignSpacer then begin Index := FCaptionImageIndex; end else if B = FCloseButton then begin Index := FCloseImageIndex; GlyphIndex := 0; end else if B = FMaximizeButton then begin if Restoring(B) then begin Index := FRestoreImageIndex; GlyphIndex := 3; end else begin Index := FMaximizeImageIndex; GlyphIndex := 1; end; end else if B = FMinimizeButton then begin if Restoring(B) then begin Index := FRestoreImageIndex; GlyphIndex := 3; end else begin Index := FMinimizeImageIndex; GlyphIndex := 2; end; end; if Index = -1 then begin B.Images := MDIButtonsImgList; B.ImageIndex := GlyphIndex; end else begin B.Images := nil; B.ImageIndex := Index; end; end; end; procedure TSpTBXButtonOptions.UpdateButtonsVisibility; begin FRightAlignSpacer.Visible := FCaption or FClose or FMaximize or FMinimize; end; procedure TSpTBXButtonOptions.ButtonsDrawImage(Sender: TObject; ACanvas: TCanvas; State: TSpTBXSkinStatesType; const PaintStage: TSpTBXPaintStage; var AImageList: TCustomImageList; var AImageIndex: Integer; var ARect: TRect; var PaintDefault: Boolean); begin // Empty, useful for descendants end; procedure TSpTBXButtonOptions.ButtonsDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin // [Theme-Change] // Don't draw the items background if ButtonBorders is False if (PaintStage = pstPrePaint) and not ButtonBorders then PaintDefault := False; end; procedure TSpTBXButtonOptions.SetCaptionLabel(const Value: WideString); begin if FCaptionLabel <> Value then begin FCaptionLabel := Value; if Assigned(FRightAlignSpacer) then FRightAlignSpacer.Caption := Value; end; end; procedure TSpTBXButtonOptions.SetCaption(const Value: Boolean); begin FCaption := Value; if Assigned(FRightAlignSpacer) then begin if Value then FRightAlignSpacer.Caption := CaptionLabel else FRightAlignSpacer.Caption := ''; UpdateButtonsVisibility; end; end; procedure TSpTBXButtonOptions.SetClose(const Value: Boolean); begin FClose := Value; if Assigned(FCloseButton) then begin FCloseButton.Visible := Value; UpdateButtonsVisibility; end; end; procedure TSpTBXButtonOptions.SetMaximize(const Value: Boolean); begin FMaximize := Value; if Assigned(FMaximizeButton) then begin FMaximizeButton.Visible := Value; UpdateButtonsVisibility; end; end; procedure TSpTBXButtonOptions.SetMinimize(const Value: Boolean); begin FMinimize := Value; if Assigned(FMinimizeButton) then begin FMinimizeButton.Visible := Value; UpdateButtonsVisibility; end; end; procedure TSpTBXButtonOptions.SetCaptionImageIndex(Value: Integer); begin if Value < 0 then Value := -1; FCaptionImageIndex := Value; if Assigned(FRightAlignSpacer) then SetupButtonIcon(FRightAlignSpacer); end; procedure TSpTBXButtonOptions.SetCloseImageIndex(Value: Integer); begin if Value < 0 then Value := -1; FCloseImageIndex := Value; if Assigned(FCloseButton) then SetupButtonIcon(FCloseButton); end; procedure TSpTBXButtonOptions.SetMinimizeImageIndex(Value: Integer); begin if Value < 0 then Value := -1; FMinimizeImageIndex := Value; if Assigned(FMinimizeButton) then SetupButtonIcon(FMinimizeButton); end; procedure TSpTBXButtonOptions.SetMaximizeImageIndex(Value: Integer); begin if Value < 0 then Value := -1; FMaximizeImageIndex := Value; if Assigned(FMaximizeButton) then SetupButtonIcon(FMaximizeButton); end; procedure TSpTBXButtonOptions.SetRestoreImageIndex(Value: Integer); begin if Value < 0 then Value := -1; FRestoreImageIndex := Value; SetupButtonIcon(FMinimizeButton); SetupButtonIcon(FMaximizeButton); end; procedure TSpTBXButtonOptions.SetTitleBarMaxSize(const Value: Integer); begin FTitleBarMaxSize := Value; TSpTBXToolbarView(FToolbar.View).MaxSize := Value; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXStatusToolbar } constructor TSpTBXStatusToolbar.Create(AOwner: TComponent); begin inherited; FSkinType := sknSkin; FSizeGrip := True; end; destructor TSpTBXStatusToolbar.Destroy; begin FParentForm := nil; inherited; end; procedure TSpTBXStatusToolbar.DoItemNotification(Ancestor: TTBCustomItem; Relayed: Boolean; Action: TTBItemChangedAction; Index: Integer; Item: TTBCustomItem); begin inherited; if not (csDestroying in ComponentState) and not (csReading in ComponentState) and not (tstResizing in FState) and not IsItemMoving then begin if (Action = tbicInvalidateAndResize) and Assigned(Owner) and (Owner is TSpTBXCustomStatusBar) then if NeedsSeparatorRepaint then TSpTBXCustomStatusBar(Owner).InvalidateBackground; end; end; function TSpTBXStatusToolbar.GetParentFormWindowState: TWindowState; // This method is more accurate than FParentForm.WindowState var R: TRect; begin if not Assigned(FParentForm) then FParentForm := GetParentForm(Self); Result := SpGetFormWindowState(FParentForm, R); end; function TSpTBXStatusToolbar.IsPointInGrip(P: TPoint): Boolean; var GR: TRect; begin Result := False; GR := GetGripRect; if not IsRectEmpty(GR) and PtInRect(GR, P) then Result := True; end; function TSpTBXStatusToolbar.GetGripRect: TRect; var C: TWinControl; FS: TWindowState; HasGrip: Boolean; begin Result := Rect(0, 0, 0, 0); if not (csDestroying in ComponentState) and FSizeGrip and Assigned(CurrentDock) then begin FS := GetParentFormWindowState; // initializes FParentForm if Assigned(FParentForm) and FParentForm.HandleAllocated then begin C := SpFindParent(Self, TSpTBXTitleBar); if Assigned(C) and TSpTBXTitleBar(C).Active and not TSpTBXTitleBar(C).FixedSize then HasGrip := (FS = wsNormal) or not TSpTBXTitleBar(C).MouseActive else HasGrip := (FS = wsNormal) and (GetWindowLong(FParentForm.Handle, GWL_STYLE) and WS_THICKFRAME <> 0); if HasGrip then begin Result := CurrentDock.ClientRect; Result.Left := Result.Right - GetSystemMetrics(SM_CXVSCROLL); end; end; end; end; function TSpTBXStatusToolbar.GetItemsTextColor(State: TSpTBXSkinStatesType): TColor; begin if Assigned(Owner) and (Owner is TSpTBXCustomStatusBar) then Result := CurrentSkin.GetTextColor(skncStatusBar, State, TSpTBXCustomStatusBar(Owner).SkinType) else Result := clNone; end; function TSpTBXStatusToolbar.GetRightAlignMargin: Integer; var R: TRect; begin R := GetGripRect; Result := R.Right - R.Left; if Result = 0 then Result := 4; end; function TSpTBXStatusToolbar.NeedsSeparatorRepaint: Boolean; var T: TSpTBXSkinType; begin // [Theme-Change] // Office themes have rectangle panels, the separator needs // to be painted by the Toolbar. if Assigned(Owner) and (Owner is TSpTBXCustomStatusBar) then begin T := TSpTBXCustomStatusBar(Owner).SkinType; Result := (CurrentSkin.OfficeStatusBar and (T = sknSkin)) or (T = sknNone); end else Result := False; end; procedure TSpTBXStatusToolbar.SetSizeGrip(const Value: Boolean); begin if FSizeGrip <> Value then begin FSizeGrip := Value; if Assigned(Owner) and (Owner is TSpTBXStatusBar) then TSpTBXStatusBar(Owner).InvalidateBackground; end; end; procedure TSpTBXStatusToolbar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var P: TPoint; begin // Resize the StatusBar if the parent is TSpTBXTitleBar if not (csDesigning in ComponentState) and (Button = mbLeft) and Assigned(FParentForm) then begin P := Point(X, Y); if IsPointInGrip(P) then begin ReleaseCapture; SendMessage(FParentForm.Handle, WM_SYSCOMMAND, $F008, 0); Exit; end; end; inherited; end; procedure TSpTBXStatusToolbar.WMNCLButtonDown(var Message: TWMNCLButtonDown); var P: TPoint; begin if not (csDesigning in ComponentState) and Assigned(FParentForm) then begin P := ScreenToClient(SmallPointToPoint(TSmallPoint(GetMessagePos()))); if IsPointInGrip(P) then begin ReleaseCapture; SendMessage(FParentForm.Handle, WM_SYSCOMMAND, $F008, 0); Exit; end; end; inherited; end; procedure TSpTBXStatusToolbar.WMSetCursor(var Message: TWMSetCursor); var P: TPoint; begin if not (csDesigning in ComponentState) and (Message.CursorWnd = Handle) and (Screen.Cursor = crDefault) and Assigned(FParentForm) then begin GetCursorPos(P); P := ScreenToClient(P); if IsPointInGrip(P) then begin Windows.SetCursor(Screen.Cursors[-8]); Message.Result := 1; Exit; end; end; inherited; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXCustomStatusBar } constructor TSpTBXCustomStatusBar.Create(AOwner: TComponent); begin inherited; Align := alBottom; end; function TSpTBXCustomStatusBar.CanResize(var NewWidth, NewHeight: Integer): Boolean; begin if Assigned(FDock) and (NewHeight <> FDock.Height) then Result := False else Result := inherited CanResize(NewWidth, NewHeight); end; procedure TSpTBXCustomStatusBar.DoDrawDockBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); var G: TRect; OfficeSeparators: Boolean; begin inherited DoDrawDockBackground(ACanvas, ARect, PaintStage, PaintDefault); if (PaintStage = pstPrePaint) and PaintDefault then begin PaintDefault := False; G := Toolbar.GetGripRect; if not IsRectEmpty(G) then begin // When it's called by the Toolbar the Gripper position should be corrected if (ARect.Left = -2) and (ARect.Top = -2) then OffsetRect(G, -2, -2); end; OfficeSeparators := Toolbar.NeedsSeparatorRepaint; SpDrawXPStatusBar(ACanvas, ARect, G, SkinType); if OfficeSeparators then DrawSeparators(ACanvas, ARect); end; end; procedure TSpTBXCustomStatusBar.DrawSeparators(ACanvas: TCanvas; ARect: TRect); // Draws Office separators when the skin has OfficeStatusBar set to true var I: Integer; IV: TTBItemViewer; R: TRect; SaveIndex: Integer; begin SaveIndex := SaveDC(ACanvas.Handle); try for I := 0 to FToolbar.View.ViewerCount - 1 do begin IV := FToolbar.View.Viewers[I]; if (IV is TSpTBXSeparatorItemViewer) and (not TSpTBXSeparatorItem(IV.Item).Blank) then begin R := IV.BoundsRect; if IsRectEmpty(R) then Continue; OffsetRect(R, ARect.Left + 2, ARect.Top + 2); R.Top := ARect.Top; R.Bottom := ARect.Bottom; R.Left := ((R.Right + R.Left) div 2) - 2; R.Right := R.Left + 3; if SpTBXSkinType(FSkinType) = sknNone then begin ACanvas.Brush.Color := clBtnFace; ACanvas.FillRect(R); SpDrawLine(ACanvas, R.Left, R.Top, R.Left, R.Bottom, clWindow); SpDrawLine(ACanvas, R.Right, R.Top, R.Right, R.Bottom, clBtnShadow); end else begin // For Office XP, when called by the Dock inc Top by 1 if ARect.Top = 0 then Inc(R.Top); SpDrawLine(ACanvas, R.Left, R.Top, R.Left, R.Bottom, clWindow); SpDrawLine(ACanvas, R.Right, R.Top, R.Right, R.Bottom, clWindow); ExcludeClipRect(ACanvas.Handle, R.Left, R.Top, R.Right, R.Bottom); end; end; end; if SpTBXSkinType(FSkinType) = sknSkin then begin Inc(ARect.Top); ACanvas.Brush.Color := clWindow; ACanvas.FrameRect(ARect); end; finally RestoreDC(ACanvas.Handle, SaveIndex); end; end; function TSpTBXCustomStatusBar.GetStatusToolbar: TSpTBXStatusToolbar; begin Result := FToolbar as TSpTBXStatusToolbar; end; function TSpTBXCustomStatusBar.GetToolbarClass: TSpTBXToolbarClass; begin Result := TSpTBXStatusToolbar; end; function TSpTBXCustomStatusBar.GetSizeGrip: Boolean; begin Result := Toolbar.SizeGrip; end; procedure TSpTBXCustomStatusBar.SetSizeGrip(const Value: Boolean); begin Toolbar.SizeGrip := Value; end; procedure TSpTBXCustomStatusBar.WMEraseBkgnd(var Message: TWMEraseBkgnd); begin Message.Result := 1; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXTitleToolbar } function TSpTBXTitleToolbar.GetItemsTextColor(State: TSpTBXSkinStatesType): TColor; begin Result := CurrentSkin.GetTextColor(skncWindowTitleBar, State); end; function TSpTBXTitleToolbar.GetRightAlignMargin: Integer; var TitleBar: TSpTBXCustomTitleBar; begin Result := inherited GetRightAlignMargin; TitleBar := GetTitleBar; if Assigned(TitleBar) and (TitleBar.WindowState = wsMaximized) then Result := 0; end; function TSpTBXTitleToolbar.GetTitleBar: TSpTBXCustomTitleBar; begin Result := CurrentDock.Parent as TSpTBXCustomTitleBar; end; procedure TSpTBXTitleToolbar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var TransparentClick: Boolean; F: TCustomForm; TitleBar: TSpTBXCustomTitleBar; P: TPoint; IV: TTBItemViewer; begin // Move the Parent Form if the toolbar client area or an item with // tbisClicksTransparent itemstyle is clicked (like a TBXLabelItem) if not (csDesigning in ComponentState) then begin TitleBar := GetTitleBar; F := TitleBar.FParentForm; if not Assigned(F) or not Assigned(TitleBar) then Exit; if not TitleBar.IsActive then Exit; if Assigned(View.Selected) then TransparentClick := tbisClicksTransparent in TTBCustomItemAccess(View.Selected.Item).ItemStyle else TransparentClick := True; case Button of mbLeft: if TransparentClick then begin if ssDouble in Shift then begin // Maximize or restore when double clicking the toolbar if TitleBar.Options.Maximize and not TitleBar.FixedSize then TitleBar.Options.MaximizeButton.Click; end else if F.WindowState <> wsMaximized then begin // Drag the form when dragging the toolbar ReleaseCapture; SendMessage(F.Handle, WM_SYSCOMMAND, $F012, 0); end; Exit; // Do not process transparent clicks end else if (ssDouble in Shift) and TitleBar.Options.SystemMenu then begin // Close the form when the system menu button is double clicked IV := View.ViewerFromPoint(Point(X, Y)); if Assigned(IV) and (IV.Item = TitleBar.Options.SystemButton) then begin F.Close; Exit; // Do not process transparent clicks end; end; mbRight: if TransparentClick and TitleBar.Options.SystemMenu then begin P := ClientToScreen(Point(X, Y)); TitleBar.Options.SystemButton.Popup(P.X, P.Y, True); Exit; // Do not process transparent clicks end; end; end; inherited; end; procedure TSpTBXTitleToolbar.WMNCCalcSize(var Message: TWMNCCalcSize); var TitleBar: TSpTBXCustomTitleBar; begin inherited; FDefaultToolbarBorderSize := CDefaultToolbarBorderSize; if Docked then begin TitleBar := GetTitleBar; if Assigned(TitleBar) and (TitleBar.WindowState = wsMaximized) then begin InflateRect(Message.CalcSize_Params.rgrc[0], 2, 2); FDefaultToolbarBorderSize := 0; end; end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXTitleBarButtonOptions } constructor TSpTBXTitleBarButtonOptions.Create(AParent: TWinControl); begin FSystemMenu := True; FTitleBar := AParent as TSpTBXCustomTitleBar; inherited Create(AParent); end; procedure TSpTBXTitleBarButtonOptions.CreateButtons; begin FSystemButton := TSpTBXSystemMenuItem.Create(nil); SetupButton(FSystemButton); FSystemButton.Visible := FSystemMenu; inherited; end; procedure TSpTBXTitleBarButtonOptions.SetSystemMenu(const Value: Boolean); begin FSystemMenu := Value; if Assigned(FSystemButton) then FSystemButton.Visible := Value; end; procedure TSpTBXTitleBarButtonOptions.ButtonsDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; ItemInfo: TSpTBXMenuItemInfo; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin inherited; // [Theme-Change] // Don't draw the items background if ButtonBorders is False or Default theme is used if (PaintStage = pstPrePaint) and (not ButtonBorders or SkinManager.IsDefaultSkin) then PaintDefault := False; end; procedure TSpTBXTitleBarButtonOptions.ButtonsClick(Sender: TObject); begin if not Assigned(FTitleBar.FParentForm) or not FTitleBar.IsActive then Exit; if Sender = FSystemButton then FSystemButton.ShowSize := not FTitleBar.FixedSize else if Sender = FMinimizeButton then FTitleBar.WindowState := wsMinimized else if Sender = FCloseButton then FTitleBar.FParentForm.Close else if Sender = FMaximizeButton then begin if FTitleBar.WindowState = wsNormal then FTitleBar.WindowState := wsMaximized else FTitleBar.WindowState := wsNormal; end; end; function TSpTBXTitleBarButtonOptions.Restoring(B: TSpTBXCustomItem): Boolean; begin Result := False; if (B = MaximizeButton) and (FTitleBar.WindowState = wsMaximized) then Result := True; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TSpTBXCustomTitleBar } constructor TSpTBXCustomTitleBar.Create(AOwner: TComponent); begin inherited; FActive := True; FMouseActive := True; ControlStyle := ControlStyle + [csAcceptsControls]; Align := alClient; FDock.OnResize := nil; FParentForm := GetParentForm(Self); FOptions := TSpTBXTitleBarButtonOptions.Create(Self); FOptions.CaptionLabel := Caption; end; destructor TSpTBXCustomTitleBar.Destroy; begin ChangeTitleBarState(False); FOptions.Free; if Assigned(FParentForm) and Assigned(FOldParentFormWndProc) then begin FParentForm.WindowProc := FOldParentFormWndProc; FOldParentFormWndProc := nil; end; if Assigned(Application) and Assigned(FNewAppWndProc) then begin SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(FOldAppWndProc)); Classes.FreeObjectInstance(FNewAppWndProc); FNewAppWndProc := nil; end; inherited; end; procedure TSpTBXCustomTitleBar.Loaded; begin inherited; // Subclass the ParentForm and Application for the System menu handling if not (csDesigning in ComponentState) then begin FParentForm := GetParentForm(Self); // Hook the ParentForm if Assigned(FParentForm) then begin FOldParentFormWndProc := FParentForm.WindowProc; FParentForm.WindowProc := NewParentFormWndProc; end; // Hook the Application to trap the $0313 message, more info on AppWndProc if not (csDesigning in ComponentState) and (Application.Handle <> 0) and (Application.MainForm = nil) and (FOldAppWndProc = nil) then begin // When Application.MainForm asume FParentForm as the MainForm FOldAppWndProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC)); FNewAppWndProc := Classes.MakeObjectInstance(AppWndProc); SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(FNewAppWndProc)); end; ChangeTitleBarState(Active); end; end; procedure TSpTBXCustomTitleBar.UpdateSkinMetrics; begin if HandleAllocated then begin // Update the NC area size, CurrentSkin.FloatingWindowBorderSize could have changed // Make sure to realign the toolbars SpRecalcNCArea(Self); Realign; end; end; procedure TSpTBXCustomTitleBar.AppWndProc(var Msg: TMessage); var SystemButtonP: TPoint; begin // Handle undocumented $0313 message, this is sent when the // taskbar button of the application is right clicked. // When Application.MainFormOnTaskbar = True (Delphi 2007 and above) // the message is sent to the Main Form, otherwise it is sent // to the Application. // More info: // http://delphi.about.com/od/vclwriteenhance/a/ttaskbarmenu.htm if (Msg.Msg = $0313) and Assigned(FParentForm) and Assigned(Options) then begin GetCursorPos(SystemButtonP); FOptions.SystemButton.Popup(SystemButtonP.X, SystemButtonP.Y, True); end else if Assigned(FOldAppWndProc) then Msg.Result := CallWindowProc(FOldAppWndProc, Application.Handle, Msg.Msg, Msg.wParam, Msg.lParam); end; procedure TSpTBXCustomTitleBar.NewParentFormWndProc(var Message: TMessage); var M: TWMSysCommand; I: Integer; HandleSpaceKey: Boolean; MMI: ^TMinMaxInfo; MonitorBounds, WorkArea, TaskBarBounds: TRect; TaskBarState, TaskBarEdge: Cardinal; SystemButtonIV: TTBItemViewer; SystemButtonP: TPoint; begin if not Assigned(FParentForm) then Exit; case Message.Msg of $0313: begin // Handle undocumented $0313 message, this is sent when the // taskbar button of the application is right clicked. // When Application.MainFormOnTaskbar = True (Delphi 2007 and above) // the message is sent to the Main Form, otherwise it is sent // to the Application. // More info: // http://delphi.about.com/od/vclwriteenhance/a/ttaskbarmenu.htm GetCursorPos(SystemButtonP); FOptions.SystemButton.Popup(SystemButtonP.X, SystemButtonP.Y, True); Exit; end; WM_GETMINMAXINFO: if IsActive and not FFullScreenMaximize then begin MMI := Pointer(Message.lParam); WorkArea := GetRectOfMonitorContainingWindow(Handle, True); MonitorBounds := GetRectOfMonitorContainingWindow(Handle, False); // Calculate the Max position and size // http://news.jrsoftware.org/news/toolbar2000.thirdparty/msg13127.html MMI^.ptMaxPosition.X := WorkArea.Left - MonitorBounds.Left; MMI^.ptMaxPosition.Y := WorkArea.Top - MonitorBounds.Top; MMI^.ptMaxSize.X := WorkArea.Right - WorkArea.Left; MMI^.ptMaxSize.Y := WorkArea.Bottom - WorkArea.Top; // Reduce the Max Size if the TaskBar is AutoHidden if SpGetTaskBar(TaskBarState, TaskBarEdge, TaskBarBounds) then begin if (TaskBarState and ABS_AUTOHIDE) = ABS_AUTOHIDE then case TaskBarEdge of ABE_LEFT, ABE_RIGHT: MMI^.ptMaxSize.X := MMI^.ptMaxSize.X - 2; ABE_TOP, ABE_BOTTOM: MMI^.ptMaxSize.Y := MMI^.ptMaxSize.Y - 2; end; end; // Max size during window resize, change the ParentForm constraints // to make it work if WindowState = wsMaximized then begin MMI^.ptMaxTrackSize.X := MMI^.ptMaxSize.X; MMI^.ptMaxTrackSize.Y := MMI^.ptMaxSize.Y; FParentForm.Constraints.MaxWidth := MMI^.ptMaxSize.X; FParentForm.Constraints.MaxHeight := MMI^.ptMaxSize.Y; end else begin FParentForm.Constraints.MaxWidth := 0; FParentForm.Constraints.MaxHeight := 0; end; Message.Result := 0; end; WM_SYSCOMMAND: if IsActive and Options.SystemMenu then begin M := TWMSysCommand(Message); if M.CmdType and $FFF0 = SC_KEYMENU then case M.Key of VK_SPACE: begin // Show the custom SysMenu SystemButtonIV := FToolbar.View.Find(FOptions.SystemButton); if Assigned(SystemButtonIV) then begin SystemButtonP.X := SystemButtonIV.BoundsRect.Left; SystemButtonP.Y := SystemButtonIV.BoundsRect.Bottom; SystemButtonP := FToolbar.ClientToScreen(SystemButtonP); FOptions.SystemButton.Popup(SystemButtonP.X, SystemButtonP.Y, True); Message.Result := 1; Exit; end; end; 0: if GetCapture = 0 then begin // When only the Alt key is pressed and a few seconds latter the Space // key is pressed the default SysMenu is showed, this only happens // when there are no menubars on the form. // In this case the WM_SYSCOMMAND is sent when the Alt key is // pressed (Key = 0), but not when the space key is pressed. // Apparently there's no way to override this, the only solution is to // handle the Alt key press (Key = 0). // // Message log when Alt [...] Space is pressed: // WM_SYSKEYDOWN: VK_MENU // WM_SYSKEYUP: VK_MENU // WM_SYSCOMMAND: Key = 0 // WM_ENTERMENULOOP // WM_INITMENU // WM_KEYDOWN: VK_SPACE // WM_CHAR: VK_SPACE // WM_INITMENUPOPUP: system hmenu // If the form has a main menu VK_SPACE will be correctly handled HandleSpaceKey := True; if Assigned(FParentForm.Menu) then HandleSpaceKey := False else if Toolbar.MenuBar then HandleSpaceKey := False else for I := 0 to FParentForm.ComponentCount - 1 do if FParentForm.Components[I] is TTBCustomToolbar then if TTBCustomToolbar(FParentForm.Components[I]).MenuBar then begin HandleSpaceKey := False; Break; end; if HandleSpaceKey then begin Message.Result := 1; Exit; end; end; end; end; end; // Default processing if Assigned(FOldParentFormWndProc) then FOldParentFormWndProc(Message); end; procedure TSpTBXCustomTitleBar.ChangeTitleBarState(Activate: Boolean); var FloatingBorderSize: TPoint; Style: Integer; RestoreR: TRect; WState: TWindowState; OnParentFormShow: TNotifyEvent; begin FParentForm := GetParentForm(Self); if Assigned(FParentForm) and (FParentForm.HandleAllocated) and ([csDesigning, csDestroying] * FParentForm.ComponentState = []) then begin if FMouseActive then begin FloatingBorderSize := GetFloatingBorderSize; // Changing the BorderStyle of the form will recreate it, // causing it to call Form.OnShow everytime Active is changed // We need to disable the OnShow calling. OnParentFormShow := TCustomFormAccess(FParentForm).OnShow; TCustomFormAccess(FParentForm).OnShow := nil; try WState := SpGetFormWindowState(FParentForm, RestoreR); if Activate then begin // Remove the border and titlebar from the form, and add the sysmenu FParentForm.BorderStyle := bsNone; Style := GetWindowLong(FParentForm.Handle, GWL_STYLE); Style := Style or WS_SYSMENU; SetWindowLong(FParentForm.Handle, GWL_STYLE, Style); // Resize the form to retain the same size before it was activated. // This is needed to keep the designtime size if (WState <> wsMaximized) and (TCustomFormAccess(FParentForm).FormStyle <> fsMDIChild) then begin FParentForm.Height := FParentForm.Height - GetSystemMetrics(SM_CYCAPTION) - (FloatingBorderSize.Y * 2); FParentForm.Width := FParentForm.Width - (FloatingBorderSize.X * 2); end; end else begin FParentForm.BorderStyle := bsSizeable; // Resize the form to retain the same size before it was deactivated. // This is needed to keep the designtime size if (WState <> wsMaximized) and (TCustomFormAccess(FParentForm).FormStyle <> fsMDIChild) then begin FParentForm.Height := FParentForm.Height + GetSystemMetrics(SM_CYCAPTION) + (FloatingBorderSize.Y * 2); FParentForm.Width := FParentForm.Width + (FloatingBorderSize.X * 2); end; end; // When Active is changed the Form is recreated, we have to // reset the Restore size if the form is currently Maximized. if WState = wsMaximized then SpSetFormWindowState(FParentForm, WState, RestoreR); InvalidateBackground; finally TCustomFormAccess(FParentForm).OnShow := OnParentFormShow; end; end; FDock.Visible := FActive; end; end; procedure TSpTBXCustomTitleBar.AdjustClientRect(var Rect: TRect); begin inherited AdjustClientRect(Rect); Rect := GetClientAreaRect; end; procedure TSpTBXCustomTitleBar.DoDrawDockBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); var FloatingBorderSize: TPoint; begin inherited DoDrawDockBackground(ACanvas, ARect, PaintStage, PaintDefault); if (PaintStage = pstPrePaint) and PaintDefault then begin PaintDefault := False; // [Theme-Change] // On WindowsXP make sure we paint the titlebar on the NC area // TSpTBXCustomTitleBar.WMEraseBkgnd and TSpTBXCustomTitleBar.DoDrawDockBackground handles this issue if SkinManager.GetSkinType = sknWindows then begin FloatingBorderSize := GetFloatingBorderSize; InflateRect(ARect, FloatingBorderSize.X, FloatingBorderSize.Y); end; SpDrawXPTitleBar(ACanvas, ARect, True); end; end; procedure TSpTBXCustomTitleBar.DoDrawBackground(ACanvas: TCanvas; ARect: TRect; const PaintStage: TSpTBXPaintStage; var PaintDefault: Boolean); begin if Assigned(FOnDrawBackground) then FOnDrawBackground(Self, ACanvas, ARect, PaintStage, PaintDefault); end; function TSpTBXCustomTitleBar.GetClientAreaRect: TRect; var FloatingBorderSize: TPoint; begin Result := ClientRect; if Active then begin FloatingBorderSize := GetFloatingBorderSize; if Assigned(FParentForm) then begin if not FMouseActive or (FParentForm.WindowState <> wsMaximized) then InflateRect(Result, -FloatingBorderSize.X, -FloatingBorderSize.Y); end else InflateRect(Result, -FloatingBorderSize.X, -FloatingBorderSize.Y); end; end; function TSpTBXCustomTitleBar.GetFloatingBorderSize: TPoint; begin if SkinManager.GetSkinType = sknSkin then Result := Point(CurrentSkin.FloatingWindowBorderSize, CurrentSkin.FloatingWindowBorderSize) else begin Result.X := GetSystemMetrics(SM_CXFRAME); Result.Y := GetSystemMetrics(SM_CYFRAME); end end; function TSpTBXCustomTitleBar.GetItems: TTBCustomItem; begin // The ToolbarEditor designer will open the editable items and // not the Toolbar.Items Result := Options.EditableItems; end; procedure TSpTBXCustomTitleBar.GetSizeCursor(MousePos: TPoint; var SizeCursor, SizeCode: Integer); var R: TRect; Pt, FloatingBorderSize: TPoint; const SC_SizeLeft = $F001; SC_SizeRight = $F002; SC_SizeUp = $F003; SC_SizeUpLeft = $F004; SC_SizeUpRight = $F005; SC_SizeDown = $F006; SC_SizeDownLeft = $F007; SC_SizeDownRight = $F008; begin SizeCursor := 0; SizeCode := 0; if not IsActive or (Assigned(FParentForm) and (FParentForm.WindowState = wsMaximized)) then Exit; R := ClientRect; FloatingBorderSize := GetFloatingBorderSize; InflateRect(R, -FloatingBorderSize.X, -FloatingBorderSize.Y); Pt := MousePos; if not PtInRect(R, Pt) then begin if (Pt.X < 10) and (Pt.Y < 10) then SizeCode := SC_SizeUpLeft else if (Pt.X > Width - 10) and (Pt.Y < 10) then SizeCode := SC_SizeUpRight else if (Pt.X < 10) and (Pt.Y > Height - 10) then SizeCode := SC_SizeDownLeft else if (Pt.X > Width - 10) and (Pt.Y > Height - 10) then SizeCode := SC_SizeDownRight else if (Pt.X > 10) and (Pt.X < Width - 10) and (Pt.Y < 10) then SizeCode := SC_SizeUp else if (Pt.X > 10) and (Pt.X < Width - 10) and (Pt.Y > Height - 10) then SizeCode := SC_SizeDown else if (Pt.Y > 10) and (Pt.Y < Height - 10) and (Pt.X < 10) then SizeCode := SC_SizeLeft else if (Pt.Y > 10) and (Pt.Y < Height - 10) and (Pt.X > Width - 10) then SizeCode := SC_SizeRight; case SizeCode of SC_SizeLeft, SC_SizeRight: SizeCursor := -9; SC_SizeUp, SC_SizeDown: SizeCursor := -7; SC_SizeUpLeft, SC_SizeDownRight: SizeCursor := -8; SC_SizeDownLeft, SC_SizeUpRight: SizeCursor := -6; end; end end; function TSpTBXCustomTitleBar.GetToolbarClass: TSpTBXToolbarClass; begin Result := TSpTBXTitleToolbar; end; function TSpTBXCustomTitleBar.GetWindowState: TWindowState; begin if Assigned(FParentForm) then Result := FParentForm.WindowState else Result := wsNormal; end; function TSpTBXCustomTitleBar.IsActive: Boolean; begin Result := FActive and FMouseActive; end; procedure TSpTBXCustomTitleBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Pt: TPoint; SizeCursor, SizeCode: Integer; begin inherited; if not FixedSize and (Button = mbLeft) then begin Pt := Point(X, Y); GetSizeCursor(Pt, SizeCursor, SizeCode); if (SizeCode > 0) and Assigned(FParentForm) then begin ReleaseCapture; FParentForm.Perform(WM_SYSCOMMAND, SizeCode, 0); end; end; end; procedure TSpTBXCustomTitleBar.SetActive(const Value: Boolean); begin if FActive <> Value then begin FActive := Value; ChangeTitleBarState(Value); end; end; procedure TSpTBXCustomTitleBar.SetFullScreenMaximize(const Value: Boolean); begin if FFullScreenMaximize <> Value then begin FFullScreenMaximize := Value; if IsActive and Assigned(FParentForm) and FParentForm.HandleAllocated then begin FParentForm.Constraints.MaxWidth := 0; FParentForm.Constraints.MaxHeight := 0; if (WindowState = wsMaximized) and not (csDesigning in ComponentState) then TCustomFormAccess(FParentForm).RecreateWnd; end; end; end; procedure TSpTBXCustomTitleBar.SetMouseActive(const Value: Boolean); begin if FMouseActive <> Value then begin FMouseActive := Value; ChangeTitleBarState(Value); end; end; procedure TSpTBXCustomTitleBar.SetWindowState(const Value: TWindowState); begin if Assigned(FParentForm) then begin case Value of wsMinimized: begin // WindowState := wsMinimized will not minimize the app correctly SendMessage(FParentForm.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0); end; wsMaximized, wsNormal: FParentForm.WindowState := Value; end; end; end; procedure TSpTBXCustomTitleBar.WMSpSkinChange(var Message: TMessage); begin UpdateSkinMetrics; inherited; end; procedure TSpTBXCustomTitleBar.CMTextChanged(var Message: TMessage); begin inherited; if Assigned(FOptions) then FOptions.CaptionLabel := Caption; end; procedure TSpTBXCustomTitleBar.WMEraseBkgnd(var Message: TMessage); var ARect, DockAreaR: TRect; FloatingBorderSize: TPoint; Maximized, PaintDefault: Boolean; B: TBitmap; begin Message.Result := 1; if not DoubleBuffered or (Message.wParam = Message.lParam) then begin B := TBitmap.Create; try ARect := GetClientRect; B.Width := ARect.Right; B.Height := ARect.Bottom; B.Canvas.Brush.Color := Color; // SpDrawXPTitleBarBody needs it to paint the background B.Canvas.FillRect(ARect); PaintDefault := True; DoDrawBackground(B.Canvas, ARect, pstPrePaint, PaintDefault); if PaintDefault then begin Maximized := (WindowState = wsMaximized) and FMouseActive; if Maximized then InflateRect(ARect, 4, 4); if Active then begin FloatingBorderSize := GetFloatingBorderSize; SpDrawXPTitleBarBody(B.Canvas, ARect, True, FloatingBorderSize); // [Theme-Change] // On WindowsXP make sure we paint the titlebar on the NC area // TSpTBXCustomTitleBar.WMEraseBkgnd and TSpTBXCustomTitleBar.DoDrawDockBackground handles this issue if Assigned(FDock) and not Maximized and (SkinManager.GetSkinType = sknWindows) then begin DockAreaR := ARect; DockAreaR.Bottom := FDock.Height + FloatingBorderSize.Y; // don't multiply by 2 SpDrawXPTitleBar(B.Canvas, DockAreaR, True); end; end; end; PaintDefault := True; DoDrawBackground(B.Canvas, ARect, pstPostPaint, PaintDefault); BitBlt(TWMEraseBkgnd(Message).DC, 0, 0, B.Width, B.Height, B.Canvas.Handle, 0, 0, SRCCOPY); finally B.Free; end; end; end; procedure TSpTBXCustomTitleBar.WMSetCursor(var Message: TWMSetCursor); var P: TPoint; SizeCursor, SizeCode: Integer; begin if not FixedSize and not (csDesigning in ComponentState) and (Message.CursorWnd = Handle) and (Screen.Cursor = crDefault) then begin GetCursorPos(P); P := ScreenToClient(P); GetSizeCursor(P, SizeCursor, SizeCode); if SizeCursor <> 0 then begin Windows.SetCursor(Screen.Cursors[SizeCursor]); Message.Result := 1; end else inherited; end else inherited; end; procedure TSpTBXCustomTitleBar.WMWindowPosChanged(var Message: TWMWindowPosChanged); begin inherited; InvalidateBackground(False); if [csDesigning, csDestroying] * ComponentState = [] then begin if FOptions.Maximize then FOptions.SetupButtonIcon(FOptions.MaximizeButton); // Hide the Toolbar if the Form is a MDI child and it's maximized if Assigned(FParentForm) and (FParentForm.HandleAllocated) then begin if (TCustomFormAccess(FParentForm).FormStyle = fsMDIChild) then FDock.Visible := FParentForm.WindowState <> wsMaximized; end; end; end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { TBitmapHint } procedure TBitmapHint.ActivateHint(Rect: TRect; const AHint: string); var SaveActivating: Boolean; // Detect Delphi 7 {$IF CompilerVersion < 17} MonitorR: TRect; Delta: TPoint; {$IFEND} begin // [Bugfix] Delphi 7 bug, D7 hints doesn't support multi-monitors {$IF CompilerVersion < 17} MonitorR := GetRectOfMonitorContainingPoint(Point(Rect.Left, Rect.Top), True); Delta := Point(0, 0); if (Rect.Left < MonitorR.Right) and (Rect.Right > MonitorR.Right) then Delta.X := - (Rect.Right - MonitorR.Right); if (Rect.Top < MonitorR.Bottom) and (Rect.Bottom > MonitorR.Bottom) then Delta.Y := - (Rect.Bottom - MonitorR.Bottom); OffsetRect(Rect, Delta.X, Delta.Y); {$IFEND} SaveActivating := FActivating; try FActivating := True; inherited ActivateHint(Rect, AHint); finally FActivating := SaveActivating; end; end; procedure TBitmapHint.ActivateHintData(Rect: TRect; const AHint: string; AData: Pointer); begin //The AData parameter is a bitmap FHintBitmap := TBitmap(AData); Rect.Right := Rect.Left + FHintBitmap.Width - 2; Rect.Bottom := Rect.Top + FHintBitmap.Height - 2; inherited ActivateHintData(Rect, AHint, AData); end; procedure TBitmapHint.CMTextChanged(var Message: TMessage); begin Message.Result := 1; end; procedure TBitmapHint.Paint; begin if Assigned(FHintBitmap) then Canvas.Draw(0, 0, FHintBitmap); end; //WMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM { Stock Objects } procedure InitializeStock; var NonClientMetrics: TNonClientMetrics; begin // Small caption font SmCaptionFont := TFont.Create; NonClientMetrics.cbSize := SizeOf(NonClientMetrics); if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then SmCaptionFont.Handle := CreateFontIndirect(NonClientMetrics.lfSmCaptionFont); SpStockHintBitmap := TBitmap.Create; Screen.Cursors[crSpTBXNewHandPoint] := LoadCursor(0, IDC_HAND); Screen.Cursors[crSpTBXCustomization] := LoadCursor(HInstance, 'CZMOVE'); Screen.Cursors[crSpTBXCustomizationCancel] := LoadCursor(HInstance, 'CZCANCEL'); // Dummy ImageList, used by TSpTBXItemViewer and TSpTBXButtonOptions MDIButtonsImgList := TImageList.Create(nil); end; procedure FinalizeStock; begin FreeAndNil(SmCaptionFont); FreeAndNil(SpStockHintBitmap); FreeAndNil(MDIButtonsImgList); end; initialization InitializeStock; finalization FinalizeStock; end.