{*******************************************************************} { } { Developer Express Visual Component Library } { ExpressBars components } { } { Copyright (c) 1998-2009 Developer Express Inc. } { ALL RIGHTS RESERVED } { } { The entire contents of this file is protected by U.S. and } { International Copyright Laws. Unauthorized reproduction, } { reverse-engineering, and distribution of all or any portion of } { the code contained in this file is strictly prohibited and may } { result in severe civil and criminal penalties and will be } { prosecuted to the maximum extent possible under the law. } { } { RESTRICTIONS } { } { THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES } { (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE } { SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS } { LICENSED TO DISTRIBUTE THE EXPRESSBARS AND ALL ACCOMPANYING VCL } { CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY. } { } { THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED } { FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE } { COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE } { AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT } { AND PERMISSION FROM DEVELOPER EXPRESS INC. } { } { CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON } { ADDITIONAL RESTRICTIONS. } { } {*******************************************************************} unit dxBar; {$I cxVer.inc} interface uses SysUtils, TypInfo, Windows, Messages, Graphics, Controls, Forms, Classes, ImgList, ActnList, Menus, StdCtrls, dxCommon, dxThemeManager, cxLookAndFeels, cxClasses, cxControls, cxGraphics, cxLibraryConsts; const WM_REPAINTBAR = WM_DX + 1; dxBarDefaultButtonArrowWidth = 11; dxBarDefaultLargeButtonArrowWidth = 13;//4; dxBarTransparentShadowSize = 4; dxBarOpaqueShadowSize = 2; type TCurImageList = TCustomImageList; TdxBarPopupMenuLink = class; TdxBarManager = class; TdxBar = class; TdxBars = class; TdxBarItemLink = class; TdxBarItemLinks = class; TdxBarPopupMenu = class; TdxDockControl = class; TdxBarDockControl = class; TdxBarShadow = class; TCustomdxBarControl = class; TdxDockRow = class; TdxBarControl = class; TdxBarSubMenuControl = class; TdxBarItem = class; TdxBarItemControl = class; TCustomdxBarSubItem = class; TdxBarEditControl = class; TdxBarItemControlPainterClass = class of TdxBarItemControlPainter; TdxBarItemClass = class of TdxBarItem; {-------------------------- Nonvisual components --------------------------} TdxBarDesigner = class function CanAddComponent(BarManager: TdxBarManager): Boolean; virtual; abstract; function CanDeleteComponent(BarManager: TdxBarManager; Component: TComponent): Boolean; virtual; abstract; procedure DeleteComponent(BarManager: TdxBarManager; Component: TPersistent); virtual; abstract; procedure SelectComponent(BarManager: TdxBarManager; Instance: TPersistent); virtual; abstract; function SelectedComponent(BarManager: TdxBarManager): TPersistent; virtual; abstract; procedure ShowDefaultEventHandler(AItem: TdxBarItem); virtual; abstract; function UniqueName(BarManager: TdxBarManager; const BaseName: string): string; virtual; abstract; end; TdxBarHintWindowClass = class of TdxBarHintWindow; TdxBarHintWindow = class(TCustomControl) private procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; protected procedure CreateParams(var Params: TCreateParams); override; procedure Paint; override; public constructor Create(AOwner: TComponent); override; procedure ActivateHint(P: TPoint; const AHint: string; BarManager: TdxBarManager); virtual; end; TdxBarItemVisible = (ivNever, ivInCustomizing, ivAlways); TdxBarGroup = class(TComponent) private FBarManager: TdxBarManager; FEnabled: Boolean; FItems: TList; FItemsNames: TStringList; FVisible: TdxBarItemVisible; function GetCount: Integer; function GetIndex: Integer; function GetItem(Index: Integer): TComponent; procedure SetEnabled(Value: Boolean); procedure SetIndex(Value: Integer); procedure SetVisible(Value: TdxBarItemVisible); procedure ReadItems(Reader: TReader); procedure WriteItems(Writer: TWriter); protected procedure DefineProperties(Filer: TFiler); override; procedure Loaded; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SetName(const NewName: TComponentName); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetParentComponent: TComponent; override; function HasParent: Boolean; override; procedure SetParentComponent(AParent: TComponent); override; procedure Add(AItem: TComponent); procedure Delete(Index: Integer); function IndexOf(AItem: TComponent): Integer; procedure Move(FromIndex, ToIndex: Integer); procedure Remove(AItem: TComponent); property BarManager: TdxBarManager read FBarManager; property Count: Integer read GetCount; property Index: Integer read GetIndex write SetIndex; property Items[Index: Integer]: TComponent read GetItem; default; published property Enabled: Boolean read FEnabled write SetEnabled default True; property Visible: TdxBarItemVisible read FVisible write SetVisible default ivAlways; end; TdxBarPopupMenuLinkActionEvent = procedure(Sender: TdxBarPopupMenuLink; var X, Y: Integer; ClickedByMouse: Boolean; var AllowPopup: Boolean) of object; TdxBarPopupMenuLink = class(TCollectionItem) private FControl: TWinControl; FPopupMenu: TdxBarPopupMenu; FProcessChildren: Boolean; FOnAction: TdxBarPopupMenuLinkActionEvent; function GetBarManager: TdxBarManager; procedure SetControl(Value: TWinControl); procedure SetPopupMenu(Value: TdxBarPopupMenu); protected function IsShortCut(AShortCut: TShortCut): Boolean; public constructor Create(Collection: TCollection); override; procedure Assign(Source: TPersistent); override; function DoAction(Wnd: HWND; P: TPoint): Boolean; property BarManager: TdxBarManager read GetBarManager; published property Control: TWinControl read FControl write SetControl; property PopupMenu: TdxBarPopupMenu read FPopupMenu write SetPopupMenu; property ProcessChildren: Boolean read FProcessChildren write FProcessChildren default True; property OnAction: TdxBarPopupMenuLinkActionEvent read FOnAction write FOnAction; end; TdxBarPopupMenuLinks = class(TCollection) private FBarManager: TdxBarManager; function GetItem(Index: Integer): TdxBarPopupMenuLink; procedure SetItem(Index: Integer; Value: TdxBarPopupMenuLink); protected function GetOwner: TPersistent; override; function IsShortCut(AControl: TWinControl; AShortCut: TShortCut): Boolean; public constructor Create(ABarManager: TdxBarManager); function Add: TdxBarPopupMenuLink; function DoAction(AControl: TWinControl; Wnd: HWND; const P: TPoint): Boolean; property BarManager: TdxBarManager read FBarManager; property Items[Index: Integer]: TdxBarPopupMenuLink read GetItem write SetItem; default; end; TdxBarBackgrounds = class(TPersistent) private FBarBackgroundBitmap: TBitmap; FSubMenuBackgroundBitmap: TBitmap; FBarManager: TdxBarManager; procedure BitmapChanged(Sender: TObject); procedure SetBarBackgroundBitmap(Value: TBitmap); procedure SetSubMenuBackgroundBitmap(Value: TBitmap); protected procedure Changed; function GetOwner: TPersistent; override; public constructor Create(ABarManager: TdxBarManager); destructor Destroy; override; procedure Assign(Source: TPersistent); override; property BarManager: TdxBarManager read FBarManager; published property Bar: TBitmap read FBarBackgroundBitmap write SetBarBackgroundBitmap; property SubMenu: TBitmap read FSubMenuBackgroundBitmap write SetSubMenuBackgroundBitmap; end; TdxBarDockingStyle = (dsNone, dsLeft, dsTop, dsRight, dsBottom); TdxBarDockingStyles = set of TdxBarDockingStyle; TdxBarManagerStyle = (bmsStandard, bmsEnhanced, bmsFlat, bmsXP, bmsOffice11, bmsUseLookAndFeel); TdxBarMenuAnimations = (maNone, maRandom, maUnfold, maSlide, maFade); TdxBarEvent = procedure(Sender: TdxBarManager; ABar: TdxBar) of object; TdxBarItemLinkEvent = procedure(Sender: TdxBarManager; AItemLink: TdxBarItemLink) of object; TdxBarVisibleChangeEvent = procedure(Sender: TdxBarManager; ABar: TdxBar) of object; TdxBarCanDockingEvent = procedure(Sender: TdxBar; Style: TdxBarDockingStyle; DockControl: TdxDockControl; var CanDocking: Boolean) of object; TdxBarMenuMergeEvent = procedure(Sender, ChildBarManager: TdxBarManager; AddItems: Boolean) of object; TdxBarShowPopupEvent = procedure(Sender: TdxBarManager; PopupItemLinks: TdxBarItemLinks) of object; TdxBarClickItemEvent = procedure(Sender: TdxBarManager; ClickedItem: TdxBarItem) of object; TdxBarManager = class(TComponent) private FAllowCallFromAnotherForm: Boolean; FAllowReset: Boolean; FAlwaysMerge: Boolean; FAlwaysSaveText: Boolean; FAutoDockColor: Boolean; FAutoHideEmptyBars: Boolean; FBackgrounds: TdxBarBackgrounds; FBarRestoringList: TList; FBars: TdxBars; FButtonArrowWidth: Integer; FCanCustomize: Boolean; FCanModifyDesigner: Boolean; FChangingStyle: Boolean; FCategories: TStrings; FCreatingFlag: Boolean; FDesigning: Boolean; FDetachingSubMenu: Boolean; FDockColor: TColor; FDockControls: TList; FDragging: Boolean; FDraggingItem: TdxBarItem; FDraggingItemLink: TdxBarItemLink; FDraggingItemLinkParentHandle: HWND; FEditFontHandle: HFONT; FFirstDocksUpdate: Boolean; FFlatCloseButton: Boolean; FFlatToolbarsBorderBrush: HBRUSH; FFlatToolbarsBrush: HBRUSH; FFlatToolbarsDownedBrush: HBRUSH; FFlatToolbarsDownedSelBrush: HBRUSH; FFlatToolbarsSelBrush: HBRUSH; FFocusedBarControl: TCustomdxBarControl; FFont: TFont; FGroups: TList; FHelpButtonGlyph: TBitmap; FHelpContext: THelpContext; FHideFloatingBarsWhenInactive: Boolean; FImageListBkColor: TColor; FImages, FLargeImages, FHotImages: TCurImageList; FDisabledImages, FDisabledLargeImages: TCurImageList; FImagesChangeLink, FLargeImagesChangeLink, FHotImagesChangeLink: TChangeLink; FDisabledImagesChangeLink, FDisabledLargeImagesChangeLink: TChangeLink; FIniFileName: string; FInternalFontChange: Boolean; FIsCustomizing: Boolean; FIsHandleCreating: Boolean; FItems: TList; FLargeButtonArrowWidth: Integer; FLargeIcons: Boolean; FLockUpdate: Boolean; FLookAndFeel: TcxLookAndFeel; FMainForm: TCustomForm; FMainFormActive: Boolean; FMainMenuBar: TdxBar; FMakeDisabledImagesFaded: Boolean; FMenuAnimations: TdxBarMenuAnimations; FMenusShowRecentItemsFirst: Boolean; FModified: Boolean; FMostRecentItemsPercents: Byte; FMostRecentlyUsedUseCount: Integer; FNotDocking: TdxBarDockingStyles; FPainterClass: TdxBarItemControlPainterClass; FPopupMenuLinks: TdxBarPopupMenuLinks; FPopupMenus: TList; FPrevActiveMDIChild: HWND; FPrevChildMainMenuVisible: Boolean; FReadStateCount: Integer; FRegistryPath: string; FScaled: Boolean; FSelectedItem: TdxBarItemControl; FShowCloseButton: Boolean; FShowFullMenusAfterDelay: Boolean; FShowHelpButton: Boolean; FShowHint: Boolean; FShowHintForDisabledItems: Boolean; FShowShortCutInHint: Boolean; FStoreInIniFile: Boolean; FStoreInRegistry: Boolean; FIniFileStream: TStream; FStretchGlyphs: Boolean; FStyle: TdxBarManagerStyle; FSunkenBorder: Boolean; FThemeAvailable: Boolean; FThemeChangedNotificator: TdxThemeChangedNotificator; FThemeToolbarsBrush: HBRUSH; // FThemeToolbarsDownedBrush: HBRUSH; // FThemeToolbarsDownedSelBrush: HBRUSH; // FThemeToolbarsSelBrush: HBRUSH; FToolbarsVisibleChanging: Boolean; FUseF10ForMenu: Boolean; FUseFullReset: Boolean; FUseLargeImagesForLargeIcons: Boolean; FUseSystemFont: Boolean; FWaitForDockingTime: Integer; IsMDIMaximized: Boolean; FBeforeFingersSize: Integer; FFingersSize: Integer; FSubMenuBeginGroupIndent: Integer; FGlyphSize: Integer; FButtonWidth: Integer; FButtonHeight: Integer; FRealButtonArrowWidth: Integer; FOnBarAdd: TdxBarEvent; FOnBarAfterReset: TdxBarEvent; FOnBarBeforeReset: TdxBarEvent; FOnBarClose: TdxBarEvent; FOnBarDelete: TdxBarEvent; FOnBarDockingStyleChange: TdxBarEvent; FOnBarVisibleChange: TdxBarVisibleChangeEvent; FOnItemLinkAdd: TdxBarItemLinkEvent; FOnItemLinkChange: TdxBarItemLinkEvent; FOnItemLinkDelete: TdxBarItemLinkEvent; FOnCloseButtonClick: TNotifyEvent; FOnDocking: TdxBarCanDockingEvent; FOnHelpButtonClick: TNotifyEvent; FOnHideCustomizingForm: TNotifyEvent; FOnMenuMerge: TdxBarMenuMergeEvent; FOnShowCustomizingForm: TNotifyEvent; FOnShowCustomizingPopup: TdxBarShowPopupEvent; FOnShowToolbarsPopup: TdxBarShowPopupEvent; FOnClickItem: TdxBarClickItemEvent; function GetBarControlFocused: Boolean; function GetCategoryItemsVisible(AIndex: Integer): TdxBarItemVisible; function GetCategoryVisible(AIndex: Integer): Boolean; function GetDockColor: TColor; function GetDockControl(Index: Integer): TdxDockControl; function GetDockControlCount: Integer; function GetFlat: Boolean; function GetFlatToolbarsBorderColor: COLORREF; function GetFlatToolbarsColor: COLORREF; function GetFlatToolbarsDownedColor: COLORREF; function GetFlatToolbarsDownedSelColor: COLORREF; function GetFlatToolbarsSelColor: COLORREF; function GetGroup(Index: Integer): TdxBarGroup; function GetGroupCount: Integer; function GetIsCustomizing: Boolean; function GetIsDestroying: Boolean; function GetIsLoading: Boolean; function GetItemCount: Integer; function GetItem(Index: Integer): TdxBarItem; function GetMainMenuControl: TdxBarControl; function GetRealLargeButtonArrowWidth: Integer; function GetRestoringListBar(Index: Integer): TdxBar; function GetRestoringListBarCount: Integer; procedure SetAutoDockColor(Value: Boolean); procedure SetAutoHideEmptyBars(Value: Boolean); procedure SetBackgrounds(Value: TdxBarBackgrounds); procedure SetBars(Value: TdxBars); procedure SetButtonArrowWidth(Value: Integer); procedure SetCategories(Value: TStrings); procedure SetCategoryItemsVisible(AIndex: Integer; Value: TdxBarItemVisible); procedure SetCategoryVisible(AIndex: Integer; Value: Boolean); procedure SetDockColor(Value: TColor); procedure SetFlatCloseButton(Value: Boolean); procedure SetFont(Value: TFont); procedure SetHelpButtonGlyph(Value: TBitmap); procedure SetHideFloatingBarsWhenInactive(Value: Boolean); procedure SetHotImages(Value: TCurImageList); procedure SetImageListBkColor(Value: TColor); procedure SetImages(Value: TCurImageList); procedure SetDisabledImages(Value: TCurImageList); procedure SetDisabledLargeImages(Value: TCurImageList); procedure SetLargeButtonArrowWidth(Value: Integer); procedure SetLargeIcons(Value: Boolean); procedure SetLargeImages(Value: TCurImageList); procedure SetLockUpdate(Value: Boolean); procedure SetLookAndFeel(Value: TcxLookAndFeel); procedure SetMakeDisabledImagesFaded(Value: Boolean); procedure SetMenuAnimations(Value: TdxBarMenuAnimations); procedure SetMenusShowRecentItemsFirst(Value: Boolean); procedure SetMostRecentItemsPercents(Value: Byte); procedure SetNotDocking(Value: TdxBarDockingStyles); procedure SetPopupMenuLinks(Value: TdxBarPopupMenuLinks); procedure SetScaled(Value: Boolean); procedure SetSelectedItem(Value: TdxBarItemControl); procedure SetShowCloseButton(Value: Boolean); procedure SetShowFullMenusAfterDelay(Value: Boolean); procedure SetShowHelpButton(Value: Boolean); procedure SetShowHint(Value: Boolean); procedure SetShowShortCutInHint(Value: Boolean); procedure SetStyle(Value: TdxBarManagerStyle); procedure SetSunkenBorder(Value: Boolean); procedure SetUseSystemFont(Value: Boolean); procedure SetUseLargeImagesForLargeIcons(Value: Boolean); procedure SetWaitForDockingTime(Value: Integer); procedure AddCustomizeLink(ItemLinks: TdxBarItemLinks; ABeginGroup: Boolean; ItemClass: TdxBarItemClass); procedure CalcButtonsConsts; procedure DrawDraggingLine(AControl: TdxBarItemControl; IsBeginGroup, IsFirstPart, IsVerticalDirection: Boolean); procedure FontChanged(Sender: TObject); function ActiveMDIChild: HWND; procedure MainFormClientWndProc(Msg: UINT; wParam: WPARAM; lParam: LPARAM); procedure MainFormWndProc(Msg: UINT; wParam: WPARAM; lParam: LPARAM); function LoadMainFormFromBin: TForm; procedure CheckToolbarsVisibility; procedure DisplayHint; procedure HintActivate(AShow: Boolean; const CustomHint: string); procedure DestroyItems; procedure HelpButtonGlyphChanged(Sender: TObject); procedure HotImageListChange(Sender: TObject); procedure ImageListChange(Sender: TObject); procedure LargeIconsChanged; procedure LargeImageListChange(Sender: TObject); procedure DisabledImageListChange(Sender: TObject); procedure DisabledLargeImageListChange(Sender: TObject); procedure ToolbarsPopupClick(Sender: TObject); procedure CalcMostRecentlyUsedUseCount; function ShowRecentItemsFirst: Boolean; procedure AddDockControl(ADockControl: TdxDockControl); procedure RemoveDockControl(ADockControl: TdxDockControl); procedure AddGroup(AGroup: TdxBarGroup); procedure RemoveGroup(AGroup: TdxBarGroup); function IsDockColorStored: Boolean; procedure ReadDockControlHeights(Reader: TReader); procedure WriteDockControlHeights(Writer: TWriter); procedure CreateFlatToolbarsBrushes; procedure DestroyFlatToolbarsBrushes; procedure CreateThemeToolbarsBrushes; procedure DestroyThemeToolbarsBrushes; procedure DestroyToolbarsBrushes; procedure CreateToolbarsBrushes; procedure RecreateToolbarsBrushes; procedure RefreshFloatingBarsShadows; procedure ResetBackgrounds; procedure InitPainterClass; procedure InternalStyleChanged; procedure ThemeChanged; procedure LFChanged(Sender: TcxLookAndFeel; AChangedValues: TcxLookAndFeelValues); protected procedure CreateBarRestoringList; procedure DestroyBarRestoringList; function BarRestoringListExists: Boolean; procedure AddBarToRestoringList(ABar: TdxBar); procedure RemoveBarFromRestoringList(ABar: TdxBar); procedure ShowBarsFromRestoringList(ADockControl: TdxBarDockControl); property RestoringListBarCount: Integer read GetRestoringListBarCount; property RestoringListBars[Index: Integer]: TdxBar read GetRestoringListBar; procedure AssignFont; function CanReset: Boolean; procedure DefineProperties(Filer: TFiler); override; procedure DesignerModified; procedure DoBarAfterReset(ABar: TdxBar); dynamic; procedure DoBarBeforeReset(ABar: TdxBar); dynamic; procedure DoBarClose(ABar: TdxBar); dynamic; procedure DoBarDockingStyleChanged(ABar: TdxBar); dynamic; procedure DoClickItem(AItem: TdxBarItem); virtual; procedure DoCloseButtonClick; dynamic; function DoDocking(ABar: TdxBar; AStyle: TdxBarDockingStyle; ADockControl: TdxDockControl): Boolean; virtual; procedure DoHelpButtonClick; dynamic; procedure DoShowCustomizingPopup(PopupItemLinks: TdxBarItemLinks); dynamic; procedure DoShowToolbarsPopup(PopupItemLinks: TdxBarItemLinks); dynamic; procedure DragAndDrop(AItem: TdxBarItem; AItemLink: TdxBarItemLink); function FindDockControl(APath: string): TdxBarDockControl; function GetCategoryRealIndex(AIndex: Integer): Integer; procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; function GetPainterClass: TdxBarItemControlPainterClass; virtual; function GetWindowForMouseCapturing: HWND; procedure HotImagesChanged; procedure ImagesChanged; procedure LargeImagesChanged; procedure DisabledImagesChanged; procedure DisabledLargeImagesChanged; function IsLargeImagesForLargeIcons: Boolean; procedure Loaded; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure ReadState(Reader: TReader); override; procedure SetName(const NewName: TComponentName); override; procedure ShowToolbars(Show, ForceHiding: Boolean; ActiveWindow: HWND); procedure UpdateItems(Sender: TdxBarItem); property BarControlFocused: Boolean read GetBarControlFocused; property Dragging: Boolean read FDragging; property DraggingItem: TdxBarItem read FDraggingItem; property DraggingItemLink: TdxBarItemLink read FDraggingItemLink; property FocusedBarControl: TCustomdxBarControl read FFocusedBarControl; property IsDestroying: Boolean read GetIsDestroying; property IsHandleCreating: Boolean read FIsHandleCreating; property IsLoading: Boolean read GetIsLoading; property MainFormActive: Boolean read FMainFormActive; function BorderSizeX: Integer; function BorderSizeY: Integer; function FingersSize(ABar: TdxBar): Integer; property BeforeFingersSize: Integer read FBeforeFingersSize; property SubMenuBeginGroupIndent: Integer read FSubMenuBeginGroupIndent; property GlyphSize: Integer read FGlyphSize; property ButtonWidth: Integer read FButtonWidth; property ButtonHeight: Integer read FButtonHeight; property RealButtonArrowWidth: Integer read FRealButtonArrowWidth; property RealLargeButtonArrowWidth: Integer read GetRealLargeButtonArrowWidth; function GetLightColor(ABtnFaceColorPart, AHighlightColorPart, AWindowColorPart: Integer): COLORREF; property CanModifyDesigner: Boolean read FCanModifyDesigner write FCanModifyDesigner; property Flat: Boolean read GetFlat; property FlatToolbarsBorderBrush: HBRUSH read FFlatToolbarsBorderBrush; property FlatToolbarsBrush: HBRUSH read FFlatToolbarsBrush; property FlatToolbarsDownedBrush: HBRUSH read FFlatToolbarsDownedBrush; property FlatToolbarsDownedSelBrush: HBRUSH read FFlatToolbarsDownedSelBrush; property FlatToolbarsSelBrush: HBRUSH read FFlatToolbarsSelBrush; property FlatToolbarsBorderColor: COLORREF read GetFlatToolbarsBorderColor; property FlatToolbarsColor: COLORREF read GetFlatToolbarsColor; property FlatToolbarsDownedColor: COLORREF read GetFlatToolbarsDownedColor; property FlatToolbarsDownedSelColor: COLORREF read GetFlatToolbarsDownedSelColor; property FlatToolbarsSelColor: COLORREF read GetFlatToolbarsSelColor; property ThemeToolbarsBrush: HBRUSH read FThemeToolbarsBrush; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function BarByCaption(const ACaption: string): TdxBar; function BarByName(const AName: string): TdxBar; function GetAllItemsByCategory(ACategory: Integer; List: TList): Integer; function GetCountByCategory(ACategory: Integer): Integer; function GetItemByCategory(ACategory, AIndex: Integer): TdxBarItem; function GetItemByName(const AName: string): TdxBarItem; function GetItemsByCategory(ACategory: Integer; List: TList): Integer; procedure MoveItem(CurIndex, NewIndex: Integer); procedure ExchangeItems(Index1, Index2: Integer); procedure CreateToolbarsPopupList(ItemLinks: TdxBarItemLinks); procedure Customizing(Show: Boolean); procedure HideAll; procedure ResetUsageData; procedure ResetUsageDataWithConfirmation; //procedure WhatIsThis; procedure LoadFromRegistry(ARegistryPath: string); procedure SaveToRegistry(ARegistryPath: string); procedure LoadFromIniFile(AFileName: string); procedure SaveToIniFile(AFileName: string); procedure LoadFromStream(AStream: TStream); procedure SaveToStream(AStream: TStream); function CreateGroup: TdxBarGroup; function CanShowRecentItems: Boolean; function GetPaintStyle: TdxBarManagerStyle; property CategoryItemsVisible[AIndex: Integer]: TdxBarItemVisible read GetCategoryItemsVisible write SetCategoryItemsVisible; property CategoryVisible[AIndex: Integer]: Boolean read GetCategoryVisible write SetCategoryVisible; property Designing: Boolean read FDesigning; property DockControlCount: Integer read GetDockControlCount; property DockControls[Index: Integer]: TdxDockControl read GetDockControl; property GroupCount: Integer read GetGroupCount; property Groups[Index: Integer]: TdxBarGroup read GetGroup; property IsCustomizing: Boolean read GetIsCustomizing; property ItemCount: Integer read GetItemCount; property Items[Index: Integer]: TdxBarItem read GetItem; property LockUpdate: Boolean read FLockUpdate write SetLockUpdate; property MainForm: TCustomForm read FMainForm; property MainMenuControl: TdxBarControl read GetMainMenuControl; property MainMenuBar: TdxBar read FMainMenuBar; property Modified: Boolean read FModified write FModified; // only for Standard style property PainterClass: TdxBarItemControlPainterClass read FPainterClass; property SelectedItem: TdxBarItemControl read FSelectedItem write SetSelectedItem; published property AllowCallFromAnotherForm: Boolean read FAllowCallFromAnotherForm write FAllowCallFromAnotherForm default False; property AllowReset: Boolean read FAllowReset write FAllowReset default True; property AlwaysMerge: Boolean read FAlwaysMerge write FAlwaysMerge default False; property AlwaysSaveText: Boolean read FAlwaysSaveText write FAlwaysSaveText default False; property AutoDockColor: Boolean read FAutoDockColor write SetAutoDockColor default True; property AutoHideEmptyBars: Boolean read FAutoHideEmptyBars write SetAutoHideEmptyBars default False; property Scaled: Boolean read FScaled write SetScaled default True; // must be before Font property Font: TFont read FFont write SetFont; // must be before Bars property Backgrounds: TdxBarBackgrounds read FBackgrounds write SetBackgrounds; property Bars: TdxBars read FBars write SetBars; property ButtonArrowWidth: Integer read FButtonArrowWidth write SetButtonArrowWidth default dxBarDefaultButtonArrowWidth; property CanCustomize: Boolean read FCanCustomize write FCanCustomize default True; property Categories: TStrings read FCategories write SetCategories; property DockColor: TColor read GetDockColor write SetDockColor stored IsDockColorStored; property FlatCloseButton: Boolean read FFlatCloseButton write SetFlatCloseButton default False; property HelpButtonGlyph: TBitmap read FHelpButtonGlyph write SetHelpButtonGlyph; property HelpContext: THelpContext read FHelpContext write FHelpContext default 0; property HideFloatingBarsWhenInactive: Boolean read FHideFloatingBarsWhenInactive write SetHideFloatingBarsWhenInactive default True; property HotImages: TCurImageList read FHotImages write SetHotImages; property ImageListBkColor: TColor read FImageListBkColor write SetImageListBkColor default clFuchsia; property Images: TCurImageList read FImages write SetImages; property DisabledImages: TCurImageList read FDisabledImages write SetDisabledImages; property DisabledLargeImages: TCurImageList read FDisabledLargeImages write SetDisabledLargeImages; property IniFileName: string read FIniFileName write FIniFileName; property LargeImages: TCurImageList read FLargeImages write SetLargeImages; property LargeButtonArrowWidth: Integer read FLargeButtonArrowWidth write SetLargeButtonArrowWidth default dxBarDefaultLargeButtonArrowWidth; property LargeIcons: Boolean read FLargeIcons write SetLargeIcons default False; property LookAndFeel: TcxLookAndFeel read FLookAndFeel write SetLookAndFeel; property MakeDisabledImagesFaded: Boolean read FMakeDisabledImagesFaded write SetMakeDisabledImagesFaded default False; property MenuAnimations: TdxBarMenuAnimations read FMenuAnimations write SetMenuAnimations default maNone; property MenusShowRecentItemsFirst: Boolean read FMenusShowRecentItemsFirst write SetMenusShowRecentItemsFirst default True; property MostRecentItemsPercents: Byte read FMostRecentItemsPercents write SetMostRecentItemsPercents default 95; property NotDocking: TdxBarDockingStyles read FNotDocking write SetNotDocking default []; property PopupMenuLinks: TdxBarPopupMenuLinks read FPopupMenuLinks write SetPopupMenuLinks; property RegistryPath: string read FRegistryPath write FRegistryPath; property ShowCloseButton: Boolean read FShowCloseButton write SetShowCloseButton default False; property ShowFullMenusAfterDelay: Boolean read FShowFullMenusAfterDelay write SetShowFullMenusAfterDelay default True; property ShowHelpButton: Boolean read FShowHelpButton write SetShowHelpButton default False; property ShowHint: Boolean read FShowHint write SetShowHint default True; property ShowHintForDisabledItems: Boolean read FShowHintForDisabledItems write FShowHintForDisabledItems default True; property ShowShortCutInHint: Boolean read FShowShortCutInHint write SetShowShortCutInHint default False; property StoreInIniFile: Boolean read FStoreInIniFile write FStoreInIniFile default False; property StoreInRegistry: Boolean read FStoreInRegistry write FStoreInRegistry default False; property StretchGlyphs: Boolean read FStretchGlyphs write FStretchGlyphs default True; property Style: TdxBarManagerStyle read FStyle write SetStyle default bmsEnhanced; property SunkenBorder: Boolean read FSunkenBorder write SetSunkenBorder default False; property UseF10ForMenu: Boolean read FUseF10ForMenu write FUseF10ForMenu default True; property UseFullReset: Boolean read FUseFullReset write FUseFullReset default False; property UseLargeImagesForLargeIcons: Boolean read FUseLargeImagesForLargeIcons write SetUseLargeImagesForLargeIcons default False; property UseSystemFont: Boolean read FUseSystemFont write SetUseSystemFont; property WaitForDockingTime: Integer read FWaitForDockingTime write SetWaitForDockingTime default 21; property OnBarAdd: TdxBarEvent read FOnBarAdd write FOnBarAdd; property OnBarAfterReset: TdxBarEvent read FOnBarAfterReset write FOnBarAfterReset; property OnBarBeforeReset: TdxBarEvent read FOnBarBeforeReset write FOnBarBeforeReset; property OnBarClose: TdxBarEvent read FOnBarClose write FOnBarClose; property OnBarDelete: TdxBarEvent read FOnBarDelete write FOnBarDelete; property OnBarDockingStyleChange: TdxBarEvent read FOnBarDockingStyleChange write FOnBarDockingStyleChange; property OnBarVisibleChange: TdxBarVisibleChangeEvent read FOnBarVisibleChange write FOnBarVisibleChange; property OnItemLinkAdd: TdxBarItemLinkEvent read FOnItemLinkAdd write FOnItemLinkAdd; property OnItemLinkChange: TdxBarItemLinkEvent read FOnItemLinkChange write FOnItemLinkChange; property OnItemLinkDelete: TdxBarItemLinkEvent read FOnItemLinkDelete write FOnItemLinkDelete; property OnCloseButtonClick: TNotifyEvent read FOnCloseButtonClick write FOnCloseButtonClick; property OnDocking: TdxBarCanDockingEvent read FOnDocking write FOnDocking; property OnHelpButtonClick: TNotifyEvent read FOnHelpButtonClick write FOnHelpButtonClick; property OnHideCustomizingForm: TNotifyEvent read FOnHideCustomizingForm write FOnHideCustomizingForm; property OnMenuMerge: TdxBarMenuMergeEvent read FOnMenuMerge write FOnMenuMerge; property OnShowCustomizingForm: TNotifyEvent read FOnShowCustomizingForm write FOnShowCustomizingForm; property OnShowCustomizingPopup: TdxBarShowPopupEvent read FOnShowCustomizingPopup write FOnShowCustomizingPopup; property OnShowToolbarsPopup: TdxBarShowPopupEvent read FOnShowToolbarsPopup write FOnShowToolbarsPopup; property OnClickItem: TdxBarClickItemEvent read FOnClickItem write FOnClickItem; end; TdxBarManagerList = class private FList: TList; function GetBarManager(Index: Integer): TdxBarManager; function GetCount: Integer; function GetCustomizingBarManager: TdxBarManager; public constructor Create; destructor Destroy; override; property BarManagers[Index: Integer]: TdxBarManager read GetBarManager; default; property Count: Integer read GetCount; property CustomizingBarManager: TdxBarManager read GetCustomizingBarManager; end; TdxBarBorderStyle = (bbsNone, bbsSingle); TdxBarStaticBorderStyle = (sbsNone, sbsLowered, sbsRaised, sbsEtched, sbsBump); TdxBarSpinEditButton = (sbNone, sbUp, sbDown); TdxBar = class(TCollectionItem) private FAllowClose: Boolean; FAllowCustomizing: Boolean; FAllowQuickCustomizing: Boolean; FAllowReset: Boolean; FAlphaBlendValue: Byte; FBackgroundBitmap: TBitmap; FBars: TdxBars; FBorderStyle: TdxBarBorderStyle; FCaption: string; FColor: TColor; FChangingDockingStyle: Boolean; FDockControl: TdxBarDockControl; FDockedDockControl: TdxBarDockControl; FDockedDockingStyle: TdxBarDockingStyle; FDockedLeft: Integer; FDockedTop: Integer; FDockingStyle: TdxBarDockingStyle; FEditFontHandle: HFONT; FFloatLeft: Integer; FFloatTop: Integer; FFloatClientWidth: Integer; FFloatClientHeight: Integer; FFont: TFont; FFreeNotificationItems: TList; FHidden: Boolean; // if True, then doesn't show in customizing form in run-time FInternalFontChange: Boolean; FInternallyHidden: Boolean; FIsMainMenu: Boolean; FIsPredefined: Boolean; FItemLinks: TdxBarItemLinks; FLoadedDockControl: TdxBarDockControl; FLoadedDockingStyle: TdxBarDockingStyle; FLoadedVisible: Boolean; FLockUpdate: Boolean; FName: string; FNotDocking: TdxBarDockingStyles; FMultiLine: Boolean; FOneOnRow: Boolean; FRotateWhenVertical: Boolean; FRow: Integer; FShowMark: Boolean; FSizeGrip: Boolean; FUseOwnFont: Boolean; FUseRecentItems: Boolean; FUseRestSpace: Boolean; FVisible: Boolean; // is it currently visible or not? FWholeRow: Boolean; procedure BitmapChanged(Sender: TObject); function GetBarManager: TdxBarManager; function GetControl: TdxBarControl; function GetDockedDockingStyle: TdxBarDockingStyle; function GetDockingStyle: TdxBarDockingStyle; function GetRealDockControl: TdxDockControl; procedure SetAllowClose(Value: Boolean); procedure SetAllowQuickCustomizing(Value: Boolean); procedure SetAlphaBlendValue(Value: Byte); procedure SetBackgroundBitmap(Value: TBitmap); procedure SetBorderStyle(Value: TdxBarBorderStyle); procedure SetCaption(Value: string); procedure SetColor(Value: TColor); procedure SetDockControl(Value: TdxBarDockControl); procedure SetDockedDockControl(Value: TdxBarDockControl); procedure SetDockedValue(Index: Integer; Value: Integer); procedure SetDockingStyle(Value: TdxBarDockingStyle); procedure SetFloatValue(Index: Integer; Value: Integer); procedure SetFont(Value: TFont); procedure SetHidden(Value: Boolean); procedure SetIsMainMenu(Value: Boolean); procedure SetItemLinks(Value: TdxBarItemLinks); procedure SetLockUpdate(Value: Boolean); procedure SetMultiLine(Value: Boolean); procedure SetNotDocking(Value: TdxBarDockingStyles); procedure SetRotateWhenVertical(Value: Boolean); procedure SetRow(Value: Integer); procedure SetShowMark(Value: Boolean); procedure SetSizeGrip(Value: Boolean); procedure SetUseOwnFont(Value: Boolean); procedure SetUseRecentItems(Value: Boolean); procedure SetUseRestSpace(Value: Boolean); procedure SetVisible(Value: Boolean); procedure SetWholeRow(Value: Boolean); procedure FontChanged(Sender: TObject); procedure ItemLinksChanged(Sender: TObject); procedure ResetToolbarClick(Sender: TObject); function IsDockedDockingStyleStored: Boolean; function IsDockingStyleStored: Boolean; protected procedure AddFreeNotification(AItem: TdxBarItem); procedure RemoveFreeNotification(AItem: TdxBarItem); procedure MakeFreeNotification; procedure CheckBarName(const AName: string); function BarNCSizeX(AStyle: TdxBarDockingStyle): Integer; function BarNCSizeY(AStyle: TdxBarDockingStyle): Integer; function CanClose: Boolean; function CanMoving: Boolean; function CanReset: Boolean; function HasSizeGrip: Boolean; function IsShortCut(AShortCut: TShortCut): Boolean; function IsStatusBar: Boolean; property Bars: TdxBars read FBars; public constructor Create(Collection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure ChangeDockingStyle(AStyle: TdxBarDockingStyle; ADockControl: TdxDockControl); procedure Reset; procedure ResetWithConfirmation; property BarManager: TdxBarManager read GetBarManager; property Control: TdxBarControl read GetControl; property IsPredefined: Boolean read FIsPredefined; property LockUpdate: Boolean read FLockUpdate write SetLockUpdate; property RealDockControl: TdxDockControl read GetRealDockControl; published property AllowClose: Boolean read FAllowClose write SetAllowClose default True; property AllowCustomizing: Boolean read FAllowCustomizing write FAllowCustomizing default True; property AllowQuickCustomizing: Boolean read FAllowQuickCustomizing write SetAllowQuickCustomizing default True; property AllowReset: Boolean read FAllowReset write FAllowReset default True; property BorderStyle: TdxBarBorderStyle read FBorderStyle write SetBorderStyle default bbsSingle; property Caption: string read FCaption write SetCaption; property Color: TColor read FColor write SetColor default clDefault; property DockControl: TdxBarDockControl read FDockControl write SetDockControl; property DockedDockControl: TdxBarDockControl read FDockedDockControl write SetDockedDockControl; property DockedDockingStyle: TdxBarDockingStyle read GetDockedDockingStyle write FDockedDockingStyle stored IsDockedDockingStyleStored; property DockedLeft: Integer index 1 read FDockedLeft write SetDockedValue; property DockedTop: Integer index 2 read FDockedTop write SetDockedValue; property DockingStyle: TdxBarDockingStyle read GetDockingStyle write SetDockingStyle stored IsDockingStyleStored; property FloatLeft: Integer index 1 read FFloatLeft write SetFloatValue; property FloatTop: Integer index 2 read FFloatTop write SetFloatValue; property FloatClientWidth: Integer index 3 read FFloatClientWidth write SetFloatValue; property FloatClientHeight: Integer index 4 read FFloatClientHeight write SetFloatValue; property Font: TFont read FFont write SetFont stored FUseOwnFont; property Hidden: Boolean read FHidden write SetHidden default False; property IsMainMenu: Boolean read FIsMainMenu write SetIsMainMenu default False; property ItemLinks: TdxBarItemLinks read FItemLinks write SetItemLinks; property MultiLine: Boolean read FMultiLine write SetMultiLine default False; property Name: string read FName write FName; property NotDocking: TdxBarDockingStyles read FNotDocking write SetNotDocking default []; property OneOnRow: Boolean read FOneOnRow write FOneOnRow; property RotateWhenVertical: Boolean read FRotateWhenVertical write SetRotateWhenVertical default True; property Row: Integer read FRow write SetRow; property ShowMark: Boolean read FShowMark write SetShowMark default True; property SizeGrip: Boolean read FSizeGrip write SetSizeGrip default True; property UseOwnFont: Boolean read FUseOwnFont write SetUseOwnFont; property UseRecentItems: Boolean read FUseRecentItems write SetUseRecentItems default True; property UseRestSpace: Boolean read FUseRestSpace write SetUseRestSpace default False; property Visible: Boolean read FVisible write SetVisible; property WholeRow: Boolean read FWholeRow write SetWholeRow; property BackgroundBitmap: TBitmap read FBackgroundBitmap write SetBackgroundBitmap; property AlphaBlendValue: Byte read FAlphaBlendValue write SetAlphaBlendValue default 255; end; TdxDockControls = array[dsLeft..dsBottom] of TdxDockControl; TdxBars = class(TCollection) private FDockControls: TdxDockControls; FDocking: Boolean; FDockingZoneSize: Integer; FBarManager: TdxBarManager; FLoading: Boolean; FMoving: Boolean; FMovingBarControl: TdxBarControl; FMovingBarOriginalDockingStyle: TdxBarDockingStyle; FMovingOffset: TPoint; FMovingStaticOffset: TPoint; function GetDockControl(Index: TdxBarDockingStyle): TdxDockControl; function GetItem(Index: Integer): TdxBar; procedure SetItem(Index: Integer; Value: TdxBar); protected function GetOwner: TPersistent; override; procedure RegInDock(AStyle: TdxBarDockingStyle; ADockControl: TdxDockControl; ABarControl: TdxBarControl; APos: TPoint); procedure UnregFromDock(AStyle: TdxBarDockingStyle; ADockControl: TdxDockControl; ABarControl: TdxBarControl); procedure ChangeBarControlPos(ABarControl: TdxBarControl; APos: TPoint); function GetDockingStyleAtPos(Bar: TdxBar; Pos: TPoint; var DockControl: TdxDockControl): TdxBarDockingStyle; procedure Moving(AMovingBarControl: TdxBarControl); procedure Update(Item: TCollectionItem); override; property DockingZoneSize: Integer read FDockingZoneSize write FDockingZoneSize; public constructor Create(ABarManager: TdxBarManager); destructor Destroy; override; function Add: TdxBar; function GetUniqueToolbarName(const BaseName: string): string; property BarManager: TdxBarManager read FBarManager; property DockControls[Index: TdxBarDockingStyle]: TdxDockControl read GetDockControl; property IsLoading: Boolean read FLoading write FLoading; property IsMoving: Boolean read FMoving; property Items[Index: Integer]: TdxBar read GetItem write SetItem; default; end; TdxBarUserDefine = (udCaption, udGlyph, udPaintStyle, udWidth); TdxBarUserDefines = set of TdxBarUserDefine; TdxBarPaintStyle = (psStandard, psCaption, psCaptionInMenu, psCaptionGlyph); TdxBarItemLink = class(TCollectionItem) private FBeginGroup: Boolean; FControl: TdxBarItemControl; FData: Integer; FItem: TdxBarItem; FItemRect: TRect; FLoadedRecentIndex: Integer; FLoadedUseCount: Integer; FLoadedVisible: Boolean; FMostRecentlyUsed: Boolean; FOriginalItemLink: TdxBarItemLink; FPrevRecentIndex: Integer; FRowHeight: Integer; FUseCount: Integer; FUserCaption: string; FUserDefine: TdxBarUserDefines; FUserGlyph: TBitmap; FUserPaintStyle: TdxBarPaintStyle; FUserWidth: Integer; FVisible: Boolean; function GetAvailableIndex: Integer; function GetBarControl: TCustomdxBarControl; function GetBarManager: TdxBarManager; function GetBeginGroup: Boolean; function GetCanVisibleIndex: Integer; function GetCaption: string; function GetGlyph: TBitmap; function GetOwnerValue: TdxBarItemLinks; function GetPaintStyle: TdxBarPaintStyle; function GetVisibleIndex: Integer; function GetWidth: Integer; procedure SetBeginGroup(Value: Boolean); procedure SetItem(Value: TdxBarItem); procedure SetMostRecentlyUsed(Value: Boolean); procedure SetUserCaption(Value: string); procedure SetUserDefine(Value: TdxBarUserDefines); procedure SetUserGlyph(Value: TBitmap); procedure SetUserPaintStyle(Value: TdxBarPaintStyle); procedure SetUserWidth(Value: Integer); procedure SetVisible(Value: Boolean); procedure AddToRecentList; procedure RemoveFromRecentList; procedure RestoreRecentIndex; procedure SaveRecentIndex; procedure InternalBringToTopInRecentList(IncCount: Boolean); procedure Synchronize(AItemLink: TdxBarItemLink); procedure CheckMostRecentlyUsed; function GetRecentIndex: Integer; procedure SetRecentIndex(Value: Integer); property RecentIndex: Integer read GetRecentIndex write SetRecentIndex; function CanVisible: Boolean; function GetRealItemLink: TdxBarItemLink; protected function HasItem(AItem: TdxBarItem): Boolean; procedure InitiateAction; function IsAccel(Key: Word; Shift: TShiftState): Boolean; procedure ItemLinkChanged; property RowHeight: Integer read FRowHeight write FRowHeight; public constructor Create(Collection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; procedure BringToTopInRecentList(IncCount: Boolean); procedure CreateControl; procedure DestroyControl; procedure SendToBottomInRecentList; property AvailableIndex: Integer read GetAvailableIndex; property BarControl: TCustomdxBarControl read GetBarControl; property BarManager: TdxBarManager read GetBarManager; property CanVisibleIndex: Integer read GetCanVisibleIndex; property Caption: string read GetCaption; property Control: TdxBarItemControl read FControl; property Data: Integer read FData write FData default 0; property Glyph: TBitmap read GetGlyph; property ItemRect: TRect read FItemRect write FItemRect; property OriginalItemLink: TdxBarItemLink read FOriginalItemLink; property Owner: TdxBarItemLinks read GetOwnerValue; property PaintStyle: TdxBarPaintStyle read GetPaintStyle; property RealItemLink: TdxBarItemLink read GetRealItemLink; property VisibleIndex: Integer read GetVisibleIndex; property Width: Integer read GetWidth; published property BeginGroup: Boolean read GetBeginGroup write SetBeginGroup default False; property Item: TdxBarItem read FItem write SetItem; property MostRecentlyUsed: Boolean read FMostRecentlyUsed write SetMostRecentlyUsed default True; property UserCaption: string read FUserCaption write SetUserCaption; property UserDefine: TdxBarUserDefines read FUserDefine write SetUserDefine default []; property UserGlyph: TBitmap read FUserGlyph write SetUserGlyph; property UserPaintStyle: TdxBarPaintStyle read FUserPaintStyle write SetUserPaintStyle default psStandard; property UserWidth: Integer read FUserWidth write SetUserWidth default 0; property Visible: Boolean read FVisible write SetVisible; end; TdxBarIterationProc = procedure(Index: Integer; ItemLink: TdxBarItemLink; var Stop: Boolean; var Data: Pointer) of object; TdxBarItemLinks = class(TCollection) private FAssigning: Boolean; FAvailableItems, FCanVisibleItems, FVisibleItems: TList; FBarControl: TCustomdxBarControl; FBarManager: TdxBarManager; FOwner: TObject; FPrevRecentItemCount: Integer; FRecentItems: TList; FRecentItemCount: Integer; FUseRecentItems: Boolean; FOnChange: TNotifyEvent; function GetAvailableItem(Index: Integer): TdxBarItemLink; function GetAvailableItemCount: Integer; function GetCanVisibleItem(Index: Integer): TdxBarItemLink; function GetCanVisibleItemCount: Integer; function GetItem(Index: Integer): TdxBarItemLink; function GetMostRecentItemCount: Integer; function GetRealVisibleItemCount: Integer; function GetVisibleItem(Index: Integer): TdxBarItemLink; function GetVisibleItemCount: Integer; procedure SetItem(Index: Integer; Value: TdxBarItemLink); procedure SetRecentItemCount(Value: Integer); procedure RefreshVisibilityLists; property MostRecentItemCount: Integer read GetMostRecentItemCount; procedure RestoreRecentItemCount; property RecentItemCount: Integer read FRecentItemCount write SetRecentItemCount; procedure EmptyItemRects; procedure Loaded(CheckVisible: Boolean); procedure CheckVisibleIntegrity; procedure AssignUsageData(AItemLinks: TdxBarItemLinks); protected function CanUseRecentItems: Boolean; procedure InitiateActions; function IsDesignTimeLinks: Boolean; function IsShortCut(AShortCut: TShortCut): Boolean; function FindItemWithAccel(Key: Word; Shift: TShiftState; Current: TdxBarItemLink): TdxBarItemLink; function First: TdxBarItemLink; function Last: TdxBarItemLink; function Next(Current: TdxBarItemLink): TdxBarItemLink; function Prev(Current: TdxBarItemLink): TdxBarItemLink; function GetOwner: TPersistent; override; procedure Update(Item: TCollectionItem); override; property RealVisibleItemCount: Integer read GetRealVisibleItemCount; public constructor Create(ABarManager: TdxBarManager); destructor Destroy; override; function Add: TdxBarItemLink; procedure Assign(Source: TPersistent); override; function AvailableIndexOf(Value: TdxBarItemLink): Integer; function CanVisibleIndexOf(Value: TdxBarItemLink): Integer; procedure CreateBarControl; procedure FreeForeignItems(ForeignBarManager: TdxBarManager); function HasItem(AItem: TdxBarItem): Boolean; function IndexOf(Value: TdxBarItemLink): Integer; function VisibleIndexOf(Value: TdxBarItemLink): Integer; property AvailableItems[Index: Integer]: TdxBarItemLink read GetAvailableItem; property AvailableItemCount: Integer read GetAvailableItemCount; property BarControl: TCustomdxBarControl read FBarControl write FBarControl; property BarManager: TdxBarManager read FBarManager; property CanVisibleItems[Index: Integer]: TdxBarItemLink read GetCanVisibleItem; property CanVisibleItemCount: Integer read GetCanVisibleItemCount; property Items[Index: Integer]: TdxBarItemLink read GetItem write SetItem; default; {$WARNINGS OFF} property Owner: TObject read FOwner; // TdxBar, TdxBarPopupMenu, TCustomdxBarSubItem, nil {$WARNINGS ON} property VisibleItems[Index: Integer]: TdxBarItemLink read GetVisibleItem; property VisibleItemCount: Integer read GetVisibleItemCount; property OnChange: TNotifyEvent read FOnChange write FOnChange; end; TdxBarPaintSubMenuBarEvent = procedure(Sender: TObject; Canvas: TCanvas; const R: TRect) of object; TdxBarPopupMenu = class(TComponent, IUnknown, IcxPopupMenu) private DontUseMessageLoop: Boolean; FBackgroundBitmap: TBitmap; FBarManager: TdxBarManager; FBarSize: Integer; FEditFontHandle: HFONT; FFont: TFont; FInternalFontChange: Boolean; FItemLinks: TdxBarItemLinks; FOwnerBounds: PRect; FOwnerControl: TWinControl; FOwnerWidth, FOwnerHeight: Integer; FPopupMenuVisible: Boolean; FShowAnimation: Boolean; FUseOwnFont: Boolean; FUseRecentItems: Boolean; FOnCloseUp: TNotifyEvent; FOnPaintBar: TdxBarPaintSubMenuBarEvent; FOnPopup: TNotifyEvent; function GetSubMenuControl: TdxBarSubMenuControl; procedure SetBackgroundBitmap(Value: TBitmap); procedure SetBarManager(Value: TdxBarManager); procedure SetBarSize(Value: Integer); procedure SetFont(Value: TFont); procedure SetItemLinks(Value: TdxBarItemLinks); procedure SetUseOwnFont(Value: Boolean); procedure SetUseRecentItems(Value: Boolean); procedure FontChanged(Sender: TObject); procedure SubMenuCloseUp(Sender: TObject); procedure SubMenuPopup(Sender: TObject); procedure OwnerDesignerModified; protected procedure DoPaintBar(Canvas: TCanvas; const R: TRect); virtual; function IsShortCut(AShortCut: TShortCut): Boolean; function IsShortCutKey(var Message: TWMKey): Boolean; procedure Loaded; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Popup(X, Y: Integer); procedure PopupEx(X, Y, AOwnerWidth, AOwnerHeight: Integer; AShowAnimation: Boolean; AOwnerBounds: PRect); procedure PopupFromCursorPos; property SubMenuControl: TdxBarSubMenuControl read GetSubMenuControl; published property BarManager: TdxBarManager read FBarManager write SetBarManager; property BarSize: Integer read FBarSize write SetBarSize default 0; property Font: TFont read FFont write SetFont stored FUseOwnFont; property ItemLinks: TdxBarItemLinks read FItemLinks write SetItemLinks; property UseOwnFont: Boolean read FUseOwnFont write SetUseOwnFont; property UseRecentItems: Boolean read FUseRecentItems write SetUseRecentItems default False; property BackgroundBitmap: TBitmap read FBackgroundBitmap write SetBackgroundBitmap; property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp; property OnPaintBar: TdxBarPaintSubMenuBarEvent read FOnPaintBar write FOnPaintBar; property OnPopup: TNotifyEvent read FOnPopup write FOnPopup; end; {----------------------- Visual components -----------------------} { dock controls } TdxDockControl = class(TCustomControl) private FAllowDocking: Boolean; FBackgroundBitmap: TBitmap; FBackgroundTempBitmap: TBitmap; FBarManager: TdxBarManager; FDockingStyle: TdxBarDockingStyle; FIsBarHandleDestroying: Boolean; FRowList: TList; FRowMarginSize: Integer; procedure BitmapChanged(Sender: TObject); function GetBars: TdxBars; function GetDockingStyle: TdxBarDockingStyle; function GetHorizontal: Boolean; function GetIsDesigning: Boolean; function GetIsLoading: Boolean; function GetMain: Boolean; function GetRow(Index: Integer): TdxDockRow; function GetRowCount: Integer; function GetTopLeft: Boolean; function GetVertical: Boolean; procedure SetBarManager(Value: TdxBarManager); procedure SetBackgroundBitmap(Value: TBitmap); procedure WMDestroy(var Message: TMessage); message WM_DESTROY; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE; procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT; procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN; procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; protected procedure AlignControls(AControl: TControl; var Rect: TRect); override; procedure CreateParams(var Params: TCreateParams); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure RequestAlign; override; procedure WndProc(var Message: TMessage); override; procedure AddBarControl(ABarControl: TdxBarControl; APos: TPoint; Update: Boolean); procedure DeleteBarControl(ABarControl: TdxBarControl; ADockCol: TObject; Update: Boolean); procedure MoveBarControl(ABarControl: TdxBarControl; APos: TPoint); procedure AssignPositions; procedure BarManagerChanged; virtual; function CanDocking(Bar: TdxBar): Boolean; virtual; procedure ColorChanged; virtual; function GetDockZoneBounds: TRect; procedure GetDockZoneMargins(Row, ZoneNumber: Integer; var M1, M2: Integer); function GetRectForRow(ARow: Integer): TRect; function GetClientSize: Integer; virtual; function GetSize: Integer; function GetRowAtPos(APos: TPoint; var Insert: Boolean): Integer; function GetColAtPos(ARow: Integer; APos: TPoint): Integer; procedure GetPosForRow(Row: Integer; OneOnRow: Boolean; var P: TPoint); function GetSunkenBorder: Boolean; virtual; function GetMainForm: TCustomForm; virtual; procedure NCChanged; procedure PaintBarControls; procedure SetSize; procedure UpdateDock; procedure FillBackground(DC: HDC; ADestR, ASourceR: TRect; ABrush: HBRUSH; AColor: TColor); virtual; function IsBackgroundBitmap: Boolean; virtual; function IsTransparent: Boolean; virtual; procedure RepaintBarControls; virtual; procedure ResetBackground; virtual; procedure UpdateDoubleBuffered; virtual; property BackgroundTempBitmap: TBitmap read FBackgroundTempBitmap; property AllowDocking: Boolean read FAllowDocking write FAllowDocking default True; property BackgroundBitmap: TBitmap read FBackgroundBitmap write SetBackgroundBitmap; property Horizontal: Boolean read GetHorizontal; property IsBarHandleDestroying: Boolean read FIsBarHandleDestroying write FIsBarHandleDestroying; property IsDesigning: Boolean read GetIsDesigning; property IsLoading: Boolean read GetIsLoading; property Main: Boolean read GetMain; property RowMarginSize: Integer read FRowMarginSize write FRowMarginSize; property SunkenBorder: Boolean read GetSunkenBorder; property TopLeft: Boolean read GetTopLeft; property Vertical: Boolean read GetVertical; public constructor Create(AOwner: TComponent); override; constructor CreateEx(AOwner: TComponent; ABarManager: TdxBarManager; ADockStyle: TdxBarDockingStyle); destructor Destroy; override; procedure InitiateAction; override; property BarManager: TdxBarManager read FBarManager write SetBarManager; property Bars: TdxBars read GetBars; property DockingStyle: TdxBarDockingStyle read GetDockingStyle; property RowCount: Integer read GetRowCount; property RowList: TList read FRowList; property Rows[Index: Integer]: TdxDockRow read GetRow; end; TdxBarDockAlign = (dalNone, dalTop, dalBottom, dalLeft, dalRight); TdxBarDockControl = class(TdxDockControl) private FAllowZeroSizeInDesignTime: Boolean; FSunkenBorder: Boolean; FUseOwnColor: Boolean; FUseOwnSunkenBorder: Boolean; function GetAlign: TdxBarDockAlign; function GetColor: TColor; function GetIsLoading: Boolean; function GetParentColor: Boolean; procedure SetAlign(Value: TdxBarDockAlign); procedure SetAllowZeroSizeInDesignTime(Value: Boolean); procedure SetColor(Value: TColor); procedure SetParentColor(Value: Boolean); procedure SetSunkenBorder(Value: Boolean); procedure SetUseOwnColor(Value: Boolean); procedure SetUseOwnSunkenBorder(Value: Boolean); function IsColorStored: Boolean; procedure WMCreate(var Message: TWMCreate); message WM_CREATE; procedure WMSize(var Message: TWMSize); message WM_SIZE; protected procedure CreateParams(var Params: TCreateParams); override; procedure Paint; override; procedure BarManagerChanged; override; function CanDocking(Bar: TdxBar): Boolean; override; procedure ColorChanged; override; function GetClientSize: Integer; override; function GetMinSize: Integer; function GetSunkenBorder: Boolean; override; function GetMainForm: TCustomForm; override; property IsLoading: Boolean read GetIsLoading; public constructor Create(AOwner: TComponent); override; published property Align: TdxBarDockAlign read GetAlign write SetAlign; property AllowDocking; property AllowZeroSizeInDesignTime: Boolean read FAllowZeroSizeInDesignTime write SetAllowZeroSizeInDesignTime default False; property Anchors; property BarManager; property Color read GetColor write SetColor stored IsColorStored; property ParentColor: Boolean read GetParentColor write SetParentColor stored IsColorStored; property SunkenBorder: Boolean read GetSunkenBorder write SetSunkenBorder stored FUseOwnSunkenBorder; property UseOwnColor: Boolean read FUseOwnColor write SetUseOwnColor default False; property UseOwnSunkenBorder: Boolean read FUseOwnSunkenBorder write SetUseOwnSunkenBorder default False; property Visible; property BackgroundBitmap; property OnClick; property OnDblClick; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnResize; end; { shadow support } TdxBarShadowCorner = (scLeft, scRight, scTop); TdxBarShadowCorners = set of TdxBarShadowCorner; TdxBarShadowPartKind = (spHorizontal, spVertical); TdxBarShadowPart = class(TCustomControl) private FCorners: TdxBarShadowCorners; FImage: TBitmap; FKind: TdxBarShadowPartKind; FOwner: TdxBarShadow; function GetControl: TWinControl; function GetShadowSize: Integer; function GetTransparent: Boolean; procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; protected function CanShow: Boolean; procedure CreateParams(var Params: TCreateParams); override; procedure Paint; override; procedure UpdateImage; property Control: TWinControl read GetControl; property Image: TBitmap read FImage; property Owner: TdxBarShadow read FOwner; property ShadowSize: Integer read GetShadowSize; property Transparent: Boolean read GetTransparent; public constructor CreateEx(AOwner: TdxBarShadow; AKind: TdxBarShadowPartKind; ACorners: TdxBarShadowCorners); destructor Destroy; override; procedure Hide; procedure Show; procedure UpdateBounds(const ABounds: TRect); property Corners: TdxBarShadowCorners read FCorners; property Kind: TdxBarShadowPartKind read FKind; end; TdxBarShadow = class private FHorizontal: Boolean; FOwner: TWinControl; FParts: array[0..4] of TdxBarShadowPart; FVisible: Boolean; function GetShadowSize: Integer; function GetTransparent: Boolean; procedure SetVisible(Value: Boolean); protected R1, R2: TRect; procedure CreateParts; procedure DestroyParts; procedure Hide; procedure Show; property Transparent: Boolean read GetTransparent; public constructor Create(AOwner: TWinControl); destructor Destroy; override; procedure Refresh; procedure SetOwnerBounds(AR1, AR2: TRect); property Horizontal: Boolean read FHorizontal; property Owner: TWinControl read FOwner; property ShadowSize: Integer read GetShadowSize; property Visible: Boolean read FVisible write SetVisible; end; { TCustomdxBarControl } TdxBarMarkState = (msNone, msSelected, msPressed); TCustomdxBarControl = class(TCustomControl) private FBackgroundTempBitmap: TBitmap; FBkBrush: HBRUSH; FChildBar: TCustomdxBarControl; FClickedControl: TdxBarItemControl; FDestroyFlag: Boolean; FDockControl: TdxDockControl; FDockingStyle: TdxBarDockingStyle; FDragDown: Boolean; FDragPoint: TPoint; FIgnoreMouseClick: Boolean; FInRepaint: Boolean; FIsActive: Boolean; FItemLinks: TdxBarItemLinks; FMarkState: TdxBarMarkState; FMouseOverClickedControl: Boolean; FMovingChanging: Boolean; FOwnerBounds: TRect; FOwnerControl: TWinControl; FParentBar: TCustomdxBarControl; FPrevActiveBarControl: TCustomdxBarControl; FSelectedItem: TdxBarItemControl; FShadow: TdxBarShadow; FTextSize, FEditTextSize: Integer; FMenuArrowHeight, FMenuArrowWidth: Integer; FComboBoxArrowWidth: Integer; function GetBarControlOwnerBrush: HBRUSH; function GetBarManager: TdxBarManager; function GetFlat: Boolean; function GetIsDestroying: Boolean; function GetOwnerLinkBounds(AOwnerPart: Boolean): TRect; function GetPainterClass: TdxBarItemControlPainterClass; procedure SetDockControl(Value: TdxDockControl); procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED; procedure WMDestroy(var Message: TMessage); message WM_DESTROY; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP; procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE; procedure WMMouseLeave(var Message: TMessage); message WM_MOUSELEAVE; procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE; procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN; procedure WMRepaintBar(var Message: TMessage); message WM_REPAINTBAR; procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; protected FLastMousePos: TPoint; procedure AdjustSize; override; procedure CreateWindowHandle(const Params: TCreateParams); override; procedure CreateWnd; override; procedure DestroyWindowHandle; override; procedure CreateControls; virtual; procedure DestroyControls; virtual; procedure WndProc(var Message: TMessage); override; procedure BeforeDestroyHandle; procedure CalcDrawingConsts; virtual; function CanAlignControl(AControl: TdxBarItemControl): Boolean; virtual; function CanCallInheritedNCCalcSize: Boolean; virtual; // obsolete //function CanCallInheritedNCPaint: Boolean; virtual; function CanCustomizing: Boolean; virtual; function CanFinishMouseTracking(const Message: TWMNCHitTest): Boolean; dynamic; function ChildrenHaveShadows: Boolean; virtual; procedure DblClickOnItem(Item: TdxBarItemControl); dynamic; procedure DrawSelectedItem(AControl: TdxBarItemControl); procedure FocusNextBarControl(AForward: Boolean); function GetBeginGroupSize: Integer; virtual; abstract; function GetEditFontHandle: HFONT; virtual; function GetFullItemRect(Item: TdxBarItemControl): TRect; virtual; function GetIsCustomizing: Boolean; virtual; function GetIsShadowVisible: Boolean; virtual; function GetItemRectEx(Item: TdxBarItemControl; IsBeginGroup: Boolean): TRect; virtual; function GetItemRegion(Item: TdxBarItemControl): HRGN; virtual; function GetItemScreenRect(Item: TdxBarItemControl): TRect; function GetOwnerControl: TWinControl; virtual; function GetToolbarBrush: HBRUSH; virtual; function GetToolbarDownedBrush: HBRUSH; virtual; function GetToolbarDownedSelBrush: HBRUSH; virtual; function GetToolbarSelBrush: HBRUSH; virtual; procedure GetWindowRect(var R: TRect); function HasShadow: Boolean; function HideOnClick: Boolean; virtual; function IsChildBar(Value: TCustomdxBarControl): Boolean; virtual; function IsLinkedToOwner: Boolean; virtual; function ItemAtPosEx(Pos: TPoint; var IsBeginGroup, IsFirstPart, IsVerticalDirection: Boolean): TdxBarItemControl; virtual; function ItemExists(Item: TdxBarItemControl): Boolean; function MarkExists: Boolean; virtual; function NotHandleMouseMove(P: TPoint): Boolean; virtual; procedure PaintItem(AControl: TdxBarItemControl); virtual; procedure PaintSelectedItem(OldSelectedItem: TdxBarItemControl); virtual; procedure ResizeShadow; function SelectedItemWantsKey(Key: Word): Boolean; procedure SetCursorForMoving(AMoving: Boolean); procedure SetDockingStyle(Value: TdxBarDockingStyle); virtual; procedure SetFont; virtual; abstract; procedure SetIsActive(Value: Boolean); virtual; procedure SetKeySelectedItem(Value: TdxBarItemControl); virtual; procedure SetLayeredAttributes; virtual; procedure SetMarkState(Value: TdxBarMarkState); virtual; abstract; procedure SetMouseSelectedItem(Value: TdxBarItemControl); virtual; procedure SetSelectedItem(Value: TdxBarItemControl); virtual; procedure UpdateControlStyle; function WantMouse: Boolean; procedure FillBackground(DC: HDC; ARect: TRect; ABrush: HBRUSH; AColor: TColor; AIsClientArea: Boolean); virtual; procedure FillBackgroundRgn(DC: HDC; ARgn: HRGN; ABrush: HBRUSH; AIsClientArea: Boolean); virtual; procedure FullInvalidate; procedure FullRepaint; function IsInternal: Boolean; virtual; function IsBackgroundBitmap: Boolean; virtual; function IsTransparent: Boolean; virtual; function NCOffset: TPoint; virtual; function PointBarToDock(const APoint: TPoint): TPoint; procedure ResetBackground; virtual; procedure UpdateDoubleBuffered; virtual; property BackgroundTempBitmap: TBitmap read FBackgroundTempBitmap; property ChildBar: TCustomdxBarControl read FChildBar write FChildBar; property DockControl: TdxDockControl read FDockControl write SetDockControl; property DockingStyle: TdxBarDockingStyle read FDockingStyle write SetDockingStyle; property Flat: Boolean read GetFlat; // TODO: obsolete property IsDestroying: Boolean read GetIsDestroying; property IsShadowVisible: Boolean read GetIsShadowVisible; property MarkState: TdxBarMarkState read FMarkState write SetMarkState; property ParentBar: TCustomdxBarControl read FParentBar write FParentBar; property SelectedItem: TdxBarItemControl read FSelectedItem write SetSelectedItem; property Shadow: TdxBarShadow read FShadow; property BeginGroupSize: Integer read GetBeginGroupSize; property OwnerBounds: TRect read FOwnerBounds write FOwnerBounds; property OwnerControl: TWinControl read GetOwnerControl; property OwnerLinkBounds[AOwnerPart: Boolean]: TRect read GetOwnerLinkBounds; property BarControlOwnerBrush: HBRUSH read GetBarControlOwnerBrush; property PainterClass: TdxBarItemControlPainterClass read GetPainterClass; property ToolbarBrush: HBRUSH read GetToolbarBrush; property ToolbarDownedBrush: HBRUSH read GetToolbarDownedBrush; property ToolbarDownedSelBrush: HBRUSH read GetToolbarDownedSelBrush; property ToolbarSelBrush: HBRUSH read GetToolbarSelBrush; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetItemRect(Item: TdxBarItemControl): TRect; procedure HideAll; virtual; function ItemAtPos(Pos: TPoint): TdxBarItemControl; procedure RepaintBar; virtual; property BarManager: TdxBarManager read GetBarManager; property BkBrush: HBRUSH read FBkBrush; property Canvas; property ComboBoxArrowWidth: Integer read FComboBoxArrowWidth; property EditFontHandle: HFONT read GetEditFontHandle; property EditTextSize: Integer read FEditTextSize; property Font; property IsActive: Boolean read FIsActive write SetIsActive; property IsCustomizing: Boolean read GetIsCustomizing; property ItemLinks: TdxBarItemLinks read FItemLinks write FItemLinks; property MenuArrowHeight: Integer read FMenuArrowHeight; property MenuArrowWidth: Integer read FMenuArrowWidth; property TextSize: Integer read FTextSize; end; { TdxBarControl } TdxDockCol = class private FBarControl: TdxBarControl; FDockRow: TdxDockRow; FPos: TPoint; public constructor Create(ADockRow: TdxDockRow; ABarControl: TdxBarControl); procedure AssignPosition; property BarControl: TdxBarControl read FBarControl; property DockRow: TdxDockRow read FDockRow; property Pos: TPoint read FPos write FPos; end; TdxDockRow = class protected FColList: TList; FDockControl: TdxDockControl; function GetCol(Index: Integer): TdxDockCol; function GetColCount: Integer; public constructor Create(ADockControl: TdxDockControl); destructor Destroy; override; property ColCount: Integer read GetColCount; property ColList: TList read FColList; property Cols[Index: Integer]: TdxDockCol read GetCol; property DockControl: TdxDockControl read FDockControl; end; TdxBarMDIButton = (mdibMinimize, mdibRestore, mdibClose); TdxBarMDIButtons = set of TdxBarMDIButton; TdxBarControl = class(TCustomdxBarControl) private BeforeBarGetFocusFocusedWnd: HWND; FBar: TdxBar; FCloseButtonState: TdxBarMarkState; FDockedHandle, FFloatingHandle: HWND; FEditSizingCursor, FRightBorderSizing: Boolean; FHasCaption: Boolean; FHasSizeGrip: Boolean; FHitTest: Longint; FInternalLockCount: Integer; FIsDowned: Boolean; FMDIButtonWidth, FMDIButtonHeight: Integer; FMinSize, FMaxSize: Integer; FMoreButtonsHintTimer: UINT; FMoving: Boolean; FSettingFont: Boolean; FSizingEditWidth: Integer; FTruncated: Boolean; FQuickPopup: TdxBarControl; NewLeft, NewTop, NewWidth, NewHeight: Integer; RX, RY: TPoint; function GetCaptionBkColor: COLORREF; function GetCaptionColor: COLORREF; function GetHorizontal: Boolean; function GetInternallyLocked: Boolean; function GetMultiLine: Boolean; function GetVertical: Boolean; procedure SetCloseButtonState(Value: TdxBarMarkState); procedure SetMoving(Value: Boolean); procedure CalcControlsPositions; procedure ChangeStyleWinTo(AStyle: TdxBarDockingStyle; ADockControl: TdxDockControl); procedure DrawEditSizingFrame(AWidth: Integer); function GetDragPointOffset(Style: TdxBarDockingStyle): TPoint; function GetCaptionNCRect: TRect; function GetCaptionRect: TRect; procedure DrawCloseButton(DC: HDC); procedure DrawMark(DC: HDC); procedure DrawMDIButton(AButton: TdxBarMDIButton; ASelected, APressed: Boolean); function GetMDIWidth: Integer; function GetMDIHeight: Integer; function RectMDI(Button: TdxBarMDIButton): TRect; function RealMDIButtonsOnBar: Boolean; function MDIButtonsOnBar: Boolean; function MDIButtonEnabled(AButton: TdxBarMDIButton; State: Integer): Boolean; procedure StartMoreButtonsHintTimer; procedure FinishMoreButtonsHintTimer; procedure CheckMarkState(const P: TPoint); procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED; procedure WMDestroy(var Message: TMessage); message WM_DESTROY; procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; procedure WMGetMinMaxInfo(var Message: TWMGetMinmaxInfo); message WM_GETMINMAXINFO; procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP; procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE; procedure WMMouseLeave(var Message: TMessage); message WM_MOUSELEAVE; procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE; procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN; procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN; procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMSizing(var Message: TMessage); message WM_SIZING; procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; protected procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; procedure Paint; override; procedure WndProc(var Message: TMessage); override; procedure BeginInternal; procedure EndInternal; property InternallyLocked: Boolean read GetInternallyLocked; procedure CalcDrawingConsts; override; function CanAlignControl(AControl: TdxBarItemControl): Boolean; override; function CanCallInheritedNCCalcSize: Boolean; override; // obsolete function CanCustomizing: Boolean; override; function CanFinishMouseTracking(const Message: TWMNCHitTest): Boolean; override; function CloseButtonRect: TRect; function CloseButtonRectNC: TRect; function GetAlphaBlendValue: Byte; function GetBeginGroupSize: Integer; override; function GetCol: Integer; function GetDockCol: TdxDockCol; function GetRow: Integer; function GetMainForm: TCustomForm; virtual; function GetMinWidth(AStyle: TdxBarDockingStyle): Integer; function GetMinHeight(AStyle: TdxBarDockingStyle): Integer; function GetMaxWidth(AStyle: TdxBarDockingStyle): Integer; function GetMaxHeight(AStyle: TdxBarDockingStyle): Integer; procedure GetMultiLineBarSize(AStyle: TdxBarDockingStyle; ASize: Integer; var Result: TPoint); function GetSizeAllCursorBounds: TRect; virtual; function GetSizeForWidth(AStyle: TdxBarDockingStyle; AWidth: Integer): TPoint; function GetSizeForHeight(AStyle: TdxBarDockingStyle; AHeight: Integer): TPoint; function GetTrackSize(AStyle: TdxBarDockingStyle): TPoint; procedure InvalidateMark; function MarkExists: Boolean; override; function MarkNCRect: TRect; function MarkRect: TRect; function MarkItemRect: TRect; function MarkScreenRect: TRect; function SizeGripRect: TRect; procedure BarManagerStyleChanged; procedure CaptionChanged; virtual; procedure DrawMDIButtons(ARgn: HRGN; AButtons: TdxBarMDIButtons); procedure FrameChanged; function GetEditFontHandle: HFONT; override; function GetFullItemRect(Item: TdxBarItemControl): TRect; override; function GetItemRegion(Item: TdxBarItemControl): HRGN; override; function GetToolbarBrush: HBRUSH; override; function ItemAtPosEx(Pos: TPoint; var IsBeginGroup, IsFirstPart, IsVerticalDirection: Boolean): TdxBarItemControl; override; function NotHandleMouseMove(P: TPoint): Boolean; override; procedure PaintItem(AControl: TdxBarItemControl); override; procedure RebuildBar; procedure RefreshShadow; procedure RepaintMDIButtons; procedure SavePos; procedure SetFont; override; procedure SetIsActive(Value: Boolean); override; procedure SetDockingStyle(Value: TdxBarDockingStyle); override; procedure SetKeySelectedItem(Value: TdxBarItemControl); override; procedure SetLayeredAttributes; override; procedure SetMarkState(Value: TdxBarMarkState); override; procedure FillBackground(DC: HDC; ARect: TRect; ABrush: HBRUSH; AColor: TColor; AIsClientArea: Boolean); override; function IsBackgroundBitmap: Boolean; override; function IsTransparent: Boolean; override; function NCOffset: TPoint; override; property CaptionBkColor: COLORREF read GetCaptionBkColor; property CaptionColor: COLORREF read GetCaptionColor; property CloseButtonState: TdxBarMarkState read FCloseButtonState write SetCloseButtonState; property Horizontal: Boolean read GetHorizontal; property IsDowned: Boolean read FIsDowned write FIsDowned; property Moving: Boolean read FMoving write SetMoving; property MultiLine: Boolean read GetMultiLine; property Vertical: Boolean read GetVertical; property MDIButtonWidth: Integer read FMDIButtonWidth; property MDIButtonHeight: Integer read FMDIButtonHeight; public constructor CreateEx(AOwner: TComponent; ABar: TdxBar); virtual; destructor Destroy; override; procedure BarGetFocus(ASelectedItem: TdxBarItemControl); virtual; procedure BarLostFocus; virtual; procedure HideAll; override; procedure Repaint; override; procedure RepaintBar; override; property Bar: TdxBar read FBar; end; { TdxBarSubMenuControl } TdxBarButtonControl = class; TdxBarSubItemControl = class; TXDirection = (xdLeft, xdRight); TYDirection = (ydTop, ydBottom); TdxBarSubMenuControl = class(TCustomdxBarControl) private FDestroyingControls: Boolean; FDetachCaptionSelected: Boolean; FDropDownButton: TdxBarButtonControl; FExpandingMenu: Boolean; FExpandMenuTimer: UINT; FLightBrush: HBRUSH; FLightPalette: HPALETTE; FMarkSize: Integer; FMenuAnimations: TdxBarMenuAnimations; FNonRecent: Boolean; FNormalItemHeight: Integer; FOnShowLeft, FOnShowTop: Integer; FOwnerWidth, FOwnerHeight: Integer; FSavedItemLinks: TList; FScrollTimerID: UINT; FShowAnimation: Boolean; FTopIndex: Integer; FSubItem: TdxBarSubItemControl; XDirection: TXDirection; YDirection: TYDirection; FOnCloseUp: TNotifyEvent; FOnPopup: TNotifyEvent; function GetBarSize: Integer; function GetBorderSize: Integer; function GetDetachCaptionSize: Integer; function GetMaxVisibleCount: Integer; function GetToolbarItemsBrush: HBRUSH; procedure SetDetachCaptionSelected(Value: Boolean); procedure SetTopIndex(Value: Integer); procedure CalcControlsPositions(Size: PPoint); procedure CreateLightBrush; procedure DestroyLightBrush; procedure PreparePalette(DC: HDC); procedure UnpreparePalette(DC: HDC); procedure ExpandMenu; function ExtendedView: Boolean; procedure InvalidateDetachCaption; function MouseOnUpArrow: Boolean; function MouseOnDownArrow: Boolean; function MouseOnMark: Boolean; procedure SetExpandMenuTimer(Time: UINT; ExpandAfterDelay: Boolean); procedure KillExpandMenuTimer; procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN; procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; procedure WMMouseLeave(var Message: TMessage); message WM_MOUSELEAVE; procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE; procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT; procedure WMPrint(var Message: TMessage); message WM_PRINT; procedure WMPrintClient(var Message: TMessage); message WM_PRINTCLIENT; procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN; procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP; procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; protected ParentWnd: HWND; procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; procedure DestroyWindowHandle; override; procedure DestroyWnd; override; procedure DoCloseUp; dynamic; procedure DoPopup; dynamic; procedure Paint; override; procedure NCPaint(DC: HDC); procedure CalcDrawingConsts; override; function CanCustomizing: Boolean; override; function ChildrenHaveShadows: Boolean; override; procedure CreateControls; override; procedure DestroyControls; override; procedure DrawBar(const R: TRect); function GetBeginGroupSize: Integer; override; function GetEditFontHandle: HFONT; override; function GetIsContextMenu: Boolean; virtual; function GetIsCustomizing: Boolean; override; function GetIsShadowVisible: Boolean; override; function GetItemRectEx(Item: TdxBarItemControl; IsBeginGroup: Boolean): TRect; override; function HideOnClick: Boolean; override; function ItemAtPosEx(Pos: TPoint; var IsBeginGroup, IsFirstPart, IsVerticalDirection: Boolean): TdxBarItemControl; override; procedure PaintItem(AControl: TdxBarItemControl); override; procedure SetFont; override; procedure SetIsActive(Value: Boolean); override; procedure SetLayeredAttributes; override; procedure SetMarkState(Value: TdxBarMarkState); override; procedure SetRecentItemCount; procedure SetSelectedItem(Value: TdxBarItemControl); override; procedure SetSizeAndCheckBounds(var ChangeXDirection, ChangeYDirection: Boolean); function CanDetach: Boolean; function Detachable: Boolean; function DetachCaptionAreaSize: Integer; function DetachCaptionRect: TRect; function MouseOnDetachCaption: Boolean; procedure DoDetachMenu; function MarkArrowSize: Integer; function MarkExists: Boolean; override; function MarkRect: TRect; function DownArrowExists: Boolean; function UpArrowExists: Boolean; function VisibleCount: Integer; procedure FillBackground(DC: HDC; ARect: TRect; ABrush: HBRUSH; AColor: TColor; AIsClientArea: Boolean); override; function GetBackgroundBitmap: TBitmap; function GetIndent1: Integer; function GetIndent2: Integer; function IsTransparent: Boolean; override; property BarSize: Integer read GetBarSize; property BorderSize: Integer read GetBorderSize; property DetachCaptionSelected: Boolean read FDetachCaptionSelected write SetDetachCaptionSelected; property DetachCaptionSize: Integer read GetDetachCaptionSize; property MarkSize: Integer read FMarkSize; property NormalItemHeight: Integer read FNormalItemHeight; property ToolbarItemsBrush: HBRUSH read GetToolbarItemsBrush; property IsContextMenu: Boolean read GetIsContextMenu; property TopIndex: Integer read FTopIndex write SetTopIndex; property MaxVisibleCount: Integer read GetMaxVisibleCount; property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp; property OnPopup: TNotifyEvent read FOnPopup write FOnPopup; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Hide; procedure HideAll; override; procedure RepaintBar; override; procedure Show; property OwnerWidth: Integer read FOwnerWidth write FOwnerWidth; property OwnerHeight: Integer read FOwnerHeight write FOwnerHeight; end; {-------------------------------------- Items --------------------------------------} TdxBarItemActionLink = class(TActionLink) protected FClient: TdxBarItem; procedure AssignClient(AClient: TObject); override; function IsCaptionLinked: Boolean; override; function IsCheckedLinked: Boolean; override; function IsEnabledLinked: Boolean; override; function IsHelpContextLinked: Boolean; override; function IsHintLinked: Boolean; override; function IsImageIndexLinked: Boolean; override; function IsShortCutLinked: Boolean; override; function IsVisibleLinked: Boolean; override; function IsOnExecuteLinked: Boolean; override; procedure SetCaption(const Value: string); override; procedure SetChecked(Value: Boolean); override; procedure SetEnabled(Value: Boolean); override; procedure SetHelpContext(Value: THelpContext); override; procedure SetHint(const Value: string); override; procedure SetImageIndex(Value: Integer); override; procedure SetShortCut(Value: TShortCut); override; procedure SetVisible(Value: Boolean); override; procedure SetOnExecute(Value: TNotifyEvent); override; end; TdxBarItemActionLinkClass = class of TdxBarItemActionLink; TdxBarItemAlign = (iaLeft, iaCenter, iaRight, iaClient); TdxBarItem = class(TComponent) private FActionLink: TdxBarItemActionLink; FAlign: TdxBarItemAlign; FBarManager: TdxBarManager; FCaption: string; FCategory: Integer; FCheckDefaults: Boolean; FClickItemLink: TdxBarItemLink; FData: TObject; FDescription: string; FEnabled: Boolean; FGlyph: TBitmap; FHelpContext: THelpContext; FHint: string; FImageIndex: Integer; FLinks: TList; // the list of the itemlinks FLoadedVisible: TdxBarItemVisible; FShortCut: TShortCut; FUnclickAfterDoing: Boolean; FVisible: TdxBarItemVisible; FOnClick: TNotifyEvent; FOnCreate: TNotifyEvent; FOnDestroy: TNotifyEvent; function GetAction: TBasicAction; function GetActuallyVisible: Boolean; function GetCurItemLink: TdxBarItemLink; function GetEnabled: Boolean; function GetFlat: Boolean; function GetIndex: Integer; function GetIsDesigning: Boolean; function GetIsDestroying: Boolean; function GetIsLoading: Boolean; function GetLinkCount: Integer; function GetLinks(Index: Integer): TdxBarItemLink; function GetPainterClass: TdxBarItemControlPainterClass; function GetVisibleForUser: Boolean; procedure SetAction(Value: TBasicAction); procedure SetAlign(Value: TdxBarItemAlign); procedure SetCaption(Value: string); procedure SetCategory(Value: Integer); procedure SetDescription(Value: string); procedure SetEnabled(Value: Boolean); procedure SetGlyph(Value: TBitmap); procedure SetShortCut(Value: TShortCut); procedure SetVisible(Value: TdxBarItemVisible); procedure DestroyLinks; procedure DoActionChange(Sender: TObject); function IsCaptionStored: Boolean; function IsEnabledStored: Boolean; function IsHelpContextStored: Boolean; function IsHintStored: Boolean; function IsImageIndexStored: Boolean; function IsShortCutStored: Boolean; function IsVisibleStored: Boolean; function IsOnClickStored: Boolean; function GetHintFromCaption: string; procedure OnGlyphChanged(Sender: TObject); protected procedure AssignTo(Dest: TPersistent); override; procedure Loaded; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure ReadState(Reader: TReader); override; procedure SetName(const NewName: TComponentName); override; procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic; procedure AlignChanged; dynamic; procedure BarManagerChanged; virtual; function CanClicked: Boolean; virtual; procedure CaptionChanged; virtual; procedure EnabledChanged; virtual; function GetActionLinkClass: TdxBarItemActionLinkClass; dynamic; function GetActionImageIndex: Integer; virtual; procedure SetActionImageIndex(Value: Integer); virtual; function GetHidden: Boolean; virtual; procedure GlyphChanged; virtual; function HasAccel(AItemLink: TdxBarItemLink): Boolean; virtual; function HasControls: Boolean; procedure HideControl(AControl: TdxBarItemControl); virtual; procedure HotGlyphChanged; virtual; function ImageIndexLinked: Boolean; function InternalActuallyVisible: Boolean; virtual; function IsHintFromCaption: Boolean; procedure LargeGlyphChanged; virtual; function NeedToBeHidden: Boolean; virtual; procedure ObjectNotification(AOperation: TOperation; AObject: TObject); virtual; procedure SetImageIndex(Value: Integer); virtual; procedure ShortCutChanged; virtual; procedure Update; virtual; procedure UpdateEx; virtual; function UseHotImages: Boolean; virtual; function UseLargeImages: Boolean; virtual; procedure VisibleChanged; virtual; property ActionLink: TdxBarItemActionLink read FActionLink write FActionLink; property ActionImageIndex: Integer read GetActionImageIndex write SetActionImageIndex; property Flat: Boolean read GetFlat; property Hidden: Boolean read GetHidden; property IsDesigning: Boolean read GetIsDesigning; property IsDestroying: Boolean read GetIsDestroying; property IsLoading: Boolean read GetIsLoading; property PainterClass: TdxBarItemControlPainterClass read GetPainterClass; property OnCreate: TNotifyEvent read FOnCreate write FOnCreate; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure BeforeDestruction; override; procedure Click; dynamic; procedure DirectClick; dynamic; procedure DoClick; dynamic; function GetParentComponent: TComponent; override; function HasParent: Boolean; override; procedure SetParentComponent(AParent: TComponent); override; function GetCurImages: TCurImageList; virtual; property ActuallyVisible: Boolean read GetActuallyVisible; property BarManager: TdxBarManager read FBarManager; property ClickItemLink: TdxBarItemLink read FClickItemLink; property CurItemLink: TdxBarItemLink read GetCurItemLink; property Data: TObject read FData write FData; property Glyph: TBitmap read FGlyph write SetGlyph; property ImageIndex: Integer read FImageIndex write SetImageIndex stored IsImageIndexStored default -1; property Index: Integer read GetIndex; property LinkCount: Integer read GetLinkCount; property Links[Index: Integer]: TdxBarItemLink read GetLinks; property ShortCut: TShortCut read FShortCut write SetShortCut stored IsShortCutStored default 0; property UnclickAfterDoing: Boolean read FUnclickAfterDoing write FUnclickAfterDoing default False; property VisibleForUser: Boolean read GetVisibleForUser; property OnClick: TNotifyEvent read FOnClick write FOnClick stored IsOnClickStored; published property Action: TBasicAction read GetAction write SetAction; property Align: TdxBarItemAlign read FAlign write SetAlign default iaLeft; property Caption: string read FCaption write SetCaption stored IsCaptionStored; property Category: Integer read FCategory write SetCategory; property Description: string read FDescription write SetDescription; property Enabled: Boolean read GetEnabled write SetEnabled stored IsEnabledStored default True; property HelpContext: THelpContext read FHelpContext write FHelpContext stored IsHelpContextStored default 0; property Hint: string read FHint write FHint stored IsHintStored; property Visible: TdxBarItemVisible read FVisible write SetVisible stored IsVisibleStored; property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy; end; TdxBarWindowItem = class(TdxBarItem) private FEmptyWindow: Boolean; FText: string; FOnChange: TNotifyEvent; FOnCurChange: TNotifyEvent; FOnEnter: TNotifyEvent; FOnExit: TNotifyEvent; FOnKeyDown: TKeyEvent; FOnKeyPress: TKeyPressEvent; FOnKeyUp: TKeyEvent; function GetCurText: string; function GetFocusedItemLink: TdxBarItemLink; procedure SetCurText(Value: string); protected function CanClicked: Boolean; override; procedure Change; dynamic; procedure CurChange; dynamic; procedure DoEnter; dynamic; procedure DoExit; dynamic; procedure KeyDown(var Key: Word; Shift: TShiftState); dynamic; procedure KeyPress(var Key: Char); dynamic; procedure KeyUp(var Key: Word; Shift: TShiftState); dynamic; procedure SetText(Value: string); virtual; property EmptyWindow: Boolean read FEmptyWindow write FEmptyWindow; public procedure SetFocus(ACheckBarControlVisibility: Boolean = False); virtual; property CurText: string read GetCurText write SetCurText; property FocusedItemLink: TdxBarItemLink read GetFocusedItemLink; published property Text: string read FText write SetText; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnCurChange: TNotifyEvent read FOnCurChange write FOnCurChange; property OnEnter: TNotifyEvent read FOnEnter write FOnEnter; property OnExit: TNotifyEvent read FOnExit write FOnExit; property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown; property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress; property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp; end; TdxBarButtonStyle = (bsDefault, bsChecked, bsDropDown); TdxBarButton = class(TdxBarItem) private FAllowAllUp: Boolean; FButtonStyle: TdxBarButtonStyle; FCloseSubMenuOnClick: Boolean; FDown: Boolean; FDropDownEnabled: Boolean; FDropDownMenu: TdxBarPopupMenu; FGroupIndex: Integer; FLowered: Boolean; FPaintStyle: TdxBarPaintStyle; procedure SetAllowAllUp(Value: Boolean); procedure SetButtonStyle(Value: TdxBarButtonStyle); procedure SetDown(Value: Boolean); procedure SetDropDownEnabled(Value: Boolean); procedure SetDropDownMenu(Value: TdxBarPopupMenu); procedure SetGroupIndex(Value: Integer); procedure SetLowered(Value: Boolean); procedure SetPaintStyle(Value: TdxBarPaintStyle); function IsDownStored: Boolean; protected procedure ButtonStyleChanged; virtual; function CanChangePaintStyle: Boolean; virtual; procedure DownChanged; virtual; procedure DoDropDown(AControl: TdxBarButtonControl; X, Y: Integer; ByMouse: Boolean); dynamic; procedure DropDownEnabledChanged; virtual; function HasAccel(AItemLink: TdxBarItemLink): Boolean; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure PaintStyleChanged; virtual; public constructor Create(AOwner: TComponent); override; procedure Click; override; published property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False; property ButtonStyle: TdxBarButtonStyle read FButtonStyle write SetButtonStyle default bsDefault; property CloseSubMenuOnClick: Boolean read FCloseSubMenuOnClick write FCloseSubMenuOnClick default True; property DropDownEnabled: Boolean read FDropDownEnabled write SetDropDownEnabled default True; property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0; // must be here property Down: Boolean read FDown write SetDown stored IsDownStored default False; property DropDownMenu: TdxBarPopupMenu read FDropDownMenu write SetDropDownMenu; property Glyph; property ImageIndex; property Lowered: Boolean read FLowered write SetLowered default False; property PaintStyle: TdxBarPaintStyle read FPaintStyle write SetPaintStyle default psStandard; property ShortCut; property UnclickAfterDoing default True; property OnClick; end; TdxBarEdit = class(TdxBarWindowItem) private FMaxLength: Integer; FReadOnly: Boolean; FShowCaption: Boolean; FWidth: Integer; procedure SetMaxLength(Value: Integer); procedure SetShowCaption(Value: Boolean); procedure SetWidth(Value: Integer); protected procedure DrawInterior(ABarEditControl: TdxBarEditControl; ACanvas: TCanvas; R: TRect; ItemLink: TdxBarItemLink); virtual; function HasAccel(AItemLink: TdxBarItemLink): Boolean; override; procedure WidthChanged; virtual; public constructor Create(AOwner: TComponent); override; published property Glyph; property ImageIndex; property MaxLength: Integer read FMaxLength write SetMaxLength default 0; property ReadOnly: Boolean read FReadOnly write FReadOnly default False; property ShowCaption: Boolean read FShowCaption write SetShowCaption default False; property Width: Integer read FWidth write SetWidth; property OnClick; end; TCustomdxBarCombo = class; TdxBarCheckKeyForDropDownWindowEvent = procedure (Sender: TCustomdxBarCombo; Key: Word; Shift: TShiftState; var AcceptKey: Boolean) of object; TdxBarGetDropDownWindowEvent = procedure (Sender: TCustomdxBarCombo; var Window: HWND) of object; TCustomdxBarCombo = class(TdxBarEdit) private FOnCheckKeyForDropDownWindow: TdxBarCheckKeyForDropDownWindowEvent; FOnCloseUp: TNotifyEvent; FOnDropDown: TNotifyEvent; FOnGetDropDownWindow: TdxBarGetDropDownWindowEvent; function GetDroppedDown: Boolean; function GetShowEditor: Boolean; procedure SetDroppedDown(Value: Boolean); procedure SetShowEditor(Value: Boolean); protected procedure AfterDropDown; dynamic; procedure CheckDropDownPoint(var X, Y: Integer); function CheckKeyForDropDownWindow(Key: Word; Shift: TShiftState): Boolean; virtual; procedure CloseUp; dynamic; procedure DropDown(X, Y: Integer); dynamic; function GetDropDownWindow: HWND; virtual; procedure InitDropDownWindow; virtual; public property DropDownWindow: HWND read GetDropDownWindow; property DroppedDown: Boolean read GetDroppedDown write SetDroppedDown; published property ShowEditor: Boolean read GetShowEditor write SetShowEditor default True; property OnCheckKeyForDropDownWindow: TdxBarCheckKeyForDropDownWindowEvent read FOnCheckKeyForDropDownWindow write FOnCheckKeyForDropDownWindow; property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp; property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown; property OnGetDropDownWindow: TdxBarGetDropDownWindowEvent read FOnGetDropDownWindow write FOnGetDropDownWindow; end; TdxBarCustomCombo = class; TdxBarDrawItemEvent = procedure(Sender: TdxBarCustomCombo; AIndex: Integer; ARect: TRect; AState: TOwnerDrawState) of object; TdxBarMeasureItemEvent = procedure(Sender: TdxBarCustomCombo; AIndex: Integer; var AHeight: Integer) of object; TdxBarCustomCombo = class(TCustomdxBarCombo) private FDropDownCount: Integer; FDropDownWidth: Integer; FInteriorIsDrawing: Boolean; FItemHeight: Integer; FItemIndex: Integer; FItems: TStrings; FListBox: TCustomListBox; FSorted: Boolean; FOnDrawItem: TdxBarDrawItemEvent; FOnMeasureItem: TdxBarMeasureItemEvent; function GetCurItemIndex: Integer; function GetItemsHeight(Index: Integer): Integer; procedure SetCurItemIndex(Value: Integer); procedure SetItemIndex(Value: Integer); procedure SetItems(Value: TStrings); procedure SetSorted(Value: Boolean); procedure CheckLocalPos; procedure ItemsChanged(Sender: TObject); procedure ListBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure ListBoxMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer); protected FCanvas: TCanvas; procedure AfterDropDown; override; function CheckKeyForDropDownWindow(Key: Word; Shift: TShiftState): Boolean; override; procedure CloseUp; override; procedure CurChange; override; procedure DrawInterior(ABarEditControl: TdxBarEditControl; ACanvas: TCanvas; R: TRect; ItemLink: TdxBarItemLink); override; procedure DrawItem(AIndex: Integer; ARect: TRect; AState: TOwnerDrawState); virtual; procedure DropDown(X, Y: Integer); override; function GetCanvas: TCanvas; virtual; function GetDropDownWidth: Integer; virtual; function GetDropDownWindow: HWND; override; function GetNearestItemIndex(AText: string): Integer; procedure InitDropDownWindow; override; procedure MeasureItem(AIndex: Integer; var AHeight: Integer); virtual; procedure MeasureItemWidth(AIndex: Integer; var AWidth: Integer); virtual; procedure SetText(Value: string); override; property ListBox: TCustomListBox read FListBox; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Canvas: TCanvas read GetCanvas; property CurItemIndex: Integer read GetCurItemIndex write SetCurItemIndex; property ItemHeight: Integer read FItemHeight write FItemHeight default 0; property Items: TStrings read FItems write SetItems; property ItemsHeight[Index: Integer]: Integer read GetItemsHeight; property Sorted: Boolean read FSorted write SetSorted default False; property ItemIndex: Integer read FItemIndex write SetItemIndex; // loading after all published property DropDownCount: Integer read FDropDownCount write FDropDownCount default 8; property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth default 0; property OnDrawItem: TdxBarDrawItemEvent read FOnDrawItem write FOnDrawItem; property OnMeasureItem: TdxBarMeasureItemEvent read FOnMeasureItem write FOnMeasureItem; end; TdxBarCombo = class(TdxBarCustomCombo) published property ItemHeight; property Items; property Sorted; property ItemIndex; // loading after all end; TCustomdxBarSubItem = class(TdxBarItem) private FBarSize: Integer; FDetachable: Boolean; FDetachingBar: TdxBar; FItemLinks: TdxBarItemLinks; FShowCaption: Boolean; FOnCloseUp: TNotifyEvent; FOnDetaching: TNotifyEvent; FOnPaintBar: TdxBarPaintSubMenuBarEvent; FOnPopup: TNotifyEvent; function GetDetachingBarIndex: Integer; procedure SetBarSize(Value: Integer); procedure SetDetachingBar(Value: Integer); procedure SetItemLinks(Value: TdxBarItemLinks); procedure SetShowCaption(Value: Boolean); protected procedure BarManagerChanged; override; function CanClicked: Boolean; override; procedure DoCloseUp; dynamic; procedure DoDetaching; dynamic; procedure DoPaintBar(Canvas: TCanvas; const R: TRect); virtual; procedure DoPopup; dynamic; function HasDesignTimeLinks: Boolean; virtual; function IsShortCut(AShortCut: TShortCut): Boolean; procedure ObjectNotification(AOperation: TOperation; AObject: TObject); override; property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp; property OnPopup: TNotifyEvent read FOnPopup write FOnPopup; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function CanContainItem(AItem: TdxBarItem): Boolean; function GetDetachingBar: TdxBar; procedure DropDown; property ItemLinks: TdxBarItemLinks read FItemLinks write SetItemLinks; published property BarSize: Integer read FBarSize write SetBarSize default 0; property Detachable: Boolean read FDetachable write FDetachable default False; property DetachingBar: Integer read GetDetachingBarIndex write SetDetachingBar default -1; property Glyph; property ImageIndex; property ShowCaption: Boolean read FShowCaption write SetShowCaption default True; property OnClick; property OnDetaching: TNotifyEvent read FOnDetaching write FOnDetaching; property OnPaintBar: TdxBarPaintSubMenuBarEvent read FOnPaintBar write FOnPaintBar; end; TdxBarSubItem = class(TCustomdxBarSubItem) private FAllowCustomizing: Boolean; FIsInternal: Boolean; protected function HasDesignTimeLinks: Boolean; override; property IsInternal: Boolean read FIsInternal; public constructor Create(AOwner: TComponent); override; published property AllowCustomizing: Boolean read FAllowCustomizing write FAllowCustomizing default True; property ItemLinks; property OnCloseUp; property OnPopup; end; TCustomdxBarContainerItem = class(TCustomdxBarSubItem) private FInOnGetData: Boolean; FNeedClearItemList: Boolean; FOnGetData: TNotifyEvent; protected procedure AddListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer; FirstCall: Boolean; CallingItemLink: TdxBarItemLink); virtual; procedure DeleteListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer); virtual; procedure ClearItemList; virtual; function HideWhenRun: Boolean; virtual; function InternalActuallyVisible: Boolean; override; procedure ItemLinksChanged; virtual; procedure NeedClearItemList; public destructor Destroy; override; published property OnGetData: TNotifyEvent read FOnGetData write FOnGetData; end; TdxBarListItem = class(TCustomdxBarContainerItem) private FItemIndex: Integer; FItemList: TList; FItems: TStrings; FShowCheck: Boolean; FShowNumbers: Boolean; function GetDataIndex: Integer; procedure SetDataIndex(Value: Integer); procedure SetItems(Value: TStrings); procedure ClickItem(Sender: TObject); procedure ItemsChanged(Sender: TObject); protected procedure AddListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer; FirstCall: Boolean; CallingItemLink: TdxBarItemLink); override; procedure ClearItemList; override; procedure DeleteListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer); override; function GetDisplayText(const AText: string): string; virtual; function InternalActuallyVisible: Boolean; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure DirectClick; override; property ItemList: TList read FItemList; published property DataIndex: Integer read GetDataIndex write SetDataIndex stored False; property ItemIndex: Integer read FItemIndex write FItemIndex default -1; property Items: TStrings read FItems write SetItems; property ShowCheck: Boolean read FShowCheck write FShowCheck default False; property ShowNumbers: Boolean read FShowNumbers write FShowNumbers default True; end; TdxBarContainerItem = class(TCustomdxBarContainerItem) protected procedure AddListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer; FirstCall: Boolean; CallingItemLink: TdxBarItemLink); override; procedure DeleteListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer); override; function InternalActuallyVisible: Boolean; override; function IsItemsExist: Boolean; virtual; published property ItemLinks; end; TdxBarPaintType = (ptHorz, ptMenu, ptVert); {-------------------------------------- Item's controls --------------------------------------} TdxBarItemControlClass = class of TdxBarItemControl; TdxBarItemControl = class(TObject) private FBeginGroupRect: TRect; FBreakingRow: Boolean; FChangeRecentGroup: Boolean; FHasWindow: Boolean; FIsActive: Boolean; FItemLink: TdxBarItemLink; FLastInRow: Boolean; FNonRecent: Boolean; FParent: TCustomdxBarControl; FPressed: Boolean; FSelectedByMouse: Boolean; function GetAlign: TdxBarItemAlign; function GetBarManager: TdxBarManager; function GetFlat: Boolean; function GetIsSelected: Boolean; function GetItem: TdxBarItem; function GetNormalItemHeightInSubMenu: Integer; function GetRealHeight: Integer; function GetRealWidth: Integer; function GetUnclickAfterDoing: Boolean; procedure SetPressed(Value: Boolean); protected procedure AlignChanged; dynamic; procedure BeforeDestroyParentHandle; virtual; procedure BeginGroupChanged; virtual; procedure CaptionChanged; virtual; procedure EnabledChanged; virtual; procedure GlyphChanged; virtual; procedure PressedChanged; virtual; procedure RealVisibleChanging(AVisible: Boolean); virtual; procedure ShortCutChanged; virtual; procedure VisibleChanged; virtual; function CanClicked: Boolean; virtual; function CanCustomize: Boolean; virtual; function CanMouseSelect: Boolean; virtual; function CanSelect: Boolean; virtual; function CanVisuallyPressed: Boolean; procedure Click(ByMouse: Boolean); virtual; procedure ControlActivate(Immediately: Boolean); virtual; procedure ControlInactivate(Immediately: Boolean); virtual; procedure ControlClick(ByMouse: Boolean); virtual; procedure ControlUnclick(ByMouse: Boolean); virtual; procedure DblClick; dynamic; function DrawSelected: Boolean; virtual; function WantsDblClick: Boolean; dynamic; procedure KeyDown(Key: Word); virtual; function WantsKey(Key: Word): Boolean; virtual; procedure DrawLowered(DC: HDC; var R: TRect); procedure DrawGlyph(R: TRect; FullBounds: PRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, Center, ForceUseBkBrush, BarControlOwner, IsSplit: Boolean); procedure DrawGlyphAndBkgnd(R: TRect; const GlyphRect: TRect; PaintType: TdxBarPaintType; AGlyph: TBitmap; AImages: TCurImageList; AImageIndex: Integer; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner, IsSplit: Boolean); procedure DrawGlyphAndTextInSubMenu(DC: HDC; var R: TRect; Selected, ShowGlyph, Down: Boolean); procedure DrawItemText(DC: HDC; S: string; PaintRect: TRect; Alignment: UINT; Enabled, Selected, Rotated, Clipped, FlatText: Boolean); procedure FrameAndFillRect(DC: HDC; var R: TRect; Enabled, Selected, Pressed: Boolean); procedure GetArrowParams(APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); virtual; function GetCaption: string; virtual; function GetEnabled: Boolean; virtual; function GetGlyph: TBitmap; virtual; function GetImageIndex: Integer; virtual; function GetImages(AInToolbar: Boolean): TCurImageList; virtual; function GetHint: string; virtual; function GetHotImages: TCurImageList; virtual; function GetImageEnabled(APaintType: TdxBarPaintType): Boolean; virtual; function GetLargeImages: TCurImageList; virtual; function GetPainterClass: TdxBarItemControlPainterClass; virtual; function GetShortCut: TShortCut; virtual; function GetTextAreaOffset: Integer; virtual; function GetHeight: Integer; virtual; function GetMinHeight: Integer; virtual; function GetMinWidth: Integer; virtual; function GetOwnedBarControl: TCustomdxBarControl; virtual; function GetWidth: Integer; virtual; function HasHint: Boolean; virtual; function HasShadow: Boolean; virtual; function ImageExists: Boolean; function ImageIndexLinked: Boolean; function IsDestroyOnClick: Boolean; virtual; function IsExpandable: Boolean; virtual; function IsInvertTextColor: Boolean; virtual; function MousePressed: Boolean; function NeedCaptureMouse: Boolean; virtual; procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); virtual; function ParentIsQuickCustControl: Boolean; function WantMouse: Boolean; procedure CheckNonRecent; procedure UncheckNonRecent; property Align: TdxBarItemAlign read GetAlign; property Caption: string read GetCaption; property Enabled: Boolean read GetEnabled; property Flat: Boolean read GetFlat; property Glyph: TBitmap read GetGlyph; property Height: Integer read GetRealHeight; property Hint: string read GetHint; property HotImages: TCurImageList read GetHotImages; property ImageIndex: Integer read GetImageIndex; property Images[AInToolbar: Boolean]: TCurImageList read GetImages; property LargeImages: TCurImageList read GetLargeImages; property MinHeight: Integer read GetMinHeight; property MinWidth: Integer read GetMinWidth; property NormalItemHeightInSubMenu: Integer read GetNormalItemHeightInSubMenu; property OwnedBarControl: TCustomdxBarControl read GetOwnedBarControl; property Pressed: Boolean read FPressed write SetPressed; property ShortCut: TShortCut read GetShortCut; property TextAreaOffset: Integer read GetTextAreaOffset; property UnclickAfterDoing: Boolean read GetUnclickAfterDoing; property Width: Integer read GetRealWidth; public constructor Create(AItemLink: TdxBarItemLink); virtual; destructor Destroy; override; procedure Repaint; virtual; property BarManager: TdxBarManager read GetBarManager; property HasWindow: Boolean read FHasWindow; property IsActive: Boolean read FIsActive; property IsSelected: Boolean read GetIsSelected; property Item: TdxBarItem read GetItem; property ItemLink: TdxBarItemLink read FItemLink; property PainterClass: TdxBarItemControlPainterClass read GetPainterClass; property Parent: TCustomdxBarControl read FParent; end; TdxBarWinControl = class(TdxBarItemControl) private FDefWndProc: Pointer; FFocused: Boolean; FFocusing: Boolean; FHandle: HWND; FKeyPressedInside: Integer; FPrevDefWndProc: Pointer; FPrevFocusedControl: HWND; FWindowRect: TRect; function GetItem: TdxBarWindowItem; function GetWindowRect: TRect; procedure SetWindowRect(const Value: TRect); protected function CanClicked: Boolean; override; procedure ControlInactivate(Immediately: Boolean); override; procedure ControlClick(ByMouse: Boolean); override; procedure CreateWindowHandle; virtual; procedure DestroyWindowHandle; virtual; function DoKeyDown(var Message: TWMKey): Boolean; function DoKeyPress(var Message: TWMKey): Boolean; function DoKeyUp(var Message: TWMKey): Boolean; procedure EnabledChanged; override; function GetText: string; virtual; function IsDestroyOnClick: Boolean; override; procedure SetFocused(Value: Boolean); virtual; procedure SetText(Value: string); virtual; procedure WndProc(var Message: TMessage); virtual; public constructor Create(AItemLink: TdxBarItemLink); override; destructor Destroy; override; property Focused: Boolean read FFocused write SetFocused; property Handle: HWND read FHandle; property Item: TdxBarWindowItem read GetItem; property Text: string read GetText write SetText; property WindowRect: TRect read GetWindowRect write SetWindowRect; end; TdxBarButtonControl = class(TdxBarItemControl) private FDroppedDown: Boolean; FShowAnimation: Boolean; function GetButtonStyle: TdxBarButtonStyle; function GetDown: Boolean; function GetDropDownEnabled: Boolean; function GetDropDownMenuControl: TdxBarSubMenuControl; function GetDroppedDownFlat: Boolean; function GetGroupIndex: Integer; function GetItem: TdxBarButton; function GetLowered: Boolean; function GetPaintStyle: TdxBarPaintStyle; function MouseOverArrow: Boolean; protected function ArrowPressed: Boolean; function ArrowWidth: Integer; virtual; procedure ButtonStyleChanged; virtual; procedure ControlInactivate(Immediately: Boolean); override; procedure ControlClick(ByMouse: Boolean); override; procedure ControlUnclick(ByMouse: Boolean); override; procedure DoCloseUp; dynamic; procedure DoDropDown(ByMouse: Boolean); dynamic; procedure DownChanged; virtual; procedure DrawArrow(const ARect: TRect; Selected, DrawDowned: Boolean; PaintType: TdxBarPaintType); function DrawSelected: Boolean; override; procedure DropDownEnabledChanged; virtual; procedure GlyphChanged; override; function GetDefaultHeight: Integer; virtual; function GetDefaultWidth: Integer; virtual; function GetHeight: Integer; override; function GetOwnedBarControl: TCustomdxBarControl; override; function GetWidth: Integer; override; function IsDestroyOnClick: Boolean; override; function IsFlatTextSelected(APressed: Boolean): Boolean; procedure KeyDown(Key: Word); override; function NeedCaptureMouse: Boolean; override; procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override; procedure PaintStyleChanged; virtual; procedure PreparePaintStyleOnBar(var APaintStyle: TdxBarPaintStyle); virtual; function WantsKey(Key: Word): Boolean; override; property ButtonStyle: TdxBarButtonStyle read GetButtonStyle; property Down: Boolean read GetDown; property DropDownEnabled: Boolean read GetDropDownEnabled; property DropDownMenuControl: TdxBarSubMenuControl read GetDropDownMenuControl; property DroppedDown: Boolean read FDroppedDown; property DroppedDownFlat: Boolean read GetDroppedDownFlat; // TODO: obsolete property GroupIndex: Integer read GetGroupIndex; property Lowered: Boolean read GetLowered; property PaintStyle: TdxBarPaintStyle read GetPaintStyle; public property Item: TdxBarButton read GetItem; end; TdxBarEditControl = class(TdxBarWinControl) private function GetCaptionWidth: Integer; function GetItem: TdxBarEdit; function GetMaxLength: Integer; function GetReadOnly: Boolean; function GetShowCaption: Boolean; protected procedure ControlClick(ByMouse: Boolean); override; procedure CreateWindowHandle; override; procedure DrawBorder(DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); procedure DrawCaption(DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); function DrawSelected: Boolean; override; procedure DrawTextField(DC: HDC; const ARect: TRect); function GetHeight: Integer; override; function GetMinWidth: Integer; override; function GetWidth: Integer; override; procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override; procedure SetFocused(Value: Boolean); override; procedure SetText(Value: string); override; procedure WidthChanged; virtual; procedure WndProc(var Message: TMessage); override; property CaptionWidth: Integer read GetCaptionWidth; property MaxLength: Integer read GetMaxLength; property ReadOnly: Boolean read GetReadOnly; property ShowCaption: Boolean read GetShowCaption; public property Item: TdxBarEdit read GetItem; end; TCustomdxBarComboControl = class(TdxBarEditControl) private FDropDownButtonRect: TRect; FOnPressDroppedDown: Boolean; FDroppedDown: Boolean; function GetDropDownWindow: HWND; function GetItem: TCustomdxBarCombo; protected procedure ControlInactivate(Immediately: Boolean); override; procedure EnabledChanged; override; procedure GetArrowParams(APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); override; // obsolete procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override; procedure SetDroppedDown(Value: Boolean); virtual; procedure WndProc(var Message: TMessage); override; property DropDownButtonRect: TRect read FDropDownButtonRect; property DropDownWindow: HWND read GetDropDownWindow; public property DroppedDown: Boolean read FDroppedDown write SetDroppedDown; property Item: TCustomdxBarCombo read GetItem; end; TdxBarComboControl = class(TCustomdxBarComboControl) private FLocalItemIndex: Integer; function GetItem: TdxBarCustomCombo; function GetItemIndex: Integer; function GetItems: TStrings; function GetSorted: Boolean; procedure SetLocalItemIndex(Value: Integer); protected procedure SetFocused(Value: Boolean); override; procedure WndProc(var Message: TMessage); override; property ItemIndex: Integer read GetItemIndex; property Items: TStrings read GetItems; property Sorted: Boolean read GetSorted; public property Item: TdxBarCustomCombo read GetItem; property LocalItemIndex: Integer read FLocalItemIndex write SetLocalItemIndex; end; TdxBarSubItemControl = class(TdxBarItemControl) private FShowAnimation: Boolean; function GetCaptionOffset: Integer; function GetItem: TCustomdxBarSubItem; protected procedure GlyphChanged; override; function GetSubMenuControl: TdxBarSubMenuControl; virtual; function CanClicked: Boolean; override; procedure ControlActivate(Immediately: Boolean); override; procedure ControlInactivate(Immediately: Boolean); override; procedure ControlClick(ByMouse: Boolean); override; procedure CreateSubMenuControl; virtual; procedure DoCreateSubMenuControl; function GetDefaultHeight: Integer; virtual; function GetDefaultWidth: Integer; virtual; function GetHeight: Integer; override; function GetOwnedBarControl: TCustomdxBarControl; override; function GetWidth: Integer; override; function HasSubMenu: Boolean; virtual; function IsDestroyOnClick: Boolean; override; function IsExpandable: Boolean; override; procedure KeyDown(Key: Word); override; procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override; function WantsDblClick: Boolean; override; function WantsKey(Key: Word): Boolean; override; property CaptionOffset: Integer read GetCaptionOffset; public destructor Destroy; override; property Item: TCustomdxBarSubItem read GetItem; property SubMenuControl: TdxBarSubMenuControl read GetSubMenuControl; end; TdxBarContainerItemControl = class(TdxBarSubItemControl) private function GetItem: TCustomdxBarContainerItem; protected procedure CreateSubMenuControl; override; function GetCaption: string; override; function IsExpandable: Boolean; override; procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override; function ShowRealCaption: Boolean; public property Item: TCustomdxBarContainerItem read GetItem; end; {-------------------------------------- Item's painters --------------------------------------} // TODO: rename TdxBarItemControlPainter to TdxBarPainter? TdxArrowType = ({atLeft, }atRight, {atUp, }atDown); TdxBarItemControlPainter = class protected // Common class procedure DrawGlyphBorder(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, BarControlOwner, IsSplit: Boolean); virtual; class procedure DrawGlyphCheckMark(ABarItemControl: TdxBarItemControl; DC: HDC; X, Y, DoubleSize: Integer); virtual; class procedure DrawGlyphEmptyImage(ABarItemControl: TdxBarItemControl; DC: HDC; R: TRect; ABrush: HBRUSH; NeedBorder: Boolean; PaintType: TdxBarPaintType; Selected, Down, DrawDowned: Boolean); virtual; class procedure DrawGlyphImage(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; const GlyphRect: TRect; AGlyph: TBitmap; AImages: TCurImageList; AImageIndex: Integer; Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean; PaintType: TdxBarPaintType); virtual; class procedure DrawItemArrow(DC: HDC; R: TRect; ArrowType: TdxArrowType; Enabled, Selected, Flat: Boolean); virtual; class procedure DrawLargeItemArrow(DC: HDC; R: TRect; ArrowType: TdxArrowType; Size: Integer; Selected, Enabled, Flat: Boolean); virtual; class procedure GetEditColors(ABarItemControl: TdxBarItemControl; var ATextColor, ABkColor: COLORREF); virtual; class function GetFadedColor(ABarControl: TCustomdxBarControl): TColor; virtual; class procedure GetTextColors(ABarItemControl: TdxBarItemControl; AEnabled, ASelected, AFlat: Boolean; var AColor1, AColor2: TColor); virtual; class function IgnoreGlyphOpaque: Boolean; virtual; class function IgnoreNonRecentColor: Boolean; virtual; class function IsMenuItem(ABarItemControl: TdxBarItemControl): Boolean; virtual; // Bar class function BarIsBarSmall(ABarControl: TdxBarControl; const R: TRect): Boolean; virtual; class function BarCaptionBkColor(ABarControl: TdxBarControl; AMainFormActive: Boolean): COLORREF; virtual; class function BarCaptionColor(ABarControl: TdxBarControl): COLORREF; virtual; class function BarMarkArrowColor(ABarControl: TdxBarControl; AState: TdxBarMarkState): COLORREF; virtual; class procedure BarDrawGrip(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); virtual; class procedure BarDrawMarkArrow(ABarControl: TdxBarControl; DC: HDC; MarkR: TRect); virtual; class procedure BarDrawMarkAtPos(ABarControl: TdxBarControl; DC: HDC; const ItemRect: TRect; Offset: Integer); virtual; class procedure BarDrawMarkBackground(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); virtual; class procedure BarDrawMarkElements(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect); virtual; class procedure BarOffsetFloatingBarCaption(ABarControl: TdxBarControl; var X: Integer; var R: TRect); virtual; class function GetDrawMarkElementColor(ABarControl: TdxBarControl): Integer; virtual; // ComboControl class procedure ComboControlDrawOneArrow(ABarItemControl: TdxBarItemControl; DC: HDC; X, Y, Size: Integer; Color: COLORREF); virtual; // SubMenuControl class procedure SubMenuControlDrawArrow(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect; UpArrow: Boolean); virtual; class procedure SubMenuControlDrawMark(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect; ASelected: Boolean); virtual; // Edit class procedure EditOffsetInteriorRect(var R: TRect); virtual; // SpinEditControl class procedure SpinEditControlDrawOneArrow(DC: HDC; X, Y, XSize, YSize, Color: Integer; AButton: TdxBarSpinEditButton); // DateNavigator class procedure DateNavigatorDrawButtonCaption(DC: HDC; R: TRect; Offset: Integer; const ACaption: string; AOpaque: Boolean); virtual; public // Common class procedure DrawBackground(ABarItemControl: TdxBarItemControl; DC: HDC; R: TRect; ABrush: HBRUSH; AOpaque: Boolean); virtual; class procedure DrawBackgroundFrameRect(ABarItemControl: TdxBarItemControl; DC: HDC; R: TRect; ABrush: HBRUSH; AOpaque: Boolean); virtual; class procedure DrawDisabledShadowRect(ABarItemControl: TdxBarItemControl; DC: HDC; R: TRect); virtual; class procedure DrawGlyph(ABarItemControl: TdxBarItemControl; R: TRect; FullBounds: PRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, Center, ForceUseBkBrush, BarControlOwner, IsSplit: Boolean); virtual; class procedure DrawGlyphAndBkgnd(ABarItemControl: TdxBarItemControl; R: TRect; const GlyphRect: TRect; PaintType: TdxBarPaintType; AGlyph: TBitmap; AImages: TCurImageList; AImageIndex: Integer; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner, IsSplit: Boolean); virtual; class procedure DrawGlyphAndTextInSubMenu(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Selected, ShowGlyph, Down: Boolean); virtual; class procedure DrawItemText(ABarItemControl: TdxBarItemControl; DC: HDC; S: string; PaintRect: TRect; Alignment: UINT; Enabled, Selected, Rotated, Clipped, FlatText: Boolean); virtual; class procedure DrawLowered(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect); virtual; class procedure DrawStaticBorder(ABarItemControl: TdxBarItemControl; DC: HDC; var ARect: TRect; ABorderWidth: Integer; ABorderStyle: TdxBarStaticBorderStyle); virtual; class procedure FrameAndFillRect(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Enabled, Selected, Pressed: Boolean); virtual; class procedure GetArrowParams(ABarItemControl: TdxBarItemControl; APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); virtual; class function GlyphBkgndBrush(ABarItemControl: TdxBarItemControl; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean): HBRUSH; virtual; class function GlyphDownShift(ABarItemControl: TdxBarItemControl): Integer; virtual; class function GlyphDrawDownedShift(ABarItemControl: TdxBarItemControl; ADown: Boolean): Integer; virtual; class function IsFlatItemText: Boolean; virtual; class function IsItemTextSelectedInverted: Boolean; virtual; class function LoweredBorderSize(ABarItemControl: TdxBarItemControl): Integer; virtual; class function TextAreaOffset(ABarItemControl: TdxBarItemControl): Integer; virtual; // BarManager class function BeforeFingersSize: Integer; virtual; class function BorderSizeX: Integer; virtual; class function BorderSizeY: Integer; virtual; class function EmptyFingersSize: Integer; virtual; class function FingersSize: Integer; virtual; class function GripperSize: Integer; virtual; class function RealButtonArrowWidth(ABarManager: TdxBarManager): Integer; virtual; class function RealLargeButtonArrowWidth(ABarManager: TdxBarManager): Integer; virtual; class function SubMenuBeginGroupIndent: Integer; virtual; // DockControl class procedure DockControlFillBackground(ADockControl: TdxDockControl; DC: HDC; ADestR, ASourceR, AWholeR: TRect; ABrush: HBRUSH; AColor: TColor); virtual; class function IsNativeBackground: Boolean; virtual; // CustomBar class function BarChildrenHaveShadows(ABarControl: TCustomdxBarControl): Boolean; virtual; class function BarControlOwnerBrush(ABarManager: TdxBarManager): HBRUSH; virtual; class procedure BarDrawDockedBackground(ABarControl: TCustomdxBarControl; DC: HDC; ADestR, ASourceR: TRect; ABrush: HBRUSH; AColor: TColor); virtual; class procedure BarDrawFloatingBackground(ABarControl: TCustomdxBarControl; DC: HDC; ADestR, ASourceR: TRect; ABrush: HBRUSH; AColor: TColor); virtual; class procedure BarDrawOwnerLink(ABarControl: TCustomdxBarControl; DC: HDC); virtual; class function BarHasShadow(ABarControl: TCustomdxBarControl): Boolean; virtual; class function BarToolbarBrush(ABarControl: TCustomdxBarControl): HBRUSH; virtual; class function BarToolbarBrushEx(ABarControl: TdxBarControl): HBRUSH; virtual; class function BarToolbarDownedBrush(ABarControl: TCustomdxBarControl): HBRUSH; virtual; class function BarToolbarDownedSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; virtual; class function BarToolbarSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; virtual; class function ComboBoxArrowWidth(ABarControl: TCustomdxBarControl; DC: HDC; cX: Integer): Integer; virtual; class function EditBorderSize(DC: HDC): Integer; virtual; class function EditTextSize(ABarControl: TCustomdxBarControl; DC: HDC; cY: Integer): Integer; virtual; // Bar class function BarAllowHotTrack: Boolean; virtual; class function BarAllowQuickCustomizing: Boolean; virtual; class function BarBeginGroupSideSize: Integer; virtual; class function BarBeginGroupSize: Integer; virtual; class procedure BarBorderPaintSizes(ABarControl: TdxBarControl; var R: TRect); virtual; class function BarBorderSize: Integer; virtual; class procedure BarBorderSizes(ABar: TdxBar; AStyle: TdxBarDockingStyle; var R: TRect); virtual; class function BarCaptionAreaSize: Integer; virtual; class procedure BarCaptionFillBackground(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); virtual; class function BarCaptionSize: Integer; virtual; class function BarCaptionTransparent: Boolean; virtual; class function BarCloseButtonSize: TSize; virtual; class procedure BarDrawBeginGroup(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH; AHorz: Boolean); virtual; class procedure BarDrawCaptionElement(ABarControl: TdxBarControl; DC: HDC; R: TRect; AState: TdxBarMarkState); virtual; class procedure BarDrawCloseButton(ABarControl: TdxBarControl; DC: HDC; R: TRect); virtual; class procedure BarDrawDockedBarBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); virtual; class procedure BarDrawFloatingBarBorder(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); virtual; class procedure BarDrawFloatingBarCaption(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); virtual; class procedure BarDrawMark(ABarControl: TdxBarControl; DC: HDC; MarkR: TRect); virtual; class procedure BarDrawMarks(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); virtual; class procedure BarDrawMDIButton(ABarControl: TdxBarControl; AButton: TdxBarMDIButton; ASelected, APressed: Boolean; DC: HDC; R: TRect); virtual; class procedure BarDrawStatusBarGrip(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); virtual; class procedure BarDrawStatusBarTopBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); virtual; class function BarHorSize: Integer; virtual; class function BarMarkRect(ABarControl: TdxBarControl): TRect; virtual; class function BarMarkItemRect(ABarControl: TdxBarControl): TRect; virtual; class procedure BarMarkRectInvalidate(ABarControl: TdxBarControl); virtual; class function BarTopSize: Integer; virtual; class function BarBottomSize: Integer; virtual; class function BarUseSystemClose: Boolean; virtual; class function BarUseSystemNCBorder: Boolean; virtual; class procedure StatusBarFillBackground(ABarControl: TdxBarControl; DC: HDC; ADestR, ASourceR, AWholeR: TRect; ABrush: HBRUSH; AColor: TColor); virtual; class function StatusBarGripSize(ABarManager: TdxBarManager): TSize; virtual; class function StatusBarTopBorderSize(ABarManager: TdxBarManager): Integer; virtual; // QuickCustItem class function BarToolbarBrushEx2(ABarControl: TdxBarControl): HBRUSH; virtual; class procedure DrawQuickCustItemFrame(ABarItemControl: TdxBarItemControl; DC: HDC; var R, ARect: TRect; Selected: Boolean); virtual; class procedure DrawQuickCustItemFrameSelected(ABarItemControl: TdxBarItemControl; DC: HDC; WholeR, R: TRect; Selected: Boolean); virtual; class function IsQuickControlPopupOnRight: Boolean; virtual; // ButtonControl class function ButtonBorderHeight: Integer; virtual; class function ButtonBorderWidth: Integer; virtual; class procedure CorrectButtonControlDefaultHeight(var DefaultHeight: Integer); virtual; class procedure CorrectButtonControlDefaultWidth(ABarItemControl: TdxBarItemControl; var DefaultWidth: Integer); virtual; class procedure DrawButtonControlArrow(ABarItemControl: TdxBarItemControl; DC: HDC; R1: TRect; Brush: HBRUSH; ArrowColor: COLORREF; Selected, DrawDowned, DroppedDown, DropDownEnabled, IsDropDownMenuControlExist: Boolean; PaintType: TdxBarPaintType); virtual; class function IsDropDownRepaintNeeded: Boolean; virtual; class procedure OffsetCaptionBounds(ABarButtonControl: TdxBarButtonControl; APressed: Boolean; var R: TRect); virtual; class procedure OffsetEllipsisBounds(ABarItemControl: TdxBarItemControl; APressed: Boolean; var R: TRect); virtual; // ComboControl class function ComboControlArrowOffset: Integer; virtual; class procedure ComboControlDrawArrow(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; Selected: Boolean; PaintType: TdxBarPaintType); virtual; class procedure ComboControlGetArrowParams(ABarItemControl: TdxBarItemControl; APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); virtual; // DropDownListBox class function DropDownListBoxBorderSize: Integer; virtual; class procedure DropDownListBoxDrawBorder(ABarManager: TdxBarManager; DC: HDC; R: TRect); virtual; // SubItemControl class function SubItemControlCaptionOffset(ABarSubItemControl: TdxBarSubItemControl): Integer; virtual; class function SubItemControlDefaultHeight(ABarSubItemControl: TdxBarSubItemControl): Integer; virtual; class function SubItemControlDefaultWidth(ABarSubItemControl: TdxBarSubItemControl): Integer; virtual; class procedure SubItemControlDraw(ABarSubItemControl: TdxBarSubItemControl; DC: HDC; R: TRect; Selected, Down: Boolean; PaintType: TdxBarPaintType); virtual; // SubMenuControl class function SubMenuControlArrowsOffset: Integer; virtual; class function SubMenuControlBeginGroupSize: Integer; virtual; class function SubMenuControlBorderSize: Integer; virtual; class procedure SubMenuControlCalcDrawingConsts(ABarSubMenuControl: TdxBarSubMenuControl; var ATextSize, AMenuArrowWidth, AMarkSize, ANormalItemHeight: Integer); virtual; class procedure SubMenuControlCalcRect(ABarSubMenuControl: TdxBarSubMenuControl; Size: PPoint; var R: TRect; var AClientHeight: Integer); virtual; class procedure SubMenuControlCalcSize(ABarSubMenuControl: TdxBarSubMenuControl; Size: PPoint; var R: TRect); virtual; class function SubMenuControlDetachCaptionAreaSize(ABarSubMenuControl: TdxBarSubMenuControl): Integer; virtual; class procedure SubMenuControlDrawArrowsArea(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; ABrush: HBRUSH; AMaxVisibleCount: Integer); virtual; class procedure SubMenuControlDrawBackground(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; ARect: TRect; ABrush: HBRUSH; AColor: TColor); virtual; class procedure SubMenuControlDrawBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); virtual; class procedure SubMenuControlDrawClientBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; var R: TRect; ABrush: HBRUSH); virtual; class procedure SubMenuControlDrawDetachCaption(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); virtual; class procedure SubMenuControlDrawBeginGroup(ABarSubMenuControl: TdxBarSubMenuControl; AControl: TdxBarItemControl; DC: HDC; AItemRect: TRect; LeftDelta: Integer); virtual; class procedure SubMenuControlDrawItemFrame(ABarSubMenuControl: TdxBarSubMenuControl; AControl: TdxBarItemControl; DC: HDC; AItemRect: TRect; AIndex, LeftDelta: Integer); virtual; class function SubMenuControlIsOffsetRecentGroupNeeded: Boolean; virtual; class function SubMenuControlMarkArrowSize(ABarSubMenuControl: TdxBarSubMenuControl; AMarkSize: Integer): Integer; virtual; class function SubMenuControlMarkRectOffset(ABarSubMenuControl: TdxBarSubMenuControl): Integer; virtual; class procedure SubMenuControlOffsetDetachCaptionRect(ABarSubMenuControl: TdxBarSubMenuControl; var R: TRect); virtual; class procedure SubMenuControlPrepareBkBrush(ABarSubMenuControl: TdxBarSubMenuControl; var ABkBrush: HBRUSH); virtual; class function SubMenuControlToolbarItemsBrush(ABarSubMenuControl: TdxBarSubMenuControl): HBRUSH; virtual; // Edit class procedure EditDrawInterior(ABarEditControl: TdxBarEditControl; ABarEdit: TdxBarEdit; ACanvas: TCanvas; R: TRect; ItemLink: TdxBarItemLink); virtual; // CustomCombo class procedure CustomComboDrawItem(ABarCustomCombo: TdxBarCustomCombo; ACanvas: TCanvas; AIndex: Integer; ARect: TRect; AState: TOwnerDrawState; AInteriorIsDrawing: Boolean); virtual; // EditControl class function EditControlCaptionWidth(ABarEditControl: TdxBarEditControl; ATextWidth: Integer): Integer; virtual; class procedure EditControlDrawBorder(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); virtual; class procedure EditControlDrawCaption(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); virtual; class procedure EditControlDrawTextField(ABarEditControl: TdxBarEditControl; DC: HDC; const ARect: TRect; AIgnoreEnabled: Boolean); virtual; class function EditControlES_Style: Integer; virtual; class procedure EditControlPrepareEditWnd(ABarEditControl: TdxBarEditControl; AHandle: HWND); virtual; class procedure EditControlUpdateWndText(ABarEditControl: TdxBarEditControl; AHandle: HWND; ANotEqual: Boolean); virtual; // ColorCombo class procedure ColorComboDrawCustomButton(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; var ACustomColorButtonRect: TRect; Selected, Pressed: Boolean); virtual; // SysPanel class procedure SysPanelCalcSize(AHandle: HWND; var ARect: TRect; var Corner: TdxCorner; Combo: TdxBarItem; AllowResizing: Boolean); virtual; class procedure SysPanelDraw(AHandle: HWND; AllowResizing, MouseAboveCloseButton, CloseButtonIsTracking: Boolean; var CloseButtonRect, GripRect: TRect; Corner: TdxCorner); virtual; class function SysPanelSize: Integer; virtual; // DateNavigator class function IsDateNavigatorFlat: Boolean; virtual; class procedure DateNavigatorDrawButton(ABarItem: TdxBarItem; DC: HDC; R: TRect; const ACaption: string; APressed: Boolean); virtual; class function DateNavigatorHeaderColor: TColor; virtual; // SpinEditControl class procedure SpinEditControlDrawButton(ABarEditControl: TdxBarEditControl; DC: HDC; ARect: TRect; XSize, YSize, Size: Integer; Selected: Boolean; AButton, AActiveButton: TdxBarSpinEditButton; AButtonPressed: Boolean); virtual; class procedure SpinEditControlDrawFrame(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect); virtual; // ProgressControl class function ProgressControlBarBrushColor: TColorRef; virtual; class function ProgressControlBarHeight(ABarItemControl: TdxBarItemControl): Integer; virtual; class procedure ProgressControlDrawBar(ABarItemControl: TdxBarItemControl; DC: HDC; BarR: TRect; ABarBrushColor: TColorRef; PaintType: TdxBarPaintType; ASmooth: Boolean; Position, Min, Max: Integer); virtual; class function ProgressControlIndent(ABarItemControl: TdxBarItemControl): Integer; virtual; // ContainerControl class function ContainerControlSubMenuOffset: Integer; virtual; // InPlaceSubItemControl class function InPlaceSubItemControlBrush: HBRUSH; virtual; class procedure InPlaceSubItemControlDrawInMenu(ABarContainerItemControl: TdxBarContainerItemControl; DC: HDC; Selected, AItemExpanded: Boolean; ARect: TRect); virtual; end; // TdxBarItemControlPainterClass = class of TdxBarItemControlPainter; TdxBarItemControlStandardPainter = class(TdxBarItemControlPainter) protected class procedure DrawGlyphBorder(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, BarControlOwner, IsSplit: Boolean); override; class procedure DrawGlyphCheckMark(ABarItemControl: TdxBarItemControl; DC: HDC; X, Y, DoubleSize: Integer); override; class function IgnoreGlyphOpaque: Boolean; override; // Bar class function BarIsBarSmall(ABarControl: TdxBarControl; const R: TRect): Boolean; override; class procedure BarDrawMarkAtPos(ABarControl: TdxBarControl; DC: HDC; const ItemRect: TRect; Offset: Integer); override; class procedure BarDrawMarkBackground(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); override; public // Common class procedure DrawDisabledShadowRect(ABarItemControl: TdxBarItemControl; DC: HDC; R: TRect); override; class procedure DrawGlyphAndTextInSubMenu(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Selected, ShowGlyph, Down: Boolean); override; class procedure DrawLowered(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect); override; class procedure FrameAndFillRect(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Enabled, Selected, Pressed: Boolean); override; class function GlyphBkgndBrush(ABarItemControl: TdxBarItemControl; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean): HBRUSH; override; class function GlyphDownShift(ABarItemControl: TdxBarItemControl): Integer; override; class function GlyphDrawDownedShift(ABarItemControl: TdxBarItemControl; ADown: Boolean): Integer; override; class function LoweredBorderSize(ABarItemControl: TdxBarItemControl): Integer; override; // BarManager class function BeforeFingersSize: Integer; override; class function FingersSize: Integer; override; class function SubMenuBeginGroupIndent: Integer; override; // Bar class procedure BarDrawCloseButton(ABarControl: TdxBarControl; DC: HDC; R: TRect); override; class procedure BarDrawDockedBarBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawFloatingBarBorder(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawMDIButton(ABarControl: TdxBarControl; AButton: TdxBarMDIButton; ASelected, APressed: Boolean; DC: HDC; R: TRect); override; class function BarHorSize: Integer; override; class function BarMarkItemRect(ABarControl: TdxBarControl): TRect; override; class function BarTopSize: Integer; override; class function BarBottomSize: Integer; override; class function BarUseSystemClose: Boolean; override; class function BarUseSystemNCBorder: Boolean; override; // ButtonControl class procedure DrawButtonControlArrow(ABarItemControl: TdxBarItemControl; DC: HDC; R1: TRect; Brush: HBRUSH; ArrowColor: COLORREF; Selected, DrawDowned, DroppedDown, DropDownEnabled, IsDropDownMenuControlExist: Boolean; PaintType: TdxBarPaintType); override; class procedure OffsetCaptionBounds(ABarButtonControl: TdxBarButtonControl; APressed: Boolean; var R: TRect); override; class procedure OffsetEllipsisBounds(ABarItemControl: TdxBarItemControl; APressed: Boolean; var R: TRect); override; // ComboControl class procedure ComboControlDrawArrow(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; Selected: Boolean; PaintType: TdxBarPaintType); override; // DropDownListBox class function DropDownListBoxBorderSize: Integer; override; class procedure DropDownListBoxDrawBorder(ABarManager: TdxBarManager; DC: HDC; R: TRect); override; // SubMenuControl class procedure SubMenuControlDrawItemFrame(ABarSubMenuControl: TdxBarSubMenuControl; AControl: TdxBarItemControl; DC: HDC; AItemRect: TRect; AIndex, LeftDelta: Integer); override; class function SubMenuControlIsOffsetRecentGroupNeeded: Boolean; override; class function SubMenuControlMarkRectOffset(ABarSubMenuControl: TdxBarSubMenuControl): Integer; override; // EditControl class procedure EditControlPrepareEditWnd(ABarEditControl: TdxBarEditControl; AHandle: HWND); override; end; TdxBarItemControlEnhancedPainter = class(TdxBarItemControlStandardPainter) protected // Bar class procedure BarDrawMarkAtPos(ABarControl: TdxBarControl; DC: HDC; const ItemRect: TRect; Offset: Integer); override; class procedure BarDrawMarkBackground(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawMarkElements(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect); override; public // BarManager class function BeforeFingersSize: Integer; override; class function FingersSize: Integer; override; class function SubMenuBeginGroupIndent: Integer; override; // Bar class function BarAllowQuickCustomizing: Boolean; override; class procedure BarDrawDockedBarBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); override; class function BarMarkItemRect(ABarControl: TdxBarControl): TRect; override; end; TdxBarItemControlFlatPainter = class(TdxBarItemControlPainter) protected // Common class procedure DrawGlyphBorder(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, BarControlOwner, IsSplit: Boolean); override; class procedure DrawGlyphCheckMark(ABarItemControl: TdxBarItemControl; DC: HDC; X, Y, DoubleSize: Integer); override; class procedure DrawGlyphImage(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; const GlyphRect: TRect; AGlyph: TBitmap; AImages: TCurImageList; AImageIndex: Integer; Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean; PaintType: TdxBarPaintType); override; class procedure FrameFlatSelRect(DC: HDC; const R: TRect); virtual; // Bar class function BarCaptionBkColor(ABarControl: TdxBarControl; AMainFormActive: Boolean): COLORREF; override; class function BarMarkArrowColor(ABarControl: TdxBarControl; AState: TdxBarMarkState): COLORREF; override; class procedure BarDrawMarkBackground(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawMarkElements(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect); override; class procedure BarOffsetFloatingBarCaption(ABarControl: TdxBarControl; var X: Integer; var R: TRect); override; class function GetDrawMarkElementColor(ABarControl: TdxBarControl): Integer; override; // Edit class procedure EditOffsetInteriorRect(var R: TRect); override; public // Common class procedure DrawGlyphAndTextInSubMenu(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Selected, ShowGlyph, Down: Boolean); override; class procedure DrawLowered(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect); override; class procedure DrawStaticBorder(ABarItemControl: TdxBarItemControl; DC: HDC; var ARect: TRect; ABorderWidth: Integer; ABorderStyle: TdxBarStaticBorderStyle); override; class procedure FrameAndFillRect(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Enabled, Selected, Pressed: Boolean); override; class procedure GetArrowParams(ABarItemControl: TdxBarItemControl; APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); override; class function GlyphBkgndBrush(ABarItemControl: TdxBarItemControl; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean): HBRUSH; override; class function IsFlatItemText: Boolean; override; class function LoweredBorderSize(ABarItemControl: TdxBarItemControl): Integer; override; class function StaticBorderBrush(ABarItemControl: TdxBarItemControl; ABorderStyle: TdxBarStaticBorderStyle): HBRUSH; virtual; class function TextAreaOffset(ABarItemControl: TdxBarItemControl): Integer; override; // BarManager class function BeforeFingersSize: Integer; override; class function FingersSize: Integer; override; class function RealButtonArrowWidth(ABarManager: TdxBarManager): Integer; override; class function RealLargeButtonArrowWidth(ABarManager: TdxBarManager): Integer; override; class function SubMenuBeginGroupIndent: Integer; override; // CustomBar class function BarChildrenHaveShadows(ABarControl: TCustomdxBarControl): Boolean; override; class procedure BarDrawBarControlOwner(ACustomBarControl: TCustomdxBarControl; DC: HDC; R: TRect; ABarControl: TCustomdxBarControl); virtual; class procedure BarDrawBarControlOwnerBorder(ACustomBarControl: TCustomdxBarControl; DC: HDC; R: TRect; ABarItemControl: TdxBarItemControl; ABarControl: TCustomdxBarControl); virtual; class procedure BarDrawBarControlOwnerFrame(ACustomBarControl: TCustomdxBarControl; DC: HDC; R: TRect); virtual; class procedure BarDrawBarControlOwnerLink(ACustomBarControl: TCustomdxBarControl; DC: HDC; R, ALinkR: TRect; ABarItemControl: TdxBarItemControl); virtual; class function BarHasShadow(ABarControl: TCustomdxBarControl): Boolean; override; class function BarToolbarBrush(ABarControl: TCustomdxBarControl): HBRUSH; override; class function BarToolbarBrushEx(ABarControl: TdxBarControl): HBRUSH; override; class function BarToolbarDownedBrush(ABarControl: TCustomdxBarControl): HBRUSH; override; class function BarToolbarDownedSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; override; class function BarToolbarSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; override; class function EditBorderSize(DC: HDC): Integer; override; // Bar class function BarAllowHotTrack: Boolean; override; class function BarAllowQuickCustomizing: Boolean; override; class function BarBeginGroupSideSize: Integer; override; class function BarBeginGroupSize: Integer; override; class procedure BarDrawBeginGroup(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH; AHorz: Boolean); override; class procedure BarDrawCloseButton(ABarControl: TdxBarControl; DC: HDC; R: TRect); override; class procedure BarDrawDockedBarBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawFloatingBarBorder(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawMark(ABarControl: TdxBarControl; DC: HDC; MarkR: TRect); override; class procedure BarDrawMDIButton(ABarControl: TdxBarControl; AButton: TdxBarMDIButton; ASelected, APressed: Boolean; DC: HDC; R: TRect); override; class function BarMarkItemRect(ABarControl: TdxBarControl): TRect; override; // QuickCustItem class function BarToolbarBrushEx2(ABarControl: TdxBarControl): HBRUSH; override; class procedure DrawQuickCustItemFrame(ABarItemControl: TdxBarItemControl; DC: HDC; var R, ARect: TRect; Selected: Boolean); override; class procedure DrawQuickCustItemFrameSelected(ABarItemControl: TdxBarItemControl; DC: HDC; WholeR, R: TRect; Selected: Boolean); override; class function IsQuickControlPopupOnRight: Boolean; override; // ButtonControl class procedure CorrectButtonControlDefaultHeight(var DefaultHeight: Integer); override; class procedure CorrectButtonControlDefaultWidth(ABarItemControl: TdxBarItemControl; var DefaultWidth: Integer); override; class procedure DrawButtonControlArrow(ABarItemControl: TdxBarItemControl; DC: HDC; R1: TRect; Brush: HBRUSH; ArrowColor: COLORREF; Selected, DrawDowned, DroppedDown, DropDownEnabled, IsDropDownMenuControlExist: Boolean; PaintType: TdxBarPaintType); override; class function IsDropDownRepaintNeeded: Boolean; override; // ComboControl class procedure ComboControlDrawArrow(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; Selected: Boolean; PaintType: TdxBarPaintType); override; class procedure ComboControlGetArrowParams(ABarItemControl: TdxBarItemControl; APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); override; // DropDownListBox class function DropDownListBoxBorderSize: Integer; override; class procedure DropDownListBoxDrawBorder(ABarManager: TdxBarManager; DC: HDC; R: TRect); override; // SubItemControl class function SubItemControlCaptionOffset(ABarSubItemControl: TdxBarSubItemControl): Integer; override; class function SubItemControlDefaultHeight(ABarSubItemControl: TdxBarSubItemControl): Integer; override; class function SubItemControlDefaultWidth(ABarSubItemControl: TdxBarSubItemControl): Integer; override; class procedure SubItemControlDraw(ABarSubItemControl: TdxBarSubItemControl; DC: HDC; R: TRect; Selected, Down: Boolean; PaintType: TdxBarPaintType); override; // SubMenuControl class function SubMenuControlBeginGroupSize: Integer; override; class function SubMenuControlBorderSize: Integer; override; class procedure SubMenuControlCalcDrawingConsts(ABarSubMenuControl: TdxBarSubMenuControl; var ATextSize, AMenuArrowWidth, AMarkSize, ANormalItemHeight: Integer); override; class procedure SubMenuControlCalcRect(ABarSubMenuControl: TdxBarSubMenuControl; Size: PPoint; var R: TRect; var AClientHeight: Integer); override; class procedure SubMenuControlCalcSize(ABarSubMenuControl: TdxBarSubMenuControl; Size: PPoint; var R: TRect); override; class function SubMenuControlDetachCaptionAreaSize(ABarSubMenuControl: TdxBarSubMenuControl): Integer; override; class procedure SubMenuControlDrawArrowsArea(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; ABrush: HBRUSH; AMaxVisibleCount: Integer); override; class procedure SubMenuControlDrawBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); override; class procedure SubMenuControlDrawClientBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; var R: TRect; ABrush: HBRUSH); override; class procedure SubMenuControlDrawDetachCaption(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); override; class procedure SubMenuControlDrawBeginGroup(ABarSubMenuControl: TdxBarSubMenuControl; AControl: TdxBarItemControl; DC: HDC; AItemRect: TRect; LeftDelta: Integer); override; class function SubMenuControlGroupSeparatorBrush(ABarSubMenuControl: TdxBarSubMenuControl): HBRUSH; virtual; class function SubMenuControlMarkArrowSize(ABarSubMenuControl: TdxBarSubMenuControl; AMarkSize: Integer): Integer; override; class procedure SubMenuControlOffsetDetachCaptionRect(ABarSubMenuControl: TdxBarSubMenuControl; var R: TRect); override; class procedure SubMenuControlPrepareBkBrush(ABarSubMenuControl: TdxBarSubMenuControl; var ABkBrush: HBRUSH); override; class function SubMenuControlToolbarItemsBrush(ABarSubMenuControl: TdxBarSubMenuControl): HBRUSH; override; // CustomCombo class procedure CustomComboDrawItem(ABarCustomCombo: TdxBarCustomCombo; ACanvas: TCanvas; AIndex: Integer; ARect: TRect; AState: TOwnerDrawState; AInteriorIsDrawing: Boolean); override; // EditControl class function EditControlCaptionWidth(ABarEditControl: TdxBarEditControl; ATextWidth: Integer): Integer; override; class procedure EditControlDrawBorder(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); override; class procedure EditControlDrawCaption(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); override; class procedure EditControlDrawTextField(ABarEditControl: TdxBarEditControl; DC: HDC; const ARect: TRect; AIgnoreEnabled: Boolean); override; class function EditControlES_Style: Integer; override; class procedure EditControlPrepareEditWnd(ABarEditControl: TdxBarEditControl; AHandle: HWND); override; class procedure EditControlUpdateWndText(ABarEditControl: TdxBarEditControl; AHandle: HWND; ANotEqual: Boolean); override; // SysPanel class procedure SysPanelDraw(AHandle: HWND; AllowResizing, MouseAboveCloseButton, CloseButtonIsTracking: Boolean; var CloseButtonRect, GripRect: TRect; Corner: TdxCorner); override; // DateNavigator class function IsDateNavigatorFlat: Boolean; override; class procedure DateNavigatorDrawButton(ABarItem: TdxBarItem; DC: HDC; R: TRect; const ACaption: string; APressed: Boolean); override; // SpinEditControl class procedure SpinEditControlDrawButton(ABarEditControl: TdxBarEditControl; DC: HDC; ARect: TRect; XSize, YSize, Size: Integer; Selected: Boolean; AButton, AActiveButton: TdxBarSpinEditButton; AButtonPressed: Boolean); override; // ContainerControl class function ContainerControlSubMenuOffset: Integer; override; // InPlaceSubItemControl class procedure InPlaceSubItemControlDrawInMenu(ABarContainerItemControl: TdxBarContainerItemControl; DC: HDC; Selected, AItemExpanded: Boolean; ARect: TRect); override; end; TdxBarItemControlOffice11Painter = class(TdxBarItemControlFlatPainter) protected // Common class procedure DrawGlyphBorder(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, BarControlOwner, IsSplit: Boolean); override; class procedure DrawGlyphImage(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; const GlyphRect: TRect; AGlyph: TBitmap; AImages: TCurImageList; AImageIndex: Integer; Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean; PaintType: TdxBarPaintType); override; class procedure DrawItemArrow(DC: HDC; R: TRect; ArrowType: TdxArrowType; Enabled, Selected, Flat: Boolean); override; class procedure DrawLargeItemArrow(DC: HDC; R: TRect; ArrowType: TdxArrowType; Size: Integer; Selected, Enabled, Flat: Boolean); override; class procedure FrameFlatSelRect(DC: HDC; const R: TRect); override; class function GetBarGradientRect(ABarControl: TCustomdxBarControl): TRect; class procedure GetDockColors(ADockControl: TdxDockControl; var AColor1, AColor2: TColor); class procedure GetMarkColors(ABarControl: TdxBarControl; var AMarkColor1, AMarkColor2, AColor6, AColor9: TColor); class procedure GetSelectedColors(ABarItemControl: TdxBarItemControl; ADown, ASelected: Boolean; var AColor1, AColor2: TColor); class procedure GetEditColors(ABarItemControl: TdxBarItemControl; var ATextColor, ABkColor: COLORREF); override; class function GetFadedColor(ABarControl: TCustomdxBarControl): TColor; override; class procedure GetTextColors(ABarItemControl: TdxBarItemControl; AEnabled, ASelected, AFlat: Boolean; var AColor1, AColor2: TColor); override; class function IgnoreNonRecentColor: Boolean; override; class function IsMenuGradient(ABarItemControl: TdxBarItemControl): Boolean; class function IsSimpleMark(ABarControl: TdxBarControl): Boolean; // Bar class function BarCaptionBkColor(ABarControl: TdxBarControl; AMainFormActive: Boolean): COLORREF; override; class function BarCaptionColor(ABarControl: TdxBarControl): COLORREF; override; class function BarMarkArrowColor(ABarControl: TdxBarControl; AState: TdxBarMarkState): COLORREF; override; class procedure BarDrawFingerElements(ABarControl: TCustomdxBarControl; DC: HDC; ARect: TRect; AHorizontal: Boolean); virtual; class procedure BarDrawMarkBackground(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawMarkElements(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect); override; // SubMenuControl class procedure SubMenuControlDrawMark(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect; ASelected: Boolean); override; // ComboControl class procedure ComboControlDrawOneArrow(ABarItemControl: TdxBarItemControl; DC: HDC; X, Y, Size: Integer; Color: COLORREF); override; public // Common class procedure DrawGlyphAndTextInSubMenu(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Selected, ShowGlyph, Down: Boolean); override; class procedure FrameAndFillRect(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Enabled, Selected, Pressed: Boolean); override; class procedure GetArrowParams(ABarItemControl: TdxBarItemControl; APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); override; class function GlyphBkgndBrush(ABarItemControl: TdxBarItemControl; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean): HBRUSH; override; class function IsItemTextSelectedInverted: Boolean; override; class function StaticBorderBrush(ABarItemControl: TdxBarItemControl; ABorderStyle: TdxBarStaticBorderStyle): HBRUSH; override; // BarManager class function BeforeFingersSize: Integer; override; class function BorderSizeX: Integer; override; class function BorderSizeY: Integer; override; class function EmptyFingersSize: Integer; override; // DockControl class procedure DockControlFillBackground(ADockControl: TdxDockControl; DC: HDC; ADestR, ASourceR, AWholeR: TRect; ABrush: HBRUSH; AColor: TColor); override; class function IsNativeBackground: Boolean; override; // CustomBar class function BarControlOwnerBrush(ABarManager: TdxBarManager): HBRUSH; override; class procedure BarDrawBarControlOwnerFrame(ACustomBarControl: TCustomdxBarControl; DC: HDC; R: TRect); override; class procedure BarDrawBarControlOwnerLink(ACustomBarControl: TCustomdxBarControl; DC: HDC; R, ALinkR: TRect; ABarItemControl: TdxBarItemControl); override; class procedure BarDrawDockedBackground(ABarControl: TCustomdxBarControl; DC: HDC; ADestR, ASourceR: TRect; ABrush: HBRUSH; AColor: TColor); override; class procedure BarDrawFloatingBackground(ABarControl: TCustomdxBarControl; DC: HDC; ADestR, ASourceR: TRect; ABrush: HBRUSH; AColor: TColor); override; class procedure BarDrawOwnerLink(ABarControl: TCustomdxBarControl; DC: HDC); override; class function BarHasShadow(ABarControl: TCustomdxBarControl): Boolean; override; class function BarToolbarBrush(ABarControl: TCustomdxBarControl): HBRUSH; override; class function BarToolbarBrushEx(ABarControl: TdxBarControl): HBRUSH; override; class function BarToolbarDownedBrush(ABarControl: TCustomdxBarControl): HBRUSH; override; class function BarToolbarDownedSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; override; class function BarToolbarSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; override; class function ComboBoxArrowWidth(ABarControl: TCustomdxBarControl; DC: HDC; cX: Integer): Integer; override; // Bar class function BarBeforeFingersIndent: Integer; virtual; class procedure BarBorderPaintSizes(ABarControl: TdxBarControl; var R: TRect); override; class procedure BarBorderSizes(ABar: TdxBar; AStyle: TdxBarDockingStyle; var R: TRect); override; class procedure BarDrawBeginGroup(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH; AHorz: Boolean); override; class procedure BarDrawCaptionElement(ABarControl: TdxBarControl; DC: HDC; R: TRect; AState: TdxBarMarkState); override; class procedure BarDrawDockedBarBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawFloatingBarBorder(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawFloatingBarCaption(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawStatusBarGrip(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawStatusBarTopBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); override; class function BarMarkRect(ABarControl: TdxBarControl): TRect; override; class procedure BarMarkRectInvalidate(ABarControl: TdxBarControl); override; class procedure StatusBarFillBackground(ABarControl: TdxBarControl; DC: HDC; ADestR, ASourceR, AWholeR: TRect; ABrush: HBRUSH; AColor: TColor); override; class function StatusBarGripSize(ABarManager: TdxBarManager): TSize; override; class function StatusBarTopBorderSize(ABarManager: TdxBarManager): Integer; override; // SubMenuControl class function IsSingleMenuBorder(ABarSubMenuControl: TdxBarSubMenuControl): Boolean; class procedure SubMenuControlCalcDrawingConsts(ABarSubMenuControl: TdxBarSubMenuControl; var ATextSize, AMenuArrowWidth, AMarkSize, ANormalItemHeight: Integer); override; class procedure SubMenuControlDrawBackground(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; ARect: TRect; ABrush: HBRUSH; AColor: TColor); override; class procedure SubMenuControlDrawClientBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; var R: TRect; ABrush: HBRUSH); override; class function SubMenuControlDetachCaptionAreaSize(ABarSubMenuControl: TdxBarSubMenuControl): Integer; override; class procedure SubMenuControlDrawBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); override; class procedure SubMenuControlDrawDetachCaption(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); override; class function SubMenuControlGroupSeparatorBrush(ABarSubMenuControl: TdxBarSubMenuControl): HBRUSH; override; class procedure SubMenuControlOffsetDetachCaptionRect(ABarSubMenuControl: TdxBarSubMenuControl; var R: TRect); override; class function SubMenuControlToolbarItemsBrush(ABarSubMenuControl: TdxBarSubMenuControl): HBRUSH; override; // DropDownListBox class procedure DropDownListBoxDrawBorder(ABarManager: TdxBarManager; DC: HDC; R: TRect); override; // QuickCustItem class function BarToolbarBrushEx2(ABarControl: TdxBarControl): HBRUSH; override; class procedure DrawQuickCustItemFrame(ABarItemControl: TdxBarItemControl; DC: HDC; var R, ARect: TRect; Selected: Boolean); override; class procedure DrawQuickCustItemFrameSelected(ABarItemControl: TdxBarItemControl; DC: HDC; WholeR, R: TRect; Selected: Boolean); override; // EditControl class function EditControlCaptionWidth(ABarEditControl: TdxBarEditControl; ATextWidth: Integer): Integer; override; class procedure EditControlDrawBorder(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); override; class procedure EditControlDrawCaption(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); override; // ButtonControl class procedure DrawButtonControlArrow(ABarItemControl: TdxBarItemControl; DC: HDC; R1: TRect; Brush: HBRUSH; ArrowColor: COLORREF; Selected, DrawDowned, DroppedDown, DropDownEnabled, IsDropDownMenuControlExist: Boolean; PaintType: TdxBarPaintType); override; // ComboControl class procedure ComboControlDrawArrow(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; Selected: Boolean; PaintType: TdxBarPaintType); override; class procedure ComboControlGetArrowParams(ABarItemControl: TdxBarItemControl; APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); override; // ProgressControl class function ProgressControlIndent(ABarItemControl: TdxBarItemControl): Integer; override; // DateNavigator class procedure DateNavigatorDrawButton(ABarItem: TdxBarItem; DC: HDC; R: TRect; const ACaption: string; APressed: Boolean); override; class function DateNavigatorHeaderColor: TColor; override; // InPlaceSubItemControl class function InPlaceSubItemControlBrush: HBRUSH; override; end; TdxBarItemControlXPPainter = class(TdxBarItemControlPainter) protected // Common class procedure DrawGlyphBorder(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, BarControlOwner, IsSplit: Boolean); override; class procedure DrawGlyphCheckMark(ABarItemControl: TdxBarItemControl; DC: HDC; X, Y, DoubleSize: Integer); override; class procedure DrawGlyphImage(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; const GlyphRect: TRect; AGlyph: TBitmap; AImages: TCurImageList; AImageIndex: Integer; Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean; PaintType: TdxBarPaintType); override; class function GetFadedColor(ABarControl: TCustomdxBarControl): TColor; override; class function IsMenuItem(ABarItemControl: TdxBarItemControl): Boolean; override; // Bar class procedure BarDrawGrip(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawMarkBackground(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawMarkElements(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect); override; class procedure BarOffsetFloatingBarCaption(ABarControl: TdxBarControl; var X: Integer; var R: TRect); override; // Edit class procedure EditOffsetInteriorRect(var R: TRect); override; public // Common class procedure DrawGlyphAndTextInSubMenu(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Selected, ShowGlyph, Down: Boolean); override; class procedure DrawLowered(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect); override; class function GlyphBkgndBrush(ABarItemControl: TdxBarItemControl; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean): HBRUSH; override; class function GlyphDownShift(ABarItemControl: TdxBarItemControl): Integer; override; class function GlyphDrawDownedShift(ABarItemControl: TdxBarItemControl; ADown: Boolean): Integer; override; // BarManager class function BeforeFingersSize: Integer; override; class function FingersSize: Integer; override; class function GripperSize: Integer; override; class function RealButtonArrowWidth(ABarManager: TdxBarManager): Integer; override; class function RealLargeButtonArrowWidth(ABarManager: TdxBarManager): Integer; override; // DockControl class procedure DockControlFillBackground(ADockControl: TdxDockControl; DC: HDC; ADestR, ASourceR, AWholeR: TRect; ABrush: HBRUSH; AColor: TColor); override; class function IsNativeBackground: Boolean; override; // CustomBar // class function BarChildrenHaveShadows(ABarControl: TCustomdxBarControl): Boolean; override; class function BarHasShadow(ABarControl: TCustomdxBarControl): Boolean; override; class function BarToolbarBrush(ABarControl: TCustomdxBarControl): HBRUSH; override; class function BarToolbarBrushEx(ABarControl: TdxBarControl): HBRUSH; override; class function BarToolbarDownedBrush(ABarControl: TCustomdxBarControl): HBRUSH; override; class function BarToolbarDownedSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; override; class function BarToolbarSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; override; class function ComboBoxArrowWidth(ABarControl: TCustomdxBarControl; DC: HDC; cX: Integer): Integer; override; class function EditBorderSize(DC: HDC): Integer; override; // Bar class function BarAllowHotTrack: Boolean; override; class function BarAllowQuickCustomizing: Boolean; override; class function BarBeginGroupSideSize: Integer; override; class function BarBeginGroupSize: Integer; override; class function BarBorderSize: Integer; override; class procedure BarCaptionFillBackground(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); override; // class function BarCaptionSize: Integer; override; class function BarCaptionTransparent: Boolean; override; class function BarCloseButtonSize: TSize; override; class procedure BarDrawBeginGroup(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH; AHorz: Boolean); override; class procedure BarDrawCloseButton(ABarControl: TdxBarControl; DC: HDC; R: TRect); override; class procedure BarDrawDockedBarBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawFloatingBarBorder(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); override; class procedure BarDrawMDIButton(ABarControl: TdxBarControl; AButton: TdxBarMDIButton; ASelected, APressed: Boolean; DC: HDC; R: TRect); override; class function BarMarkItemRect(ABarControl: TdxBarControl): TRect; override; class procedure StatusBarFillBackground(ABarControl: TdxBarControl; DC: HDC; ADestR, ASourceR, AWholeR: TRect; ABrush: HBRUSH; AColor: TColor); override; class function StatusBarGripSize(ABarManager: TdxBarManager): TSize; override; // QuickCustItem class function IsQuickControlPopupOnRight: Boolean; override; // ButtonControl class function ButtonBorderHeight: Integer; override; class function ButtonBorderWidth: Integer; override; class procedure CorrectButtonControlDefaultHeight(var DefaultHeight: Integer); override; class procedure DrawButtonControlArrow(ABarItemControl: TdxBarItemControl; DC: HDC; R1: TRect; Brush: HBRUSH; ArrowColor: COLORREF; Selected, DrawDowned, DroppedDown, DropDownEnabled, IsDropDownMenuControlExist: Boolean; PaintType: TdxBarPaintType); override; class procedure OffsetCaptionBounds(ABarButtonControl: TdxBarButtonControl; APressed: Boolean; var R: TRect); override; class procedure OffsetEllipsisBounds(ABarItemControl: TdxBarItemControl; APressed: Boolean; var R: TRect); override; // EditControl class function EditControlCaptionWidth(ABarEditControl: TdxBarEditControl; ATextWidth: Integer): Integer; override; class procedure EditControlDrawBorder(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); override; class procedure EditControlDrawCaption(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); override; class procedure EditControlDrawTextField(ABarEditControl: TdxBarEditControl; DC: HDC; const ARect: TRect; AIgnoreEnabled: Boolean); override; class function EditControlES_Style: Integer; override; class procedure EditControlPrepareEditWnd(ABarEditControl: TdxBarEditControl; AHandle: HWND); override; class procedure EditControlUpdateWndText(ABarEditControl: TdxBarEditControl; AHandle: HWND; ANotEqual: Boolean); override; // CustomCombo class procedure CustomComboDrawItem(ABarCustomCombo: TdxBarCustomCombo; ACanvas: TCanvas; AIndex: Integer; ARect: TRect; AState: TOwnerDrawState; AInteriorIsDrawing: Boolean); override; // ComboControl class function ComboControlArrowOffset: Integer; override; class procedure ComboControlDrawArrow(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; Selected: Boolean; PaintType: TdxBarPaintType); override; // SubMenuControl class function SubMenuControlArrowsOffset: Integer; override; class function SubMenuControlBeginGroupSize: Integer; override; class function SubMenuControlBorderSize: Integer; override; class procedure SubMenuControlCalcRect(ABarSubMenuControl: TdxBarSubMenuControl; Size: PPoint; var R: TRect; var AClientHeight: Integer); override; class procedure SubMenuControlCalcSize(ABarSubMenuControl: TdxBarSubMenuControl; Size: PPoint; var R: TRect); override; class function SubMenuControlDetachCaptionAreaSize(ABarSubMenuControl: TdxBarSubMenuControl): Integer; override; class procedure SubMenuControlDrawBeginGroup(ABarSubMenuControl: TdxBarSubMenuControl; AControl: TdxBarItemControl; DC: HDC; AItemRect: TRect; LeftDelta: Integer); override; class procedure SubMenuControlDrawBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); override; class procedure SubMenuControlDrawClientBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; var R: TRect; ABrush: HBRUSH); override; class procedure SubMenuControlOffsetDetachCaptionRect(ABarSubMenuControl: TdxBarSubMenuControl; var R: TRect); override; class procedure SubMenuControlPrepareBkBrush(ABarSubMenuControl: TdxBarSubMenuControl; var ABkBrush: HBRUSH); override; class function SubMenuControlToolbarItemsBrush(ABarSubMenuControl: TdxBarSubMenuControl): HBRUSH; override; // DropDownListBox class function DropDownListBoxBorderSize: Integer; override; class procedure DropDownListBoxDrawBorder(ABarManager: TdxBarManager; DC: HDC; R: TRect); override; // ColorCombo class procedure ColorComboDrawCustomButton(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; var ACustomColorButtonRect: TRect; Selected, Pressed: Boolean); override; // DateNavigator class function IsDateNavigatorFlat: Boolean; override; class procedure DateNavigatorDrawButton(ABarItem: TdxBarItem; DC: HDC; R: TRect; const ACaption: string; APressed: Boolean); override; // SysPanel class procedure SysPanelDraw(AHandle: HWND; AllowResizing, MouseAboveCloseButton, CloseButtonIsTracking: Boolean; var CloseButtonRect, GripRect: TRect; Corner: TdxCorner); override; class function SysPanelSize: Integer; override; // SpinEditControl class procedure SpinEditControlDrawButton(ABarEditControl: TdxBarEditControl; DC: HDC; ARect: TRect; XSize, YSize, Size: Integer; Selected: Boolean; AButton, AActiveButton: TdxBarSpinEditButton; AButtonPressed: Boolean); override; class procedure SpinEditControlDrawFrame(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect); override; // ProgressControl class function ProgressControlBarBrushColor: TColorRef; override; class function ProgressControlBarHeight(ABarItemControl: TdxBarItemControl): Integer; override; class procedure ProgressControlDrawBar(ABarItemControl: TdxBarItemControl; DC: HDC; BarR: TRect; ABarBrushColor: TColorRef; PaintType: TdxBarPaintType; ASmooth: Boolean; Position, Min, Max: Integer); override; end; function dxBarItemClass(AIndex: Integer): TdxBarItemClass; function dxBarItemCount: Integer; function dxBarVisibleItemClass(AIndex: Integer): TdxBarItemClass; function dxBarVisibleItemCount: Integer; procedure dxBarRegisterItem(AItemClass: TdxBarItemClass; AItemControlClass: TdxBarItemControlClass; AVisible: Boolean); procedure dxBarUnregisterItem(AItemClass: TdxBarItemClass); procedure dxBarDesignerModified(ABarManager: TdxBarManager); function dxGenBarItemName(ABarManager: TdxBarManager; ABarItemClass: TdxBarItemClass): string; function ActiveBarControl: TCustomdxBarControl; function VisibleTodxBarVisible(Value: Boolean): TdxBarItemVisible; function GetBarManagerByForm(AForm: TCustomForm): TdxBarManager; function GetWorkArea(const P: TPoint): TRect; function IsVertical(ABarControl: TCustomdxBarControl): Boolean; function GetTextOf(const S: string): string; procedure DrawItemArrow(DC: HDC; R: TRect; ArrowType: TdxArrowType; Enabled, Selected, Flat: Boolean); procedure DrawLargeItemArrow(DC: HDC; R: TRect; ArrowType: TdxArrowType; Size: Integer; Selected, Enabled, Flat: Boolean); procedure FrameFlatSelRect(DC: HDC; const R: TRect); procedure DrawVerticalGradient(Canvas: TCanvas; const ARect: TRect; FromR, ToR, FromG, ToG, FromB, ToB: Byte); procedure TransparentDraw(DrawDC: HDC; Brush: HBRUSH; FullRect, R: TRect; ABitmap: TBitmap; AImages: TCurImageList; AImageIndex: Integer; AEnabled, AGrayScale, AFlat, ASelected, ADown, APressed, AShadow, ATransparent: Boolean; AFadedColor: TColor; ImageListBkColor: TColor); function CloneFont(Source: HFONT): HFONT; procedure FillRectByBitmap(DC: HDC; ADestR, ASourceR: TRect; ABitmap: TBitmap); procedure SaveClipRgn(DC: HDC; var AClipRgn: HRGN; var AClipRgnExists: Boolean); procedure RestoreClipRgn(DC: HDC; var AClipRgn: HRGN; var AClipRgnExists: Boolean); procedure ProcessMouseMessages; procedure ProcessPaintMessages; function dxBarCustomizingPopup: TdxBarSubMenuControl; function dxBarCustomizingPopupItemLink: TdxBarItemLink; procedure ClearInternalItemList; function LeftButtonPressed: Boolean; function RightButtonPressed: Boolean; var dxBarDesigner: TdxBarDesigner; dxBarHintWindowClass: TdxBarHintWindowClass = TdxBarHintWindow; dxBarManagerList: TdxBarManagerList; PatternBrush: HBRUSH; InternalItemList: TList; dxBarMakeInactiveImagesDingy: Boolean = True; dxBarPlaySound: Boolean = True; const dxBarManagerTempCategoryIndex = -1000; dxBarCustomizingPopupPaintStyleGroupIndex = -1000; dxBarNonrecentlyUsedItemsColorDelta: Integer = 20; dxBarFlatToolbarsColorDelta: Integer = 20; dxBarWaitForSubMenuTime: Integer = 400; implementation {$R dxBar.res} uses CommCtrl, MMSystem, Registry, IniFiles, dxCore, dxUxTheme, dxThemeConsts, dxOffice11, dxBarCommon, dxBarStrs, dxBarCustForm, dxBarPopupMenuEd; const {$IFNDEF DELPHI6} WS_EX_LAYERED = $00080000; AC_SRC_ALPHA = $01; LWA_ALPHA = $00000002; {$ENDIF} dxBarButtonBorderWidth = 7; dxBarButtonBorderHeight = 6; dxBarFingerSize = 3; dxBarHorSize = 4; dxBarTopSize = 2; dxBarBottomSize = 1; dxBarFlatBorderSize = 3; DefautGlyphSize = 16; InsertZone = 10; MarkSizeX = 11; MarkSizeY = 9; MarkSizeArrowY = 4; MarkSizeArrowX = 2 * MarkSizeArrowY - 1; MakeBeginGroupDragSize = 4; MinToolbarSize = 2 + 19 + 2; FloatToolbarMarkIndent = 1; HintOffset = 20; MinEditWidth = 20; EditSizingZoneSize = 7; MinDockSize = 3; DetachAreaDelta = 15; dxBarWaitForShowHintTime = 1000; dxBarWaitForHideHintTime = 10000; dxBarHiddedHintLifeTime = 400; dxBarScrollMenuTime = 80; dxBarSlowExpandMenuTime = 4000; MDIButtonCommands: array[TdxBarMDIButton] of Integer = (SC_MINIMIZE, SC_RESTORE, SC_CLOSE); MDIButtonStyles: array[TdxBarMDIButton] of Integer = (DFCS_CAPTIONMIN, DFCS_CAPTIONRESTORE, DFCS_CAPTIONCLOSE); ImageShadowSize = 2; ListItemSeparator = '-'; type PBoolean = ^Boolean; TCurIniFile = TMemIniFile; TDummyBitmap = class(TBitmap); TDummyControl = class(TControl); TDummyForm = class(TCustomForm); TRegItemRecord = class public ItemClass: TdxBarItemClass; ItemControlClass: TdxBarItemControlClass; Visible: Boolean; end; var FUser32DLL: HMODULE; TrackMouseEvent: function(var EventTrack: TTrackMouseEvent): BOOL; stdcall; UpdateLayeredWindow: function(Handle: THandle; hdcDest: HDC; pptDst: PPoint; _psize: PSize; hdcSrc: HDC; pptSrc: PPoint; crKey: COLORREF; pblend: PBLENDFUNCTION; dwFlags: DWORD): Boolean; stdcall; FRegItemList: TList; FBarControls: TList; FActiveBarControl: TCustomdxBarControl; FIsMDIButtonPressed, FIsMouseOverMDIButton: Boolean; FPressedMDIButton, FSelectedMDIButton: TdxBarMDIButton; ResettingToolbar, InternalLoading: Boolean; ShowFullMenus: Boolean; BitsPerPixel: Integer; { blending } type TAnimateWindowProc = function(hWnd: HWND; dwTime: DWORD; dwFlags: DWORD): BOOL; stdcall; TSetLayeredWindowAttributes = function (Hwnd: THandle; crKey: COLORREF; bAlpha: Byte; dwFlags: DWORD): Boolean; stdcall; var AnimateWindowProc: TAnimateWindowProc = nil; SetLayeredWindowAttributes: TSetLayeredWindowAttributes = nil; procedure SetLayeredWndAttributes(AHandle: HWND; AAlphaBlendValue: Integer); var AStyle: Integer; begin if Assigned(SetLayeredWindowAttributes) then begin AStyle := GetWindowLong(AHandle, GWL_EXSTYLE); if AAlphaBlendValue < 255 then begin if (AStyle and WS_EX_LAYERED) = 0 then SetWindowLong(AHandle, GWL_EXSTYLE, AStyle or WS_EX_LAYERED); SetLayeredWindowAttributes(AHandle, 0, AAlphaBlendValue, LWA_ALPHA); end else if (AStyle and WS_EX_LAYERED) <> 0 then begin SetWindowLong(AHandle, GWL_EXSTYLE, AStyle and not WS_EX_LAYERED); RedrawWindow(AHandle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME or RDW_ALLCHILDREN); end; end; end; function IsPopupMenuShowed: Boolean; var I, J: Integer; begin Result := False; for I := 0 to dxBarManagerList.Count - 1 do for J := 0 to dxBarManagerList[I].FPopupMenus.Count - 1 do if TdxBarPopupMenu(dxBarManagerList[I].FPopupMenus[J]).FPopupMenuVisible then begin Result := True; Break; end; end; { global methods } function dxBarItemClass(AIndex: Integer): TdxBarItemClass; begin Result := TRegItemRecord(FRegItemList[AIndex]).ItemClass; end; function dxBarItemCount: Integer; begin Result := FRegItemList.Count; end; function dxBarVisibleItemClass(AIndex: Integer): TdxBarItemClass; var VisibleIndex, I: Integer; begin Result := nil; VisibleIndex := -1; with FRegItemList do for I := 0 to Count - 1 do with TRegItemRecord(FRegItemList[I]) do begin if Visible then Inc(VisibleIndex); if VisibleIndex = AIndex then begin Result := ItemClass; Exit; end; end; end; function dxBarVisibleItemCount: Integer; var I: Integer; begin Result := 0; with FRegItemList do for I := 0 to Count - 1 do if TRegItemRecord(FRegItemList[I]).Visible then Inc(Result); end; procedure dxBarRegisterItem(AItemClass: TdxBarItemClass; AItemControlClass: TdxBarItemControlClass; AVisible: Boolean); var ARecord: TRegItemRecord; begin ARecord := TRegItemRecord.Create; with ARecord do begin ItemClass := AItemClass; ItemControlClass := AItemControlClass; Visible := AVisible; end; FRegItemList.Add(ARecord); RegisterClass(AItemClass); end; procedure dxBarUnregisterItem(AItemClass: TdxBarItemClass); var I: Integer; begin for I := 0 to FRegItemList.Count - 1 do if TRegItemRecord(FRegItemList[I]).ItemClass = AItemClass then begin TRegItemRecord(FRegItemList[I]).Free; FRegItemList.Delete(I); UnregisterClass(AItemClass); Break; end; end; procedure AddBarControl(ABarControl: TCustomdxBarControl); begin FBarControls.Add(ABarControl); end; procedure RemoveBarControl(ABarControl: TCustomdxBarControl); begin FBarControls.Remove(ABarControl); end; function BarControlExists(ABarControl: TCustomdxBarControl): Boolean; begin Result := (ABarControl <> nil) and (FBarControls.IndexOf(ABarControl) <> -1); end; procedure dxBarDesignerModified(ABarManager: TdxBarManager); begin if ABarManager <> nil then ABarManager.DesignerModified; end; function dxGenBarItemName(ABarManager: TdxBarManager; ABarItemClass: TdxBarItemClass): string; var S, S1: string; I, J: Integer; AFound: Boolean; begin S := ABarItemClass.ClassName; Delete(S, 1, 1); J := 0; repeat Inc(J); S1 := S + IntToStr(J); AFound := False; for I := 0 to ABarManager.ItemCount - 1 do if CompareText(S1, ABarManager.Items[I].Name) = 0 then begin AFound := True; Break; end; until not AFound; Result := S1; end; function ActiveBarControl: TCustomdxBarControl; begin Result := FActiveBarControl; end; function VisibleTodxBarVisible(Value: Boolean): TdxBarItemVisible; begin if Value then Result := ivAlways else Result := ivNever; end; function GetBarManagerByForm(AForm: TCustomForm): TdxBarManager; var I: Integer; begin Result := nil; if AForm = nil then Exit; if TCustomForm(AForm).Parent = nil then begin if Assigned(cxControls.cxGetParentFormForDocking) then AForm := cxControls.cxGetParentFormForDocking(AForm); end; if (AForm <> nil) and (dxBarManagerList <> nil) then for I := 0 to dxBarManagerList.Count - 1 do if dxBarManagerList[I].MainForm = AForm then begin Result := dxBarManagerList[I]; Break; end; end; function GetParentBarOrSubMenuForBar(Value: TCustomdxBarControl): TCustomdxBarControl; begin Result := Value; while (Result <> nil) and not Result.IsDestroying do if Result.ParentBar <> nil then Result := Result.ParentBar else if (Result is TdxBarSubMenuControl) and (TdxBarSubMenuControl(Result).FDropDownButton <> nil) then Result := TdxBarSubMenuControl(Result).FDropDownButton.Parent else Break; end; function GetParentBarForBar(Value: TCustomdxBarControl): TCustomdxBarControl; begin Result := GetParentBarOrSubMenuForBar(Value); if Result is TdxBarSubMenuControl then Result := nil; end; function GetParentBarOrSubMenuForControl(Value: TdxBarItemControl): TCustomdxBarControl; begin if Value = nil then Result := nil else Result := GetParentBarOrSubMenuForBar(Value.Parent); end; function GetParentBarForControl(Value: TdxBarItemControl): TCustomdxBarControl; begin Result := GetParentBarOrSubMenuForControl(Value); if Result is TdxBarSubMenuControl then Result := nil; end; function FindVCLControl(Wnd: HWND): TWinControl; begin repeat Result := FindControl(Wnd); if Result <> nil then Break; Wnd := GetParent(Wnd); until Wnd = 0; end; function HasAsParent(Wnd: HWND; ParentWnd: HWND): Boolean; begin repeat Wnd := GetParent(Wnd); Result := Wnd = ParentWnd; if (Wnd = 0) or Result then Break; until False; end; function WindowFromPointEx(P: TPoint): HWND; function FindOne(Wnd: HWND; P: TPoint): HWND; begin Result := ChildWindowFromPointEx(Wnd, P, CWP_SKIPINVISIBLE); if Result = 0 then Result := Wnd else if Result <> Wnd then begin MapWindowPoints(Wnd, Result, P, 1); Result := FindOne(Result, P); end; end; begin Result := WindowFromPoint(P); if Result <> 0 then begin ScreenToClient(Result, P); Result := FindOne(Result, P); end; end; function GetTextOf(const S: string): string; var I: Integer; begin Result := S; I := 1; while I < Length(Result) do begin if Result[I] = '&' then Delete(Result, I, 1); Inc(I); end; end; procedure DrawItemArrow(DC: HDC; R: TRect; ArrowType: TdxArrowType; Enabled, Selected, Flat: Boolean); var Size: Integer; begin if ArrowType = atRight then Size := R.Bottom - R.Top - 6 else // atDown Size := R.Right - R.Left - 8; Size := (Size - 1) div 2 + Byte(Size mod 2 <> 0); if Size < 3 then Size := 3; DrawLargeItemArrow(DC, R, ArrowType, Size, Selected, Enabled, Flat); end; procedure DrawLargeItemArrow(DC: HDC; R: TRect; ArrowType: TdxArrowType; Size: Integer; Selected, Enabled, Flat: Boolean); var Color: COLORREF; X, Y: Integer; P: array[1..3] of TPoint; Pen: HPEN; Brush: HBRUSH; procedure DrawEnabled; begin with R do if ArrowType = atRight then begin X := (Left + Right - Size) div 2; Y := (Top + Bottom - (2 * Size - 1)) div 2; P[1] := Point(X, Y); P[2] := Point(X, Y + 2 * Size - 2); end else // atDown begin X := (Left + Right - (2 * Size - 1)) div 2; Y := (Top + Bottom - Size) div 2; P[1] := Point(X, Y); P[2] := Point(X + 2 * Size - 2, Y); end; P[3] := Point(X + Size - 1, Y + Size - 1); Pen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(Color))); Brush := SelectObject(DC, GetSysColorBrush(Color)); Polygon(DC, P, 3); SelectObject(DC, Brush); DeleteObject(SelectObject(DC, Pen)); end; procedure DrawDisabled; begin Pen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT))); if ArrowType = atRight then begin MoveToEx(DC, X + Size - 1, Y + Size, nil); LineTo(DC, X, Y + 2 * Size - 1); MoveToEx(DC, X + Size, Y + Size, nil); LineTo(DC, X, Y + 2 * Size); end else begin MoveToEx(DC, X + Size, Y + Size - 1, nil); LineTo(DC, X + 2 * Size - 1, Y); MoveToEx(DC, X + Size, Y + Size, nil); LineTo(DC, X + 2 * Size, Y); end; DeleteObject(SelectObject(DC, Pen)); end; begin if Enabled then if Selected then begin if IsHighContrastWhite then Color := COLOR_BTNFACE // White else Color := COLOR_HIGHLIGHTTEXT; end else Color := COLOR_BTNTEXT else Color := COLOR_BTNSHADOW; DrawEnabled; if not Enabled and not Flat then DrawDisabled; end; procedure FrameFlatSelRect(DC: HDC; const R: TRect); begin FrameRect(DC, R, GetSysColorBrush(COLOR_HIGHLIGHT)); end; { items global functions } function GetWorkArea(const P: TPoint): TRect; begin Result := GetDesktopWorkArea(P); end; procedure CheckEditWidth(var Value: Integer); begin if Value < MinEditWidth then Value := MinEditWidth; end; function IsRealVertical(ABarControl: TCustomdxBarControl): Boolean; begin Result := ABarControl is TdxBarControl and TdxBarControl(ABarControl).Vertical; end; function IsVertical(ABarControl: TCustomdxBarControl): Boolean; begin Result := IsRealVertical(ABarControl) and TdxBarControl(ABarControl).Bar.RotateWhenVertical; end; procedure RefreshDeviceConsts; var DC: Integer; begin DC := GetDC(0); try BitsPerPixel := GetDeviceCaps(DC, BITSPIXEL); finally ReleaseDC(0, DC); end; end; procedure CreatePatternBrush; var Pattern: TBitmap; X, Y: Integer; begin Pattern := TBitmap.Create; with Pattern, Canvas do begin Width := 8; Height := 8; Brush.Color := GetSysColor(COLOR_BTNHIGHLIGHT); FillRect(Rect(0, 0, Width, Height)); for Y := 0 to 7 do for X := 0 to 7 do if (Y mod 2) = (X mod 2) then Pixels[X, Y] := GetSysColor(COLOR_BTNFACE); end; if PatternBrush <> 0 then DeleteObject(PatternBrush); PatternBrush := Windows.CreatePatternBrush(Pattern.Handle); Pattern.Free; end; procedure DrawVerticalGradient(Canvas: TCanvas; const ARect: TRect; FromR, ToR, FromG, ToG, FromB, ToB: Byte); var SR: TRect; H, I: Integer; R, G, B: Byte; begin SR := ARect; with ARect do H := Bottom - Top; for I := 0 to 255 do begin SR.Bottom := ARect.Top + MulDiv(I + 1, H, 256); with Canvas do begin R := FromR + MulDiv(I, ToR - FromR, 255); G := FromG + MulDiv(I, ToG - FromG, 255); B := FromB + MulDiv(I, ToB - FromB, 255); Brush.Color := RGB(R, G, B); FillRect(SR); end; SR.Top := SR.Bottom; end; end; procedure TransparentDraw(DrawDC: HDC; Brush: HBRUSH; FullRect, R: TRect; ABitmap: TBitmap; AImages: TCurImageList; AImageIndex: Integer; AEnabled, AGrayScale, AFlat, ASelected, ADown, APressed, AShadow, ATransparent: Boolean; AFadedColor: TColor; ImageListBkColor: TColor); const ROP_DSPDxax = $00E20746; AndOrBitBltFlags: array[Boolean] of DWORD = (MERGEPAINT, SRCAND); BitBltFlags: array[Boolean] of DWORD = (SRCINVERT, ROP_DSPDxax); type // PColors = ^TColors; // TColors = array[0..MaxInt - 1] of Byte; TColors = array of Byte; var W, H, BW, BH, X, Y: Integer; DC, BDC, MaskDC: HDC; B, BitmapHandle, PrevBitmapHandle, MaskHandle: HBITMAP; PrevPalette: HPALETTE; BI: TBitmapInfo; ATransparentColor, ATextColor, ABackColor: COLORREF; ABrush: HBRUSH; function GetBitmapColors(ABitmap: HBITMAP): TColors; begin with BI.bmiHeader do begin biSize := SizeOf(BI.bmiHeader); biWidth := BW; biHeight := -BH; biPlanes := 1; biBitCount := 32; biCompression := BI_RGB; // GetMem(Result, 4 * BW * BH); SetLength(Result, 4 * BW * BH); GetDIBits(DrawDC, ABitmap, 0, BH, Result, BI, DIB_RGB_COLORS); end; end; procedure SetBitmapColors(ABitmap: HBITMAP; AColors: TColors); begin SetDIBits(DrawDC, ABitmap, 0, BH, AColors, BI, DIB_RGB_COLORS); // FreeMem(AColors); end; procedure CreateGrayScaleBitmap; var Colors: TColors; I, J, K: Integer; AColor: COLORREF; begin Colors := GetBitmapColors(BitmapHandle); try for I := 0 to BW - 1 do for J := 0 to BH - 1 do begin K := (J * BW + I) * 4; AColor := (Colors[K] + Colors[K + 1] + Colors[K + 2]) div 3; Colors[K] := AColor; Colors[K + 1] := AColor; Colors[K + 2] := AColor; end; finally SetBitmapColors(BitmapHandle, Colors); end; end; procedure CreateFadedBitmap; var Colors: TColors; I, J, K, P1, P2, AColor: Integer; R, G, B: Byte; begin Colors := GetBitmapColors(BitmapHandle); try R := GetRValue(AFadedColor); G := GetGValue(AFadedColor); B := GetBValue(AFadedColor); P1 := 192; // P1 := 100; P2 := 64; for I := 0 to BW - 1 do for J := 0 to BH - 1 do begin K := (J * BW + I) * 4; AColor := (77 * Colors[K] + 151 * Colors[K + 1] + 28 * Colors[K + 2]) div 256; AColor := (AColor * P1 + 255 * (256 - P1)) div 256; Colors[K] := (P2 * AColor + (256 - P2) * B) div 256; Colors[K + 1] := (P2 * AColor + (256 - P2) * G) div 256; Colors[K + 2] := (P2 * AColor + (256 - P2) * R) div 256; end; finally SetBitmapColors(BitmapHandle, Colors); end; end; procedure MakeBitmapDingy; var Colors: TColors; I, J, K: Integer; procedure LightColor(var AColor: Byte); begin Inc(AColor, MulDiv(255 - AColor, 3, 10)); end; begin Colors := GetBitmapColors(BitmapHandle); try for I := 0 to BW - 1 do for J := 0 to BH - 1 do begin K := (J * BW + I) * 4; LightColor(Colors[K]); LightColor(Colors[K + 1]); LightColor(Colors[K + 2]); end; finally SetBitmapColors(BitmapHandle, Colors); end; end; procedure DrawShadow; var LogBrush: TLogBrush; begin GetObject(Brush, SizeOf(LogBrush), @LogBrush); ATextColor := SetTextColor(DC, GetSysColor(COLOR_BTNSHADOW)); ABackColor := SetBkColor(DC, LogBrush.lbColor); ABrush := SelectObject(DC, Brush); StretchBlt(DC, X + ImageShadowSize, Y + ImageShadowSize, W, H, MaskDC, 0, 0, BW, BH, SRCCOPY); SelectObject(DC, ABrush); SetTextColor(DC, ATextColor); SetBkColor(DC, ABackColor); end; function InvertImage: Boolean; begin Result := not AGrayScale and not (AFlat and ASelected) and (GetSysColor(COLOR_BTNFACE) = 0); end; var AFaded: Boolean; begin AFaded := AFadedColor <> clNone; if AFaded then AFadedColor := ColorToRGB(AFadedColor); with R do begin W := Right - Left; H := Bottom - Top; if (ABitmap = nil) or ABitmap.Empty then begin BW := AImages.Width; BH := AImages.Height; end else begin BW := ABitmap.Width; BH := ABitmap.Height; end; OffsetRect(R, -FullRect.Left, -FullRect.Top); DC := CreateCompatibleDC(DrawDC); with FullRect do B := CreateCompatibleBitmap(DrawDC, Right - Left, Bottom - Top); B := SelectObject(DC, B); PrevPalette := SelectPalette(DC, GetCurrentObject(DrawDC, OBJ_PAL), True); RealizePalette(DC); try with FullRect do if ATransparent then BitBlt(DC, 0, 0, Right - Left, Bottom - Top, DrawDC, Left, Top, SRCCOPY) else FillRect(DC, Rect(0, 0, Right - Left, Bottom - Top), Brush); if AEnabled or AFaded then begin BDC := CreateCompatibleDC(DrawDC); BitmapHandle := CreateCompatibleBitmap(DrawDC, BW, BH); PrevBitmapHandle := SelectObject(BDC, BitmapHandle); try if (ABitmap = nil) or ABitmap.Empty then begin ABrush := CreateSolidBrush(ColorToRGB(ImageListBkColor)); FillRect(BDC, Rect(0, 0, BW, BH), ABrush); DeleteObject(ABrush); ImageList_Draw(AImages.Handle, AImageIndex, BDC, 0, 0, ILD_NORMAL); end else BitBlt(BDC, 0, 0, BW, BH, ABitmap.Canvas.Handle, 0, 0, SRCCOPY); ATransparentColor := GetPixel(BDC, 0, BH - 1); MaskDC := CreateCompatibleDC(DrawDC); MaskHandle := CreateBitmap(BW, BH, 1, 1, nil); MaskHandle := SelectObject(MaskDC, MaskHandle); try ABackColor := SetBkColor(BDC, ATransparentColor); BitBlt(MaskDC, 0, 0, BW, BH, BDC, 0, 0, SRCCOPY); SetBkColor(BDC, ABackColor); if not AEnabled and AFaded then CreateFadedBitmap else if AGrayScale then CreateGrayScaleBitmap; if (AEnabled or not AFaded) and AFlat and not ASelected and not ADown and not AGrayScale and dxBarMakeInactiveImagesDingy and (BitsPerPixel > 8) then MakeBitmapDingy; X := Left; Y := Top; if AFlat and AShadow and ASelected and not APressed {and not ADown} then begin Dec(X, ImageShadowSize div 2); Dec(Y, ImageShadowSize div 2); DrawShadow; end; StretchBlt(DC, X, Y, W, H, MaskDC, 0, 0, BW, BH, AndOrBitBltFlags[InvertImage]); BitBlt(BDC, 0, 0, BW, BH, MaskDC, 0, 0, SRCPAINT); StretchBlt(DC, X, Y, W, H, BDC, 0, 0, BW, BH, AndOrBitBltFlags[not InvertImage]); finally DeleteObject(SelectObject(MaskDC, MaskHandle)); DeleteDC(MaskDC); end; finally SelectObject(BDC, PrevBitmapHandle); DeleteObject(BitmapHandle); DeleteDC(BDC); end end else begin MaskDC := CreateCompatibleDC(DrawDC); MaskHandle := CreateBitmap(BW, BH, 1, 1, nil); MaskHandle := SelectObject(MaskDC, MaskHandle); try if (ABitmap = nil) or ABitmap.Empty then begin FillRect(MaskDC, Rect(0, 0, BW, BH), GetStockObject(WHITE_BRUSH)); ImageList_Draw(AImages.Handle, AImageIndex, MaskDC, 0, 0, ILD_NORMAL); end else begin BitBlt(MaskDC, 0, 0, BW, BH, ABitmap.Canvas.Handle, 0, 0, SRCCOPY); ABackColor := SetBkColor(ABitmap.Canvas.Handle, ColorToRGB(ABitmap.TransparentColor)); BitBlt(MaskDC, 0, 0, BW, BH, ABitmap.Canvas.Handle, 0, 0, BitBltFlags[IsWin95]); SetBkColor(ABitmap.Canvas.Handle, ABackColor); end; ATextColor := SetTextColor(DC, $FFFFFF); ABackColor := SetBkColor(DC, 0); ABrush := SelectObject(DC, GetSysColorBrush(COLOR_BTNHIGHLIGHT)); if not AFlat then StretchBlt(DC, Left + 1, Top + 1, W, H, MaskDC, 0, 0, BW, BH, ROP_DSPDxax); SelectObject(DC, GetSysColorBrush(COLOR_BTNSHADOW)); StretchBlt(DC, Left, Top, W, H, MaskDC, 0, 0, BW, BH, ROP_DSPDxax); SelectObject(DC, ABrush); SetTextColor(DC, ATextColor); SetBkColor(DC, ABackColor); finally DeleteObject(SelectObject(MaskDC, MaskHandle)); DeleteDC(MaskDC); end; end; with FullRect do BitBlt(DrawDC, Left, Top, Right - Left, Bottom - Top, DC, 0, 0, SRCCOPY); finally SelectPalette(DC, PrevPalette, False); DeleteObject(SelectObject(DC, B)); DeleteDC(DC); end; end; end; { procedure TransparentDrawEx(DrawDC: HDC; SourceDC: HDC; R: TRect; Brush: HBRUSH); const ROP_DSPDxax = $00E20746; CopyBitBltFlags: array[Boolean] of DWORD = (SRCCOPY, NOTSRCCOPY); var W, H: Integer; MaskDC: HDC; MaskHandle: HBITMAP; PrevPalette: HPALETTE; ATextColor, ABackColor: COLORREF; ABrush: HBRUSH; begin with R do begin W := Right - Left; H := Bottom - Top; PrevPalette := SelectPalette(SourceDC, GetCurrentObject(DrawDC, OBJ_PAL), True); RealizePalette(SourceDC); try MaskDC := CreateCompatibleDC(DrawDC); MaskHandle := CreateBitmap(W, H, 1, 1, nil); MaskHandle := SelectObject(MaskDC, MaskHandle); try ABackColor := SetBkColor(SourceDC, GetPixel(SourceDC, 0, H - 1)); BitBlt(MaskDC, 0, 0, W, H, SourceDC, 0, 0, SRCCOPY); SetBkColor(SourceDC, ABackColor); StretchBlt(DrawDC, Left, Top, W, H, SourceDC, 0, 0, W, H, CopyBitBltFlags[(GetSysColor(COLOR_BTNFACE) = 0)]); ATextColor := SetTextColor(DrawDC, 0); ABackColor := SetBkColor(DrawDC, $FFFFFF); ABrush := SelectObject(DrawDC, Brush); StretchBlt(DrawDC, Left, Top, W, H, MaskDC, 0, 0, W, H, ROP_DSPDxax); SelectObject(DrawDC, ABrush); SetTextColor(DrawDC, ATextColor); SetBkColor(DrawDC, ABackColor); finally DeleteObject(SelectObject(MaskDC, MaskHandle)); DeleteDC(MaskDC); end; finally SelectPalette(SourceDC, PrevPalette, False); end; end; end; } { toolbars global function } {function SMCaptionY: Integer; begin Result := GetSystemMetrics(SM_CYSMCAPTION); end; } procedure ProcessMouseMessages; var Msg: TMsg; begin while PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_NOREMOVE) do begin case Integer(GetMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST)) of -1: Break; 0: begin PostQuitMessage(Msg.wParam); Break; end; end; DispatchMessage(Msg); end; end; procedure ProcessPaintMessages; var Msg: TMsg; begin while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_NOREMOVE) do begin case Integer(GetMessage(Msg, 0, WM_PAINT, WM_PAINT)) of -1: Break; 0: begin PostQuitMessage(Msg.wParam); Break; end; end; DispatchMessage(Msg); end; end; type TPlaySoundType = (psMenuPopup, psMenuCommand, psStopPlay); procedure PlaySound(APlaySoundType: TPlaySoundType); const PlaySounds: array[TPlaySoundType] of PChar = ('MenuPopup', 'MenuCommand', nil); begin if dxBarPlaySound then MMSystem.PlaySound(PlaySounds[APlaySoundType], 0, SND_ALIAS or SND_ASYNC or SND_NODEFAULT {or SND_NOSTOP }or SND_NOWAIT); end; procedure InitMMSystem; begin PlaySound(psStopPlay); end; procedure CreateEditFontHandle(Font: TFont; var EditFontHandle: HFONT; Scaled: Boolean); var SystemLogFont, LogFont: TLogFont; begin if EditFontHandle <> 0 then DeleteObject(EditFontHandle); if Scaled then begin SystemParametersInfo(SPI_GETICONTITLELOGFONT, SizeOf(SystemLogFont), @SystemLogFont, 0); GetObject(Font.Handle, SizeOf(LogFont), @LogFont); LogFont.lfHeight := SystemLogFont.lfHeight; with LogFont do if lfHeight > -11 then lfHeight := -11; EditFontHandle := CreateFontIndirect(LogFont); end else EditFontHandle := CloneFont(Font.Handle); end; function CloneFont(Source: HFONT): HFONT; var LogFont: TLogFont; begin GetObject(Source, SizeOf(LogFont), @LogFont); Result := CreateFontIndirect(LogFont); end; procedure RestoreClipRgn(DC: HDC; var AClipRgn: HRGN; var AClipRgnExists: Boolean); begin if AClipRgnExists then SelectClipRgn(DC, AClipRgn) else SelectClipRgn(DC, 0); DeleteObject(AClipRgn); end; procedure SaveClipRgn(DC: HDC; var AClipRgn: HRGN; var AClipRgnExists: Boolean); begin AClipRgn := CreateRectRgn(0, 0, 0, 0); AClipRgnExists := GetClipRgn(DC, AClipRgn) = 1; end; procedure AddClipRect(DC: HDC; const R: TRect); var ARgn: HRGN; begin with R do ARgn := CreateRectRgn(Left, Top, Right, Bottom); ExtSelectClipRgn(DC, ARgn, RGN_OR); DeleteObject(ARgn); end; procedure ExcludeRect(var MainRgn: HRGN; const R: TRect); var TempRgn: HRGN; begin TempRgn := CreateRectRgnIndirect(R); CombineRgn(MainRgn, MainRgn, TempRgn, RGN_DIFF); DeleteObject(TempRgn); end; function GetRealColor(AColor: COLORREF): COLORREF; var DC: HDC; begin DC := GetDC(0); Result := GetNearestColor(DC, AColor); ReleaseDC(0, DC); end; procedure FillBackgroundRect(DC: HDC; ADestR, ASourceR: TRect; ABrush: HBRUSH; AColor: TColor; ABitmap: TBitmap); var ABrushExist: Boolean; begin if (ABitmap <> nil) and not ABitmap.Empty then FillRectByBitmap(DC, ADestR, ASourceR, ABitmap) else begin ABrushExist := ABrush <> 0; if not ABrushExist then ABrush := CreateSolidBrush(ColorToRGB(AColor)); FillRect(DC, ADestR, ABrush); if not ABrushExist then DeleteObject(ABrush); end; end; procedure FillRectByBitmap(DC: HDC; ADestR, ASourceR: TRect; ABitmap: TBitmap); var W, H, RW, RH: Integer; I, J, XStart, XEnd, YStart, YEnd, X, Y: Integer; AClipRgn: HRGN; AClipRgnExists: Boolean; begin W := ABitmap.Width; H := ABitmap.Height; RW := ASourceR.Right - ASourceR.Left; RH := ASourceR.Bottom - ASourceR.Top; if (W = 0) or (H = 0) or (RW = 0) or (RH = 0) then Exit; XStart := ASourceR.Left div W; XEnd := (ASourceR.Right - 1) div W; YStart := ASourceR.Top div H; YEnd := (ASourceR.Bottom - 1) div H; SaveClipRgn(DC, AClipRgn, AClipRgnExists); with ADestR do IntersectClipRect(DC, Left, Top, Right, Bottom); for J := YStart to YEnd do for I := XStart to XEnd do begin Y := J * H - (ASourceR.Top - ADestR.Top); X := I * W - (ASourceR.Left - ADestR.Left); BitBlt(DC, X, Y, W, H, ABitmap.Canvas.Handle, 0, 0, SRCCOPY); end; RestoreClipRgn(DC, AClipRgn, AClipRgnExists); end; { mouse tracking functions } var FMouseTrackingWnd: HWND; FMouseTrackingTimerID: UINT; function MouseTracking(AWnd: HWND): Boolean; var Event: TTrackMouseEvent; begin if @TrackMouseEvent <> nil then begin with Event do begin cbSize := SizeOf(Event); dwFlags := TME_QUERY; hwndTrack := AWnd; end; TrackMouseEvent(Event); Result := Event.dwFlags and TME_LEAVE <> 0; end else Result := AWnd = FMouseTrackingWnd; end; procedure FinishMouseTracking(AWnd: HWND); var Event: TTrackMouseEvent; begin if MouseTracking(AWnd) then begin if @TrackMouseEvent <> nil then begin with Event do begin cbSize := SizeOf(Event); dwFlags := TME_LEAVE or TME_CANCEL; hwndTrack := AWnd; end; TrackMouseEvent(Event); end else begin KillTimer(0, FMouseTrackingTimerID); FMouseTrackingTimerID := 0; FMouseTrackingWnd := 0; end; SendMessage(AWnd, WM_MOUSELEAVE, 0, 0); end; end; procedure MouseTrackingTimerProc(Wnd: HWND; Msg: UINT; idEvent: UINT; Time: DWORD); stdcall; var P: TPoint; begin GetCursorPos(P); Wnd := WindowFromPointEx(P); if Wnd <> FMouseTrackingWnd then FinishMouseTracking(FMouseTrackingWnd); end; procedure StartMouseTracking(AWnd: HWND); var Event: TTrackMouseEvent; begin if not MouseTracking(AWnd) then if @TrackMouseEvent <> nil then begin with Event do begin cbSize := SizeOf(Event); dwFlags := TME_LEAVE; hwndTrack := AWnd; end; TrackMouseEvent(Event); end else begin if FMouseTrackingWnd <> 0 then FinishMouseTracking(FMouseTrackingWnd); FMouseTrackingWnd := AWnd; FMouseTrackingTimerID := SetTimer(0, 0, 50, @MouseTrackingTimerProc); end; end; { internal item list } procedure ClearInternalItemList; var I: Integer; begin with InternalItemList do for I := Count - 1 downto 0 do with TdxBarItem(Items[I]) do if not HasControls then Free; end; { test of mouse keys pressing } function LeftButtonPressed: Boolean; begin if GetSystemMetrics(SM_SWAPBUTTON) = 0 then Result := GetAsyncKeyState(VK_LBUTTON) < 0 else Result := GetAsyncKeyState(VK_RBUTTON) < 0; end; function RightButtonPressed: Boolean; begin if GetSystemMetrics(SM_SWAPBUTTON) = 0 then Result := GetAsyncKeyState(VK_RBUTTON) < 0 else Result := GetAsyncKeyState(VK_LBUTTON) < 0; end; procedure DrawSizeGrip(DC: HDC; R: TRect); const ROP_DSPDxax = $00E20746; var APrevBitmap, ATempBitmap, AMaskBitmap: HBITMAP; TempDC, MDC, MaskDC: HDC; W, H: Integer; APrevBkColor: COLORREF; begin W := R.Right - R.Left; H := R.Bottom - R.Top; TempDC := CreateCompatibleDC(DC); ATempBitmap := SelectObject(TempDC, CreateCompatibleBitmap(DC, W, H)); try BitBlt(TempDC, 0, 0, W, H, DC, R.Left, R.Top, SRCCOPY); // 1 MDC := CreateCompatibleDC(DC); APrevBitmap := SelectObject(MDC, CreateCompatibleBitmap(DC, W, H)); DrawFrameControl(MDC, Rect(0, 0, W, H), DFC_SCROLL, DFCS_SCROLLSIZEGRIP); // 2 MaskDC := CreateCompatibleDC(DC); AMaskBitmap := SelectObject(MaskDC, CreateBitmap(W, H, 1, 1, nil)); try APrevBkColor := SetBkColor(MDC, ColorToRGB(clBtnFace)); //! BitBlt(MaskDC, 0, 0, W, H, MDC, 0, 0, SRCCOPY); SetBkColor(MDC, APrevBkColor); BitBlt(TempDC, 0, 0, W, H, MaskDC, 0, 0, MERGEPAINT); BitBlt(MDC, 0, 0, W, H, MaskDC, 0, 0, SRCPAINT); BitBlt(TempDC, 0, 0, W, H, MDC, 0, 0, SRCAND); finally DeleteObject(SelectObject(MaskDC, AMaskBitmap)); DeleteDC(MaskDC); end; DeleteObject(SelectObject(MDC, APrevBitmap)); DeleteDC(MDC); BitBlt(DC, R.Left, R.Top, W, H, TempDC, 0, 0, SRCCOPY); finally DeleteObject(SelectObject(TempDC, ATempBitmap)); DeleteDC(TempDC); end; end; { XP routines } function ThemeEditState(ABarEditControl: TdxBarEditControl): Integer; begin if not ABarEditControl.Enabled then Result := ETS_DISABLED else if ABarEditControl.ReadOnly then Result := ETS_READONLY else Result := ETS_NORMAL; end; function ThemeEditColor(ATheme: TdxTheme; AEditState: Integer): COLORREF; begin Result := GetSysColor(COLOR_WINDOW); if AEditState = ETS_DISABLED then begin if FAILED(GetThemeColor(ATheme, EP_EDITTEXT, AEditState, TMT_FILLCOLOR, Result)) then Result := GetSysColor(COLOR_WINDOW); end; end; function ThemeEditTextColor(ATheme: TdxTheme; AEditState: Integer): COLORREF; begin if FAILED(GetThemeColor(ATheme, EP_EDITTEXT, AEditState, TMT_TEXTCOLOR, Result)) then begin if AEditState = ETS_DISABLED then Result := GetSysColor(COLOR_GRAYTEXT) else Result := GetSysColor(COLOR_WINDOWTEXT); end; end; function ThemeToolbarColor: COLORREF; var ATheme: TdxTheme; begin ATheme := OpenTheme(totToolbar); if FAILED(GetThemeColor(ATheme, 0, 0, TMT_FILLCOLOR, Result)) then Result := COLOR_BTNFACE; end; function ThemeCloseButtonSize(DC: HDC): TSize; var ATheme: TdxTheme; begin ATheme := OpenTheme(totWindow); GetThemePartSize(ATheme, DC, WP_SMALLCLOSEBUTTON, CBS_NORMAL, nil, TS_TRUE, @Result); end; procedure ThemeDrawCloseButton(DC: HDC; var R: TRect; ASelected, APressed: Boolean; ACorner: TdxCorner); const ButtonStates: array [TdxBarMarkState] of Integer = (CBS_NORMAL, CBS_HOT, CBS_PUSHED); var ATheme: TdxTheme; AState, X: Integer; ASize: TSize; begin ATheme := OpenTheme(totWindow); if APressed then AState := CBS_PUSHED else if ASelected then AState := CBS_HOT else AState := CBS_NORMAL; ASize := ThemeCloseButtonSize(DC); if (R.Bottom - R.Top) > ASize.cy then X := ((R.Bottom - R.Top) - ASize.cy) div 2 else X := 0; with R do begin if ACorner in [coTopRight, coBottomRight] then begin Inc(Left, X); Right := Left + ASize.cx; end else begin Dec(Right, X); Left := Right - ASize.cx; end; Inc(Top, X); Bottom := Top + ASize.cy; end; FillRect(DC, R, GetSysColorBrush(COLOR_BTNFACE)); DrawThemeBackground(ATheme, DC, WP_SMALLCLOSEBUTTON, AState, @R); end; function ThemeSizeGripSize(DC: HDC): TSize; const Offset = 2; // ! var ATheme: TdxTheme; begin ATheme := OpenTheme(totScrollBar); GetThemePartSize(ATheme, DC, SBP_SIZEBOX, SZB_RIGHTALIGN, nil, TS_TRUE, @Result); Result.cx := Result.cx + Offset; Result.cy := Result.cy + Offset; end; procedure ThemeDrawSizeGrip(DC: HDC; var R: TRect; ACorner: TdxCorner); const Offset = 2; // ! Delta = 1; var ATheme: TdxTheme; AMirrorX, AMirrorY: Boolean; R1: TRect; AScrollBarSize: TSize; APrevBitmap: HBITMAP; MDC: HDC; X, Y: Integer; begin ATheme := OpenTheme(totScrollBar); AScrollBarSize := ThemeSizeGripSize(DC); with R do begin if ACorner in [coTopRight, coBottomRight] then Left := Right - AScrollBarSize.cx - Delta else Right := Left + AScrollBarSize.cx + Delta; if ACorner in [coBottomLeft, coBottomRight] then Top := Bottom - AScrollBarSize.cy else Bottom := Top + AScrollBarSize.cy; AMirrorX := ACorner in [coTopLeft, coBottomLeft]; AMirrorY := ACorner in [coTopLeft, coTopRight]; end; FillRect(DC, R, GetSysColorBrush(COLOR_BTNFACE)); R1 := R; with R1 do begin if AMirrorX then Dec(Right, Offset) else Inc(Left, Offset); if AMirrorY then Dec(Bottom, Offset) else Inc(Top, Offset); end; X := R1.Left; Y := R1.Top; OffsetRect(R1, -R1.Left, -R1.Top); MDC := CreateCompatibleDC(DC); APrevBitmap := SelectObject(MDC, CreateCompatibleBitmap(DC, R1.Right, R1.Bottom)); FillRect(MDC, R1, COLOR_BTNFACE + 1); DrawThemeBackground(ATheme, MDC, SBP_SIZEBOX, SZB_RIGHTALIGN, @R1); with R1 do StretchBlt(DC, X, Y, Right, Bottom, MDC, Byte(AMirrorX) * (Right - 1), Byte(AMirrorY) * (Bottom - 1), (2 * Byte(not AMirrorX) - 1) * Right, (2 * Byte(not AMirrorY) - 1) * Bottom, SRCCOPY); DeleteObject(SelectObject(MDC, APrevBitmap)); DeleteDC(MDC); end; { TdxBarToolbarsPopup } type TdxBarToolbarsPopup = class(TdxBarSubMenuControl) protected function GetIsCustomizing: Boolean; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; constructor TdxBarToolbarsPopup.Create(AOwner: TComponent); begin ClearInternalItemList; inherited Create(AOwner); FItemLinks := TdxBarItemLinks.Create(BarManager); FItemLinks.FOwner := Self; BarManager.CreateToolbarsPopupList(FItemLinks); FItemLinks.FBarControl := Self; end; destructor TdxBarToolbarsPopup.Destroy; begin Destroying; FItemLinks.Free; FItemLinks := nil; inherited Destroy; end; function TdxBarToolbarsPopup.GetIsCustomizing: Boolean; begin Result := False; end; procedure ShowToolbarsPopup(Sender: TCustomControl; ABarManager: TdxBarManager; P: TPoint); var ToolbarsPopup: TdxBarToolbarsPopup; begin ToolbarsPopup := TdxBarToolbarsPopup.Create(ABarManager); with ToolbarsPopup do if FItemLinks.Count = 0 then Free else begin ABarManager.HideAll; Left := P.X; Top := P.Y; FShowAnimation := True; Show; end; end; { TdxBarCustomizingPopup } type TdxBarCustomizingPopup = class(TdxBarSubMenuControl) private FStartIndex: Integer; procedure TextItemChange(Sender: TObject); procedure ItemClick(Sender: TObject); protected procedure DesignClick(ACode: Integer); procedure DoCloseUp; override; function GetIsCustomizing: Boolean; override; procedure LoadDesignItems(AItemLinks: TdxBarItemLinks); public constructor CreateEx(AOwner: TComponent; ACustomizingItemLinks: TdxBarItemLinks; ACustomizingItemLink: TdxBarItemLink); virtual; destructor Destroy; override; end; var FCustomizingPopupItemLink: TdxBarItemLink; FCustomizingPopupItemLinks: TdxBarItemLinks; FCreatingBarItem: Boolean; CustomizedPopup: TdxBarCustomizingPopup; function dxBarCustomizingPopup: TdxBarSubMenuControl; begin Result := CustomizedPopup; end; function dxBarCustomizingPopupItemLink: TdxBarItemLink; begin Result := FCustomizingPopupItemLink; end; // TODO: remove to designer constructor TdxBarCustomizingPopup.CreateEx(AOwner: TComponent; ACustomizingItemLinks: TdxBarItemLinks; ACustomizingItemLink: TdxBarItemLink); var ResStrs: array[-4..9] of string; FItemCount: Integer; I, J: Integer; AItem: TdxBarItem; ASubItem: TdxBarSubItem; AItemLink: TdxBarItemLink; AEmptyBar: Boolean; CCPS: Boolean; begin ResStrs[-4] := cxGetResourceString(@dxSBAR_CP_ADDSUBITEM); ResStrs[-3] := cxGetResourceString(@dxSBAR_CP_ADDBUTTON); ResStrs[-2] := cxGetResourceString(@dxSBAR_CP_ADDITEM); ResStrs[-1] := cxGetResourceString(@dxSBAR_CP_DELETEBAR); ResStrs[0] := cxGetResourceString(@dxSBAR_CP_RESET); ResStrs[1] := cxGetResourceString(@dxSBAR_CP_DELETE); ResStrs[2] := cxGetResourceString(@dxSBAR_CP_NAME); ResStrs[3] := cxGetResourceString(@dxSBAR_CP_DEFAULTSTYLE); ResStrs[4] := cxGetResourceString(@dxSBAR_CP_TEXTONLYALWAYS); ResStrs[5] := cxGetResourceString(@dxSBAR_CP_TEXTONLYINMENUS); ResStrs[6] := cxGetResourceString(@dxSBAR_CP_IMAGEANDTEXT); ResStrs[7] := cxGetResourceString(@dxSBAR_CP_BEGINAGROUP); ResStrs[8] := cxGetResourceString(@dxSBAR_CP_VISIBLE); ResStrs[9] := cxGetResourceString(@dxSBAR_CP_MOSTRECENTLYUSED); ClearInternalItemList; inherited Create(AOwner); FCustomizingPopupItemLinks := ACustomizingItemLinks; FCustomizingPopupItemLink := ACustomizingItemLink; FShowAnimation := False; FItemLinks := TdxBarItemLinks.Create(BarManager); FItemLinks.FOwner := Self; // create items FItemCount := 8; AEmptyBar := False; if BarManager.Designing then begin FStartIndex := 4; if FCustomizingPopupItemLink = nil then begin FItemCount := 0; AEmptyBar := FCustomizingPopupItemLinks.BarControl is TdxBarControl; end else Inc(FItemCount, 1 + Byte(BarManager.CanShowRecentItems)); end else FStartIndex := 0; J := -FStartIndex; for I := J to FItemCount - 1 do begin if (I = -1) and not AEmptyBar then begin Dec(FStartIndex); Continue; end; if I = -2 then begin ASubItem := TdxBarSubItem.Create(nil); ASubItem.FIsInternal := True; InternalItemList.Add(ASubItem); LoadDesignItems(ASubItem.ItemLinks); end else if I = 2 then InternalItemList.Add(TdxBarEdit.Create(nil)) else InternalItemList.Add(TdxBarButton.Create(nil)); AItem := TdxBarItem(InternalItemList.Last); with AItem do begin if (I = 2) and BarManager.Designing then Caption := cxGetResourceString(@dxSBAR_CP_CAPTION) else Caption := ResStrs[I]; Tag := (I); OnClick := ItemClick; if I in [3..6, 7, 8, 9] then with TdxBarButton(InternalItemList.Last) do begin ButtonStyle := bsChecked; if I in [3..6] then GroupIndex := dxBarCustomizingPopupPaintStyleGroupIndex; end; end; AItemLink := FItemLinks.Add; if (I in [0, 2, 3, 7]) or (I = -1) then AItemLink.BeginGroup := True; AItemLink.Item := AItem; end; FItemLinks.FBarControl := Self; // prepare if FItemCount > 0 then // not AEmptyBar begin with TdxBarEdit(ItemLinks[FStartIndex + 2].Item) do begin Text := FCustomizingPopupItemLink.Caption; FOnChange := TextItemChange; end; CCPS := (FCustomizingPopupItemLink.Item is TdxBarButton) and TdxBarButton(FCustomizingPopupItemLink.Item).CanChangePaintStyle; for I := 3 to 6 do with TdxBarButton(ItemLinks[FStartIndex + I].Item) do begin Enabled := CCPS; Down := CCPS and (Ord(FCustomizingPopupItemLink.PaintStyle) = I - 3) or (not CCPS and (I = 3)); end; with TdxBarButton(ItemLinks[FStartIndex + 7].Item) do begin Enabled := FCustomizingPopupItemLink.Index > 0; Down := FCustomizingPopupItemLink.BeginGroup; end; if ItemLinks.Count > (FStartIndex + 8) then with TdxBarButton(ItemLinks[FStartIndex + 8].Item) do Down := FCustomizingPopupItemLink.Visible; if ItemLinks.Count > (FStartIndex + 9) then with TdxBarButton(ItemLinks[FStartIndex + 9].Item) do Down := FCustomizingPopupItemLink.MostRecentlyUsed; end; BarManager.DoShowCustomizingPopup(FItemLinks); end; destructor TdxBarCustomizingPopup.Destroy; begin Destroying; FItemLinks.Free; inherited Destroy; end; procedure TdxBarCustomizingPopup.TextItemChange(Sender: TObject); begin if TdxBarEdit(Sender).Text = '' then begin if dxBarCustomizingPopup <> nil then dxBarCustomizingPopup.Hide; Application.MessageBox(PChar(cxGetResourceString(@dxSBAR_COMMANDNAMECANNOTBEBLANK)), PChar(Application.Title), MB_ICONSTOP); end else if BarManager.Designing then begin FCustomizingPopupItemLink.Item.Caption := TdxBarEdit(Sender).Text; BarManager.DesignerModified; end else FCustomizingPopupItemLink.UserCaption := TdxBarEdit(Sender).Text; end; procedure TdxBarCustomizingPopup.ItemClick(Sender: TObject); var ATag: Integer; begin ATag := (TComponent(Sender).Tag); if ATag < 0 then begin FCreatingBarItem := True; try DesignClick(ATag); finally FCreatingBarItem := False; end; end else case ATag of 0: FCustomizingPopupItemLink.UserDefine := []; 1: begin FCustomizingPopupItemLink.Free; FCustomizingPopupItemLink := nil; end; 3..6: FCustomizingPopupItemLink.UserPaintStyle := TdxBarPaintStyle((TComponent(Sender).Tag) - 3); 7: with FCustomizingPopupItemLink do BeginGroup := not BeginGroup; 8: with FCustomizingPopupItemLink do Visible := not Visible; 9: with FCustomizingPopupItemLink do MostRecentlyUsed := not MostRecentlyUsed; end; end; procedure TdxBarCustomizingPopup.DesignClick(ACode: Integer); var ABar: TdxBar; ABarManager: TdxBarManager; ABarItemClass: TdxBarItemClass; AItem: TdxBarItem; AItemLink: TdxBarItemLink; AItemLinks: TdxBarItemLinks; ACategoryIndex: Integer; begin if ACode = -1 then begin if FCustomizingPopupItemLinks.BarControl is TdxBarControl then begin ABar := TdxBarControl(FCustomizingPopupItemLinks.BarControl).Bar; ABar.Free; FCustomizingPopupItemLinks := nil; FCustomizingPopupItemLink := nil; DeleteCustomizingBar(ABar); // update cust form end; Exit; end; if ACode = -4 then ABarItemClass := TdxBarSubItem else if ACode = -3 then ABarItemClass := TdxBarButton else if ACode <= -100 then ABarItemClass := dxBarVisibleItemClass(-(ACode + 100)) else Exit; AItemLinks := FCustomizingPopupItemLinks; ABarManager := AItemLinks.BarManager; AItem := ABarItemClass.Create(ABarManager.Owner); try // Category ACategoryIndex := ABarManager.Categories.IndexOf(dxSBAR_DEFAULTCATEGORYNAME); if ACategoryIndex = -1 then ACategoryIndex := 0; AItem.Category := ACategoryIndex; // Name AItem.Name := dxGenBarItemName(ABarManager, ABarItemClass); // Caption AItem.Caption := 'New Item'; // put in toolbar AItemLinks.BeginUpdate; try AItemLink := AItemLinks.Add; AItemLink.Item := AItem; if FCustomizingPopupItemLink <> nil then AItemLink.Index := FCustomizingPopupItemLink.Index + 1; finally AItemLinks.EndUpdate; end; UpdateCustomizingCommands(AItem); if AItemLinks.BarControl <> nil then begin AItemLinks.BarControl.RepaintBar; // select if visible if not IsRectEmpty(AItemLinks.BarControl.GetItemRect(AItemLink.Control)) then AItemLinks.BarControl.SetKeySelectedItem(AItemLink.Control); end; except AItem.Free; raise; end; end; procedure TdxBarCustomizingPopup.DoCloseUp; begin if FCustomizingPopupItemLink <> nil then with FCustomizingPopupItemLink do if not BarManager.FIsCustomizing and (BarControl <> nil) and (BarControl.SelectedItem = Control) then begin BarManager.FSelectedItem := nil; BarControl.SelectedItem := nil; end; inherited; end; function TdxBarCustomizingPopup.GetIsCustomizing: Boolean; begin Result := False; end; procedure TdxBarCustomizingPopup.LoadDesignItems(AItemLinks: TdxBarItemLinks); var I: Integer; AItem: TdxBarButton; AItemLink: TdxBarItemLink; begin for I := 0 to dxBarVisibleItemCount - 1 do begin AItem := TdxBarButton.Create(nil); AItem.Tag := (-100 - I); AItem.Caption := dxBarVisibleItemClass(I).ClassName; AItem.OnClick := ItemClick; AItemLink := AItemLinks.Add; AItemLink.Item := AItem; end; end; { TdxBarDropDownListBox } type TdxBarDropDownListBox = class(TCustomListBox) private FCombo: TdxBarCustomCombo; WaitForCapture: Boolean; procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP; procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT; protected procedure Click; override; procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; public constructor Create(AOwner: TComponent); override; property OnDrawItem; property OnMeasureItem; end; constructor TdxBarDropDownListBox.Create(AOwner: TComponent); begin inherited; BorderStyle := bsNone; Style := lbOwnerDrawVariable; Visible := False; end; procedure TdxBarDropDownListBox.WMCaptureChanged(var Message: TMessage); begin inherited; WaitForCapture := False; end; procedure TdxBarDropDownListBox.WMEraseBkgnd(var Message: TWMEraseBkgnd); begin Message.Result := 1; end; procedure TdxBarDropDownListBox.WMLButtonUp(var Message: TWMLButtonUp); var ACombo: TdxBarCustomCombo; AItemIndex: Integer; AItemLink, RealItemLink: TdxBarItemLink; begin inherited; if WaitForCapture then begin ReleaseCapture; Exit; end; ACombo := FCombo; AItemIndex := ItemIndex; AItemLink := ACombo.CurItemLink; RealItemLink := AItemLink.RealItemLink; if RealItemLink <> nil then begin RealItemLink.BringToTopInRecentList(True); RealItemLink.BarManager.HideAll; end else AItemLink.BarManager.HideAll; if AItemIndex > -1 then ACombo.ItemIndex := AItemIndex; end; procedure TdxBarDropDownListBox.WMNCCalcSize(var Message: TWMNCCalcSize); var ABorderSize: Integer; begin inherited; ABorderSize := FCombo.BarManager.PainterClass.DropDownListBoxBorderSize; InflateRect(Message.CalcSize_Params.rgrc[0], -ABorderSize, -ABorderSize); end; procedure TdxBarDropDownListBox.WMNCPaint(var Message: TWMNCPaint); var R: TRect; DC: HDC; begin inherited; GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top); DC := GetWindowDC(Handle); FCombo.BarManager.PainterClass.DropDownListBoxDrawBorder(FCombo.BarManager, DC, R); ReleaseDC(Handle, DC); end; procedure TdxBarDropDownListBox.Click; begin if ItemIndex > -1 then TdxBarComboControl(FCombo.CurItemLink.Control).LocalItemIndex := ItemIndex; end; procedure TdxBarDropDownListBox.CreateParams(var Params: TCreateParams); begin inherited; with Params do begin ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST; WindowClass.Style := WindowClass.Style or CS_SAVEBITS; end; end; procedure TdxBarDropDownListBox.CreateWnd; begin inherited; Font.Handle := CloneFont(FCombo.CurItemLink.BarControl.EditFontHandle); Font.Color := clWindowText; Canvas.Font := Font; Windows.SetParent(Handle, 0); CallWindowProc(DefWndProc, Handle, WM_SETFOCUS, 0, 0); end; procedure TdxBarDropDownListBox.KeyDown(var Key: Word; Shift: TShiftState); begin if (ItemIndex = -1) and (Items.Count > 0) then ItemIndex := TopIndex; inherited; end; procedure TdxBarDropDownListBox.MouseMove(Shift: TShiftState; X, Y: Integer); var I: Integer; begin if (GetCapture = Handle) and WaitForCapture and PtInRect(ClientRect, Point(X, Y)) then begin WaitForCapture := False; CallWindowProc(DefWndProc, Handle, WM_LBUTTONDOWN, 0, MAKELPARAM(X, Y)); end; inherited; I := ItemAtPos(Point(X, Y), True); if (0 <= I) and (I <= Items.Count - 1) then ItemIndex := I; end; { TdxBarQuickCustItem and TdxBarQuickCustItemControl } type TdxBarQuickCustItem = class(TdxBarButton) public procedure DoClick; override; end; TdxBarQuickCustItemControl = class(TdxBarButtonControl) private function GetLinkedItemLink: TdxBarItemLink; protected procedure ControlUnclick(ByMouse: Boolean); override; function GetCaption: string; override; function GetGlyph: TBitmap; override; function GetImageIndex: Integer; override; function GetImages(AInToolbar: Boolean): TCurImageList; override; function GetHint: string; override; function GetShortCut: TShortCut; override; function GetDefaultWidth: Integer; override; function IsDestroyOnClick: Boolean; override; procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override; property LinkedItemLink: TdxBarItemLink read GetLinkedItemLink; end; procedure TdxBarQuickCustItem.DoClick; var ItemLink: TdxBarItemLink; begin inherited; ItemLink := TdxBarItemLink(ClickItemLink.Data); with ItemLink do Visible := not Visible; end; function TdxBarQuickCustItemControl.GetLinkedItemLink: TdxBarItemLink; begin Result := TdxBarItemLink(FItemLink.Data); end; procedure TdxBarQuickCustItemControl.ControlUnclick(ByMouse: Boolean); begin inherited; Repaint; end; function TdxBarQuickCustItemControl.GetCaption: string; begin Result := LinkedItemLink.Caption; end; function TdxBarQuickCustItemControl.GetGlyph: TBitmap; begin Result := LinkedItemLink.Glyph; end; function TdxBarQuickCustItemControl.GetImageIndex: Integer; begin Result := LinkedItemLink.Item.ImageIndex; end; function TdxBarQuickCustItemControl.GetImages(AInToolbar: Boolean): TCurImageList; begin Result := LinkedItemLink.Item.GetCurImages; end; function TdxBarQuickCustItemControl.GetHint: string; begin Result := LinkedItemLink.Item.Hint; end; function TdxBarQuickCustItemControl.GetShortCut: TShortCut; begin Result := LinkedItemLink.Item.ShortCut; end; function TdxBarQuickCustItemControl.GetDefaultWidth: Integer; begin Result := inherited GetDefaultWidth; Inc(Result, GetDefaultHeight); end; function TdxBarQuickCustItemControl.IsDestroyOnClick: Boolean; begin Result := False; end; procedure TdxBarQuickCustItemControl.Paint(ARect: TRect; PaintType: TdxBarPaintType); var WholeR, R: TRect; DC: HDC; Selected: Boolean; begin WholeR := ARect; R := ARect; DC := Parent.Canvas.Handle; Selected := IsSelected; PainterClass.DrawQuickCustItemFrame(Self, DC, R, ARect, Selected); PainterClass.DrawGlyph(Self, R, nil, ptMenu, True, Selected, LinkedItemLink.Visible, False, False, False, False, False); inherited; PainterClass.DrawQuickCustItemFrameSelected(Self, DC, WholeR, R, Selected); end; { TdxBarQuickCustExtButtonControl } type TdxBarQuickCustExtButton = class(TdxBarButton); TdxBarQuickCustExtButtonControl = class(TdxBarButtonControl) protected function GetTextAreaOffset: Integer; override; function GetDefaultWidth: Integer; override; procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override; end; function TdxBarQuickCustExtButtonControl.GetTextAreaOffset: Integer; begin Result := inherited GetTextAreaOffset + GetDefaultHeight; end; function TdxBarQuickCustExtButtonControl.GetDefaultWidth: Integer; begin Result := inherited GetDefaultWidth; Inc(Result, GetDefaultHeight); end; procedure TdxBarQuickCustExtButtonControl.Paint(ARect: TRect; PaintType: TdxBarPaintType); var WholeR, R: TRect; DC: HDC; Selected: Boolean; begin WholeR := ARect; R := ARect; DC := Parent.Canvas.Handle; Selected := IsSelected; PainterClass.DrawQuickCustItemFrame(Self, DC, R, ARect, Selected); PainterClass.DrawGlyph(Self, R, nil, ptMenu, True, Selected, False, False, False, False, False, False); inherited; PainterClass.DrawQuickCustItemFrameSelected(Self, DC, WholeR, R, Selected); end; { TdxBarQuickControl } type TdxBarQuickSubItem = class(TdxBarSubItem) end; TdxBarQuickControl = class(TdxBarControl) private FAddRemoveSubItem: TdxBarQuickSubItem; FOwnerBar: TdxBarControl; FQuickCustItem: TdxBarQuickCustItem; procedure AddRemoveSubItemPopup(Sender: TObject); procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN; procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; protected function GetMainForm: TCustomForm; override; function GetToolbarBrush: HBRUSH; override; function HideOnClick: Boolean; override; function IsLinkedToOwner: Boolean; override; function IsInternal: Boolean; override; function GetOwnerControl: TWinControl; override; public constructor CreateWithOwnerBar(AOwner: TComponent; AOwnerBar: TdxBarControl); destructor Destroy; override; procedure CloseUp; procedure HideAll; override; procedure Popup(const OwnerR: TRect); end; var QuickCustBar: TdxBarQuickControl; HideQuickCustBarTimer: UINT; procedure FinishHideQuickCustBar; begin if HideQuickCustBarTimer <> 0 then begin KillTimer(0, HideQuickCustBarTimer); HideQuickCustBarTimer := 0; end; end; procedure HideQuickCustBarTimerProc(Wnd: HWND; Msg: UINT; idEvent: UINT; Time: DWORD); stdcall; begin FinishHideQuickCustBar; if (QuickCustBar <> nil) and (QuickCustBar.BarManager.SelectedItem <> nil) and (GetParentBarForControl(QuickCustBar.BarManager.SelectedItem) <> QuickCustBar) then try QuickCustBar.CloseUp; except end; end; procedure StartHideQuickCustBar; begin if HideQuickCustBarTimer = 0 then HideQuickCustBarTimer := SetTimer(0, 0, 200, @HideQuickCustBarTimerProc); end; constructor TdxBarQuickControl.CreateWithOwnerBar(AOwner: TComponent; AOwnerBar: TdxBarControl); var I: Integer; ItemLink: TdxBarItemLink; begin ClearInternalItemList; inherited Create(AOwner); QuickCustBar := Self; FHasCaption := False; FOwnerBar := AOwnerBar; OwnerBounds := FOwnerBar.MarkScreenRect; FBar := BarManager.Bars.Add; FBar.FAllowQuickCustomizing := False; FBar.Hidden := True; FBar.Font := FOwnerBar.Font; FBar.UseOwnFont := FOwnerBar.Bar.UseOwnFont; FItemLinks := FBar.ItemLinks; FItemLinks.FBarControl := Self; // add links to available items FAddRemoveSubItem := TdxBarQuickSubItem.Create(BarManager.MainForm); with FAddRemoveSubItem do begin Caption := cxGetResourceString(@dxSBAR_ADDREMOVEBUTTONS); Enabled := FOwnerBar.Bar.AllowQuickCustomizing; if Enabled then OnPopup := AddRemoveSubItemPopup; end; InternalItemList.Add(FAddRemoveSubItem); for I := 0 to FOwnerBar.ItemLinks.CanVisibleItemCount - 1 do begin ItemLink := FOwnerBar.ItemLinks.CanVisibleItems[I]; if (ItemLink.VisibleIndex = -1) or (ItemLink.Control <> nil) and IsRectEmpty(ItemLink.ItemRect) then begin FItemLinks.Add.Assign(ItemLink); FItemLinks[FItemLinks.Count - 1].FOriginalItemLink := ItemLink; end; end; with FItemLinks.Add do begin Item := FAddRemoveSubItem; BeginGroup := True; end; end; destructor TdxBarQuickControl.Destroy; begin FinishHideQuickCustBar; QuickCustBar := nil; inherited; if FQuickCustItem <> nil then begin FQuickCustItem.Free; FQuickCustItem := nil; end; FBar.Free; end; procedure TdxBarQuickControl.AddRemoveSubItemPopup(Sender: TObject); var I: Integer; ItemLink: TdxBarItemLink; AllowReset: Boolean; begin ClearInternalItemList; FAddRemoveSubItem.ItemLinks.Clear; FQuickCustItem := TdxBarQuickCustItem.Create(BarManager.MainForm); for I := 0 to FOwnerBar.ItemLinks.AvailableItemCount - 1 do begin ItemLink := FOwnerBar.ItemLinks.AvailableItems[I]; if (ItemLink.Control = nil) or ItemLink.Control.CanCustomize then with FAddRemoveSubItem.ItemLinks.Add do begin Item := FQuickCustItem; Data := Integer(ItemLink); end; end; // add reset button AllowReset := BarManager.CanReset and FOwnerBar.Bar.CanReset; if AllowReset then begin InternalItemList.Add(TdxBarQuickCustExtButton.Create(BarManager.MainForm)); with TdxBarButton(InternalItemList.Last) do begin Caption := cxGetResourceString(@dxSBAR_RESETTOOLBAR); OnClick := FOwnerBar.Bar.ResetToolbarClick; end; with FAddRemoveSubItem.ItemLinks.Add do begin BeginGroup := True; Item := TdxBarButton(InternalItemList.Last); end; end; // add customize button BarManager.AddCustomizeLink(FAddRemoveSubItem.ItemLinks, not AllowReset, TdxBarQuickCustExtButton); end; procedure TdxBarQuickControl.WMNCHitTest(var Message: TWMNCHitTest); begin inherited; with Message do if Result <> HTCLIENT then Result := HTBORDER; FHitTest := HTCLIENT; end; procedure TdxBarQuickControl.WMNCPaint(var Message: TMessage); var DC: HDC; begin inherited; DC := GetWindowDC(Handle); PainterClass.BarDrawOwnerLink(Self, DC); ReleaseDC(Handle, DC); end; procedure TdxBarQuickControl.WMRButtonDown(var Message: TWMRButtonDown); begin with TMessage(Message) do Result := DefWindowProc(Handle, Msg, wParam, lParam); end; procedure TdxBarQuickControl.WMWindowPosChanged(var Message: TWMWindowPosChanged); begin inherited; if (Message.WindowPos^.flags and SWP_HIDEWINDOW <> 0) and not IsDestroying then CloseUp; end; function TdxBarQuickControl.GetMainForm: TCustomForm; begin if FOwnerBar <> nil then Result := FOwnerBar.GetMainForm else Result := inherited GetMainForm; end; function TdxBarQuickControl.GetToolbarBrush: HBRUSH; begin Result := PainterClass.BarToolbarBrushEx2(Self); end; function TdxBarQuickControl.HideOnClick: Boolean; begin Result := True; end; function TdxBarQuickControl.IsLinkedToOwner: Boolean; begin Result := inherited IsLinkedToOwner{ or ((FOwnerBar <> nil) and (FOwnerBar.FQuickPopup = Self))}; end; function TdxBarQuickControl.IsInternal: Boolean; begin Result := True; end; function TdxBarQuickControl.GetOwnerControl: TWinControl; begin Result := FOwnerBar; end; procedure TdxBarQuickControl.CloseUp; begin FOwnerBar.MarkState := msNone; end; procedure TdxBarQuickControl.HideAll; var WasFocused: Boolean; P: TPoint; begin WasFocused := BarManager.FocusedBarControl = Self; inherited; if WasFocused then begin if LeftButtonPressed then begin GetCursorPos(P); Windows.ScreenToClient(FOwnerBar.Handle, P); if PtInRect(FOwnerBar.MarkRect, P) then FOwnerBar.FIgnoreMouseClick := True; end; CloseUp; end; end; procedure TdxBarQuickControl.Popup(const OwnerR: TRect); var P, Size: TPoint; WorkArea: TRect; begin Size := GetSizeForWidth(dsNone, 0); Inc(Size.X, 2 * BarManager.BorderSizeX); Inc(Size.Y, 2 * BarManager.BorderSizeY); if IsRealVertical(FOwnerBar) then P := Point(OwnerR.Right, OwnerR.Top) else if (FOwnerBar.DockingStyle = dsNone) and PainterClass.IsQuickControlPopupOnRight then P := Point(OwnerR.Left, OwnerR.Bottom) else P := Point(OwnerR.Right - Size.X, OwnerR.Bottom); WorkArea := GetWorkArea(P); if IsRealVertical(FOwnerBar) then begin if P.X + Size.X > WorkArea.Right then P.X := OwnerR.Left - Size.X; if P.Y < WorkArea.Top then P.Y := WorkArea.Top; if P.Y + Size.Y > WorkArea.Bottom then P.Y := WorkArea.Bottom - Size.Y; end else begin if P.X < WorkArea.Left then P.X := WorkArea.Left; if P.X + Size.X > WorkArea.Right then P.X := WorkArea.Right - Size.X; if P.Y + Size.Y > WorkArea.Bottom then P.Y := OwnerR.Top - Size.Y; end; SetWindowPos(Handle, HWND_TOP, P.X, P.Y, Size.X, Size.Y, SWP_SHOWWINDOW or SWP_NOACTIVATE); end; { TdxBarManagerCategories } type TdxBarCategoryData = class public ItemsVisible, LoadedItemsVisible: TdxBarItemVisible; Visible: Boolean; end; TdxBarManagerCategories = class(TStringList) private FMoving: Boolean; Owner: TdxBarManager; procedure ListChanged(Sender: TObject); procedure ChangeCategory(OldCategory, NewCategory: Integer); procedure ReadItemsVisibles(Reader: TReader); procedure ReadVisibles(Reader: TReader); procedure WriteItemsVisibles(Writer: TWriter); procedure WriteVisibles(Writer: TWriter); protected procedure ClearObjects; procedure DefineProperties(Filer: TFiler); override; public constructor Create(AOwner: TdxBarManager); destructor Destroy; override; procedure Clear; override; procedure Delete(Index: Integer); override; procedure Insert(Index: Integer; const S: string); override; procedure Exchange(Index1, Index2: Integer); override; procedure Move(CurIndex, NewIndex: Integer); override; end; constructor TdxBarManagerCategories.Create(AOwner: TdxBarManager); begin inherited Create; Owner := AOwner; if not Owner.IsLoading then Add(cxGetResourceString(@dxSBAR_DEFAULTCATEGORYNAME)); OnChange := ListChanged; end; destructor TdxBarManagerCategories.Destroy; begin ClearObjects; inherited; end; procedure TdxBarManagerCategories.Clear; begin ClearObjects; inherited; end; procedure TdxBarManagerCategories.ListChanged(Sender: TObject); begin Owner.DesignerModified; end; procedure TdxBarManagerCategories.ChangeCategory(OldCategory, NewCategory: Integer); var List: TList; I: Integer; begin if (OldCategory > -1) and (OldCategory < Count) and (NewCategory > -1) then begin List := TList.Create; Owner.GetAllItemsByCategory(OldCategory, List); for I := 0 to List.Count - 1 do TdxBarItem(List[I]).FCategory := NewCategory; List.Free; end; end; procedure TdxBarManagerCategories.ReadItemsVisibles(Reader: TReader); var I: Integer; begin Reader.ReadListBegin; try BeginUpdate; try for I := 0 to Count - 1 do begin if Reader.EndOfList then Break; Owner.CategoryItemsVisible[I] := TdxBarItemVisible(Reader.ReadInteger); end; finally EndUpdate; end; finally Reader.ReadListEnd; end; end; procedure TdxBarManagerCategories.ReadVisibles(Reader: TReader); var I: Integer; begin Reader.ReadListBegin; try BeginUpdate; try for I := 0 to Count - 1 do begin if Reader.EndOfList then Break; Owner.CategoryVisible[I] := Reader.ReadBoolean; end; finally EndUpdate; end; finally Reader.ReadListEnd; end; end; procedure TdxBarManagerCategories.WriteItemsVisibles(Writer: TWriter); var I: Integer; begin Writer.WriteListBegin; try for I := 0 to Count - 1 do Writer.WriteInteger(Longint(Owner.CategoryItemsVisible[I])); finally Writer.WriteListEnd; end; end; procedure TdxBarManagerCategories.WriteVisibles(Writer: TWriter); var I: Integer; begin Writer.WriteListBegin; try for I := 0 to Count - 1 do Writer.WriteBoolean(Owner.CategoryVisible[I]); finally Writer.WriteListEnd; end; end; procedure TdxBarManagerCategories.ClearObjects; var I: Integer; begin for I := 0 to Count - 1 do if Objects[I] <> nil then begin TdxBarCategoryData(Objects[I]).Free; Objects[I] := nil; end; end; procedure TdxBarManagerCategories.DefineProperties(Filer: TFiler); begin inherited; Filer.DefineProperty('ItemsVisibles', ReadItemsVisibles, WriteItemsVisibles, True); Filer.DefineProperty('Visibles', ReadVisibles, WriteVisibles, True); end; procedure TdxBarManagerCategories.Delete(Index: Integer); var List: TList; I: Integer; begin if FMoving then inherited else begin if (Index > -1) and (Index < Count) then begin List := TList.Create; Owner.GetAllItemsByCategory(Index, List); for I := 0 to List.Count - 1 do TdxBarItem(List[I]).Free; List.Free; for I := Index + 1 to Count - 1 do ChangeCategory(I, I - 1); if Objects[Index] <> nil then TdxBarCategoryData(Objects[Index]).Free; inherited; end; if Count = 0 then Add(cxGetResourceString(@dxSBAR_DEFAULTCATEGORYNAME)); end; end; procedure TdxBarManagerCategories.Insert(Index: Integer; const S: string); var I: Integer; begin if not FMoving and (Index > -1) and (Index < Count) then for I := Count - 1 downto Index do ChangeCategory(I, I + 1); inherited Insert(Index, S); end; procedure TdxBarManagerCategories.Exchange(Index1, Index2: Integer); var I: Integer; List1: TList; List2: TList; begin if (Index1 > -1) and (Index1 < Count) and (Index2 > -1) and (Index2 < Count) then begin List1 := TList.Create; List2 := TList.Create; Owner.GetAllItemsByCategory(Index1, List1); Owner.GetAllItemsByCategory(Index2, List2); for I := 0 to List1.Count - 1 do TdxBarItem(List1[I]).Category := Index2; for I := 0 to List2.Count - 1 do TdxBarItem(List2[I]).Category := Index1; List2.Free; List1.Free; inherited Exchange(Index1, Index2); end; end; procedure TdxBarManagerCategories.Move(CurIndex, NewIndex: Integer); var List: TList; I: Integer; begin if (0 <= CurIndex) and (CurIndex < Count) and (0 <= NewIndex) and (NewIndex < Count) and (CurIndex <> NewIndex) then begin List := TList.Create; Owner.GetAllItemsByCategory(CurIndex, List); for I := 0 to List.Count - 1 do TdxBarItem(List[I]).FCategory := dxBarManagerTempCategoryIndex; if CurIndex < NewIndex then for I := CurIndex + 1 to NewIndex do ChangeCategory(I, I - 1) else for I := CurIndex - 1 downto NewIndex do ChangeCategory(I, I + 1); for I := 0 to List.Count - 1 do TdxBarItem(List[I]).FCategory := NewIndex; List.Free; FMoving := True; inherited Move(CurIndex, NewIndex); FMoving := False; end; end; { TdxBarHintWindow } constructor TdxBarHintWindow.Create(AOwner: TComponent); begin inherited Create(AOwner); Color := clInfoBk; Canvas.Brush.Style := bsClear; end; procedure TdxBarHintWindow.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin Style := WS_POPUP or WS_DISABLED; WindowClass.Style := WindowClass.Style or CS_SAVEBITS; ExStyle := WS_EX_TOOLWINDOW or WS_EX_TOPMOST; end; end; procedure TdxBarHintWindow.Paint; var R: TRect; begin R := ClientRect; DrawEdge(Canvas.Handle, R, BDR_RAISEDOUTER, BF_RECT); InflateRect(R, -1, -1); Inc(R.Left, 2); Inc(R.Top, 2); cxDrawText(Canvas.Handle, Caption, R, DT_LEFT or DT_NOCLIP or DT_NOPREFIX or DT_WORDBREAK); end; procedure TdxBarHintWindow.ActivateHint(P: TPoint; const AHint: string; BarManager: TdxBarManager); var NonClientMetrics: TNonClientMetrics; R, WorkArea: TRect; begin Caption := AHint; if BarManager.UseSystemFont then begin NonClientMetrics.cbSize := SizeOf(NonClientMetrics); if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then Canvas.Font.Handle := CreateFontIndirect(NonClientMetrics.lfStatusFont) else Canvas.Font.Size := 8; end else Canvas.Font := BarManager.Font; {$IFNDEF DELPHI6} Canvas.Font.Color := clInfoText; {$ELSE} Canvas.Font.Color := Screen.HintFont.Color; {$ENDIF} Color := Application.HintColor; WorkArea := GetWorkArea(P); R := Rect(0, 0, WorkArea.Right - WorkArea.Left, 0); cxDrawText(Canvas.Handle, AHint, R, DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK); Inc(R.Right, 2 * (1 + 2)); Inc(R.Bottom, 2 * (1 + 2)); Width := R.Right; Height := R.Bottom; OffsetRect(R, P.X, P.Y); if R.Left + Width > WorkArea.Right then R.Left := WorkArea.Right - Width; // if R.Top + Height > WorkArea.Bottom then // R.Top := P.Y - 5 * HintOffset div 2; if R.Top + Height > WorkArea.Bottom then R.Top := P.Y - Height - HintOffset; if R.Left < WorkArea.Left then R.Left := WorkArea.Left; if R.Top < WorkArea.Top then R.Top := WorkArea.Top; InvalidateRect(Handle, nil, True); SetWindowPos(Handle, HWND_TOPMOST, R.Left, R.Top, 0, 0, SWP_NOSIZE or SWP_SHOWWINDOW or SWP_NOACTIVATE); end; procedure TdxBarHintWindow.WMNCHitTest(var Message: TWMNCHitTest); begin Message.Result := HTTRANSPARENT; end; { TdxBarGroup } constructor TdxBarGroup.Create(AOwner: TComponent); begin inherited; FEnabled := True; FItems := TList.Create; FVisible := ivAlways; end; destructor TdxBarGroup.Destroy; begin FBarManager.RemoveGroup(Self); FItems.Free; inherited; end; function TdxBarGroup.GetCount: Integer; begin Result := FItems.Count; end; function TdxBarGroup.GetIndex: Integer; begin Result := FBarManager.FGroups.IndexOf(Self); end; function TdxBarGroup.GetItem(Index: Integer): TComponent; begin Result := TComponent(FItems[Index]); end; procedure TdxBarGroup.SetEnabled(Value: Boolean); var PrevLockUpdate, ALock: Boolean; I: Integer; Item: TComponent; begin //if FEnabled <> Value then begin FEnabled := Value; PrevLockUpdate := FBarManager.LockUpdate; ALock := (QuickCustBar = nil) and ([csLoading, csDestroying] * ComponentState = []); if ALock then FBarManager.LockUpdate := True; try for I := 0 to Count - 1 do begin Item := Items[I]; if Item is TdxBarItem then TdxBarItem(Item).Enabled := Value else TdxBarGroup(Item).Enabled := Value; end; finally if ALock then FBarManager.LockUpdate := PrevLockUpdate; end; end; end; procedure TdxBarGroup.SetIndex(Value: Integer); begin if Index <> Value then FBarManager.FGroups.Move(Index, Value); end; procedure TdxBarGroup.SetVisible(Value: TdxBarItemVisible); var PrevLockUpdate: Boolean; I: Integer; Item: TComponent; begin //if FVisible <> Value then begin FVisible := Value; PrevLockUpdate := FBarManager.LockUpdate; if [csLoading, csDestroying] * ComponentState = [] then FBarManager.LockUpdate := True; try for I := 0 to Count - 1 do begin Item := Items[I]; if Item is TdxBarItem then TdxBarItem(Item).Visible := Value else TdxBarGroup(Item).Visible := Value; end; finally FBarManager.LockUpdate := PrevLockUpdate; end; end; end; procedure TdxBarGroup.ReadItems(Reader: TReader); begin if FItemsNames = nil then FItemsNames := TStringList.Create else FItemsNames.Clear; Reader.ReadListBegin; try while not Reader.EndOfList do FItemsNames.Add(Reader.ReadString); finally Reader.ReadListEnd; end; end; procedure TdxBarGroup.WriteItems(Writer: TWriter); var I: Integer; begin Writer.WriteListBegin; try for I := 0 to Count - 1 do Writer.WriteString(Items[I].Name); finally Writer.WriteListEnd; end; end; procedure TdxBarGroup.DefineProperties(Filer: TFiler); begin inherited; Filer.DefineProperty('Items', ReadItems, WriteItems, Count <> 0); end; procedure TdxBarGroup.Loaded; var I: Integer; AItem: TComponent; begin inherited; if FItemsNames = nil then Exit; try for I := 0 to FItemsNames.Count - 1 do begin AItem := FBarManager.MainForm.FindComponent(FItemsNames[I]); if AItem <> nil then Add(AItem); end; finally FItemsNames.Free; end; end; procedure TdxBarGroup.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent <> Self) and ((AComponent is TdxBarItem) or (AComponent is TdxBarGroup)) then Remove(AComponent); end; procedure TdxBarGroup.SetName(const NewName: TComponentName); begin inherited; UpdateGroups; end; function TdxBarGroup.GetParentComponent: TComponent; begin Result := FBarManager; end; function TdxBarGroup.HasParent: Boolean; begin Result := FBarManager <> nil; end; procedure TdxBarGroup.SetParentComponent(AParent: TComponent); begin inherited; if AParent is TdxBarManager then TdxBarManager(AParent).AddGroup(Self); end; procedure TdxBarGroup.Add(AItem: TComponent); function IsRecursive(AItem: TComponent): Boolean; var I: Integer; begin Result := False; if AItem is TdxBarGroup then begin Result := AItem = Self; if not Result then with TdxBarGroup(AItem) do for I := 0 to Count - 1 do begin Result := IsRecursive(Items[I]); if Result then Break; end; end; end; begin if (AItem = nil) or (IndexOf(AItem) <> -1) or not ((AItem is TdxBarItem) or (AItem is TdxBarGroup)) then Exit; if IsRecursive(AItem) then raise Exception.Create(cxGetResourceString(@dxSBAR_RECURSIVEGROUPS)); FItems.Add(AItem); AItem.FreeNotification(Self); end; procedure TdxBarGroup.Delete(Index: Integer); begin FItems.Delete(Index); end; function TdxBarGroup.IndexOf(AItem: TComponent): Integer; begin Result := FItems.IndexOf(AItem); end; procedure TdxBarGroup.Move(FromIndex, ToIndex: Integer); begin FItems.Move(FromIndex, ToIndex); end; procedure TdxBarGroup.Remove(AItem: TComponent); begin FItems.Remove(AItem); end; { TdxBarPopupMenuLink } function TdxBarPopupMenuLink.GetBarManager: TdxBarManager; begin Result := TdxBarPopupMenuLinks(Collection).BarManager; end; procedure TdxBarPopupMenuLink.SetControl(Value: TWinControl); begin if (Value <> nil) and (GetBarManagerByForm(GetParentForm(Value{$IFDEF DELPHI9}, not BarManager.Designing{$ENDIF})) <> BarManager) then Value := nil; if FControl <> Value then begin FControl := Value; if Value <> nil then Value.FreeNotification(BarManager); end; end; procedure TdxBarPopupMenuLink.SetPopupMenu(Value: TdxBarPopupMenu); begin if FPopupMenu <> Value then begin FPopupMenu := Value; if Value <> nil then Value.FreeNotification(BarManager); end; end; function TdxBarPopupMenuLink.IsShortCut(AShortCut: TShortCut): Boolean; var X, Y: Integer; begin Result := FPopupMenu <> nil; if Assigned(FOnAction) then begin X := -1; Y := -1; FOnAction(Self, X, Y, False, Result); end; if Result then Result := (FPopupMenu <> nil) and FPopupMenu.IsShortCut(AShortCut); end; constructor TdxBarPopupMenuLink.Create(Collection: TCollection); begin inherited; FProcessChildren := True; end; procedure TdxBarPopupMenuLink.Assign(Source: TPersistent); function FindLinkComponent(AComponent: TComponent): TComponent; begin if AComponent <> nil then Result := BarManager.Owner.FindComponent(AComponent.Name) else Result := nil; end; begin if Source is TdxBarPopupMenuLink then begin Control := FindLinkComponent(TdxBarPopupMenuLink(Source).Control) as TWinControl; PopupMenu := FindLinkComponent(TdxBarPopupMenuLink(Source).PopupMenu) as TdxBarPopupMenu; ProcessChildren := TdxBarPopupMenuLink(Source).ProcessChildren; end else inherited Assign(Source); end; function TdxBarPopupMenuLink.DoAction(Wnd: HWND; P: TPoint): Boolean; var Msg: TMsg; ClickedByMouse: Boolean; {$IFDEF DELPHI5} PrevP: TPoint; {$ENDIF} begin PeekMessage(Msg, Wnd, WM_CONTEXTMENU, WM_CONTEXTMENU, PM_REMOVE); ClickedByMouse := P.X <> -1; if ClickedByMouse then begin ScreenToClient(Wnd, P); {$IFDEF DELPHI5} PrevP := P; MapWindowPoints(Wnd, FControl.Handle, PrevP, 1); {$ENDIF} end else begin {$IFDEF DELPHI5} PrevP := P; {$ENDIF} if HideCaret(Wnd) then begin ShowCaret(Wnd); GetCaretPos(P); end else P := Point(0, 0); end; {$IFDEF DELPHI5} Result := False; TDummyControl(FControl).DoContextPopup(PrevP, Result); if Result then Exit; {$ENDIF} Result := FPopupMenu <> nil; if Assigned(FOnAction) then begin MapWindowPoints(Wnd, FControl.Handle, P, 1); FOnAction(Self, P.X, P.Y, ClickedByMouse, Result); MapWindowPoints(FControl.Handle, Wnd, P, 1); end; if Result and (FPopupMenu <> nil) then begin if IsWindowEnabled(Wnd) then SetFocus(Wnd); ClientToScreen(Wnd, P); FPopupMenu.Popup(P.X, P.Y); end; end; { TdxBarPopupMenuLinks } constructor TdxBarPopupMenuLinks.Create(ABarManager: TdxBarManager); begin inherited Create(TdxBarPopupMenuLink); FBarManager := ABarManager; end; function TdxBarPopupMenuLinks.GetItem(Index: Integer): TdxBarPopupMenuLink; begin Result := TdxBarPopupMenuLink(inherited GetItem(Index)); end; procedure TdxBarPopupMenuLinks.SetItem(Index: Integer; Value: TdxBarPopupMenuLink); begin inherited SetItem(Index, Value); end; function TdxBarPopupMenuLinks.GetOwner: TPersistent; begin Result := FBarManager; end; function TdxBarPopupMenuLinks.IsShortCut(AControl: TWinControl; AShortCut: TShortCut): Boolean; var I: Integer; begin Result := False; // process controls for I := 0 to Count - 1 do if Items[I].Control = AControl then begin Result := Items[I].IsShortCut(AShortCut); if Result then Break; end; // process children if not Result then begin AControl := AControl.Parent; while not Result and (AControl <> nil) do begin for I := 0 to Count - 1 do if Items[I].ProcessChildren and (Items[I].Control = AControl) then begin Result := Items[I].IsShortCut(AShortCut); if Result then Break; end; AControl := AControl.Parent; end; end; end; function TdxBarPopupMenuLinks.Add: TdxBarPopupMenuLink; begin Result := TdxBarPopupMenuLink(inherited Add); end; function TdxBarPopupMenuLinks.DoAction(AControl: TWinControl; Wnd: HWND; const P: TPoint): Boolean; var I: Integer; begin Result := False; if FBarManager.Designing then Exit; // process controls for I := 0 to Count - 1 do if Items[I].Control = AControl then begin Result := Items[I].DoAction(Wnd, P); if Result then Break; end; // process children if not Result then begin AControl := AControl.Parent; while not Result and (AControl <> nil) do begin for I := 0 to Count - 1 do if Items[I].ProcessChildren and (Items[I].Control = AControl) then begin Result := Items[I].DoAction(Wnd, P); if Result then Break; end; AControl := AControl.Parent; end; end; end; { TdxBarBackgrounds } constructor TdxBarBackgrounds.Create(ABarManager: TdxBarManager); begin inherited Create; FBarManager := ABarManager; FBarBackgroundBitmap := TBitmap.Create; FBarBackgroundBitmap.OnChange := BitmapChanged; FSubMenuBackgroundBitmap := TBitmap.Create; end; destructor TdxBarBackgrounds.Destroy; begin FSubMenuBackgroundBitmap.Free; FSubMenuBackgroundBitmap := nil; FBarBackgroundBitmap.Free; FBarBackgroundBitmap := nil; inherited Destroy; end; procedure TdxBarBackgrounds.Assign(Source: TPersistent); begin if Source is TdxBarBackgrounds then begin Bar := TdxBarBackgrounds(Source).Bar; SubMenu := TdxBarBackgrounds(Source).SubMenu; end else inherited Assign(Source); end; procedure TdxBarBackgrounds.Changed; begin BarManager.InternalStyleChanged; // TODO: ??? end; function TdxBarBackgrounds.GetOwner: TPersistent; begin Result := FBarManager; end; procedure TdxBarBackgrounds.BitmapChanged(Sender: TObject); begin Changed; end; procedure TdxBarBackgrounds.SetBarBackgroundBitmap(Value: TBitmap); var AChanged: Boolean; begin AChanged := not ((Value = nil) and FBarBackgroundBitmap.Empty); FBarBackgroundBitmap.Assign(Value); if AChanged then Changed; end; procedure TdxBarBackgrounds.SetSubMenuBackgroundBitmap(Value: TBitmap); begin FSubMenuBackgroundBitmap.Assign(Value); end; { TdxBarManager } var KeyboardHookHandle: HHOOK; MouseHookHandle: HHOOK; WndProcHookHandle: HHOOK; EatKey, WaitForMenu, DontCallNextKeybHook: Boolean; EatingKey: WPARAM; InMouseHook: Boolean; AClassName: PChar; FDockTimerID: UINT; FDockBarManager: TdxBarManager; FHintWindow: TdxBarHintWindow; FHintWindowShowing: Boolean; FHintTimerID, FHiddenHintTimerID: UINT; FCustomHint: string; FLiveHiddenHint: Boolean; AnimatingSubMenu: TdxBarSubMenuControl; procedure KillHintTimer; begin if FHintTimerID <> 0 then begin KillTimer(0, FHintTimerID); FHintTimerID := 0; end; end; procedure KillHiddenHintTimer; begin if FHiddenHintTimerID <> 0 then begin KillTimer(0, FHiddenHintTimerID); FHiddenHintTimerID := 0; FLiveHiddenHint := False; end; end; function dxBarKeyboardHook(Code: Integer; wParam: WParam; lParam: LParam): LRESULT; stdcall; const KeyMessages: array[Boolean] of Integer = (WM_KEYUP, WM_KEYDOWN); var AControl: TWinControl; AForm: TCustomForm; ABarManager, AFormBarManager, ATempBarManager: TdxBarManager; AKeyPressed: Boolean; //Msg: TMsg; Res: LRESULT; APopupMenuLinks: TdxBarPopupMenuLinks; function GetPopupMenuLinksForFocusedWindow(var AControl: TWinControl): TdxBarPopupMenuLinks; var ABarManager: TdxBarManager; begin Result := nil; AControl := FindVCLControl(GetFocus); if AControl <> nil then begin ABarManager := GetBarManagerByForm(GetParentForm(AControl)); if ABarManager <> nil then Result := ABarManager.PopupMenuLinks; end; end; function KeyPressed: Boolean; var KS: TKeyboardState; I: Integer; begin GetKeyboardState(KS); for I := Low(KS) to High(KS) do begin Result := KS[I] and 128 <> 0; if Result then Break; end; end; function ShiftState: TShiftState; begin Result := []; if GetAsyncKeyState(VK_SHIFT) < 0 then Result := Result + [ssShift]; if GetAsyncKeyState(VK_CONTROL) < 0 then Result := Result + [ssCtrl]; if GetAsyncKeyState(VK_MENU) < 0 then Result := Result + [ssAlt]; end; procedure HandleKey; var Shift: TShiftState; AItemLink: TdxBarItemLink; UniqueItem: Boolean; function IsShortCutUsed: Boolean; var ShortCut: TShortCut; AControl: TWinControl; APopupMenuLinks: TdxBarPopupMenuLinks; procedure CheckBarManager(ABarManager: TdxBarManager); var I: Integer; begin with ABarManager do begin if MainMenuBar = nil then Result := False else Result := MainMenuBar.IsShortCut(ShortCut); if not Result then for I := 0 to Bars.Count - 1 do if Bars[I].Visible and not Bars[I].IsMainMenu and (Bars[I].Control <> nil) and Bars[I].Control.HandleAllocated and IsWindowVisible(Bars[I].Control.Handle) then begin Result := Bars[I].IsShortCut(ShortCut); if Result then Break; end; end; end; begin ShortCut := Byte(wParam); if GetAsyncKeyState(VK_SHIFT) < 0 then Inc(ShortCut, scShift); if GetAsyncKeyState(VK_CONTROL) < 0 then Inc(ShortCut, scCtrl); if GetAsyncKeyState(VK_MENU) < 0 then Inc(ShortCut, scAlt); APopupMenuLinks := GetPopupMenuLinksForFocusedWindow(AControl); if (APopupMenuLinks <> nil) and APopupMenuLinks.IsShortCut(AControl, ShortCut) then begin Result := True; Exit; end; CheckBarManager(ABarManager); if not Result and (AFormBarManager <> ABarManager) and (AFormBarManager <> nil) then CheckBarManager(AFormBarManager); end; function GlobalFindItemWithAccel(ABarManager: TdxBarManager): TdxBarItemLink; var I: Integer; begin with ABarManager do begin if MainMenuControl <> nil then Result := MainMenuBar.ItemLinks.FindItemWithAccel(wParam, Shift, nil) else Result := nil; if Result = nil then for I := 0 to Bars.Count - 1 do if Bars[I].Visible and not Bars[I].IsMainMenu then begin Result := Bars[I].ItemLinks.FindItemWithAccel(wParam, Shift, nil); if Result <> nil then Break; end; end; end; begin if IsShortCutUsed then Result := 1 else if GetAsyncKeyState(VK_MENU) < 0 then begin Shift := ShiftState - [ssAlt]; AItemLink := GlobalFindItemWithAccel(ABarManager); if (AItemLink = nil) and (AFormBarManager <> ABarManager) and (AFormBarManager <> nil) then AItemLink := GlobalFindItemWithAccel(AFormBarManager); if (AItemLink <> nil) and AItemLink.Item.Enabled then with AItemLink do begin UniqueItem := Owner.FindItemWithAccel(wParam, Shift, AItemLink) = AItemLink; if not Control.IsDestroyOnClick or not UniqueItem then TdxBarControl(BarControl).BarGetFocus(Control); if UniqueItem then begin if Control is TdxBarSubItemControl then TdxBarControl(BarControl).IsDowned := True; Control.Click(False); end; Result := 1; end; end; end; begin Result := 0; try if Code = HC_NOREMOVE then Exit; if FIsMDIButtonPressed then begin Result := 1; Exit; end; if wParam = VK_PROCESSKEY then Exit; // for Korean windows if Code >= 0 then begin if EatKey and (wParam = EatingKey) and ((lParam shr 31) and 1 <> 0) then // release eating key begin EatKey := False; Result := 1; Exit; end; if (ActiveBarControl <> nil) and not ActiveBarControl.BarManager.FDetachingSubMenu then if not ActiveBarControl.IsCustomizing then with ActiveBarControl do if not (SelectedItem is TdxBarWinControl and TdxBarWinControl(SelectedItem).Focused) then begin //PeekMessage(Msg, GetFocus, WM_CONTEXTMENU, WM_CONTEXTMENU, PM_REMOVE); AKeyPressed := (lParam shr 31) and 1 = 0; if AKeyPressed then begin EatKey := True; EatingKey := wParam; end; SendMessage(Handle, KeyMessages[AKeyPressed], wParam, lParam); if (ActiveBarControl <> nil) or (GetAsyncKeyState(wParam) >= 0) then EatKey := False; Result := 1; Exit; end else else if (wParam = VK_ESCAPE) and (GetCapture = ActiveBarControl.Handle) then begin ReleaseCapture; Result := 1; Exit; end; if GetCapture = 0 then begin if (wParam = VK_APPS) and ((lParam shr 31) and 1 <> 0) or (wParam = VK_F10) and ((lParam shr 31) and 1 = 0) and (ShiftState = [ssShift]) then begin APopupMenuLinks := GetPopupMenuLinksForFocusedWindow(AControl); if (APopupMenuLinks <> nil) and APopupMenuLinks.DoAction(AControl, GetFocus, Point(-1, -1)) then begin Result := 1; Exit; end; end; AControl := FindControl(GetActiveWindow); if (AControl is TCustomForm) and IsWindowEnabled(AControl.Handle) then AForm := TCustomForm(AControl) else AForm := nil; if (AForm <> nil) and not (csDesigning in AForm.ComponentState) then begin with TDummyForm(AForm) do if (FormStyle = fsMDIForm) and (ActiveMDIChild <> nil) then AForm := ActiveMDIChild; AFormBarManager := GetBarManagerByForm(AForm); // check dock form if (AFormBarManager = nil) and not (fsModal in AForm.FormState) and (FindControl(GetParent(AForm.Handle)) is TCustomForm) then AFormBarManager := GetBarManagerByForm(TCustomForm(FindControl(GetParent(AForm.Handle)))); ABarManager := AFormBarManager; if (TDummyForm(AForm).FormStyle = fsMDIChild) or not (TDummyForm(AForm).FormStyle in [fsMDIChild, fsMDIForm]) and (ABarManager = nil) and (GetBarManagerByForm(Application.MainForm) <> nil) and GetBarManagerByForm(Application.MainForm).AllowCallFromAnotherForm and IsWindowEnabled(Application.MainForm.Handle) then ABarManager := GetBarManagerByForm(Application.MainForm); if AFormBarManager = nil then AFormBarManager := ABarManager else if (TDummyForm(AForm).FormStyle = fsMDIChild) and (AFormBarManager.MainMenuControl <> nil) then // Main menu in MDI Child begin ATempBarManager := ABarManager; ABarManager := AFormBarManager; AFormBarManager := ATempBarManager; end; end else begin ABarManager := nil; AFormBarManager := nil; end; if (ABarManager <> nil) and not ABarManager.IsCustomizing and not ABarManager.BarControlFocused then if (lParam shr 31) and 1 <> 0 then // release key if (ABarManager.MainMenuControl <> nil) and ((wParam = VK_MENU) and WaitForMenu and not KeyPressed or ABarManager.UseF10ForMenu and (wParam = VK_F10) and (ShiftState = [])) then begin WaitForMenu := False; ABarManager.MainMenuControl.BarGetFocus(nil); Result := 1; Exit; end else WaitForMenu := False else // press key if wParam = VK_MENU then WaitForMenu := True else begin WaitForMenu := False; HandleKey; Exit; end; end; end; finally if DontCallNextKeybHook then Result := 0 else begin Res := CallNextHookEx(KeyboardHookHandle, Code, wParam, lParam); if Result = 0 then Result := Res; end; end; end; function dxBarMouseHook(Code: Integer; wParam: WParam; lParam: LParam): LRESULT; stdcall; var ManualProcessing: Boolean; ACustomizingForm: TCustomForm; ABarManager: TdxBarManager; I: Integer; P: TPoint; AKeys: Longint; BarControl: TCustomdxBarControl; Control: TWinControl; Res: HRESULT; function ProcessMouseMessage: Boolean; var AWnd: HWND; AControl: TCustomdxBarControl; function IsParentWnd(AWnd, ARootParentWnd: HWND): Boolean; var AParentWnd: HWND; begin AParentWnd := AWnd; repeat AParentWnd := GetParent(AParentWnd); Result := AParentWnd = ARootParentWnd; until Result or (AParentWnd = 0); end; begin with PMouseHookStruct(lParam)^ do begin AControl := ActiveBarControl; if AControl <> nil then begin Result := True; repeat if (hwnd = AControl.Handle) or (GetParent(hwnd) = AControl.Handle) {or (GetParent(GetParent(hwnd)) = AControl.Handle)} then Exit; AControl := AControl.ParentBar; until AControl = nil; if (ActiveBarControl.SelectedItem <> nil) and (ActiveBarControl.SelectedItem is TCustomdxBarComboControl) and TCustomdxBarComboControl(ActiveBarControl.SelectedItem).DroppedDown then begin AWnd := TCustomdxBarComboControl(ActiveBarControl.SelectedItem).DropDownWindow; Result := IsWindowVisible(AWnd) and ((hwnd = AWnd) or IsParentWnd(hwnd, AWnd)); end else Result := False; end else Result := False; end; end; (* function ProcessMouseMessage: Boolean; var TopWnd: HWND; AControl: TCustomdxBarControl; function TopWndIsChild: Boolean; var Wnd: HWND; begin Result := True; Wnd := TopWnd; repeat if Wnd = ActiveBarControl.Handle then Exit; Wnd := GetParent(Wnd); until Wnd = 0; Result := False; end; begin Result := True; with PMouseHookStruct(lParam)^ do begin //if hwnd = GetTopWindow(0) then Exit; TopWnd := GetTopWindow(0); if (hwnd = TopWnd) or not IsWindowVisible(TopWnd) and TopWndIsChild then Exit; AControl := ActiveBarControl; repeat if (hwnd = AControl.Handle) or (GetParent(hwnd) = AControl.Handle) then Exit; AControl := AControl.ParentBar; until AControl = nil; end; Result := False; end;*) function ActiveControl: TdxBarItemControl; begin Result := nil; with PMouseHookStruct(lParam)^ do begin if FindControl(hwnd) is TCustomdxBarControl then Result := TCustomdxBarControl(FindControl(hwnd)).SelectedItem; if (Result = nil) and (GetCapture > 0) and (ActiveBarControl <> nil) then if WindowFromPointEx(pt) = ActiveBarControl.Handle then Result := ActiveBarControl.SelectedItem else begin Result := ActiveBarControl.SelectedItem; if (Result <> nil) and (not (Result.ItemLink.Item is TCustomdxBarCombo) or not TCustomdxBarCombo(Result.ItemLink.Item).DroppedDown) then Result := nil; end; end; end; function NeedProccessThisEvent(wnd: HWND): Boolean; var I: Integer; begin Result := (FindControl(wnd) is TCustomForm); if IsWin95 and not Result then begin for I := 0 to Screen.FormCount - 1 do if wnd = Screen.Forms[I].Handle then begin Result := True; break; end; end; end; begin Result := 0; try ManualProcessing := False; if dxBarCustomizingForm <> nil then ACustomizingForm := dxBarCustomizingForm.BarManager.MainForm else ACustomizingForm := nil; if (ACustomizingForm <> nil) and (TDummyForm(ACustomizingForm).FormStyle = fsMDIChild) and not (csDesigning in ACustomizingForm.ComponentState) then begin Control := FindControl(PMouseHookStruct(lParam)^.hwnd); if (Control is TCustomForm) and (TDummyForm(Control).FormStyle = fsMDIForm) then begin P := PMouseHookStruct(lParam)^.pt; ScreenToClient(TDummyForm(Control).ClientHandle, P); if ChildWindowFromPointEx(TDummyForm(Control).ClientHandle, P, CWP_SKIPINVISIBLE) = ACustomizingForm.Handle then begin if (WM_MOUSEMOVE <= wParam) and (wParam <= WM_MBUTTONDBLCLK) then wParam := wParam - WM_MOUSEMOVE + WM_NCMOUSEMOVE; with PMouseHookStruct(lParam)^ do begin hwnd := ACustomizingForm.Handle; wHitTestCode := UINT(HTERROR); end; end; end; end; with PMouseHookStruct(lParam)^ do if NeedProccessThisEvent(hwnd) and (SmallInt(wHitTestCode) = HTERROR) then begin ABarManager := GetBarManagerByForm(TCustomForm(FindControl(hwnd))); if (ABarManager = nil) or not ABarManager.FIsCustomizing then ABarManager := dxBarManagerList.CustomizingBarManager; if (ABarManager <> nil) and ABarManager.FIsCustomizing and (dxBarCustomizingForm <> nil) and dxBarCustomizingForm.Active then with ABarManager do for I := 0 to Bars.Count - 1 do if (Bars[I].Control <> nil) and Bars[I].Control.WantMouse then begin ManualProcessing := True; hwnd := Bars[I].Control.Handle; wHitTestCode := SendMessage(hwnd, WM_NCHITTEST, 0, MakeLParam(pt.X, pt.Y)); SendMessage(hwnd, WM_SETCURSOR, hwnd, MakeLParam(wHitTestCode, wParam)); Break; end; end; if not InMouseHook and (Code >= 0) and (FActiveBarControl <> nil) then begin InMouseHook := True; if ((wParam = WM_RBUTTONUP) or (wParam = WM_NCRBUTTONUP) or (wParam = WM_MBUTTONUP) or (wParam = WM_NCMBUTTONUP)) and (ActiveControl = nil) and not ProcessMouseMessage then begin InMouseHook := False; Result := 1; Exit; end; if not ActiveBarControl.BarManager.Dragging then repeat if (((wParam = WM_LBUTTONUP) or (wParam = WM_NCLBUTTONUP)) and (ActiveControl = nil) and (AnimatingSubMenu = nil) and not ActiveBarControl.IsCustomizing and ((ActiveBarControl is TdxBarControl) or (ActiveBarControl.ParentBar <> nil)) or (wParam = WM_LBUTTONDOWN) or (wParam = WM_LBUTTONDBLCLK) or (wParam = WM_RBUTTONDOWN) or (wParam = WM_RBUTTONDBLCLK) or (wParam = WM_MBUTTONDOWN) or (wParam = WM_MBUTTONDBLCLK) or (wParam = WM_NCLBUTTONDOWN) or (wParam = WM_NCLBUTTONDBLCLK) or (wParam = WM_NCRBUTTONDOWN) or (wParam = WM_NCRBUTTONDBLCLK) or (wParam = WM_NCMBUTTONDOWN) or (wParam = WM_NCMBUTTONDBLCLK)) and not ProcessMouseMessage then ActiveBarControl.HideAll else Break; until ActiveBarControl = nil; InMouseHook := False; if not IsWindowVisible(PMouseHookStruct(lParam)^.hwnd) then begin Result := 1; Exit; end; end; if (QuickCustBar <> nil) and not QuickCustBar.IsActive and ((WM_MOUSEFIRST < wParam) and (wParam <= WM_MOUSELAST) or (WM_NCMOUSEMOVE < wParam) and (wParam <= WM_NCMBUTTONDBLCLK)) then begin with PMouseHookStruct(lParam)^ do begin if FindControl(hwnd) is TCustomdxBarControl then BarControl := TCustomdxBarControl(FindControl(hwnd)) else BarControl := nil; P := pt; if BarControl <> nil then ScreenToClient(hwnd, P); end; if (BarControl = nil) or (BarControl <> QuickCustBar) and ((BarControl <> QuickCustBar.FOwnerBar) or not PtInRect(TdxBarControl(BarControl).MarkRect, P) or (wParam = WM_RBUTTONDOWN)) then QuickCustBar.CloseUp; end; with PMouseHookStruct(lParam)^ do if ManualProcessing then begin P := pt; if (WM_NCMOUSEMOVE <= wParam) and (wParam <= WM_NCMBUTTONDBLCLK) then begin wParam := wParam - WM_NCMOUSEMOVE + WM_MOUSEMOVE; ScreenToClient(hwnd, P); end; if wParam <> WM_MOUSEMOVE then SetForegroundWindow(dxBarCustomizingForm.Handle); AKeys := Byte(GetAsyncKeyState(VK_CONTROL) < 0) * MK_CONTROL + Byte(LeftButtonPressed) * MK_LBUTTON + Byte(GetAsyncKeyState(VK_MBUTTON) < 0) * MK_MBUTTON + Byte(RightButtonPressed) * MK_RBUTTON + Byte(GetAsyncKeyState(VK_SHIFT) < 0) * MK_SHIFT; SendMessage(hwnd, wParam, AKeys, MakeLParam(P.X, P.Y)); Result := 1; end else if ((wParam = WM_RBUTTONUP) or (wParam = WM_NCRBUTTONUP)) {and (GetCapture = 0) }then begin Control := FindVCLControl(hwnd); if (Control <> nil) and IsWindowEnabled(Control.Handle){for Modal windows} then begin ABarManager := GetBarManagerByForm(GetParentForm(Control)); // we should leave Result = 0 and pass message to the window for processing // because of the ListView (it does not stop multiselection without this, see #22286) if (ABarManager <> nil) then ABarManager.PopupMenuLinks.DoAction(Control, hwnd, pt); { if (ABarManager <> nil) and ABarManager.PopupMenuLinks.DoAction(Control, hwnd, pt) then Result := 1;} end; end; finally Res := CallNextHookEx(MouseHookHandle, Code, wParam, lParam); if Result = 0 then Result := Res; end; end; // win95 bug fix var FIsGetingBarManagerdxBarWndProcHook: Boolean; function dxBarWndProcHook(Code: Integer; wParam: WParam; lParam: LParam): LRESULT; stdcall; var AWnd, AParentWnd: HWND; ABarManager, ABarManager2: TdxBarManager; function GetParentFormHandle(Wnd: HWND): HWND; begin Result := Wnd; while not (FindControl(Result) is TCustomForm) and (GetParent(Result) <> 0) do Result := GetParent(Result); end; function GetBarManager(AWnd: HWND): TdxBarManager; var AControl: TWinControl; begin AControl := FindControl(AWnd); if AControl is TCustomForm then Result := GetBarManagerByForm(TCustomForm(AControl)) else { if (message = WM_ACTIVATE) and (wParam = WA_INACTIVE) and (AControl is TdxBarControl) then // for control containers begin ABarManager := TdxBarControl(AControl).BarManager; AControl := FindControl(lParam); if (AControl is TCustomForm) and (AControl = ABarManager.MainForm) or (AControl is TdxBarControl) and (TdxBarControl(AControl).BarManager = ABarManager) then ABarManager := nil; end else} Result := nil; end; procedure ActivateMDIChildFormToolbars(AActivate: Boolean; AActiveWindow: HWND); var I: Integer; AMDIBarManager: TdxBarManager; begin for I := 0 to dxBarManagerList.Count - 1 do begin AMDIBarManager := dxBarManagerList[I]; if (TDummyForm(AMDIBarManager.MainForm).FormStyle = fsMDIChild) and (not AActivate or (Application.MainForm.ActiveMDIChild = AMDIBarManager.MainForm)) then begin if (FindControl(AActiveWindow) is TCustomdxBarControl) and (TCustomdxBarControl(FindControl(AActiveWindow)).BarManager = AMDIBarManager) then Break; AMDIBarManager.ShowToolbars(AActivate, False, AActiveWindow); end; end; end; {procedure NotifyActiveMDIChildAboutActivation; begin ABarManager := GetBarManagerByForm(Application.MainForm.ActiveMDIChild); if ABarManager <> nil then with PCWPStruct(lParam)^ do ABarManager.MainFormWndProc(message, wParam, lParam); end;} begin with PCWPStruct(lParam)^ do begin AWnd := hwnd; if (message = WM_HELP) and (ActiveBarControl <> nil) then begin AParentWnd := ActiveBarControl.BarManager.MainForm.Handle; if GetParentFormHandle(AWnd) <> AParentWnd then AWnd := AParentWnd; end; if not FIsGetingBarManagerdxBarWndProcHook then begin FIsGetingBarManagerdxBarWndProcHook := True; ABarManager := GetBarManager(AWnd); FIsGetingBarManagerdxBarWndProcHook := False; if ABarManager <> nil then ABarManager.MainFormWndProc(message, wParam, lParam) else if (message = WM_ACTIVATE) and not (FindControl(AWnd) is TdxBarSubMenuControl) and not (FindControl(AWnd) is TdxBarQuickControl) and not ((FindControl(AWnd) is TdxBarControl) and (Windows.HWND(lParam) = GetParent(hwnd))) then begin // !!! FIsGetingBarManagerdxBarWndProcHook := True; if (FindControl(GetParent(AWnd)) is TCustomForm) and IsWindowVisible(GetParent(AWnd)) then ABarManager2 := GetBarManager(GetParent(AWnd)) else ABarManager2 := nil; FIsGetingBarManagerdxBarWndProcHook := False; if ABarManager2 <> nil then ABarManager2.MainFormWndProc(message, wParam, lParam) end; if (Application.MainForm <> nil) and (Application.MainForm.FormStyle = fsMDIForm) and Application.MainForm.HandleAllocated and (AWnd = Application.MainForm.Handle) and not IsPopupMenuShowed then case message of WM_ACTIVATE: ActivateMDIChildFormToolbars(LOWORD(wParam) <> WA_INACTIVE, lParam); {WM_ACTIVATE: if (LOWORD(wParam) = WA_INACTIVE) or (ABarManager = nil) or not ABarManager.IsCustomizing or (csDestroying in dxBarCustomizingForm.ComponentState) then NotifyActiveMDIChildAboutActivation;} WM_WINDOWPOSCHANGED: if dxBarCustomizingForm <> nil then dxBarCustomizingForm.UpdateVisibility(PWindowPos(lParam)^); end; end; end; (* with PCWPStruct(lParam)^ do begin AWnd := hwnd; if (message = WM_HELP) and (ActiveBarControl <> nil) then begin AParentWnd := ActiveBarControl.BarManager.MainForm.Handle; if GetParentFormHandle(AWnd) <> AParentWnd then AWnd := AParentWnd; end; ABarManager := GetBarManager(AWnd); if ABarManager <> nil then ABarManager.MainFormWndProc(message, wParam, lParam); if (Application.MainForm <> nil) and (Application.MainForm.FormStyle = fsMDIForm) and Application.MainForm.HandleAllocated and (AWnd = Application.MainForm.Handle) then case message of {WM_ACTIVATE: if (LOWORD(wParam) = WA_INACTIVE) or (ABarManager = nil) or not ABarManager.IsCustomizing or (csDestroying in dxBarCustomizingForm.ComponentState) then NotifyActiveMDIChildAboutActivation;} WM_WINDOWPOSCHANGED: if dxBarCustomizingForm <> nil then dxBarCustomizingForm.UpdateVisibility(PWindowPos(lParam)^); end; end; *) Result := CallNextHookEx(WndProcHookHandle, Code, wParam, lParam); with PCWPStruct(lParam)^ do if (message = WM_CHILDACTIVATE) or (message = WM_DESTROY) or (message = WM_MDIACTIVATE) then begin AParentWnd := GetParent(AWnd); if AParentWnd <> 0 then begin GetClassName(AParentWnd, AClassName, 256); if AnsiStrIComp(AClassName, 'MDICLIENT') = 0 then begin ABarManager := GetBarManager(GetParent(AParentWnd)); if ABarManager <> nil then ABarManager.MainFormClientWndProc(message, wParam, lParam); end; end; end; end; procedure RegisterdxBarManager(ABarManager: TdxBarManager); begin if dxBarManagerList.FList.IndexOf(ABarManager) < 0 then begin if dxBarManagerList.Count = 0 then InitMMSystem; dxBarManagerList.FList.Add(ABarManager); end; if not ABarManager.Designing and (FHintWindow = nil) then FHintWindow := dxBarHintWindowClass.Create(nil); if KeyboardHookHandle = 0 then KeyboardHookHandle := SetWindowsHookEx(WH_KEYBOARD, dxBarKeyboardHook, 0, GetCurrentThreadId); if MouseHookHandle = 0 then MouseHookHandle := SetWindowsHookEx(WH_MOUSE, dxBarMouseHook, 0, GetCurrentThreadId); if WndProcHookHandle = 0 then WndProcHookHandle := SetWindowsHookEx(WH_CALLWNDPROC, dxBarWndProcHook, 0, GetCurrentThreadId); end; procedure UnregisterdxBarManager(ABarManager: TdxBarManager); begin dxBarManagerList.FList.Remove(ABarManager); if dxBarManagerList.Count = 0 then begin if WndProcHookHandle <> 0 then begin UnhookWindowsHookEx(WndProcHookHandle); WndProcHookHandle := 0; end; if MouseHookHandle <> 0 then begin UnhookWindowsHookEx(MouseHookHandle); MouseHookHandle := 0; end; if KeyboardHookHandle <> 0 then begin UnhookWindowsHookEx(KeyboardHookHandle); KeyboardHookHandle := 0; end; if FHintWindow <> nil then begin FHintWindow.Free; FHintWindow := nil; end; end; end; constructor TdxBarManager.Create(AOwner: TComponent); begin inherited Create(AOwner); FCreatingFlag := True; if (AOwner = nil) and (Application.MainForm <> nil) then AOwner := Application.MainForm; if not (AOwner is TCustomForm) then raise Exception.Create(cxGetResourceString(@dxSBAR_BARMANAGERBADOWNER)); FMainForm := TCustomForm(AOwner); if GetBarManagerByForm(FMainForm) <> nil then raise Exception.Create(cxGetResourceString(@dxSBAR_BARMANAGERMORETHENONE)); FCreatingFlag := False; RegisterdxBarManager(Self); FBackgrounds := TdxBarBackgrounds.Create(Self); InitPainterClass; FCanModifyDesigner := True; FDesigning := csDesigning in ComponentState; FAllowReset := True; FAutoDockColor := True; FItems := TList.Create; FCategories := TdxBarManagerCategories.Create(Self); FDockControls := TList.Create; FPopupMenus := TList.Create; FBars := TdxBars.Create(Self); FCanCustomize := True; FDockColor := clBtnFace; FFont := TFont.Create; FFont.OnChange := FontChanged; FGroups := TList.Create; FHelpButtonGlyph := TBitmap.Create; FHelpButtonGlyph.OnChange := HelpButtonGlyphChanged; FHideFloatingBarsWhenInactive := True; FImageListBkColor := clFuchsia; FImagesChangeLink := TChangeLink.Create; FImagesChangeLink.OnChange := ImageListChange; FLargeImagesChangeLink := TChangeLink.Create; FLargeImagesChangeLink.OnChange := LargeImageListChange; FHotImagesChangeLink := TChangeLink.Create; FHotImagesChangeLink.OnChange := HotImageListChange; FDisabledImagesChangeLink := TChangeLink.Create; FDisabledImagesChangeLink.OnChange := DisabledImageListChange; FDisabledLargeImagesChangeLink := TChangeLink.Create; FDisabledLargeImagesChangeLink.OnChange := DisabledLargeImageListChange; FThemeChangedNotificator := TdxThemeChangedNotificator.Create; FThemeChangedNotificator.OnThemeChanged := ThemeChanged; FButtonArrowWidth := dxBarDefaultButtonArrowWidth; FLargeButtonArrowWidth := dxBarDefaultLargeButtonArrowWidth; FMenusShowRecentItemsFirst := True; FMostRecentItemsPercents := 95; CalcMostRecentlyUsedUseCount; FPopupMenuLinks := TdxBarPopupMenuLinks.Create(Self); FScaled := True; FShowFullMenusAfterDelay := True; FShowHint := True; FShowHintForDisabledItems := True; FStretchGlyphs := True; CalcButtonsConsts; FLookAndFeel := TcxLookAndFeel.Create(Self); FLookAndFeel.OnChanged := LFChanged; Style := bmsEnhanced; FUseF10ForMenu := True; UseSystemFont := True; FWaitForDockingTime := 21; CreateToolbarsBrushes; end; destructor TdxBarManager.Destroy; begin if not FCreatingFlag then begin FLookAndFeel.Free; FLookAndFeel := nil; FThemeChangedNotificator.Free; if FHintTimerID <> 0 then begin KillHintTimer; HintActivate(False, ''); end; KillHiddenHintTimer; Customizing(False); DestroyToolbarsBrushes; while FPopupMenus.Count > 0 do TdxBarPopupMenu(FPopupMenus.Last).Free; FPopupMenus.Free; FDisabledImagesChangeLink.Free; FDisabledLargeImagesChangeLink.Free; FHotImagesChangeLink.Free; FLargeImagesChangeLink.Free; FImagesChangeLink.Free; FHelpButtonGlyph.Free; while GroupCount > 0 do Groups[0].Free; FGroups.Free; FFont.Free; DeleteObject(FEditFontHandle); FBars.Free; FBars := nil; FDockControls.Free; FDockControls := nil; DestroyItems; FItems.Free; UnregisterdxBarManager(Self); FCategories.Free; DestroyBarRestoringList; FPopupMenuLinks.Free; FBackgrounds.Free; end; inherited Destroy; end; function TdxBarManager.GetBarControlFocused: Boolean; begin Result := FFocusedBarControl <> nil; end; function TdxBarManager.GetCategoryItemsVisible(AIndex: Integer): TdxBarItemVisible; begin if (0 <= AIndex) and (AIndex < FCategories.Count) then with FCategories do if Objects[AIndex] = nil then Result := ivAlways else Result := TdxBarCategoryData(Objects[AIndex]).ItemsVisible else Result := ivNever; end; function TdxBarManager.GetCategoryVisible(AIndex: Integer): Boolean; begin if (0 <= AIndex) and (AIndex < FCategories.Count) then with FCategories do Result := (Objects[AIndex] = nil) or TdxBarCategoryData(Objects[AIndex]).Visible else Result := False; end; function TdxBarManager.GetDockColor: TColor; begin if FAutoDockColor then Result := FMainForm.Color else Result := FDockColor; end; function TdxBarManager.GetDockControl(Index: Integer): TdxDockControl; begin Result := FDockControls[Index]; end; function TdxBarManager.GetDockControlCount: Integer; begin Result := FDockControls.Count; end; function TdxBarManager.GetFlat: Boolean; begin Result := FStyle = bmsFlat; end; function TdxBarManager.GetFlatToolbarsBorderColor: COLORREF; function GetDarkValue(Value: Byte): Byte; begin Result := MulDiv(Value, 8, 10); end; begin Result := GetSysColor(COLOR_BTNSHADOW); Result := RGB( GetDarkValue(GetRValue(Result)), GetDarkValue(GetGValue(Result)), GetDarkValue(GetBValue(Result))); Result := GetRealColor(Result); end; function TdxBarManager.GetFlatToolbarsColor: COLORREF; function GetLightValue(Value: Byte): Byte; begin Result := Value + MulDiv(255 - Value, 16, 100); end; begin Result := GetSysColor(COLOR_BTNFACE); Result := RGB( GetLightValue(GetRValue(Result)), GetLightValue(GetGValue(Result)), GetLightValue(GetBValue(Result))); Result := GetRealColor(Result); end; function TdxBarManager.GetFlatToolbarsDownedColor: COLORREF; begin Result := GetRealColor(GetLightColor(11, 9, 73)); end; function TdxBarManager.GetFlatToolbarsDownedSelColor: COLORREF; begin Result := GetRealColor(GetLightColor(14, 44, 40)); end; function TdxBarManager.GetFlatToolbarsSelColor: COLORREF; begin Result := GetRealColor(GetLightColor(-2, 30, 72)); end; function TdxBarManager.GetGroup(Index: Integer): TdxBarGroup; begin Result := TdxBarGroup(FGroups[Index]); end; function TdxBarManager.GetGroupCount: Integer; begin Result := FGroups.Count; end; function TdxBarManager.GetIsCustomizing: Boolean; begin Result := FIsCustomizing or FDesigning; end; function TdxBarManager.GetIsDestroying: Boolean; begin Result := csDestroying in ComponentState; end; function TdxBarManager.GetItemCount: Integer; begin Result := FItems.Count; end; function TdxBarManager.GetItem(Index: Integer): TdxBarItem; begin if (0 <= Index) and (Index < FItems.Count) then Result := TdxBarItem(FItems[Index]) else Result := nil; end; function TdxBarManager.GetRealLargeButtonArrowWidth: Integer; begin Result := PainterClass.RealLargeButtonArrowWidth(Self); end; function TdxBarManager.GetRestoringListBar(Index: Integer): TdxBar; begin Result := TdxBar(FBarRestoringList[Index]); end; function TdxBarManager.GetRestoringListBarCount: Integer; begin if BarRestoringListExists then Result := FBarRestoringList.Count else Result := 0; end; procedure TdxBarManager.SetAutoDockColor(Value: Boolean); var I: Integer; begin if FAutoDockColor <> Value then begin FAutoDockColor := Value; for I := 0 to DockControlCount - 1 do DockControls[I].ColorChanged; end; end; procedure TdxBarManager.SetAutoHideEmptyBars(Value: Boolean); var I: Integer; begin if FAutoHideEmptyBars <> Value then begin FAutoHideEmptyBars := Value; if not Value then for I := 0 to FBars.Count - 1 do Bars[I].FInternallyHidden := False; end; end; procedure TdxBarManager.SetBackgrounds(Value: TdxBarBackgrounds); begin FBackgrounds.Assign(Value); end; procedure TdxBarManager.SetBars(Value: TdxBars); begin FBars.Assign(Value); end; procedure TdxBarManager.SetButtonArrowWidth(Value: Integer); var I: Integer; begin if FButtonArrowWidth <> Value then begin if Value < 2 then Exit; FButtonArrowWidth := Value; CalcButtonsConsts; for I := 0 to Bars.Count - 1 do with Bars[I] do if Control <> nil then Control.RepaintBar; end; end; procedure TdxBarManager.SetCategories(Value: TStrings); begin Categories.Assign(Value); end; procedure TdxBarManager.SetCategoryItemsVisible(AIndex: Integer; Value: TdxBarItemVisible); var PrevValue: TdxBarItemVisible; EmptyBars, AList: TList; PrevLockUpdate: Boolean; I: Integer; begin if (0 <= AIndex) and (AIndex < FCategories.Count) then begin PrevValue := CategoryItemsVisible[AIndex]; with FCategories do begin if Objects[AIndex] = nil then begin Objects[AIndex] := TdxBarCategoryData.Create; with TdxBarCategoryData(Objects[AIndex]) do begin ItemsVisible := ivAlways; Visible := True; end; end; if Self.IsLoading then begin TdxBarCategoryData(Objects[AIndex]).LoadedItemsVisible := Value; Exit; end; TdxBarCategoryData(Objects[AIndex]).ItemsVisible := Value; if not FDesigning then begin EmptyBars := nil; if FAutoHideEmptyBars then begin EmptyBars := TList.Create; for I := 0 to FBars.Count - 1 do if FBars[I].ItemLinks.AvailableItemCount = 0 then EmptyBars.Add(FBars[I]); end; PrevLockUpdate := LockUpdate; LockUpdate := True; AList := TList.Create; try GetAllItemsByCategory(AIndex, AList); if Value = ivAlways then for I := AList.Count - 1 downto 0 do with TdxBarItem(AList[I]) do if Visible = PrevValue then Visible := Value else else for I := 0 to AList.Count - 1 do with TdxBarItem(AList[I]) do if Visible = PrevValue then Visible := Value; finally AList.Free; if FAutoHideEmptyBars then begin for I := 0 to FBars.Count - 1 do if (Value = ivNever) and (FBars[I].ItemLinks.AvailableItemCount = 0) and (EmptyBars.IndexOf(FBars[I]) = -1) or (Value = ivAlways) and (FBars[I].ItemLinks.AvailableItemCount > 0) and FBars[I].FInternallyHidden then with FBars[I] do begin Visible := Value = ivAlways; FInternallyHidden := Value = ivNever; end; EmptyBars.Free; end; LockUpdate := PrevLockUpdate; end; end; end; if Value <> PrevValue then DesignerModified; end; end; procedure TdxBarManager.SetCategoryVisible(AIndex: Integer; Value: Boolean); begin if (0 <= AIndex) and (AIndex < FCategories.Count) and (CategoryVisible[AIndex] <> Value) then begin with FCategories do begin if Objects[AIndex] = nil then begin Objects[AIndex] := TdxBarCategoryData.Create; TdxBarCategoryData(Objects[AIndex]).ItemsVisible := ivAlways; end; TdxBarCategoryData(Objects[AIndex]).Visible := Value; end; DesignerModified; end; end; function TdxBarManager.GetMainMenuControl: TdxBarControl; begin if FMainMenuBar <> nil then Result := FMainMenuBar.Control else Result := nil; end; procedure TdxBarManager.SetDockColor(Value: TColor); var I: Integer; begin if FDockColor <> Value then begin FDockColor := Value; FAutoDockColor := False; for I := 0 to DockControlCount - 1 do DockControls[I].ColorChanged; end; end; procedure TdxBarManager.SetFlatCloseButton(Value: Boolean); begin if FFlatCloseButton <> Value then begin FFlatCloseButton := Value; if MainMenuControl <> nil then begin if (SelectedItem <> nil) and (SelectedItem.Parent = MainMenuControl) then SelectedItem := nil; MainMenuControl.RepaintBar; end; end; end; procedure TdxBarManager.SetFont(Value: TFont); begin FFont.Assign(Value); end; procedure TdxBarManager.SetHelpButtonGlyph(Value: TBitmap); begin FHelpButtonGlyph.Assign(Value); end; procedure TdxBarManager.SetHideFloatingBarsWhenInactive(Value: Boolean); begin if FHideFloatingBarsWhenInactive <> Value then begin FHideFloatingBarsWhenInactive := Value; ShowToolbars(FMainFormActive or not FHideFloatingBarsWhenInactive, False, 0); end; end; procedure TdxBarManager.SetHotImages(Value: TCurImageList); begin if FHotImages <> Value then begin if FHotImages <> nil then FHotImages.UnRegisterChanges(FHotImagesChangeLink); FHotImages := Value; if FHotImages <> nil then begin FHotImages.RegisterChanges(FHotImagesChangeLink); FHotImages.FreeNotification(Self); end; HotImagesChanged; end; end; procedure TdxBarManager.SetImageListBkColor(Value: TColor); var I: Integer; begin if FImageListBkColor <> Value then begin FImageListBkColor := Value; for I := 0 to FBars.Count - 1 do with FBars[I] do if Control <> nil then Control.Repaint; end; end; procedure TdxBarManager.SetImages(Value: TCurImageList); begin if FImages <> Value then begin if FImages <> nil then FImages.UnRegisterChanges(FImagesChangeLink); FImages := Value; if FImages <> nil then begin FImages.RegisterChanges(FImagesChangeLink); FImages.FreeNotification(Self); end; ImagesChanged; end; end; procedure TdxBarManager.SetDisabledImages(Value: TCurImageList); begin if FDisabledImages <> Value then begin if FDisabledImages <> nil then FDisabledImages.UnRegisterChanges(FDisabledImagesChangeLink); FDisabledImages := Value; if FDisabledImages <> nil then begin FDisabledImages.RegisterChanges(FDisabledImagesChangeLink); FDisabledImages.FreeNotification(Self); end; DisabledImagesChanged; end; end; procedure TdxBarManager.SetDisabledLargeImages(Value: TCurImageList); begin if FDisabledLargeImages <> Value then begin if FDisabledLargeImages <> nil then FDisabledLargeImages.UnRegisterChanges(FDisabledLargeImagesChangeLink); FDisabledLargeImages := Value; if FDisabledLargeImages <> nil then begin FDisabledLargeImages.RegisterChanges(FDisabledLargeImagesChangeLink); FDisabledLargeImages.FreeNotification(Self); end; DisabledLargeImagesChanged; end; end; function TdxBarManager.GetIsLoading: Boolean; begin Result := csLoading in ComponentState; end; procedure TdxBarManager.SetLargeButtonArrowWidth(Value: Integer); var I: Integer; begin if FLargeButtonArrowWidth <> Value then begin if Value < 2 then Exit; FLargeButtonArrowWidth := Value; for I := 0 to Bars.Count - 1 do with Bars[I] do if Control <> nil then Control.RepaintBar; end; end; procedure TdxBarManager.SetLargeIcons(Value: Boolean); begin if FLargeIcons <> Value then begin FLargeIcons := Value; LargeIconsChanged; end; end; procedure TdxBarManager.SetLargeImages(Value: TCurImageList); begin if FLargeImages <> Value then begin if FLargeImages <> nil then FLargeImages.UnRegisterChanges(FLargeImagesChangeLink); FLargeImages := Value; if FLargeImages <> nil then begin FLargeImages.RegisterChanges(FLargeImagesChangeLink); FLargeImages.FreeNotification(Self); end; if LargeIcons and UseLargeImagesForLargeIcons then LargeIconsChanged; LargeImagesChanged; end; end; procedure TdxBarManager.SetLockUpdate(Value: Boolean); var I: Integer; begin if FLockUpdate <> Value then begin FLockUpdate := Value; for I := 0 to DockControlCount - 1 do with DockControls[I] do if Visible and HandleAllocated then SendMessage(Handle, WM_SETREDRAW, WPARAM(not Self.FLockUpdate), 0); for I := 0 to Bars.Count - 1 do if FBars[I].DockingStyle = dsNone then FBars[I].LockUpdate := FLockUpdate else FBars[I].FLockUpdate := FLockUpdate; if not FLockUpdate then begin // Recreate ItemLink.Control(s) !!! { for I := 0 to Bars.Count - 1 do if FBars[I].DockingStyle <> dsNone then begin if FBars[I].Control <> nil then begin FBars[I].Control.DestroyControls; FBars[I].Control.CreateControls; end; end;} for I := 0 to DockControlCount - 1 do with DockControls[I] do if Visible and HandleAllocated then begin UpdateDock; SendMessage(Handle, WM_NCPAINT, 0, 0); end; for I := 0 to FBars.Count - 1 do if (FBars[I].DockingStyle <> dsNone) and (FBars[I].Control <> nil) then with FBars[I].Control do begin FrameChanged; Repaint; end; end; end; end; procedure TdxBarManager.SetLookAndFeel(Value: TcxLookAndFeel); begin FLookAndFeel.Assign(Value); end; procedure TdxBarManager.SetMakeDisabledImagesFaded(Value: Boolean); var I: Integer; begin if FMakeDisabledImagesFaded <> Value then begin FMakeDisabledImagesFaded := Value; for I := 0 to Bars.Count - 1 do with Bars[I] do if Control <> nil then Control.RepaintBar; end; end; procedure TdxBarManager.SetMenuAnimations(Value: TdxBarMenuAnimations); begin if FMenuAnimations <> Value then begin FMenuAnimations := Value; DesignerModified; UpdateBarManagerOptions; end; end; procedure TdxBarManager.SetMenusShowRecentItemsFirst(Value: Boolean); begin if FMenusShowRecentItemsFirst <> Value then begin FMenusShowRecentItemsFirst := Value; DesignerModified; UpdateBarManagerOptions; end; end; procedure TdxBarManager.SetMostRecentItemsPercents(Value: Byte); begin if Value > 100 then Value := 100; FMostRecentItemsPercents := Value; CalcMostRecentlyUsedUseCount; end; procedure TdxBarManager.SetNotDocking(Value: TdxBarDockingStyles); begin if FNotDocking <> Value then begin FNotDocking := Value; InternalStyleChanged; // TODO: ??? end; end; procedure TdxBarManager.SetPopupMenuLinks(Value: TdxBarPopupMenuLinks); begin FPopupMenuLinks.Assign(Value); end; procedure TdxBarManager.SetScaled(Value: Boolean); begin if FScaled <> Value then begin FScaled := Value; if Value and not FUseSystemFont then AssignFont; end; end; procedure TdxBarManager.SetSelectedItem(Value: TdxBarItemControl); var OldSelectedItem: TdxBarItemControl; begin if FSelectedItem <> Value then begin if IsCustomizing and (FSelectedItem <> nil) and ((Value = nil) or (GetParentBarForControl(Value) <> GetParentBarForControl(FSelectedItem))) then if GetParentBarForControl(FSelectedItem) <> nil then GetParentBarForControl(FSelectedItem).SetMouseSelectedItem(nil) else if (dxBarSubMenuEditor <> nil) and (GetParentBarOrSubMenuForControl(FSelectedItem) = dxBarSubMenuEditor.ItemLinks.BarControl) then dxBarSubMenuEditor.ItemLinks.BarControl.Free; OldSelectedItem := FSelectedItem; FSelectedItem := Value; if (OldSelectedItem <> nil) and (OldSelectedItem.Parent <> nil) and not FDragging then OldSelectedItem.Repaint; if Designing and (FSelectedItem <> nil) and not FDragging then dxBarDesigner.SelectComponent(Self, FSelectedItem.ItemLink.Item); end; end; procedure TdxBarManager.SetShowCloseButton(Value: Boolean); begin if FShowCloseButton <> Value then begin FShowCloseButton := Value; if MainMenuControl <> nil then begin if (SelectedItem <> nil) and (SelectedItem.Parent = MainMenuControl) then SelectedItem := nil; MainMenuControl.RepaintBar; end; end; end; procedure TdxBarManager.SetShowFullMenusAfterDelay(Value: Boolean); begin if FShowFullMenusAfterDelay <> Value then begin FShowFullMenusAfterDelay := Value; DesignerModified; UpdateBarManagerOptions; end; end; procedure TdxBarManager.SetShowHelpButton(Value: Boolean); begin if FShowHelpButton <> Value then begin FShowHelpButton := Value; UpdateHelpButton; end; end; procedure TdxBarManager.SetShowHint(Value: Boolean); begin if FShowHint <> Value then begin FShowHint := Value; DesignerModified; UpdateBarManagerOptions; end; end; procedure TdxBarManager.SetShowShortCutInHint(Value: Boolean); begin if FShowShortCutInHint <> Value then begin FShowShortCutInHint := Value; DesignerModified; UpdateBarManagerOptions; end; end; procedure TdxBarManager.SetStyle(Value: TdxBarManagerStyle); begin if FStyle <> Value then begin FStyle := Value; InternalStyleChanged; end; end; procedure TdxBarManager.SetSunkenBorder(Value: Boolean); var I: Integer; begin if FSunkenBorder <> Value then begin FSunkenBorder := Value; for I := 0 to DockControlCount - 1 do DockControls[I].NCChanged; end; end; procedure TdxBarManager.SetUseSystemFont(Value: Boolean); begin if FUseSystemFont <> Value then begin FUseSystemFont := Value; if FUseSystemFont then MainFormWndProc(WM_SETTINGCHANGE, SPI_SETNONCLIENTMETRICS, 0); end; end; procedure TdxBarManager.SetUseLargeImagesForLargeIcons(Value: Boolean); begin if FUseLargeImagesForLargeIcons <> Value then begin FUseLargeImagesForLargeIcons := Value; LargeIconsChanged; end; end; procedure TdxBarManager.SetWaitForDockingTime(Value: Integer); begin if Value >= 0 then FWaitForDockingTime := Value; end; procedure TdxBarManager.AddCustomizeLink(ItemLinks: TdxBarItemLinks; ABeginGroup: Boolean; ItemClass: TdxBarItemClass); begin if FCanCustomize then begin InternalItemList.Add(ItemClass.Create(nil)); with TdxBarButton(InternalItemList.Last) do begin Caption := cxGetResourceString(@dxSBAR_CUSTOMIZE); Enabled := dxBarCustomizingForm = nil; Tag := 1000; OnClick := ToolbarsPopupClick; end; with ItemLinks.Add do begin Item := TdxBarButton(InternalItemList.Last); BeginGroup := ABeginGroup; end; end; end; procedure TdxBarManager.CalcButtonsConsts; begin if FLargeIcons then begin if IsLargeImagesForLargeIcons then FGlyphSize := LargeImages.Width else FGlyphSize := DefautGlyphSize * 2; end else FGlyphSize := DefautGlyphSize; // * (1 + Byte(FLargeIcons)); FButtonWidth := FGlyphSize + PainterClass.ButtonBorderWidth; FButtonHeight := FGlyphSize + PainterClass.ButtonBorderHeight; FRealButtonArrowWidth := PainterClass.RealButtonArrowWidth(Self); end; procedure TdxBarManager.DrawDraggingLine(AControl: TdxBarItemControl; IsBeginGroup, IsFirstPart, IsVerticalDirection: Boolean); const LineSize = 6; Pairs: array[0..5] of DWORD = (2, 2, 2, 2, 2, 2); type PPoints = ^TPoints; TPoints = array[0..0] of TPoint; var IsLastControl: Boolean; R: TRect; DC: HDC; Origin: Integer; procedure PolyPolyLine(const Points: array of TPoint); begin Windows.PolyPolyLine(DC, PPoints(@Points)^, Pairs, 6); end; begin if IsBeginGroup then begin if IsFirstPart then with AControl do AControl := Parent.ItemLinks.VisibleItems[ItemLink.VisibleIndex - 1].Control; IsFirstPart := not IsFirstPart; end else if not IsFirstPart then begin with AControl do IsLastControl := AControl.FLastInRow or Parent.ItemLinks.VisibleItems[ItemLink.VisibleIndex + 1].BeginGroup; if not IsLastControl then begin with AControl do AControl := Parent.ItemLinks.VisibleItems[ItemLink.VisibleIndex + 1].Control; IsFirstPart := True; end; end; R := AControl.Parent.GetItemRect(AControl); DC := AControl.Parent.Canvas.Handle; with R do begin SetROP2(DC, R2_NOT); if IsVerticalDirection then begin if IsFirstPart then Origin := R.Top else Origin := R.Bottom - LineSize; PolyPolyLine( [Point(Left, Origin), Point(Left, Origin + LineSize), Point(Left + 1, Origin + 1), Point(Left + 1, Origin + LineSize - 1), Point(Left + 2, Origin + 2), Point(Right - 2, Origin + 2), Point(Left + 2, Origin + 3), Point(Right - 2, Origin + 3), Point(Right - 2, Origin + 1), Point(Right - 2, Origin + LineSize - 1), Point(Right - 1, Origin), Point(Right - 1, Origin + LineSize)]); end else begin if IsFirstPart then Origin := R.Left else Origin := R.Right - LineSize; PolyPolyLine( [Point(Origin, Top), Point(Origin + LineSize, Top), Point(Origin + 1, Top + 1), Point(Origin + LineSize - 1, Top + 1), Point(Origin + 2, Top + 2), Point(Origin + 2, Bottom - 2), Point(Origin + 3, Top + 2), Point(Origin + 3, Bottom - 2), Point(Origin + 1, Bottom - 2), Point(Origin + LineSize - 1, Bottom - 2), Point(Origin, Bottom - 1), Point(Origin + LineSize, Bottom - 1)]); end; SetROP2(DC, R2_COPYPEN); end; end; procedure TdxBarManager.FontChanged(Sender: TObject); procedure ProcessBars; var I: Integer; begin for I := 0 to Bars.Count - 1 do with Bars[I] do begin FInternalFontChange := True; try if UseOwnFont then FontChanged(nil) else Font := Self.FFont; finally FInternalFontChange := False; end; end; end; procedure ProcessPopupMenus; var I: Integer; begin for I := 0 to FPopupMenus.Count - 1 do with TdxBarPopupMenu(FPopupMenus[I]) do begin FInternalFontChange := True; try if UseOwnFont then FontChanged(nil) else Font := Self.FFont; finally FInternalFontChange := False; end; end; end; begin if not FInternalFontChange then FUseSystemFont := False; if FScaled then begin FFont.OnChange := nil; try AssignFont; finally FFont.OnChange := FontChanged; end; end; CreateEditFontHandle(FFont, FEditFontHandle, FScaled); ProcessBars; ProcessPopupMenus; end; { TSystemMenuSubItem } type TSystemMenuSubItem = class(TCustomdxBarSubItem) private FMDIChildHandle: HWND; function GetIconHandle: HICON; procedure ButtonClick(Sender: TObject); protected procedure BuildMenu; procedure DirectClick; override; public property IconHandle: HICON read GetIconHandle; property MDIChildHandle: HWND read FMDIChildHandle write FMDIChildHandle; end; function TSystemMenuSubItem.GetIconHandle: HICON; begin Result := SendMessage(FMDIChildHandle, WM_GETICON, ICON_SMALL, 0); if Result = 0 then Result := SendMessage(FMDIChildHandle, WM_GETICON, ICON_BIG, 0); Result := CopyImage(Result, IMAGE_ICON, 16, 16, LR_COPYFROMRESOURCE); end; procedure TSystemMenuSubItem.ButtonClick(Sender: TObject); begin with TdxBarItem(Sender) do SendMessage(MDIChildHandle, WM_SYSCOMMAND, Tag, 0); end; procedure TSystemMenuSubItem.BuildMenu; const SLength = 1024; procedure BuildSubMenu(SubItem: TCustomdxBarSubItem; Menu: HWND); const BitmapNames: array[HBMMENU_POPUP_CLOSE..HBMMENU_POPUP_MINIMIZE] of string = ('DXBARCLOSE', 'DXBARRESTORE', 'DXBARMAXIMIZE', 'DXBARMINIMIZE'); var ABeginGroup: Boolean; S: PChar; I, P: Integer; MI: TMenuItemInfo; AShortCutText: string; AItem: TdxBarItem; begin ABeginGroup := False; GetMem(S, SLength); try for I := 0 to GetMenuItemCount(Menu) - 1 do begin with MI do begin if not IsWin95 then cbSize := SizeOf(MI) else begin cbSize := 44; MI.hbmpItem := 0; end; fMask := MIIM_CHECKMARKS or MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE; dwTypeData := S; cch := SLength; end; GetMenuItemInfo(Menu, I, True, MI); if MI.fType and MFT_SEPARATOR <> 0 then begin ABeginGroup := True; Continue; end; if MI.fType and MFT_BITMAP <> 0 then GetMenuString(Menu, I, S, SLength, MF_BYPOSITION) else if MI.cch = 0 then StrCopy(S, ''); P := Pos(#9, S); if P = 0 then AShortCutText := '' else begin AShortCutText := Copy(S, P + 1, Length(S) - P); StrLCopy(S, S, P - 1); end; if MI.hSubMenu = 0 then begin AItem := TdxBarButton.Create(Owner); if MI.fState and MFS_CHECKED <> 0 then with TdxBarButton(AItem) do begin ButtonStyle := bsChecked; Down := True; end; with AItem do begin Tag := MI.wID; OnClick := ButtonClick; end; end else begin AItem := TdxBarSubItem.Create(Owner); BuildSubMenu(TCustomdxBarSubItem(AItem), MI.hSubMenu); end; InternalItemList.Add(AItem); with AItem do begin Caption := S; Enabled := MI.fState and (MFS_DISABLED or MFS_GRAYED) = 0; if MI.hbmpItem in [HBMMENU_POPUP_CLOSE..HBMMENU_POPUP_MINIMIZE] then Glyph.Handle := LoadBitmap(HInstance, PChar(BitmapNames[MI.hbmpItem])) else begin if MI.fState and MFS_CHECKED <> 0 then if MI.hbmpChecked <> 0 then Glyph.Handle := CopyImage(MI.hbmpChecked, IMAGE_BITMAP, 0, 0, 0) else else if MI.hbmpUnchecked <> 0 then Glyph.Handle := CopyImage(MI.hbmpUnchecked, IMAGE_BITMAP, 0, 0, 0); if (Glyph.Handle = 0) and (MI.fType and MFT_BITMAP <> 0) then Glyph.Handle := CopyImage(HBITMAP(MI.dwTypeData), IMAGE_BITMAP, 0, 0, 0); end; ShortCut := TextToShortCut(AShortCutText); end; with SubItem.ItemLinks.Add do begin BeginGroup := ABeginGroup; Item := AItem; end; ABeginGroup := False; end; finally FreeMem(S); end; end; begin ClearInternalItemList; BuildSubMenu(Self, GetSystemMenu(FMDIChildHandle, False)); end; procedure TSystemMenuSubItem.DirectClick; begin BuildMenu; inherited; end; { TSystemMenuSubItemControl } type TSystemMenuSubItemControl = class(TdxBarSubItemControl) private function GetItem: TSystemMenuSubItem; protected function CanCustomize: Boolean; override; function CanSelect: Boolean; override; procedure DblClick; override; function HasShadow: Boolean; override; function GetHeight: Integer; override; function GetWidth: Integer; override; function IsExpandable: Boolean; override; procedure Paint(ARect: TRect; PaintType: TdxBarPaintType); override; function WantsDblClick: Boolean; override; public property Item: TSystemMenuSubItem read GetItem; end; function TSystemMenuSubItemControl.GetItem: TSystemMenuSubItem; begin Result := TSystemMenuSubItem(ItemLink.Item); end; function TSystemMenuSubItemControl.CanCustomize: Boolean; begin Result := False; end; function TSystemMenuSubItemControl.CanSelect: Boolean; begin Result := not BarManager.IsCustomizing; end; procedure TSystemMenuSubItemControl.DblClick; begin inherited; Parent.HideAll; with Item do SendMessage(FMDIChildHandle, WM_SYSCOMMAND, GetMenuDefaultItem(GetSystemMenu(FMDIChildHandle, False), 0, 0), 0); end; function TSystemMenuSubItemControl.HasShadow: Boolean; begin Result := False; end; function TSystemMenuSubItemControl.GetHeight: Integer; begin Result := GetSystemMetrics(SM_CYSMICON); end; function TSystemMenuSubItemControl.GetWidth: Integer; begin Result := GetSystemMetrics(SM_CXSMICON); end; function TSystemMenuSubItemControl.IsExpandable: Boolean; begin Result := False; end; procedure TSystemMenuSubItemControl.Paint(ARect: TRect; PaintType: TdxBarPaintType); var Icon: HIcon; begin Icon := Item.IconHandle; with ARect do begin Parent.FillBackground(Parent.Canvas.Handle, ARect, Parent.BkBrush, clNone, True); DrawIconEx(Parent.Canvas.Handle, Left, Top, Icon, Right - Left, Bottom - Top, 0, 0{Parent.BkBrush}, DI_NORMAL); end; DestroyIcon(Icon); end; function TSystemMenuSubItemControl.WantsDblClick: Boolean; begin Result := True; end; { continuation } function TdxBarManager.ActiveMDIChild: HWND; begin Result := SendMessage(TDummyForm(FMainForm).ClientHandle, WM_MDIGETACTIVE, 0, 0); end; procedure TdxBarManager.MainFormClientWndProc(Msg: UINT; wParam: WPARAM; lParam: LPARAM); var AActiveMDIChild: HWND; PrevIsMDIMaximized: Boolean; PrevLockUpdate: Boolean; procedure RefreshMainMenu(AWnd: HWND; AddItems, OnlySystemMenu, LeaveUpdateLocked: Boolean); var AForm: TWinControl; ABarManager: TdxBarManager; I: Integer; AItemLink: TdxBarItemLink; procedure CreateMDIChildSystemMenu(AWnd: HWND); var SystemMenuSubItem: TSystemMenuSubItem; begin if GetSystemMenu(AWnd, False) = 0 then Exit; MainMenuBar.LockUpdate := True; ClearInternalItemList; SystemMenuSubItem := TSystemMenuSubItem.Create(FMainForm); InternalItemList.Add(SystemMenuSubItem); SystemMenuSubItem.MDIChildHandle := AWnd; with MainMenuBar.ItemLinks.Add do begin Item := SystemMenuSubItem; Index := 0; end; end; procedure DestroyMDIChildSystemMenu; begin if (MainMenuBar.ItemLinks.Count <> 0) and (MainMenuBar.ItemLinks[0].Item is TSystemMenuSubItem) then begin MainMenuBar.LockUpdate := True; MainMenuBar.ItemLinks[0].Free; ClearInternalItemList; end; end; var PrevBoundsRect: TRect; procedure SetRightWindowRect; var AHandle: HWND; R: TRect; begin with TDummyForm(ABarManager.MainForm) do if HandleAllocated then begin AHandle := Handle; PrevBoundsRect := BoundsRect; GetWindowRect(AHandle, R); MapWindowPoints(0, GetParent(AHandle), R, 2); WindowHandle := 0; BoundsRect := R; WindowHandle := AHandle; end; end; procedure RestoreOriginalWindowRect; var AHandle: HWND; begin with TDummyForm(ABarManager.MainForm) do if HandleAllocated then begin AHandle := Handle; WindowHandle := 0; BoundsRect := PrevBoundsRect; WindowHandle := AHandle; end; end; begin AForm := FindControl(AWnd); if (MainMenuBar = nil) or (AForm = nil) then Exit; if AddItems and IsZoomed(AWnd) then CreateMDIChildSystemMenu(AWnd) else if not AddItems then DestroyMDIChildSystemMenu; if OnlySystemMenu then Exit; with TDummyForm(FMainForm) do begin ABarManager := GetBarManagerByForm(TCustomForm(AForm)); if (ABarManager = nil) or (ABarManager.MainMenuBar = nil) then Exit; if AddItems and (FAlwaysMerge or IsZoomed(AWnd)) then begin FPrevChildMainMenuVisible := ABarManager.MainMenuBar.Visible; if Assigned(FOnMenuMerge) then FOnMenuMerge(Self, ABarManager, True) else begin MainMenuBar.LockUpdate := True; for I := 0 to ABarManager.MainMenuBar.ItemLinks.CanVisibleItemCount - 1 do begin AItemLink := MainMenuBar.ItemLinks.Add; AItemLink.Assign(ABarManager.MainMenuBar.ItemLinks.CanVisibleItems[I]); // **** end; MainMenuBar.LockUpdate := PrevLockUpdate; end; SetRightWindowRect; ABarManager.MainMenuBar.Visible := False; RestoreOriginalWindowRect; end; if not AddItems then begin MainMenuBar.LockUpdate := True; for I := MainMenuBar.ItemLinks.CanVisibleItemCount - 1 downto 0 do begin AItemLink := MainMenuBar.ItemLinks.CanVisibleItems[I]; if AItemLink.Item.BarManager = ABarManager then AItemLink.Free; // *** end; if not LeaveUpdateLocked then MainMenuBar.LockUpdate := PrevLockUpdate; if Assigned(FOnMenuMerge) then FOnMenuMerge(Self, ABarManager, False); SetRightWindowRect; if not FAlwaysMerge and not ABarManager.MainMenuBar.Visible then ABarManager.MainMenuBar.Visible := FPrevChildMainMenuVisible; RestoreOriginalWindowRect; end; end; end; begin AActiveMDIChild := ActiveMDIChild; PrevIsMDIMaximized := IsMDIMaximized; IsMDIMaximized := (AActiveMDIChild <> 0) and IsZoomed(AActiveMDIChild); if MainMenuBar <> nil then PrevLockUpdate := MainMenuBar.LockUpdate else PrevLockUpdate := False; try if AActiveMDIChild <> FPrevActiveMDIChild then begin RefreshMainMenu(FPrevActiveMDIChild, False, False, True); RefreshMainMenu(AActiveMDIChild, True, False, False); end else if IsMDIMaximized <> PrevIsMDIMaximized then RefreshMainMenu(AActiveMDIChild, IsMDIMaximized, FAlwaysMerge, False); finally if MainMenuBar <> nil then MainMenuBar.LockUpdate := PrevLockUpdate; end; if (IsMDIMaximized <> PrevIsMDIMaximized) and (MainMenuControl <> nil) then MainMenuControl.RepaintBar; FPrevActiveMDIChild := AActiveMDIChild; end; procedure TdxBarManager.MainFormWndProc(Msg: UINT; wParam: WPARAM; lParam: LPARAM); var AControl: TWinControl; P: TPoint; AItem: TdxBarItemControl; ContextID: Integer; I: Integer; procedure ActivateToolbars(Activate, ForceHiding: Boolean; ActiveWindow: HWND); begin FMainFormActive := Activate; ShowToolbars(Activate, ForceHiding, ActiveWindow); end; begin if (csDestroying in FMainForm.ComponentState) or (FMainForm = dxBarCustomizingForm) then begin if (Msg = WM_DESTROY) and not FDesigning then begin if FStoreInRegistry then SaveToRegistry(FRegistryPath); if FStoreInIniFile then SaveToIniFile(FIniFileName); end; Exit; end; case Msg of WM_ACTIVATE: begin if (LOWORD(wParam) = WA_INACTIVE) and (FindControl(lParam) is TCustomdxBarControl) then with TCustomdxBarControl(FindControl(lParam)) do if (BarManager = Self) {and IsActive}{for control containers} then Exit; FMainFormActive := LOWORD(wParam) <> WA_INACTIVE; // if (LOWORD(wParam) <> WA_INACTIVE) and not IsWindowVisible(MainForm.Handle) then Exit; ActivateToolbars(FMainFormActive, False, lParam); // notify MDI Forms if (TDummyForm(MainForm).ActiveMDIChild <> nil) and (GetBarManagerByForm(TDummyForm(MainForm).ActiveMDIChild) <> nil) then GetBarManagerByForm(TDummyForm(MainForm).ActiveMDIChild).MainFormWndProc(Msg, wParam, lParam); if not FToolbarsVisibleChanging and FMainFormActive and (dxBarCustomizingForm <> nil) and FIsCustomizing and not IsWindowEnabled(MainForm.Handle) then SendMessage(dxBarCustomizingForm.Handle, Msg, wParam, MainForm.Handle); end; WM_ACTIVATEAPP: if wParam = 0 then begin // notify MDI Forms if (TDummyForm(MainForm).ActiveMDIChild <> nil) and (GetBarManagerByForm(TDummyForm(MainForm).ActiveMDIChild) <> nil) then GetBarManagerByForm(TDummyForm(MainForm).ActiveMDIChild).MainFormWndProc(Msg, wParam, lParam); ActivateToolbars(False, False, 0); if SelectedItem <> nil then SendMessage(SelectedItem.Parent.Handle, WM_MOUSELEAVE, 0, 0); SelectedItem := nil; end; WM_CHILDACTIVATE: ActivateToolbars(True, False, 0); WM_CREATE: if BarRestoringListExists then begin FIsHandleCreating := True; try for I := 0 to DockControlCount - 1 do if CanAllocateHandle(DockControls[I]) then // for BarDockControl DockControls[I].HandleNeeded; ShowBarsFromRestoringList(nil); finally if RestoringListBarCount = 0 then // for BarDockControl DestroyBarRestoringList; FIsHandleCreating := False; end; end; WM_DISPLAYCHANGE: CheckToolbarsVisibility; WM_HELP: if not FDesigning then with PHelpInfo(lParam)^ do if iContextType = HELPINFO_WINDOW then begin AItem := nil; if ActiveBarControl <> nil then begin AControl := ActiveBarControl; AItem := TCustomdxBarControl(AControl).SelectedItem; if (AItem = nil) or (AItem.Item.HelpContext = 0) then begin while TCustomdxBarControl(AControl).ParentBar <> nil do begin AItem := TdxBarSubMenuControl(AControl).FSubItem; AControl := TCustomdxBarControl(AControl).ParentBar; if AItem.Item.HelpContext <> 0 then Break; end; if (AItem = nil) or (AItem.Item.HelpContext = 0) then begin HideAll; ContextID := AControl.HelpContext; if ContextID <> 0 then if biHelp in TDummyForm(FMainForm).BorderIcons then Application.HelpCommand(HELP_CONTEXTPOPUP, ContextID) else Application.HelpContext(ContextID); Exit; end; end; end else begin AControl := FindControl(hItemHandle); if AControl is TCustomdxBarControl then begin P := MousePos; ScreenToClient(AControl.Handle, P); AItem := TCustomdxBarControl(AControl).ItemAtPos(P); end; end; if AItem <> nil then begin with AItem.ItemLink.ItemRect do P := Point((Left + Right) div 2, Bottom); ClientToScreen(AControl.Handle, P); ContextID := AItem.Item.HelpContext; HideAll; if ContextID = 0 then Exit; if biHelp in TDummyForm(FMainForm).BorderIcons then begin Application.HelpCommand(HELP_SETPOPUP_POS, Longint(PointToSmallPoint(P))); Application.HelpCommand(HELP_CONTEXTPOPUP, ContextID); end else Application.HelpContext(ContextID); end; end; WM_MDIACTIVATE: if TDummyForm(MainForm).FormStyle = fsMDIChild then ActivateToolbars(HWND(lParam) = MainForm.Handle, False, 0); {WM_NCACTIVATE: - does not allow submenu.edit.setfocus if TDummyForm(MainForm).FormStyle = fsMDIChild then ActivateToolbars(Boolean(wParam), False, 0);} WM_SETTINGCHANGE: case wParam of SPI_SETNONCLIENTMETRICS: AssignFont; SPI_SETWORKAREA: CheckToolbarsVisibility; end; WM_SYSCOLORCHANGE: begin RefreshDeviceConsts; CreatePatternBrush; RecreateToolbarsBrushes; RefreshFloatingBarsShadows; if TDummyForm(MainForm).FormStyle = fsMDIForm then for I := 0 to dxBarManagerList.Count - 1 do if TDummyForm(dxBarManagerList[I].MainForm).FormStyle = fsMDIChild then dxBarManagerList[I].MainFormWndProc(MSg, wParam, lParam); end; WM_SYSCOMMAND: begin if (wParam = SC_CLOSE) and FDesigning and (ActiveBarControl <> nil) and (ActiveBarControl.BarManager = Self) then ActiveBarControl.HideAll; if (wParam = SC_MINIMIZE) or (wParam = SC_MAXIMIZE) or (wParam = SC_RESTORE) or (wParam = SC_CLOSE) then begin for I := 0 to Bars.Count - 1 do with Bars[I] do if Visible and (Control <> nil) and (DockingStyle = dsNone) then with Control do if (wParam = SC_MINIMIZE) or (wParam = SC_CLOSE) then ShowWindow(Handle, SW_HIDE) else begin ShowWindow(Handle, SW_SHOWNOACTIVATE); UpdateWindow(Handle); end; //if IsWindowVisible(MainForm.Handle) then ProcessPaintMessages; end; end; WM_WINDOWPOSCHANGED: if FIsCustomizing and (dxBarCustomizingForm <> nil) then begin dxBarCustomizingForm.UpdateVisibility(PWindowPos(lParam)^); if dxBarSubMenuEditor <> nil then if PWindowPos(lParam)^.flags and SWP_SHOWWINDOW <> 0 then ShowWindow(dxBarSubMenuEditor.Handle, SW_SHOWNA) else if PWindowPos(lParam)^.flags and SWP_HIDEWINDOW <> 0 then ShowWindow(dxBarSubMenuEditor.Handle, SW_HIDE); end; WM_WINDOWPOSCHANGING: if (PWindowPos(lParam)^.flags and SWP_HIDEWINDOW <> 0) and (PWindowPos(lParam)^.hwnd = MainForm.Handle) then ActivateToolbars(False, True, 0); end; end; function TdxBarManager.LoadMainFormFromBin: TForm; var HInstance: HINST; ResName, S: string; HResource: THandle; PrevCursor: TCursor; ResStream: TResourceStream; OutStream, BinStream: TMemoryStream; StrList, OutStrList: TStringList; I, J: Integer; TempBarManager: TdxBarManager; begin Result := nil; HInstance := FindResourceHInstance(FindClassHInstance(MainForm.ClassType)); ResName := MainForm.ClassName; HResource := FindResource(HInstance, PChar(ResName), RT_RCDATA); if HResource = 0 then Exit; PrevCursor := Screen.Cursor; Screen.Cursor := crHourglass; ResStream := TResourceStream.Create(HInstance, ResName, RT_RCDATA); OutStream := TMemoryStream.Create; BinStream := TMemoryStream.Create; try ObjectBinaryToText(ResStream, OutStream); OutStream.Position := 0; StrList := TStringList.Create; try StrList.LoadFromStream(OutStream); OutStrList := TStringList.Create; try // add Width, Height, ClientWidth, ClientHeight values J := 0; for I := 1 to StrList.Count - 1 do begin S := StrList[I]; if (Copy(S, 3, 7) = 'Width =') or (Copy(S, 3, 8) = 'Height =') or (Copy(S, 3, 13) = 'ClientWidth =') or (Copy(S, 3, 14) = 'ClientHeight =') then begin OutStrList.Add(StrList[I]); Inc(J); if J = 2 then Break; end; end; S := 'object ' + Name + ': ' + ClassName; for I := 5 to StrList.Count - 1 do if Trim(StrList[I]) = S then begin S := Copy(StrList[I], 1, Pos('o', StrList[I]) - 1) + 'end'; for J := I to StrList.Count - 1 do begin if Copy(TrimLeft(StrList[J]), 1, 2) <> 'On' then OutStrList.Add(StrList[J]); if StrList[J] = S then Break; end; OutStrList.Insert(0, 'object TempForm: TdxBarTempForm'); OutStrList.Add('end'); OutStream.Clear; OutStrList.SaveToStream(OutStream); OutStream.Position := 0; ObjectTextToBinary(OutStream, BinStream); BinStream.Position := 0; Result := TForm.Create(nil); try RegisterClass(TPersistentClass(ClassType)); InternalLoading := True; try BinStream.ReadComponent(Result); finally InternalLoading := False; end; UnregisterClass(TPersistentClass(ClassType)); except Result.Free; Result := nil; raise; end; Break; end; finally OutStrList.Free; end; finally StrList.Free; end; finally BinStream.Free; OutStream.Free; ResStream.Free; Screen.Cursor := PrevCursor; end; if Result <> nil then begin TempBarManager := TdxBarManager(Result.FindComponent(Name)); if TempBarManager <> nil then begin TempBarManager.StoreInIniFile := False; TempBarManager.StoreInRegistry := False; end; end; end; procedure TdxBarManager.CheckToolbarsVisibility; var WorkArea, R: TRect; I: Integer; begin with FMainForm do WorkArea := GetWorkArea(Point(Left + Width div 2, Top + Height div 2)); for I := 0 to FBars.Count - 1 do with FBars[I] do if DockingStyle = dsNone then begin if Control = nil then R := Bounds(FloatLeft, FloatTop, BarNCSizeX(dsNone) + FloatClientWidth, BarNCSizeY(dsNone) + FloatClientHeight) else R := Control.BoundsRect; with WorkArea do begin if R.Bottom > Bottom then OffsetRect(R, 0, Bottom - R.Bottom); if R.Top < Top then OffsetRect(R, 0, Top - R.Top); if R.Right > Right then OffsetRect(R, Right - R.Right, 0); if R.Left < Left then OffsetRect(R, Left - R.Left, 0); end; if Control = nil then begin FloatLeft := R.Left; FloatTop := R.Top; end else Control.BoundsRect := R; end; end; var HintTimerABarManager: TdxBarManager; procedure ShowHintTimerProc(Wnd: HWnd; Msg, TimerID, SysTime: Longint); stdcall; begin if (HintTimerABarManager <> nil) and not HintTimerABarManager.IsDestroying then with HintTimerABarManager do begin KillHintTimer; DisplayHint; end; end; procedure HideHintTimerProc(Wnd: HWnd; Msg, TimerID, SysTime: Longint); stdcall; begin if (HintTimerABarManager <> nil) and not HintTimerABarManager.IsDestroying then with HintTimerABarManager do begin KillHintTimer; HintActivate(False, ''); end; end; procedure KillHiddenHintTimerProc(Wnd: HWnd; Msg, TimerID, SysTime: Longint); stdcall; begin KillHiddenHintTimer; end; procedure TdxBarManager.DisplayHint; var P: TPoint; S, S1: string; Action: TBasicAction; begin if (SelectedItem <> nil) and (SelectedItem.Parent <> nil) and not SelectedItem.Parent.IsActive or (FCustomHint <> '') then begin GetCursorPos(P); if FCustomHint = '' then with SelectedItem.Parent do if ItemAtPos(ScreenToClient(P)) <> Self.SelectedItem then Exit; Inc(P.Y, HintOffset); if FCustomHint = '' then begin S := GetShortHint(SelectedItem.Hint); Action := SelectedItem.Item.Action; if Action is TCustomAction then if not TCustomAction(Action).DoHint(S) then begin HintActivate(False, ''); Exit; end; end else S := FCustomHint; if (S <> '') and ((FCustomHint <> '') or (SelectedItem.Enabled or ShowHintForDisabledItems)) then begin if (FCustomHint = '') and (ShowShortCutInHint or Application.HintShortCuts) then begin S1 := ShortCutToText(SelectedItem.ShortCut); if S1 <> '' then S := S + ' (' + S1 + ')'; end; FHintWindow.ActivateHint(P, S, Self); FHintWindowShowing := True; HintTimerABarManager := Self; FHintTimerID := SetTimer(0, 0, dxBarWaitForHideHintTime, @HideHintTimerProc); end else HintActivate(False, ''); end; end; var FHintTimerPrevShow: Boolean; //*** procedure TdxBarManager.HintActivate(AShow: Boolean; const CustomHint: string); var PrevShow: Boolean; begin if IsCustomizing or not FShowHint or (not AShow and not FHintTimerPrevShow){***} then Exit; FHintTimerPrevShow := AShow; //*** FCustomHint := CustomHint; FHintWindowShowing := False; PrevShow := AShow; AShow := AShow and ((FSelectedItem <> nil) and not FSelectedItem.Parent.IsActive or (FCustomHint <> '')); if AShow then begin KillHintTimer; if not IsWindowVisible(FHintWindow.Handle) and not FLiveHiddenHint then begin HintTimerABarManager := Self; FHintTimerID := SetTimer(0, 0, dxBarWaitForShowHintTime, @ShowHintTimerProc); end else DisplayHint; end else begin KillHintTimer; if IsWindowVisible(FHintWindow.Handle) then begin ShowWindow(FHintWindow.Handle, SW_HIDE); if PrevShow then begin KillHiddenHintTimer; FLiveHiddenHint := True; FHiddenHintTimerID := SetTimer(0, 0, dxBarHiddedHintLifeTime, @KillHiddenHintTimerProc); end; end; end; end; procedure TdxBarManager.DestroyItems; var AItem: TdxBarItem; begin while FItems.Count > 0 do begin AItem := TdxBarItem(FItems.Last); FItems.Remove(AItem); AItem.Free; end; end; procedure TdxBarManager.HelpButtonGlyphChanged(Sender: TObject); begin UpdateHelpButton; end; procedure TdxBarManager.HotImageListChange(Sender: TObject); begin HotImagesChanged; end; procedure TdxBarManager.ImageListChange(Sender: TObject); begin if not IsLoading then ImagesChanged; end; procedure TdxBarManager.LargeIconsChanged; var I: Integer; begin CalcButtonsConsts; DesignerModified; UpdateBarManagerOptions; for I := 0 to Bars.Count - 1 do with Bars[I] do if Control <> nil then Control.RepaintBar; end; procedure TdxBarManager.LargeImageListChange(Sender: TObject); begin LargeImagesChanged; end; procedure TdxBarManager.DisabledImageListChange(Sender: TObject); begin DisabledImagesChanged; end; procedure TdxBarManager.DisabledLargeImageListChange(Sender: TObject); begin DisabledLargeImagesChanged; end; procedure TdxBarManager.ToolbarsPopupClick(Sender: TObject); begin if TComponent(Sender).Tag = 1000 then Customizing(True) else with Bars[TComponent(Sender).Tag] do Visible := not Visible; end; procedure TdxBarManager.CalcMostRecentlyUsedUseCount; var I: Integer; begin if FMostRecentItemsPercents = 100 then FMostRecentlyUsedUseCount := 0 else for I := 1 to MaxInt do if I * (100 - FMostRecentItemsPercents) div 100 > 0 then begin FMostRecentlyUsedUseCount := I; Break; end; end; function TdxBarManager.ShowRecentItemsFirst: Boolean; begin Result := CanShowRecentItems and MenusShowRecentItemsFirst; end; procedure TdxBarManager.AddDockControl(ADockControl: TdxDockControl); begin FDockControls.Add(ADockControl); FreeNotification(ADockControl); end; procedure TdxBarManager.RemoveDockControl(ADockControl: TdxDockControl); var I: Integer; begin if FBars <> nil then for I := 0 to FBars.Count - 1 do with FBars[I] do begin if DockControl = ADockControl then DockControl := nil; if DockedDockControl = ADockControl then DockedDockControl := nil; if RealDockControl = ADockControl then Visible := False; end; if FDockControls <> nil then FDockControls.Remove(ADockControl); if ADockControl.Main and (FBars <> nil) then FBars.FDockControls[ADockControl.FDockingStyle] := nil; ADockControl.ParentColor := True; end; procedure TdxBarManager.AddGroup(AGroup: TdxBarGroup); begin FGroups.Add(AGroup); AGroup.FBarManager := Self; end; procedure TdxBarManager.RemoveGroup(AGroup: TdxBarGroup); begin FGroups.Remove(AGroup); end; function TdxBarManager.IsDockColorStored: Boolean; begin Result := not FAutoDockColor; end; procedure TdxBarManager.ReadDockControlHeights(Reader: TReader); begin with Reader, FBars do begin ReadListBegin; try FDockControls[dsLeft].Width := ReadInteger; FDockControls[dsRight].Width := ReadInteger; FDockControls[dsTop].Height := ReadInteger; FDockControls[dsBottom].Height := ReadInteger; finally ReadListEnd; end; end; end; procedure TdxBarManager.WriteDockControlHeights(Writer: TWriter); begin with Writer, FBars do begin WriteListBegin; try WriteInteger(FDockControls[dsLeft].Width); WriteInteger(FDockControls[dsRight].Width); WriteInteger(FDockControls[dsTop].Height); WriteInteger(FDockControls[dsBottom].Height); finally WriteListEnd; end; end; end; procedure TdxBarManager.CreateFlatToolbarsBrushes; begin DestroyFlatToolbarsBrushes; FFlatToolbarsBorderBrush := CreateSolidBrush(FlatToolbarsBorderColor); FFlatToolbarsBrush := CreateSolidBrush(FlatToolbarsColor); FFlatToolbarsDownedBrush := CreateSolidBrush(FlatToolbarsDownedColor); FFlatToolbarsDownedSelBrush := CreateSolidBrush(FlatToolbarsDownedSelColor); FFlatToolbarsSelBrush := CreateSolidBrush(FlatToolbarsSelColor); end; procedure TdxBarManager.DestroyFlatToolbarsBrushes; begin if FFlatToolbarsSelBrush <> 0 then DeleteObject(FFlatToolbarsSelBrush); if FFlatToolbarsDownedSelBrush <> 0 then DeleteObject(FFlatToolbarsDownedSelBrush); if FFlatToolbarsDownedBrush <> 0 then DeleteObject(FFlatToolbarsDownedBrush); if FFlatToolbarsBrush <> 0 then DeleteObject(FFlatToolbarsBrush); if FFlatToolbarsBorderBrush <> 0 then DeleteObject(FFlatToolbarsBorderBrush); end; procedure TdxBarManager.CreateThemeToolbarsBrushes; begin DestroyThemeToolbarsBrushes; if FThemeAvailable then begin FThemeToolbarsBrush := CreateSolidBrush(ThemeToolbarColor); // FThemeToolbarsDownedBrush := CreateSolidBrush(); // FThemeToolbarsDownedSelBrush := CreateSolidBrush(); // FThemeToolbarsSelBrush := CreateSolidBrush(); end; end; procedure TdxBarManager.DestroyThemeToolbarsBrushes; begin // if FThemeToolbarsSelBrush <> 0 then DeleteObject(FThemeToolbarsSelBrush); // if FThemeToolbarsDownedSelBrush <> 0 then DeleteObject(FThemeToolbarsDownedSelBrush); // if FThemeToolbarsDownedBrush <> 0 then DeleteObject(FThemeToolbarsDownedBrush); if FThemeToolbarsBrush <> 0 then DeleteObject(FThemeToolbarsBrush); end; procedure TdxBarManager.DestroyToolbarsBrushes; begin DestroyThemeToolbarsBrushes; DestroyFlatToolbarsBrushes; ReleaseOffice11Colors; end; procedure TdxBarManager.CreateToolbarsBrushes; begin CreateFlatToolbarsBrushes; CreateThemeToolbarsBrushes; CreateOffice11Colors; ResetBackgrounds; end; procedure TdxBarManager.RecreateToolbarsBrushes; begin CreateFlatToolbarsBrushes; CreateThemeToolbarsBrushes; RefreshOffice11Colors; ResetBackgrounds; end; procedure TdxBarManager.RefreshFloatingBarsShadows; var I: Integer; begin for I := 0 to Bars.Count - 1 do if (Bars[I].DockingStyle = dsNone) and (Bars[I].Control <> nil) then Bars[I].Control.RefreshShadow; end; procedure TdxBarManager.ResetBackgrounds; var I: Integer; begin for I := 0 to DockControlCount - 1 do begin // DockControls[I].ResetBackground; DockControls[I].BarManagerChanged; DockControls[I].UpdateDoubleBuffered; DockControls[I].Invalidate; end; for I := 0 to Bars.Count - 1 do if Bars[I].Control <> nil then begin Bars[I].Control.ResetBackground; Bars[I].Control.UpdateDoubleBuffered; Bars[I].Control.FullInvalidate; end; end; procedure TdxBarManager.InitPainterClass; begin FThemeAvailable := AreVisualStylesAvailable([totToolBar, totComboBox, totEdit, totWindow, totScrollBar, totRebar, totStatus, totSpin, totProgress]); FPainterClass := GetPainterClass; end; procedure TdxBarManager.InternalStyleChanged; var I: Integer; begin FChangingStyle := True; try InitPainterClass; FBeforeFingersSize := PainterClass.BeforeFingersSize; FFingersSize := PainterClass.FingersSize; FSubMenuBeginGroupIndent := PainterClass.SubMenuBeginGroupIndent; CalcButtonsConsts; for I := 0 to Bars.Count - 1 do with Bars[I] do if Control <> nil then Control.BarManagerStyleChanged; HostBarManagerStyleChanged; ResetBackgrounds; finally FChangingStyle := False; end; end; procedure TdxBarManager.ThemeChanged; begin InternalStyleChanged; end; procedure TdxBarManager.LFChanged(Sender: TcxLookAndFeel; AChangedValues: TcxLookAndFeelValues); begin if not IsDestroying then InternalStyleChanged; end; procedure TdxBarManager.CreateBarRestoringList; begin if not BarRestoringListExists then FBarRestoringList := TList.Create; end; procedure TdxBarManager.DestroyBarRestoringList; begin FreeAndNil(FBarRestoringList); end; function TdxBarManager.BarRestoringListExists: Boolean; begin Result := FBarRestoringList <> nil; end; procedure TdxBarManager.AddBarToRestoringList(ABar: TdxBar); begin if BarRestoringListExists and (FBarRestoringList.IndexOf(ABar) = -1) then FBarRestoringList.Add(ABar); end; procedure TdxBarManager.RemoveBarFromRestoringList(ABar: TdxBar); begin if BarRestoringListExists then FBarRestoringList.Remove(ABar); end; procedure TdxBarManager.ShowBarsFromRestoringList(ADockControl: TdxBarDockControl); function CanShowBar(ABar: TdxBar): Boolean; begin if ADockControl = nil then Result := (ABar.RealDockControl = nil) or ABar.RealDockControl.HandleAllocated else Result := (ABar.DockControl = ADockControl) and (ABar.DockingStyle <> dsNone); end; var I: Integer; begin for I := RestoringListBarCount - 1 downto 0 do if CanShowBar(RestoringListBars[I]) then RestoringListBars[I].Visible := True; end; procedure TdxBarManager.AssignFont; var NonClientMetrics: TNonClientMetrics; begin NonClientMetrics.cbSize := SizeOf(NonClientMetrics); SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0); if FUseSystemFont then begin FInternalFontChange := True; try Font.Handle := CreateFontIndirect(NonClientMetrics.lfMenuFont); finally FInternalFontChange := False; end; end else if FScaled then Font.Height := NonClientMetrics.lfMenuFont.lfHeight; end; function TdxBarManager.CanReset: Boolean; begin Result := (FReadStateCount = 1) and FAllowReset; end; procedure TdxBarManager.DefineProperties(Filer: TFiler); begin inherited; Filer.DefineProperty('DockControlHeights', ReadDockControlHeights, WriteDockControlHeights, True); end; procedure TdxBarManager.DesignerModified; function ImagesAreLoaded: Boolean; function ComponentIsLoaded(AComponent: TComponent): Boolean; begin Result := (AComponent = nil) or not (csLoading in AComponent.ComponentState); end; begin Result := ComponentIsLoaded(HotImages) and ComponentIsLoaded(Images) and ComponentIsLoaded(LargeImages) and ComponentIsLoaded(DisabledImages) and ComponentIsLoaded(DisabledLargeImages); end; begin if not IsLoading and not IsDestroying and FCanModifyDesigner then begin FModified := True; if Designing and not (csUpdating in ComponentState) and not FFirstDocksUpdate and (FMainForm <> nil) and (FMainForm.Designer <> nil) and ImagesAreLoaded then FMainForm.Designer.Modified; end; end; procedure TdxBarManager.DoBarAfterReset(ABar: TdxBar); begin if Assigned(FOnBarAfterReset) then FOnBarAfterReset(Self, ABar); end; procedure TdxBarManager.DoBarBeforeReset(ABar: TdxBar); begin if Assigned(FOnBarBeforeReset) then FOnBarBeforeReset(Self, ABar); end; procedure TdxBarManager.DoBarClose(ABar: TdxBar); begin if Assigned(FOnBarClose) then FOnBarClose(Self, ABar); end; procedure TdxBarManager.DoBarDockingStyleChanged(ABar: TdxBar); begin if not FBars.FLoading then begin if Assigned(FOnBarDockingStyleChange) then FOnBarDockingStyleChange(Self, ABar); DesignerModified; end; end; procedure TdxBarManager.DoClickItem(AItem: TdxBarItem); begin if Assigned(FOnClickItem) then FOnClickItem(Self, AItem); end; procedure TdxBarManager.DoCloseButtonClick; begin if Assigned(FOnCloseButtonClick) then FOnCloseButtonClick(Self); end; function TdxBarManager.DoDocking(ABar: TdxBar; AStyle: TdxBarDockingStyle; ADockControl: TdxDockControl): Boolean; begin Result := not (AStyle in ABar.NotDocking) and (((ADockControl = nil) or ADockControl.Main) and not (AStyle in NotDocking) or (ADockControl <> nil) and not ADockControl.Main and ADockControl.CanDocking(ABar)); if Assigned(FOnDocking) then FOnDocking(ABar, AStyle, ADockControl, Result); end; procedure TdxBarManager.DoHelpButtonClick; begin if Assigned(FOnHelpButtonClick) then FOnHelpButtonClick(Self); end; procedure TdxBarManager.DoShowCustomizingPopup(PopupItemLinks: TdxBarItemLinks); begin if Assigned(FOnShowCustomizingPopup) then FOnShowCustomizingPopup(Self, PopupItemLinks); end; procedure TdxBarManager.DoShowToolbarsPopup(PopupItemLinks: TdxBarItemLinks); begin if Assigned(FOnShowToolbarsPopup) then FOnShowToolbarsPopup(Self, PopupItemLinks); end; procedure TdxBarManager.DragAndDrop(AItem: TdxBarItem; AItemLink: TdxBarItemLink); var PrevCursor: TCursor; CaptureWnd, Wnd: HWND; WasDragging, EndDrag, DragOverCategories, FDragCopy, CopyModeChanged, FDragLineVisible, IsFirstPart, IsBeginGroup, IsVerticalDirection, FDragOverBeginGroup, FDragOverFirstPart, FDragOverVerticalDirection, FSetBeginGroup, NeedRepaintBar: Boolean; Msg: TMsg; P, DragDownPoint: TPoint; AControl: TWinControl; ABarControl: TCustomdxBarControl; R: TRect; I: Integer; ACursor: TCursor; FDragOverItemControl, AItemControl: TdxBarItemControl; AList: TList; AItemLinks: TdxBarItemLinks; function NeedDragLineVisible: Boolean; begin Result := FDragOverItemControl <> nil; if Result then with FDragOverItemControl, DraggingItemLink do Result := not ((DraggingItemLink <> nil) and (GetAsyncKeyState(VK_CONTROL) >= 0) and ((ItemLink = DraggingItemLink) and (not FDragOverBeginGroup or not FDragOverFirstPart) or (VisibleIndex > 0) and (ItemLink = Owner.VisibleItems[VisibleIndex - 1]) and (not BeginGroup and not FDragOverBeginGroup and not FDragOverFirstPart) or (VisibleIndex < Owner.VisibleItemCount - 1) and (ItemLink = Owner.VisibleItems[VisibleIndex + 1]) and ((FDragOverBeginGroup and FDragOverFirstPart) or (not ItemLink.BeginGroup and FDragOverFirstPart)))); end; procedure DrawDraggingLine; begin if FDragOverItemControl <> nil then begin if not FDragLineVisible then FDragOverItemControl.Parent.Update; Self.DrawDraggingLine(FDragOverItemControl, FDragOverBeginGroup, FDragOverFirstPart, FDragOverVerticalDirection); FDragLineVisible := not FDragLineVisible; end; end; begin FDraggingItem := AItem; FDraggingItemLink := AItemLink; FDragging := True; if FDraggingItemLink <> nil then begin GetCursorPos(DragDownPoint); ScreenToClient(FDraggingItemLink.BarControl.Handle, DragDownPoint); with FDraggingItemLink.ItemRect do begin Dec(DragDownPoint.X, Left); Dec(DragDownPoint.Y, Top); end; end; ABarControl := nil; FDragOverItemControl := nil; FDragOverBeginGroup := False; FDragOverFirstPart := False; FDragOverVerticalDirection := False; WasDragging := False; EndDrag := False; DragOverCategories := False; FDragCopy := GetAsyncKeyState(VK_CONTROL) < 0; CopyModeChanged := False; FDragLineVisible := False; PrevCursor := Screen.Cursor; CaptureWnd := GetWindowForMouseCapturing; SetCapture(CaptureWnd); try while GetCapture = CaptureWnd do begin case Integer(GetMessage(Msg, 0, 0, 0)) of -1: Break; 0: begin PostQuitMessage(Msg.wParam); Break; end; end; with Msg do if ((message = WM_KEYDOWN) or (message = WM_KEYUP)) and (wParam = VK_CONTROL) then begin CopyModeChanged := FDragCopy <> (message = WM_KEYDOWN); FDragCopy := message = WM_KEYDOWN; message := WM_MOUSEMOVE; end; case Msg.message of WM_KEYDOWN, WM_KEYUP: if Msg.wParam = VK_ESCAPE then Break; WM_MOUSEMOVE: begin WasDragging := True; GetCursorPos(P); // don't change this line ABarControl := nil; Wnd := WindowFromPointEx(P); AControl := FindControl(Wnd); if (AControl is TCustomdxBarControl) and (TCustomdxBarControl(AControl).BarManager <> Self) then begin Wnd := 0; AControl := nil; end; if (dxBarCustomizingForm <> nil) and (DraggingItemLink = nil) and FDesigning then with dxBarCustomizingForm.LCategories do if AControl = dxBarCustomizingForm.LCategories then begin Windows.ScreenToClient(Handle, P); I := ItemAtPos(P, True); if (0 <= I) and (I <= Items.Count - 1) then begin ItemIndex := I; ACursor := crdxBarDrag; DragOverCategories := True; end else begin ItemIndex := DraggingItem.Category; ACursor := crdxBarDragNoDrop; DragOverCategories := False; end; SetCursor(Screen.Cursors[ACursor]); Continue; end else begin ItemIndex := DraggingItem.Category; DragOverCategories := False; end; if (dxBarSubMenuEditor <> nil) and (dxBarSubMenuEditor.Handle = Wnd) then dxBarSubMenuEditor.Perform(CM_ACTIVATE, 0, 0) else if AControl is TCustomdxBarControl then ABarControl := TCustomdxBarControl(AControl) else begin if dxBarCustomizingForm <> nil then GetWindowRect(dxBarCustomizingForm.Handle, R); if (dxBarCustomizingForm = nil) or not PtInRect(R, P) then for I := 0 to Bars.Count - 1 do if (Bars[I].Control <> nil) and Bars[I].Control.WantMouse then begin ABarControl := Bars[I].Control; Break; end; end; if (ABarControl <> nil) and not ABarControl.CanCustomizing then ABarControl := nil; if ABarControl <> nil then begin ScreenToClient(ABarControl.Handle, P); AItemControl := ABarControl.ItemAtPosEx(P, IsBeginGroup, IsFirstPart, IsVerticalDirection); end else AItemControl := nil; if (ABarControl = nil) or (AItemControl = nil) and (ABarControl.ItemLinks.VisibleItemCount <> 0) then ACursor := crdxBarDragNoDrop else if (GetAsyncKeyState(VK_CONTROL) < 0) or (FDraggingItemLink = nil) then ACursor := crdxBarDragCopy else ACursor := crdxBarDrag; SetCursor(Screen.Cursors[ACursor]); if ABarControl = nil then begin if FDragLineVisible then DrawDraggingLine; FDragOverItemControl := nil; end else begin if (not (ABarControl is TdxBarSubMenuControl) or (TdxBarSubMenuControl(ABarControl).FScrollTimerID = 0)) and ((AItemControl <> FDragOverItemControl) or (IsBeginGroup <> FDragOverBeginGroup) or (IsFirstPart <> FDragOverFirstPart) or (IsVerticalDirection <> FDragOverVerticalDirection) or CopyModeChanged) then begin if not CopyModeChanged and NeedDragLineVisible or CopyModeChanged and ((FDragCopy and not FDragLineVisible) or (not FDragCopy and FDragLineVisible and not NeedDragLineVisible)) then DrawDraggingLine; if AItemControl <> FDragOverItemControl then begin if AItemControl <> nil then if (AItemControl is TdxBarSubItemControl) or (AItemControl.Parent.SelectedItem is TdxBarSubItemControl) then AItemControl.Parent.SetMouseSelectedItem(AItemControl) else begin // for better painting SelectedItem := AItemControl; AItemControl.Parent.FSelectedItem := AItemControl; end; FDragOverItemControl := AItemControl; end; if (FDragOverItemControl <> nil) and not CopyModeChanged then begin FDragOverBeginGroup := IsBeginGroup; FDragOverFirstPart := IsFirstPart; FDragOverVerticalDirection := IsVerticalDirection; if NeedDragLineVisible then DrawDraggingLine; end; CopyModeChanged := False; end; if ABarControl is TdxBarSubMenuControl then begin SendMessage(ABarControl.Handle, WM_MOUSEMOVE, 0, MakeLParam(P.X, P.Y)); if TdxBarSubMenuControl(ABarControl).FScrollTimerID > 0 then begin if FDragLineVisible then DrawDraggingLine; FDragOverItemControl := nil; end; end; end; end; WM_LBUTTONUP: begin EndDrag := True; Break; end; else TranslateMessage(Msg); DispatchMessage(Msg); end; end; finally if FDragLineVisible and (SelectedItem <> nil) and (SelectedItem = FDragOverItemControl) then DrawDraggingLine; if GetCapture = CaptureWnd then ReleaseCapture; SetCursor(Screen.Cursors[PrevCursor]); if FDraggingItemLinkParentHandle <> 0 then begin DestroyWindow(FDraggingItemLinkParentHandle); FDraggingItemLinkParentHandle := 0; end; FDragging := False; if EndDrag and WasDragging then if DragOverCategories then if (dxBarCustomizingForm <> nil) and (DraggingItem.Category <> dxBarCustomizingForm.LCategories.ItemIndex) then with dxBarCustomizingForm do // move item to another category begin AList := TList.Create; GetAllItemsByCategory(LCategories.ItemIndex, AList); if AList.Count > 0 then begin I := TdxBarItem(AList[AList.Count - 1]).Index + 1; if I > ItemCount - 1 then Dec(I); MoveItem(DraggingItem.Index, I); end; AList.Free; DraggingItem.Category := LCategories.ItemIndex; end else else if ABarControl = nil then begin if (DraggingItemLink <> nil) and (GetAsyncKeyState(VK_CONTROL) >= 0) then begin // delete dragging itemlink DraggingItemLink.Free; FDraggingItemLink := nil; DesignerModified; end; if FSelectedItem <> nil then begin ABarControl := FSelectedItem.Parent; FSelectedItem := nil; ABarControl.RepaintBar; end; end else if ABarControl <> nil then if (FDragOverItemControl <> nil) and (FDraggingItemLink <> nil) and ((FDragOverItemControl.ItemLink = FDraggingItemLink) or not NeedDragLineVisible) and (GetAsyncKeyState(VK_CONTROL) >= 0) and not (FDragOverBeginGroup and FDragOverFirstPart) then begin // change BeginGroup only GetCursorPos(P); ScreenToClient(FDraggingItemLink.BarControl.Handle, P); with FDraggingItemLink.ItemRect do begin Dec(P.X, Left); Dec(P.Y, Top); end; if (ABarControl is TdxBarSubMenuControl) or IsRealVertical(ABarControl) then I := P.Y - DragDownPoint.Y else I := P.X - DragDownPoint.X; if Abs(I) >= MakeBeginGroupDragSize then with FDraggingItemLink do if BeginGroup <> (I > 0) then begin BarControl.FSelectedItem := Control; FSelectedItem := Control; BeginGroup := I > 0; end else BarControl.SetKeySelectedItem(Control); end else // create new [and delete old] itemlink if (FDragOverItemControl <> nil) or PtInRect(ABarControl.ClientRect, P) and (ABarControl.ItemLinks.VisibleItemCount = 0) then with ABarControl.ItemLinks.Add do begin InternalBringToTopInRecentList(True); AItemLinks := ABarControl.ItemLinks; Item := FDraggingItem; if DraggingItemLink <> nil then begin Assign(DraggingItemLink); FBeginGroup := False; end; if FDragOverItemControl <> nil then begin FSetBeginGroup := FDragOverBeginGroup and not FDragOverFirstPart or not FDragOverBeginGroup and FDragOverFirstPart and FDragOverItemControl.ItemLink.BeginGroup; Index := FDragOverItemControl.ItemLink.Index + Byte(not FDragOverBeginGroup and not FDragOverFirstPart); if FSetBeginGroup then begin BeginGroup := True; with FDragOverItemControl do begin Parent.FDestroyFlag := True; // for RepaintBar ItemLink.BeginGroup := False; Parent.FDestroyFlag := False; end; end; end; CreateControl; FSelectedItem := Control; ABarControl.FSelectedItem := Control; if (DraggingItemLink <> nil) and (GetAsyncKeyState(VK_CONTROL) >= 0) then begin NeedRepaintBar := DraggingItemLink.Owner <> AItemLinks; DraggingItemLink.Free; FDraggingItemLink := nil; end else NeedRepaintBar := True; if NeedRepaintBar and (AItemLinks.BarControl <> nil) then AItemLinks.BarControl.RepaintBar; DesignerModified; // activate barcontrol which contains new itemlink if (ActiveBarControl <> nil) and (AItemLinks.BarControl is TdxBarControl) and (ActiveBarControl <> AItemLinks.BarControl) then begin ActiveBarControl.HideAll; if AItemLinks.BarControl <> nil then TdxBarControl(AItemLinks.BarControl).BarGetFocus(Control); end; end else if SelectedItem <> nil then SelectedItem := nil; FDraggingItem := nil; if FDraggingItemLink <> nil then if FDraggingItemLink.Control <> nil then with FDraggingItemLink.Control do begin FDraggingItemLink := nil; Repaint; end else FDraggingItemLink := nil; end; end; function TdxBarManager.FindDockControl(APath: string): TdxBarDockControl; var ARootName: string; ARoot: TComponent; begin ARootName := Copy(APath, 1, Pos('.', APath) - 1); if ARootName <> '' then begin ARoot := FindGlobalComponent(ARootName); Delete(APath, 1, Length(ARootName) + 1); end else ARoot := FMainForm; {$IFDEF DELPHI5} Result := FindNestedComponent(ARoot, APath) as TdxBarDockControl; {$ELSE} Result := ARoot.FindComponent(APath) as TdxBarDockControl; {$ENDIF} end; function TdxBarManager.GetCategoryRealIndex(AIndex: Integer): Integer; var I: Integer; begin if FDesigning then Result := AIndex else begin Result := -1; for I := 0 to FCategories.Count - 1 do if CategoryVisible[I] then begin Inc(Result); if Result = AIndex then begin Result := I; Exit; end; end; Result := -1; end; end; procedure TdxBarManager.GetChildren(Proc: TGetChildProc; Root: TComponent); var I: Integer; begin // for I := 0 to GroupCount - 1 do // if Groups[I].Owner = Root then Proc(Groups[I]); for I := 0 to ItemCount - 1 do if (Items[I].Owner = Root) and (Items[I].Category > -1) then Proc(Items[I]); for I := 0 to GroupCount - 1 do if Groups[I].Owner = Root then Proc(Groups[I]); end; function TdxBarManager.GetPainterClass: TdxBarItemControlPainterClass; begin case GetPaintStyle of bmsEnhanced: Result := TdxBarItemControlEnhancedPainter; bmsFlat: Result := TdxBarItemControlFlatPainter; bmsXP: begin if FThemeAvailable then Result := TdxBarItemControlXPPainter else Result := TdxBarItemControlEnhancedPainter; end; bmsOffice11: Result := TdxBarItemControlOffice11Painter; else Result := TdxBarItemControlStandardPainter; end; end; function TdxBarManager.GetWindowForMouseCapturing: HWND; begin if FIsCustomizing and (dxBarCustomizingForm <> nil) then Result := dxBarCustomizingForm.Handle else if IsWindowVisible(Application.Handle) then Result := Application.Handle else Result := FMainForm.Handle; end; procedure TdxBarManager.HotImagesChanged; var PrevLockUpdate: Boolean; I: Integer; begin if not IsLoading and not IsDestroying then begin PrevLockUpdate := LockUpdate; LockUpdate := True; try for I := 0 to ItemCount - 1 do if Items[I].UseHotImages then Items[I].HotGlyphChanged; finally LockUpdate := PrevLockUpdate; end; end; end; procedure TdxBarManager.ImagesChanged; var PrevLockUpdate: Boolean; I: Integer; begin if not IsLoading and not IsDestroying then begin PrevLockUpdate := LockUpdate; LockUpdate := True; try for I := 0 to ItemCount - 1 do if Items[I].ImageIndex > -1 then Items[I].GlyphChanged; finally LockUpdate := PrevLockUpdate; end; end; end; procedure TdxBarManager.LargeImagesChanged; var PrevLockUpdate: Boolean; I: Integer; begin if not IsLoading and not IsDestroying then begin PrevLockUpdate := LockUpdate; LockUpdate := True; try for I := 0 to ItemCount - 1 do if Items[I].UseLargeImages then Items[I].LargeGlyphChanged; finally LockUpdate := PrevLockUpdate; end; end; end; procedure TdxBarManager.DisabledImagesChanged; var PrevLockUpdate: Boolean; I: Integer; begin if not IsLoading and not IsDestroying then begin PrevLockUpdate := LockUpdate; LockUpdate := True; try for I := 0 to ItemCount - 1 do if Items[I].ImageIndex > -1 then Items[I].GlyphChanged; finally LockUpdate := PrevLockUpdate; end; end; end; procedure TdxBarManager.DisabledLargeImagesChanged; var PrevLockUpdate: Boolean; I: Integer; begin if not IsLoading and not IsDestroying then begin PrevLockUpdate := LockUpdate; LockUpdate := True; try for I := 0 to ItemCount - 1 do if Items[I].UseLargeImages then Items[I].LargeGlyphChanged; finally LockUpdate := PrevLockUpdate; end; end; end; function TdxBarManager.IsLargeImagesForLargeIcons: Boolean; begin Result := UseLargeImagesForLargeIcons and (LargeImages <> nil); end; procedure TdxBarManager.Loaded; var I: Integer; begin inherited Loaded; if LockUpdate then Exit; FBars.FLoading := True; for I := 0 to ItemCount - 1 do with Items[I] do begin if Items[I] is TCustomdxBarSubItem then TCustomdxBarSubItem(Items[I]).ItemLinks.Loaded(True); Visible := FLoadedVisible; end; for I := 0 to FBars.Count - 1 do with FBars[I] do begin FIsPredefined := True; ItemLinks.Loaded(True); DockControl := FLoadedDockControl; if DockControl = nil then DockingStyle := FLoadedDockingStyle; Visible := FLoadedVisible; end; if not FDesigning and not InternalLoading then begin if FStoreInRegistry then LoadFromRegistry(FRegistryPath); if FStoreInIniFile then LoadFromIniFile(FIniFileName); end; FBars.FLoading := False; for I := 0 to FCategories.Count - 1 do if FCategories.Objects[I] <> nil then CategoryItemsVisible[I] := TdxBarCategoryData(FCategories.Objects[I]).LoadedItemsVisible; FFirstDocksUpdate := True; for I := 0 to DockControlCount - 1 do DockControls[I].UpdateDock; FFirstDocksUpdate := False; end; procedure TdxBarManager.Notification(AComponent: TComponent; Operation: TOperation); var I: Integer; begin inherited; if Operation = opRemove then begin if AComponent = DisabledLargeImages then DisabledLargeImages := nil; if AComponent = DisabledImages then DisabledImages := nil; if AComponent = HotImages then HotImages := nil; if AComponent = Images then Images := nil; if AComponent = LargeImages then LargeImages := nil; if AComponent is TControl then for I := 0 to FPopupMenuLinks.Count - 1 do if FPopupMenuLinks[I].Control = AComponent then FPopupMenuLinks[I].Control := nil; if AComponent is TdxBarPopupMenu then for I := 0 to FPopupMenuLinks.Count - 1 do if FPopupMenuLinks[I].PopupMenu = AComponent then FPopupMenuLinks[I].PopupMenu := nil; end; end; procedure TdxBarManager.ReadState(Reader: TReader); begin inherited; Inc(FReadStateCount); end; procedure TdxBarManager.SetName(const NewName: TComponentName); var I: Integer; OldName, ItemName, NamePrefix: TComponentName; Item: TdxBarItem; begin OldName := Name; inherited SetName(NewName); if FDesigning and (Name <> OldName) then for I := 0 to FItems.Count - 1 do begin Item := Items[I]; if Item.Owner = Owner then begin ItemName := Item.Name; NamePrefix := ItemName; if Length(NamePrefix) > Length(OldName) then begin SetLength(NamePrefix, Length(OldName)); if CompareText(OldName, NamePrefix) = 0 then begin System.Delete(ItemName, 1, Length(OldName)); System.Insert(NewName, ItemName, 1); try Item.Name := ItemName; except on EComponentError do end; end; end; end; end; end; procedure TdxBarManager.ShowToolbars(Show, ForceHiding: Boolean; ActiveWindow: HWND); var I: Integer; ProcessId1, ProcessId2: Longint; function CanHideToolbars: Boolean; begin Result := FHideFloatingBarsWhenInactive or ForceHiding; end; procedure InvalidateBarsCaptions; var I: Integer; begin for I := 0 to Bars.Count - 1 do if (Bars[I].Control <> nil) and (Bars[I].DockingStyle = dsNone) then Bars[I].Control.FrameChanged; end; function CanHideActiveBarControl: Boolean; begin Result := (ActiveBarControl.BarManager = Self) or FIsCustomizing and (ActiveBarControl.BarManager.MainForm = dxBarCustomizingForm) and (ActiveBarControl.Handle <> ActiveWindow) or (TDummyForm(FMainForm).FormStyle = fsMDIForm) and (TDummyForm(ActiveBarControl.BarManager.MainForm).FormStyle = fsMDIChild) and (not (ActiveBarControl.SelectedItem is TdxBarWinControl) or not TdxBarWinControl(ActiveBarControl.SelectedItem).FFocusing); end; begin if FToolbarsVisibleChanging then Exit; FToolbarsVisibleChanging := True; try if not CanHideToolbars then InvalidateBarsCaptions; if not Show then begin if IsDestroying or (GetParent(ActiveWindow) = MainForm.Handle) {and IsWindowVisible(MainForm.Handle)} then Exit; // !!! //if not CanHideToolbars then Exit; if (ActiveBarControl <> nil) and CanHideActiveBarControl then ActiveBarControl.HideAll; if not CanHideToolbars then begin if QuickCustBar <> nil then QuickCustBar.CloseUp; Exit; end; GetWindowThreadProcessId(FMainForm.Handle, @ProcessId1); GetWindowThreadProcessId(ActiveWindow, @ProcessId2); // if GetParent(ActiveWindow) = MainForm.Handle then // Exit; // !!! if (ActiveWindow = 0) or (FindControl(ActiveWindow) is TCustomForm) and ((dxBarCustomizingForm = nil) or (ActiveWindow <> dxBarCustomizingForm.Handle) or not FIsCustomizing) or (ProcessId1 <> ProcessId2) or (ActiveWindow = Application.Handle) then begin for I := 0 to Bars.Count - 1 do if (Bars[I].Control <> nil) and (Bars[I].DockingStyle = dsNone) then SetWindowPos(Bars[I].Control.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_HIDEWINDOW or SWP_NOACTIVATE); SendMessage(FMainForm.Handle, WM_NCACTIVATE, 0, 0); end; end else if not IsIconic(FMainForm.Handle) then begin for I := 0 to Bars.Count - 1 do with Bars[I] do if (Control <> nil) and Visible and (DockingStyle = dsNone) then with Control do begin ShowWindow(Handle, SW_SHOWNOACTIVATE); //UpdateWindow(Handle); end; //if IsWindowVisible(FMainForm.Handle) then ProcessPaintMessages; end; finally FToolbarsVisibleChanging := False; end; end; procedure TdxBarManager.UpdateItems(Sender: TdxBarItem); begin if (Sender.Category > -1) and IsCustomizing and Designing and not (IsLoading or IsDestroying) and not FCreatingBarItem then UpdateCustomizingBarItems; end; function TdxBarManager.BorderSizeX: Integer; begin Result := PainterClass.BorderSizeX; end; function TdxBarManager.BorderSizeY: Integer; begin Result := PainterClass.BorderSizeY; end; function TdxBarManager.FingersSize(ABar: TdxBar): Integer; begin if ABar.CanMoving then Result := FFingersSize else Result := PainterClass.EmptyFingersSize; end; function TdxBarManager.GetLightColor(ABtnFaceColorPart, AHighlightColorPart, AWindowColorPart: Integer): COLORREF; begin Result := dxOffice11.GetLightColor(ABtnFaceColorPart, AHighlightColorPart, AWindowColorPart); end; function TdxBarManager.BarByCaption(const ACaption: string): TdxBar; var I: Integer; begin for I := 0 to FBars.Count - 1 do begin Result := FBars[I]; if Result.Caption = ACaption then Exit; end; Result := nil; end; function TdxBarManager.BarByName(const AName: string): TdxBar; var I: Integer; begin for I := 0 to FBars.Count - 1 do begin Result := FBars[I]; if Result.Name = AName then Exit; end; Result := nil; end; function TdxBarManager.GetAllItemsByCategory(ACategory: Integer; List: TList): Integer; var I: Integer; begin List.Clear; if (0 <= ACategory) and (ACategory < Categories.Count) then for I := 0 to ItemCount - 1 do if Items[I].Category = ACategory then List.Add(Items[I]); Result := List.Count; end; function TdxBarManager.GetCountByCategory(ACategory: Integer): Integer; var I: Integer; begin Result := 0; if (0 <= ACategory) and (ACategory < Categories.Count) then for I := 0 to ItemCount - 1 do with Items[I] do if (Category = ACategory) and (Designing or ActuallyVisible and not Hidden) then Inc(Result); end; function TdxBarManager.GetItemByCategory(ACategory, AIndex: Integer): TdxBarItem; var List: TList; begin Result := nil; List := TList.Create; GetItemsByCategory(ACategory, List); if (0 <= AIndex) and (AIndex < List.Count) then Result := TdxBarItem(List[AIndex]); List.Free; end; function TdxBarManager.GetItemByName(const AName: string): TdxBarItem; var I: Integer; begin Result := nil; for I := 0 to ItemCount - 1 do if CompareText(Items[I].Name, AName) = 0 then begin Result := Items[I]; Break; end; end; function TdxBarManager.GetItemsByCategory(ACategory: Integer; List: TList): Integer; var I: Integer; begin if FDesigning then Result := GetAllItemsByCategory(ACategory, List) else begin List.Clear; if (0 <= ACategory) and (ACategory < Categories.Count) then for I := 0 to ItemCount - 1 do with Items[I] do if (Category = ACategory) and ActuallyVisible and not Hidden then List.Add(Items[I]); Result := List.Count; end; end; procedure TdxBarManager.MoveItem(CurIndex, NewIndex: Integer); begin FItems.Move(CurIndex, NewIndex); DesignerModified; end; procedure TdxBarManager.ExchangeItems(Index1, Index2: Integer); begin FItems.Exchange(Index1, Index2); DesignerModified; end; procedure TdxBarManager.CreateToolbarsPopupList(ItemLinks: TdxBarItemLinks); var I: Integer; begin for I := 0 to FBars.Count - 1 do if FBars[I].CanClose and not FBars[I].Hidden then begin InternalItemList.Add(TdxBarButton.Create(nil)); with TdxBarButton(InternalItemList.Last) do begin Caption := FBars[I].Caption; Tag := I; OnClick := ToolbarsPopupClick; ButtonStyle := bsChecked; Down := FBars[I].Visible; end; ItemLinks.Add.Item := TdxBarItem(InternalItemList.Last); end; AddCustomizeLink(ItemLinks, True, TdxBarButton); DoShowToolbarsPopup(ItemLinks); end; procedure TdxBarManager.Customizing(Show: Boolean); var I: Integer; begin if (FIsCustomizing <> Show) and (not Show or (dxBarCustomizingForm = nil)) then begin for I := 0 to Bars.Count - 1 do if Bars[I].Control <> nil then with Bars[I].Control do begin HideAll; DestroyControls; end; FIsCustomizing := Show; for I := 0 to Bars.Count - 1 do with Bars[I] do begin ItemLinks.RefreshVisibilityLists; if Control <> nil then Control.CreateControls; end; for I := 0 to ItemCount - 1 do if Items[I] is TCustomdxBarSubItem then TCustomdxBarSubItem(Items[I]).ItemLinks.RefreshVisibilityLists; for I := 0 to FPopupMenus.Count - 1 do TdxBarPopupMenu(FPopupMenus[I]).ItemLinks.RefreshVisibilityLists; dxBarCustomizing(Self, Show); for I := 0 to Bars.Count - 1 do with Bars[I] do if Control <> nil then with Control do begin UpdateControlState; RepaintBar; end; end; end; procedure TdxBarManager.HideAll; begin if (ActiveBarControl <> nil) {and (ActiveBarControl.BarManager = Self) }then ActiveBarControl.HideAll; end; procedure TdxBarManager.ResetUsageData; var PrevLockUpdate: Boolean; TempForm: TForm; TempBarManager: TdxBarManager; I: Integer; TempSubItem: TCustomdxBarSubItem; TempBar: TdxBar; begin PrevLockUpdate := LockUpdate; LockUpdate := True; try TempForm := LoadMainFormFromBin; if TempForm <> nil then try TempBarManager := TdxBarManager(TempForm.FindComponent(Name)); if TempBarManager <> nil then begin for I := 0 to ItemCount - 1 do with Items[I] do if Items[I] is TCustomdxBarSubItem then begin TempSubItem := TCustomdxBarSubItem(TempForm.FindComponent(Name)); if TempSubItem <> nil then TCustomdxBarSubItem(Items[I]).ItemLinks.AssignUsageData(TempSubItem.ItemLinks); end; for I := 0 to FBars.Count - 1 do if I < TempBarManager.Bars.Count then begin TempBar := TempBarManager.Bars[I]; FBars[I].ItemLinks.AssignUsageData(TempBar.ItemLinks); end; end; finally TempForm.Free; end; finally LockUpdate := PrevLockUpdate; end; end; procedure TdxBarManager.ResetUsageDataWithConfirmation; begin if Application.MessageBox(PChar(cxGetResourceString(@dxSBAR_WANTTORESETUSAGEDATA)), PChar(Application.Title), MB_YESNO or MB_DEFBUTTON2 or MB_ICONEXCLAMATION) = ID_YES then ResetUsageData; end; { var WhatIsThisMode: Boolean; WndProcRetHook: HHOOK; function WndProcRetHookProc(Code: Integer; wParam: WParam; lParam: LParam): LRESULT; stdcall; begin with PCWPRetStruct(lParam)^ do if message = WM_SETCURSOR then SetCursor(Screen.Cursors[crHelp]); Result := CallNextHookEx(WndProcRetHook, Code, wParam, lParam); end; procedure TdxBarManager.WhatIsThis; var Msg: TMsg; P: TPoint; begin if WhatIsThisMode then Exit; WhatIsThisMode := True; WndProcRetHook := SetWindowsHookEx(WH_CALLWNDPROCRET, WndProcRetHookProc, HInstance, GetCurrentThreadId); try repeat case Integer(GetMessage(Msg, 0, 0, 0)) of -1: Break; 0: begin PostQuitMessage(Msg.wParam); Break; end; end; case Msg.message of WM_KEYDOWN, WM_KEYUP: if Msg.wParam = VK_ESCAPE then Break; WM_NCLBUTTONDOWN, WM_LBUTTONDOWN: begin P := SmallPointToPoint(TSmallPoint(Msg.lParam)); ClientToScreen(Msg.hwnd, P); Application.MessageBox('Help!', '', 0); Break; end; end; TranslateMessage(Msg); DispatchMessage(Msg); until False; finally UnhookWindowsHookEx(WndProcRetHook); WhatIsThisMode := False; SetCursor(Screen.Cursors[Screen.Cursor]); end; end; } function GetComponentPath(AMainForm, AComponent: TComponent): string; begin Result := AComponent.Name; if AComponent.Owner <> AMainForm then while (AComponent.Owner <> nil) and (AComponent.Owner.Name <> '') do begin AComponent := AComponent.Owner; Result := AComponent.Name + '.' + Result; end; end; procedure TdxBarManager.LoadFromRegistry(ARegistryPath: string); var Stream: TMemoryStream; Registry: TRegistry; I: Integer; AKey: string; PrevBarManagerLockUpdate, PrevLockUpdate, PrevLoading: Boolean; procedure ReadItemLinks(const AKey: string; AItemLinks: TdxBarItemLinks); var I: Integer; begin AItemLinks.Clear; with Registry do begin if ValueExists('ItemLinkCount') then I := ReadInteger('ItemLinkCount') else I := 0; CloseKey; try for I := 0 to I - 1 do if OpenKey(AKey + '\ItemLink' + IntToStr(I), False) then with AItemLinks.Add do try try Item := GetItemByName(ReadString('ItemName')); if Item = nil then Free else begin BeginGroup := ReadBool('BeginGroup'); ReadBinaryData('UserDefine', FUserDefine, SizeOf(UserDefine)); if udCaption in UserDefine then UserCaption := ReadString('UserCaption'); if udGlyph in UserDefine then begin Stream.SetSize(GetDataSize('UserGlyph')); ReadBinaryData('UserGlyph', Stream.Memory^, Stream.Size); UserGlyph.LoadFromStream(Stream); Stream.Clear; end; if udPaintStyle in UserDefine then UserPaintStyle := TdxBarPaintStyle(ReadInteger('UserPaintStyle')); if udWidth in UserDefine then UserWidth := ReadInteger('UserWidth'); if (AItemLinks.Owner is TdxBar) and ValueExists('Visible') then FLoadedVisible := ReadBool('Visible'); if CanShowRecentItems and AItemLinks.FUseRecentItems then begin if ValueExists('UseCount') then FLoadedUseCount := ReadInteger('UseCount'); if ValueExists('RecentIndex') then FLoadedRecentIndex := ReadInteger('RecentIndex'); end; end; except end; finally CloseKey; end; finally AItemLinks.Loaded(True); end; end; end; begin if ARegistryPath = '' then Exit; if ARegistryPath[1] <> '\' then ARegistryPath := '\' + ARegistryPath; if ARegistryPath[Length(ARegistryPath)] = '\' then Delete(ARegistryPath, Length(ARegistryPath), 1); Stream := TMemoryStream.Create; Registry := TRegistry.Create; try with Registry do if OpenKey(ARegistryPath, False) then begin PrevBarManagerLockUpdate := LockUpdate; LockUpdate := True; try // read options if CanShowRecentItems then begin if ValueExists('MenusShowRecentItemsFirst') then MenusShowRecentItemsFirst := ReadBool('MenusShowRecentItemsFirst'); if ValueExists('ShowFullMenusAfterDelay') then ShowFullMenusAfterDelay := ReadBool('ShowFullMenusAfterDelay'); end; if ValueExists('LargeIcons') then LargeIcons := ReadBool('LargeIcons'); if ValueExists('MenuAnimations') then MenuAnimations := TdxBarMenuAnimations(ReadInteger('MenuAnimations')); if ValueExists('ShowHint') then ShowHint := ReadBool('ShowHint'); if ValueExists('ShowShortCutInHint') then ShowShortCutInHint := ReadBool('ShowShortCutInHint'); // read (TdxBar)s if ValueExists('BarCount') then begin for I := 0 to Bars.Count - 1 do Bars[I].Visible := False; I := ReadInteger('BarCount'); CloseKey; for I := 0 to I - 1 do begin AKey := ARegistryPath + '\Bar' + IntToStr(I); if OpenKey(AKey, False) then begin if I > Bars.Count - 1 then Bars.Add; with Bars[I] do begin PrevLockUpdate := LockUpdate; LockUpdate := True; try ReadItemLinks(AKey, ItemLinks); OpenKey(AKey, False); try try Caption := ReadString('Caption'); DockedDockControl := FindDockControl(ReadString('DockedDockControl')); DockedDockingStyle := TdxBarDockingStyle(ReadInteger('DockedDockingStyle')); DockedLeft := ReadInteger('DockedLeft'); DockedTop := ReadInteger('DockedTop'); OneOnRow := ReadBool('OneOnRow'); Row := ReadInteger('Row'); FloatLeft := ReadInteger('FloatLeft'); FloatTop := ReadInteger('FloatTop'); FloatClientWidth := ReadInteger('FloatClientWidth'); FloatClientHeight := ReadInteger('FloatClientHeight'); DockControl := FindDockControl(ReadString('DockControl')); DockingStyle := TdxBarDockingStyle(ReadInteger('DockingStyle')); PrevLoading := FBars.FLoading; FBars.FLoading := True; try Visible := ReadBool('Visible'); finally FBars.FLoading := PrevLoading; end; except Visible := True; end; finally CloseKey; end; finally LockUpdate := PrevLockUpdate; end; end; end; end; end; // read (TCustomdxBarSubItem)s for I := 0 to ItemCount - 1 do if Items[I] is TCustomdxBarSubItem then with TCustomdxBarSubItem(Items[I]) do if Name <> '' then begin AKey := ARegistryPath + '\SubItem_' + Name; if OpenKey(AKey, False) then ReadItemLinks(AKey, ItemLinks); end; finally LockUpdate := PrevBarManagerLockUpdate; end; end; finally Registry.Free; Stream.Free; end; end; procedure TdxBarManager.SaveToRegistry(ARegistryPath: string); var Registry, SubRegistry: TRegistry; Keys, SubKeys: TStringList; I, J: Integer; Stream: TMemoryStream; AKey: string; procedure WriteItemLinks(const AKey: string; AItemLinks: TdxBarItemLinks); var I: Integer; begin with Registry do begin WriteInteger('ItemLinkCount', AItemLinks.Count); CloseKey; for I := 0 to AItemLinks.Count - 1 do if (AItemLinks[I].Item <> nil) and (AItemLinks[I].Item.Name <> '') and OpenKey(AKey + '\ItemLink' + IntToStr(I), True) then with AItemLinks[I] do begin WriteString('ItemName', Item.Name); WriteBool('BeginGroup', BeginGroup); WriteBinaryData('UserDefine', FUserDefine, SizeOf(UserDefine)); if udCaption in UserDefine then WriteString('UserCaption', UserCaption); if udGlyph in UserDefine then begin UserGlyph.SaveToStream(Stream); WriteBinaryData('UserGlyph', Stream.Memory^, Stream.Size); Stream.Clear; end; if udPaintStyle in UserDefine then WriteInteger('UserPaintStyle', Ord(UserPaintStyle)); if udWidth in UserDefine then WriteInteger('UserWidth', UserWidth); if AItemLinks.Owner is TdxBar then WriteBool('Visible', Visible); if CanShowRecentItems and AItemLinks.FUseRecentItems then begin WriteInteger('UseCount', FUseCount); WriteInteger('RecentIndex', RecentIndex); end; CloseKey; end; end; end; begin if ARegistryPath = '' then Exit; if ARegistryPath[1] <> '\' then ARegistryPath := '\' + ARegistryPath; if ARegistryPath[Length(ARegistryPath)] = '\' then Delete(ARegistryPath, Length(ARegistryPath), 1); Stream := TMemoryStream.Create; Registry := TRegistry.Create; with Registry do if OpenKey(ARegistryPath, True) then begin // delete entire previous data from registry Keys := TStringList.Create; SubKeys := TStringList.Create; SubRegistry := TRegistry.Create; try GetKeyNames(Keys); for I := 0 to Keys.Count - 1 do begin with SubRegistry do begin OpenKey(ARegistryPath + '\' + Keys[I], False); SubRegistry.GetKeyNames(SubKeys); for J := 0 to SubKeys.Count - 1 do DeleteKey(SubKeys[J]); CloseKey; end; DeleteKey(Keys[I]); end; finally SubRegistry.Free; SubKeys.Free; Keys.Free; end; // write options if CanShowRecentItems then begin WriteBool('MenusShowRecentItemsFirst', MenusShowRecentItemsFirst); WriteBool('ShowFullMenusAfterDelay', ShowFullMenusAfterDelay); end; WriteBool('LargeIcons', LargeIcons); WriteInteger('MenuAnimations', Ord(MenuAnimations)); WriteBool('ShowHint', ShowHint); WriteBool('ShowShortCutInHint', ShowShortCutInHint); // write (TdxBar)s WriteInteger('BarCount', Bars.Count); CloseKey; for I := 0 to Bars.Count - 1 do begin AKey := ARegistryPath + '\Bar' + IntToStr(I); if OpenKey(AKey, True) then with Bars[I] do begin WriteString('Caption', Caption); if DockedDockControl <> nil then WriteString('DockedDockControl', GetComponentPath(MainForm, DockedDockControl)); WriteInteger('DockedDockingStyle', Ord(DockedDockingStyle)); WriteInteger('DockedLeft', DockedLeft); WriteInteger('DockedTop', DockedTop); WriteBool('OneOnRow', OneOnRow); WriteInteger('Row', Row); WriteInteger('FloatLeft', FloatLeft); WriteInteger('FloatTop', FloatTop); WriteInteger('FloatClientWidth', FloatClientWidth); WriteInteger('FloatClientHeight', FloatClientHeight); if DockControl <> nil then WriteString('DockControl', GetComponentPath(MainForm, DockControl)); WriteInteger('DockingStyle', Ord(DockingStyle)); WriteBool('Visible', Visible); WriteItemLinks(AKey, ItemLinks); end; end; // write (TCustomdxBarSubItem)s for I := 0 to ItemCount - 1 do if Items[I] is TCustomdxBarSubItem then with TCustomdxBarSubItem(Items[I]) do if Name <> '' then begin AKey := ARegistryPath + '\SubItem_' + Name; if OpenKey(AKey, True) then WriteItemLinks(AKey, ItemLinks); end; end; Registry.Free; Stream.Free; end; procedure TdxBarManager.LoadFromIniFile(AFileName: string); var IniFile: TCurIniFile; BaseName, Section: string; I: Integer; PrevBarManagerLockUpdate, PrevLockUpdate, PrevLoading: Boolean; procedure ReadItemLinks(const ASection: string; AItemLinks: TdxBarItemLinks); var I: Integer; Section: string; begin AItemLinks.Clear; with IniFile do begin I := ReadInteger(ASection, 'ItemLinkCount', 0); try for I := 0 to I - 1 do begin Section := ASection + '.ItemLink' + IntToStr(I); if ReadString(Section, 'ItemName', '') <> '' then with AItemLinks.Add do try Item := GetItemByName(ReadString(Section, 'ItemName', '')); if Item = nil then Free else begin BeginGroup := ReadBool(Section, 'BeginGroup', False); FUserDefine := TdxBarUserDefines(Byte(ReadInteger(Section, 'UserDefine', 0))); if udCaption in UserDefine then UserCaption := ReadString(Section, 'UserCaption', ''); if udPaintStyle in UserDefine then UserPaintStyle := TdxBarPaintStyle(ReadInteger(Section, 'UserPaintStyle', 0)); if udWidth in UserDefine then UserWidth := ReadInteger(Section, 'UserWidth', 100); // don't load UserGlyph if AItemLinks.Owner is TdxBar then FLoadedVisible := ReadBool(Section, 'Visible', True); if CanShowRecentItems and AItemLinks.FUseRecentItems then begin FLoadedUseCount := ReadInteger(Section, 'UseCount', 0); FLoadedRecentIndex := ReadInteger(Section, 'RecentIndex', -1); end; end; except end; end; finally AItemLinks.Loaded(True); end; end; end; var ATempList: TStringList; begin if (AFileName = '') and (FIniFileStream = nil) then Exit; BaseName := MainForm.Name + '.' + Name + '.'; IniFile := TCurIniFile.Create(AFileName); try if FIniFileStream <> nil then begin ATempList := TStringList.Create; try ATempList.LoadFromStream(FIniFileStream); IniFile.SetStrings(ATempList); finally ATempList.Free; end; end; with IniFile do begin PrevBarManagerLockUpdate := LockUpdate; LockUpdate := True; try // read options Section := BaseName + 'Main'; if CanShowRecentItems then begin MenusShowRecentItemsFirst := ReadBool(Section, 'MenusShowRecentItemsFirst', MenusShowRecentItemsFirst); ShowFullMenusAfterDelay := ReadBool(Section, 'ShowFullMenusAfterDelay', ShowFullMenusAfterDelay); end; LargeIcons := ReadBool(Section, 'LargeIcons', LargeIcons); MenuAnimations := TdxBarMenuAnimations(ReadInteger(Section, 'MenuAnimations', Byte(MenuAnimations))); ShowHint := ReadBool(Section, 'ShowHint', ShowHint); ShowShortCutInHint := ReadBool(Section, 'ShowShortCutInHint', ShowShortCutInHint); // read (TdxBar)s if ReadInteger(Section, 'BarCount', -1) > -1 then begin for I := 0 to Bars.Count - 1 do Bars[I].Visible := False; I := ReadInteger(Section, 'BarCount', 0); for I := 0 to I - 1 do begin Section := BaseName + 'Bar' + IntToStr(I); if ReadInteger(Section, 'Row', -1000) > -1000 then begin if I > Bars.Count - 1 then Bars.Add; with Bars[I] do begin PrevLockUpdate := LockUpdate; LockUpdate := True; try ReadItemLinks(Section, ItemLinks); try Caption := ReadString(Section, 'Caption', Caption); DockedDockControl := FindDockControl(ReadString(Section, 'DockedDockControl', '')); DockedDockingStyle := TdxBarDockingStyle(ReadInteger(Section, 'DockedDockingStyle', Integer(DockedDockingStyle))); DockedLeft := ReadInteger(Section, 'DockedLeft', DockedLeft); DockedTop := ReadInteger(Section, 'DockedTop', DockedTop); OneOnRow := ReadBool(Section, 'OneOnRow', OneOnRow); Row := ReadInteger(Section, 'Row', Row); FloatLeft := ReadInteger(Section, 'FloatLeft', FloatLeft); FloatTop := ReadInteger(Section, 'FloatTop', FloatTop); FloatClientWidth := ReadInteger(Section, 'FloatClientWidth', FloatClientWidth); FloatClientHeight := ReadInteger(Section, 'FloatClientHeight', FloatClientHeight); DockControl := FindDockControl(ReadString(Section, 'DockControl', ''));; DockingStyle := TdxBarDockingStyle(ReadInteger(Section, 'DockingStyle', Integer(DockingStyle))); PrevLoading := FBars.FLoading; FBars.FLoading := True; try Visible := ReadBool(Section, 'Visible', False); finally FBars.FLoading := PrevLoading; end; except Visible := True; end; finally LockUpdate := PrevLockUpdate; end; end; end; end; end; // read (TCustomdxBarSubItem)s for I := 0 to ItemCount - 1 do if Items[I] is TCustomdxBarSubItem then with TCustomdxBarSubItem(Items[I]) do if Name <> '' then begin Section := BaseName + 'SubItem_' + Name; if ReadInteger(Section, 'ItemLinkCount', -1) > -1 then ReadItemLinks(Section, ItemLinks); end; finally LockUpdate := PrevBarManagerLockUpdate; end; end; finally IniFile.Free; end; end; procedure TdxBarManager.SaveToIniFile(AFileName: string); var IniFile: TCurIniFile; Sections: TStringList; BaseName, Section: string; I: Integer; procedure WriteItemLinks(const ASection: string; AItemLinks: TdxBarItemLinks); var I: Integer; Section: string; begin with IniFile do begin WriteInteger(ASection, 'ItemLinkCount', AItemLinks.Count); for I := 0 to AItemLinks.Count - 1 do if (AItemLinks[I].Item <> nil) and (AItemLinks[I].Item.Name <> '') then with AItemLinks[I] do begin Section := ASection + '.ItemLink' + IntToStr(I); WriteString(Section, 'ItemName', Item.Name); WriteBool(Section, 'BeginGroup', BeginGroup); WriteInteger(Section, 'UserDefine', Byte(FUserDefine)); if udCaption in UserDefine then WriteString(Section, 'UserCaption', UserCaption); if udPaintStyle in UserDefine then WriteInteger(Section, 'UserPaintStyle', Ord(UserPaintStyle)); if udWidth in UserDefine then WriteInteger(Section, 'UserWidth', UserWidth); // don't save UserGlyph if AItemLinks.Owner is TdxBar then WriteBool(Section, 'Visible', Visible); if CanShowRecentItems and AItemLinks.FUseRecentItems then begin WriteInteger(Section, 'UseCount', FUseCount); WriteInteger(Section, 'RecentIndex', RecentIndex); end; end; end; end; var ATempList: TStringList; begin if (AFileName = '') and (FIniFileStream = nil) then Exit; BaseName := MainForm.Name + '.' + Name + '.'; IniFile := TCurIniFile.Create(AFileName); try with IniFile do begin // delete entire previous data from inifile Sections := TStringList.Create; ReadSections(Sections); for I := 0 to Sections.Count - 1 do if Copy(Sections[I], 1, Length(BaseName)) = BaseName then EraseSection(Sections[I]); Sections.Free; // write options Section := BaseName + 'Main'; if CanShowRecentItems then begin WriteBool(Section, 'MenusShowRecentItemsFirst', MenusShowRecentItemsFirst); WriteBool(Section, 'ShowFullMenusAfterDelay', ShowFullMenusAfterDelay); end; WriteBool(Section, 'LargeIcons', LargeIcons); WriteInteger(Section, 'MenuAnimations', Ord(MenuAnimations)); WriteBool(Section, 'ShowHint', ShowHint); WriteBool(Section, 'ShowShortCutInHint', ShowShortCutInHint); // write (TdxBar)s WriteInteger(Section, 'BarCount', Bars.Count); for I := 0 to Bars.Count - 1 do begin Section := BaseName + 'Bar' + IntToStr(I); with Bars[I] do begin WriteString(Section, 'Caption', Caption); if DockedDockControl <> nil then WriteString(Section, 'DockedDockControl', GetComponentPath(MainForm, DockedDockControl)); WriteInteger(Section, 'DockedDockingStyle', Ord(DockedDockingStyle)); WriteInteger(Section, 'DockedLeft', DockedLeft); WriteInteger(Section, 'DockedTop', DockedTop); WriteBool(Section, 'OneOnRow', OneOnRow); WriteInteger(Section, 'Row', Row); WriteInteger(Section, 'FloatLeft', FloatLeft); WriteInteger(Section, 'FloatTop', FloatTop); WriteInteger(Section, 'FloatClientWidth', FloatClientWidth); WriteInteger(Section, 'FloatClientHeight', FloatClientHeight); if DockControl <> nil then WriteString(Section, 'DockControl', GetComponentPath(MainForm, DockControl)); WriteInteger(Section, 'DockingStyle', Ord(DockingStyle)); WriteBool(Section, 'Visible', Visible); WriteItemLinks(Section, ItemLinks); end; end; // write (TCustomdxBarSubItem)s for I := 0 to ItemCount - 1 do if Items[I] is TCustomdxBarSubItem then with TCustomdxBarSubItem(Items[I]) do if Name <> '' then begin Section := BaseName + 'SubItem_' + Name; WriteItemLinks(Section, ItemLinks); end; end; finally if FIniFileStream = nil then IniFile.UpdateFile else begin ATempList := TStringList.Create; try IniFile.GetStrings(ATempList); ATempList.SaveToStream(FIniFileStream); finally ATempList.Free; end; end; IniFile.Free; end; end; procedure TdxBarManager.LoadFromStream(AStream: TStream); begin FIniFileStream := AStream; try LoadFromIniFile(''); finally FIniFileStream := nil; end; end; procedure TdxBarManager.SaveToStream(AStream: TStream); begin FIniFileStream := AStream; try SaveToIniFile(''); finally FIniFileStream := nil; end; end; function TdxBarManager.CreateGroup: TdxBarGroup; begin Result := TdxBarGroup.Create(FMainForm); AddGroup(Result); end; function TdxBarManager.CanShowRecentItems: Boolean; begin Result := GetPaintStyle <> bmsStandard; end; function TdxBarManager.GetPaintStyle: TdxBarManagerStyle; const AStyles: array[TcxLookAndFeelKind] of TdxBarManagerStyle = ( bmsEnhanced, bmsStandard, bmsFlat{$IFDEF DXVER500}, bmsOffice11{$ENDIF}); begin if Style = bmsUseLookAndFeel then begin if LookAndFeel.NativeStyle and FThemeAvailable then Result := bmsXP else Result := AStyles[LookAndFeel.Kind]; end else Result := Style; end; { TdxDockControl } constructor TdxDockControl.Create(AOwner: TComponent); begin inherited Create(AOwner); FBackgroundBitmap := TBitmap.Create; FBackgroundBitmap.OnChange := BitmapChanged; FBackgroundTempBitmap := TBitmap.Create; ParentColor := True; FAllowDocking := True; FRowMarginSize := InsertZone; FRowList := TList.Create; end; constructor TdxDockControl.CreateEx(AOwner: TComponent; ABarManager: TdxBarManager; ADockStyle: TdxBarDockingStyle); const Styles: array[dsLeft..dsBottom] of TAlign = (alLeft, alTop, alRight, alBottom); begin Create(AOwner); Align := Styles[ADockStyle]; ControlStyle := [csNoDesignVisible]; if ADockStyle = dsTop then ControlStyle := ControlStyle + [csActionClient]; ; FDockingStyle := ADockStyle; BarManager := ABarManager; end; destructor TdxDockControl.Destroy; begin Destroying; BarManager := nil; while FRowList.Count <> 0 do begin while TdxDockRow(FRowList[0]).ColList.Count <> 0 do begin TdxDockCol(TdxDockRow(FRowList[0]).ColList[0]).Free; TdxDockRow(FRowList[0]).ColList.Delete(0); end; TdxDockRow(FRowList[0]).Free; FRowList.Delete(0); end; FRowList.Free; FBackgroundTempBitmap.Free; FBackgroundBitmap.Free; inherited Destroy; end; procedure TdxDockControl.BitmapChanged(Sender: TObject); begin Invalidate; UpdateDoubleBuffered; RepaintBarControls; end; function TdxDockControl.GetBars: TdxBars; begin if FBarManager = nil then Result := nil else Result := FBarManager.Bars; end; function TdxDockControl.GetDockingStyle: TdxBarDockingStyle; const Styles: array[TAlign] of TdxBarDockingStyle = (dsTop, dsTop, dsBottom, dsLeft, dsRight, dsTop{$IFDEF DELPHI6}, dsTop{$ENDIF}); begin Result := Styles[Align]; end; function TdxDockControl.GetHorizontal: Boolean; begin Result := DockingStyle in [dsTop, dsBottom]; end; function TdxDockControl.GetIsDesigning: Boolean; begin Result := csDesigning in ComponentState; end; function TdxDockControl.GetIsLoading: Boolean; begin Result := csLoading in ComponentState; end; function TdxDockControl.GetMain: Boolean; begin Result := FDockingStyle <> dsNone; end; function TdxDockControl.GetRow(Index: Integer): TdxDockRow; begin Result := FRowList[Index]; end; function TdxDockControl.GetRowCount: Integer; begin Result := FRowList.Count; end; function TdxDockControl.GetTopLeft: Boolean; begin Result := DockingStyle in [dsLeft, dsTop]; end; function TdxDockControl.GetVertical: Boolean; begin Result := DockingStyle in [dsLeft, dsRight]; end; procedure TdxDockControl.SetBarManager(Value: TdxBarManager); begin if FBarManager <> Value then begin if FBarManager <> nil then FBarManager.RemoveDockControl(Self); FBarManager := Value; if FBarManager <> nil then FBarManager.AddDockControl(Self); BarManagerChanged; end; end; procedure TdxDockControl.SetBackgroundBitmap(Value: TBitmap); var AChanged: Boolean; begin AChanged := not ((Value = nil) and FBackgroundBitmap.Empty); FBackgroundBitmap.Assign(Value); if AChanged then BitmapChanged(nil); end; procedure TdxDockControl.WMDestroy(var Message: TMessage); begin if FBarManager <> nil then FBarManager.CreateBarRestoringList; inherited; end; procedure TdxDockControl.WMEraseBkgnd(var Message: TWMEraseBkgnd); var R: TRect; begin R := ClientRect; FillBackground(Message.DC, R, R, 0, Color); Message.Result := 1; end; procedure TdxDockControl.WMMouseActivate(var Message: TWMMouseActivate); begin inherited; if (FBarManager <> nil) and not IsDesigning then begin Message.Result := MA_NOACTIVATE; SetWindowPos(GetMainForm.Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); end; end; procedure TdxDockControl.WMNCCalcSize(var Message: TWMNCCalcSize); begin inherited; if SunkenBorder then InflateRect(Message.CalcSize_Params.rgrc[0], -1, -1); end; procedure TdxDockControl.WMNCPaint(var Message: TWMNCPaint); var R: TRect; DC: HDC; begin inherited; if SunkenBorder then begin GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top); DC := GetWindowDC(Handle); DrawEdge(DC, R, BDR_SUNKENOUTER, BF_RECT); ReleaseDC(Handle, DC); end; end; procedure TdxDockControl.WMSize(var Message: TWMSize); begin ResetBackground; inherited; end; procedure TdxDockControl.WMRButtonDown(var Message: TWMRButtonDown); var P: TPoint; begin inherited; if FBarManager <> nil then begin if FBarManager.IsCustomizing then Exit; P.X := Message.XPos; P.Y := Message.YPos; P := ClientToScreen(P); ShowToolbarsPopup(Self, FBarManager, P); end; end; procedure TdxDockControl.WMWindowPosChanged(var Message: TWMWindowPosChanged); var PrevLockUpdate: Boolean; I, J: Integer; begin inherited; if (BarManager <> nil) and (Message.WindowPos^.flags and (SWP_NOMOVE or SWP_NOSIZE) <> SWP_NOMOVE or SWP_NOSIZE) then begin PrevLockUpdate := BarManager.FLockUpdate; BarManager.FLockUpdate := True; try if DockingStyle = dsBottom then for I := 0 to RowCount - 1 do for J := 0 to Rows[I].ColCount - 1 do with Rows[I].Cols[J].BarControl do if Bar.IsStatusBar then RebuildBar; finally BarManager.FLockUpdate := PrevLockUpdate; end; if IsTransparent then RepaintBarControls; end; end; procedure TdxDockControl.CMSysColorChange(var Message: TMessage); begin inherited; if IsWin9X and Main and (DockingStyle = dsLeft) then BarManager.MainFormWndProc(WM_SYSCOLORCHANGE, 0, 0); end; procedure TdxDockControl.AlignControls(AControl: TControl; var Rect: TRect); begin if (FBarManager <> nil) and not FBarManager.IsLoading then begin UpdateDock; end; end; procedure TdxDockControl.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin Style := WS_CHILD or WS_CLIPCHILDREN or WS_CLIPSIBLINGS; ExStyle := 0; WindowClass.Style := CS_DBLCLKS; end; end; procedure TdxDockControl.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = BarManager) then BarManager := nil; end; procedure TdxDockControl.RequestAlign; begin if not (csDestroyingHandle in ControlState) then inherited; end; procedure TdxDockControl.WndProc(var Message: TMessage); begin if (FBarManager <> nil) and (Message.Msg = WM_LBUTTONDBLCLK) and FBarManager.CanCustomize then begin FBarManager.Customizing(True); Exit; end; inherited; end; procedure TdxDockControl.AddBarControl(ABarControl: TdxBarControl; APos: TPoint; Update: Boolean); var Ins: Boolean; ARow, ACol, I: Integer; DockRow: TdxDockRow; DockCol: TdxDockCol; begin if FBarManager = nil then Exit; Ins := False; ARow := 0; if (ABarControl <> nil) and not ABarControl.InternallyLocked then ARow := GetRowAtPos(APos, Ins) else if ABarControl.FBar <> nil then begin ARow := ABarControl.FBar.Row; Ins := ABarControl.FBar.OneOnRow; end; if (ABarControl <> nil) and (ABarControl.Bar <> nil) and ABarControl.Bar.WholeRow then Ins := True; if ABarControl.InternallyLocked and (Bars.FLoading or BarManager.IsHandleCreating) and (ARow > FRowList.Count - 1) then for I := FRowList.Count to ARow do FRowList.Insert(I, TdxDockRow.Create(Self)) else begin if ARow > FRowList.Count - 1 + Byte(Ins) then begin //Ins := True; ARow := FRowList.Count - Byte(not Ins){!}; end; if ARow < 0 then ARow := 0; end; if ARow >= FRowList.Count then Ins := True; if not Ins then with TdxDockRow(FRowList[ARow]) do for I := 0 to ColList.Count - 1 do with TdxDockCol(ColList[I]) do if BarControl.Bar.WholeRow and (BarControl <> ABarControl) then begin Ins := True; Break; end; if Ins then begin if ABarControl.InternallyLocked and (Bars.FLoading or BarManager.IsHandleCreating) then DockRow := FRowList[ARow] else begin DockRow := TdxDockRow.Create(Self); FRowList.Insert(ARow, DockRow); end; DockCol := TdxDockCol.Create(DockRow, ABarControl); DockRow.ColList.Add(DockCol); end else begin DockCol := TdxDockCol.Create(TdxDockRow(FRowList[ARow]), ABarControl); ACol := GetColAtPos(ARow, APos); GetColAtPos(ARow, APos); TdxDockRow(FRowList[ARow]).ColList.Insert(ACol, DockCol); end; if not ABarControl.InternallyLocked then begin with Bars, FMovingOffset do if FMoving then begin Dec(APos.X, X); Dec(APos.Y, Y); end; with ABarControl, GetDragPointOffset(DockingStyle) do begin Dec(APos.X, X); Dec(APos.Y, Y); end; end; Windows.ScreenToClient(Handle, APos); case Horizontal of True: if APos.X < 0 then APos.X := 0; False: if APos.Y < 0 then APos.Y := 0; end; DockCol.FPos := APos; if Update then begin if not {Bars.}ABarControl.FMoving then with ABarControl do begin Left := APos.X; Top := APos.Y; end; UpdateDock; if not BarManager.Bars.FLoading and not BarManager.IsHandleCreating then DockCol.AssignPosition; end; end; procedure TdxDockControl.DeleteBarControl(ABarControl: TdxBarControl; ADockCol: TObject; Update: Boolean); var I, J: Integer; procedure DeleteCol; begin with TdxDockRow(FRowList[I]) do begin TdxDockCol(ColList[J]).Free; ColList.Delete(J); if ColList.Count = 0 then begin Free; FRowList.Delete(I); end; end; if Update then UpdateDock; end; begin if FBarManager = nil then Exit; for I := 0 to FRowList.Count - 1 do with TdxDockRow(FRowList[I]) do if ADockCol <> nil then begin J := ColList.IndexOf(ADockCol); if J > -1 then begin DeleteCol; Exit; end; end else for J := 0 to ColList.Count - 1 do if TdxDockCol(ColList[J]).BarControl = ABarControl then begin DeleteCol; Exit; end; end; procedure TdxDockControl.MoveBarControl(ABarControl: TdxBarControl; APos: TPoint); var DockCol: Pointer; begin if FBarManager = nil then Exit; DockCol := TdxDockRow(FRowList[ABarControl.GetRow]).ColList[ABarControl.GetCol]; DeleteBarControl(ABarControl, DockCol, False); AddBarControl(ABarControl, APos, True); if IsTransparent then begin ResetBackground; RepaintBarControls; end; end; procedure TdxDockControl.AssignPositions; var I, J: Integer; begin for I := 0 to RowCount - 1 do with Rows[I] do for J := 0 to ColCount - 1 do Cols[J].AssignPosition; end; procedure TdxDockControl.BarManagerChanged; begin ResetBackground; end; function TdxDockControl.CanDocking(Bar: TdxBar): Boolean; begin Result := FAllowDocking; end; procedure TdxDockControl.ColorChanged; begin if (FBarManager = nil) or FBarManager.AutoDockColor then ParentColor := True else Color := FBarManager.DockColor; end; function TdxDockControl.GetDockZoneBounds: TRect; begin Result := BoundsRect; InflateRect(Result, Bars.DockingZoneSize, Byte(Horizontal) * Bars.DockingZoneSize); MapWindowPoints(GetParent(Handle), 0, Result, 2); end; procedure TdxDockControl.GetDockZoneMargins(Row, ZoneNumber: Integer; var M1, M2: Integer); var IM1, IM2: Integer; begin M1 := 0; M2 := 0; if Row = -1 then if TopLeft then begin M1 := -Bars.DockingZoneSize; M2 := 0; end else begin if DockingStyle = dsRight then M1 := ClientWidth else M1 := ClientHeight; M1 := M1 - GetClientSize - Bars.DockingZoneSize; M2 := M1 + Bars.DockingZoneSize; end else if Row = FRowList.Count then if TopLeft then begin M1 := GetClientSize; M2 := M1 + Bars.DockingZoneSize; end else begin if DockingStyle = dsRight then M1 := ClientWidth else M1 := ClientHeight; M2 := M1 + Bars.DockingZoneSize; end else with GetRectForRow(Row) do if Horizontal then begin M1 := Top; M2 := Bottom; end else begin M1 := Left; M2 := Right; end; case DockingStyle of dsLeft, dsTop: IM1 := M1 + (Bars.DockingZoneSize - InsertZone div 2) div 2; dsRight, dsBottom: IM1 := M2 - (Bars.DockingZoneSize - InsertZone div 2) div 2 - InsertZone div 2; else IM1 := 0; end; IM2 := IM1 + InsertZone div 2; case ZoneNumber of 0: M2 := IM1; 1: begin M1 := IM1; M2 := IM2; end; 2: M1 := IM2; end; end; function TdxDockControl.GetRectForRow(ARow: Integer): TRect; var I: Integer; Origin, Size: Integer; function GetRowHeight(ARow: Integer): Integer; var J: Integer; begin Result := 0; for J := 0 to TdxDockRow(FRowList[ARow]).ColList.Count - 1 do with TdxDockCol(TdxDockRow(FRowList[ARow]).ColList[J]).BarControl do case Self.DockingStyle of dsLeft, dsRight: if Result < Width then Result := Width; dsTop, dsBottom: if Result < Height then Result := Height; end; end; begin SetRectEmpty(Result); if (ARow < 0) or (ARow > FRowList.Count - 1) then Exit; Size := 0; if not Bars.FMoving or (DockingStyle in [dsLeft, dsTop]) then begin Origin := 0; for I := 0 to ARow do begin Inc(Origin, Size); Size := GetRowHeight(I); end; end else begin if DockingStyle = dsRight then Origin := ClientWidth else Origin := ClientHeight; for I := FRowList.Count - 1 downto ARow do begin Size := GetRowHeight(I); Dec(Origin, Size); end; end; case DockingStyle of dsLeft, dsRight: Result := Bounds(Origin, 0, Size, ClientHeight); dsTop, dsBottom: Result := Bounds(0, Origin, ClientWidth, Size); end; end; function TdxDockControl.GetClientSize: Integer; var I: Integer; R: TRect; begin Result := 0; case DockingStyle of dsLeft, dsRight: for I := 0 to FRowList.Count - 1 do begin R := GetRectForRow(I); Inc(Result, R.Right - R.Left); end; dsTop, dsBottom: for I := 0 to FRowList.Count - 1 do begin R := GetRectForRow(I); Inc(Result, R.Bottom - R.Top); end; end; end; function TdxDockControl.GetSize: Integer; begin Result := GetClientSize; if (Result > 0) and SunkenBorder then Inc(Result, 2); end; function TdxDockControl.GetRowAtPos(APos: TPoint; var Insert: Boolean): Integer; var I, J, Z, M1, M2: Integer; Found: Boolean; begin if FRowList.Count = 0 then begin Result := 0; Insert := True; Exit; end; Result := -1; Insert := False; Windows.ScreenToClient(Handle, APos); if Vertical then Z := APos.X else Z := APos.Y; Found := False; for I := -1 to FRowList.Count - 1 do begin for J := 0 to 2 do begin GetDockZoneMargins(I, J, M1, M2); if (M1 <= Z) and (Z < M2) then begin Result := I + Byte(J > 0); Insert := J = 1; Found := True; Break; end; end; if Found then Break; end; if Result = -1 then begin Insert := True; if Z >= GetClientSize then Result := FRowList.Count else Result := 0; end else if Result >= FRowList.Count then Insert := True; end; function TdxDockControl.GetColAtPos(ARow: Integer; APos: TPoint): Integer; var I: Integer; begin Result := 0; if (FRowList[ARow] = nil) or (TdxDockRow(FRowList[ARow]).ColList.Count = 0) then Exit; Windows.ScreenToClient(Handle, APos); if Bars.FMoving and not Bars.FMovingBarControl.InternallyLocked then with Bars.FMovingBarControl.GetDragPointOffset(DockingStyle) do case DockingStyle of dsLeft, dsRight: Dec(APos.Y, Y); dsTop, dsBottom: Dec(APos.X, X); end; with TdxDockRow(FRowList[ARow]) do begin for I := 0 to ColList.Count - 1 do with TdxDockCol(ColList[I]), BarControl.Bar do case DockingStyle of dsLeft, dsRight: if APos.Y <= DockedTop then begin Result := I; Exit; end; dsTop, dsBottom: if APos.X <= DockedLeft then begin Result := I; Exit; end; end; Result := ColList.Count; end; end; procedure TdxDockControl.GetPosForRow(Row: Integer; OneOnRow: Boolean; var P: TPoint); var M1, M2, Temp: Integer; begin if OneOnRow and (Row = FRowList.Count) then OneOnRow := False; if OneOnRow then GetDockZoneMargins(Row - 1, 1, M1, M2) else begin GetDockZoneMargins(Row - 1, 2, M1, Temp); GetDockZoneMargins(Row, 0, Temp, M2); if Temp - M1 > M2 - Temp then M1 := Temp - (M2 - Temp); end; Temp := (M1 + M2) div 2; Windows.ScreenToClient(Handle, P); if Vertical then P.X := Temp else P.Y := Temp; Windows.ClientToScreen(Handle, P); end; function TdxDockControl.GetSunkenBorder: Boolean; begin if BarManager = nil then Result := False else Result := BarManager.SunkenBorder; end; function TdxDockControl.GetMainForm: TCustomForm; begin Result := FBarManager.MainForm; end; procedure TdxDockControl.NCChanged; var I, J: Integer; begin if not HandleAllocated then Exit; SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_FRAMECHANGED); for I := 0 to RowCount - 1 do for J := 0 to Rows[I].ColCount - 1 do Rows[I].Cols[J].BarControl.FrameChanged{RebuildBar}; UpdateDock; end; procedure TdxDockControl.PaintBarControls; var AVertical: Boolean; Temp, I, J, K, MarkSize, ClientSize, LenMax, MinSize, MaxSize, MaxHeight, RowLen, RestSize, Margin, FixedSize, Size, APos: Integer; R: TRect; ASize: TPoint; function GetMinSize(ABarControl: TdxBarControl): Integer; begin if Vertical then Result := ABarControl.GetMinHeight(DockingStyle) else Result := ABarControl.GetMinWidth(DockingStyle); end; function GetMaxSizeX(ABarControl: TdxBarControl): Integer; begin if Vertical then Result := ABarControl.GetMaxHeight(DockingStyle) else Result := ABarControl.GetMaxWidth(DockingStyle); end; function GetMaxSizeY(ABarControl: TdxBarControl): Integer; begin if Vertical then Result := ABarControl.GetMaxWidth(DockingStyle) else Result := ABarControl.GetMaxHeight(DockingStyle); end; function NCSizeX(ABarControl: TdxBarControl): Integer; begin if Vertical then Result := ABarControl.Bar.BarNCSizeY(DockingStyle) else Result := ABarControl.Bar.BarNCSizeX(DockingStyle); end; function NCSizeY(ABarControl: TdxBarControl): Integer; begin if Vertical then Result := ABarControl.Bar.BarNCSizeX(DockingStyle) else Result := ABarControl.Bar.BarNCSizeY(DockingStyle); end; function GetFullSize(ABarControl: TdxBarControl; ASize: Integer): TPoint; begin Dec(ASize, NCSizeX(ABarControl) + Byte(ABarControl.FTruncated and not BarManager.PainterClass.BarAllowQuickCustomizing) * MarkSize); if Vertical then begin Result := ABarControl.GetSizeForHeight(DockingStyle, ASize); with Result do begin Temp := X; X := Y; Y := Temp; end; end else Result := ABarControl.GetSizeForWidth(DockingStyle, ASize); end; begin if (FRowList = nil) or (FBarManager = nil) or (csDestroying in FBarManager.MainForm.ComponentState) or (Bars = nil) or Bars.FLoading then Exit; if not BarManager.Designing and HandleAllocated then SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); DisableAlign; AVertical := Vertical; MarkSize := MarkSizeX; if AVertical then ClientSize := ClientHeight else ClientSize := ClientWidth; for I := 0 to FRowList.Count - 1 do with TdxDockRow(FRowList[I]) do if ColList.Count > 0 then begin LenMax := 0; for J := 0 to ColList.Count - 1 do with TdxDockCol(ColList[J]), BarControl do begin FTruncated := False; ItemLinks.RecentItemCount := -1; FMinSize := GetMinSize(BarControl) + NCSizeX(BarControl); FMaxSize := GetMaxSizeX(BarControl) + NCSizeX(BarControl); if not MarkExists and (FMinSize <> FMaxSize) then Inc(FMinSize, MarkSize); Inc(LenMax, FMaxSize); end; R := GetRectForRow(I); if AVertical then with R do begin Temp := Left; Left := Top; Top := Temp; end; RowLen := ClientSize; MaxHeight := 0; if TdxDockCol(ColList[0]).BarControl.Bar.WholeRow then with TdxDockCol(ColList[0]), BarControl do begin NewLeft := R.Left; NewTop := R.Top; NewWidth := RowLen; if NewWidth < FMinSize then NewWidth := FMinSize; FTruncated := not MultiLine and (NewWidth < FMaxSize); NewHeight := GetFullSize(BarControl, NewWidth).Y + NCSizeY(BarControl); if NewHeight > MaxHeight then MaxHeight := NewHeight; end else if LenMax <= RowLen then begin Margin := RowLen; for J := ColList.Count - 1 downto 0 do with TdxDockCol(ColList[J]), BarControl do begin NewTop := R.Top; NewWidth := FMaxSize; if MultiLine then NewHeight := GetFullSize(BarControl, NewWidth).Y else NewHeight := GetMaxSizeY(BarControl); Inc(NewHeight, NCSizeY(BarControl)); if NewHeight > MaxHeight then MaxHeight := NewHeight; if AVertical then APos := Pos.Y else APos := Pos.X; if APos + NewWidth <= Margin then NewLeft := APos else NewLeft := Margin - NewWidth; FixedSize := 0; for K := 0 to J - 1 do Inc(FixedSize, TdxDockCol(ColList[K]).BarControl.FMaxSize); if NewLeft < FixedSize then NewLeft := FixedSize; Margin := NewLeft; end; end else begin Size := RowLen; for J := ColList.Count - 1 downto 0 do with TdxDockCol(ColList[J]), BarControl do begin if AVertical then FixedSize := Pos.Y else FixedSize := Pos.X; MinSize := 0; MaxSize := 0; for K := J - 1 downto 0 do with TdxDockCol(ColList[K]).BarControl do begin Inc(MinSize, FMinSize); Inc(MaxSize, FMaxSize); end; if FixedSize < MinSize then FixedSize := MinSize; if FixedSize > MaxSize then FixedSize := MaxSize; if (J > 0) and (TdxDockCol(ColList[J - 1]).BarControl = Bars.FMovingBarControl) then begin with TdxDockCol(ColList[J - 1]), BarControl, Bar do begin if AVertical then K := Pos.Y else K := Pos.X; if K < MinSize - FMinSize then K := MinSize - FMinSize; Inc(K, FMaxSize); end; if K < FixedSize then begin if AVertical then FPos.Y := K else FPos.X := K; FixedSize := K; end; end; RestSize := Size - FixedSize; if RestSize >= FMaxSize then begin NewWidth := FMaxSize; if MultiLine then NewHeight := GetFullSize(BarControl, NewWidth).Y else NewHeight := GetMaxSizeY(BarControl); end else begin FTruncated := not MultiLine and (FMinSize <> FMaxSize); if RestSize <= FMinSize then NewWidth := FMinSize else NewWidth := RestSize; NewHeight := GetFullSize(BarControl, NewWidth).Y; end; if (J = 0) and (Size > NewWidth) then NewWidth := Size; NewLeft := Size - NewWidth; if NewLeft < MinSize then NewLeft := MinSize; if NewLeft > MaxSize then NewLeft := MaxSize; NewTop := R.Top; Inc(NewHeight, NCSizeY(BarControl)); if NewHeight > MaxHeight then MaxHeight := NewHeight; Dec(Size, NewWidth); end; end; for J := 0 to ColList.Count - 1 do with TdxDockCol(ColList[J]).BarControl do if Bar.UseRestSpace then begin if J = 0 then NewLeft := 0 else with TdxDockCol(ColList[J - 1]).BarControl do TdxDockCol(ColList[J]).BarControl.NewLeft := NewLeft + NewWidth; if J = ColList.Count - 1 then NewWidth := ClientSize - NewLeft else NewWidth := TdxDockCol(ColList[J + 1]).BarControl.NewLeft - NewLeft; if NewWidth < FMinSize then NewWidth := FMinSize; end; for J := 0 to ColList.Count - 1 do with TdxDockCol(ColList[J]), BarControl do begin if FTruncated and (J = ColList.Count - 1) then begin NewWidth := ClientSize - NewLeft; if NewWidth < FMinSize then NewWidth := FMinSize; end; NewHeight := MaxHeight; // for the RecentItemCount calculating GetFullSize(BarControl, NewWidth); if AVertical then begin Temp := NewLeft; NewLeft := NewTop; NewTop := Temp; Temp := NewWidth; NewWidth := NewHeight; NewHeight := Temp; end; if (Left <> NewLeft) or (Top <> NewTop) or (Width <> NewWidth) or (Height <> NewHeight) then SetWindowPos(Handle, 0, NewLeft, NewTop, NewWidth, NewHeight, SWP_NOZORDER or SWP_NOACTIVATE); CalcControlsPositions; end; end; EnableAlign; Repaint; end; procedure TdxDockControl.SetSize; function IsCurrentDockControl(ABarControl: TCustomdxBarControl): Boolean; begin Result := True; ABarControl := GetParentBarForBar(ABarControl); if ABarControl is TdxBarControl then if (Self is TdxBarDockControl) and not (TdxBarControl(ABarControl).DockControl is TdxBarDockControl) or (ABarControl.BarManager <> BarManager) and (GetParentForm(Self) <> GetParentForm(ABarControl)) then Result := False; end; var ASize, PrevSize: Integer; begin ASize := GetSize; PrevSize := 0; case DockingStyle of dsLeft, dsRight: begin PrevSize := Width; if DockingStyle = dsRight then begin Parent.DisableAlign; Left := Left - (ASize - Width); end; Width := ASize; if DockingStyle = dsRight then Parent.EnableAlign; end; dsTop, dsBottom: begin PrevSize := Height; if DockingStyle = dsBottom then begin Parent.DisableAlign; Top := Top - (ASize - Height); end; Height := ASize; if DockingStyle = dsBottom then Parent.EnableAlign; end; end; if (ASize <> PrevSize) and (ActiveBarControl <> nil) and not (GetParentBarForBar(ActiveBarControl) is TdxBarQuickControl) and (ActiveBarControl.Handle <> GetCapture) and IsCurrentDockControl(ActiveBarControl) then ActiveBarControl.HideAll; end; procedure TdxDockControl.UpdateDock; begin if (FBarManager <> nil) and not (csDestroying in FBarManager.MainForm.ComponentState) and not FBarManager.LockUpdate and not FBarManager.IsDestroying then begin PaintBarControls; SetSize; end; end; procedure TdxDockControl.FillBackground(DC: HDC; ADestR, ASourceR: TRect; ABrush: HBRUSH; AColor: TColor); var CR: TRect; begin if not BackgroundBitmap.Empty or (BarManager = nil) then FillBackgroundRect(DC, ADestR, ASourceR, ABrush, AColor, BackgroundBitmap) else begin if not BarManager.Backgrounds.Bar.Empty then FillBackgroundRect(DC, ADestR, ASourceR, ABrush, AColor, BarManager.Backgrounds.Bar) else begin CR := ClientRect; if not IsRectEmpty(CR) then BarManager.PainterClass.DockControlFillBackground(Self, DC, ADestR, ASourceR, CR, ABrush, AColor) end; end; end; function TdxDockControl.IsBackgroundBitmap: Boolean; begin Result := not BackgroundBitmap.Empty; end; function TdxDockControl.IsTransparent: Boolean; begin Result := not BackgroundBitmap.Empty or ((BarManager <> nil) and (BarManager.PainterClass.IsNativeBackground or not BarManager.Backgrounds.Bar.Empty)); end; procedure TdxDockControl.RepaintBarControls; var I, J: Integer; begin for I := 0 to RowCount - 1 do for J := 0 to Rows[I].ColCount - 1 do Rows[I].Cols[J].BarControl.FullRepaint; end; procedure TdxDockControl.ResetBackground; begin FBackgroundTempBitmap.Assign(nil); end; procedure TdxDockControl.UpdateDoubleBuffered; begin DoubleBuffered := IsTransparent; end; procedure TdxDockControl.InitiateAction; var I: Integer; begin if FBarManager <> nil then with FBarManager do for I := 0 to Bars.Count - 1 do with Bars[I] do if Visible then ItemLinks.InitiateActions; end; { TdxBarDockControl } constructor TdxBarDockControl.Create(AOwner: TComponent); begin inherited; Align := dalTop; end; function TdxBarDockControl.GetAlign: TdxBarDockAlign; begin Result := TdxBarDockAlign(inherited Align); end; function TdxBarDockControl.GetColor: TColor; begin Result := inherited Color; end; function TdxBarDockControl.GetIsLoading: Boolean; begin Result := (csLoading in ComponentState) or (BarManager <> nil) and BarManager.Bars.IsLoading; end; function TdxBarDockControl.GetParentColor: Boolean; begin Result := inherited ParentColor; end; procedure TdxBarDockControl.SetAlign(Value: TdxBarDockAlign); const Styles: array[TdxBarDockAlign] of TdxBarDockingStyle = (dsTop, dsTop, dsBottom, dsLeft, dsRight); var PrevLockUpdate: Boolean; I, J: Integer; begin if Align <> Value then begin if BarManager <> nil then begin PrevLockUpdate := BarManager.LockUpdate; BarManager.LockUpdate := True; end else PrevLockUpdate := False; try for I := 0 to RowCount - 1 do for J := 0 to Rows[I].ColCount - 1 do Rows[I].Cols[J].BarControl.DockingStyle := Styles[Value]; inherited Align := TAlign(Value); finally if BarManager <> nil then begin BarManager.LockUpdate := PrevLockUpdate; for I := 0 to RowCount - 1 do for J := 0 to Rows[I].ColCount - 1 do Rows[I].Cols[J].BarControl.RepaintBar; if Parent <> nil then Parent.Invalidate; end; end; end; end; procedure TdxBarDockControl.SetAllowZeroSizeInDesignTime(Value: Boolean); begin if FAllowZeroSizeInDesignTime <> Value then begin FAllowZeroSizeInDesignTime := Value; Perform(WM_SIZE, 0, 0); end; end; procedure TdxBarDockControl.SetColor(Value: TColor); begin if Color <> Value then begin inherited Color := Value; if not IsLoading then UseOwnColor := True; end; end; procedure TdxBarDockControl.SetParentColor(Value: Boolean); begin if ParentColor <> Value then begin inherited ParentColor := Value; if not IsLoading then UseOwnColor := True; end; end; procedure TdxBarDockControl.SetSunkenBorder(Value: Boolean); begin if SunkenBorder <> Value then begin FSunkenBorder := Value; FUseOwnSunkenBorder := True; NCChanged; end; end; procedure TdxBarDockControl.SetUseOwnColor(Value: Boolean); begin if FUseOwnColor <> Value then begin FUseOwnColor := Value; if not Value then ColorChanged; end; end; procedure TdxBarDockControl.SetUseOwnSunkenBorder(Value: Boolean); var PrevSunkenBorder: Boolean; begin if FUseOwnSunkenBorder <> Value then begin PrevSunkenBorder := SunkenBorder; FUseOwnSunkenBorder := Value; if Value then FSunkenBorder := PrevSunkenBorder else if SunkenBorder <> PrevSunkenBorder then NCChanged; end; end; function TdxBarDockControl.IsColorStored: Boolean; begin Result := FUseOwnColor and not ParentColor; end; procedure TdxBarDockControl.WMCreate(var Message: TWMCreate); begin inherited; if BarManager <> nil then BarManager.ShowBarsFromRestoringList(Self); end; procedure TdxBarDockControl.WMSize(var Message: TWMSize); begin inherited; if not IsLoading and (RowCount = 0) then if Horizontal then ClientHeight := GetMinSize else ClientWidth := GetMinSize; end; procedure TdxBarDockControl.CreateParams(var Params: TCreateParams); begin inherited; if IsDesigning then with Params do WindowClass.Style := WindowClass.Style or CS_HREDRAW or CS_VREDRAW; end; procedure TdxBarDockControl.Paint; begin inherited; if IsDesigning then begin Canvas.Brush.Style := bsClear; Canvas.Pen.Style := psDot; Canvas.Rectangle(0, 0, ClientWidth, ClientHeight); Canvas.Pen.Style := psSolid; Canvas.Brush.Style := bsSolid; end; { if IsDesigning then with Canvas do begin Brush := Self.Brush; Pen.Style := psDot; Rectangle(0, 0, ClientWidth, ClientHeight); Pen.Style := psSolid; end else inherited;} end; procedure TdxBarDockControl.BarManagerChanged; begin inherited; if not (csDestroying in ComponentState) then begin ColorChanged; NCChanged; end; end; function TdxBarDockControl.CanDocking(Bar: TdxBar): Boolean; begin Result := inherited CanDocking(Bar) and ((Bar.Control = nil) or not HasAsParent(Handle, Bar.Control.Handle)); end; procedure TdxBarDockControl.ColorChanged; begin if not FUseOwnColor then begin inherited; FUseOwnColor := False; end; end; function TdxBarDockControl.GetClientSize: Integer; begin if IsLoading then if Horizontal then Result := ClientHeight else Result := ClientWidth else begin Result := inherited GetClientSize; if Result = 0 then Result := GetMinSize; end; end; function TdxBarDockControl.GetMinSize: Integer; begin if IsDesigning and not AllowZeroSizeInDesignTime then Result := MinDockSize else Result := 0; end; function TdxBarDockControl.GetSunkenBorder: Boolean; begin if FUseOwnSunkenBorder then Result := FSunkenBorder else Result := inherited GetSunkenBorder; end; function TdxBarDockControl.GetMainForm: TCustomForm; begin Result := GetParentForm(Self); if Result = nil then // Result.HandleAllocated? Result := inherited GetMainForm; end; { TdxBarPopupMenu } constructor TdxBarPopupMenu.Create(AOwner: TComponent); var AForm: TCustomForm; begin inherited Create(AOwner); if dxBarManagerList.Count = 0 then raise Exception.Create(cxGetResourceString(@dxSBAR_NOBARMANAGERS)); FBackgroundBitmap := TBitmap.Create; if AOwner is TCustomForm then AForm := TCustomForm(AOwner) else AForm := nil; if AForm <> nil then BarManager := GetBarManagerByForm(AForm); if FBarManager = nil then BarManager := TdxBarManager(dxBarManagerList[0]); FFont := TFont.Create; FFont.Assign(BarManager.Font); FFont.OnChange := FontChanged; FItemLinks := TdxBarItemLinks.Create(FBarManager); FItemLinks.FOwner := Self; FItemLinks.FUseRecentItems := False; FShowAnimation := True; end; destructor TdxBarPopupMenu.Destroy; begin Destroying; if FItemLinks <> nil then begin FItemLinks.Free; FItemLinks := nil; end; FFont.Free; if FEditFontHandle <> 0 then DeleteObject(FEditFontHandle); BarManager := nil; FBackgroundBitmap.Free; FBackgroundBitmap := nil; inherited Destroy; end; function TdxBarPopupMenu.GetSubMenuControl: TdxBarSubMenuControl; begin Result := TdxBarSubMenuControl(FItemLinks.BarControl); end; procedure TdxBarPopupMenu.SetBackgroundBitmap(Value: TBitmap); begin FBackgroundBitmap.Assign(Value); end; procedure TdxBarPopupMenu.SetBarManager(Value: TdxBarManager); begin if FBarManager <> Value then begin if (Value = nil) and not (csDestroying in ComponentState) then Exit; if FBarManager <> nil then FBarManager.FPopupMenus.Remove(Self); FBarManager := Value; if FItemLinks <> nil then FItemLinks.FBarManager := Value; if FBarManager <> nil then FBarManager.FPopupMenus.Add(Self); end; end; procedure TdxBarPopupMenu.SetBarSize(Value: Integer); begin if Value < 0 then Value := 0; FBarSize := Value; end; procedure TdxBarPopupMenu.SetFont(Value: TFont); begin FFont.Assign(Value); end; procedure TdxBarPopupMenu.SetItemLinks(Value: TdxBarItemLinks); begin FItemLinks.Assign(Value); end; procedure TdxBarPopupMenu.SetUseOwnFont(Value: Boolean); begin if FUseOwnFont <> Value then begin FUseOwnFont := Value; FInternalFontChange := True; try if FUseOwnFont then FontChanged(nil) else begin Font := BarManager.Font; DeleteObject(FEditFontHandle); FEditFontHandle := 0; end; finally FInternalFontChange := False; end; end; end; procedure TdxBarPopupMenu.SetUseRecentItems(Value: Boolean); begin if FUseRecentItems <> Value then begin FUseRecentItems := Value; FItemLinks.FUseRecentItems := Value; end; end; procedure TdxBarPopupMenu.FontChanged(Sender: TObject); begin if not FInternalFontChange then FUseOwnFont := True; if FUseOwnFont then CreateEditFontHandle(FFont, FEditFontHandle, False); end; procedure TdxBarPopupMenu.SubMenuCloseUp(Sender: TObject); begin FPopupMenuVisible := False; if Assigned(FOnCloseUp) then FOnCloseUp(Self); end; procedure TdxBarPopupMenu.SubMenuPopup(Sender: TObject); begin FPopupMenuVisible := True; if Assigned(FOnPopup) then FOnPopup(Self); end; procedure TdxBarPopupMenu.OwnerDesignerModified; begin if (csDesigning in ComponentState) and ([csLoading, csDestroying, csUpdating] * ComponentState = []) then begin BarManager.DesignerModified; {$IFDEF DELPHI5} if FindRootDesigner(Self) <> nil then FindRootDesigner(Self).Modified; {$ENDIF} end; end; procedure TdxBarPopupMenu.DoPaintBar(Canvas: TCanvas; const R: TRect); begin if Assigned(FOnPaintBar) then FOnPaintBar(Self, Canvas, R); end; function TdxBarPopupMenu.IsShortCut(AShortCut: TShortCut): Boolean; begin Result := FItemLinks.IsShortCut(AShortCut); end; function TdxBarPopupMenu.IsShortCutKey(var Message: TWMKey): Boolean; const AltMask = $20000000; var AShortCut: TShortCut; begin AShortCut := Byte(Message.CharCode); if AShortCut = 0 then Result := False else begin if GetKeyState(VK_SHIFT) < 0 then Inc(AShortCut, scShift); if GetKeyState(VK_CONTROL) < 0 then Inc(AShortCut, scCtrl); if Message.KeyData and AltMask <> 0 then Inc(AShortCut, scAlt); Result := IsShortCut(AShortCut); end; end; procedure TdxBarPopupMenu.Loaded; begin inherited; FItemLinks.Loaded(True); end; procedure TdxBarPopupMenu.Popup(X, Y: Integer); var Msg: TMsg; begin if FItemLinks.BarControl <> nil then Exit; if Owner is TCustomForm then TCustomForm(Owner).SendCancelMode(nil) else BarManager.MainForm.SendCancelMode(nil); if GetCapture <> 0 then begin SendMessage(GetCapture, CM_CANCELMODE, 0, 0); ReleaseCapture; end; FItemLinks.CreateBarControl; FItemLinks.BarControl.Left := X; FItemLinks.BarControl.Top := Y; with TdxBarSubMenuControl(FItemLinks.BarControl) do begin if Self.FOwnerBounds <> nil then OwnerBounds := Self.FOwnerBounds^; FOwnerControl := Self.FOwnerControl; OwnerWidth := Self.FOwnerWidth; OwnerHeight := Self.FOwnerHeight; if Self.Owner is TWinControl then ParentWnd := TWinControl(Self.Owner).Handle; OnCloseUp := SubMenuCloseUp; OnPopup := SubMenuPopup; FShowAnimation := Self.FShowAnimation; try Show; except HideAll; raise; end; if DontUseMessageLoop then Exit; repeat case Integer(GetMessage(Msg, 0, 0, 0)) of -1: Break; 0: begin PostQuitMessage(Msg.wParam); Break; end; end; if not FPopupMenuVisible then with Msg do PostMessage(hwnd, message, wParam, lParam) else if Msg.message = WM_COMMAND then // do nothing else begin TranslateMessage(Msg); DispatchMessage(Msg); end; until not FPopupMenuVisible; end; end; procedure TdxBarPopupMenu.PopupEx(X, Y, AOwnerWidth, AOwnerHeight: Integer; AShowAnimation: Boolean; AOwnerBounds: PRect); begin FOwnerWidth := AOwnerWidth; FOwnerHeight := AOwnerHeight; FShowAnimation := AShowAnimation; FOwnerBounds := AOwnerBounds; Popup(X, Y); FOwnerWidth := 0; FOwnerHeight := 0; FShowAnimation := True; end; procedure TdxBarPopupMenu.PopupFromCursorPos; var P: TPoint; begin GetCursorPos(P); Popup(P.X, P.Y); end; { TCustomdxBarControl } constructor TCustomdxBarControl.Create(AOwner: TComponent); begin inherited Create(AOwner); AddBarControl(Self); ControlStyle := ControlStyle - [csCaptureMouse]; UpdateControlStyle; Color := clBtnFace; FLastMousePos := Point(-1, -1); FShadow := TdxBarShadow.Create(Self); Visible := False; SetBounds(100, 100, 30, 50); FBackgroundTempBitmap := TBitmap.Create; end; destructor TCustomdxBarControl.Destroy; begin if Self is TdxBarControl then TdxBarControl(Self).HideAll//BarLostFocus else IsActive := False; if (BarManager <> nil) and (BarManager.FSelectedItem <> nil) and (BarManager.FSelectedItem.Parent = Self) then BarManager.FSelectedItem := nil; if FItemLinks <> nil then FItemLinks.FBarControl := nil; if IsCustomizing and (Self is TdxBarSubMenuControl) then begin FSelectedItem := nil; with TdxBarSubMenuControl(Self) do if FSubItem <> nil then with FSubItem do begin BarManager.FSelectedItem := FSubItem; FIsActive := False; Repaint; end; end; RemoveBarControl(Self); FShadow.Free; FBackgroundTempBitmap.Free; cxClearObjectLinks(Self); inherited Destroy; end; function TCustomdxBarControl.GetBarControlOwnerBrush: HBRUSH; begin Result := PainterClass.BarControlOwnerBrush(BarManager); end; function TCustomdxBarControl.GetBarManager: TdxBarManager; begin Result := Owner as TdxBarManager; end; function TCustomdxBarControl.GetFlat: Boolean; begin // TODO: obsolete Result := BarManager.Flat; end; function TCustomdxBarControl.GetIsDestroying: Boolean; begin Result := csDestroying in ComponentState; end; function TCustomdxBarControl.GetOwnerLinkBounds(AOwnerPart: Boolean): TRect; var AOwnerBounds: TRect; AFirstCase: Boolean; procedure ConvertRects; procedure ConvertRect(var R: TRect); procedure ConvertPoint(var P: TPoint); var APrevX: Integer; begin with P do begin APrevX := X; X := Y; Y := APrevX; end; end; begin ConvertPoint(R.TopLeft); ConvertPoint(R.BottomRight); end; begin if not FShadow.Horizontal then begin ConvertRect(Result); ConvertRect(AOwnerBounds); end; end; begin if IsRectEmpty(FOwnerBounds) or not IsLinkedToOwner then SetRectEmpty(Result) else begin GetWindowRect(Result); AOwnerBounds := FOwnerBounds; with Result do begin OffsetRect(AOwnerBounds, -Left, -Top); OffsetRect(Result, -Left, -Top); ConvertRects; AFirstCase := AOwnerBounds.Bottom = Top; if AFirstCase then Bottom := Top + 1 else Top := Bottom - 1; if AOwnerPart then OffsetRect(Result, 0, -(2 * Ord(AFirstCase) - 1)); if Left < AOwnerBounds.Left + 1 then Left := AOwnerBounds.Left + 1 else Inc(Left); if Right > AOwnerBounds.Right - 1 then Right := AOwnerBounds.Right - 1 else Dec(Right); ConvertRects; end; if AOwnerPart then OffsetRect(Result, Left, Top); end; end; function TCustomdxBarControl.GetPainterClass: TdxBarItemControlPainterClass; begin Result := BarManager.PainterClass; end; procedure TCustomdxBarControl.SetDockControl(Value: TdxDockControl); begin FDockControl := Value; UpdateDoubleBuffered; //! end; procedure TCustomdxBarControl.WMCaptureChanged(var Message: TMessage); begin inherited; if FDragDown then begin BarManager.FDraggingItem := nil; BarManager.FDraggingItemLink := nil; FDragDown := False; end; FClickedControl := nil; end; procedure TCustomdxBarControl.WMDestroy(var Message: TMessage); begin if not IsDestroying then begin FinishMouseTracking(Handle); MarkState := msNone; BeforeDestroyHandle; end; inherited; end; procedure TCustomdxBarControl.WMEraseBkgnd(var Message: TWMEraseBkgnd); begin // if FItemLinks.CanVisibleItemCount = 0 then // else Fill Rgn is called // FillBackground(Message.DC, ClientRect, ToolbarBrush, clNone, True); Message.Result := 1; end; procedure TCustomdxBarControl.WMKeyDown(var Message: TWMKeyDown); var Key: Word; IsTabKey, Duplicate, Hidden: Boolean; AItemLink, DuplicateItemLink: TdxBarItemLink; ATabForward: Boolean; begin inherited; if ActiveBarControl = nil then Exit; Key := Message.CharCode; if IsRealVertical(Self) then begin case Key of VK_LEFT: Key := VK_UP; VK_RIGHT: Key := VK_DOWN; VK_UP: Key := VK_LEFT; VK_DOWN: Key := VK_RIGHT; end; Message.CharCode := Key; end; if Self is TdxBarSubMenuControl then case Key of VK_LEFT, VK_RIGHT: Key := 0; VK_UP: Key := VK_LEFT; VK_DOWN: Key := VK_RIGHT; end; IsTabKey := Key = VK_TAB; ATabForward := False; if IsTabKey then begin if GetKeyState(VK_CONTROL) < 0 then ATabForward := not (GetKeyState(VK_SHIFT) < 0) else if GetKeyState(VK_SHIFT) < 0 then Key := VK_LEFT else Key := VK_RIGHT; end; case Key of VK_TAB: // + Ctrl FocusNextBarControl(ATabForward); VK_F10, VK_MENU: if (Key = VK_MENU) or BarManager.UseF10ForMenu then begin Message.CharCode := 0; HideAll; end; VK_LEFT: begin if FSelectedItem = nil then AItemLink := ItemLinks.First else AItemLink := ItemLinks.Prev(FSelectedItem.ItemLink); if AItemLink <> nil then SetKeySelectedItem(AItemLink.Control); if IsTabKey and (SelectedItem is TdxBarWinControl) then SelectedItem.Click(False); end; VK_RIGHT: begin if FSelectedItem = nil then AItemLink := ItemLinks.First else AItemLink := ItemLinks.Next(FSelectedItem.ItemLink); if AItemLink <> nil then SetKeySelectedItem(AItemLink.Control); if IsTabKey and (SelectedItem is TdxBarWinControl) then SelectedItem.Click(False); end; VK_HOME: begin AItemLink := ItemLinks.First; if AItemLink <> nil then SetKeySelectedItem(AItemLink.Control); end; VK_END: begin AItemLink := ItemLinks.Last; if AItemLink <> nil then SetKeySelectedItem(AItemLink.Control); end; else begin Key := MapVirtualKey(Key, 2); if ((Ord('A') <= Key) and (Key <= Ord('Z'))) or (Ord('0') <= Key) and (Key <= Ord('9')) then with ItemLinks do begin if SelectedItem = nil then AItemLink := nil else AItemLink := SelectedItem.ItemLink; AItemLink := FindItemWithAccel(Key, KeyDataToShiftState(Message.KeyData), AItemLink); if (AItemLink <> nil) and AItemLink.Item.Enabled then begin Duplicate := False; DuplicateItemLink := AItemLink; repeat Hidden := DuplicateItemLink.VisibleIndex = -1; DuplicateItemLink := FindItemWithAccel(Key, KeyDataToShiftState(Message.KeyData), DuplicateItemLink); if DuplicateItemLink = AItemLink then Break; Duplicate := True; until Hidden; if (BarManager.GetPaintStyle <> bmsStandard) and (Self is TdxBarSubMenuControl) and // ??? (Duplicate and Hidden or not Duplicate and not AItemLink.Control.IsDestroyOnClick and Hidden) then MarkState := msPressed; SetKeySelectedItem(AItemLink.Control); if not Duplicate then SendMessage(Handle, WM_KEYDOWN, VK_RETURN, 0); end; end; end; end; end; procedure TCustomdxBarControl.WMLButtonDblClk(var Message: TWMLButtonDblClk); var P: TPoint; Item: TdxBarItemControl; begin inherited; if SelectedItem <> nil then begin P := SmallPointToPoint(Message.Pos); if PtInRect(ClientRect, P) then begin Item := ItemAtPos(P); if Item = SelectedItem then begin {if Item.HasWindow and not PtInRect(TdxBarWinControl(Item).WindowRect, P) then begin MapWindowPoints(Handle, TdxBarWinControl(Item).Handle, P, 1); SendMessage(TdxBarWinControl(Item).Handle, WM_LBUTTONDBLCLK, Message.Keys, MakeLParam(P.X, P.Y)); end;} if Item.WantsDblClick then DblClickOnItem(Item) else with TMessage(Message) do Result := SendMessage(Handle, WM_LBUTTONDOWN, wParam, lParam); end; end; end; end; procedure TCustomdxBarControl.WMLButtonDown(var Message: TWMLButtonDown); var P: TPoint; Item: TdxBarItemControl; ABarButtonControl: TdxBarButtonControl; begin if FIgnoreMouseClick or (ItemLinks.VisibleItemCount = 0) then Exit; inherited; P.X := Message.XPos; P.Y := Message.YPos; Item := nil; if PtInRect(ClientRect, P) then begin Item := ItemAtPos(P); if (Item <> nil) and (not IsCustomizing and (not Item.Enabled or not Item.WantMouse)) then Item := nil; end; if IsCustomizing then if (Item = nil) or Item.CanCustomize then {1} begin if not ((Item = nil) and PtInRect(ClientRect, P)) then begin if (Item <> nil) and (Item = SelectedItem) then begin if Item.IsActive then Item.ControlInactivate(True) else Item.ControlActivate(True); BarManager.SelectedItem := Item; Item.Repaint; end; SetMouseSelectedItem(Item); end; if Item <> nil then begin FDragPoint := P; BarManager.FDraggingItem := Item.ItemLink.Item; BarManager.FDraggingItemLink := Item.ItemLink; FDragDown := True; SetCapture(Handle); end; end else else if (Item <> nil) and Item.Enabled then begin SetKeySelectedItem(Item); if FSelectedItem is TdxBarButtonControl then TdxBarButtonControl(FSelectedItem).FShowAnimation := True; if FSelectedItem is TdxBarSubItemControl then TdxBarSubItemControl(FSelectedItem).FShowAnimation := True; Item.ControlClick(True); if not ItemExists(Item) then Exit; if FSelectedItem is TdxBarButtonControl then begin ABarButtonControl := TdxBarButtonControl(FSelectedItem); ABarButtonControl.FShowAnimation := False; // *** // if (ABarButtonControl.Item.FDropDownMenu <> nil) and // (ABarButtonControl.Item.FDropDownMenu.SubMenuControl <> nil) then // ABarButtonControl.Item.FDropDownMenu.SubMenuControl.ParentBar := Self; end; if (Self is TdxBarControl) and (FSelectedItem <> nil) and FSelectedItem.NeedCaptureMouse then begin FClickedControl := Item; FMouseOverClickedControl := True; SetCapture(Handle); Item.Repaint; end; if Item.HasWindow and not PtInRect(TdxBarWinControl(Item).WindowRect, P) then begin MapWindowPoints(Handle, TdxBarWinControl(Item).Handle, P, 1); SendMessage(TdxBarWinControl(Item).Handle, WM_LBUTTONDOWN, Message.Keys, MakeLParam(P.X, P.Y)); end; end; end; procedure TCustomdxBarControl.WMLButtonUp(var Message: TWMLButtonUp); var P: TPoint; Item, AClickedControl: TdxBarItemControl; begin if FIgnoreMouseClick then begin FIgnoreMouseClick := False; Exit; end; inherited; if FDragDown then ReleaseCapture else begin P.X := Message.XPos; P.Y := Message.YPos; AClickedControl := FClickedControl; if AClickedControl <> nil then ReleaseCapture; if PtInRect(ClientRect, P) and IsActive then begin Item := ItemAtPos(P); if not IsCustomizing and (Item <> nil) and Item.WantMouse then if Item.Enabled and (Item = SelectedItem) then begin if Item.HasWindow then begin MapWindowPoints(Handle, TdxBarWinControl(Item).Handle, P, 1); SendMessage(TdxBarWinControl(Item).Handle, WM_LBUTTONUP, Message.Keys, MakeLParam(P.X, P.Y)); end; Item.ControlUnclick(True); end else if not Item.Enabled and (Item <> SelectedItem) and (Self is TdxBarControl) and not ((SelectedItem is TdxBarButtonControl) and TdxBarButtonControl(SelectedItem).DroppedDown) then TdxBarControl(Self).HideAll;//BarLostFocus; end; if (AClickedControl <> nil) and BarControlExists(Self) then HideAll; end; end; procedure TCustomdxBarControl.WMMouseActivate(var Message: TWMMouseActivate); begin inherited; Message.Result := MA_NOACTIVATE; end; procedure TCustomdxBarControl.WMMouseLeave(var Message: TMessage); begin if MarkState = msSelected then MarkState := msNone; inherited; if (ChildBar = nil) and not IsCustomizing and not ((SelectedItem is TdxBarButtonControl) and TdxBarButtonControl(SelectedItem).DroppedDown) then SetMouseSelectedItem(nil); end; procedure TCustomdxBarControl.WMMouseMove(var Message: TWMMouseMove); const dXY = 2; var P: TPoint; Item: TdxBarItemControl; PrevMouseOverClickedControl, FocusedControlExists: Boolean; function WantClientMouse: Boolean; begin Result := PtInRect(ClientRect, SmallPointToPoint(Message.Pos)); end; function DragRect: TRect; begin Result := Bounds(0, 0, GetSystemMetrics(SM_CXDRAG), GetSystemMetrics(SM_CYDRAG)); with Result, FDragPoint do OffsetRect(Result, X - Right div 2, Y - Bottom div 2); end; begin if FDestroyFlag then Exit; with Message do P := Point(XPos, YPos); if FClickedControl <> nil then begin Item := ItemAtPos(P); PrevMouseOverClickedControl := FMouseOverClickedControl; FMouseOverClickedControl := Item = FClickedControl; if FMouseOverClickedControl <> PrevMouseOverClickedControl then FClickedControl.Repaint; end; if FDragDown and not PtInRect(DragRect, P) then begin FDragDown := False; ReleaseCapture; with BarManager do begin DraggingItemLink.Control.ControlInactivate(True); DragAndDrop(DraggingItem, DraggingItemLink); end; Exit; end; if WantClientMouse then begin inherited; if NotHandleMouseMove(P) then Exit; FLastMousePos := P; Windows.ClientToScreen(Handle, FLastMousePos); Item := ItemAtPos(P); FocusedControlExists := (BarManager.SelectedItem <> nil) and (BarManager.SelectedItem is TdxBarWinControl) and TdxBarWinControl(BarManager.SelectedItem).Focused; if (ActiveBarControl = nil) or (ActiveBarControl = Self) then if (Item <> nil) and (Item is TdxBarWinControl) and PtInRect(TdxBarWinControl(Item).WindowRect, P) and (not FocusedControlExists or (Item = BarManager.SelectedItem)) then Cursor := crIBeam else Cursor := crDefault; if FocusedControlExists then Exit; if not MouseTracking(Handle) then begin StartMouseTracking(Handle); if (Item <> nil) and (Item = SelectedItem) and (Item is TdxBarButtonControl) then Item.Repaint; end; if (Item <> nil) and not Item.CanMouseSelect then Item := nil; if (Self is TdxBarControl) and IsActive and (Item = nil) then Exit; if FClickedControl <> nil then Exit; if not ((Item = nil) and (SelectedItem <> nil) and (SelectedItem is TdxBarSubItemControl) and (TdxBarSubItemControl(SelectedItem).SubMenuControl <> nil)) then SetMouseSelectedItem(Item); end; end; procedure TCustomdxBarControl.WMNCHitTest(var Message: TWMNCHitTest); begin inherited; if CanFinishMouseTracking(Message) then FinishMouseTracking(Handle); end; procedure TCustomdxBarControl.WMRButtonDown(var Message: TWMRButtonDown); var P: TPoint; Item: TdxBarItemControl; AItemLink: TdxBarItemLink; begin inherited; if not IsCustomizing then Exit; if SelectedItem <> nil then SelectedItem.ControlInactivate(True); P.X := Message.XPos; P.Y := Message.YPos; if PtInRect(ClientRect, P) then begin Item := ItemAtPos(P); if Item <> nil then begin if Item = SelectedItem then begin BarManager.SelectedItem := Item; Item.Repaint; end; SetKeySelectedItem(Item); end; if (Item <> nil) or BarManager.Designing then begin P := ClientToScreen(P); if Item <> nil then AItemLink := Item.ItemLink else AItemLink := nil; CustomizedPopup := TdxBarCustomizingPopup.CreateEx(BarManager, ItemLinks, AItemLink); with CustomizedPopup do begin Left := P.X; Top := P.Y; Show; end; end; end; end; procedure TCustomdxBarControl.WMRepaintBar(var Message: TMessage); begin RepaintBar; end; procedure TCustomdxBarControl.WMSetCursor(var Message: TWMSetCursor); begin with Message do if (HitTest = HTCLIENT) and (CursorWnd = Handle) then begin Windows.SetCursor(Screen.Cursors[Cursor]); Result := 1; end else inherited; end; procedure TCustomdxBarControl.WMSize(var Message: TWMSize); begin // ResetBackground; inherited; end; procedure TCustomdxBarControl.WMWindowPosChanged(var Message: TWMWindowPosChanged); begin inherited; with Message.WindowPos^ do if (flags and SWP_NOSIZE = 0) or (flags and SWP_NOMOVE = 0) then ResizeShadow; FShadow.Visible := IsShadowVisible; ResetBackground; end; procedure TCustomdxBarControl.AdjustSize; begin // do nothing end; procedure TCustomdxBarControl.CreateWindowHandle(const Params: TCreateParams); begin inherited; CreateControls; SetLayeredAttributes; end; procedure TCustomdxBarControl.CreateWnd; begin inherited; SetFont; CalcDrawingConsts; end; procedure TCustomdxBarControl.DestroyWindowHandle; begin if WindowHandle <> 0 then BeforeDestroyHandle; DestroyControls; inherited; end; procedure TCustomdxBarControl.CreateControls; var I: Integer; begin if FItemLinks <> nil then for I := 0 to FItemLinks.CanVisibleItemCount - 1 do FItemLinks.CanVisibleItems[I].CreateControl; end; procedure TCustomdxBarControl.DestroyControls; var I: Integer; PrevDestroyFlag: Boolean; begin if FItemLinks <> nil then begin PrevDestroyFlag := FDestroyFlag; FDestroyFlag := True; for I := 0 to FItemLinks.CanVisibleItemCount - 1 do FItemLinks.CanVisibleItems[I].DestroyControl; FDestroyFlag := PrevDestroyFlag; end; end; procedure TCustomdxBarControl.WndProc(var Message: TMessage); function ProcessMouseMessage: Boolean; var AControl: TCustomdxBarControl; begin Result := True; AControl := ActiveBarControl; while AControl <> nil do begin if AControl = Self then Exit; AControl := AControl.ParentBar; end; Result := False; end; { function IsEditAndReadOnly: Boolean; begin Result := (SelectedItem <> nil) and (SelectedItem is TdxBarEditControl) and TdxBarEditControl(SelectedItem).ReadOnly; end; } begin if (Message.Msg = WM_CTLCOLOREDIT) or ((Message.Msg = WM_CTLCOLORSTATIC){ and IsEditAndReadOnly}) then begin SetTextColor(Message.wParam, GetSysColor(COLOR_WINDOWTEXT)); SetBkColor(Message.wParam, GetSysColor(COLOR_WINDOW)); Message.Result := GetSysColorBrush(COLOR_WINDOW); Exit; end; if (Message.Msg = WM_KILLFOCUS) and (Message.wParam = 0) then begin inherited; HideAll; Exit; end; if Message.Msg = WM_NCACTIVATE then begin if (Message.wParam = Longint(True)) and not BarManager.IsCustomizing then SendMessage(GetParent(Handle), WM_NCACTIVATE, Longint(True), 0); Message.wParam := Longint(True); end; if (Message.Msg = WM_SETFOCUS) and not (SelectedItem is TdxBarWinControl) then begin if IsCustomizing and (dxBarCustomizingForm <> nil) then begin SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); Windows.SetFocus(dxBarCustomizingForm.Handle); SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); end else if IsWindowVisible(BarManager.MainForm.Handle) then Windows.SetFocus(BarManager.MainForm.Handle) else Windows.SetFocus(GetNextWindow(BarManager.MainForm.Handle, GW_HWNDNEXT)); Exit; end; with Message do if ((Msg >= WM_MOUSEFIRST) and (Msg <= WM_MOUSELAST) or (Msg >= WM_NCMOUSEMOVE) and (Msg <= WM_NCMBUTTONDBLCLK)) and (ActiveBarControl <> nil) and not ProcessMouseMessage then Exit; inherited; with Message do case Msg of WM_COMMAND: if (Result = 0) and (HiWord(wParam) = EN_CHANGE) and (lParam <> 0) then Result := SendMessage(lParam, Msg, wParam, lParam); end; end; procedure TCustomdxBarControl.BeforeDestroyHandle; var I: Integer; begin for I := 0 to ItemLinks.CanVisibleItemCount - 1 do with ItemLinks.CanVisibleItems[I] do if Control <> nil then Control.BeforeDestroyParentHandle; end; procedure TCustomdxBarControl.CalcDrawingConsts; var Size: TSize; DC: HDC; PrevFont: HFONT; begin GetTextExtentPoint32(Canvas.Handle, '0', 1, Size); FTextSize := Size.cY + 6; FMenuArrowHeight := FTextSize div 5; if FMenuArrowHeight < 4 then FMenuArrowHeight := 4; DC := GetDC(0); PrevFont := SelectObject(DC, EditFontHandle); GetTextExtentPoint32(DC, '0', 1, Size); SelectObject(DC, PrevFont); FEditTextSize := PainterClass.EditTextSize(Self, DC, Size.cy); FComboBoxArrowWidth := PainterClass.ComboBoxArrowWidth(Self, DC, Size.cX); ReleaseDC(0, DC); end; function TCustomdxBarControl.CanAlignControl(AControl: TdxBarItemControl): Boolean; begin Result := False; end; function TCustomdxBarControl.CanCallInheritedNCCalcSize: Boolean; // obsolete begin Result := True; end; function TCustomdxBarControl.CanCustomizing: Boolean; begin Result := BarManager.Designing; end; function TCustomdxBarControl.CanFinishMouseTracking(const Message: TWMNCHitTest): Boolean; begin Result := Message.Result <> HTCLIENT; end; function TCustomdxBarControl.ChildrenHaveShadows: Boolean; begin Result := PainterClass.BarChildrenHaveShadows(Self); end; procedure TCustomdxBarControl.DblClickOnItem(Item: TdxBarItemControl); begin if BarManager.Designing then dxBarDesigner.ShowDefaultEventHandler(Item.Item) else if Item.IsExpandable then with TCustomdxBarSubItem(Item.Item).ItemLinks do if (BarControl <> nil) and BarControl.MarkExists then BarControl.MarkState := msPressed else else Item.DblClick; end; procedure TCustomdxBarControl.DrawSelectedItem(AControl: TdxBarItemControl); var R: TRect; begin if IsCustomizing and (not BarManager.Dragging and (SelectedItem = AControl) and (BarManager.SelectedItem = AControl) or BarManager.Dragging and (AControl.ItemLink = BarManager.DraggingItemLink)) then with Canvas, R do begin R := AControl.ItemLink.ItemRect; if (AControl is TdxBarSubItemControl) and (Self is TdxBarSubMenuControl) then begin Dec(Right); Dec(Bottom); Pen.Mode := pmNot; Polyline([Point(Left, Top), Point(Right, Top), Point(Right, Bottom), Point(Left, Bottom), Point(Left, Top)]); InflateRect(R, -1, -1); Polyline([Point(Left, Top), Point(Right, Top), Point(Right, Bottom), Point(Left, Bottom), Point(Left, Top)]); Pen.Mode := pmCopy; end else begin Windows.FrameRect(Handle, R, GetSysColorBrush(COLOR_WINDOWTEXT)); InflateRect(R, -1, -1); Windows.FrameRect(Handle, R, GetSysColorBrush(COLOR_WINDOWTEXT)); end; end; end; procedure TCustomdxBarControl.FocusNextBarControl(AForward: Boolean); var APrevBarControl: TCustomdxBarControl; AIndex, APrevIndex: Integer; ABar: TdxBar; begin APrevBarControl := GetParentBarForBar(Self); if APrevBarControl is TdxBarControl then begin ABar := TdxBarControl(APrevBarControl).Bar; APrevIndex := ABar.Index; repeat AIndex := ABar.Index; if AForward then begin Inc(AIndex); if AIndex >= ABar.Bars.Count then AIndex := 0; end else begin Dec(AIndex); if AIndex < 0 then AIndex := ABar.Bars.Count - 1; end; if AIndex = APrevIndex then Break; ABar := ABar.Bars[AIndex]; if (ABar.Control <> nil) and (ABar.ItemLinks.First <> nil) then begin TdxBarControl(APrevBarControl).BarLostFocus; ABar.Control.BarGetFocus(ABar.ItemLinks.First.Control); Break; end; until False; end; end; function TCustomdxBarControl.GetEditFontHandle: HFONT; begin Result := BarManager.FEditFontHandle; end; function TCustomdxBarControl.GetFullItemRect(Item: TdxBarItemControl): TRect; begin Result := GetItemRect(Item); end; function TCustomdxBarControl.GetIsCustomizing; begin Result := BarManager.IsCustomizing; end; function TCustomdxBarControl.GetIsShadowVisible: Boolean; begin Result := HasShadow and IsWindowVisible(Handle); end; function TCustomdxBarControl.GetItemRect(Item: TdxBarItemControl): TRect; begin if Item = nil then SetRectEmpty(Result) else Result := Item.ItemLink.ItemRect; end; function TCustomdxBarControl.GetItemRectEx(Item: TdxBarItemControl; IsBeginGroup: Boolean): TRect; begin Result := GetItemRect(Item); end; function TCustomdxBarControl.GetItemRegion(Item: TdxBarItemControl): HRGN; begin Result := CreateRectRgnIndirect(GetItemRectEx(Item, True)); end; function TCustomdxBarControl.GetItemScreenRect(Item: TdxBarItemControl): TRect; begin Result := GetItemRect(Item); MapWindowPoints(Handle, 0, Result, 2); end; function TCustomdxBarControl.GetOwnerControl: TWinControl; begin if not IsRectEmpty(FOwnerBounds) then Result := FOwnerControl else Result := nil; end; function TCustomdxBarControl.GetToolbarBrush: HBRUSH; begin Result := PainterClass.BarToolbarBrush(Self); end; function TCustomdxBarControl.GetToolbarDownedBrush: HBRUSH; begin Result := PainterClass.BarToolbarDownedBrush(Self); end; function TCustomdxBarControl.GetToolbarDownedSelBrush: HBRUSH; begin Result := PainterClass.BarToolbarDownedSelBrush(Self); end; function TCustomdxBarControl.GetToolbarSelBrush: HBRUSH; begin Result := PainterClass.BarToolbarSelBrush(Self); end; procedure TCustomdxBarControl.GetWindowRect(var R: TRect); begin Windows.GetWindowRect(Handle, R); end; function TCustomdxBarControl.HasShadow: Boolean; begin Result := PainterClass.BarHasShadow(Self); end; function TCustomdxBarControl.HideOnClick: Boolean; begin Result := False; end; function TCustomdxBarControl.IsChildBar(Value: TCustomdxBarControl): Boolean; begin Result := False; while Value.ParentBar <> nil do begin Value := Value.ParentBar; if Self = Value then begin Result := True; Exit; end; end; end; function TCustomdxBarControl.IsLinkedToOwner: Boolean; var R1, R2: TRect; begin R1 := FOwnerBounds; R2 := BoundsRect; Result := ((R1.Bottom = R2.Top) or (R1.Top = R2.Bottom)) and (R1.Left < R2.Right) and (R1.Right > R2.Left) or ((R1.Right = R2.Left) or (R1.Left = R2.Right)) and (R1.Top < R2.Bottom) and (R1.Bottom > R2.Top); end; function TCustomdxBarControl.ItemAtPos(Pos: TPoint): TdxBarItemControl; var I: Integer; ItemLink: TdxBarItemLink; begin if IsCustomizing and not CanCustomizing then Result := nil else begin Result := nil; for I := 0 to ItemLinks.VisibleItemCount - 1 do begin ItemLink := ItemLinks.VisibleItems[I]; if PtInRect(ItemLink.ItemRect, Pos) then begin //if ItemLink.Control.CanSelect then {1} Result := ItemLink.Control; Break; end; end; end; end; function TCustomdxBarControl.ItemAtPosEx(Pos: TPoint; var IsBeginGroup, IsFirstPart, IsVerticalDirection: Boolean): TdxBarItemControl; var CalcVerticalDirection: Boolean; I: Integer; Control: TdxBarItemControl; Rgn: HRGN; R: TRect; begin Result := nil; IsVerticalDirection := IsRealVertical(Self) or (Self is TdxBarSubMenuControl); CalcVerticalDirection := IsVerticalDirection; for I := 0 to FItemLinks.VisibleItemCount - 1 do begin Control := FItemLinks.VisibleItems[I].Control; if Control.CanCustomize then begin Rgn := GetItemRegion(Control); if PtInRegion(Rgn, Pos.X, Pos.Y) then begin Result := Control; R := GetFullItemRect(Result); IsBeginGroup := not PtInRect(R, Pos); if IsBeginGroup then begin if Pos.Y < R.Top then CalcVerticalDirection := True; R := Result.FBeginGroupRect; end; if CalcVerticalDirection then IsFirstPart := (Pos.Y - R.Top) < (R.Bottom - Pos.Y) else IsFirstPart := (Pos.X - R.Left) < (R.Right - Pos.X); DeleteObject(Rgn); Break; end; DeleteObject(Rgn); end; end; end; function TCustomdxBarControl.ItemExists(Item: TdxBarItemControl): Boolean; var I: Integer; begin Result := True; for I := 0 to ItemLinks.Count - 1 do if ItemLinks[I].Control = Item then Exit; Result := False; end; function TCustomdxBarControl.MarkExists: Boolean; begin Result := False; end; function TCustomdxBarControl.NotHandleMouseMove(P: TPoint): Boolean; begin Windows.ClientToScreen(Handle, P); Result := IsCustomizing or (FLastMousePos.X = P.X) and (FLastMousePos.Y = P.Y); end; procedure TCustomdxBarControl.PaintItem(AControl: TdxBarItemControl); begin FBkBrush := ToolbarBrush; end; procedure TCustomdxBarControl.PaintSelectedItem(OldSelectedItem: TdxBarItemControl); begin if FDestroyFlag then Exit; FInRepaint := True; try if (OldSelectedItem <> nil) and (OldSelectedItem.ItemLink.Item <> nil) and not OldSelectedItem.ItemLink.Item.IsDestroying then PaintItem(OldSelectedItem); // FInRepaint := True; if FSelectedItem <> nil then PaintItem(FSelectedItem); finally FInRepaint := False; end; end; procedure TCustomdxBarControl.ResizeShadow; var R: TRect; begin if IsLinkedToOwner then R := FOwnerBounds else SetRectEmpty(R); FShadow.SetOwnerBounds(R, BoundsRect); end; procedure TCustomdxBarControl.SetIsActive(Value: Boolean); begin BarManager.HintActivate(False, ''); if FIsActive <> Value then begin FIsActive := Value; if FIsActive then begin if FActiveBarControl = nil then ShowFullMenus := IsCustomizing; FPrevActiveBarControl := FActiveBarControl; FActiveBarControl := Self; if not IsCustomizing then ItemLinks.InitiateActions; end else begin if IsCustomizing then FSelectedItem := nil else SetKeySelectedItem(nil); if FActiveBarControl = Self then FActiveBarControl := FPrevActiveBarControl; if (FActiveBarControl <> nil) and (not BarControlExists(FActiveBarControl) or not FActiveBarControl.IsActive) then FActiveBarControl := nil; end; end; end; function TCustomdxBarControl.SelectedItemWantsKey(Key: Word): Boolean; begin Result := (SelectedItem <> nil) and SelectedItem.Enabled and SelectedItem.WantsKey(Key); if Result then SelectedItem.KeyDown(Key); end; procedure TCustomdxBarControl.SetCursorForMoving(AMoving: Boolean); const Cursors: array[Boolean] of TCursor = (crDefault, crSizeAll); begin Cursor := Cursors[AMoving]; end; procedure TCustomdxBarControl.SetDockingStyle(Value: TdxBarDockingStyle); begin if FDockingStyle <> Value then begin FDockingStyle := Value; ResetBackground; Perform(CM_FONTCHANGED, 0, 0); SetLayeredAttributes; end; end; procedure TCustomdxBarControl.SetKeySelectedItem(Value: TdxBarItemControl); begin if FSelectedItem <> Value then begin if (FSelectedItem <> nil) and FSelectedItem.IsActive then FSelectedItem.ControlInactivate(True); if not BarControlExists(Self) then Exit; if Value is TdxBarSubItemControl then TdxBarSubItemControl(Value).FShowAnimation := False; if Value <> nil then Value.FSelectedByMouse := False; SelectedItem := Value; end; end; procedure TCustomdxBarControl.SetLayeredAttributes; begin end; procedure TCustomdxBarControl.SetMouseSelectedItem(Value: TdxBarItemControl); begin if not HandleAllocated then Exit; if (FSelectedItem <> Value) and not ((FSelectedItem <> nil) and FSelectedItem.HasWindow and TdxBarWinControl(FSelectedItem).Focused) then begin if (FSelectedItem <> nil) and FSelectedItem.IsActive then FSelectedItem.ControlInactivate(False); if Value <> nil then Value.FSelectedByMouse := True; SelectedItem := Value; if not BarControlExists(Self) then Exit; if FSelectedItem <> nil then begin if FSelectedItem is TdxBarSubItemControl then with TCustomdxBarSubItem(FSelectedItem.ItemLink.Item) do if BarManager.Dragging and not CanContainItem(BarManager.DraggingItem) then Exit else TdxBarSubItemControl(FSelectedItem).FShowAnimation := True; FSelectedItem.ControlActivate(False); end; end; end; procedure TCustomdxBarControl.SetSelectedItem(Value: TdxBarItemControl); var OldSelectedItem: TdxBarItemControl; AParentBar: TCustomdxBarControl; begin if FSelectedItem <> Value then begin if (QuickCustBar <> nil) and not QuickCustBar.IsActive and (QuickCustBar <> Self) and (Value <> nil) then StartHideQuickCustBar; OldSelectedItem := FSelectedItem; FSelectedItem := Value; if IsCustomizing then begin BarManager.SelectedItem := Value; if not BarControlExists(Self) then Exit; end else if not BarManager.IsCustomizing then BarManager.FSelectedItem := Value; PaintSelectedItem(OldSelectedItem); GetCursorPos(FLastMousePos); if FSelectedItem = nil then Cursor := crDefault; if (FSelectedItem <> nil) or (Self is TdxBarSubMenuControl) or (TdxBarControl(Self).MarkState = msNone) then BarManager.HintActivate(True, ''); // for Application.Hint: if (FSelectedItem <> nil) and (FSelectedItem.Enabled or BarManager.ShowHintForDisabledItems) then Hint := GetLongHint(FSelectedItem.Hint) else Hint := ''; AParentBar := GetParentBarOrSubMenuForBar(Self); if (AParentBar is TdxBarSubMenuControl) and (AParentBar.ItemLinks.Owner is TdxBarPopupMenu) and not TdxBarPopupMenu(AParentBar.ItemLinks.Owner).DontUseMessageLoop then Application.Hint := Hint; end; end; procedure TCustomdxBarControl.UpdateControlStyle; begin if (BarManager.GetPaintStyle = bmsStandard) and not IsCustomizing then // ??? ControlStyle := ControlStyle - [csDoubleClicks] else ControlStyle := ControlStyle + [csDoubleClicks]; end; function TCustomdxBarControl.WantMouse: Boolean; var P: TPoint; begin GetCursorPos(P); Result := WindowFromPointEx(P) = Handle; end; procedure TCustomdxBarControl.FillBackground(DC: HDC; ARect: TRect; ABrush: HBRUSH; AColor: TColor; AIsClientArea: Boolean); var R: TRect; ANCOffset: TPoint; begin // calc rect R := ARect; if AIsClientArea then begin ANCOffset := NCOffset; OffsetRect(R, ANCOffset.X, ANCOffset.Y); end; // fill if DockControl <> nil then PainterClass.BarDrawDockedBackground(Self, DC, ARect, R, ABrush, AColor) else PainterClass.BarDrawFloatingBackground(Self, DC, ARect, R, ABrush, AColor) end; procedure TCustomdxBarControl.FillBackgroundRgn(DC: HDC; ARgn: HRGN; ABrush: HBRUSH; AIsClientArea: Boolean); var AClipRgn: HRGN; AClipRgnExists: Boolean; AWindowOrigin: TPoint; R: TRect; begin SaveClipRgn(DC, AClipRgn, AClipRgnExists); GetWindowOrgEx(DC, AWindowOrigin); OffsetRgn(ARgn, -AWindowOrigin.X, -AWindowOrigin.Y); ExtSelectClipRgn(DC, ARgn, RGN_AND); GetWindowRect(R); OffsetRect(R, -R.Left, -R.Top); FillBackground(DC, R, ABrush, clNone, AIsClientArea); RestoreClipRgn(DC, AClipRgn, AClipRgnExists); end; procedure TCustomdxBarControl.FullInvalidate; begin if HandleAllocated then SendMessage(Handle, WM_NCPAINT, 0, 0); Invalidate; end; procedure TCustomdxBarControl.FullRepaint; begin if HandleAllocated then SendMessage(Handle, WM_NCPAINT, 0, 0); Repaint; end; function TCustomdxBarControl.IsInternal: Boolean; begin Result := ItemLinks.Owner is TdxBarQuickSubItem; end; function TCustomdxBarControl.IsBackgroundBitmap: Boolean; begin Result := (DockControl <> nil) and DockControl.IsBackgroundBitmap; end; function TCustomdxBarControl.IsTransparent: Boolean; begin Result := (DockControl <> nil) and DockControl.IsTransparent; end; function TCustomdxBarControl.NCOffset: TPoint; begin Result.X := 0; Result.Y := 0; end; function TCustomdxBarControl.PointBarToDock(const APoint: TPoint): TPoint; var ABounds: TRect; begin ABounds := BoundsRect; Result.X := APoint.X + ABounds.Left; Result.Y := APoint.Y + ABounds.Top; end; procedure TCustomdxBarControl.ResetBackground; begin FBackgroundTempBitmap.Assign(nil); end; procedure TCustomdxBarControl.UpdateDoubleBuffered; begin DoubleBuffered := IsTransparent; end; procedure TCustomdxBarControl.HideAll; begin IsActive := False; if not BarControlExists(Self) then Exit; if ParentBar <> nil then ParentBar.HideAll; end; procedure TCustomdxBarControl.RepaintBar; begin end; { TdxDockCol } constructor TdxDockCol.Create(ADockRow: TdxDockRow; ABarControl: TdxBarControl); begin inherited Create; FDockRow := ADockRow; FBarControl := ABarControl; end; procedure TdxDockCol.AssignPosition; begin with FBarControl do FPos := Point(Left, Top); end; { TdxBarButton } constructor TdxBarButton.Create(AOwner: TComponent); begin inherited Create(AOwner); FCloseSubMenuOnClick := True; FDropDownEnabled := True; FUnclickAfterDoing := True; end; procedure TdxBarButton.SetAllowAllUp(Value: Boolean); var I: Integer; begin if FAllowAllUp <> Value then begin FAllowAllUp := Value; if GroupIndex <> 0 then with BarManager do for I := 0 to ItemCount - 1 do if (Items[I] is TdxBarButton) and (TdxBarButton(Items[I]).GroupIndex = GroupIndex) then TdxBarButton(Items[I]).FAllowAllUp := FAllowAllUp; end; end; procedure TdxBarButton.SetButtonStyle; begin if FButtonStyle <> Value then begin FButtonStyle := Value; Down := False; if not IsLoading then ButtonStyleChanged; BarManager.UpdateItems(Self); end; end; procedure TdxBarButton.SetDown; var DownedButton: TdxBarButton; function GetDownedButton: TdxBarButton; var I: Integer; begin with BarManager do for I := 0 to ItemCount - 1 do if Items[I] is TdxBarButton then begin Result := TdxBarButton(Items[I]); with Result do if (ButtonStyle = bsChecked) and (GroupIndex = Self.GroupIndex) and Down then Exit; end; Result := nil; end; function AnotherDownedButtonExists: Boolean; var I: Integer; begin Result := True; with BarManager do for I := 0 to ItemCount - 1 do if (Items[I] <> Self) and (Items[I] is TdxBarButton) then with TdxBarButton(Items[I]) do if (ButtonStyle = bsChecked) and (GroupIndex = Self.GroupIndex) and Down then Exit; Result := False; end; begin if (FDown <> Value) and ((ButtonStyle = bsChecked) or not Value) then begin if not IsLoading and (ButtonStyle = bsChecked) and (GroupIndex <> 0) then if Value then DownedButton := GetDownedButton else if not AllowAllUp and not AnotherDownedButtonExists then Exit else DownedButton := nil else DownedButton := nil; FDown := Value; if not IsLoading then begin DownChanged; if DownedButton <> nil then DownedButton.Down := False; end; end; end; procedure TdxBarButton.SetDropDownEnabled(Value: Boolean); begin if FDropDownEnabled <> Value then begin FDropDownEnabled := Value; if not IsLoading then DropDownEnabledChanged; end; end; procedure TdxBarButton.SetDropDownMenu(Value: TdxBarPopupMenu); begin FDropDownMenu := Value; if Value <> nil then Value.FreeNotification(Self); end; procedure TdxBarButton.SetGroupIndex; begin if FGroupIndex <> Value then begin if ButtonStyle <> bsChecked then Value := 0; FGroupIndex := Value; Down := False; end; end; procedure TdxBarButton.SetLowered(Value: Boolean); begin if FLowered <> Value then begin FLowered := Value; if not IsLoading then UpdateEx; end; end; procedure TdxBarButton.SetPaintStyle(Value: TdxBarPaintStyle); begin if FPaintStyle <> Value then begin FPaintStyle := Value; if not IsLoading then PaintStyleChanged; end; end; function TdxBarButton.IsDownStored: Boolean; begin Result := (FActionLink = nil) or not FActionLink.IsCheckedLinked; end; procedure TdxBarButton.ButtonStyleChanged; var I: Integer; begin for I := 0 to LinkCount - 1 do if Links[I].Control <> nil then TdxBarButtonControl(Links[I].Control).ButtonStyleChanged; end; function TdxBarButton.CanChangePaintStyle: Boolean; begin Result := True; end; procedure TdxBarButton.DownChanged; var I: Integer; begin for I := 0 to LinkCount - 1 do if Links[I].Control <> nil then TdxBarButtonControl(Links[I].Control).DownChanged; end; procedure TdxBarButton.DoDropDown(AControl: TdxBarButtonControl; X, Y: Integer; ByMouse: Boolean); var R: TRect; begin if FDropDownMenu <> nil then begin if AControl.HasShadow then R := AControl.Parent.GetItemScreenRect(AControl) else R := Rect(0, 0, 0, 0); FDropDownMenu.DontUseMessageLoop := True; FDropDownMenu.FOwnerControl := AControl.Parent; try with AControl, ItemLink.ItemRect do if Parent is TdxBarSubMenuControl or IsRealVertical(Parent) then FDropDownMenu.PopupEx(X, Y, Right - Left, 0, FShowAnimation, @R) else FDropDownMenu.PopupEx(X, Y, 0, Bottom - Top, FShowAnimation, @R); finally FDropDownMenu.FOwnerControl := nil; FDropDownMenu.DontUseMessageLoop := False; end; with FDropDownMenu.SubMenuControl do begin FDropDownButton := AControl; if not ByMouse and (ItemLinks.First <> nil) then SetKeySelectedItem(ItemLinks.First.Control); end; if AControl.Parent is TdxBarSubMenuControl then AControl.Parent.ChildBar := FDropDownMenu.SubMenuControl; end; end; procedure TdxBarButton.DropDownEnabledChanged; var I: Integer; begin for I := 0 to LinkCount - 1 do if Links[I].Control <> nil then TdxBarButtonControl(Links[I].Control).DropDownEnabledChanged; end; function TdxBarButton.HasAccel(AItemLink: TdxBarItemLink): Boolean; begin Result := inherited HasAccel(AItemLink) and (not (AItemLink.Owner.Owner is TdxBar) or (AItemLink.PaintStyle in [psCaption, psCaptionGlyph]) or (AItemLink.Control <> nil) and (TdxBarButtonControl(AItemLink.Control).PaintStyle in [psCaption, psCaptionGlyph])); end; procedure TdxBarButton.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = DropDownMenu) then DropDownMenu := nil; end; procedure TdxBarButton.PaintStyleChanged; var I: Integer; begin for I := 0 to LinkCount - 1 do if not (udPaintStyle in Links[I].UserDefine) and (Links[I].Control <> nil) then TdxBarButtonControl(Links[I].Control).PaintStyleChanged; end; procedure TdxBarButton.Click; begin if Enabled and (ButtonStyle = bsChecked) then Down := not Down; inherited; end; { TdxBarEdit } constructor TdxBarEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidth := 100; end; procedure TdxBarEdit.SetMaxLength(Value: Integer); begin FMaxLength := Value; if FMaxLength <= 0 then FMaxLength := 0; end; procedure TdxBarEdit.SetShowCaption(Value: Boolean); begin if FShowCaption <> Value then begin FShowCaption := Value; if not IsLoading then UpdateEx; end; end; procedure TdxBarEdit.SetWidth(Value: Integer); begin CheckEditWidth(Value); if FWidth <> Value then begin FWidth := Value; if not IsLoading then WidthChanged; end; end; procedure TdxBarEdit.DrawInterior(ABarEditControl: TdxBarEditControl; ACanvas: TCanvas; R: TRect; ItemLink: TdxBarItemLink); begin PainterClass.EditDrawInterior(ABarEditControl, Self, ACanvas, R, ItemLink); end; function TdxBarEdit.HasAccel(AItemLink: TdxBarItemLink): Boolean; begin Result := inherited HasAccel(AItemLink) and (FShowCaption or not (AItemLink.Owner.Owner is TdxBar)); end; procedure TdxBarEdit.WidthChanged; var I: Integer; begin for I := 0 to LinkCount - 1 do if not (udWidth in Links[I].UserDefine) and (Links[I].Control is TdxBarEditControl) then TdxBarEditControl(Links[I].Control).WidthChanged; end; { TdxBarItemControl } constructor TdxBarItemControl.Create(AItemLink: TdxBarItemLink); begin inherited Create; FItemLink := AItemLink; FParent := AItemLink.BarControl; end; destructor TdxBarItemControl.Destroy; begin if (BarManager <> nil) and (BarManager.FSelectedItem = Self) then BarManager.FSelectedItem := nil; if FItemLink <> nil then FItemLink.FControl := nil; if (FParent <> nil) and not BarManager.IsDestroying and (FParent.SelectedItem = Self) and not BarManager.IsCustomizing then if (FItemLink <> nil) and (FItemLink.VisibleIndex <> -1) then FParent.SetMouseSelectedItem(nil) else FParent.FSelectedItem := nil; cxClearObjectLinks(Self); inherited Destroy; end; function TdxBarItemControl.GetAlign: TdxBarItemAlign; begin Result := Item.Align; if (Result <> iaLeft) and not Parent.CanAlignControl(Self) then Result := iaLeft; end; function TdxBarItemControl.GetBarManager: TdxBarManager; begin if FItemLink <> nil then Result := FItemLink.BarManager else Result := nil; end; function TdxBarItemControl.GetFlat: Boolean; begin // TODO: obsolete Result := Parent.Flat; end; function TdxBarItemControl.GetIsSelected: Boolean; begin Result := (FParent <> nil) and (FParent.FSelectedItem = Self) and (Enabled or not FSelectedByMouse); end; function TdxBarItemControl.GetItem: TdxBarItem; begin Result := FItemLink.Item; end; function TdxBarItemControl.GetNormalItemHeightInSubMenu: Integer; begin Result := TdxBarSubMenuControl(Parent).NormalItemHeight; end; function TdxBarItemControl.GetRealHeight: Integer; begin Result := GetHeight; if (Align = iaClient) and TdxBarControl(Parent).Vertical then if IsVertical(Parent) then Result := MinWidth else Result := MinHeight; end; function TdxBarItemControl.GetRealWidth: Integer; begin Result := GetWidth; if (Align = iaClient) and not TdxBarControl(Parent).Vertical then Result := MinWidth; end; function TdxBarItemControl.GetUnclickAfterDoing: Boolean; begin if Item is TdxBarButton then Result := Item.UnclickAfterDoing else Result := True; end; procedure TdxBarItemControl.SetPressed(Value: Boolean); begin if FPressed <> Value then begin FPressed := Value; PressedChanged; end; end; procedure TdxBarItemControl.AlignChanged; begin FParent.RepaintBar; end; procedure TdxBarItemControl.BeforeDestroyParentHandle; begin end; procedure TdxBarItemControl.BeginGroupChanged; begin FParent.RepaintBar; end; procedure TdxBarItemControl.CaptionChanged; begin if Align = iaClient then Repaint else FParent.RepaintBar; end; procedure TdxBarItemControl.EnabledChanged; begin if not Enabled and (Parent.FSelectedItem = Self) then Parent.FSelectedItem := nil; Repaint; end; procedure TdxBarItemControl.GlyphChanged; begin Repaint; end; procedure TdxBarItemControl.PressedChanged; begin if not FPressed then Repaint; end; procedure TdxBarItemControl.RealVisibleChanging(AVisible: Boolean); begin end; procedure TdxBarItemControl.ShortCutChanged; begin if (Parent <> nil) and (Parent is TdxBarSubMenuControl) then FParent.RepaintBar; end; procedure TdxBarItemControl.VisibleChanged; begin FParent.RepaintBar; end; function TdxBarItemControl.CanClicked: Boolean; begin Result := True; end; function TdxBarItemControl.CanCustomize: Boolean; begin Result := (BarManager = Item.BarManager) or (csAncestor in BarManager.ComponentState); end; function TdxBarItemControl.CanMouseSelect: Boolean; begin Result := CanSelect; end; function TdxBarItemControl.CanSelect: Boolean; begin Result := not (Parent.IsCustomizing and (BarManager <> Item.BarManager) and not (csAncestor in BarManager.ComponentState)); end; function TdxBarItemControl.CanVisuallyPressed: Boolean; begin Result := not Parent.HideOnClick; end; procedure TdxBarItemControl.Click(ByMouse: Boolean); var AParent: TCustomdxBarControl; begin if Enabled then begin AParent := Parent; ControlClick(ByMouse); if BarControlExists(AParent) and AParent.ItemExists(Self) then ControlUnclick(ByMouse); end; end; procedure TdxBarItemControl.ControlActivate(Immediately: Boolean); begin FIsActive := True; end; procedure TdxBarItemControl.ControlInactivate(Immediately: Boolean); begin FIsActive := False; end; procedure TdxBarItemControl.ControlClick(ByMouse: Boolean); begin end; procedure TdxBarItemControl.ControlUnclick(ByMouse: Boolean); var AItem: TdxBarItem; AItemLink: TdxBarItemLink; AllowClick, AIsDestroyOnClick, AllowPressed: Boolean; // AParent: TCustomdxBarControl; ALinkSelf, ALinkItem: TcxObjectLink; begin if (Self is TdxBarButtonControl) and (Parent is TdxBarSubMenuControl) then PlaySound(psMenuCommand); AItemLink := FItemLink.RealItemLink; AItem := FItemLink.Item; AllowClick := CanClicked; AIsDestroyOnClick := IsDestroyOnClick; // AParent := Parent; try if AIsDestroyOnClick then begin AItemLink.BringToTopInRecentList(True); // for TCustomdxBarContainerItem: if AItemLink <> FItemLink then FItemLink.BringToTopInRecentList(True); end; except end; ALinkSelf := cxAddObjectLink(Self); AllowPressed := UnclickAfterDoing and (not AIsDestroyOnClick or CanVisuallyPressed); if AllowPressed then Pressed := True; try if AIsDestroyOnClick then Parent.HideAll else if AItemLink = nil then AItemLink := FItemLink; if AllowClick then begin ALinkItem := cxAddObjectLink(AItem); AItem.FClickItemLink := AItemLink; try AItem.DirectClick; finally if ALinkItem.Ref <> nil then AItem.FClickItemLink := nil; cxRemoveObjectLink(ALinkItem); end; end; finally if (ALinkSelf.Ref <> nil) and AllowPressed {and BarControlExists(AParent)} then Pressed := False; cxRemoveObjectLink(ALinkSelf); end; end; procedure TdxBarItemControl.DblClick; begin end; function TdxBarItemControl.DrawSelected: Boolean; begin Result := IsSelected; end; function TdxBarItemControl.WantsDblClick: Boolean; begin Result := BarManager.Designing or IsExpandable; end; procedure TdxBarItemControl.KeyDown(Key: Word); begin end; function TdxBarItemControl.WantsKey(Key: Word): Boolean; begin Result := False; end; procedure TdxBarItemControl.DrawLowered(DC: HDC; var R: TRect); begin PainterClass.DrawLowered(Self, DC, R); end; procedure TdxBarItemControl.DrawGlyph(R: TRect; FullBounds: PRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, Center, ForceUseBkBrush, BarControlOwner, IsSplit: Boolean); begin PainterClass.DrawGlyph(Self, R, FullBounds, PaintType, IsGlyphEmpty, Selected, Down, DrawDowned, Center, ForceUseBkBrush, BarControlOwner, IsSplit); end; procedure TdxBarItemControl.DrawGlyphAndBkgnd(R: TRect; const GlyphRect: TRect; PaintType: TdxBarPaintType; AGlyph: TBitmap; AImages: TCurImageList; AImageIndex: Integer; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner, IsSplit: Boolean); begin PainterClass.DrawGlyphAndBkgnd(Self, R, GlyphRect, PaintType, AGlyph, AImages, AImageIndex, IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner, IsSplit); end; procedure TdxBarItemControl.DrawGlyphAndTextInSubMenu(DC: HDC; var R: TRect; Selected, ShowGlyph, Down: Boolean); begin PainterClass.DrawGlyphAndTextInSubMenu(Self, DC, R, Selected, ShowGlyph, Down); end; procedure TdxBarItemControl.DrawItemText(DC: HDC; S: string; PaintRect: TRect; Alignment: UINT; Enabled, Selected, Rotated, Clipped, FlatText: Boolean); begin PainterClass.DrawItemText(Self, DC, S, PaintRect, Alignment, Enabled, Selected, Rotated, Clipped, FlatText); end; procedure TdxBarItemControl.FrameAndFillRect(DC: HDC; var R: TRect; Enabled, Selected, Pressed: Boolean); begin PainterClass.FrameAndFillRect(Self, DC, R, Enabled, Selected, Pressed); end; procedure TdxBarItemControl.GetArrowParams(APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); begin PainterClass.GetArrowParams(Self, APaintType, AEnabled, ASelected, ADroppedDown, ABrush, AArrowColor); end; function TdxBarItemControl.GetCaption: string; begin if FItemLink <> nil then Result := FItemLink.Caption else Result := ''; end; function TdxBarItemControl.GetEnabled: Boolean; begin if FItemLink <> nil then Result := FItemLink.Item.Enabled else Result := False; end; function TdxBarItemControl.GetGlyph: TBitmap; begin if FItemLink <> nil then Result := FItemLink.Glyph else Result := nil; end; function TdxBarItemControl.GetImageIndex: Integer; begin Result := FItemLink.Item.ImageIndex; end; function TdxBarItemControl.GetImages(AInToolbar: Boolean): TCurImageList; var AUseLarge: Boolean; begin AUseLarge := AInToolbar and BarManager.LargeIcons and BarManager.IsLargeImagesForLargeIcons; if Enabled then begin if AUseLarge then Result := BarManager.LargeImages else Result := BarManager.Images; end else begin if AUseLarge then begin Result := BarManager.DisabledLargeImages; if Result = nil then Result := BarManager.LargeImages; end else begin Result := BarManager.DisabledImages; if Result = nil then Result := BarManager.Images; end; end; end; function TdxBarItemControl.GetHint; begin if (FItemLink <> nil) and (FItemLink.Item <> nil) then Result := FItemLink.Item.Hint else Result := ''; end; function TdxBarItemControl.GetHotImages: TCurImageList; begin Result := FItemLink.Item.BarManager.HotImages; end; function TdxBarItemControl.GetImageEnabled(APaintType: TdxBarPaintType): Boolean; begin Result := Enabled or ((BarManager.DisabledImages <> nil) and ((Glyph = nil) or Glyph.Empty)); end; function TdxBarItemControl.GetLargeImages: TCurImageList; begin if not Enabled and (BarManager.DisabledLargeImages <> nil) then Result := BarManager.DisabledLargeImages else Result := BarManager.LargeImages; end; function TdxBarItemControl.GetPainterClass: TdxBarItemControlPainterClass; begin Result := BarManager.PainterClass; end; function TdxBarItemControl.GetShortCut; begin if FItemLink <> nil then Result := FItemLink.Item.ShortCut else Result := 0; end; function TdxBarItemControl.GetTextAreaOffset: Integer; begin Result := PainterClass.TextAreaOffset(Self); end; function TdxBarItemControl.GetHeight: Integer; begin Result := 0; end; function TdxBarItemControl.GetMinHeight: Integer; begin Result := 1; end; function TdxBarItemControl.GetMinWidth: Integer; begin Result := 1; end; function TdxBarItemControl.GetOwnedBarControl: TCustomdxBarControl; begin Result := nil; end; function TdxBarItemControl.GetWidth: Integer; begin Result := 0; end; function TdxBarItemControl.HasHint: Boolean; begin Result := (Hint <> '') and (Parent is TdxBarControl); end; function TdxBarItemControl.HasShadow: Boolean; begin Result := FParent.ChildrenHaveShadows; end; function TdxBarItemControl.ImageExists: Boolean; begin Result := not Glyph.Empty or ImageIndexLinked; end; function TdxBarItemControl.ImageIndexLinked: Boolean; begin Result := (Images[False] <> nil) and (0 <= ImageIndex) and (ImageIndex < Images[False].Count); end; function TdxBarItemControl.IsDestroyOnClick: Boolean; begin Result := True; end; function TdxBarItemControl.IsExpandable: Boolean; begin Result := False; end; function TdxBarItemControl.IsInvertTextColor: Boolean; begin Result := False; end; function TdxBarItemControl.MousePressed: Boolean; var R: TRect; P: TPoint; begin R := Parent.GetItemRect(Self); GetCursorPos(P); ScreenToClient(Parent.Handle, P); Result := Enabled and PtInRect(R, P); if Result then if InMouseHook then Result := LeftButtonPressed else Result := GetKeyState(VK_LBUTTON) < 0; end; function TdxBarItemControl.NeedCaptureMouse: Boolean; begin Result := False; end; procedure TdxBarItemControl.Paint(ARect: TRect; PaintType: TdxBarPaintType); begin end; function TdxBarItemControl.ParentIsQuickCustControl: Boolean; begin Result := Parent is TdxBarQuickControl; end; function TdxBarItemControl.WantMouse: Boolean; begin Result := CanSelect or CanClicked; end; procedure TdxBarItemControl.CheckNonRecent; begin if Parent is TdxBarSubMenuControl then TdxBarSubMenuControl(Parent).FNonRecent := FNonRecent; end; procedure TdxBarItemControl.UncheckNonRecent; begin if Parent is TdxBarSubMenuControl then TdxBarSubMenuControl(Parent).FNonRecent := False; end; procedure TdxBarItemControl.Repaint; begin // if not Parent.IsDestroying then Parent.PaintItem(Self); if not Parent.IsDestroying then begin Parent.FInRepaint := True; try Parent.PaintItem(Self); finally Parent.FInRepaint := False; end; end; end; { TCustomdxBarSubItem } constructor TCustomdxBarSubItem.Create(AOwner: TComponent); begin inherited Create(AOwner); FItemLinks := TdxBarItemLinks.Create(BarManager); FItemLinks.FOwner := Self; FShowCaption := True; end; destructor TCustomdxBarSubItem.Destroy; begin DetachingBar := -1; FItemLinks.Free; FItemLinks := nil; inherited Destroy; end; function TCustomdxBarSubItem.GetDetachingBarIndex: Integer; begin if FDetachingBar = nil then Result := -1 else Result := FDetachingBar.Index; end; procedure TCustomdxBarSubItem.SetBarSize(Value: Integer); begin if Value < 0 then Value := 0; FBarSize := Value; end; procedure TCustomdxBarSubItem.SetDetachingBar(Value: Integer); begin if (BarManager.Bars = nil) or (Value < -1) or (Value > BarManager.Bars.Count - 1) then Value := -1; if DetachingBar <> Value then begin if FDetachingBar <> nil then FDetachingBar.RemoveFreeNotification(Self); if Value = -1 then FDetachingBar := nil else FDetachingBar := BarManager.Bars[Value]; if FDetachingBar <> nil then FDetachingBar.AddFreeNotification(Self); end; end; procedure TCustomdxBarSubItem.SetItemLinks(Value: TdxBarItemLinks); begin FItemLinks.Assign(Value); end; procedure TCustomdxBarSubItem.SetShowCaption(Value: Boolean); begin if FShowCaption <> Value then begin FShowCaption := Value; if not IsLoading then UpdateEx; end; end; procedure TCustomdxBarSubItem.BarManagerChanged; begin if FItemLinks <> nil then FItemLinks.FBarManager := BarManager; end; function TCustomdxBarSubItem.CanClicked: Boolean; begin Result := False; end; procedure TCustomdxBarSubItem.DoCloseUp; begin if Assigned(FOnCloseUp) then FOnCloseUp(Self); end; procedure TCustomdxBarSubItem.DoDetaching; begin if Assigned(FOnDetaching) then FOnDetaching(Self); end; procedure TCustomdxBarSubItem.DoPaintBar(Canvas: TCanvas; const R: TRect); begin if Assigned(FOnPaintBar) then FOnPaintBar(Self, Canvas, R); end; procedure TCustomdxBarSubItem.DoPopup; begin if Assigned(FOnPopup) then FOnPopup(Self); end; function TCustomdxBarSubItem.HasDesignTimeLinks: Boolean; begin Result := True; end; function TCustomdxBarSubItem.IsShortCut(AShortCut: TShortCut): Boolean; begin Result := FItemLinks.IsShortCut(AShortCut); end; procedure TCustomdxBarSubItem.ObjectNotification(AOperation: TOperation; AObject: TObject); begin inherited; if (AOperation = opRemove) and (AObject = FDetachingBar) then DetachingBar := -1; end; function TCustomdxBarSubItem.CanContainItem(AItem: TdxBarItem): Boolean; begin Result := not ((AItem is TCustomdxBarSubItem) and ((Self = AItem) or TCustomdxBarSubItem(AItem).ItemLinks.HasItem(Self)) or (AItem is TdxBarButton) and (TdxBarButton(AItem).DropDownMenu <> nil) and TdxBarButton(AItem).DropDownMenu.ItemLinks.HasItem(Self)); end; function TCustomdxBarSubItem.GetDetachingBar: TdxBar; begin Result := FDetachingBar; end; procedure TCustomdxBarSubItem.DropDown; var I: Integer; begin for I := 0 to LinkCount - 1 do with Links[I] do if Control is TdxBarSubItemControl and IsWindowVisible(BarControl.Handle) then begin (BarControl as TdxBarControl).BarGetFocus(Control); TdxBarControl(BarControl).IsDowned := True; Control.Click(False); Break; end; end; { TdxBarSubItem } constructor TdxBarSubItem.Create(AOwner: TComponent); begin inherited; FAllowCustomizing := True; end; function TdxBarSubItem.HasDesignTimeLinks: Boolean; begin Result := inherited HasDesignTimeLinks and not IsInternal; end; { TCustomdxBarContainerItem } destructor TCustomdxBarContainerItem.Destroy; begin if FNeedClearItemList then ClearItemList; inherited; end; procedure TCustomdxBarContainerItem.AddListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer; FirstCall: Boolean; CallingItemLink: TdxBarItemLink); begin if FNeedClearItemList then ClearItemList; if FirstCall and Assigned(FOnGetData) then begin FInOnGetData := True; try FOnGetData(Self); except FInOnGetData := False; end; end; end; procedure TCustomdxBarContainerItem.DeleteListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer); begin end; procedure TCustomdxBarContainerItem.ClearItemList; begin FNeedClearItemList := False; end; function TCustomdxBarContainerItem.HideWhenRun: Boolean; begin Result := True; end; function TCustomdxBarContainerItem.InternalActuallyVisible: Boolean; begin Result := Assigned(FOnGetData); end; procedure TCustomdxBarContainerItem.ItemLinksChanged; begin if not FInOnGetData and not ResettingToolbar then VisibleChanged; end; procedure TCustomdxBarContainerItem.NeedClearItemList; begin FNeedClearItemList := True; end; { TdxBarListItem } constructor TdxBarListItem.Create(AOwner: TComponent); begin inherited; FItems := TStringList.Create; TStringList(FItems).OnChange := ItemsChanged; FItemIndex := -1; FItemList := TList.Create; FShowNumbers := True; end; destructor TdxBarListItem.Destroy; begin FItemList.Free; FItemList := nil; FItems.Free; inherited; end; function TdxBarListItem.GetDataIndex: Integer; var I: Integer; begin Result := -1; if (0 <= FItemIndex) and (FItemIndex < Items.Count) then for I := 0 to FItemIndex do if Items[I] <> ListItemSeparator then Inc(Result); end; procedure TdxBarListItem.SetDataIndex(Value: Integer); var J, I: Integer; begin if Items.Count = 0 then I := -1 else begin J := -1; for I := 0 to Items.Count - 1 do begin if Items[I] <> ListItemSeparator then Inc(J); if J = Value then Break; end; end; ItemIndex := I; end; procedure TdxBarListItem.SetItems(Value: TStrings); begin FItems.Assign(Value); end; procedure TdxBarListItem.ClickItem(Sender: TObject); begin FItemIndex := TComponent(Sender).Tag; DirectClick; end; procedure TdxBarListItem.ItemsChanged(Sender: TObject); begin if not FInOnGetData then VisibleChanged; end; procedure TdxBarListItem.AddListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer; FirstCall: Boolean; CallingItemLink: TdxBarItemLink); var I, CurIndex: Integer; IsBeginGroup, ItemListExists: Boolean; begin inherited; IsBeginGroup := False; ItemListExists := FItemList.Count > 0; CurIndex := 0; for I := 0 to Items.Count - 1 do if Items[I] = ListItemSeparator then IsBeginGroup := True else begin if not ItemListExists then begin FItemList.Add(TdxBarButton.Create(BarManager.MainForm)); with TdxBarButton(FItemList[CurIndex]) do begin Action := Self.Action; if ShowCheck and (I{CurIndex} = FItemIndex) then begin ButtonStyle := bsChecked; Down := True; end; if FShowNumbers then begin if CurIndex < 9 then FCaption := IntToStr(CurIndex + 1) else FCaption := Chr(Ord('A') + CurIndex - 9); FCaption := '&' + FCaption + ' '; end else FCaption := ''; FCaption := FCaption + GetDisplayText(Items[I]); Tag := I; //CurIndex; OnClick := ClickItem; Enabled := Self.Enabled; end; end; with AItemLinks.Add do begin FOriginalItemLink := CallingItemLink; Index := AIndex + CurIndex; Item := TdxBarItem(FItemList[CurIndex]); if (CurIndex = 0) or IsBeginGroup then BeginGroup := True; Synchronize(CallingItemLink); end; IsBeginGroup := False; Inc(CurIndex); end; end; procedure TdxBarListItem.ClearItemList; begin if (FItemList <> nil) and (FItemList.Count > 0) and (TdxBarItem(FItemList.First).LinkCount = 0) then while FItemList.Count > 0 do begin TdxBarItem(FItemList.Last).Free; FItemList.Delete(FItemList.Count - 1); end; inherited; end; procedure TdxBarListItem.DeleteListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer); var I: Integer; begin inherited; for I := 0 to Items.Count - 1 do if Items[I] <> ListItemSeparator then AItemLinks[AIndex].Free; end; function TdxBarListItem.GetDisplayText(const AText: string): string; begin Result := AText; end; function TdxBarListItem.InternalActuallyVisible: Boolean; begin Result := inherited InternalActuallyVisible or (Items.Count > 0); end; procedure TdxBarListItem.DirectClick; begin if CurItemLink = nil then inherited; end; { TdxDockRow } constructor TdxDockRow.Create(ADockControl: TdxDockControl); begin inherited Create; FDockControl := ADockControl; FColList := TList.Create; end; destructor TdxDockRow.Destroy; var I: Integer; begin for I := ColCount - 1 downto 0 do Cols[I].Free; FColList.Free; inherited; end; function TdxDockRow.GetCol(Index: Integer): TdxDockCol; begin Result := FColList[Index]; end; function TdxDockRow.GetColCount: Integer; begin Result := FColList.Count; end; { TdxBarButtonControl } function TdxBarButtonControl.GetButtonStyle: TdxBarButtonStyle; begin Result := Item.ButtonStyle; end; function TdxBarButtonControl.GetDown: Boolean; begin if ItemLink.Item is TdxBarButton then Result := Item.Down else Result := False; end; function TdxBarButtonControl.GetDropDownEnabled: Boolean; begin Result := Item.DropDownEnabled; end; function TdxBarButtonControl.GetDropDownMenuControl: TdxBarSubMenuControl; begin if Item.DropDownMenu <> nil then Result := TdxBarSubMenuControl(Item.DropDownMenu.ItemLinks.BarControl) else Result := nil; end; function TdxBarButtonControl.GetDroppedDownFlat: Boolean; begin Result := PainterClass.IsFlatItemText and FDroppedDown and (DropDownMenuControl <> nil); end; function TdxBarButtonControl.GetGroupIndex: Integer; begin Result := Item.GroupIndex; end; function TdxBarButtonControl.GetItem: TdxBarButton; begin Result := TdxBarButton(FItemLink.Item); end; function TdxBarButtonControl.GetLowered: Boolean; begin Result := Item.Lowered; end; function TdxBarButtonControl.GetPaintStyle: TdxBarPaintStyle; begin if FItemLink <> nil then Result := FItemLink.PaintStyle else Result := psStandard; // if (Parent is TdxBarControl) and (Result = psStandard) and not ImageExists then // Result := psCaption; if (Parent is TdxBarControl) and (Result = psStandard) then PreparePaintStyleOnBar(Result); end; function TdxBarButtonControl.MouseOverArrow: Boolean; var R: TRect; P: TPoint; begin if ButtonStyle = bsDropDown then begin GetCursorPos(P); ScreenToClient(Parent.Handle, P); R := Parent.GetItemRect(Self); R.Left := R.Right - ArrowWidth; Result := PtInRect(R, P); end else Result := False; end; function TdxBarButtonControl.ArrowPressed: Boolean; begin Result := MousePressed and MouseOverArrow; end; function TdxBarButtonControl.ArrowWidth: Integer; begin if Parent is TdxBarSubMenuControl then Result := Parent.MenuArrowWidth else Result := BarManager.RealButtonArrowWidth; end; procedure TdxBarButtonControl.ButtonStyleChanged; begin Parent.RepaintBar; end; procedure TdxBarButtonControl.ControlInactivate(Immediately: Boolean); begin inherited; if (Item.ButtonStyle = bsDropDown) and DroppedDown and (DropDownMenuControl <> nil) then DropDownMenuControl.Hide; end; procedure TdxBarButtonControl.ControlClick(ByMouse: Boolean); begin inherited; if (ButtonStyle = bsDropDown) and ArrowPressed then DoDropDown(True) else if (Parent is TdxBarControl) or (ButtonStyle = bsDropDown) then Repaint; end; procedure TdxBarButtonControl.ControlUnclick(ByMouse: Boolean); begin if not DroppedDown then begin with Item do if ButtonStyle = bsChecked then Down := not Down; ControlInactivate(True); inherited; end; end; procedure TdxBarButtonControl.DoCloseUp; begin if FDroppedDown then begin FDroppedDown := False; if (Parent is TdxBarControl) then TdxBarControl(Parent).IsDowned := False; end; end; procedure TdxBarButtonControl.DoDropDown(ByMouse: Boolean); var Rect: TRect; P: TPoint; begin if not FDroppedDown and Enabled and DropDownEnabled and (Item.DropDownMenu <> nil) then begin FDroppedDown := True; if not IsActive then ControlActivate(True); Repaint; Rect := Parent.GetItemRect(Self); with Rect do if Parent is TdxBarSubMenuControl or IsRealVertical(Parent) then begin P := Point(Right, Top); if {not Flat or }(Parent is TdxBarSubMenuControl) then // fix Dec(P.Y, TdxBarSubMenuControl(Parent).BorderSize); end else P := Point(Left, Bottom); P := Parent.ClientToScreen(P); Item.DoDropDown(Self, P.X, P.Y, ByMouse); if PainterClass.IsDropDownRepaintNeeded then Repaint; end; end; procedure TdxBarButtonControl.DownChanged; begin Repaint; end; procedure TdxBarButtonControl.DrawArrow(const ARect: TRect; Selected, DrawDowned: Boolean; PaintType: TdxBarPaintType); var DC: HDC; R1: TRect; Brush: HBRUSH; ArrowColor: COLORREF; begin DC := Parent.Canvas.Handle; R1 := ARect; R1.Left := R1.Right - ArrowWidth; GetArrowParams(PaintType, Enabled, Selected, DroppedDown, Brush, ArrowColor); PainterClass.DrawButtonControlArrow(Self, DC, R1, Brush, ArrowColor, Selected, DrawDowned, Self.DroppedDown, Self.DropDownEnabled, Self.DropDownMenuControl <> nil, PaintType); end; function TdxBarButtonControl.DrawSelected: Boolean; begin Result := inherited DrawSelected and not FParent.IsCustomizing or Pressed; end; procedure TdxBarButtonControl.DropDownEnabledChanged; begin Repaint; end; procedure TdxBarButtonControl.GlyphChanged; begin if FItemLink.PaintStyle = psStandard then Parent.RepaintBar else inherited; end; function TdxBarButtonControl.GetDefaultHeight: Integer; begin Result := Parent.TextSize; if Parent is TdxBarControl then if PaintStyle in [psStandard, psCaptionInMenu] then Result := BarManager.ButtonHeight else if not IsVertical(Parent) then if Result < BarManager.ButtonHeight then Result := BarManager.ButtonHeight else else if Result < BarManager.ButtonWidth then Result := BarManager.ButtonWidth else else PainterClass.CorrectButtonControlDefaultHeight(Result); if Lowered then Inc(Result, 2 * PainterClass.LoweredBorderSize(Self)); end; function TdxBarButtonControl.GetDefaultWidth: Integer; begin with Parent.Canvas do if Parent is TdxBarSubMenuControl then begin Result := 2 * Parent.TextSize + 3 + TextWidth(GetTextOf(Caption)) + 3; if ShortCut <> 0 then Inc(Result, Parent.TextSize - 6 + TextWidth(ShortCutToText(ShortCut))); PainterClass.CorrectButtonControlDefaultWidth(Self, Result); end else with BarManager, Parent.Canvas do if PaintStyle in [psStandard, psCaptionInMenu] then Result := ButtonWidth else begin Result := TextWidth(GetTextOf(Caption)); if PaintStyle = psCaption then Inc(Result, Font.Size) else if not IsVertical(Parent) then Inc(Result, ButtonWidth + 4) else Inc(Result, ButtonHeight + 4); end; if Lowered then Inc(Result, 2 * PainterClass.LoweredBorderSize(Self)); end; function TdxBarButtonControl.GetHeight: Integer; begin if IsVertical(Parent) and (PaintStyle in [psCaption, psCaptionGlyph]) then Result := GetDefaultWidth else Result := GetDefaultHeight; end; function TdxBarButtonControl.GetOwnedBarControl: TCustomdxBarControl; begin Result := DropDownMenuControl; end; function TdxBarButtonControl.GetWidth: Integer; begin if IsVertical(Parent) and (PaintStyle in [psCaption, psCaptionGlyph]) then Result := GetDefaultHeight else Result := GetDefaultWidth; if (Parent is TdxBarControl) and (ButtonStyle = bsDropDown) then Inc(Result, ArrowWidth); end; function TdxBarButtonControl.IsDestroyOnClick: Boolean; begin Result := Parent is TdxBarControl or Item.CloseSubMenuOnClick; end; function TdxBarButtonControl.IsFlatTextSelected(APressed: Boolean): Boolean; begin Result := PainterClass.IsFlatItemText and (APressed or Down and DrawSelected) and PainterClass.IsItemTextSelectedInverted; if IsHighContrastWhite and PainterClass.IsFlatItemText and ((APressed or Down) or DrawSelected) and not DroppedDown then Result := True; //!!! Result := False; end; procedure TdxBarButtonControl.KeyDown(Key: Word); begin inherited; case Key of VK_UP, VK_DOWN, VK_RIGHT: DoDropDown(False); end; end; function TdxBarButtonControl.NeedCaptureMouse: Boolean; begin Result := not DroppedDown; end; procedure TdxBarButtonControl.Paint(ARect: TRect; PaintType: TdxBarPaintType); var DC: HDC; R: TRect; Selected, APressed: Boolean; function GetFullBounds: PRect; begin if DroppedDownFlat then Result := @ARect else Result := nil; end; procedure PrepareCaptionBounds; begin with R do if PaintStyle = psCaption then if PaintType = ptHorz then Inc(Left, Parent.Canvas.Font.Size div 2) else Inc(Top, Parent.Canvas.Font.Size div 2) else if PaintType = ptHorz then Inc(Left, BarManager.ButtonWidth) else Inc(Top, BarManager.ButtonHeight); PainterClass.OffsetCaptionBounds(Self, APressed, R); end; begin if ARect.Left = ARect.Right then Exit; DC := Parent.Canvas.Handle; if Lowered then DrawLowered(DC, ARect); R := ARect; Selected := DrawSelected; with R do if PaintType = ptMenu then begin DrawGlyphAndTextInSubMenu(DC, R, Selected, not (PaintStyle in [psCaption, psCaptionInMenu]), Down); if ShortCut <> 0 then begin Dec(Right, 5 + Bottom - Top); DrawItemText(DC, ShortCutToText(ShortCut), R, DT_RIGHT, Enabled, Selected, False, False, PainterClass.IsFlatItemText and not IsHighContrastWhite); end; end else begin if ButtonStyle = bsDropDown then Dec(Right, ArrowWidth); APressed := Selected and Parent.IsActive and MousePressed and not ArrowPressed and not DroppedDown or Pressed and (ButtonStyle <> bsChecked); DrawGlyph(R, GetFullBounds, PaintType, PaintStyle = psCaption, Selected, Down or DroppedDownFlat, APressed, False, False, ButtonStyle = bsDropDown, ButtonStyle = bsDropDown); if PaintStyle in [psCaption, psCaptionGlyph] then begin PrepareCaptionBounds; DrawItemText(DC, Caption, R, DT_LEFT, Enabled, IsFlatTextSelected(APressed), PaintType = ptVert, False, not IsFlatTextSelected(APressed)); end; end; if ButtonStyle = bsDropDown then DrawArrow(ARect, Selected, APressed, PaintType); end; procedure TdxBarButtonControl.PaintStyleChanged; begin Parent.RepaintBar; end; procedure TdxBarButtonControl.PreparePaintStyleOnBar(var APaintStyle: TdxBarPaintStyle); begin if (APaintStyle = psStandard) and not ImageExists then APaintStyle := psCaption; end; function TdxBarButtonControl.WantsKey(Key: Word): Boolean; begin Result := inherited WantsKey(Key) or (ButtonStyle = bsDropDown) and ((Parent is TdxBarControl) and ((Key = VK_UP) or (Key = VK_DOWN)) or (Parent is TdxBarSubMenuControl) and (Key = VK_RIGHT)); end; { TCustomdxBarComboControl } function TCustomdxBarComboControl.GetDropDownWindow: HWND; begin Result := Item.DropDownWindow; end; function TCustomdxBarComboControl.GetItem: TCustomdxBarCombo; begin Result := TCustomdxBarCombo(ItemLink.Item); end; procedure TCustomdxBarComboControl.ControlInactivate(Immediately: Boolean); begin DroppedDown := False; inherited; end; procedure TCustomdxBarComboControl.EnabledChanged; begin DroppedDown := False; inherited; end; procedure TCustomdxBarComboControl.GetArrowParams(APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); begin PainterClass.ComboControlGetArrowParams(Self, APaintType, AEnabled, ASelected, ADroppedDown, ABrush, AArrowColor); end; procedure TCustomdxBarComboControl.Paint(ARect: TRect; PaintType: TdxBarPaintType); const Borders: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER); var Selected: Boolean; R, R1: TRect; DC: HDC; procedure DrawArrow(ARect: TRect); begin PainterClass.ComboControlDrawArrow(Self, DC, ARect, Selected, PaintType); end; begin if ARect.Left = ARect.Right then Exit; Selected := DrawSelected; R := ARect; DC := Parent.Canvas.Handle; DrawCaption(DC, R, PaintType, Selected); DrawBorder(DC, R, PaintType, Selected); R1 := R; Dec(R1.Right, PainterClass.ComboControlArrowOffset + Parent.ComboBoxArrowWidth); if Enabled then WindowRect := R1; if not Enabled or not Focused or Item.EmptyWindow then DrawTextField(DC, R1); DrawArrow(R); end; procedure TCustomdxBarComboControl.SetDroppedDown(Value: Boolean); var P: TPoint; begin if (FDroppedDown <> Value) and not Item.ReadOnly then begin FDroppedDown := Value; Repaint; if FDroppedDown then begin with Parent.GetItemRect(Self), P do if Parent is TdxBarSubMenuControl or IsRealVertical(Parent) then begin X := Right; Y := Top; end else begin X := Left + CaptionWidth; Y := Bottom; end; ClientToScreen(Parent.Handle, P); Item.DropDown(P.X, P.Y); end else Item.CloseUp; end; end; procedure TCustomdxBarComboControl.WndProc(var Message: TMessage); var Shift: TShiftState; AHandle: HWND; R: TRect; function LButtonDowned: Boolean; begin with Message do LButtonDowned := (Msg = WM_LBUTTONDOWN) or (Msg = WM_LBUTTONDBLCLK); end; begin with Message do case Msg of WM_KEYDOWN, WM_KEYUP, WM_CHAR: begin Shift := KeyDataToShiftState(lParam); if (Msg = WM_KEYDOWN) and (wParam = VK_F4) then begin DroppedDown := not DroppedDown; Exit; end else if DroppedDown and (DropDownWindow <> 0) and Item.CheckKeyForDropDownWindow(wParam, Shift) then begin Result := SendMessage(DropDownWindow, Msg, wParam, lParam); Exit; end; end; WM_SYSKEYDOWN, WM_SYSKEYUP: begin Shift := KeyDataToShiftState(lParam); if ((wParam = VK_UP) or (wParam = VK_DOWN)) and (ssAlt in Shift) then begin if Msg = WM_SYSKEYDOWN then DroppedDown := not DroppedDown; Message.wParam := 0; Exit; end end; end; AHandle := Handle; inherited; if not IsWindowVisible(AHandle) then Exit; if LButtonDowned then FOnPressDroppedDown := DroppedDown; if not FOnPressDroppedDown and LButtonDowned or FOnPressDroppedDown and (Message.Msg = WM_LBUTTONUP) then begin R := DropDownButtonRect; if not Item.ShowEditor then R.Left := WindowRect.Left; MapWindowPoints(Parent.Handle, Handle, R, 2); if PtInRect(R, SmallPointToPoint(TSmallPoint(Message.lParam))) then DroppedDown := not DroppedDown; end; end; { TdxBarComboControl } function TdxBarComboControl.GetItem: TdxBarCustomCombo; begin Result := TdxBarCustomCombo(ItemLink.Item); end; function TdxBarComboControl.GetItemIndex: Integer; begin Result := Item.ItemIndex; end; function TdxBarComboControl.GetItems: TStrings; begin Result := Item.Items; end; function TdxBarComboControl.GetSorted: Boolean; begin Result := Item.Sorted; end; procedure TdxBarComboControl.SetLocalItemIndex(Value: Integer); begin FLocalItemIndex := Value; if (0 <= FLocalItemIndex) and (FLocalItemIndex <= Items.Count - 1) then Text := Items[FLocalItemIndex] else Text := Item.Text; if Item.EmptyWindow then Repaint; end; procedure TdxBarComboControl.SetFocused(Value: Boolean); begin FFocusing := True; try if Value then LocalItemIndex := ItemIndex; finally FFocusing := False; end; inherited; end; procedure TdxBarComboControl.WndProc(var Message: TMessage); var Shift: TShiftState; begin if not ReadOnly then begin with Message do case Msg of WM_MOUSEWHEEL: begin if SmallInt(HIWORD(TWMMOuse(Message).Keys)) > 0 then begin if not DroppedDown then begin if LocalItemIndex > 0 then LocalItemIndex := LocalItemIndex - 1; end else SendMessage(DropDownWindow, WM_VScroll, SB_LINEUP, 0); end else begin if not DroppedDown then begin if LocalItemIndex < (Items.Count - 1) then LocalItemIndex := LocalItemIndex + 1; end else SendMessage(DropDownWindow, WM_VScroll, SB_LINEDOWN, 0); end; end; WM_KEYDOWN: begin if (wParam = VK_RETURN) or (wParam = VK_TAB) then begin if (LocalItemIndex <> -1) and (Item.Items[LocalItemIndex] = Text) then begin Item.ItemIndex := LocalItemIndex; if not IsWindowVisible(Handle) then Exit; end; end else begin Shift := KeyDataToShiftState(lParam); if not DroppedDown and ((wParam = VK_UP) or (wParam = VK_DOWN)) and (Shift = []) then begin if (wParam = VK_UP) and (LocalItemIndex > 0) then LocalItemIndex := LocalItemIndex - 1 else if (wParam = VK_DOWN) and (LocalItemIndex < Items.Count - 1) then LocalItemIndex := LocalItemIndex + 1; Exit; end; end; end; end; end; inherited WndProc(Message); end; { TdxBarItemActionLink } procedure TdxBarItemActionLink.AssignClient(AClient: TObject); begin FClient := AClient as TdxBarItem; end; function TdxBarItemActionLink.IsCaptionLinked: Boolean; begin Result := inherited IsCaptionLinked and (FClient.Caption = (Action as TCustomAction).Caption); end; function TdxBarItemActionLink.IsCheckedLinked: Boolean; begin Result := inherited IsCheckedLinked and (FClient is TdxBarButton) and (TdxBarButton(FClient).Down = (Action as TCustomAction).Checked); end; function TdxBarItemActionLink.IsEnabledLinked: Boolean; begin Result := inherited IsEnabledLinked and (FClient.Enabled = (Action as TCustomAction).Enabled); end; function TdxBarItemActionLink.IsHelpContextLinked: Boolean; begin Result := inherited IsHelpContextLinked and (FClient.HelpContext = (Action as TCustomAction).HelpContext); end; function TdxBarItemActionLink.IsHintLinked: Boolean; begin Result := inherited IsHintLinked and ((FClient.Hint = (Action as TCustomAction).Hint) or FClient.IsHintFromCaption); end; function TdxBarItemActionLink.IsImageIndexLinked: Boolean; begin Result := inherited IsImageIndexLinked and (FClient.ActionImageIndex = (Action as TCustomAction).ImageIndex); end; function TdxBarItemActionLink.IsShortCutLinked: Boolean; begin Result := inherited IsShortCutLinked and (FClient.ShortCut = (Action as TCustomAction).ShortCut); end; function TdxBarItemActionLink.IsVisibleLinked: Boolean; function GetClientVisible: TdxBarItemVisible; begin if FClient.IsLoading then Result := FClient.FLoadedVisible else Result := FClient.Visible; end; begin Result := inherited IsVisibleLinked and (GetClientVisible = VisibleTodxBarVisible((Action as TCustomAction).Visible)); end; function TdxBarItemActionLink.IsOnExecuteLinked: Boolean; begin Result := inherited IsOnExecuteLinked and (@FClient.OnClick = @Action.OnExecute); end; procedure TdxBarItemActionLink.SetCaption(const Value: string); begin if IsCaptionLinked then FClient.Caption := Value; end; procedure TdxBarItemActionLink.SetChecked(Value: Boolean); begin if IsCheckedLinked and (FClient is TdxBarButton) then TdxBarButton(FClient).Down := Value; end; procedure TdxBarItemActionLink.SetEnabled(Value: Boolean); begin if IsEnabledLinked then FClient.Enabled := Value; end; procedure TdxBarItemActionLink.SetHelpContext(Value: THelpContext); begin if IsHelpContextLinked then FClient.HelpContext := Value; end; procedure TdxBarItemActionLink.SetHint(const Value: string); begin if IsHintLinked then FClient.Hint := Value; end; procedure TdxBarItemActionLink.SetImageIndex(Value: Integer); begin if IsImageIndexLinked then FClient.ActionImageIndex := Value; end; procedure TdxBarItemActionLink.SetShortCut(Value: TShortCut); begin if IsShortCutLinked then FClient.ShortCut := Value; end; procedure TdxBarItemActionLink.SetVisible(Value: Boolean); begin if IsVisibleLinked then FClient.Visible := VisibleTodxBarVisible(Value); end; procedure TdxBarItemActionLink.SetOnExecute(Value: TNotifyEvent); begin if IsOnExecuteLinked then FClient.OnClick := Value; end; { TdxBarSubItemControl } var ABarSubItemTimer: TdxBarSubItemControl; ABarSubMenuTimerID: Integer; procedure ActivateSubMenuTimerProc(Wnd: HWnd; Msg, TimerID, SysTime: Longint); stdcall; begin try try if ABarSubItemTimer <> nil then ABarSubItemTimer.ControlActivate(True); finally KillTimer(0, ABarSubMenuTimerID); ABarSubItemTimer := nil; end; except end; end; procedure DeActivateSubMenuTimerProc(Wnd: HWnd; Msg, TimerID, SysTime: Longint); stdcall; begin try try if ABarSubItemTimer <> nil then ABarSubItemTimer.ControlInActivate(True); finally KillTimer(0, ABarSubMenuTimerID); ABarSubItemTimer := nil; end; except end; end; destructor TdxBarSubItemControl.Destroy; begin if ABarSubItemTimer = Self then begin ABarSubItemTimer := nil; KillTimer(0, ABarSubMenuTimerID); end; if (SubMenuControl <> nil) {and not ItemLink.Item.IsDestroying} then SubMenuControl.Hide; FIsActive := False; inherited Destroy; end; function TdxBarSubItemControl.GetCaptionOffset: Integer; begin Result := PainterClass.SubItemControlCaptionOffset(Self); end; function TdxBarSubItemControl.GetItem: TCustomdxBarSubItem; begin Result := TCustomdxBarSubItem(ItemLink.Item); end; procedure TdxBarSubItemControl.GlyphChanged; begin Parent.RepaintBar; end; function TdxBarSubItemControl.GetSubMenuControl: TdxBarSubMenuControl; begin if Item.ItemLinks = nil then Result := nil else Result := TdxBarSubMenuControl(Item.ItemLinks.BarControl); end; function TdxBarSubItemControl.CanClicked: Boolean; begin Result := False; end; procedure TdxBarSubItemControl.ControlActivate(Immediately: Boolean); var R: TRect; P: TPoint; begin // if AnimatingSubMenu <> nil then Exit; if not HasSubMenu then Exit; if SubMenuControl <> nil then if (ItemLink.Item.CurItemLink = nil) or (Self = ItemLink.Item.CurItemLink.Control) then begin if ABarSubItemTimer = Self then begin ABarSubItemTimer := nil; KillTimer(0, ABarSubMenuTimerID); end; Exit; end else ItemLink.Item.CurItemLink.Control.ControlInActivate(True); inherited; if not Enabled and not BarManager.Designing then Exit; if Parent is TdxBarControl then if Parent.IsCustomizing or TdxBarControl(Parent).IsDowned then Immediately := True else Exit; if not Immediately and not BarManager.IsCustomizing then begin if ABarSubItemTimer <> nil then begin KillTimer(0, ABarSubMenuTimerID); try if ABarSubItemTimer.Parent <> Parent.ParentBar then ABarSubItemTimer.ControlInActivate(True); except end; end; ABarSubItemTimer := Self; ABarSubMenuTimerID := SetTimer(0, 0, dxBarWaitForSubMenuTime, @ActivateSubMenuTimerProc); Exit; end; Item.DoPopup; Item.DirectClick; DoCreateSubMenuControl; if SubMenuControl <> nil then begin R := FParent.GetItemRect(Self); if Parent is TdxBarSubMenuControl then begin P := Point(R.Right, R.Top - TdxBarSubMenuControl(Parent).BorderSize); SubMenuControl.OwnerWidth := R.Right - R.Left; end else if IsRealVertical(Parent) then begin P := Point(R.Right, R.Top); SubMenuControl.OwnerWidth := R.Right - R.Left; end else begin P := Point(R.Left, R.Bottom); SubMenuControl.OwnerHeight := R.Bottom - R.Top; end; SubMenuControl.FSubItem := Self; P := FParent.ClientToScreen(P); SubMenuControl.Left := P.X; SubMenuControl.Top := P.Y; // *** Parent.ChildBar := SubMenuControl; SubMenuControl.ParentBar := Parent; // *** if not (Parent is TdxBarSubMenuControl) then Repaint; SubMenuControl.FShowAnimation := FShowAnimation; FShowAnimation := False; SubMenuControl.Show; if PainterClass.IsDropDownRepaintNeeded then Repaint; end; end; procedure TdxBarSubItemControl.ControlInactivate(Immediately: Boolean); var AHadSubMenuControl: Boolean; begin // if AnimatingSubMenu <> nil then Exit; if not HasSubMenu then Exit; if Parent is TdxBarControl then Immediately := True; if not Immediately and (ABarSubItemTimer = nil) and (Parent <> nil) and not Parent.IsDestroying and not BarManager.IsCustomizing then begin ABarSubItemTimer := Self; ABarSubMenuTimerID := SetTimer(0, 0, dxBarWaitForSubMenuTime, @DeActivateSubMenuTimerProc); Exit; end; if SubMenuControl <> nil then SubMenuControl.FSubItem := nil; inherited; if ABarSubItemTimer = Self then begin ABarSubItemTimer := nil; KillTimer(0, ABarSubMenuTimerID); end; AHadSubMenuControl := SubMenuControl <> nil; if AHadSubMenuControl then SubMenuControl.Hide; if not (Parent is TdxBarSubMenuControl) then Repaint; if AHadSubMenuControl then Item.DoCloseUp; end; procedure TdxBarSubItemControl.ControlClick(ByMouse: Boolean); begin if SubMenuControl = nil then begin ControlActivate(True); if not ByMouse and (SubMenuControl <> nil) then with SubMenuControl do if ItemLinks.First <> nil then SetKeySelectedItem(ItemLinks.First.Control); end else if Parent.IsCustomizing or (BarManager.GetPaintStyle = bmsStandard) then // ??? ControlInactivate(True); end; procedure TdxBarSubItemControl.CreateSubMenuControl; begin Item.ItemLinks.CreateBarControl; end; procedure TdxBarSubItemControl.DoCreateSubMenuControl; begin CreateSubMenuControl; if HasShadow and (SubMenuControl <> nil) then begin SubMenuControl.OwnerBounds := Parent.GetItemScreenRect(Self); SubMenuControl.FOwnerControl := Parent; end; end; function TdxBarSubItemControl.GetDefaultHeight: Integer; begin Result := PainterClass.SubItemControlDefaultHeight(Self); end; function TdxBarSubItemControl.GetDefaultWidth: Integer; begin Result := PainterClass.SubItemControlDefaultWidth(Self); end; function TdxBarSubItemControl.GetHeight: Integer; begin if IsVertical(Parent) then Result := GetDefaultWidth else Result := GetDefaultHeight; end; function TdxBarSubItemControl.GetOwnedBarControl: TCustomdxBarControl; begin Result := SubMenuControl; end; function TdxBarSubItemControl.GetWidth: Integer; begin if IsVertical(Parent) then Result := GetDefaultHeight else Result := GetDefaultWidth; end; function TdxBarSubItemControl.HasSubMenu: Boolean; begin Result := True; end; function TdxBarSubItemControl.IsDestroyOnClick: Boolean; begin Result := False; end; function TdxBarSubItemControl.IsExpandable: Boolean; begin Result := True; end; procedure TdxBarSubItemControl.KeyDown(Key: Word); begin inherited; case Key of VK_RIGHT: Click(False); end; end; procedure TdxBarSubItemControl.Paint(ARect: TRect; PaintType: TdxBarPaintType); const Borders: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER); var R: TRect; Selected, Down: Boolean; DC: HDC; begin if ARect.Left = ARect.Right then Exit; R := ARect; Selected := DrawSelected; Down := IsActive and (SubMenuControl <> nil); DC := Parent.Canvas.Handle; PainterClass.SubItemControlDraw(Self, DC, R, Selected, Down, PaintType); end; function TdxBarSubItemControl.WantsDblClick: Boolean; begin Result := inherited WantsDblClick and not BarManager.Designing; end; function TdxBarSubItemControl.WantsKey(Key: Word): Boolean; begin Result := inherited WantsKey(Key) or (Parent is TdxBarSubMenuControl) and (Key = VK_RIGHT); end; { TdxBarSubMenuControl } type TAnimationInfo = record MenuAnimations: TdxBarMenuAnimations; LeftDirection, TopDirection: Boolean; RealLeft, RealTop, RealClientWidth, RealClientHeight, BorderWidth, BorderHeight, FirstValue, Delta, Step: Integer; OldClientRect: TRect; end; var AnimationBitmap: HBITMAP; AnimationBitmapDC: HDC; AnimationInfo: TAnimationInfo; AnimationThread: THandle; KillingAnimation: Boolean; procedure TerminateAnimation(ASubMenu: TdxBarSubMenuControl); var Msg: TMsg; begin if (AnimatingSubMenu = ASubMenu) and (AnimatingSubMenu <> nil) then begin KillingAnimation := True; while MsgWaitForMultipleObjects(1, AnimationThread, False, INFINITE, QS_SENDMESSAGE) = WAIT_OBJECT_0 + 1 do begin if AnimatingSubMenu <> nil then PeekMessage(Msg, AnimatingSubMenu.Handle, 0, 0, PM_REMOVE); if (AnimatingSubMenu <> nil) and not AnimatingSubMenu.FDestroyFlag then DispatchMessage(Msg); end; ProcessPaintMessages; end; end; constructor TdxBarSubMenuControl.Create(AOwner: TComponent); begin inherited Create(AOwner); Width := 0; XDirection := xdRight; YDirection := ydBottom; end; destructor TdxBarSubMenuControl.Destroy; begin if (ChildBar <> nil) and not ChildBar.FDestroyFlag then ChildBar.Free; if ParentBar <> nil then ParentBar.ChildBar := nil; inherited Destroy; end; function TdxBarSubMenuControl.GetBarSize: Integer; begin if ItemLinks.Owner is TdxBarPopupMenu then Result := TdxBarPopupMenu(ItemLinks.Owner).BarSize else if ItemLinks.Owner is TCustomdxBarSubItem then Result := TCustomdxBarSubItem(ItemLinks.Owner).BarSize else Result := 0; end; function TdxBarSubMenuControl.GetBorderSize: Integer; begin Result := PainterClass.SubMenuControlBorderSize; end; function TdxBarSubMenuControl.GetDetachCaptionSize: Integer; begin Result := Canvas.TextHeight('Qq') div 2; if not Odd(Result) then Inc(Result); end; function TdxBarSubMenuControl.GetMaxVisibleCount: Integer; var I: Integer; begin for I := TopIndex to ItemLinks.VisibleItemCount - 1 do if ItemLinks.VisibleItems[I].ItemRect.Bottom = 0 then begin Result := I - TopIndex; Exit; end; Result := ItemLinks.VisibleItemCount - TopIndex; end; function TdxBarSubMenuControl.GetToolbarItemsBrush: HBRUSH; begin Result := PainterClass.SubMenuControlToolbarItemsBrush(Self); end; procedure TdxBarSubMenuControl.SetDetachCaptionSelected(Value: Boolean); begin if IsCustomizing or (GetCapture <> 0) then Exit; if FDetachCaptionSelected <> Value then begin if Value then FinishMouseTracking(Handle); FDetachCaptionSelected := Value; InvalidateDetachCaption; if Value then StartMouseTracking(Handle); SetCursorForMoving(Value); if Value then BarManager.HintActivate(True, cxGetResourceString(@dxSBAR_DRAGTOMAKEMENUFLOAT)) else if SelectedItem = nil then BarManager.HintActivate(False, ''); end; end; procedure TdxBarSubMenuControl.SetTopIndex(Value: Integer); begin if Value < 0 then Value := 0; if FTopIndex <> Value then begin FTopIndex := Value; Repaint; end; end; procedure TdxBarSubMenuControl.CalcControlsPositions(Size: PPoint); var ARecentItemCount: Integer; AExtendedView: Boolean; R: TRect; I, AClientHeight, W: Integer; LastWasRecentItem: Boolean; AItemLink: TdxBarItemLink; begin ItemLinks.EmptyItemRects; ARecentItemCount := ItemLinks.MostRecentItemCount; if ARecentItemCount = -1 then ARecentItemCount := ItemLinks.CanVisibleItemCount; AExtendedView := ExtendedView; PainterClass.SubMenuControlCalcRect(Self, Size, R, AClientHeight); LastWasRecentItem := True; for I := TopIndex to ItemLinks.VisibleItemCount - 1 do begin AItemLink := ItemLinks.VisibleItems[I]; AItemLink.Control.FNonRecent := AExtendedView and (AItemLink.RecentIndex >= ARecentItemCount); AItemLink.Control.FChangeRecentGroup := AExtendedView and ((I > TopIndex) or Detachable) and (AItemLink.Control.FNonRecent = LastWasRecentItem); if AItemLink.Control.FChangeRecentGroup and PainterClass.SubMenuControlIsOffsetRecentGroupNeeded then Inc(R.Top); if AItemLink.BeginGroup and (I > TopIndex) and not (UpArrowExists and (I = TopIndex + 1)) then Inc(R.Top, BeginGroupSize); R.Bottom := R.Top + AItemLink.Control.Height; if R.Bottom > AClientHeight then Break; if Size <> nil then begin W := AItemLink.Control.Width; if W > Size^.X then Size^.X := W; end; LastWasRecentItem := not AItemLink.Control.FNonRecent; AItemLink.ItemRect := R; R.Top := R.Bottom; end; if Size <> nil then PainterClass.SubMenuControlCalcSize(Self, Size, R); end; procedure TdxBarSubMenuControl.CreateLightBrush; var Color: COLORREF; R, G, B: Integer; DC: HDC; LogPalette: TLogPalette; begin Color := GetSysColor(COLOR_BTNFACE); R := GetRValue(Color) + dxBarNonrecentlyUsedItemsColorDelta; if R > 255 then R := 255; G := GetGValue(Color) + dxBarNonrecentlyUsedItemsColorDelta; if G > 255 then G := 255; B := GetBValue(Color) + dxBarNonrecentlyUsedItemsColorDelta; if B > 255 then B := 255; DC := GetDC(0); if BarManager.ShowRecentItemsFirst and (GetDeviceCaps(DC, BITSPIXEL) <= 8) then begin with LogPalette do begin palVersion := $0300; palNumEntries := 1; with palPalEntry[0] do begin peRed := R; peGreen := G; peBlue := B; peFlags := 0; end; end; FLightPalette := CreatePalette(LogPalette); FLightBrush := CreateSolidBrush(PaletteIndex(0)); end else begin Color := RGB(R, G, B); FLightBrush := CreateSolidBrush(Color); end; ReleaseDC(0, DC); end; procedure TdxBarSubMenuControl.DestroyLightBrush; begin if FLightBrush <> 0 then begin DeleteObject(FLightBrush); FLightBrush := 0; end; if FLightPalette <> 0 then begin DeleteObject(FLightPalette); FLightPalette := 0; end; end; procedure TdxBarSubMenuControl.PreparePalette(DC: HDC); begin if FLightPalette <> 0 then begin SelectPalette(DC, FLightPalette, True); RealizePalette(DC); end; end; procedure TdxBarSubMenuControl.UnpreparePalette(DC: HDC); begin if FLightPalette <> 0 then begin SelectPalette(DC, GetStockObject(DEFAULT_PALETTE), True); RealizePalette(DC); end; end; procedure TdxBarSubMenuControl.ExpandMenu; begin if MarkExists then begin ShowFullMenus := True; FShowAnimation := True; FExpandingMenu := True; try DestroyWnd; finally FExpandingMenu := False; end; Left := FOnShowLeft; Top := FOnShowTop; Show; end; end; function TdxBarSubMenuControl.ExtendedView: Boolean; begin Result := BarManager.ShowRecentItemsFirst and ShowFullMenus; end; procedure TdxBarSubMenuControl.InvalidateDetachCaption; var DC: HDC; begin DC := GetWindowDC(Handle); PainterClass.SubMenuControlDrawDetachCaption(Self, DC, DetachCaptionRect); ReleaseDC(Handle, DC); end; function TdxBarSubMenuControl.MouseOnUpArrow: Boolean; var P: TPoint; R: TRect; begin GetCursorPos(P); Windows.ScreenToClient(Handle, P); R := GetItemRect(ItemLinks.CanVisibleItems[TopIndex].Control); Result := PtInRect(R, P); end; function TdxBarSubMenuControl.MouseOnDownArrow: Boolean; var P: TPoint; R: TRect; begin GetCursorPos(P); Windows.ScreenToClient(Handle, P); R := GetItemRectEx(ItemLinks.VisibleItems[TopIndex + MaxVisibleCount - 1].Control, True); R.Bottom := ClientHeight - 2; if MarkExists then Dec(R.Bottom, TextSize); Result := PtInRect(R, P); end; function TdxBarSubMenuControl.MouseOnMark: Boolean; var P: TPoint; begin GetCursorPos(P); Windows.ScreenToClient(Handle, P); Result := PtInRect(MarkRect, P); end; procedure ExpandMenuTimerProc(Wnd: HWND; Msg: UINT; idEvent: UINT; Time: DWORD); stdcall; begin with TdxBarSubMenuControl(FindControl(Wnd)) do begin KillExpandMenuTimer; if idEvent = 3 then MarkState := msPressed else if ChildBar = nil then MarkState := msSelected; end; end; procedure TdxBarSubMenuControl.SetExpandMenuTimer(Time: UINT; ExpandAfterDelay: Boolean); begin FExpandMenuTimer := SetTimer(Handle, 2 + Byte(ExpandAfterDelay), Time, @ExpandMenuTimerProc); end; procedure TdxBarSubMenuControl.KillExpandMenuTimer; begin if FExpandMenuTimer <> 0 then begin KillTimer(Handle, FExpandMenuTimer); FExpandMenuTimer := 0; end; end; procedure TdxBarSubMenuControl.WMGetDlgCode; begin Message.Result := DLGC_WANTALLKEYS or DLGC_WANTARROWS or DLGC_WANTTAB; end; procedure TdxBarSubMenuControl.WMKeyDown(var Message: TWMKeyDown); var ALinkSelf: TcxObjectLink; Shift: TShiftState; ParentBarControl: TCustomdxBarControl; begin TerminateAnimation(Self); Shift := KeyDataToShiftState(Message.KeyData); if (Message.CharCode in [VK_DOWN, VK_TAB]) and MarkExists then if (Message.CharCode = VK_DOWN) and (Shift = [ssCtrl]) then begin MarkState := msPressed; Exit; end else if (Shift = []) and (SelectedItem <> nil) then with SelectedItem.ItemLink do if VisibleIndex = Owner.VisibleItemCount - 1 then begin MarkState := msPressed; SendMessage(Handle, WM_KEYDOWN, Message.CharCode, 1); Exit; end; ALinkSelf := cxAddObjectLink(Self); try inherited; if (ALinkSelf.Ref = nil) or (ActiveBarControl = nil) or SelectedItemWantsKey(Message.CharCode) then Exit; with Message do begin case CharCode of VK_ESCAPE: if (ParentBar <> nil) and (ParentBar.FSelectedItem <> nil) then begin ParentBarControl := ParentBar; ParentBarControl.FSelectedItem.ControlInactivate(True); if ParentBarControl is TdxBarControl then TdxBarControl(ParentBarControl).IsDowned := False; end else Hide; VK_LEFT: begin if ParentBar <> nil then ParentBarControl := ParentBar else if FDropDownButton <> nil then ParentBarControl := FDropDownButton.Parent else ParentBarControl := nil; if (ParentBarControl <> nil) and (ParentBarControl.SelectedItem <> nil) then if ParentBarControl is TdxBarSubMenuControl then ParentBarControl.SelectedItem.ControlInactivate(True) else begin ParentBarControl := GetParentBarForBar(Self); if ParentBarControl <> nil then if IsRealVertical(ParentBarControl) then Message.Result := SendMessage(Handle, WM_KEYDOWN, VK_ESCAPE, 0) else Message.Result := SendMessage(ParentBarControl.Handle, WM_KEYDOWN, VK_LEFT, 0); end; end; VK_RIGHT: begin ParentBarControl := GetParentBarForBar(Self); if ParentBarControl <> nil then Message.Result := SendMessage(ParentBarControl.Handle, WM_KEYDOWN, VK_RIGHT, 0); end; VK_RETURN: if SelectedItem <> nil then SelectedItem.Click(False); end; end; finally cxRemoveObjectLink(ALinkSelf); end; end; procedure TdxBarSubMenuControl.WMLButtonDown(var Message: TWMLButtonDown); begin if FScrollTimerId <> 0 then Exit; inherited; if not BarControlExists(Self) then Exit; if FIgnoreMouseClick then Exit; TerminateAnimation(Self); if DetachCaptionSelected then DoDetachMenu else if MarkExists and MouseOnMark then if MarkState = msNone then begin SetKeySelectedItem(nil); MarkState := msSelected; end else begin // FIgnoreMouseClick := True; MarkState := msPressed; end; end; procedure EndScrollingSubMenu(Wnd: HWND); var P: TPoint; begin with TdxBarSubMenuControl(FindControl(Wnd)) do begin KillTimer(Handle, FScrollTimerId); FScrollTimerId := 0; FLastMousePos := Point(-1, -1); GetCursorPos(P); if BarManager.Dragging then begin Windows.ScreenToClient(BarManager.MainForm.Handle, P); PostMessage(BarManager.MainForm.Handle, WM_MOUSEMOVE, 0, MakeLParam(P.X, P.Y)); end else begin Windows.ScreenToClient(Handle, P); SendMessage(Handle, WM_MOUSEMOVE, 0, MakeLParam(P.X, P.Y)); end; end; end; procedure UpArrowTimerProc(Wnd: HWND; Msg: UINT; idEvent: UINT; Time: DWORD); stdcall; begin with TdxBarSubMenuControl(FindControl(Wnd)) do if UpArrowExists and MouseOnUpArrow then TopIndex := TopIndex - 1 else EndScrollingSubMenu(Wnd); end; procedure DownArrowTimerProc(Wnd: HWND; Msg: UINT; idEvent: UINT; Time: DWORD); stdcall; begin with TdxBarSubMenuControl(FindControl(Wnd)) do if DownArrowExists and MouseOnDownArrow then TopIndex := TopIndex + 1 else EndScrollingSubMenu(Wnd); end; procedure TdxBarSubMenuControl.WMMouseLeave(var Message: TMessage); begin DetachCaptionSelected := False; inherited; end; procedure TdxBarSubMenuControl.WMMouseMove(var Message: TWMMouseMove); var P: TPoint; begin P := SmallPointToPoint(Message.Pos); if not NotHandleMouseMove(P) then begin TerminateAnimation(Self); if not BarControlExists(Self) then Exit; end else if AnimatingSubMenu = Self then Exit; if WantMouse and (FSubItem <> nil) and (ParentBar <> nil) then ParentBar.SetMouseSelectedItem(FSubItem); if Detachable then DetachCaptionSelected := MouseOnDetachCaption; if MarkExists then if MouseOnMark then MarkState := msSelected else MarkState := msNone; Windows.ClientToScreen(Handle, P); if UpArrowExists and MouseOnUpArrow then if (FScrollTimerId = 0) and ((FLastMousePos.X <> P.X) or (FLastMousePos.Y <> P.Y)) then begin if SelectedItem = BarManager.SelectedItem then BarManager.FSelectedItem := nil; // otherwise BarManager will hide all SetKeySelectedItem(nil); FScrollTimerId := SetTimer(Handle, 1, dxBarScrollMenuTime, @UpArrowTimerProc); end else else if DownArrowExists and MouseOnDownArrow then if (FScrollTimerId = 0) and ((FLastMousePos.X <> P.X) or (FLastMousePos.Y <> P.Y)) then begin if SelectedItem = BarManager.SelectedItem then BarManager.FSelectedItem := nil; // otherwise BarManager will hide all SetKeySelectedItem(nil); FScrollTimerId := SetTimer(Handle, 1, dxBarScrollMenuTime, @DownArrowTimerProc); end else else begin if FScrollTimerId > 0 then begin KillTimer(Handle, FScrollTimerId); FScrollTimerId := 0; FLastMousePos := Point(-1, -1); end; inherited; end; end; procedure TdxBarSubMenuControl.WMNCCalcSize(var Message: TWMNCCalcSize); begin inherited; with Message.CalcSize_Params^ do begin InflateRect(rgrc[0], -1, -1); if Detachable then Inc(rgrc[0].Top, DetachCaptionAreaSize); end; end; procedure TdxBarSubMenuControl.WMNCHitTest(var Message: TWMNCHitTest); var R: TRect; begin if Detachable then begin R := DetachCaptionRect; OffsetRect(R, Left, Top); if PtInRect(R, SmallPointToPoint(Message.Pos)) then Message.Result := HTCLIENT else inherited; end else inherited; end; procedure TdxBarSubMenuControl.WMNCPaint(var Message: TWMNCPaint); var DC: HDC; begin inherited; DC := GetWindowDC(Handle); NCPaint(DC); ReleaseDC(Handle, DC); end; procedure TdxBarSubMenuControl.WMPrint(var Message: TMessage); begin inherited; NCPaint(Message.WParam); end; procedure TdxBarSubMenuControl.WMPrintClient(var Message: TMessage); begin inherited; PaintWindow(Message.WParam); end; procedure TdxBarSubMenuControl.WMRButtonDown(var Message: TWMRButtonUp); begin inherited; if IsContextMenu then with TMessage(Message) do SendMessage(Handle, WM_LBUTTONDOWN, WParam, LParam); end; procedure TdxBarSubMenuControl.WMRButtonUp(var Message: TWMRButtonUp); begin inherited; if IsContextMenu then with TMessage(Message) do SendMessage(Handle, WM_LBUTTONUP, WParam, LParam); end; procedure TdxBarSubMenuControl.CMFontChanged(var Message: TMessage); begin inherited; Canvas.Font := Font; CalcDrawingConsts; end; procedure TdxBarSubMenuControl.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin Style := WS_CLIPCHILDREN or WS_CLIPSIBLINGS or WS_POPUP; ExStyle := ExStyle or WS_EX_TOPMOST; WindowClass.Style := CS_DBLCLKS or CS_HREDRAW or CS_VREDRAW or CS_OWNDC or CS_SAVEBITS; if ParentWnd > 0 then WndParent := ParentWnd else WndParent := BarManager.MainForm.Handle; end; end; function AnimationThreadProc(lpParameter: Pointer): DWORD; stdcall; var I: Integer; FirstTime: DWORD; DC: HDC; procedure DoOneStepOfAnimation; var NewLeft, NewTop, NewClientWidth, NewClientHeight: Integer; R, R1, R2: TRect; begin with AnimatingSubMenu, AnimationInfo do begin begin if FirstValue >= 0 then begin NewClientWidth := Step * I; NewClientHeight := FirstValue + NewClientWidth; if MenuAnimations = maSlide then NewClientWidth := ClientWidth; end else begin NewClientHeight := Step * I; NewClientWidth := Abs(FirstValue) + NewClientHeight; end; if LeftDirection then NewLeft := Left - (NewClientWidth - ClientWidth) else NewLeft := Left; if TopDirection then NewTop := Top - (NewClientHeight - ClientHeight) else NewTop := Top; SetWindowPos(Handle, 0, NewLeft, NewTop, BorderWidth + NewClientWidth, BorderHeight + NewClientHeight, SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW); DC := GetDC(Handle); PreparePalette(DC); R1 := OldClientRect; if TopDirection then begin R := Rect(0, 0, NewClientWidth, NewClientHeight); OffsetRect(R1, 0, NewClientHeight - R1.Bottom); with OldClientRect do BitBlt(DC, Left, Top, Right - Left, Bottom - Top, DC, R1.Left, R1.Top, SRCCOPY); R1 := OldClientRect; BitBlt(DC, 0, R1.Bottom, ClientWidth, ClientHeight - R1.Bottom, AnimationBitmapDC, R.Left, R.Top + R1.Bottom, SRCCOPY); BitBlt(DC, R1.Right, R1.Top, ClientWidth - R1.Right, R1.Bottom - R1.Top, AnimationBitmapDC, R.Left + R1.Right, R.Top, SRCCOPY); end else if LeftDirection then begin R := Rect(RealClientWidth - ClientWidth, RealClientHeight - ClientHeight, RealClientWidth, RealClientHeight); OffsetRect(R1, ClientWidth - R1.Right, 0); R2 := R1; OffsetRect(R2, 0, ClientHeight - R1.Bottom); with R2 do BitBlt(DC, Left, Top, Right - Left, Bottom - Top, DC, R1.Left, R1.Top, SRCCOPY); R1 := R2; BitBlt(DC, 0, 0, ClientWidth, R1.Top, AnimationBitmapDC, R.Left, R.Top, SRCCOPY); BitBlt(DC, 0, R1.Top, R1.Left, ClientHeight - R1.Top, AnimationBitmapDC, R.Left, R.Top + R1.Top, SRCCOPY); end else begin R := Rect(0, RealClientHeight - ClientHeight, ClientWidth, RealClientHeight); OffsetRect(R1, 0, ClientHeight - R1.Bottom); with R1 do BitBlt(DC, Left, Top, Right - Left, Bottom - Top, DC, OldClientRect.Left, OldClientRect.Top, SRCCOPY); BitBlt(DC, 0, 0, ClientWidth, R1.Top, AnimationBitmapDC, R.Left, R.Top, SRCCOPY); BitBlt(DC, R1.Right, R1.Top, ClientWidth - R1.Right, ClientHeight - R1.Top, AnimationBitmapDC, R.Left + R1.Right, R.Top + R1.Top, SRCCOPY); end; OldClientRect := ClientRect; UnpreparePalette(DC); UpdateColors(DC); ReleaseDC(Handle, DC); end; end; end; begin Result := 0; with AnimationInfo do for I := 1 to Delta div Step do begin if KillingAnimation then Break; FirstTime := GetTickCount; DoOneStepOfAnimation; Sleep(1); while (GetTickCount - FirstTime < 1) and not KillingAnimation do; end; DeleteObject(SelectObject(AnimationBitmapDC, AnimationBitmap)); DeleteDC(AnimationBitmapDC); with AnimatingSubMenu, AnimationInfo do begin FShowAnimation := False; if not FDestroyFlag then SetWindowPos(Handle, 0, RealLeft, RealTop, BorderWidth + RealClientWidth, BorderHeight + RealClientHeight, SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_FRAMECHANGED {to enforce WM_WINDOWPOSCHANGED}); if not FDestroyFlag then Repaint; end; AnimatingSubMenu := nil; AnimationThread := 0; KillingAnimation := False; CloseHandle(AnimationThread); end; procedure TdxBarSubMenuControl.CreateWnd; var ChangeXDirection, ChangeYDirection: Boolean; AnimationThreadID: DWORD; begin //ProcessPaintMessages; - destroys submenu because of PeekMessage CreateLightBrush; inherited CreateWnd; FOnShowLeft := Left; FOnShowTop := Top; IsActive := True; SetRecentItemCount; FTopIndex := -1; TopIndex := 0; SetSizeAndCheckBounds(ChangeXDirection, ChangeYDirection); // PlaySound(psMenuPopup); if FShowAnimation then with AnimationInfo do begin //TerminateAnimation(AnimatingSubMenu); {1} RealLeft := Left; RealTop := Top; RealClientWidth := ClientWidth; RealClientHeight := ClientHeight; BorderWidth := Width - ClientWidth; BorderHeight := Height - ClientHeight; LeftDirection := ((XDirection = xdLeft) and not ChangeXDirection) or ((XDirection = xdRight) and ChangeXDirection); TopDirection := ((YDirection = ydTop) and not ChangeYDirection) or ((YDirection = ydBottom) and ChangeYDirection); MenuAnimations := FMenuAnimations; if MenuAnimations = maUnfold then begin FirstValue := ClientHeight - ClientWidth; if FirstValue > 0 then begin OldClientRect := Rect(0, 0, 0, FirstValue); Delta := ClientWidth; end else begin OldClientRect := Rect(0, 0, -FirstValue, 0); Delta := ClientHeight; end; Step := 8; end else if MenuAnimations = maSlide then begin FirstValue := 0; OldClientRect := Rect(0, 0, ClientWidth, 0); Delta := ClientHeight; Step := 17; end else begin FirstValue := 0; Delta := 128; Step := 1; end; AnimationBitmap := CreateCompatibleBitmap(Canvas.Handle, RealClientWidth, RealClientHeight); AnimationBitmapDC := CreateCompatibleDC(Canvas.Handle); AnimationBitmap := SelectObject(AnimationBitmapDC, AnimationBitmap); FShowAnimation := False; PaintWindow(AnimationBitmapDC); FShowAnimation := True; DestroyLightBrush; CreateLightBrush; AnimatingSubMenu := Self; AnimationThread := CreateThread(nil, 0, @AnimationThreadProc, nil, 0, AnimationThreadID); end; PlaySound(psMenuPopup); end; procedure TdxBarSubMenuControl.DestroyWindowHandle; begin if BarManager.Dragging and (BarManager.DraggingItemLink <> nil) and (ItemLinks.IndexOf(BarManager.DraggingItemLink) > -1) and (BarManager.FDraggingItemLinkParentHandle = 0) then begin BarManager.FDraggingItemLinkParentHandle := WindowHandle; Perform(WM_DESTROY, 0, 0); SetWindowLong(WindowHandle, GWL_WNDPROC, Longint(DefWndProc)); ShowWindow(WindowHandle, SW_HIDE); DestroyControls; WindowHandle := 0; end else inherited; end; procedure TdxBarSubMenuControl.DestroyWnd; begin TerminateAnimation(Self); if FScrollTimerId > 0 then begin KillTimer(Handle, FScrollTimerId); FScrollTimerId := 0; end; KillExpandMenuTimer; if (ChildBar <> nil) and not ChildBar.FDestroyFlag and ChildBar.HandleAllocated then ChildBar.DestroyWnd; if not FExpandingMenu then begin IsActive := False; if FDropDownButton <> nil then with FDropDownButton do if Parent.HandleAllocated then begin DoCloseUp; Repaint; if MousePressed then begin Parent.FIgnoreMouseClick := ArrowPressed; if Parent is TdxBarControl then Parent.HideAll; end else if (GetKeyState(VK_ESCAPE) >= 0) and (GetKeyState(VK_LEFT) >= 0) and (GetKeyState(VK_RIGHT) >= 0) then Parent.HideAll; end; end; inherited DestroyWnd; if Self = CustomizedPopup then CustomizedPopup := nil; // ProcessPaintMessages; DoCloseUp; DestroyLightBrush; end; procedure TdxBarSubMenuControl.DoCloseUp; begin if Assigned(FOnCloseUp) then FOnCloseUp(Self); end; procedure TdxBarSubMenuControl.DoPopup; begin if Assigned(FOnPopup) then FOnPopup(Self); end; procedure TdxBarSubMenuControl.Paint; var R, CR, BarRect: TRect; AMaxVisibleCount, I: Integer; DC: HDC; ABrush: HBRUSH; AControl: TdxBarItemControl; begin if FShowAnimation or FDestroyFlag then Exit; DC := Canvas.Handle; ABrush := ToolbarBrush; R := ClientRect; PainterClass.SubMenuControlDrawClientBorder(Self, DC, R, ABrush); InflateRect(R, -1, -1); CR := R; R.Right := R.Left + BarSize; CR.Left := R.Right; BarRect := R; try if ItemLinks.CanVisibleItemCount = 0 then begin FillBackground(DC, CR, ToolbarBrush, clNone, True); Exit; end; CalcControlsPositions(nil); AMaxVisibleCount := GetMaxVisibleCount; if AMaxVisibleCount = 0 then AMaxVisibleCount := 1; PainterClass.SubMenuControlDrawArrowsArea(Self, DC, ABrush, AMaxVisibleCount); for I := 0 to ItemLinks.VisibleItemCount - 1 do begin AControl := ItemLinks.VisibleItems[I].Control; AControl.RealVisibleChanging(((TopIndex + Byte(UpArrowExists)) <= I) and (I <= (TopIndex + AMaxVisibleCount - 1 - Byte(DownArrowExists)))); end; for I := TopIndex + Byte(UpArrowExists) to TopIndex + AMaxVisibleCount - 1 - Byte(DownArrowExists) do begin AControl := ItemLinks.VisibleItems[I].Control; AControl.FLastInRow := False; PaintItem(AControl); end; if DownArrowExists and (TopIndex + AMaxVisibleCount - 2 >= 0) then ItemLinks.VisibleItems[TopIndex + AMaxVisibleCount - 2].Control.FLastInRow := True else ItemLinks.VisibleItems[ItemLinks.VisibleItemCount - 1].Control.FLastInRow := True; finally DrawBar(BarRect); end; end; procedure TdxBarSubMenuControl.NCPaint(DC: HDC); var R: TRect; begin GetWindowRect(R); OffsetRect(R, -R.Left, -R.Top); PainterClass.SubMenuControlDrawBorder(Self, DC, R); end; procedure TdxBarSubMenuControl.CalcDrawingConsts; begin inherited; PainterClass.SubMenuControlCalcDrawingConsts(Self, FTextSize, FMenuArrowWidth, FMarkSize, FNormalItemHeight); end; function TdxBarSubMenuControl.CanCustomizing: Boolean; begin Result := inherited CanCustomizing or (ItemLinks.Owner is TdxBarSubItem) and TdxBarSubItem(ItemLinks.Owner).AllowCustomizing or (ItemLinks.Owner is TdxBarPopupMenu); end; function TdxBarSubMenuControl.ChildrenHaveShadows: Boolean; begin Result := False; end; procedure TdxBarSubMenuControl.CreateControls; var FDoneItems: TList; I: Integer; AItemLink: TdxBarItemLink; FirstCall, HideWhenRun: Boolean; begin if (FItemLinks <> nil) and not IsCustomizing and not FDestroyingControls then begin FDoneItems := TList.Create; try I := 0; while I <= FItemLinks.CanVisibleItemCount - 1 do begin AItemLink := FItemLinks.CanVisibleItems[I]; if AItemLink.Item is TCustomdxBarContainerItem then begin if FSavedItemLinks = nil then FSavedItemLinks := TList.Create; FSavedItemLinks.Count := AItemLink.Index + 1; FSavedItemLinks[AItemLink.Index] := AItemLink; FirstCall := FDoneItems.IndexOf(AItemLink.Item) = -1; if FirstCall then FDoneItems.Add(AItemLink.Item); HideWhenRun := TCustomdxBarContainerItem(AItemLink.Item).HideWhenRun; if HideWhenRun then AItemLink.SaveRecentIndex; TCustomdxBarContainerItem(AItemLink.Item).AddListedItemLinks(FItemLinks, AItemLink.Index + 1, FirstCall, AItemLink); if HideWhenRun then begin AItemLink.SendToBottomInRecentList; AItemLink.Collection := nil; Dec(I); end; end; Inc(I); end; finally FDoneItems.Free; end; end; inherited; end; procedure TdxBarSubMenuControl.DestroyControls; var I: Integer; HideWhenRun: Boolean; begin inherited; if not IsCustomizing and (FSavedItemLinks <> nil) and not FDestroyingControls then begin FDestroyingControls := True; try for I := FSavedItemLinks.Count - 1 downto 0 do if FSavedItemLinks[I] <> nil then with TdxBarItemLink(FSavedItemLinks[I]) do begin HideWhenRun := TCustomdxBarContainerItem(Item).HideWhenRun; TCustomdxBarContainerItem(Item).DeleteListedItemLinks(FItemLinks, I + Byte(not HideWhenRun)); if HideWhenRun then begin Collection := FItemLinks; Index := I; RestoreRecentIndex; end; end; for I := 0 to FSavedItemLinks.Count - 1 do if FSavedItemLinks[I] <> nil then TCustomdxBarContainerItem(TdxBarItemLink(FSavedItemLinks[I]).Item).NeedClearItemList; finally FSavedItemLinks.Free; FSavedItemLinks := nil; FDestroyingControls := False; end; end; end; procedure TdxBarSubMenuControl.DrawBar(const R: TRect); begin if BarManager.Designing then DrawVerticalGradient(Canvas, R, 0, 0, 0, 0, 0, 255) else if ItemLinks.Owner is TdxBarPopupMenu then TdxBarPopupMenu(ItemLinks.Owner).DoPaintBar(Canvas, R) else if ItemLinks.Owner is TCustomdxBarSubItem then TCustomdxBarSubItem(ItemLinks.Owner).DoPaintBar(Canvas, R); end; function TdxBarSubMenuControl.GetBeginGroupSize: Integer; begin Result := PainterClass.SubMenuControlBeginGroupSize; end; function TdxBarSubMenuControl.GetEditFontHandle: HFONT; begin if ParentBar = nil then if (ItemLinks.Owner is TdxBarPopupMenu) and TdxBarPopupMenu(ItemLinks.Owner).UseOwnFont then Result := TdxBarPopupMenu(ItemLinks.Owner).FEditFontHandle else Result := inherited GetEditFontHandle else Result := ParentBar.GetEditFontHandle; end; function TdxBarSubMenuControl.GetIsContextMenu: Boolean; begin Result := (OwnerWidth = 0) and (OwnerHeight = 0) or (ParentBar is TdxBarSubMenuControl) and TdxBarSubMenuControl(ParentBar).IsContextMenu; end; function TdxBarSubMenuControl.GetIsCustomizing: Boolean; begin if (FSubItem <> nil) and (FSubItem.ItemLink.Item is TdxBarSubItem) and TdxBarSubItem(FSubItem.ItemLink.Item).IsInternal then Result := False else Result := inherited GetIsCustomizing; end; function TdxBarSubMenuControl.GetIsShadowVisible: Boolean; begin Result := inherited GetIsShadowVisible and not FShowAnimation; end; function TdxBarSubMenuControl.GetItemRectEx(Item: TdxBarItemControl; IsBeginGroup: Boolean): TRect; var AIndex: Integer; begin Result := inherited GetItemRectEx(Item, IsBeginGroup); if Item <> nil then begin if Item.FChangeRecentGroup and PainterClass.SubMenuControlIsOffsetRecentGroupNeeded then Dec(Result.Top); if IsBeginGroup and Item.ItemLink.BeginGroup then begin AIndex := Item.ItemLink.VisibleIndex; if (AIndex > TopIndex) and not (UpArrowExists and (AIndex = TopIndex + 1)) then Dec(Result.Top, BeginGroupSize); end; end; end; function TdxBarSubMenuControl.HideOnClick: Boolean; begin Result := True; end; function TdxBarSubMenuControl.ItemAtPosEx(Pos: TPoint; var IsBeginGroup, IsFirstPart, IsVerticalDirection: Boolean): TdxBarItemControl; begin if UpArrowExists and MouseOnUpArrow or DownArrowExists and MouseOnDownArrow or MarkExists and MouseOnMark then Result := nil else Result := inherited ItemAtPosEx(Pos, IsBeginGroup, IsFirstPart, IsVerticalDirection); end; procedure TdxBarSubMenuControl.PaintItem(AControl: TdxBarItemControl); var AIndex, LeftDelta: Integer; AItemRect: TRect; DC: HDC; ANonRecent: Boolean; begin if FDestroyFlag or (AControl.ItemLink.Control = nil) then Exit; inherited; AItemRect := GetItemRect(AControl); if IsRectEmpty(AItemRect) then begin SetRectEmpty(AControl.FBeginGroupRect); Exit; end; DC := Canvas.Handle; ANonRecent := not PainterClass.IgnoreNonRecentColor and AControl.FNonRecent; if ANonRecent then begin PreparePalette(DC); FBkBrush := FLightBrush; end else PainterClass.SubMenuControlPrepareBkBrush(Self, FBkBrush); AIndex := AControl.ItemLink.VisibleIndex; LeftDelta := Ord(BarSize = 0); if AControl.ItemLink.BeginGroup and (AIndex > TopIndex) and not (UpArrowExists and (AIndex = TopIndex + 1)) then PainterClass.SubMenuControlDrawBeginGroup(Self, AControl, DC, AItemRect, LeftDelta) else SetRectEmpty(AControl.FBeginGroupRect); PainterClass.SubMenuControlDrawItemFrame(Self, AControl, DC, AItemRect, AIndex, LeftDelta); AControl.Paint(AItemRect, ptMenu); DrawSelectedItem(AControl); if ANonRecent then UnpreparePalette(DC); end; procedure TdxBarSubMenuControl.SetFont; begin if ParentBar = nil then if ItemLinks.Owner is TdxBarPopupMenu then Font := TdxBarPopupMenu(ItemLinks.Owner).Font else Font := BarManager.Font else Font := ParentBar.Font; end; procedure TdxBarSubMenuControl.SetIsActive(Value: Boolean); var PrevIsActive: Boolean; begin PrevIsActive := IsActive; inherited; if not BarControlExists(Self) then Exit; if IsActive and not PrevIsActive and BarManager.ShowRecentItemsFirst and not ShowFullMenus and BarManager.ShowFullMenusAfterDelay then SetExpandMenuTimer(dxBarSlowExpandMenuTime, True); end; procedure TdxBarSubMenuControl.SetLayeredAttributes; begin end; procedure TdxBarSubMenuControl.SetMarkState(Value: TdxBarMarkState); var R: TRect; begin if IsCustomizing or not BarManager.ShowRecentItemsFirst then Exit; if (Value = msSelected) and (SelectedItem is TdxBarWinControl) and TdxBarWinControl(SelectedItem).Focused then Value := msNone; if FMarkState <> Value then begin FMarkState := Value; if Value = msPressed then ExpandMenu else begin R := MarkRect; InvalidateRect(Handle, @R, False); end; if BarManager.ShowFullMenusAfterDelay then begin KillExpandMenuTimer; if (FMarkState = msSelected) and MouseOnMark then SetExpandMenuTimer(dxBarWaitForShowHintTime, True); end else if FMarkState = msSelected then BarManager.HintActivate(True, cxGetResourceString(@dxSBAR_EXPAND)) else BarManager.HintActivate(False, ''); end; end; procedure TdxBarSubMenuControl.SetRecentItemCount; begin with ItemLinks do if BarManager.ShowRecentItemsFirst and not ShowFullMenus then RecentItemCount := MostRecentItemCount else RecentItemCount := -1; end; procedure TdxBarSubMenuControl.SetSelectedItem(Value: TdxBarItemControl); var AIndex: Integer; begin if MarkState = msNone then begin KillExpandMenuTimer; if IsActive and BarManager.ShowRecentItemsFirst and not ShowFullMenus and BarManager.ShowFullMenusAfterDelay then SetExpandMenuTimer(dxBarSlowExpandMenuTime, False); end; if Value <> nil then begin AIndex := Value.ItemLink.VisibleIndex; if UpArrowExists and (AIndex <= TopIndex) then TopIndex := AIndex - 1 else if DownArrowExists and (AIndex >= TopIndex + MaxVisibleCount - 1) then begin repeat Inc(FTopIndex); CalcControlsPositions(nil); until AIndex <= TopIndex + MaxVisibleCount - 1 - Byte(DownArrowExists); Repaint; end; end; inherited SetSelectedItem(Value); end; procedure TdxBarSubMenuControl.SetSizeAndCheckBounds(var ChangeXDirection, ChangeYDirection: Boolean); var Size: TPoint; R: TRect; begin CalcControlsPositions(@Size); R := GetWorkArea(Point(Left, Top)); ChangeXDirection := False; ChangeYDirection := False; if Left + Size.X > R.Right then if OwnerWidth = 0 then Left := R.Right - Size.X else if Left - OwnerWidth - R.Left > R.Right - Left then begin Left := Left - OwnerWidth - Size.X; ChangeXDirection := True; end; if Left < R.Left then if OwnerWidth = 0 then Left := R.Left else if (XDirection = xdLeft) and (R.Right - (Left + Size.X + OwnerWidth) > Left + Size.X - R.Left) then begin Left := Left + Size.X + OwnerWidth; ChangeXDirection := True; end; if Left + Size.X > R.Right then Left := R.Right - Size.X; if Left < R.Left then Left := R.Left; if Top + Size.Y > R.Bottom then if OwnerHeight = 0 then if (OwnerWidth = 0) and (Top - Size.Y >= R.Top) then // for popupmenu begin Top := Top - Size.Y; ChangeYDirection := True; end else Top := R.Bottom - Size.Y else if Top - OwnerHeight - R.Top > R.Bottom - Top then begin Top := Top - OwnerHeight - Size.Y; ChangeYDirection := True; end else Size.Y := R.Bottom - Top; if Top < R.Top then if YDirection = ydBottom then if ChangeYDirection and (OwnerHeight <> 0) then begin Size.Y := Size.Y - (R.Top - Top); Top := R.Top; end else begin Top := R.Top; if Top + Size.Y > R.Bottom then Size.Y := R.Bottom - Top; end else if (OwnerHeight <> 0) and (R.Bottom - (Top + Size.Y + OwnerHeight) > Top + Size.Y - R.Top) then begin Top := Top + Size.Y + OwnerHeight; if Top + Size.Y > R.Bottom then Size.Y := R.Bottom - Top; ChangeYDirection := True; end; SetBounds(Left, Top, Size.X, Size.Y); end; function TdxBarSubMenuControl.CanDetach: Boolean; begin Result := Detachable and (FSubItem.Item.GetDetachingBar <> nil) and ((GetParentBarForBar(FSubItem.Parent) = nil) or (GetParentBarForBar(FSubItem.Parent) <> FSubItem.Item.GetDetachingBar.Control)); end; function TdxBarSubMenuControl.Detachable: Boolean; begin Result := (FSubItem <> nil) and FSubItem.Item.Detachable; end; function TdxBarSubMenuControl.DetachCaptionAreaSize: Integer; begin Result := PainterClass.SubMenuControlDetachCaptionAreaSize(Self); end; function TdxBarSubMenuControl.DetachCaptionRect: TRect; begin GetWindowRect(Result); with Result do OffsetRect(Result, -Left, -Top); PainterClass.SubMenuControlOffsetDetachCaptionRect(Self, Result); with Result do Bottom := Top + DetachCaptionSize; end; function TdxBarSubMenuControl.MouseOnDetachCaption: Boolean; var P: TPoint; begin GetCursorPos(P); with P do begin Dec(X, Left); Dec(Y, Top); end; Result := PtInRect(DetachCaptionRect, P); end; procedure TdxBarSubMenuControl.DoDetachMenu; var ADetachingBar: TdxBar; ASubItem: TdxBarSubItemControl; NonDetachableArea: TRect; Success, Started: Boolean; PrevP, P: TPoint; CaptureWnd: HWND; Msg: TMsg; ABarManager: TdxBarManager; begin FSubItem.Item.DoDetaching; if not CanDetach then Exit; ADetachingBar := FSubItem.Item.GetDetachingBar; ASubItem := FSubItem; NonDetachableArea := DetachCaptionRect; OffsetRect(NonDetachableArea, Left, Top); InflateRect(NonDetachableArea, DetachAreaDelta, DetachAreaDelta); Success := False; Started := False; GetCursorPos(PrevP); ABarManager := BarManager; // if self is will destroyed ABarManager.FDetachingSubMenu := True; CaptureWnd := ParentBar.Handle; SetCapture(CaptureWnd); try while GetCapture = CaptureWnd do begin case Integer(GetMessage(Msg, 0, 0, 0)) of -1: Break; 0: begin PostQuitMessage(Msg.wParam); Break; end; end; case Msg.message of WM_KEYDOWN, WM_KEYUP: if Msg.wParam = VK_ESCAPE then begin ASubItem.ControlActivate(True); Break; end; WM_MOUSEMOVE: begin P := SmallPointToPoint(TSmallPoint(Msg.lParam)); Windows.ClientToScreen(Msg.hwnd, P); if (P.X <> PrevP.X) or (P.Y <> PrevP.Y) then begin if not Started and not PtInRect(NonDetachableArea, P) then begin ASubItem.ControlInactivate(True); if ADetachingBar.DockingStyle <> dsNone then begin ADetachingBar.Visible := False; ADetachingBar.DockingStyle := dsNone; end; if not ADetachingBar.Visible then begin ADetachingBar.FloatLeft := P.X - 100; ADetachingBar.FloatTop := P.Y - ABarManager.PainterClass.BarCaptionAreaSize div 2; ADetachingBar.Visible := True; end; Started := True; end; if Started then if PtInRect(NonDetachableArea, P) then begin ADetachingBar.Visible := False; ASubItem.ControlActivate(True); Break; end else with ADetachingBar.Control do SetWindowPos(Handle, 0, P.X - Width div 2, P.Y - ABarManager.PainterClass.BarCaptionAreaSize div 2, 0, 0, SWP_NOZORDER or SWP_NOSIZE or SWP_NOACTIVATE); PrevP := P; end; end; WM_LBUTTONUP: begin Success := True; Break; end; else TranslateMessage(Msg); DispatchMessage(Msg); end; end; finally if GetCapture = CaptureWnd then ReleaseCapture; if Started then if Success then ADetachingBar.BarManager.HideAll else ADetachingBar.Visible := False; ADetachingBar.BarManager.FDetachingSubMenu := False; end; end; function TdxBarSubMenuControl.MarkArrowSize: Integer; begin Result := PainterClass.SubMenuControlMarkArrowSize(Self, FMarkSize); end; function TdxBarSubMenuControl.MarkExists: Boolean; begin Result := BarManager.ShowRecentItemsFirst and (ItemLinks.VisibleItemCount < ItemLinks.CanVisibleItemCount); end; function TdxBarSubMenuControl.MarkRect: TRect; var AOffset: Integer; begin Result := ClientRect; AOffset := PainterClass.SubMenuControlMarkRectOffset(Self); with Result do begin Inc(Left, AOffset + BarSize); Dec(Right, AOffset); Dec(Bottom, AOffset); Top := Bottom - MarkSize; end; end; function TdxBarSubMenuControl.DownArrowExists: Boolean; begin Result := ItemLinks.VisibleItemCount - TopIndex > MaxVisibleCount; end; function TdxBarSubMenuControl.UpArrowExists: Boolean; begin Result := TopIndex > 0; end; function TdxBarSubMenuControl.VisibleCount: Integer; begin Result := MaxVisibleCount - Byte(UpArrowExists) - Byte(DownArrowExists); end; procedure TdxBarSubMenuControl.FillBackground(DC: HDC; ARect: TRect; ABrush: HBRUSH; AColor: TColor; AIsClientArea: Boolean); begin PainterClass.SubMenuControlDrawBackground(Self, DC, ARect, ABrush, AColor); end; function TdxBarSubMenuControl.GetBackgroundBitmap: TBitmap; begin Result := BarManager.Backgrounds.SubMenu; if (ItemLinks.Owner is TdxBarPopupMenu) and not TdxBarPopupMenu(ItemLinks.Owner).BackgroundBitmap.Empty then Result := TdxBarPopupMenu(ItemLinks.Owner).BackgroundBitmap; end; function TdxBarSubMenuControl.GetIndent1: Integer; begin // WARNING: sync with TdxBarButtonControl.GetDefaultHeight Result := TextSize + BarSize + 2; PainterClass.CorrectButtonControlDefaultHeight(Result); end; function TdxBarSubMenuControl.GetIndent2: Integer; begin // WARNING: sync with TdxBarButtonControl.GetDefaultHeight if IsInternal then begin Result := TextSize; PainterClass.CorrectButtonControlDefaultHeight(Result); end else Result := 0; end; function TdxBarSubMenuControl.IsTransparent: Boolean; begin if (ItemLinks.Owner is TdxBarPopupMenu) and not TdxBarPopupMenu(ItemLinks.Owner).BackgroundBitmap.Empty then Result := True else Result := not BarManager.Backgrounds.SubMenu.Empty; end; procedure TdxBarSubMenuControl.Hide; begin if not FDestroyFlag then begin FDestroyFlag := True; if HandleAllocated then DestroyWnd; Free; end; end; procedure TdxBarSubMenuControl.HideAll; begin if ParentBar = nil then begin ChildBar := nil; Hide; ProcessPaintMessages; end else inherited; end; procedure TdxBarSubMenuControl.RepaintBar; var PrevSelectedItemLink: TdxBarItemLink; WasVisible, ChangeXDirection, ChangeYDirection, NeedRepaint: Boolean; PrevTopIndex: Integer; begin if FDestroyFlag or FDestroyingControls or not HandleAllocated then Exit; WasVisible := IsWindowVisible(Handle); PrevSelectedItemLink := nil; if IsCustomizing then begin if (BarManager.SelectedItem <> nil) and (BarManager.SelectedItem.Parent = Self) then begin PrevSelectedItemLink := BarManager.SelectedItem.ItemLink; BarManager.FSelectedItem := nil; end; FSelectedItem := nil; end; DestroyControls; CreateControls; SetRecentItemCount; if (Left <> FOnShowLeft) or (Top <> FOnShowTop) then begin ShowWindow(Handle, SW_HIDE); Left := FOnShowLeft; Top := FOnShowTop; NeedRepaint := False; end else NeedRepaint := True; SetSizeAndCheckBounds(ChangeXDirection, ChangeYDirection); CalcControlsPositions(nil); if UpArrowExists and not DownArrowExists then begin PrevTopIndex := FTopIndex; repeat Dec(FTopIndex); CalcControlsPositions(nil); until DownArrowExists or (FTopIndex = 0); if DownArrowExists then Inc(FTopIndex); NeedRepaint := NeedRepaint or (FTopIndex <> PrevTopIndex); end; if WasVisible then Show; if NeedRepaint then begin CalcControlsPositions(nil); Invalidate; end; if IsCustomizing and (PrevSelectedItemLink <> nil) then SetKeySelectedItem(PrevSelectedItemLink.Control); end; procedure TdxBarSubMenuControl.Show; const Shows: array[Boolean] of Integer = (0, SWP_SHOWWINDOW); var AParentBar: TCustomdxBarControl; ARandom: Double; begin DoPopup; AParentBar := GetParentBarForBar(Self); if AParentBar <> nil then FMenuAnimations := AParentBar.BarManager.MenuAnimations else FMenuAnimations := BarManager.MenuAnimations; // prepare AMenuAnimations if FMenuAnimations = maRandom then begin ARandom := Random(100); if ARandom < 33 then FMenuAnimations := maUnfold else if ARandom < 66 then FMenuAnimations := maSlide else FMenuAnimations := maFade; end; FShowAnimation := FShowAnimation and not (FMenuAnimations in [maNone, maFade]) and not ((ItemLinks.CanVisibleItemCount = 0) or BarManager.IsCustomizing); if (FMenuAnimations = maFade) and Assigned(AnimateWindowProc) and not IsWin9X then begin ProcessPaintMessages; AnimateWindowProc(Handle, 150, AW_BLEND); end else begin SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or Shows[not FShowAnimation]); ProcessPaintMessages; end; end; { TdxBarItemLink } constructor TdxBarItemLink.Create(Collection: TCollection); begin inherited Create(Collection); FLoadedRecentIndex := -1; FUseCount := BarManager.FMostRecentlyUsedUseCount; FMostRecentlyUsed := True; FUserGlyph := TBitmap.Create; FVisible := True; FLoadedVisible := True; AddToRecentList; if not BarManager.IsLoading and Assigned(BarManager.FOnItemLinkAdd) then BarManager.FOnItemLinkAdd(BarManager, Self); end; destructor TdxBarItemLink.Destroy; var AItemLinks: TdxBarItemLinks; ABarControl: TCustomdxBarControl; ItemLinkWithBeginGroup: TdxBarItemLink; begin if not BarManager.IsDestroying and Assigned(BarManager.FOnItemLinkDelete) then BarManager.FOnItemLinkDelete(BarManager, Self); AItemLinks := Owner; ABarControl := BarControl; if (Item <> nil) and (Self = BarManager.DraggingItemLink) and not BarManager.IsDestroying and (CanVisibleIndex < AItemLinks.CanVisibleItemCount - 1) and ((CanVisibleIndex = 0) and AItemLinks.CanVisibleItems[CanVisibleIndex + 1].BeginGroup or BeginGroup and not AItemLinks.CanVisibleItems[CanVisibleIndex + 1].BeginGroup) then ItemLinkWithBeginGroup := AItemLinks.CanVisibleItems[CanVisibleIndex + 1] else ItemLinkWithBeginGroup := nil; if FControl <> nil then begin if (ABarControl <> nil) and not ABarControl.IsDestroying and (ABarControl.SelectedItem = FControl) then begin BarManager.FSelectedItem := nil; ABarControl.SelectedItem := nil; end; FControl.Free; end; if FItem <> nil then FItem.FLinks.Remove(Self); FUserGlyph.Free; RemoveFromRecentList; inherited Destroy; if ItemLinkWithBeginGroup <> nil then with ItemLinkWithBeginGroup do BeginGroup := not FBeginGroup; if (ABarControl <> nil) and ABarControl.HandleAllocated and not ABarControl.IsDestroying then begin ABarControl.RepaintBar; if Assigned(AItemLinks.FOnChange) then AItemLinks.FOnChange(AItemLinks); end; end; function TdxBarItemLink.GetAvailableIndex: Integer; begin if Owner = nil then Result := -1 else Result := Owner.AvailableIndexOf(Self); end; function TdxBarItemLink.GetBarControl: TCustomdxBarControl; begin Result := Owner.FBarControl; end; function TdxBarItemLink.GetBarManager: TdxBarManager; begin Result := Owner.BarManager; end; function TdxBarItemLink.GetBeginGroup: Boolean; var AVisibleIndex: Integer; function HiddenBeginGroupExists: Boolean; var I: Integer; begin for I := Owner.VisibleItems[AVisibleIndex - 1].Index + 1 to Index - 1 do begin Result := Owner[I].BeginGroup; if Result then Exit; end; Result := False; end; begin AVisibleIndex := VisibleIndex; Result := FBeginGroup and (AVisibleIndex <> 0) or (AVisibleIndex > 0) and HiddenBeginGroupExists; end; function TdxBarItemLink.GetCanVisibleIndex: Integer; begin if Owner = nil then Result := -1 else Result := Owner.CanVisibleIndexOf(Self); end; function TdxBarItemLink.GetCaption: string; begin if not (udCaption in FUserDefine) and (FItem <> nil) then Result := FItem.Caption else Result := FUserCaption; end; function TdxBarItemLink.GetGlyph: TBitmap; begin if not (udGlyph in FUserDefine) and (FItem <> nil) then Result := FItem.Glyph else Result := FUserGlyph; end; function TdxBarItemLink.GetOwnerValue: TdxBarItemLinks; begin Result := TdxBarItemLinks(Collection); end; function TdxBarItemLink.GetPaintStyle: TdxBarPaintStyle; begin if not (udPaintStyle in FUserDefine) and (FItem <> nil) then if FItem is TdxBarButton then Result := TdxBarButton(FItem).PaintStyle else Result := psStandard else Result := FUserPaintStyle; end; function TdxBarItemLink.GetVisibleIndex: Integer; begin if Owner = nil then Result := -1 else Result := Owner.VisibleIndexOf(Self); end; function TdxBarItemLink.GetWidth: Integer; begin if udWidth in FUserDefine then Result := FUserWidth else if Item is TdxBarEdit then Result := TdxBarEdit(Item).Width else Result := 0 end; procedure TdxBarItemLink.SetBeginGroup(Value: Boolean); begin if FBeginGroup <> Value then begin FBeginGroup := Value; if Control <> nil then Control.BeginGroupChanged; ItemLinkChanged; end; end; procedure TdxBarItemLink.SetItem(Value: TdxBarItem); begin if FItem <> Value then begin if FItem <> nil then FItem.FLinks.Remove(Self); FItem := Value; if FItem <> nil then try if (Owner.Owner is TCustomdxBarSubItem) and not TCustomdxBarSubItem(Owner.Owner).CanContainItem(FItem) then begin FItem := nil; raise Exception.Create(cxGetResourceString(@dxSBAR_RECURSIVESUBITEMS)); end else begin FItem.FLinks.Add(Self); Owner.RefreshVisibilityLists; end; if (Owner.Owner is TComponent) and not (csLoading in TComponent(Owner.Owner).ComponentState) then CheckMostRecentlyUsed; finally ItemLinkChanged; end else Free; end; end; procedure TdxBarItemLink.SetMostRecentlyUsed(Value: Boolean); begin if FMostRecentlyUsed <> Value then begin FMostRecentlyUsed := Value; CheckMostRecentlyUsed; if BarControl <> nil then BarControl.RepaintBar; ItemLinkChanged; end; end; procedure TdxBarItemLink.SetUserCaption(Value: string); begin if FUserCaption <> Value then begin FUserCaption := Value; FUserDefine := FUserDefine + [udCaption]; if Control <> nil then Control.CaptionChanged; ItemLinkChanged; end; end; procedure TdxBarItemLink.SetUserDefine(Value: TdxBarUserDefines); begin if FUserDefine <> Value then begin FUserDefine := Value; if not (udCaption in FUserDefine) then FUserCaption := ''; if not (udGlyph in FUserDefine) then FUserGlyph.Assign(nil); if not (udPaintStyle in FUserDefine) then FUserPaintStyle := psStandard; if not (udWidth in FUserDefine) then FUserWidth := 0; if Control <> nil then begin Control.CaptionChanged; Control.GlyphChanged; end; ItemLinkChanged; end; end; procedure TdxBarItemLink.SetUserGlyph(Value: TBitmap); begin FUserGlyph.Assign(Value); FUserDefine := FUserDefine + [udGlyph]; if Control <> nil then Control.GlyphChanged; ItemLinkChanged; end; procedure TdxBarItemLink.SetUserPaintStyle(Value: TdxBarPaintStyle); begin if PaintStyle <> Value then begin FUserPaintStyle := Value; FUserDefine := FUserDefine + [udPaintStyle]; if Control is TdxBarButtonControl then TdxBarButtonControl(Control).PaintStyleChanged; ItemLinkChanged; end; end; procedure TdxBarItemLink.SetUserWidth(Value: Integer); begin CheckEditWidth(Value); if Width <> Value then begin FUserWidth := Value; FUserDefine := FUserDefine + [udWidth]; if Control is TdxBarEditControl then TdxBarEditControl(Control).WidthChanged; ItemLinkChanged; end; end; procedure TdxBarItemLink.SetVisible(Value: Boolean); begin if BarManager.IsLoading or Owner.FAssigning then begin FLoadedVisible := Value; Exit; end; if FVisible <> Value then begin FVisible := Value; if not BarManager.Designing then begin Owner.RefreshVisibilityLists; if Value then begin BringToTopInRecentList(False); if BarControl <> nil then begin CreateControl; Control.VisibleChanged; end; end else begin SendToBottomInRecentList; if Control <> nil then begin Control.VisibleChanged; DestroyControl; end; end; end; ItemLinkChanged; end; end; procedure TdxBarItemLink.AddToRecentList; begin Owner.FRecentItems.Add(Self); end; procedure TdxBarItemLink.RemoveFromRecentList; begin with Owner do if FRecentItems <> nil then FRecentItems.Remove(Self); end; procedure TdxBarItemLink.RestoreRecentIndex; begin RecentIndex := FPrevRecentIndex; end; procedure TdxBarItemLink.SaveRecentIndex; begin FPrevRecentIndex := RecentIndex; end; procedure TdxBarItemLink.InternalBringToTopInRecentList(IncCount: Boolean); begin if (Owner <> nil) and not Owner.CanUseRecentItems then Exit; RecentIndex := 0; if IncCount then Inc(FUseCount); end; procedure TdxBarItemLink.Synchronize(AItemLink: TdxBarItemLink); begin FUseCount := AItemLink.FUseCount; RecentIndex := AItemLink.RecentIndex; end; procedure TdxBarItemLink.CheckMostRecentlyUsed; begin if MostRecentlyUsed then begin FUseCount := BarManager.FMostRecentlyUsedUseCount; BringToTopInRecentList(False); end else begin FUseCount := 0; SendToBottomInRecentList; end end; function TdxBarItemLink.GetRecentIndex: Integer; begin Result := Owner.FRecentItems.IndexOf(Self); end; procedure TdxBarItemLink.SetRecentIndex(Value: Integer); begin if Owner = nil then FPrevRecentIndex := Value else with Owner, FRecentItems do begin if Value >= Count then Value := Count - 1; Move(IndexOf(Self), Value); RefreshVisibilityLists; end; end; function TdxBarItemLink.CanVisible: Boolean; begin Result := Item.ActuallyVisible and Visible; end; function TdxBarItemLink.GetRealItemLink: TdxBarItemLink; begin if FOriginalItemLink <> nil then Result := FOriginalItemLink else Result := Self end; function TdxBarItemLink.HasItem(AItem: TdxBarItem): Boolean; begin Result := FItem = AItem; if not Result and (FItem is TCustomdxBarSubItem) then Result := TCustomdxBarSubItem(FItem).ItemLinks.HasItem(AItem); end; procedure TdxBarItemLink.InitiateAction; begin if (Item <> nil) and (Item.ActionLink <> nil) then Item.ActionLink.Update; end; function TdxBarItemLink.IsAccel(Key: Word; Shift: TShiftState): Boolean; var Accel: Char; VK: SHORT; AShift: TShiftState; function GetAccel(const S: string): Char; var P, I, L: Integer; begin P := 0; I := 1; L := Length(S); while I < L do begin if S[I] = '&' then begin Inc(I); if S[I] <> '&' then P := I; end; Inc(I); end; if P = 0 then Result := #0 else begin Result := AnsiLowerCase(S[P])[1]; if Result <> S[P] then Shift := Shift - [ssShift]; end; end; begin Accel := GetAccel(Caption); if Accel = #0 then Result := False else if (Accel in ['0'..'9']) and (Key = Ord(Accel)) and (Shift = []) then Result := True else begin VK := VkKeyScan(Accel); if Lo(VK) = Key then begin VK := Hi(VK); AShift := []; if VK and 1 = 1 then Include(AShift, ssShift); if VK and 2 = 2 then Include(AShift, ssCtrl); Result := AShift = Shift; end else Result := False; end; end; procedure TdxBarItemLink.ItemLinkChanged; begin if (BarControl <> nil) and BarControl.IsCustomizing then with Owner do if Owner is TdxBarPopupMenu then TdxBarPopupMenu(Owner).OwnerDesignerModified else BarManager.DesignerModified; if not BarManager.IsLoading and Assigned(BarManager.FOnItemLinkChange) then BarManager.FOnItemLinkChange(BarManager, Self); end; procedure TdxBarItemLink.Assign(Source: TPersistent); function IsInheritanceUpdating: Boolean; begin Result := (csUpdating in BarManager.ComponentState) or ((Owner.FOwner is TdxBarPopupMenu) and (csUpdating in TdxBarPopupMenu(Owner.FOwner).ComponentState)) or ((Owner.FOwner is TCustomdxBarSubItem) and (csUpdating in TCustomdxBarSubItem(Owner.FOwner).ComponentState)); end; var Link: TdxBarItemLink; begin if Source is TdxBarItemLink then begin Link := TdxBarItemLink(Source); Data := Link.Data; FUserCaption := Link.FUserCaption; FUserGlyph.Assign(Link.FUserGlyph); FUserPaintStyle := Link.FUserPaintStyle; FUserWidth := Link.FUserWidth; if ResettingToolbar then Item := TdxBarItem(BarManager.MainForm.FindComponent(Link.Item.Name)) else begin if Assigned(Link.Item) and IsInheritanceUpdating then Item := BarManager.GetItemByName(Link.Item.Name) else Item := Link.Item; end; UserDefine := Link.UserDefine; BeginGroup := Link.BeginGroup; Visible := Link.Visible; // do not assign MostRecentlyUsed property end else inherited Assign(Source); end; procedure TdxBarItemLink.BringToTopInRecentList(IncCount: Boolean); var PrevVisibleIndex: Integer; AParentItem: TdxBarItem; begin if not CanVisible then Exit; PrevVisibleIndex := VisibleIndex; InternalBringToTopInRecentList(IncCount); if CanVisibleIndex > -1 then begin if (BarControl is TdxBarControl) and (PrevVisibleIndex = -1) and (BarControl.DockingStyle <> dsNone) and BarControl.BarManager.CanShowRecentItems then PostMessage(BarControl.Handle, WM_REPAINTBAR, 0, 0); AParentItem := nil; with Owner do if Owner is TCustomdxBarSubItem then AParentItem := TCustomdxBarSubItem(Owner) else if Owner is TdxBarPopupMenu then if (BarControl <> nil) and (TdxBarSubMenuControl(BarControl).FDropDownButton <> nil) then AParentItem := TdxBarSubMenuControl(BarControl).FDropDownButton.Item; if AParentItem <> nil then with AParentItem do if (CurItemLink <> nil) and (CurItemLink.RealItemLink <> nil) then CurItemLink.RealItemLink.BringToTopInRecentList(IncCount); end; end; procedure TdxBarItemLink.CreateControl; var I: Integer; begin if (FControl = nil) and (BarControl <> nil) and not BarControl.FDestroyFlag and (Item <> nil) then if (Item is TdxBarWindowItem) and IsVertical(BarControl) then FControl := TdxBarButtonControl.Create(Self) else with FRegItemList do for I := 0 to Count - 1 do with TRegItemRecord(Items[I]) do if Item.ClassInfo = ItemClass.ClassInfo then begin FControl := ItemControlClass.Create(Self); Break; end; end; procedure TdxBarItemLink.DestroyControl; begin if FControl <> nil then begin FControl.Free; FControl := nil; end; end; procedure TdxBarItemLink.SendToBottomInRecentList; var PrevVisibleIndex: Integer; begin PrevVisibleIndex := VisibleIndex; RecentIndex := Owner.FRecentItems.Count - 1; if (BarControl is TdxBarControl) and (PrevVisibleIndex > -1) and BarControl.BarManager.CanShowRecentItems then PostMessage(BarControl.Handle, WM_REPAINTBAR, 0, 0); end; { TdxBarItemLinks } constructor TdxBarItemLinks.Create(ABarManager: TdxBarManager); begin inherited Create(TdxBarItemLink); FBarManager := ABarManager; FAvailableItems := TList.Create; FCanVisibleItems := TList.Create; FVisibleItems := TList.Create; FRecentItems := TList.Create; FRecentItemCount := -1; FUseRecentItems := True; end; destructor TdxBarItemLinks.Destroy; begin if (FBarControl <> nil) and not FBarControl.IsDestroying then FBarControl.Free; FRecentItems.Free; FRecentItems := nil; FVisibleItems.Free; FVisibleItems := nil; FCanVisibleItems.Free; FCanVisibleItems := nil; FAvailableItems.Free; FAvailableItems := nil; inherited; end; function TdxBarItemLinks.GetAvailableItem(Index: Integer): TdxBarItemLink; begin Result := TdxBarItemLink(FAvailableItems[Index]); end; function TdxBarItemLinks.GetAvailableItemCount: Integer; begin Result := FAvailableItems.Count; end; function TdxBarItemLinks.GetCanVisibleItem(Index: Integer): TdxBarItemLink; begin Result := TdxBarItemLink(FCanVisibleItems[Index]); end; function TdxBarItemLinks.GetCanVisibleItemCount: Integer; begin Result := FCanVisibleItems.Count; end; function TdxBarItemLinks.GetItem(Index: Integer): TdxBarItemLink; begin Result := TdxBarItemLink(inherited Items[Index]); end; function TdxBarItemLinks.GetMostRecentItemCount: Integer; var MinCount, MaxCount, I, Level: Integer; begin if CanUseRecentItems then begin MinCount := MaxInt; MaxCount := 0; for I := 0 to CanVisibleItemCount - 1 do with CanVisibleItems[I] do begin if FUseCount < MinCount then MinCount := FUseCount; if FUseCount > MaxCount then MaxCount := FUseCount; end; Level := MinCount + MulDiv(MaxCount - MinCount, 100 - BarManager.MostRecentItemsPercents, 100); Result := 0; for I := CanVisibleItemCount - 1 downto 0 do with TdxBarItemLink(FRecentItems[I]) do if (FUseCount >= Level) and (Owner = Self) then begin Result := I + 1; Break; end; if Result = CanVisibleItemCount then Result := -1; end else Result := -1; end; function TdxBarItemLinks.GetRealVisibleItemCount: Integer; var R, AItemRect, ResultR: TRect; I: Integer; begin Result := VisibleItemCount; if Owner is TdxBar then begin R := BarControl.ClientRect; for I := 0 to Result - 1 do begin AItemRect := VisibleItems[I].ItemRect; IntersectRect(ResultR, R, AItemRect); if not EqualRect(AItemRect, ResultR) or IsRectEmpty(AItemRect) then begin Result := I; Break; end; end; end; end; function TdxBarItemLinks.GetVisibleItem(Index: Integer): TdxBarItemLink; begin Result := TdxBarItemLink(FVisibleItems[Index]); end; function TdxBarItemLinks.GetVisibleItemCount: Integer; begin Result := FVisibleItems.Count; end; procedure TdxBarItemLinks.SetItem(Index: Integer; Value: TdxBarItemLink); begin Items[Index].Assign(Value); end; procedure TdxBarItemLinks.SetRecentItemCount(Value: Integer); begin FPrevRecentItemCount := FRecentItemCount; if not CanUseRecentItems then Value := -1; FRecentItemCount := Value; RefreshVisibilityLists; end; function VisibleItemsCompare(Item1, Item2: Pointer): Integer; begin if TdxBarItemLink(Item1).CanVisibleIndex < TdxBarItemLink(Item2).CanVisibleIndex then Result := -1 else if TdxBarItemLink(Item1).CanVisibleIndex > TdxBarItemLink(Item2).CanVisibleIndex then Result := 1 else Result := 0; end; procedure TdxBarItemLinks.RefreshVisibilityLists; var IsDesignTime: Boolean; I: Integer; ItemLink: TdxBarItemLink; Item: TdxBarItem; begin if FAvailableItems = nil then Exit; FAvailableItems.Clear; FCanVisibleItems.Clear; FVisibleItems.Clear; IsDesignTime := BarManager.Designing; for I := 0 to Count - 1 do begin ItemLink := Items[I]; Item := ItemLink.Item; if (Item <> nil) and ({Item.AlwaysVisible or }IsDesignTime or Item.ActuallyVisible) then begin FAvailableItems.Add(ItemLink); if {Item.AlwaysVisible or }IsDesignTime or ItemLink.Visible then begin FCanVisibleItems.Add(ItemLink); if {Item.AlwaysVisible or }IsDesignTime or (RecentItemCount = -1) then FVisibleItems.Add(ItemLink); end; end; end; if not IsDesignTime and (RecentItemCount > 0) then begin for I := 0 to FRecentItems.Count - 1 do if CanVisibleIndexOf(FRecentItems[I]) <> -1 then begin FVisibleItems.Add(FRecentItems[I]); if FVisibleItems.Count = RecentItemCount then Break; end; FVisibleItems.Sort(VisibleItemsCompare); end; end; procedure TdxBarItemLinks.RestoreRecentItemCount; begin FRecentItemCount := FPrevRecentItemCount; RefreshVisibilityLists; end; procedure TdxBarItemLinks.EmptyItemRects; var I: Integer; begin for I := 0 to Count - 1 do SetRectEmpty(Items[I].FItemRect); end; procedure TdxBarItemLinks.Loaded(CheckVisible: Boolean); var J, I: Integer; begin for J := Count - 1 downto 0 do with Items[J] do if Item = nil then //Free else CheckMostRecentlyUsed; if CheckVisible then for J := Count - 1 downto 0 do with Items[J] do Visible := FLoadedVisible; for I := 0 to Count - 1 do for J := 0 to Count - 1 do with Items[J] do if FLoadedRecentIndex = I then begin FUseCount := FLoadedUseCount; RecentIndex := FLoadedRecentIndex; FLoadedRecentIndex := -1; end; if FBarControl <> nil then FBarControl.CreateControls; end; procedure TdxBarItemLinks.CheckVisibleIntegrity; var I, J: Integer; ItemLink: TdxBarItemLink; begin for I := 0 to FRecentItems.Count - 1 do begin ItemLink := TdxBarItemLink(FRecentItems[I]); if ItemLink.CanVisibleIndex = -1 then Break; end; for J := I + 1 to FRecentItems.Count - 1 do begin ItemLink := TdxBarItemLink(FRecentItems[J]); if ItemLink.CanVisibleIndex > -1 then begin ItemLink.RecentIndex := I; Inc(I); end; end; end; procedure TdxBarItemLinks.AssignUsageData(AItemLinks: TdxBarItemLinks); var J: Integer; begin for J := 0 to Count - 1 do if J < AItemLinks.Count then Items[J].FMostRecentlyUsed := AItemLinks[J].FMostRecentlyUsed; Loaded(False); CheckVisibleIntegrity; end; function TdxBarItemLinks.CanUseRecentItems: Boolean; var AItemLinks: TdxBarItemLinks; begin Result := BarManager.CanShowRecentItems; if Result then begin AItemLinks := Self; repeat Result := AItemLinks.FUseRecentItems; if (AItemLinks.Owner is TdxBar) or (AItemLinks.Owner is TdxBarPopupMenu) or (AItemLinks.BarControl = nil) or (AItemLinks.BarControl.ParentBar = nil) then Break; AItemLinks := AItemLinks.BarControl.ParentBar.ItemLinks; until False; end; end; procedure TdxBarItemLinks.InitiateActions; var I: Integer; begin for I := 0 to Count - 1 do Items[I].InitiateAction; end; function TdxBarItemLinks.IsDesignTimeLinks: Boolean; begin Result := not (Owner is TdxBarToolbarsPopup) and not (Owner is TdxBarCustomizingPopup) and (not (Owner is TCustomdxBarSubItem) or TCustomdxBarSubItem(Owner).HasDesignTimeLinks); end; function TdxBarItemLinks.IsShortCut(AShortCut: TShortCut): Boolean; var I: Integer; AItemLink: TdxBarItemLink; begin Result := False; if AShortCut = 0 then Exit; InitiateActions; for I := 0 to AvailableItemCount - 1 do begin AItemLink := AvailableItems[I]; if not AItemLink.Item.Enabled then Continue; if AItemLink.Item is TCustomdxBarSubItem then Result := TCustomdxBarSubItem(AItemLink.Item).IsShortCut(AShortCut) else begin if not AItemLink.Item.CanClicked then Continue; Result := (AItemLink.Item.ShortCut = AShortCut); if Result then AItemLink.Item.Click else if AItemLink.Item is TdxBarButton then with TdxBarButton(AItemLink.Item) do if (ButtonStyle = bsDropDown) and (DropDownMenu <> nil) then Result := DropDownMenu.IsShortCut(AShortCut); end; if Result then Break; end; end; function TdxBarItemLinks.FindItemWithAccel(Key: Word; Shift: TShiftState; Current: TdxBarItemLink): TdxBarItemLink; begin Shift := Shift - [ssAlt]; if BarControl is TdxBarControl then begin if IsWindowVisible(BarControl.Handle) then begin Result := Current; repeat Result := Next(Result); if Result = nil then Break; if Result.Item.HasAccel(Result) and Result.IsAccel(Key, Shift) then Exit; if Result = Current then Break; if Current = nil then Current := Result; until False; end; Result := nil; end else begin if CanVisibleItemCount = 0 then begin Result := nil; Exit; end; if Current = nil then Current := CanVisibleItems[0]; Result := Current; repeat if Result = CanVisibleItems[CanVisibleItemCount - 1] then Result := CanVisibleItems[0] else Result := CanVisibleItems[Result.CanVisibleIndex + 1]; if Result.Item.HasAccel(Result) and Result.IsAccel(Key, Shift) then Exit; until Result = Current; Result := nil; end; end; function TdxBarItemLinks.First: TdxBarItemLink; var I: Integer; begin for I := 0 to RealVisibleItemCount - 1 do begin Result := VisibleItems[I]; if Result.Control.CanSelect then Exit; end; Result := nil; end; function TdxBarItemLinks.Last: TdxBarItemLink; var I: Integer; begin for I := RealVisibleItemCount - 1 downto 0 do begin Result := VisibleItems[I]; if Result.Control.CanSelect then Exit; end; Result := nil; end; function TdxBarItemLinks.Next(Current: TdxBarItemLink): TdxBarItemLink; var CurrentIndex, I, ACount: Integer; begin if Current = nil then Result := First else begin CurrentIndex := Current.VisibleIndex; I := CurrentIndex; ACount := RealVisibleItemCount; repeat Inc(I); if I > ACount - 1 then I := 0; Result := VisibleItems[I]; if Result.Control.CanSelect then Exit; until I = CurrentIndex; Result := nil; end; end; function TdxBarItemLinks.Prev(Current: TdxBarItemLink): TdxBarItemLink; var CurrentIndex, I: Integer; begin if Current = nil then Result := Last else begin CurrentIndex := Current.VisibleIndex; I := CurrentIndex; repeat Dec(I); if I = -1 then I := RealVisibleItemCount - 1; Result := VisibleItems[I]; if Result.Control.CanSelect then Exit; until I = CurrentIndex; Result := nil; end; end; function TdxBarItemLinks.GetOwner: TPersistent; begin if FOwner is TPersistent then Result := TPersistent(FOwner) else Result := FBarManager; end; procedure TdxBarItemLinks.Update(Item: TCollectionItem); begin if (Owner is TComponent) and (csDestroying in TComponent(Owner).ComponentState) then Exit; if IsDesignTimeLinks then if Owner is TdxBarPopupMenu then TdxBarPopupMenu(Owner).OwnerDesignerModified else BarManager.DesignerModified; inherited Update(Item); RefreshVisibilityLists; if Owner is TdxBarContainerItem then TdxBarContainerItem(Owner).ItemLinksChanged; // TODO: virtual if Assigned(FOnChange) then FOnChange(Self); end; function TdxBarItemLinks.Add: TdxBarItemLink; begin Result := TdxBarItemLink(inherited Add); end; procedure TdxBarItemLinks.Assign(Source: TPersistent); var ContainsMDISystemMenu: Boolean; SystemMenuSubItem: TSystemMenuSubItem; I: Integer; begin ContainsMDISystemMenu := (Count <> 0) and (Items[0].Item is TSystemMenuSubItem); if ContainsMDISystemMenu then SystemMenuSubItem := TSystemMenuSubItem(Items[0].Item) else SystemMenuSubItem := nil; FAssigning := True; try inherited; finally FAssigning := False; for I := 0 to Count - 1 do with Items[I] do Visible := FLoadedVisible; if ContainsMDISystemMenu then with Add do begin Item := SystemMenuSubItem; Index := 0; end; end; end; function TdxBarItemLinks.AvailableIndexOf(Value: TdxBarItemLink): Integer; begin Result := FAvailableItems.IndexOf(Value); end; function TdxBarItemLinks.CanVisibleIndexOf(Value: TdxBarItemLink): Integer; begin Result := FCanVisibleItems.IndexOf(Value); end; procedure TdxBarItemLinks.CreateBarControl; begin if Owner is TdxBar then FBarControl := TdxBarControl.CreateEx(BarManager, TdxBar(Owner)) else if (Owner is TCustomdxBarSubItem) and (TCustomdxBarSubItem(Owner).CurItemLink <> nil) then FBarControl := TdxBarSubMenuControl.Create(TCustomdxBarSubItem(Owner).CurItemLink.BarManager) else FBarControl := TdxBarSubMenuControl.Create(BarManager); FBarControl.FItemLinks := Self; end; procedure TdxBarItemLinks.FreeForeignItems(ForeignBarManager: TdxBarManager); var PrevLockUpdate: Boolean; I: Integer; begin if Owner is TdxBar then begin PrevLockUpdate := TdxBar(Owner).LockUpdate; TdxBar(Owner).LockUpdate := True; end else PrevLockUpdate := False; for I := 0 to Count - 1 do if (ForeignBarManager <> nil) and (Items[I].BarManager = ForeignBarManager) or (ForeignBarManager = nil) and (Items[I].BarManager <> BarManager) then Items[I].Free; if Owner is TdxBar then TdxBar(Owner).LockUpdate := PrevLockUpdate; end; function TdxBarItemLinks.HasItem(AItem: TdxBarItem): Boolean; var I: Integer; begin Result := False; for I := 0 to Count - 1 do if Items[I].HasItem(AItem) then begin Result := True; Break; end; end; function TdxBarItemLinks.IndexOf(Value: TdxBarItemLink): Integer; begin Result := Value.Index; end; function TdxBarItemLinks.VisibleIndexOf(Value: TdxBarItemLink): Integer; begin Result := FVisibleItems.IndexOf(Value); end; { TdxBarShadowPart } constructor TdxBarShadowPart.CreateEx(AOwner: TdxBarShadow; AKind: TdxBarShadowPartKind; ACorners: TdxBarShadowCorners); begin Create(nil); FOwner := AOwner; FKind := AKind; FCorners := ACorners; FImage := TBitmap.Create; end; destructor TdxBarShadowPart.Destroy; begin FImage.Free; inherited; end; function TdxBarShadowPart.GetControl: TWinControl; begin Result := FOwner.Owner; end; function TdxBarShadowPart.GetShadowSize: Integer; begin Result := FOwner.ShadowSize; end; function TdxBarShadowPart.GetTransparent: Boolean; begin Result := FOwner.Transparent; end; procedure TdxBarShadowPart.WMNCHitTest(var Message: TWMNCHitTest); begin inherited; Message.Result := HTTRANSPARENT; end; function TdxBarShadowPart.CanShow: Boolean; begin Result := (FCorners = []) or (Width >= ShadowSize) and (Height >= ShadowSize); end; procedure TdxBarShadowPart.CreateParams(var Params: TCreateParams); begin inherited; with Params do begin Style := WS_POPUP; if Transparent then ExStyle := WS_EX_LAYERED else ExStyle := 0; if GetWindowLong(Control.Handle, GWL_EXSTYLE) and WS_EX_TOPMOST <> 0 then ExStyle := ExStyle or WS_EX_TOPMOST; WndParent := Control.Handle; WindowClass.style := 0; end; end; procedure TdxBarShadowPart.Paint; begin with Canvas do begin Brush.Color := clBtnShadow; FillRect(ClientRect); end; end; procedure TdxBarShadowPart.UpdateImage; type PColors = ^TColors; TColors = array[0..MaxInt - 1] of Byte; var BI: TBitmapInfo; Colors: PColors; function GetAlphaIndex(X, Y: Integer): Integer; begin Result := (Y * Width + X) * 4 + 3; end; function GetAlpha(X, Y: Integer): Byte; begin Result := Colors^[GetAlphaIndex(X, Y)]; end; procedure SetAlpha(X, Y: Integer; Value: Byte); begin Colors^[GetAlphaIndex(X, Y)] := Value; end; procedure ProcessMainContent; const AlphaStep = 15; var X, Y: Integer; begin for X := 0 to Width - 1 do for Y := 0 to Height - 1 do if FKind = spHorizontal then SetAlpha(X, Y, (Height - Y) * AlphaStep) else SetAlpha(X, Y, (Width - X) * AlphaStep); end; procedure ProcessCorners; type TCornerKind = (ckLeft, ckRight, ckTop); procedure ProcessCorner(ACornerKind: TCornerKind); var I, J, X, Y: Integer; procedure ConvertCoordinates; begin case ACornerKind of ckLeft: begin X := I; Y := J; end; ckRight: begin X := Width - 1 - I; Y := J; end; ckTop: begin X := J; Y := I; end; end; end; begin for I := 0 to ShadowSize - 1 do for J := 0 to ShadowSize - 1 do begin ConvertCoordinates; SetAlpha(X, Y, MulDiv(GetAlpha(X, Y), 1 + I, 1 + ShadowSize)); end; end; begin if FKind = spHorizontal then begin if scLeft in FCorners then ProcessCorner(ckLeft); if scRight in FCorners then ProcessCorner(ckRight); end else if scTop in FCorners then ProcessCorner(ckTop); end; begin if not CanShow then Exit; FImage.PixelFormat := pf32bit; FImage.Width := Width; FImage.Height := Height; with BI.bmiHeader do begin biSize := SizeOf(BI.bmiHeader); biWidth := Width; biHeight := -Height; biPlanes := 1; biBitCount := 32; biCompression := BI_RGB; end; GetMem(Colors, 4 * Width * Height); try FillChar(Colors^, 4 * Width * Height, 0); ProcessMainContent; ProcessCorners; SetDIBits(FImage.Canvas.Handle, FImage.Handle, 0, Height, Colors, BI, DIB_RGB_COLORS); finally FreeMem(Colors); end; end; procedure TdxBarShadowPart.Hide; begin ShowWindow(Handle, SW_HIDE); DestroyHandle; end; procedure TdxBarShadowPart.Show; procedure MakeAlphaBlended; var ASize: TSize; P: TPoint; ABlend: TBlendFunction; begin ASize := TSize(ClientRect.BottomRight); P := Point(0, 0); with ABlend do begin BlendOp := AC_SRC_OVER; BlendFlags := 0; SourceConstantAlpha := 255; AlphaFormat := AC_SRC_ALPHA; end; UpdateLayeredWindow(Handle, 0, nil, @ASize, FImage.Canvas.Handle, @P, 0, @ABlend, LWA_ALPHA); end; begin if not CanShow then Exit; if Transparent then MakeAlphaBlended; SetWindowPos(Handle, Control.Handle, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW or SWP_NOACTIVATE); end; procedure TdxBarShadowPart.UpdateBounds(const ABounds: TRect); begin BoundsRect := ABounds; UpdateImage; if FOwner.Visible then Show; end; { TdxBarShadow } constructor TdxBarShadow.Create(AOwner: TWinControl); begin inherited Create; FOwner := AOwner; end; destructor TdxBarShadow.Destroy; begin DestroyParts; inherited; end; function TdxBarShadow.GetShadowSize: Integer; begin if Transparent then Result := dxBarTransparentShadowSize else Result := dxBarOpaqueShadowSize; end; function TdxBarShadow.GetTransparent: Boolean; begin Result := (@UpdateLayeredWindow <> nil) and (BitsPerPixel > 8); end; procedure TdxBarShadow.SetVisible(Value: Boolean); begin if FVisible <> Value then begin FVisible := Value; if FVisible then Show else Hide; end; end; procedure TdxBarShadow.CreateParts; var APartCount: Integer; procedure CreatePart(AKind: TdxBarShadowPartKind; ACorners: TdxBarShadowCorners; const ABounds: TRect); begin if IsRectEmpty(ABounds) then Exit; FParts[APartCount] := TdxBarShadowPart.CreateEx(Self, AKind, ACorners); FParts[APartCount].UpdateBounds(ABounds); Inc(APartCount); end; procedure CreatePartsForHorizontalMode; begin if not IsRectEmpty(R1) then CreatePart(spVertical, [scTop], Rect(R1.Right, R1.Top + ShadowSize, R1.Right + ShadowSize, R1.Bottom)); CreatePart(spHorizontal, [scLeft, scRight], Rect(R2.Left + ShadowSize, R2.Bottom, R2.Right + ShadowSize, R2.Bottom + ShadowSize)); if not IsRectEmpty(R1) then begin if R1.Left + ShadowSize < R2.Left then CreatePart(spHorizontal, [scLeft], Rect(R1.Left + ShadowSize, R1.Bottom, R2.Left, R1.Bottom + ShadowSize)); if R1.Right > R2.Right then CreatePart(spHorizontal, [scRight], Rect(R2.Right, R1.Bottom, R1.Right + ShadowSize, R1.Bottom + ShadowSize)); end; if IsRectEmpty(R1) or (R1.Right < R2.Right) then CreatePart(spVertical, [scTop], Rect(R2.Right, R2.Top + ShadowSize, R2.Right + ShadowSize, R2.Bottom)) else CreatePart(spVertical, [], Rect(R2.Right, R2.Top, R2.Right + ShadowSize, R2.Bottom)); end; procedure CreatePartsForVerticalMode; begin CreatePart(spVertical, [scTop], Rect(R2.Right, R2.Top + ShadowSize, R2.Right + ShadowSize, R2.Bottom)); if R1.Top + ShadowSize < R2.Top then CreatePart(spVertical, [scTop], Rect(R1.Right, R1.Top + ShadowSize, R1.Right + ShadowSize, R2.Top)); if R1.Bottom > R2.Bottom then begin CreatePart(spHorizontal, [scLeft, scRight], Rect(R1.Left + ShadowSize, R1.Bottom, R1.Right + ShadowSize, R1.Bottom + ShadowSize)); CreatePart(spVertical, [], Rect(R1.Right, R2.Bottom, R1.Right + ShadowSize, R1.Bottom)); end else CreatePart(spHorizontal, [scLeft], Rect(R1.Left + ShadowSize, R1.Bottom, R1.Right, R1.Bottom + ShadowSize)); if R1.Bottom >= R2.Bottom then CreatePart(spHorizontal, [scRight], Rect(R2.Left, R2.Bottom, R2.Right + ShadowSize, R2.Bottom + ShadowSize)) else CreatePart(spHorizontal, [scLeft, scRight], Rect(R2.Left + ShadowSize, R2.Bottom, R2.Right + ShadowSize, R2.Bottom + ShadowSize)); end; begin APartCount := 0; if FHorizontal then CreatePartsForHorizontalMode else CreatePartsForVerticalMode; end; procedure TdxBarShadow.DestroyParts; var I: Integer; begin for I := Low(FParts) to High(FParts) do begin FParts[I].Free; FParts[I] := nil; end; end; procedure TdxBarShadow.Hide; var I: Integer; begin for I := Low(FParts) to High(FParts) do if FParts[I] <> nil then FParts[I].Hide; end; procedure TdxBarShadow.Show; var I: Integer; begin for I := Low(FParts) to High(FParts) do if FParts[I] <> nil then FParts[I].Show; end; procedure TdxBarShadow.Refresh; begin DestroyParts; CreateParts; end; procedure TdxBarShadow.SetOwnerBounds(AR1, AR2: TRect); procedure SwapRects; var R: TRect; begin R := R1; R1 := R2; R2 := R; end; begin R1 := AR1; R2 := AR2; FHorizontal := IsRectEmpty(R1) or (R1.Bottom = R2.Top) or (R1.Top = R2.Bottom); if FHorizontal and (R1.Top = R2.Bottom) or not FHorizontal and (R1.Left = R2.Right) then SwapRects; Refresh; end; { TCustomdxBarCombo } function TCustomdxBarCombo.GetDroppedDown: Boolean; begin if CurItemLink = nil then Result := False else if CurItemLink.Control is TCustomdxBarComboControl then Result := TCustomdxBarComboControl(CurItemLink.Control).DroppedDown else Result := False; end; function TCustomdxBarCombo.GetShowEditor: Boolean; begin Result := not EmptyWindow; end; procedure TCustomdxBarCombo.SetDroppedDown(Value: Boolean); begin if (CurItemLink <> nil) and (CurItemLink.Control is TCustomdxBarComboControl) then TCustomdxBarComboControl(CurItemLink.Control).DroppedDown := Value; end; procedure TCustomdxBarCombo.SetShowEditor(Value: Boolean); begin EmptyWindow := not Value; end; procedure TCustomdxBarCombo.AfterDropDown; begin end; procedure TCustomdxBarCombo.CheckDropDownPoint(var X, Y: Integer); var R: TRect; ControlWidth, ControlHeight, DropDownWindowWidth, DropDownWindowHeight: Integer; begin if DropDownWindow > 0 then with R do begin with CurItemLink.ItemRect do begin ControlWidth := Right - Left; ControlHeight := Bottom - Top; end; GetWindowRect(DropDownWindow, R); DropDownWindowWidth := Right - Left; DropDownWindowHeight := Bottom - Top; R := GetWorkArea(Point(X, Y)); if (CurItemLink.BarControl is TdxBarSubMenuControl) or IsRealVertical(CurItemLink.BarControl) then begin if (X + DropDownWindowWidth > Right) and (X - ControlWidth - Left > Right - X) then Dec(X, ControlWidth + DropDownWindowWidth); if Y + DropDownWindowHeight > Bottom then Y := Bottom - DropDownWindowHeight; end else begin if X + DropDownWindowWidth > Right then X := Right - DropDownWindowWidth; if (Y + DropDownWindowHeight > Bottom) and (Y - ControlHeight - Top > Bottom - Y) then Dec(Y, ControlHeight + DropDownWindowHeight); end; if X < Left then X := Left; if Y < Top then Y := Top; end; end; function TCustomdxBarCombo.CheckKeyForDropDownWindow(Key: Word; Shift: TShiftState): Boolean; begin Result := (Key <> VK_ESCAPE) and (Key <> VK_RETURN) and (Key <> VK_TAB); if Assigned(FOnCheckKeyForDropDownWindow) then FOnCheckKeyForDropDownWindow(Self, Key, Shift, Result); end; procedure TCustomdxBarCombo.CloseUp; begin if DropDownWindow <> 0 then ShowWindow(DropDownWindow, SW_HIDE); if Assigned(FOnCloseUp) then FOnCloseUp(Self); end; procedure TCustomdxBarCombo.DropDown(X, Y: Integer); begin if Assigned(FOnDropDown) then FOnDropDown(Self); if DropDownWindow <> 0 then begin InitDropDownWindow; CheckDropDownPoint(X, Y); SetWindowPos(DropDownWindow, 0, X, Y, 0, 0, SWP_NOZORDER or SWP_NOSIZE or SWP_NOACTIVATE); SetWindowPos(DropDownWindow, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_FRAMECHANGED); AfterDropDown; end; end; function TCustomdxBarCombo.GetDropDownWindow: HWND; begin Result := 0; if Assigned(FOnGetDropDownWindow) then FOnGetDropDownWindow(Self, Result); end; procedure TCustomdxBarCombo.InitDropDownWindow; begin end; { TdxBarCustomCombo } constructor TdxBarCustomCombo.Create(AOwner: TComponent); begin inherited Create(AOwner); FDropDownCount := 8; FItemIndex := -1; FItems := TStringList.Create; TStringList(FItems).OnChange := ItemsChanged; FListBox := TdxBarDropDownListBox.Create(Self); with TdxBarDropDownListBox(FListBox) do begin FCombo := Self; OnDrawItem := ListBoxDrawItem; OnMeasureItem := ListBoxMeasureItem; end; end; destructor TdxBarCustomCombo.Destroy; begin FListBox.Free; FItems.Free; inherited Destroy; end; function TdxBarCustomCombo.GetCurItemIndex: Integer; begin if FocusedItemLink = nil then Result := ItemIndex else Result := TdxBarComboControl(FocusedItemLink.Control).LocalItemIndex; end; function TdxBarCustomCombo.GetItemsHeight(Index: Integer): Integer; begin MeasureItem(Index, Result); end; procedure TdxBarCustomCombo.SetCurItemIndex(Value: Integer); begin if FocusedItemLink = nil then ItemIndex := Value else TdxBarComboControl(FocusedItemLink.Control).LocalItemIndex := Value; end; procedure TdxBarCustomCombo.SetItemIndex(Value: Integer); var AText: string; begin if FItemIndex <> Value then begin FItemIndex := Value; if (FItemIndex < 0) or (FItemIndex > Items.Count - 1) then FItemIndex := -1; if FItemIndex = -1 then AText := '' else AText := Items[FItemIndex]; if Text = AText then begin Update; Change; Update; end else Text := AText; end; end; procedure TdxBarCustomCombo.SetItems(Value: TStrings); begin FItems.Assign(Value); end; procedure TdxBarCustomCombo.SetSorted(Value: Boolean); begin if FSorted <> Value then begin FSorted := Value; TStringList(FItems).Sorted := FSorted; FItemIndex := FItems.IndexOf(Text); end; end; procedure TdxBarCustomCombo.CheckLocalPos; var AText: string; AItemIndex: Integer; begin if (CurItemLink = nil) or not (CurItemLink.Control is TdxBarComboControl) then Exit; AText := TdxBarComboControl(CurItemLink.Control).Text; AItemIndex := TdxBarComboControl(CurItemLink.Control).LocalItemIndex; if not ((0 <= AItemIndex) and (AItemIndex < Items.Count) and (Items[AItemIndex] = AText)) then AItemIndex := GetNearestItemIndex(AText); TdxBarComboControl(CurItemLink.Control).FLocalItemIndex := AItemIndex; if DroppedDown then if (AItemIndex > -1) and (AnsiCompareText(AText, Items[AItemIndex]) = 0) then ListBox.ItemIndex := AItemIndex else begin ListBox.ItemIndex := -1; ListBox.TopIndex := AItemIndex; end; end; procedure TdxBarCustomCombo.ItemsChanged(Sender: TObject); begin if ItemIndex > Items.Count - 1 then ItemIndex := -1 else Update; end; procedure TdxBarCustomCombo.ListBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); begin DrawItem(Index, Rect, State); end; procedure TdxBarCustomCombo.ListBoxMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer); begin MeasureItem(Index, Height); end; procedure TdxBarCustomCombo.AfterDropDown; begin with TdxBarDropDownListBox(ListBox) do if LeftButtonPressed then begin SetCapture(Handle); WaitForCapture := True; end else WaitForCapture := False; end; function TdxBarCustomCombo.CheckKeyForDropDownWindow(Key: Word; Shift: TShiftState): Boolean; begin Result := (Shift = []) and ((Key = VK_UP) or (Key = VK_DOWN) or (Key = VK_PRIOR) or (Key = VK_NEXT)); end; procedure TdxBarCustomCombo.CloseUp; begin inherited; FListBox.Parent := nil; end; procedure TdxBarCustomCombo.CurChange; begin inherited; CheckLocalPos; end; procedure TdxBarCustomCombo.DrawInterior(ABarEditControl: TdxBarEditControl; ACanvas: TCanvas; R: TRect; ItemLink: TdxBarItemLink); var AIndex: Integer; begin FCanvas := ACanvas; try if FocusedItemLink = ItemLink then AIndex := TdxBarComboControl(CurItemLink.Control).LocalItemIndex else AIndex := ItemIndex; FInteriorIsDrawing := True; try DrawItem(AIndex, R, []); finally FInteriorIsDrawing := False; end; finally FCanvas := nil; end; end; procedure TdxBarCustomCombo.DrawItem(AIndex: Integer; ARect: TRect; AState: TOwnerDrawState); begin if Assigned(FOnDrawItem) then FOnDrawItem(Self, AIndex, ARect, AState) else PainterClass.CustomComboDrawItem(Self, Canvas, AIndex, ARect, AState, FInteriorIsDrawing); if odFocused in AState then DrawFocusRect(Canvas.Handle, ARect); // for hiding focus rect end; procedure TdxBarCustomCombo.DropDown(X, Y: Integer); begin FListBox.Parent := CurItemLink.Control.Parent; //BarManager.MainForm; inherited; CheckLocalPos; end; function TdxBarCustomCombo.GetCanvas: TCanvas; begin if FCanvas <> nil then Result := FCanvas else Result := FListBox.Canvas; end; function TdxBarCustomCombo.GetDropDownWidth: Integer; var I, ItemWidth: Integer; begin Result := DropDownWidth; if Result <= 0 then begin if CurItemLink <> nil then with CurItemLink.ItemRect do Result := Right - Left - TdxBarComboControl(CurItemLink.Control).CaptionWidth - 2 * 2; if DropDownCount < Items.Count then Dec(Result, GetSystemMetrics(SM_CXVSCROLL)); for I := 0 to Items.Count - 1 do begin MeasureItemWidth(I, ItemWidth); if ItemWidth > Result then Result := ItemWidth; end; end; Inc(Result, 2 + 2); if DropDownCount < Items.Count then Inc(Result, GetSystemMetrics(SM_CXVSCROLL)); end; function TdxBarCustomCombo.GetDropDownWindow: HWND; begin Result := inherited GetDropDownWindow; if Result = 0 then Result := FListBox.Handle; end; function TdxBarCustomCombo.GetNearestItemIndex(AText: string): Integer; var AItem: string; FoundChars, I, J: Integer; begin AText := AnsiUpperCase(AText); FoundChars := 0; Result := -1; for I := 0 to Items.Count - 1 do begin AItem := AnsiUpperCase(Items[I]); if Copy(AItem, 1, FoundChars) = Copy(AText, 1, FoundChars) then for J := FoundChars + 1 to Length(AText) do if (J <= Length(AItem)) and (AItem[J] = AText[J]) then begin FoundChars := J; Result := I; if J = Length(AText) then Exit; end else Break; end; end; procedure TdxBarCustomCombo.InitDropDownWindow; var AWidth, AHeight, I: Integer; begin FListBox.Items.Assign(Items); AWidth := GetDropDownWidth; if DropDownCount > Items.Count then I := Items.Count else I := DropDownCount; AHeight := 2 * 2; for I := 0 to I - 1 do Inc(AHeight, ItemsHeight[I]); SetWindowPos(FListBox.Handle, 0, 0, 0, AWidth, AHeight, SWP_NOZORDER or SWP_NOMOVE or SWP_NOACTIVATE); end; procedure TdxBarCustomCombo.MeasureItem(AIndex: Integer; var AHeight: Integer); begin if ItemHeight <= 0 then AHeight := Canvas.TextHeight('Qq') else AHeight := ItemHeight; if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, AIndex, AHeight); end; procedure TdxBarCustomCombo.MeasureItemWidth(AIndex: Integer; var AWidth: Integer); begin AWidth := 1 + Canvas.TextWidth(Items[AIndex]) + 1; end; procedure TdxBarCustomCombo.SetText(Value: string); begin if (FItemIndex = -1) or (Items[FItemIndex] <> Value) then FItemIndex := Items.IndexOf(Value); inherited; end; { TdxBarContainerItem } procedure TdxBarContainerItem.AddListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer; FirstCall: Boolean; CallingItemLink: TdxBarItemLink); var I: Integer; begin inherited; if AItemLinks = ItemLinks then Exit; for I := 0 to FItemLinks.CanVisibleItemCount - 1 do with AItemLinks.Add do begin FOriginalItemLink := CallingItemLink; Assign(FItemLinks.CanVisibleItems[I]); Index := AIndex + I; if (I = 0) and HideWhenRun then BeginGroup := True; Synchronize(FOriginalItemLink); end; end; procedure TdxBarContainerItem.DeleteListedItemLinks(AItemLinks: TdxBarItemLinks; AIndex: Integer); var I: Integer; begin inherited; if AItemLinks = ItemLinks then Exit; for I := 0 to FItemLinks.CanVisibleItemCount - 1 do AItemLinks[AIndex].Free; end; function TdxBarContainerItem.InternalActuallyVisible: Boolean; begin Result := inherited InternalActuallyVisible or IsItemsExist; end; function TdxBarContainerItem.IsItemsExist: Boolean; var I: Integer; AItemExists: Boolean; begin Result := ItemLinks.Count > 0; if Result then // check empty items begin AItemExists := False; for I := 0 to ItemLinks.Count - 1 do if ItemLinks[I].Item <> nil then begin AItemExists := True; Break; end; if AItemExists then begin Result := False; for I := 0 to ItemLinks.Count - 1 do if (ItemLinks[I].Item <> nil) and ItemLinks[I].Item.ActuallyVisible then begin Result := True; Break; end; end; end; end; { TContainerItemSubMenuControl } type TContainerItemSubMenuControl = class(TdxBarSubMenuControl) private FContainerItem: TCustomdxBarContainerItem; protected procedure DoCloseUp; override; function GetIsCustomizing: Boolean; override; public destructor Destroy; override; end; destructor TContainerItemSubMenuControl.Destroy; var AContainerItem: TCustomdxBarContainerItem; begin AContainerItem := FContainerItem; inherited; AContainerItem.NeedClearItemList; end; procedure TContainerItemSubMenuControl.DoCloseUp; begin with FContainerItem do DeleteListedItemLinks(ItemLinks, 0); inherited; end; function TContainerItemSubMenuControl.GetIsCustomizing: Boolean; begin Result := False; end; { TdxBarContainerItemControl } function TdxBarContainerItemControl.GetItem: TCustomdxBarContainerItem; begin Result := TCustomdxBarContainerItem(ItemLink.Item); end; procedure TdxBarContainerItemControl.CreateSubMenuControl; begin if BarManager.IsCustomizing then Exit; Item.ItemLinks.FBarControl := TContainerItemSubMenuControl.Create(BarManager); SubMenuControl.FItemLinks := Item.ItemLinks; TContainerItemSubMenuControl(SubMenuControl).FContainerItem := Item; with Item do AddListedItemLinks(ItemLinks, 0, True, ItemLink); end; function TdxBarContainerItemControl.GetCaption: string; begin Result := inherited GetCaption; if not ShowRealCaption then Result := '(' + Result + ')'; end; function TdxBarContainerItemControl.IsExpandable: Boolean; begin Result := not BarManager.IsCustomizing; end; procedure TdxBarContainerItemControl.Paint(ARect: TRect; PaintType: TdxBarPaintType); var DC: HDC; begin if PaintType = ptMenu then begin if ARect.Left = ARect.Right then Exit; DC := Parent.Canvas.Handle; DrawGlyphAndTextInSubMenu(DC, ARect, False, True, False); end else inherited; end; function TdxBarContainerItemControl.ShowRealCaption: Boolean; begin Result := (Parent is TdxBarControl) or not Item.HideWhenRun; end; { TdxBarWinControl } constructor TdxBarWinControl.Create(AItemLink: TdxBarItemLink); begin inherited Create(AItemLink); FHasWindow := True; if not (Parent is TdxBarControl and TdxBarControl(Parent).Moving) then CreateWindowHandle; end; destructor TdxBarWinControl.Destroy; begin if not (Parent is TdxBarControl and TdxBarControl(Parent).Moving) then DestroyWindowHandle; inherited Destroy; end; function TdxBarWinControl.GetItem: TdxBarWindowItem; begin Result := TdxBarWindowItem(ItemLink.Item); end; function TdxBarWinControl.GetWindowRect: TRect; begin if Enabled then begin Result := FWindowRect; if Item.EmptyWindow then with Result do Right := Left; end else SetRectEmpty(Result); end; procedure TdxBarWinControl.SetWindowRect(const Value: TRect); var R: TRect; begin FWindowRect := Value; if IsWindowVisible(Handle) then begin Windows.GetWindowRect(Handle, R); if not EqualRect(R, FWindowRect) then begin with WindowRect do SetWindowPos(Handle, 0, Left, Top, Right - Left, Bottom - Top, SWP_NOZORDER or SWP_NOACTIVATE {SWP_SHOWWINDOW}); if (Self is TdxBarEditControl) then PainterClass.EditControlPrepareEditWnd(TdxBarEditControl(Self), Handle); end; end; end; function TdxBarWinControl.CanClicked: Boolean; begin Result := IsVertical(FParent); end; procedure TdxBarWinControl.ControlInactivate(Immediately: Boolean); begin inherited; Focused := False; end; procedure TdxBarWinControl.ControlClick(ByMouse: Boolean); begin Focused := True; inherited; end; procedure TdxBarWinControl.CreateWindowHandle; begin FDefWndProc := MakeObjectInstance(WndProc); FPrevDefWndProc := Pointer(GetWindowLong(FHandle, GWL_WNDPROC)); SetWindowLong(FHandle, GWL_WNDPROC, Longint(FDefWndProc)); end; procedure TdxBarWinControl.DestroyWindowHandle; begin if FHandle <> 0 then begin Focused := False; SetWindowLong(FHandle, GWL_WNDPROC, Longint(FPrevDefWndProc)); FreeObjectInstance(FDefWndProc); FDefWndProc := nil; DestroyWindow(FHandle); FHandle := 0; end; end; function TdxBarWinControl.DoKeyDown(var Message: TWMKey): Boolean; begin with Message do TdxBarWindowItem(ItemLink.Item).KeyDown(CharCode, KeyDataToShiftState(KeyData)); Result := (Message.CharCode = 0); end; function TdxBarWinControl.DoKeyPress(var Message: TWMKey): Boolean; var Ch: Char; begin with Message do begin Ch := Char(CharCode); TdxBarWindowItem(ItemLink.Item).KeyPress(Ch); CharCode := Word(Ch); end; Result := (Char(Message.CharCode) = #0); end; function TdxBarWinControl.DoKeyUp(var Message: TWMKey): Boolean; begin with Message do TdxBarWindowItem(ItemLink.Item).KeyUp(CharCode, KeyDataToShiftState(KeyData)); Result := (Message.CharCode = 0); end; procedure TdxBarWinControl.EnabledChanged; begin Focused := False; inherited; end; function TdxBarWinControl.GetText: string; var S: PChar; Len: Integer; begin if Handle <> 0 then begin S := StrAlloc(256); Len := SendMessage(Handle, WM_GETTEXT, 255, Longint(S)); if Len = 0 then Result := '' else Result := S; StrDispose(S); end; end; function TdxBarWinControl.IsDestroyOnClick: Boolean; begin Result := False; end; procedure TdxBarWinControl.SetFocused(Value: Boolean); var IsDesignForm: Boolean; procedure SetTopMosts(AShow: Boolean); const TopMosts: array[Boolean] of HWND = (HWND_NOTOPMOST, HWND_TOPMOST); var PrevBarControl, ABarControl: TCustomdxBarControl; begin if dxBarCustomizingPopup <> nil then if AShow then begin SetWindowPos(dxBarCustomizingPopup.Handle, TopMosts[AShow], 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); PrevBarControl := dxBarCustomizingPopup; if dxBarCustomizingPopupItemLink.Control <> nil then begin ABarControl := dxBarCustomizingPopupItemLink.Control.Parent; repeat SetWindowPos(ABarControl.Handle, PrevBarControl.Handle, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); PrevBarControl := ABarControl; ABarControl := ABarControl.ParentBar; until ABarControl = nil; end; end else begin if dxBarCustomizingPopupItemLink.Control <> nil then begin ABarControl := dxBarCustomizingPopupItemLink.Control.Parent; while ABarControl.ParentBar <> nil do ABarControl := ABarControl.ParentBar; repeat SetWindowPos(ABarControl.Handle, TopMosts[AShow], 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); ABarControl := ABarControl.ChildBar; until ABarControl = nil; end; SetWindowPos(dxBarCustomizingPopup.Handle, TopMosts[AShow], 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); end; end; begin if FFocused <> Value then begin FFocused := Value; if FFocused then begin FPrevFocusedControl := Windows.GetFocus; if not IsWindowVisible(FPrevFocusedControl) then FPrevFocusedControl := BarManager.MainForm.Handle; SendMessage(Handle, WM_SETFONT, Parent.EditFontHandle, 0); if not IsActive then ControlActivate(True); with WindowRect do SetWindowPos(Handle, 0, Left, Top, Right - Left, Bottom - Top, SWP_SHOWWINDOW); if (Self is TdxBarEditControl) then PainterClass.EditControlPrepareEditWnd(TdxBarEditControl(Self), Handle); FFocusing := True; try Text := TdxBarWindowItem(FItemLink.Item).Text; // SetFocus(Handle); finally FFocusing := False; end; SetFocus(Handle); end else begin { if FHandle <> 0 then SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_HIDEWINDOW or SWP_NOACTIVATE);} if FHandle <> 0 then ShowWindow(Handle, SW_HIDE); if not BarManager.FToolbarsVisibleChanging then begin IsDesignForm := (dxBarCustomizingForm <> nil) and (GetParentForm(FindControl(FPrevFocusedControl)) = dxBarCustomizingForm); if IsDesignForm then SetTopMosts(True); if (FPrevFocusedControl > 0) and IsWindowVisible(FPrevFocusedControl) then SetFocus(FPrevFocusedControl) else if IsWindowVisible(BarManager.MainForm.Handle) then Windows.SetFocus(BarManager.MainForm.Handle) else Windows.SetFocus(GetNextWindow(BarManager.MainForm.Handle, GW_HWNDNEXT)); if IsDesignForm then SetTopMosts(False); FPrevFocusedControl := 0; end; if BarManager.AlwaysSaveText and ((GetAsyncKeyState(VK_ESCAPE) >= 0) or (GetAsyncKeyState(VK_CONTROL) < 0) or (GetAsyncKeyState(VK_MENU) < 0)) then TdxBarWindowItem(FItemLink.Item).Text := Text; end; end; end; procedure TdxBarWinControl.SetText(Value: string); begin SetWindowText(Handle, PChar(Value)); if Item.EmptyWindow then Repaint; end; procedure TdxBarWinControl.WndProc(var Message: TMessage); var ASelfLink: TcxObjectLink; AMsg: TMsg; P: TPoint; FocusedParent: HWND; AItem: TdxBarWindowItem; procedure KillBeep; begin while PeekMessage(AMsg, Handle, WM_CHAR, WM_CHAR, PM_REMOVE) do; end; procedure DefaultHandler; begin with Message do Result := CallWindowProc(FPrevDefWndProc, FHandle, Msg, wParam, lParam); end; begin ASelfLink := cxAddObjectLink(Self); try with Message do begin case Msg of WM_SETFOCUS: Item.DoEnter; WM_KILLFOCUS: begin AItem := Item; try if Focused then begin DefaultHandler; //KillBeep; Parent.HideAll; Exit; end; if Parent is TdxBarControl then begin if GetFocus = Parent.Handle then FocusedParent := Parent.Handle else FocusedParent := GetParent(GetFocus); if not (FindControl(FocusedParent) is TdxBarControl) then FocusedParent := GetParent(FocusedParent); if FocusedParent <> Parent.Handle then begin DefaultHandler; KillBeep; Parent.HideAll; Exit; end; end; finally AItem.DoExit; end; end; WM_RBUTTONDOWN: begin P := SmallPointToPoint(TSmallPoint(lParam)); MapWindowPoints(Handle, Parent.Handle, P, 1); Result := SendMessage(Parent.Handle, Msg, wParam, MakeLParam(P.X, P.Y)); Exit; end; WM_CHAR: if DoKeyPress(TWMKey(Message)) then Exit; WM_KEYDOWN: if DoKeyDown(TWMKey(Message)) then Exit; WM_KEYUP: if DoKeyUp(TWMKey(Message)) then Exit; WM_SYSKEYDOWN, WM_SYSKEYUP: begin if Msg = WM_SYSKEYDOWN then Inc(FKeyPressedInside) else if FKeyPressedInside <> 0 then Dec(FKeyPressedInside) else Exit; if not (GetAsyncKeyState(VK_MENU) < 0) {Alt is not pressed} and ((wParam <> VK_MENU) or (Msg = WM_SYSKEYUP)) then begin FKeyPressedInside := 0; Parent.HideAll; if (wParam = VK_F10) and (GetAsyncKeyState(VK_SHIFT) < 0) then Exit; if wParam = VK_MENU then WaitForMenu := True; DontCallNextKeybHook := True; try if dxBarKeyboardHook(0, wParam, lParam) = 1 then Exit; finally DontCallNextKeybHook := False; end; end; end; end; if ASelfLink.Ref = nil then Exit; if Msg = WM_KEYDOWN then case wParam of VK_ESCAPE, VK_RETURN: begin Parent.SetKeySelectedItem(nil); KillBeep; if wParam = VK_ESCAPE then Parent.SelectedItem := Self else Parent.HideAll; end; VK_TAB: begin KillBeep; Result := SendMessage(Parent.Handle, Msg, wParam, lParam); end; else DefaultHandler; end else begin if (WM_MOUSEFIRST <= Msg) and (Msg <= WM_MOUSELAST) then begin P := SmallPointToPoint(TSmallPoint(lParam)); MapWindowPoints(Handle, Parent.Handle, P, 1); if (GetCapture <> Handle) and not PtInRect(WindowRect, P) and PtInRect(Parent.GetItemRect(Self), P) then Exit; end; if Msg = WM_DESTROY then Focused := False; if not ((Msg = WM_SYSKEYDOWN) and (WParam = VK_MENU)) then // to prevent SysMenu calling DefaultHandler; if Msg = WM_DESTROY then begin SetWindowLong(FHandle, GWL_WNDPROC, Longint(FPrevDefWndProc)); FreeObjectInstance(FDefWndProc); FDefWndProc := nil; FHandle := 0; end; end; end; finally cxRemoveObjectLink(ASelfLink); end; end; { TdxBarEditControl } function TdxBarEditControl.GetCaptionWidth: Integer; begin if ShowCaption then begin Result := Parent.Canvas.TextWidth(GetTextOf(Caption)); Result := PainterClass.EditControlCaptionWidth(Self, Result); end else Result := 0; end; function TdxBarEditControl.GetItem: TdxBarEdit; begin Result := TdxBarEdit(ItemLink.Item); end; function TdxBarEditControl.GetMaxLength: Integer; begin Result := Item.MaxLength; end; function TdxBarEditControl.GetReadOnly: Boolean; begin Result := Item.ReadOnly; end; function TdxBarEditControl.GetShowCaption: Boolean; begin Result := (Parent is TdxBarSubMenuControl) or Item.ShowCaption; end; procedure TdxBarEditControl.ControlClick(ByMouse: Boolean); begin inherited; if Focused then SendMessage(FHandle, EM_SETSEL, 0, -1); end; procedure TdxBarEditControl.CreateWindowHandle; begin FHandle := CreateWindowEx(0, 'EDIT', '', WS_CHILD or PainterClass.EditControlES_Style, 0, 0, 100, 100, Parent.Handle, 0, HInstance, nil); Text := Item.Text; SendMessage(FHandle, EM_SETLIMITTEXT, MaxLength, 0); inherited CreateWindowHandle; end; procedure TdxBarEditControl.DrawBorder(DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); begin PainterClass.EditControlDrawBorder(Self, DC, ARect, PaintType, Selected); end; procedure TdxBarEditControl.DrawCaption(DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); begin if not ShowCaption then Exit; PainterClass.EditControlDrawCaption(Self, DC, ARect, PaintType, Selected); end; function TdxBarEditControl.DrawSelected: Boolean; begin Result := inherited DrawSelected and not FParent.IsCustomizing; end; procedure TdxBarEditControl.DrawTextField(DC: HDC; const ARect: TRect); begin PainterClass.EditControlDrawTextField(Self, DC, ARect, False); end; function TdxBarEditControl.GetHeight: Integer; begin Result := Parent.EditTextSize; if ShowCaption and (Result < Parent.TextSize) then Result := Parent.TextSize; end; function TdxBarEditControl.GetMinWidth: Integer; begin Result := CaptionWidth + MinEditWidth; end; function TdxBarEditControl.GetWidth: Integer; begin Result := CaptionWidth + ItemLink.Width; end; procedure TdxBarEditControl.Paint(ARect: TRect; PaintType: TdxBarPaintType); var Selected: Boolean; R: TRect; DC: HDC; begin if ARect.Left = ARect.Right then Exit; Selected := DrawSelected; R := ARect; DC := Parent.Canvas.Handle; DrawCaption(DC, R, PaintType, Selected); DrawBorder(DC, R, PaintType, Selected); if Enabled then WindowRect := R; if not Focused or not Enabled then DrawTextField(DC, R); end; procedure TdxBarEditControl.SetFocused(Value: Boolean); begin if Value{Focused} then SendMessage(Handle, EM_SETREADONLY, WPARAM(ReadOnly or Item.EmptyWindow), 0); inherited; end; procedure TdxBarEditControl.SetText(Value: string); var ANotEqual: Boolean; begin ANotEqual := Text <> Value; inherited; PainterClass.EditControlUpdateWndText(Self, Handle, ANotEqual); end; procedure TdxBarEditControl.WidthChanged; begin FParent.RepaintBar; end; procedure TdxBarEditControl.WndProc(var Message: TMessage); var AHandle: HWND; RealItemLink: TdxBarItemLink; begin with Message do begin if (Msg = WM_KEYDOWN) and ((wParam = VK_RETURN) or (wParam = VK_TAB)) then begin AHandle := Handle; RealItemLink := ItemLink.RealItemLink; if (RealItemLink <> nil) and (wParam = VK_RETURN) then RealItemLink.BringToTopInRecentList(True); Item.Text := Text; if not IsWindowVisible(AHandle) then Exit; end; if (Msg = WM_COMMAND) and (HiWord(wParam) = EN_CHANGE) and not FFocusing then Item.CurChange; end; inherited WndProc(Message); end; { TdxBarManagerList } constructor TdxBarManagerList.Create; begin inherited Create; FList := TList.Create; end; destructor TdxBarManagerList.Destroy; begin while Count <> 0 do BarManagers[0].Free; FList.Free; inherited Destroy; end; function TdxBarManagerList.GetBarManager(Index: Integer): TdxBarManager; begin Result := nil; if (Index > -1) and (Index < Count) then Result := TdxBarManager(FList[Index]); end; function TdxBarManagerList.GetCount: Integer; begin Result := FList.Count; end; function TdxBarManagerList.GetCustomizingBarManager: TdxBarManager; var I: Integer; begin Result := nil; for I := 0 to Count - 1 do if BarManagers[I].IsCustomizing then begin Result := BarManagers[I]; Break; end; end; { TdxBarItemControlPainter } class procedure TdxBarItemControlPainter.DrawBackground(ABarItemControl: TdxBarItemControl; DC: HDC; R: TRect; ABrush: HBRUSH; AOpaque: Boolean); begin if AOpaque then FillRect(DC, R, ABrush) else begin ABarItemControl.CheckNonRecent; try ABarItemControl.Parent.FillBackground(DC, R, ABrush, clNone, True); finally ABarItemControl.UncheckNonRecent; end; end; end; class procedure TdxBarItemControlPainter.DrawBackgroundFrameRect(ABarItemControl: TdxBarItemControl; DC: HDC; R: TRect; ABrush: HBRUSH; AOpaque: Boolean); var AClipRgn: HRGN; AClipRgnExists: Boolean; begin if AOpaque then FrameRect(DC, R, ABrush) else begin SaveClipRgn(DC, AClipRgn, AClipRgnExists); InflateRect(R, -1, -1); with R do ExcludeClipRect(DC, Left, Top, Right, Bottom); InflateRect(R, 1, 1); DrawBackground(ABarItemControl, DC, R, ABrush, False); RestoreClipRgn(DC, AClipRgn, AClipRgnExists); end; end; class procedure TdxBarItemControlPainter.DrawDisabledShadowRect(ABarItemControl: TdxBarItemControl; DC: HDC; R: TRect); begin FillRect(DC, R, COLOR_BTNSHADOW + 1); end; class procedure TdxBarItemControlPainter.DrawGlyph(ABarItemControl: TdxBarItemControl; R: TRect; FullBounds: PRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, Center, ForceUseBkBrush, BarControlOwner, IsSplit: Boolean); var AWidth, AHeight, AImageWidth, AImageHeight: Integer; GlyphRect: TRect; procedure GetDimensions(var AWidth, AHeight: Integer); begin with R do begin AWidth := Right - Left; AHeight := Bottom - Top; if not Center then case PaintType of ptHorz: AWidth := ABarItemControl.BarManager.ButtonWidth; ptVert: AHeight := ABarItemControl.BarManager.ButtonHeight; end; end; end; procedure GetImageDimensions(var AWidth, AHeight: Integer); begin if (ABarItemControl.Glyph = nil) or ABarItemControl.Glyph.Empty then with ABarItemControl.Images[PaintType <> ptMenu] do begin AWidth := Width; AHeight := Height; end else with ABarItemControl.Glyph do begin AWidth := Width; AHeight := Height; end; end; procedure GetRealImageDimensions(var AImageWidth, AImageHeight: Integer); begin if PaintType = ptMenu then if ABarItemControl.BarManager.StretchGlyphs then begin if Center then AImageWidth := MulDiv(AImageWidth, AHeight, ABarItemControl.NormalItemHeightInSubMenu) else AImageWidth := MulDiv(AImageWidth, AWidth, ABarItemControl.NormalItemHeightInSubMenu); AImageHeight := MulDiv(AImageHeight, AHeight, ABarItemControl.NormalItemHeightInSubMenu); end else else begin if ABarItemControl.BarManager.LargeIcons then begin if ABarItemControl.BarManager.IsLargeImagesForLargeIcons then begin AImageWidth := ABarItemControl.BarManager.LargeImages.Width; AImageHeight := ABarItemControl.BarManager.LargeImages.Height; end else begin AImageWidth := 2 * AImageWidth; AImageHeight := 2 * AImageHeight; end; end; end; end; function GetImageBounds: TRect; begin Result := Bounds( R.Left + (AWidth - AImageWidth) div 2, R.Top + (AHeight - AImageHeight) div 2, AImageWidth, AImageHeight); if Down then OffsetRect(Result, GlyphDownShift(ABarItemControl), GlyphDownShift(ABarItemControl)); if DrawDowned then OffsetRect(Result, GlyphDrawDownedShift(ABarItemControl, Down), GlyphDrawDownedShift(ABarItemControl, Down)); end; begin GlyphRect := R; GetDimensions(AWidth, AHeight); IsGlyphEmpty := IsGlyphEmpty or not ABarItemControl.ImageExists; if not IsGlyphEmpty then begin GetImageDimensions(AImageWidth, AImageHeight); GetRealImageDimensions(AImageWidth, AImageHeight); GlyphRect := GetImageBounds; end; if FullBounds <> nil then R := FullBounds^; DrawGlyphAndBkgnd(ABarItemControl, R, GlyphRect, PaintType, ABarItemControl.Glyph, ABarItemControl.Images[PaintType <> ptMenu], ABarItemControl.ImageIndex, IsGlyphEmpty or not ABarItemControl.ImageExists, Selected, Down, DrawDowned, ForceUseBkBrush, False, BarControlOwner, IsSplit); end; class procedure TdxBarItemControlPainter.DrawGlyphAndBkgnd(ABarItemControl: TdxBarItemControl; R: TRect; const GlyphRect: TRect; PaintType: TdxBarPaintType; AGlyph: TBitmap; AImages: TCurImageList; AImageIndex: Integer; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner, IsSplit: Boolean); var DC: HDC; ABrush: HBRUSH; AWidth, AHeight, AImageWidth, AImageHeight: Integer; NeedBorder: Boolean; procedure GetDimensions(var AWidth, AHeight: Integer); begin with R do begin AWidth := Right - Left; AHeight := Bottom - Top; end; end; procedure GetImageDimensions(var AWidth, AHeight: Integer); begin with GlyphRect do begin AWidth := Right - Left; AHeight := Bottom - Top; end; end; begin DC := ABarItemControl.Parent.Canvas.Handle; GetDimensions(AWidth, AHeight); ABrush := GlyphBkgndBrush(ABarItemControl, PaintType, IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner); if IsGlyphEmpty then begin NeedBorder := (ABarItemControl.BarManager.GlyphSize + 2 <= AWidth) and (ABarItemControl.BarManager.GlyphSize + 2 <= AHeight); end else begin GetImageDimensions(AImageWidth, AImageHeight); NeedBorder := (AImageWidth + 2 <= AWidth) and (AImageHeight + 2 <= AHeight); end; if IsNativeBackground then DrawGlyphBorder(ABarItemControl, DC, ABrush, NeedBorder, R, PaintType, IsGlyphEmpty, Selected, Down, DrawDowned, BarControlOwner, IsSplit); if IsGlyphEmpty then begin DrawGlyphEmptyImage(ABarItemControl, DC, R, ABrush, NeedBorder, PaintType, Selected, Down, DrawDowned); end else begin DrawGlyphImage(ABarItemControl, DC, ABrush, NeedBorder, R, GlyphRect, AGlyph, AImages, AImageIndex, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner, PaintType); end; if not IsNativeBackground then DrawGlyphBorder(ABarItemControl, DC, ABrush, NeedBorder, R, PaintType, IsGlyphEmpty, Selected, Down, DrawDowned, BarControlOwner, IsSplit); end; class procedure TdxBarItemControlPainter.DrawGlyphAndTextInSubMenu(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Selected, ShowGlyph, Down: Boolean); begin // Required end; class procedure TdxBarItemControlPainter.DrawItemText(ABarItemControl: TdxBarItemControl; DC: HDC; S: string; PaintRect: TRect; Alignment: UINT; Enabled, Selected, Rotated, Clipped, FlatText: Boolean); var R: TRect; Format: UINT; ClipRgn: HRGN; TM: TTextMetric; AccelPos, OffsetY: Integer; Size, Size1: TSize; AFlat: Boolean; AColor1, AColor2: TColor; function GetAccelPos(S: string): Integer; var I: Integer; begin Result := 0; I := 1; while I < Length(S) do begin if S[I] = '&' then begin Delete(S, I, 1); if S[I] <> '&' then Result := I; end; Inc(I); end; end; procedure UnderlineAccel; var X, Y: Integer; Pen, PrevPen: HPEN; begin if AccelPos > 0 then begin Pen := CreatePen(PS_SOLID, 1, GetTextColor(DC)); PrevPen := SelectObject(DC, Pen); with R do begin X := (Left + Right - Size.cy) div 2 + TM.tmDescent - 2; Y := Top + OffsetY; MoveToEx(DC, X, Y, nil); LineTo(DC, X, Y + Size1.cx); end; SelectObject(DC, PrevPen); DeleteObject(Pen); end; end; begin R := PaintRect; SetBkMode(DC, TRANSPARENT); Format := DT_SINGLELINE; ClipRgn := 0; if not Clipped then Format := Format or DT_NOCLIP else if Rotated then begin Format := Format or DT_NOCLIP; ClipRgn := CreateRectRgn(0, 0, 0, 0); GetClipRgn(DC, ClipRgn); with PaintRect do IntersectClipRect(DC, Left, Top, Right, Bottom); end; if Rotated then begin GetTextMetrics(DC, TM); AccelPos := GetAccelPos(S); if AccelPos > 0 then begin S := GetTextOf(S); Format := Format or DT_NOPREFIX; end; with PaintRect do begin GetTextExtentPoint32(DC, PChar(S), Length(S), Size); case Alignment of DT_CENTER: OffsetY := (Bottom - Top - Size.cx) div 2; DT_LEFT: OffsetY := 0; DT_RIGHT: OffsetY := Bottom - Top - Size.cx; end; OffsetRect(PaintRect, (Right - Left + Size.cy) div 2, OffsetY); if AccelPos > 0 then begin GetTextExtentPoint32(DC, PChar(Copy(S, 1, AccelPos - 1)), AccelPos - 1, Size1); Inc(OffsetY, Size1.cx); GetTextExtentPoint32(DC, PChar(string(S[AccelPos])), 1, Size1); end; end; end else Format := Format or Alignment or DT_VCENTER; AFlat := IsFlatItemText and FlatText; // TODO and ... GetTextColors(ABarItemControl, Enabled, Selected, AFlat, AColor1, AColor2); SetTextColor(DC, ColorToRGB(AColor1)); if AColor2 <> AColor1 then begin OffsetRect(PaintRect, 1, 1); DrawText(DC, PChar(S), Length(S), PaintRect, Format); if Rotated then begin OffsetRect(R, 1, 1); UnderlineAccel; OffsetRect(R, -1, -1); end; OffsetRect(PaintRect, -1, -1); SetTextColor(DC, ColorToRGB(AColor2)); end; DrawText(DC, PChar(S), Length(S), PaintRect, Format); if Rotated then UnderlineAccel; if ClipRgn <> 0 then begin GetRgnBox(ClipRgn, R); if IsRectEmpty(R) then SelectClipRgn(DC, 0) else SelectClipRgn(DC, ClipRgn); DeleteObject(ClipRgn); end; SetBkMode(DC, OPAQUE); end; class procedure TdxBarItemControlPainter.DrawLowered(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect); begin // Required end; class procedure TdxBarItemControlPainter.DrawStaticBorder(ABarItemControl: TdxBarItemControl; DC: HDC; var ARect: TRect; ABorderWidth: Integer; ABorderStyle: TdxBarStaticBorderStyle); const Borders: array[TdxBarStaticBorderStyle] of Integer = (0, BDR_SUNKENOUTER, BDR_RAISEDINNER, EDGE_ETCHED, 0); begin if ABorderStyle = sbsNone then Exit; if ABorderStyle = sbsBump then begin DrawEdge(DC, ARect, BDR_RAISEDINNER, BF_RECT); InflateRect(ARect, -1, -1); DrawEdge(DC, ARect, BDR_SUNKENOUTER, BF_RECT); InflateRect(ARect, -1, -1); end else begin DrawEdge(DC, ARect, Borders[ABorderStyle], BF_RECT); InflateRect(ARect, -ABorderWidth, -ABorderWidth); end; end; class procedure TdxBarItemControlPainter.FrameAndFillRect(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Enabled, Selected, Pressed: Boolean); begin // Required end; class procedure TdxBarItemControlPainter.GetArrowParams(ABarItemControl: TdxBarItemControl; APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); begin AArrowColor := COLOR_BTNTEXT; ABrush := ABarItemControl.Parent.BkBrush; end; class function TdxBarItemControlPainter.GlyphBkgndBrush(ABarItemControl: TdxBarItemControl; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean): HBRUSH; begin Result := ABarItemControl.Parent.BkBrush; end; class function TdxBarItemControlPainter.GlyphDownShift(ABarItemControl: TdxBarItemControl): Integer; begin Result := 0; end; class function TdxBarItemControlPainter.GlyphDrawDownedShift(ABarItemControl: TdxBarItemControl; ADown: Boolean): Integer; begin Result := 0; end; class function TdxBarItemControlPainter.IsFlatItemText: Boolean; begin Result := False; end; class function TdxBarItemControlPainter.IsItemTextSelectedInverted: Boolean; begin Result := True; end; class function TdxBarItemControlPainter.LoweredBorderSize(ABarItemControl: TdxBarItemControl): Integer; begin Result := 0; end; class function TdxBarItemControlPainter.TextAreaOffset(ABarItemControl: TdxBarItemControl): Integer; begin if ABarItemControl.Parent is TdxBarSubMenuControl then Result := ABarItemControl.Parent.TextSize + 1 else Result := 0; end; class function TdxBarItemControlPainter.BeforeFingersSize: Integer; begin // Required Result := 0; end; class function TdxBarItemControlPainter.BorderSizeX: Integer; begin Result := GetSystemMetrics(SM_CXFRAME); end; class function TdxBarItemControlPainter.BorderSizeY: Integer; begin Result := GetSystemMetrics(SM_CYFRAME); end; class function TdxBarItemControlPainter.EmptyFingersSize: Integer; begin Result := 0; end; class function TdxBarItemControlPainter.FingersSize: Integer; begin // Required Result := 0; end; class function TdxBarItemControlPainter.GripperSize: Integer; begin Result := dxBarFingerSize; end; class function TdxBarItemControlPainter.RealButtonArrowWidth(ABarManager: TdxBarManager): Integer; begin Result := (1 + Byte(ABarManager.FLargeIcons)) * ABarManager.FButtonArrowWidth; if not Odd(Result) then Inc(Result); end; class function TdxBarItemControlPainter.RealLargeButtonArrowWidth(ABarManager: TdxBarManager): Integer; begin Result := ABarManager.FLargeButtonArrowWidth; end; class function TdxBarItemControlPainter.SubMenuBeginGroupIndent: Integer; begin // Required Result := 0; end; class procedure TdxBarItemControlPainter.DockControlFillBackground(ADockControl: TdxDockControl; DC: HDC; ADestR, ASourceR, AWholeR: TRect; ABrush: HBRUSH; AColor: TColor); begin FillBackgroundRect(DC, ADestR, ASourceR, ABrush, AColor, nil); end; class function TdxBarItemControlPainter.IsNativeBackground: Boolean; begin Result := False; end; class function TdxBarItemControlPainter.BarChildrenHaveShadows(ABarControl: TCustomdxBarControl): Boolean; begin Result := False; end; class procedure TdxBarItemControlPainter.BarDrawDockedBackground(ABarControl: TCustomdxBarControl; DC: HDC; ADestR, ASourceR: TRect; ABrush: HBRUSH; AColor: TColor); var ABounds: TRect; begin ABounds := ABarControl.BoundsRect; OffsetRect(ASourceR, ABounds.Left, ABounds.Top); ABarControl.DockControl.FillBackground(DC, ADestR, ASourceR, ABrush, AColor); end; class function TdxBarItemControlPainter.BarControlOwnerBrush(ABarManager: TdxBarManager): HBRUSH; begin Result := ABarManager.FlatToolbarsBrush; end; class procedure TdxBarItemControlPainter.BarDrawFloatingBackground(ABarControl: TCustomdxBarControl; DC: HDC; ADestR, ASourceR: TRect; ABrush: HBRUSH; AColor: TColor); begin FillBackgroundRect(DC, ADestR, ASourceR, ABrush, AColor, ABarControl.BarManager.Backgrounds.Bar); end; class procedure TdxBarItemControlPainter.BarDrawOwnerLink(ABarControl: TCustomdxBarControl; DC: HDC); begin if not IsRectEmpty(ABarControl.OwnerLinkBounds[False]) then FillRect(DC, ABarControl.OwnerLinkBounds[False], ABarControl.BarControlOwnerBrush); end; class function TdxBarItemControlPainter.BarHasShadow(ABarControl: TCustomdxBarControl): Boolean; begin Result := False; end; class function TdxBarItemControlPainter.BarToolbarBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin Result := GetSysColorBrush(COLOR_BTNFACE); end; class function TdxBarItemControlPainter.BarToolbarBrushEx(ABarControl: TdxBarControl): HBRUSH; begin Result := BarToolbarBrush(ABarControl); end; class function TdxBarItemControlPainter.BarToolbarDownedBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin Result := PatternBrush; end; class function TdxBarItemControlPainter.BarToolbarDownedSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin Result := GetSysColorBrush(COLOR_BTNFACE); end; class function TdxBarItemControlPainter.BarToolbarSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin Result := GetSysColorBrush(COLOR_HIGHLIGHT); end; class function TdxBarItemControlPainter.ComboBoxArrowWidth(ABarControl: TCustomdxBarControl; DC: HDC; cX: Integer): Integer; begin Result := 2 * cX - 1; end; class function TdxBarItemControlPainter.EditBorderSize(DC: HDC): Integer; begin Result := (2 + 1) * 2; end; class function TdxBarItemControlPainter.EditTextSize(ABarControl: TCustomdxBarControl; DC: HDC; cY: Integer): Integer; begin Result := cY + EditBorderSize(DC); end; class function TdxBarItemControlPainter.BarAllowHotTrack: Boolean; begin Result := False; end; class function TdxBarItemControlPainter.BarAllowQuickCustomizing: Boolean; begin Result := False; end; class function TdxBarItemControlPainter.BarBeginGroupSideSize: Integer; begin Result := (BarBeginGroupSize - (1 + 1){|}) div 2; end; class function TdxBarItemControlPainter.BarBeginGroupSize: Integer; begin Result := 2 + (1 + 1){|} + 2; end; class procedure TdxBarItemControlPainter.BarBorderPaintSizes(ABarControl: TdxBarControl; var R: TRect); begin R := Rect(BarBorderSize, BarBorderSize, BarBorderSize, BarBorderSize); end; class function TdxBarItemControlPainter.BarBorderSize: Integer; begin Result := 1; end; class procedure TdxBarItemControlPainter.BarBorderSizes(ABar: TdxBar; AStyle: TdxBarDockingStyle; var R: TRect); begin R := Rect(2, 2, 2, 2); end; class function TdxBarItemControlPainter.BarCaptionAreaSize: Integer; begin Result := BarCaptionSize + 1; end; class procedure TdxBarItemControlPainter.BarCaptionFillBackground(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); begin FillRect(DC, R, AToolbarBrush); end; class function TdxBarItemControlPainter.BarCaptionSize: Integer; var NonClientMetrics: TNonClientMetrics; begin NonClientMetrics.cbSize := SizeOf(NonClientMetrics); SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0); Result := NonClientMetrics.iSmCaptionHeight; end; class function TdxBarItemControlPainter.BarCaptionTransparent: Boolean; begin Result := False; end; class function TdxBarItemControlPainter.BarCloseButtonSize: TSize; begin Result.cx := BarCaptionSize; Result.cy := Result.cx; end; class procedure TdxBarItemControlPainter.BarDrawBeginGroup(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH; AHorz: Boolean); begin if AHorz then begin with ItemRect do begin ABarControl.FillBackground(DC, Rect(Left, Top, Right, Top + BarBeginGroupSideSize), AToolbarBrush, clNone, True); ABarControl.FillBackground(DC, Rect(Left, Bottom - BarBeginGroupSideSize, Right, Bottom), AToolbarBrush, clNone, True); end; InflateRect(ItemRect, 0, -BarBeginGroupSideSize); DrawEdge(DC, ItemRect, EDGE_ETCHED, BF_TOP) end else begin with ItemRect do begin ABarControl.FillBackground(DC, Rect(Left, Top, Left + BarBeginGroupSideSize, Bottom), AToolbarBrush, clNone, True); ABarControl.FillBackground(DC, Rect(Right - BarBeginGroupSideSize, Top, Right, Bottom), AToolbarBrush, clNone, True); end; InflateRect(ItemRect, -BarBeginGroupSideSize, 0); DrawEdge(DC, ItemRect, EDGE_ETCHED, BF_LEFT); end; end; class procedure TdxBarItemControlPainter.BarDrawCaptionElement(ABarControl: TdxBarControl; DC: HDC; R: TRect; AState: TdxBarMarkState); var ABrush: HBRUSH; begin if AState <> msNone then begin FrameFlatSelRect(DC, R); InflateRect(R, -1, -1); if AState = msSelected then ABrush := ABarControl.ToolbarSelBrush else ABrush := ABarControl.ToolbarDownedSelBrush; FillRect(DC, R, ABrush); end else begin ABrush := CreateSolidBrush(ABarControl.CaptionBkColor); FillRect(DC, R, ABrush); DeleteObject(ABrush); end; end; class procedure TdxBarItemControlPainter.BarDrawCloseButton(ABarControl: TdxBarControl; DC: HDC; R: TRect); begin // Required end; class procedure TdxBarItemControlPainter.BarDrawDockedBarBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); begin // Required end; class procedure TdxBarItemControlPainter.BarDrawFloatingBarBorder(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); begin // Required end; class procedure TdxBarItemControlPainter.BarDrawFloatingBarCaption(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); var NonClientMetrics: TNonClientMetrics; R1: TRect; X: Integer; ATransparent: Boolean; procedure DrawCaption; var S: string; AFont: HFONT; Size: TSize; APrevBkMode: Integer; AFlags: Integer; begin if R.Right - R.Left <= 0 then Exit; S := ABarControl.Bar.Caption; if not ABarControl.BarManager.UseSystemFont then with NonClientMetrics.lfSmCaptionFont, ABarControl.Bar.Font do begin if lfHeight > -11 then lfHeight := -11; Move(Name[1], lfFaceName, Length(Name)); lfFaceName[Length(Name)] := #0; end; AFont := SelectObject(DC, CreateFontIndirect(NonClientMetrics.lfSmCaptionFont)); // SetTextColor(DC, GetSysColor(COLOR_CAPTIONTEXT)); SetTextColor(DC, ABarControl.CaptionColor); SetBkColor(DC, ABarControl.CaptionBkColor); AFlags := ETO_CLIPPED; if ATransparent then APrevBkMode := SetBkMode(DC, TRANSPARENT) else begin AFlags := AFlags or ETO_OPAQUE; APrevBkMode := 0; // WARN OFF end; GetTextExtentPoint32(DC, PChar(S), Length(S), Size); ExtTextOut(DC, X, (R.Top + R.Bottom - Size.cy) div 2, AFlags, @R, PChar(S), Length(S), nil); if ATransparent then SetBkMode(DC, APrevBkMode); DeleteObject(SelectObject(DC, AFont)); end; begin NonClientMetrics.cbSize := SizeOf(NonClientMetrics); SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0); R1 := R; R1.Top := R.Bottom; R1.Bottom := R1.Top + 1; FillRect(DC, R1, AToolbarBrush); ATransparent := BarCaptionTransparent; if ATransparent then BarCaptionFillBackground(ABarControl, DC, R, AToolbarBrush); if ABarControl.Bar.CanClose then begin Dec(R.Right, BarCaptionSize); ABarControl.DrawCloseButton(DC); end; X := R.Left; if ABarControl.MarkExists then BarOffsetFloatingBarCaption(ABarControl, X, R) else Inc(X, 2); DrawCaption; if ABarControl.MarkExists then ABarControl.DrawMark(DC); end; class procedure TdxBarItemControlPainter.BarDrawMark(ABarControl: TdxBarControl; DC: HDC; MarkR: TRect); begin BarDrawMarkArrow(ABarControl, DC, MarkR); end; class procedure TdxBarItemControlPainter.BarDrawMarks(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); begin BarDrawMarkBackground(ABarControl, DC, ItemRect, AToolbarBrush); BarDrawMarkElements(ABarControl, DC, ItemRect); end; class procedure TdxBarItemControlPainter.BarDrawMDIButton(ABarControl: TdxBarControl; AButton: TdxBarMDIButton; ASelected, APressed: Boolean; DC: HDC; R: TRect); begin // Required end; class procedure TdxBarItemControlPainter.BarDrawStatusBarGrip(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); var R1: TRect; begin R1 := R; R1.Top := R1.Bottom - StatusBarGripSize(ABarControl.BarManager).cy; BarDrawGrip(ABarControl, DC, R1, AToolbarBrush); R1.Bottom := R1.Top; R1.Top := R.Top; ABarControl.FillBackground(DC, R1, AToolbarBrush, clNone, False); end; class procedure TdxBarItemControlPainter.BarDrawStatusBarTopBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); begin ABarControl.FillBackground(DC, R, AToolbarBrush, clNone, False); end; class function TdxBarItemControlPainter.BarHorSize: Integer; begin Result := 0; end; class function TdxBarItemControlPainter.BarMarkRect(ABarControl: TdxBarControl): TRect; begin Result := BarMarkItemRect(ABarControl); end; class function TdxBarItemControlPainter.BarMarkItemRect(ABarControl: TdxBarControl): TRect; begin // TODO: Required SetRectEmpty(Result); end; class procedure TdxBarItemControlPainter.BarMarkRectInvalidate(ABarControl: TdxBarControl); var DC: HDC; R: TRect; begin if ABarControl.DockingStyle = dsNone then begin DC := GetWindowDC(ABarControl.Handle); ABarControl.DrawMark(DC); ReleaseDC(ABarControl.Handle, DC); end else begin R := BarMarkItemRect(ABarControl); InvalidateRect(ABarControl.Handle, @R, False); end; end; class function TdxBarItemControlPainter.BarTopSize: Integer; begin Result := 0; end; class function TdxBarItemControlPainter.BarBottomSize: Integer; begin Result := 0; end; class function TdxBarItemControlPainter.BarUseSystemClose: Boolean; begin Result := False; end; class function TdxBarItemControlPainter.BarUseSystemNCBorder: Boolean; begin Result := False; end; class procedure TdxBarItemControlPainter.StatusBarFillBackground(ABarControl: TdxBarControl; DC: HDC; ADestR, ASourceR, AWholeR: TRect; ABrush: HBRUSH; AColor: TColor); begin FillBackgroundRect(DC, ADestR, ASourceR, ABrush, AColor, nil); end; class function TdxBarItemControlPainter.StatusBarGripSize(ABarManager: TdxBarManager): TSize; begin Result.cx := GetSystemMetrics(SM_CXHSCROLL); Result.cy := GetSystemMetrics(SM_CYHSCROLL); end; class function TdxBarItemControlPainter.StatusBarTopBorderSize(ABarManager: TdxBarManager): Integer; begin Result := 2; end; class function TdxBarItemControlPainter.BarToolbarBrushEx2(ABarControl: TdxBarControl): HBRUSH; begin Result := BarToolbarBrushEx(ABarControl); end; class procedure TdxBarItemControlPainter.DrawQuickCustItemFrame(ABarItemControl: TdxBarItemControl; DC: HDC; var R, ARect: TRect; Selected: Boolean); begin with R do Right := Left + Bottom - Top; ARect.Left := R.Right; end; class procedure TdxBarItemControlPainter.DrawQuickCustItemFrameSelected(ABarItemControl: TdxBarItemControl; DC: HDC; WholeR, R: TRect; Selected: Boolean); begin end; class function TdxBarItemControlPainter.IsQuickControlPopupOnRight: Boolean; begin Result := False; end; class function TdxBarItemControlPainter.ButtonBorderHeight: Integer; begin Result := dxBarButtonBorderHeight; end; class function TdxBarItemControlPainter.ButtonBorderWidth: Integer; begin Result := dxBarButtonBorderWidth; end; class procedure TdxBarItemControlPainter.CorrectButtonControlDefaultHeight(var DefaultHeight: Integer); begin end; class procedure TdxBarItemControlPainter.CorrectButtonControlDefaultWidth(ABarItemControl: TdxBarItemControl; var DefaultWidth: Integer); begin end; class procedure TdxBarItemControlPainter.DrawButtonControlArrow(ABarItemControl: TdxBarItemControl; DC: HDC; R1: TRect; Brush: HBRUSH; ArrowColor: COLORREF; Selected, DrawDowned, DroppedDown, DropDownEnabled, IsDropDownMenuControlExist: Boolean; PaintType: TdxBarPaintType); begin // Required end; class function TdxBarItemControlPainter.IsDropDownRepaintNeeded: Boolean; begin Result := False; end; class procedure TdxBarItemControlPainter.OffsetCaptionBounds(ABarButtonControl: TdxBarButtonControl; APressed: Boolean; var R: TRect); begin end; class procedure TdxBarItemControlPainter.OffsetEllipsisBounds(ABarItemControl: TdxBarItemControl; APressed: Boolean; var R: TRect); begin end; class function TdxBarItemControlPainter.ComboControlArrowOffset: Integer; begin Result := 1; end; class procedure TdxBarItemControlPainter.ComboControlDrawArrow(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; Selected: Boolean; PaintType: TdxBarPaintType); begin // Required end; class procedure TdxBarItemControlPainter.ComboControlGetArrowParams(ABarItemControl: TdxBarItemControl; APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); begin GetArrowParams(ABarItemControl, APaintType, AEnabled, ASelected, ADroppedDown, ABrush, AArrowColor); end; class function TdxBarItemControlPainter.DropDownListBoxBorderSize: Integer; begin // Required Result := 0; end; class procedure TdxBarItemControlPainter.DropDownListBoxDrawBorder(ABarManager: TdxBarManager; DC: HDC; R: TRect); begin // Required end; class function TdxBarItemControlPainter.SubItemControlCaptionOffset(ABarSubItemControl: TdxBarSubItemControl): Integer; begin Result := -ABarSubItemControl.Parent.Canvas.Font.Height div 2; end; class function TdxBarItemControlPainter.SubItemControlDefaultHeight(ABarSubItemControl: TdxBarSubItemControl): Integer; begin if ABarSubItemControl.Parent is TdxBarControl then begin if ABarSubItemControl.ImageExists or not ABarSubItemControl.Item.ShowCaption then if not IsVertical(ABarSubItemControl.Parent) then Result := ABarSubItemControl.BarManager.ButtonHeight else Result := ABarSubItemControl.BarManager.ButtonWidth else Result := 0; if (Result = 0) or ABarSubItemControl.Item.ShowCaption and (Result < ABarSubItemControl.Parent.TextSize) then Result := ABarSubItemControl.Parent.TextSize; end else Result := ABarSubItemControl.Parent.TextSize; end; class function TdxBarItemControlPainter.SubItemControlDefaultWidth(ABarSubItemControl: TdxBarSubItemControl): Integer; begin with ABarSubItemControl.Parent.Canvas do if ABarSubItemControl.Parent is TdxBarSubMenuControl then Result := 2 * ABarSubItemControl.Parent.TextSize + 3 + TextWidth(GetTextOf(ABarSubItemControl.Caption)) else begin if ABarSubItemControl.Item.ShowCaption then Result := TextWidth(GetTextOf(ABarSubItemControl.Caption)) else Result := 0; if ABarSubItemControl.ImageExists or not ABarSubItemControl.Item.ShowCaption then begin if not IsVertical(ABarSubItemControl.Parent) then Inc(Result, ABarSubItemControl.BarManager.ButtonWidth) else Inc(Result, ABarSubItemControl.BarManager.ButtonHeight); if ABarSubItemControl.Item.ShowCaption then Inc(Result, 4); end else Inc(Result, 2 * ABarSubItemControl.CaptionOffset); if not TdxBarControl(ABarSubItemControl.Parent).Bar.IsMainMenu then Inc(Result, ABarSubItemControl.Parent.TextSize div 2); end; end; class procedure TdxBarItemControlPainter.SubItemControlDraw(ABarSubItemControl: TdxBarSubItemControl; DC: HDC; R: TRect; Selected, Down: Boolean; PaintType: TdxBarPaintType); procedure DrawArrow; var Size: Integer; begin if PaintType = ptMenu then Size := ABarSubItemControl.Parent.MenuArrowHeight else Size := ABarSubItemControl.Parent.MenuArrowHeight - 1; with R do case PaintType of ptMenu: begin Left := Right - ABarSubItemControl.Parent.TextSize + Size; DrawLargeItemArrow(DC, R, atRight, Size, Selected, ABarSubItemControl.Enabled, False{Flat}); end; ptHorz: begin Left := Right - ABarSubItemControl.Parent.TextSize div 2 + ABarSubItemControl.Parent.Canvas.Font.Height div 2; DrawLargeItemArrow(DC, R, atDown, Size, False, ABarSubItemControl.Enabled, False{Flat}); end; ptVert: begin Top := Bottom - ABarSubItemControl.Parent.TextSize div 2 + ABarSubItemControl.Parent.Canvas.Font.Height div 2; DrawLargeItemArrow(DC, R, atRight, Size, False, ABarSubItemControl.Enabled, False{Flat}); end; end; end; begin with R do if PaintType = ptMenu then begin DrawGlyphAndTextInSubMenu(ABarSubItemControl, DC, R, Selected, True, False); DrawArrow; end else begin DrawGlyph(ABarSubItemControl, R, nil, PaintType, False, Selected, Down, False, False, False, True, False); if ABarSubItemControl.ImageExists or not ABarSubItemControl.Item.ShowCaption then if PaintType = ptHorz then Inc(Left, ABarSubItemControl.BarManager.ButtonWidth) else Inc(Top, ABarSubItemControl.BarManager.ButtonHeight) else if PaintType = ptHorz then Inc(Left, ABarSubItemControl.CaptionOffset) else Inc(Top, ABarSubItemControl.CaptionOffset); if Down and not (IsMenuItem(ABarSubItemControl)) then OffsetRect(R, 1, 1); // *** if ABarSubItemControl.Item.ShowCaption then DrawItemText(ABarSubItemControl, DC, ABarSubItemControl.Caption, R, DT_LEFT, ABarSubItemControl.Enabled, IsMenuItem(ABarSubItemControl) and Selected{***}, PaintType = ptVert, False, False); if not TdxBarControl(ABarSubItemControl.Parent).Bar.IsMainMenu then DrawArrow; end; end; class function TdxBarItemControlPainter.SubMenuControlArrowsOffset: Integer; begin Result := 2; end; class function TdxBarItemControlPainter.SubMenuControlBeginGroupSize: Integer; begin Result := 4 + 2 + 4; end; class function TdxBarItemControlPainter.SubMenuControlBorderSize: Integer; begin Result := 3; end; class procedure TdxBarItemControlPainter.SubMenuControlCalcDrawingConsts(ABarSubMenuControl: TdxBarSubMenuControl; var ATextSize, AMenuArrowWidth, AMarkSize, ANormalItemHeight: Integer); var Size: Integer; begin AMenuArrowWidth := ATextSize div 4 * 3 + 1; AMarkSize := ABarSubMenuControl.Canvas.TextHeight('0') + 1; Size := SubMenuControlMarkArrowSize(ABarSubMenuControl, AMarkSize); if Odd(Size) then AMarkSize := (Size - 1) * 2 + 2 * 3; ANormalItemHeight := 19; end; class procedure TdxBarItemControlPainter.SubMenuControlCalcRect(ABarSubMenuControl: TdxBarSubMenuControl; Size: PPoint; var R: TRect; var AClientHeight: Integer); begin with ABarSubMenuControl do begin R := Rect(2 + BarSize, 2 * Byte(not Detachable), ClientWidth - 2, 2 * Byte(not Detachable)); if Size = nil then AClientHeight := ClientHeight - 1 - 1 - TextSize * Byte(MarkExists) else begin Size^.X := 0; AClientHeight := MaxInt; end; end; end; class procedure TdxBarItemControlPainter.SubMenuControlCalcSize(ABarSubMenuControl: TdxBarSubMenuControl; Size: PPoint; var R: TRect); begin with ABarSubMenuControl do begin if Size^.X = 0 then Size^.X := 100 else Inc(Size^.X, 2 * 3 + BarSize); if (R.Top <= 2) or MarkExists then Inc(R.Top, TextSize); Size^.Y := 1 + R.Top + 3; if Detachable then Inc(Size^.Y, DetachCaptionAreaSize); end; end; class function TdxBarItemControlPainter.SubMenuControlIsOffsetRecentGroupNeeded: Boolean; begin Result := False; end; class function TdxBarItemControlPainter.SubMenuControlDetachCaptionAreaSize(ABarSubMenuControl: TdxBarSubMenuControl): Integer; begin Result := 2 + ABarSubMenuControl.DetachCaptionSize + 1; end; class procedure TdxBarItemControlPainter.SubMenuControlDrawArrowsArea(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; ABrush: HBRUSH; AMaxVisibleCount: Integer); const BrushColors: array[Boolean] of COLORREF = (COLOR_BTNHIGHLIGHT, COLOR_BTNSHADOW); var R: TRect; AControl: TdxBarItemControl; begin with ABarSubMenuControl do begin if UpArrowExists then begin R := ItemLinks.VisibleItems[TopIndex].ItemRect; SubMenuControlDrawArrow(ABarSubMenuControl, DC, R, True); DrawBackground(ItemLinks.VisibleItems[TopIndex].Control, DC, R, ToolbarItemsBrush, False); SelectClipRgn(DC, 0); end; AControl := ItemLinks.VisibleItems[TopIndex + AMaxVisibleCount - 1].Control; R := GetItemRectEx(AControl, True); if DownArrowExists then begin SubMenuControlDrawArrow(ABarSubMenuControl, DC, R, False); if AControl.FChangeRecentGroup then begin with R do DrawBackground(AControl, DC, Rect(Left - 1, Top, Right + 1, Top + 1), BrushColors[AControl.FNonRecent] + 1, False); Inc(R.Top); end; DrawBackground(AControl, DC, R, ToolbarItemsBrush, False); end; R.Top := R.Bottom; R.Bottom := ClientHeight - SubMenuControlArrowsOffset; if MarkExists then Dec(R.Bottom, TextSize); DrawBackground(AControl, DC, R, ToolbarItemsBrush, False); if DownArrowExists then SelectClipRgn(DC, 0); if MarkExists then begin R.Top := R.Bottom; R.Bottom := R.Top + TextSize; Dec(R.Bottom, MarkSize); DrawBackground(AControl, DC, R, ToolbarItemsBrush, False); R.Top := R.Bottom; Inc(R.Bottom, MarkSize); if MarkState = msSelected then begin DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT); ABrush := FLightBrush; InflateRect(R, -1, -1); PreparePalette(DC); DrawBackground(AControl, DC, R, ABrush, False); UnpreparePalette(DC); InflateRect(R, 1, 1); end else DrawBackground(AControl, DC, R, ToolbarItemsBrush, False); SubMenuControlDrawMark(ABarSubMenuControl, DC, R, False); end; end; end; class procedure TdxBarItemControlPainter.SubMenuControlDrawBackground(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; ARect: TRect; ABrush: HBRUSH; AColor: TColor); begin FillBackgroundRect(DC, ARect, ARect, ABrush, AColor, ABarSubMenuControl.GetBackgroundBitmap); end; class procedure TdxBarItemControlPainter.SubMenuControlDrawBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); begin with R do begin FillRect(DC, Rect(Left, Top, Left + 1, Bottom - 1), COLOR_BTNFACE + 1); FillRect(DC, Rect(Left + 1, Top, Right - 1, Top + 1), COLOR_BTNFACE + 1); end; DrawEdge(DC, R, BDR_RAISEDOUTER, BF_BOTTOMRIGHT); if ABarSubMenuControl.Detachable then begin InflateRect(R, -1, -1); DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT - BF_BOTTOM); InflateRect(R, -1, -1); R.Bottom := R.Top + ABarSubMenuControl.DetachCaptionAreaSize - 1; FrameRect(DC, R, GetSysColorBrush(COLOR_BTNFACE)); SubMenuControlDrawDetachCaption(ABarSubMenuControl, DC, ABarSubMenuControl.DetachCaptionRect); end; end; class procedure TdxBarItemControlPainter.SubMenuControlDrawClientBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; var R: TRect; ABrush: HBRUSH); begin if ABarSubMenuControl.Detachable then Dec(R.Top, 2); DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT); InflateRect(R, -1, -1); FrameRect(DC, R, ABrush); end; class procedure TdxBarItemControlPainter.SubMenuControlDrawDetachCaption(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); const Colors: array[Boolean] of COLORREF = (COLOR_INACTIVECAPTION, COLOR_ACTIVECAPTION); begin FillRect(DC, R, Colors[ABarSubMenuControl.DetachCaptionSelected] + 1); end; class procedure TdxBarItemControlPainter.SubMenuControlDrawBeginGroup(ABarSubMenuControl: TdxBarSubMenuControl; AControl: TdxBarItemControl; DC: HDC; AItemRect: TRect; LeftDelta: Integer); var R: TRect; ABrush: HBRUSH; LD, RD: Integer; AOpaque: Boolean; begin RD := Byte(AControl.FNonRecent); R := AItemRect; if AControl.FChangeRecentGroup and AControl.FNonRecent then begin Dec(R.Top); RD := 0; ABrush := ABarSubMenuControl.ToolbarBrush; end else ABrush := ABarSubMenuControl.BkBrush; LD := RD * LeftDelta; R.Bottom := R.Top; Dec(R.Top, ABarSubMenuControl.BeginGroupSize); AControl.FBeginGroupRect := R; AOpaque := AControl.FNonRecent and not AControl.FChangeRecentGroup; with R do begin DrawBackground(AControl, DC, Rect(Left - LD, Top, Right + 2 * RD, Top + 4), ABrush, AOpaque); DrawBackground(AControl, DC, Rect(Left - LD, Bottom - 4, Right + 2 * RD, Bottom), ABrush, AOpaque); DrawBackground(AControl, DC, Rect(Left - LD, Top + 4, Left + ABarSubMenuControl.BarManager.SubMenuBeginGroupIndent, Bottom - 4), ABrush, AOpaque); DrawBackground(AControl, DC, Rect(Right - ABarSubMenuControl.BarManager.SubMenuBeginGroupIndent, Top + 4, Right + 2 * RD, Bottom - 4), ABrush, AOpaque); InflateRect(R, -ABarSubMenuControl.BarManager.SubMenuBeginGroupIndent, -4); DrawEdge(DC, R, EDGE_ETCHED, BF_TOP); end; end; class procedure TdxBarItemControlPainter.SubMenuControlDrawItemFrame(ABarSubMenuControl: TdxBarSubMenuControl; AControl: TdxBarItemControl; DC: HDC; AItemRect: TRect; AIndex, LeftDelta: Integer); begin end; class function TdxBarItemControlPainter.SubMenuControlMarkArrowSize(ABarSubMenuControl: TdxBarSubMenuControl; AMarkSize: Integer): Integer; begin Result := (AMarkSize - 2 * (2 + 1)) div 2; end; class function TdxBarItemControlPainter.SubMenuControlMarkRectOffset(ABarSubMenuControl: TdxBarSubMenuControl): Integer; begin Result := 1; end; class procedure TdxBarItemControlPainter.SubMenuControlOffsetDetachCaptionRect(ABarSubMenuControl: TdxBarSubMenuControl; var R: TRect); begin InflateRect(R, -3, -3); end; class procedure TdxBarItemControlPainter.SubMenuControlPrepareBkBrush(ABarSubMenuControl: TdxBarSubMenuControl; var ABkBrush: HBRUSH); begin end; class function TdxBarItemControlPainter.SubMenuControlToolbarItemsBrush(ABarSubMenuControl: TdxBarSubMenuControl): HBRUSH; begin Result := COLOR_BTNFACE + 1; end; class procedure TdxBarItemControlPainter.EditDrawInterior(ABarEditControl: TdxBarEditControl; ABarEdit: TdxBarEdit; ACanvas: TCanvas; R: TRect; ItemLink: TdxBarItemLink); var DC: HDC; S: string; begin DC := ACanvas.Handle; FillRect(DC, R, ACanvas.Brush.Handle); // draw only client area Inc(R.Left, 2); Dec(R.Right, 2); EditOffsetInteriorRect(R); if ABarEdit.FocusedItemLink = ItemLink then S := ABarEdit.CurText else S := ABarEdit.Text; SetBkMode(DC, TRANSPARENT); DrawText(DC, PChar(S), Length(S), R, DT_NOPREFIX); SetBkMode(DC, OPAQUE); end; class procedure TdxBarItemControlPainter.CustomComboDrawItem(ABarCustomCombo: TdxBarCustomCombo; ACanvas: TCanvas; AIndex: Integer; ARect: TRect; AState: TOwnerDrawState; AInteriorIsDrawing: Boolean); var S: string; begin with ACanvas, ARect do begin if AIndex = -1 then S := ABarCustomCombo.Text else S := ABarCustomCombo.Items[AIndex]; FillRect(ARect); TextOut(Left + 2, Top, S); end; end; class function TdxBarItemControlPainter.EditControlCaptionWidth(ABarEditControl: TdxBarEditControl; ATextWidth: Integer): Integer; begin Result := 2 + ATextWidth + 4; end; class procedure TdxBarItemControlPainter.EditControlDrawBorder(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); var Brush: HBRUSH; begin if Selected then DrawEdge(DC, ARect, BDR_SUNKENOUTER, BF_RECT) else DrawBackgroundFrameRect(ABarEditControl, DC, ARect, ABarEditControl.Parent.BkBrush, ABarEditControl.FNonRecent); InflateRect(ARect, -1, -1); if ABarEditControl.Enabled then Brush := ABarEditControl.Parent.BkBrush else Brush := GetSysColorBrush(COLOR_BTNHIGHLIGHT); DrawBackgroundFrameRect(ABarEditControl, DC, ARect, Brush, (Selected or ABarEditControl.FNonRecent) or not ABarEditControl.Enabled); InflateRect(ARect, -1, -1); end; class procedure TdxBarItemControlPainter.EditControlDrawCaption(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); var S: string; Size: TSize; R: TRect; Brush: HBRUSH; begin S := GetTextOf(ABarEditControl.Caption); GetTextExtentPoint32(DC, PChar(S), Length(S), Size); R := ARect; R.Right := R.Left + 2 + Size.cX; ARect.Left := R.Right + 4; if Selected and (PaintType = ptMenu) then Brush := ABarEditControl.Parent.ToolbarSelBrush else Brush := ABarEditControl.Parent.BkBrush; DrawBackground(ABarEditControl, DC, R, Brush, (PaintType = ptMenu) and (Selected or ABarEditControl.FNonRecent)); DrawItemText(ABarEditControl, DC, ABarEditControl.Caption, R, DT_RIGHT, ABarEditControl.Enabled, Selected and (PaintType = ptMenu), False, False, False); R.Left := R.Right; R.Right := ARect.Left; DrawBackground(ABarEditControl, DC, R, ABarEditControl.Parent.BkBrush, (PaintType = ptMenu) and ABarEditControl.FNonRecent); end; class procedure TdxBarItemControlPainter.EditControlDrawTextField(ABarEditControl: TdxBarEditControl; DC: HDC; const ARect: TRect; AIgnoreEnabled: Boolean); var ATextColor, ABkColor: COLORREF; PrevClipRgn: HRGN; ClipRgnExists: Boolean; PrevFont: HFONT; begin // if ABarEditControl.Enabled or AIgnoreEnabled then if True then begin GetEditColors(ABarEditControl, ATextColor, ABkColor); SetTextColor(DC, ATextColor); SaveClipRgn(DC, PrevClipRgn, ClipRgnExists); with ARect do IntersectClipRect(DC, Left, Top, Right, Bottom); try with ABarEditControl.Parent.Canvas do begin Font.Color := ATextColor; Brush.Color := ABkColor; Handle; // RequiredState(csAllValid) end; PrevFont := SelectObject(DC, ABarEditControl.Parent.EditFontHandle); try ABarEditControl.Item.DrawInterior(ABarEditControl, ABarEditControl.Parent.Canvas, ARect, ABarEditControl.ItemLink); finally if GetObjectType(PrevFont) = OBJ_FONT then SelectObject(DC, PrevFont); end; finally RestoreClipRgn(DC, PrevClipRgn, ClipRgnExists); end; end else FillRect(DC, ARect, ABarEditControl.Parent.BkBrush); end; class function TdxBarItemControlPainter.EditControlES_Style: Integer; begin Result := ES_AUTOHSCROLL; end; class procedure TdxBarItemControlPainter.EditControlPrepareEditWnd(ABarEditControl: TdxBarEditControl; AHandle: HWND); begin end; class procedure TdxBarItemControlPainter.ColorComboDrawCustomButton(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; var ACustomColorButtonRect: TRect; Selected, Pressed: Boolean); var DotSize, I: Integer; begin with ARect do begin DrawBackgroundFrameRect(ABarComboControl, DC, ARect, ABarComboControl.Parent.BkBrush, False); InflateRect(ARect, 0, -1); DrawBackgroundFrameRect(ABarComboControl, DC, ARect, ABarComboControl.Parent.BkBrush, False); InflateRect(ARect, -1, -1); ACustomColorButtonRect := ARect; FrameAndFillRect(ABarComboControl, DC, ARect, ABarComboControl.Enabled, Selected, Pressed); // draw dots DotSize := (Right - Left) div 7; Right := Left; Dec(Bottom, DotSize); Top := Bottom - DotSize; OffsetEllipsisBounds(ABarComboControl, Pressed, ARect); for I := 0 to 2 do begin Left := Right + DotSize; Right := Left + DotSize; if ABarComboControl.Enabled then begin if IsHighContrastWhite and Selected then FillRect(DC, ARect, COLOR_BTNFACE + 1) else FillRect(DC, ARect, COLOR_BTNTEXT + 1); end else DrawDisabledShadowRect(ABarComboControl, DC, ARect); end; end; end; class procedure TdxBarItemControlPainter.SysPanelCalcSize(AHandle: HWND; var ARect: TRect; var Corner: TdxCorner; Combo: TdxBarItem; AllowResizing: Boolean); var R: TRect; AControl: TdxBarWinControl; begin InflateRect(ARect, -1, -1); if AllowResizing and (Combo.CurItemLink <> nil) and (Combo.CurItemLink.Control <> nil) then begin GetWindowRect(AHandle, R); AControl := TdxBarWinControl(Combo.CurItemLink.Control); MapWindowPoints(0, AControl.Parent.Handle, R, 2); Corner := GetCornerForRects(AControl.WindowRect, R); with ARect do if Corner in [coBottomLeft, coBottomRight] then Dec(Bottom, SysPanelSize) else Inc(Top, SysPanelSize); end; end; class procedure TdxBarItemControlPainter.SysPanelDraw(AHandle: HWND; AllowResizing, MouseAboveCloseButton, CloseButtonIsTracking: Boolean; var CloseButtonRect, GripRect: TRect; Corner: TdxCorner); begin dxBarPopupNCPaint(AHandle, AllowResizing, False, MouseAboveCloseButton, CloseButtonIsTracking, CloseButtonRect, GripRect, Corner); end; class function TdxBarItemControlPainter.SysPanelSize: Integer; begin Result := dxDropDownNCHeight; end; class function TdxBarItemControlPainter.IsDateNavigatorFlat: Boolean; begin Result := False; end; class procedure TdxBarItemControlPainter.DateNavigatorDrawButton(ABarItem: TdxBarItem; DC: HDC; R: TRect; const ACaption: string; APressed: Boolean); var Offset: Integer; APrevPen: HPEN; begin Offset := 0; with R do begin if APressed then begin DrawFrameControl(DC, R, DFC_BUTTON, DFCS_BUTTONPUSH or DFCS_PUSHED); Offset := 1; end else begin APrevPen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNTEXT))); MoveToEx(DC, Left, Bottom - 1, nil); LineTo(DC, Right - 1, Bottom - 1); LineTo(DC, Right - 1, Top); DeleteObject(SelectObject(DC, APrevPen)); APrevPen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNFACE))); LineTo(DC, Left, Top); LineTo(DC, Left, Bottom - 1); DeleteObject(SelectObject(DC, APrevPen)); APrevPen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW))); MoveToEx(DC, Left + 1, Bottom - 2, nil); LineTo(DC, Right - 2, Bottom - 2); LineTo(DC, Right - 2, Top + 1); DeleteObject(SelectObject(DC, APrevPen)); APrevPen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT))); MoveToEx(DC, Left + 1, Bottom - 3, nil); LineTo(DC, Left + 1, Top + 1); LineTo(DC, Right - 2, Top + 1); DeleteObject(SelectObject(DC, APrevPen)); SetPixel(DC, Right - 2, Top + 1, GetSysColor(COLOR_BTNFACE)); end; InflateRect(R, -2, -2); end; // draw button's caption DateNavigatorDrawButtonCaption(DC, R, Offset, ACaption, True); end; class function TdxBarItemControlPainter.DateNavigatorHeaderColor: TColor; begin Result := clBtnFace; end; class procedure TdxBarItemControlPainter.SpinEditControlDrawButton(ABarEditControl: TdxBarEditControl; DC: HDC; ARect: TRect; XSize, YSize, Size: Integer; Selected: Boolean; AButton, AActiveButton: TdxBarSpinEditButton; AButtonPressed: Boolean); var R: TRect; begin R := ARect; with R do begin if AButton = sbUp then Bottom := Top + Size else Inc(Top, Size); FrameAndFillRect(ABarEditControl, DC, R, ABarEditControl.Enabled, Selected, (AActiveButton = AButton) and AButtonPressed); Inc(Left, YSize); Top := (Top + Bottom - YSize) div 2 + Byte(AButton = sbUp) * (YSize - 1); if (AActiveButton = AButton) and AButtonPressed then begin Inc(Left); Inc(Top); end; if ABarEditControl.Enabled then SpinEditControlDrawOneArrow(DC, Left, Top, XSize, YSize, COLOR_BTNTEXT, AButton) else begin SpinEditControlDrawOneArrow(DC, Left + 1, Top + 1, XSize, YSize, COLOR_BTNHIGHLIGHT, AButton); SpinEditControlDrawOneArrow(DC, Left, Top, XSize, YSize, COLOR_BTNSHADOW, AButton); end; end; end; class procedure TdxBarItemControlPainter.SpinEditControlDrawFrame(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect); begin with ARect do begin DrawBackground(ABarEditControl, DC, Rect(Left, Top, Left + 1, Bottom), ABarEditControl.Parent.BkBrush, False); DrawBackground(ABarEditControl, DC, Rect(Right - 1, Top, Right, Bottom), ABarEditControl.Parent.BkBrush, False); Inc(Left); Dec(Right); end; end; class function TdxBarItemControlPainter.ProgressControlBarBrushColor: TColorRef; begin Result := GetSysColor(COLOR_HIGHLIGHT); end; class function TdxBarItemControlPainter.ProgressControlBarHeight(ABarItemControl: TdxBarItemControl): Integer; begin Result := 12; end; class procedure TdxBarItemControlPainter.ProgressControlDrawBar(ABarItemControl: TdxBarItemControl; DC: HDC; BarR: TRect; ABarBrushColor: TColorRef; PaintType: TdxBarPaintType; ASmooth: Boolean; Position, Min, Max: Integer); var R: TRect; Limit, Step: Integer; ALeft, ARight: ^Integer; ABarBrush: HBRUSH; begin R := BarR; with R do if PaintType = ptVert then begin ALeft := @Top; ARight := @Bottom; end else begin ALeft := @Left; ARight := @Right; end; ARight^ := ALeft^ + MulDiv(ARight^ - ALeft^, Position - Min, Max - Min); Limit := ARight^; ABarBrush := CreateSolidBrush(ABarBrushColor); if ASmooth then FillRect(DC, R, ABarBrush) else begin with R do if PaintType = ptVert then Step := MulDiv(Right - Left, 2, 3) else Step := MulDiv(Bottom - Top, 2, 3); repeat ARight^ := ALeft^ + Step; if ARight^ > Limit then ARight^ := Limit; FillRect(DC, R, ABarBrush); ALeft^ := ARight^; Inc(ARight^, 2); if ARight^ > Limit then ARight^ := Limit; DrawBackground(ABarItemControl, DC, R, ABarItemControl.Parent.BkBrush, False); ALeft^ := ARight^; until ARight^ = Limit; end; if PaintType = ptVert then BarR.Top := Limit else BarR.Left := Limit; DrawBackground(ABarItemControl, DC, BarR, ABarItemControl.Parent.BkBrush, False); DeleteObject(ABarBrush); end; class function TdxBarItemControlPainter.ProgressControlIndent(ABarItemControl: TdxBarItemControl): Integer; begin Result := 0; end; class function TdxBarItemControlPainter.ContainerControlSubMenuOffset: Integer; begin Result := 0; end; class function TdxBarItemControlPainter.InPlaceSubItemControlBrush: HBRUSH; begin Result := GetSysColorBrush(COLOR_BTNSHADOW); end; class procedure TdxBarItemControlPainter.InPlaceSubItemControlDrawInMenu(ABarContainerItemControl: TdxBarContainerItemControl; DC: HDC; Selected, AItemExpanded: Boolean; ARect: TRect); const Arrows: array[Boolean] of TdxArrowType = (atRight, atDown); var R: TRect; Brush: HBRUSH; Size: Integer; begin R := ARect; R.Top := R.Bottom - 1; FillRect(DC, R, ABarContainerItemControl.Parent.BkBrush); R.Bottom := R.Top; R.Top := ARect.Top; if Selected then Brush := ABarContainerItemControl.Parent.ToolbarSelBrush else Brush := InPlaceSubItemControlBrush; FillRect(DC, R, Brush); Inc(R.Left, 5); DrawItemText(ABarContainerItemControl, DC, ABarContainerItemControl.Caption, R, DT_LEFT, True, True, False, False, Selected); if ABarContainerItemControl.Enabled then begin Size := ABarContainerItemControl.Parent.MenuArrowHeight; with R do Left := Right - ABarContainerItemControl.Parent.TextSize + Byte(not AItemExpanded) * Size; DrawLargeItemArrow(DC, R, Arrows[AItemExpanded], Size, True, True, False{Flat}); end; end; class procedure TdxBarItemControlPainter.EditControlUpdateWndText(ABarEditControl: TdxBarEditControl; AHandle: HWND; ANotEqual: Boolean); begin SendMessage(AHandle, EM_SETSEL, 0, -1); end; class procedure TdxBarItemControlPainter.DrawGlyphBorder(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, BarControlOwner, IsSplit: Boolean); begin // Required end; class procedure TdxBarItemControlPainter.DrawGlyphCheckMark(ABarItemControl: TdxBarItemControl; DC: HDC; X, Y, DoubleSize: Integer); begin // Required // TODO: make default from Flat? end; class procedure TdxBarItemControlPainter.DrawGlyphEmptyImage(ABarItemControl: TdxBarItemControl; DC: HDC; R: TRect; ABrush: HBRUSH; NeedBorder: Boolean; PaintType: TdxBarPaintType; Selected, Down, DrawDowned: Boolean); var DoubleSize: Integer; begin if NeedBorder then InflateRect(R, -1, -1); if not IsNativeBackground then DrawBackground(ABarItemControl, DC, R, ABrush, ({not IgnoreGlyphOpaque and }(Down or DrawDowned or Selected)) or ABarItemControl.FNonRecent); // A1865 if NeedBorder then InflateRect(R, 1, 1); if (PaintType = ptMenu) and Down then with R do begin DoubleSize := 1 + Byte(ABarItemControl.Parent.Canvas.Font.Size >= 16); DrawGlyphCheckMark(ABarItemControl, DC, (Left + Right - DoubleSize * 9) div 2, (Top + Bottom - DoubleSize * 7) div 2, DoubleSize); end; end; class procedure TdxBarItemControlPainter.DrawGlyphImage(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; const GlyphRect: TRect; AGlyph: TBitmap; AImages: TCurImageList; AImageIndex: Integer; Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean; PaintType: TdxBarPaintType); var ATransparent: Boolean; begin if NeedBorder then InflateRect(R, -1, -1); ATransparent := not ABarItemControl.FNonRecent and ABarItemControl.Parent.IsTransparent; if ATransparent then DrawBackground(ABarItemControl, DC, R, ABrush, (not IgnoreGlyphOpaque and (Down or DrawDowned or Selected)) or ABarItemControl.FNonRecent); TransparentDraw(DC, ABrush, R, GlyphRect, AGlyph, AImages, AImageIndex, ABarItemControl.GetImageEnabled(PaintType), GrayScale, False{Flat}, Selected, Down, DrawDowned, False{Shadow}, ATransparent, GetFadedColor(ABarItemControl.Parent){Faded}, ABarItemControl.Item.BarManager.ImageListBkColor); if NeedBorder then InflateRect(R, 1, 1); end; class procedure TdxBarItemControlPainter.DrawItemArrow(DC: HDC; R: TRect; ArrowType: TdxArrowType; Enabled, Selected, Flat: Boolean); begin dxBar.DrawItemArrow(DC, R, ArrowType, Enabled, Selected, Flat); end; class procedure TdxBarItemControlPainter.DrawLargeItemArrow(DC: HDC; R: TRect; ArrowType: TdxArrowType; Size: Integer; Selected, Enabled, Flat: Boolean); begin dxBar.DrawLargeItemArrow(DC, R, ArrowType, Size, Selected, Enabled, Flat); end; class procedure TdxBarItemControlPainter.GetEditColors(ABarItemControl: TdxBarItemControl; var ATextColor, ABkColor: COLORREF); var ALogBrush: TLogBrush; begin if ABarItemControl.Enabled then begin ATextColor := GetSysColor(COLOR_WINDOWTEXT); ABkColor := GetSysColor(COLOR_WINDOW); end else begin ATextColor := GetSysColor(COLOR_GRAYTEXT); GetObject(ABarItemControl.Parent.BkBrush, SizeOf(ALogBrush), @ALogBrush); ABkColor := ALogBrush.lbColor; end; end; class function TdxBarItemControlPainter.GetFadedColor(ABarControl: TCustomdxBarControl): TColor; begin if ABarControl.BarManager.MakeDisabledImagesFaded then Result := GetMiddleRGB(clBtnShadow, clWhite, 70) //clBtnFace else Result := clNone; end; class procedure TdxBarItemControlPainter.GetTextColors(ABarItemControl: TdxBarItemControl; AEnabled, ASelected, AFlat: Boolean; var AColor1, AColor2: TColor); begin if AEnabled then begin if ASelected and not AFlat then AColor1 := GetSysColor(COLOR_HIGHLIGHTTEXT) else AColor1 := GetSysColor(COLOR_BTNTEXT); AColor2 := AColor1; end else begin if ASelected or AFlat then begin AColor1 := GetSysColor(COLOR_GRAYTEXT); AColor2 := AColor1; end else begin AColor1 := GetSysColor(COLOR_BTNHIGHLIGHT); AColor2 := GetSysColor(COLOR_BTNSHADOW); end; end; // AColor1 := clRed; // AColor2 := AColor2; end; class function TdxBarItemControlPainter.IgnoreGlyphOpaque: Boolean; begin Result := False; end; class function TdxBarItemControlPainter.IgnoreNonRecentColor: Boolean; begin Result := False; end; class function TdxBarItemControlPainter.IsMenuItem(ABarItemControl: TdxBarItemControl): Boolean; begin Result := False; end; class function TdxBarItemControlPainter.BarIsBarSmall(ABarControl: TdxBarControl; const R: TRect): Boolean; begin with R do Result := Bottom - Top <= 1 + 3 + 5 + 3 + 3 + 1; end; class function TdxBarItemControlPainter.BarCaptionBkColor(ABarControl: TdxBarControl; AMainFormActive: Boolean): COLORREF; const CaptionBkColors: array[Boolean] of Integer = (COLOR_INACTIVECAPTION, COLOR_ACTIVECAPTION); begin Result := GetSysColor(CaptionBkColors[AMainFormActive]); end; class function TdxBarItemControlPainter.BarCaptionColor(ABarControl: TdxBarControl): COLORREF; begin Result := GetSysColor(COLOR_CAPTIONTEXT); end; class function TdxBarItemControlPainter.BarMarkArrowColor(ABarControl: TdxBarControl; AState: TdxBarMarkState): COLORREF; begin Result := GetSysColor(COLOR_CAPTIONTEXT); end; class procedure TdxBarItemControlPainter.BarDrawGrip(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); begin ABarControl.FillBackground(DC, R, AToolbarBrush, clNone, True); // DrawFrameControl(DC, R, DFC_SCROLL, DFCS_SCROLLSIZEGRIP); DrawSizeGrip(DC, R); end; class procedure TdxBarItemControlPainter.BarDrawMarkArrow(ABarControl: TdxBarControl; DC: HDC; MarkR: TRect); var P: array[1..3] of TPoint; ABrush: HBRUSH; APen: HPEN; begin with MarkR, P[1] do begin P[1] := Point((Left + Right - MarkSizeArrowX) div 2, (Top + Bottom - MarkSizeArrowY) div 2 + (Top + Bottom - MarkSizeArrowY) mod 2); P[2] := Point(X + MarkSizeArrowX - 1, Y); P[3] := Point(X + MarkSizeArrowX div 2, Y + MarkSizeArrowY - 1); end; APen := SelectObject(DC, CreatePen(PS_SOLID, 1, BarMarkArrowColor(ABarControl, ABarControl.MarkState))); ABrush := SelectObject(DC, CreateSolidBrush(BarMarkArrowColor(ABarControl, ABarControl.MarkState))); Polygon(DC, P, 3); DeleteObject(SelectObject(DC, ABrush)); DeleteObject(SelectObject(DC, APen)); end; class procedure TdxBarItemControlPainter.BarDrawMarkAtPos(ABarControl: TdxBarControl; DC: HDC; const ItemRect: TRect; Offset: Integer); begin // Required end; class procedure TdxBarItemControlPainter.BarDrawMarkBackground(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); begin // Required end; class procedure TdxBarItemControlPainter.BarDrawMarkElements(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect); begin with ItemRect do begin if ABarControl.FTruncated then if ABarControl.Horizontal then begin BarDrawMarkAtPos(ABarControl, DC, ItemRect, Left + 2); BarDrawMarkAtPos(ABarControl, DC, ItemRect, Left + 6); end else begin BarDrawMarkAtPos(ABarControl, DC, ItemRect, Bottom - MarkSizeY); BarDrawMarkAtPos(ABarControl, DC, ItemRect, Bottom - MarkSizeY + 4); end; end; end; class procedure TdxBarItemControlPainter.BarOffsetFloatingBarCaption(ABarControl: TdxBarControl; var X: Integer; var R: TRect); begin X := ABarControl.MarkNCRect.Right + 3 * FloatToolbarMarkIndent; end; class function TdxBarItemControlPainter.GetDrawMarkElementColor(ABarControl: TdxBarControl): Integer; begin Result := COLOR_BTNTEXT; end; class procedure TdxBarItemControlPainter.ComboControlDrawOneArrow(ABarItemControl: TdxBarItemControl; DC: HDC; X, Y, Size: Integer; Color: COLORREF); var Brush: HBRUSH; P: array[1..3] of TPoint; Pen: HPEN; begin P[1] := Point(X, Y); P[2] := Point(X + Size - 1, Y); P[3] := Point(X + Size div 2, Y + Size div 2); Pen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(Color))); Brush := SelectObject(DC, GetSysColorBrush(Color)); Polygon(DC, P, 3); SelectObject(DC, Brush); DeleteObject(SelectObject(DC, Pen)); end; class procedure TdxBarItemControlPainter.SubMenuControlDrawArrow(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect; UpArrow: Boolean); var X, Y, Size: Integer; P: array[1..3] of TPoint; APen: HPEN; ABrush: HBRUSH; Rgn: HRGN; begin with ABarSubMenuControl do begin Size := TextSize div 3 - 1; X := (ClientWidth - BarSize) div 2; if UpArrow then Y := (TextSize - Size) div 2 + Size - 1 else if MarkExists then Y := R.Bottom - (TextSize - Size) div 2 - Size else Y := ClientHeight - (TextSize - Size) div 2 - Size; P[1] := Point(X - (Size - 1), Y); P[2] := Point(X + (Size - 1), Y); P[3] := Point(X, Y - (2 * Byte(UpArrow) - 1) * (Size - 1)); APen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNTEXT))); ABrush := SelectObject(DC, GetSysColorBrush(COLOR_BTNTEXT)); Polygon(DC, P, 3); SelectObject(DC, ABrush); DeleteObject(SelectObject(DC, APen)); if UpArrow then begin Dec(P[1].X); Inc(P[1].Y); Inc(P[2].X, 2); Inc(P[2].Y); Dec(P[3].Y); end else begin Inc(P[2].X); Inc(P[3].Y); end; Rgn := CreatePolygonRgn(P, 3, WINDING); ExtSelectClipRgn(DC, Rgn, RGN_DIFF); DeleteObject(Rgn); end; end; class procedure TdxBarItemControlPainter.SubMenuControlDrawMark(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect; ASelected: Boolean); var APen: HPEN; Size, X, Y, I: Integer; procedure DrawOneMark(const Y: Integer); begin MoveToEx(DC, X, Y, nil); LineTo(DC, X + Size div 2, Y + Size div 2); LineTo(DC, X + Size + 1, Y - 1); end; var AColor: COLORREF; begin Size := ABarSubMenuControl.MarkArrowSize; if IsHighContrastWhite and ASelected then AColor := GetSysColor(COLOR_BTNFACE) else AColor := GetSysColor(COLOR_BTNTEXT); APen := SelectObject(DC, CreatePen(PS_SOLID, 1, AColor)); with R do begin X := (Left + Right - (Size + 1)) div 2; Y := Top + (ABarSubMenuControl.MarkSize - 2 * Size) div 2; for I := Y to Y + Size - 1 do DrawOneMark(I + Byte(I >= Y + Size div 2) * Size div 2); end; DeleteObject(SelectObject(DC, APen)); end; class procedure TdxBarItemControlPainter.EditOffsetInteriorRect(var R: TRect); begin end; class procedure TdxBarItemControlPainter.SpinEditControlDrawOneArrow(DC: HDC; X, Y, XSize, YSize, Color: Integer; AButton: TdxBarSpinEditButton); var P: array[1..3] of TPoint; Pen: HPEN; Brush: HBRUSH; begin P[1] := Point(X, Y); P[2] := Point(X + XSize - 1, Y); P[3] := Point(X + XSize div 2, Y - (2 * Byte(AButton = sbUp) - 1) * XSize div 2); Pen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(Color))); Brush := SelectObject(DC, GetSysColorBrush(Color)); Polygon(DC, P, 3); SelectObject(DC, Brush); DeleteObject(SelectObject(DC, Pen)); end; class procedure TdxBarItemControlPainter.DateNavigatorDrawButtonCaption(DC: HDC; R: TRect; Offset: Integer; const ACaption: string; AOpaque: Boolean); var Flags: Integer; Size: TSize; APrevBkMode: Integer; begin with R do begin GetTextExtentPoint32(DC, PChar(ACaption), Length(ACaption), Size); SetTextColor(DC, GetSysColor(COLOR_BTNTEXT)); SetBkColor(DC, GetSysColor(COLOR_BTNFACE)); Flags := ETO_CLIPPED; APrevBkMode := GetBkMode(DC); if AOpaque then Flags := Flags or ETO_OPAQUE else SetBkMode(DC, TRANSPARENT); ExtTextOut(DC, (Left + Right - Size.cX) div 2 + Offset, (Top + Bottom - Size.cY) div 2 + Offset, Flags, @R, PChar(ACaption), Length(ACaption), nil); SetBkMode(DC, APrevBkMode); end; end; { TdxBarItemControlStandardPainter } class procedure TdxBarItemControlStandardPainter.DrawDisabledShadowRect(ABarItemControl: TdxBarItemControl; DC: HDC; R: TRect); begin OffsetRect(R, 1, 1); FillRect(DC, R, COLOR_BTNHIGHLIGHT + 1); OffsetRect(R, -1, -1); inherited DrawDisabledShadowRect(ABarItemControl, DC, R); end; class procedure TdxBarItemControlStandardPainter.DrawGlyphAndTextInSubMenu(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Selected, ShowGlyph, Down: Boolean); var IconRect: TRect; IsGlyphEmpty, AOpaque: Boolean; Brush: HBRUSH; begin with R do begin IconRect := R; IconRect.Right := IconRect.Left + Bottom - Top; IsGlyphEmpty := not ABarItemControl.ImageExists or not ShowGlyph; DrawGlyph(ABarItemControl, IconRect, nil, ptMenu, IsGlyphEmpty, Selected, Down, False, False, False, False, False); if Selected and (IsGlyphEmpty and not Down) then Brush := ABarItemControl.Parent.ToolbarSelBrush else Brush := ABarItemControl.Parent.BkBrush; Left := IconRect.Right + 1; AOpaque := Selected or ABarItemControl.FNonRecent; with IconRect do DrawBackground(ABarItemControl, DC, Rect(Right, Top, R.Left, Bottom), Brush, AOpaque); if Selected then Brush := ABarItemControl.Parent.ToolbarSelBrush else Brush := ABarItemControl.Parent.BkBrush; DrawBackground(ABarItemControl, DC, R, Brush, AOpaque); Inc(Left, 2); DrawItemText(ABarItemControl, DC, ABarItemControl.Caption, R, DT_LEFT, ABarItemControl.Enabled, Selected, False, False, False); end; end; class procedure TdxBarItemControlStandardPainter.DrawLowered(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect); begin DrawEdge(DC, R, BDR_SUNKENOUTER, BF_RECT); InflateRect(R, -1, -1); // LoweredBorderSize(ABarItemControl) = 1 end; class procedure TdxBarItemControlStandardPainter.FrameAndFillRect(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Enabled, Selected, Pressed: Boolean); const Borders: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER); var Brush: HBRUSH; begin Brush := ABarItemControl.Parent.BkBrush; if Selected then DrawEdge(DC, R, Borders[Pressed], BF_RECT) else FrameRect(DC, R, ABarItemControl.Parent.BkBrush); InflateRect(R, -1, -1); FillRect(DC, R, Brush); end; class function TdxBarItemControlStandardPainter.GlyphBkgndBrush(ABarItemControl: TdxBarItemControl; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean): HBRUSH; begin if Down and ABarItemControl.Enabled then if Selected then Result := ABarItemControl.Parent.ToolbarDownedSelBrush else Result := ABarItemControl.Parent.ToolbarDownedBrush else if Selected and (PaintType = ptMenu) and IsGlyphEmpty and not Down then Result := ABarItemControl.Parent.ToolbarSelBrush else Result := ABarItemControl.Parent.BkBrush; end; class function TdxBarItemControlStandardPainter.GlyphDownShift(ABarItemControl: TdxBarItemControl): Integer; begin Result := 1; end; class function TdxBarItemControlStandardPainter.GlyphDrawDownedShift(ABarItemControl: TdxBarItemControl; ADown: Boolean): Integer; begin Result := 1; end; class function TdxBarItemControlStandardPainter.LoweredBorderSize(ABarItemControl: TdxBarItemControl): Integer; begin Result := 1; end; class function TdxBarItemControlStandardPainter.BeforeFingersSize: Integer; begin Result := 2; end; class function TdxBarItemControlStandardPainter.FingersSize: Integer; begin Result := BeforeFingersSize + 2 * GripperSize + 1; end; class procedure TdxBarItemControlStandardPainter.BarDrawCloseButton(ABarControl: TdxBarControl; DC: HDC; R: TRect); const Pushes: array[Boolean] of Integer = (0, DFCS_PUSHED); var ABrush: HBRUSH; begin ABrush := CreateSolidBrush(ABarControl.CaptionBkColor); FrameRect(DC, R, ABrush); DeleteObject(ABrush); InflateRect(R, -1, -1); DrawFrameControl(DC, R, DFC_CAPTION, DFCS_CAPTIONCLOSE or Pushes[ABarControl.CloseButtonState = msPressed]); end; class procedure TdxBarItemControlStandardPainter.BarDrawDockedBarBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); procedure DrawFinger; begin with R do begin DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT); if ABarControl.Horizontal then SetPixel(DC, Left, Bottom - 1, GetSysColor(COLOR_BTNHIGHLIGHT)) else SetPixel(DC, Right - 1, Top, GetSysColor(COLOR_BTNHIGHLIGHT)); InflateRect(R, -1, -1); FillRect(DC, R, GetSysColorBrush(COLOR_BTNFACE)); InflateRect(R, 1, 1); ExcludeClipRect(DC, Left, Top, Right, Bottom); end; end; begin with R do begin DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT); InflateRect(R, -2, -2); if ABarControl.Bar.CanMoving then begin if ABarControl.Horizontal then begin Inc(Left, ABarControl.BarManager.BeforeFingersSize); Right := Left + ABarControl.PainterClass.GripperSize; end else begin Inc(Top, ABarControl.BarManager.BeforeFingersSize); Bottom := Top + ABarControl.PainterClass.GripperSize; end; DrawFinger; if ABarControl.Horizontal then OffsetRect(R, ABarControl.PainterClass.GripperSize, 0) else OffsetRect(R, 0, ABarControl.PainterClass.GripperSize); DrawFinger; end; end; end; class procedure TdxBarItemControlStandardPainter.BarDrawFloatingBarBorder(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); begin DrawEdge(DC, R, EDGE_RAISED, BF_RECT); InflateRect(R, -2, -2); FrameRect(DC, R, GetSysColorBrush(COLOR_BTNFACE)); InflateRect(R, -1, -1); FrameRect(DC, R, GetSysColorBrush(COLOR_BTNFACE)); end; class procedure TdxBarItemControlStandardPainter.BarDrawMDIButton(ABarControl: TdxBarControl; AButton: TdxBarMDIButton; ASelected, APressed: Boolean; DC: HDC; R: TRect); const Borders: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER); var AFlat, ClipRgnExists: Boolean; Rgn1, Rgn2: HRGN; AFlags: Integer; begin AFlat := (AButton = mdibClose) and ABarControl.BarManager.FlatCloseButton and ABarControl.MDIButtonsOnBar and not ABarControl.RealMDIButtonsOnBar; Rgn1 := 0; ClipRgnExists := False; if AFlat then begin SaveClipRgn(DC, Rgn1, ClipRgnExists); InflateRect(R, -1, -1); Rgn2 := CreateRectRgnIndirect(R); SelectClipRgn(DC, Rgn2); DeleteObject(Rgn2); InflateRect(R, 1, 1); end; AFlags := 0; if not ABarControl.MDIButtonEnabled(AButton, MF_GRAYED) then AFlags := AFlags or DFCS_INACTIVE else if ASelected and APressed then AFlags := AFlags or DFCS_PUSHED; DrawFrameControl(DC, R, DFC_CAPTION, MDIButtonStyles[AButton] or AFlags or Byte(AFlat) * DFCS_FLAT); if AFlat then begin RestoreClipRgn(DC, Rgn1, ClipRgnExists); DrawEdge(DC, R, Borders[ASelected and APressed], BF_RECT); end; end; class function TdxBarItemControlStandardPainter.BarHorSize: Integer; begin Result := dxBarHorSize; end; class function TdxBarItemControlStandardPainter.BarMarkItemRect(ABarControl: TdxBarControl): TRect; begin case ABarControl.DockingStyle of dsTop, dsBottom: with Result do begin Left := ABarControl.ClientWidth - MarkSizeX; Top := 0; Right := Left + MarkSizeX; Bottom := MarkSizeY; end; dsLeft, dsRight: with Result do begin Left := ABarControl.ClientWidth - MarkSizeY; Top := ABarControl.ClientHeight - MarkSizeX; Right := ABarControl.ClientWidth; Bottom := Top + MarkSizeX; end; else Result := ABarControl.GetCaptionRect; with Result do Right := Left + 3 + 7 + 3; end; end; class function TdxBarItemControlStandardPainter.BarTopSize: Integer; begin Result := dxBarTopSize; end; class function TdxBarItemControlStandardPainter.BarBottomSize: Integer; begin Result := dxBarBottomSize; end; class function TdxBarItemControlStandardPainter.BarUseSystemClose: Boolean; begin Result := True; end; class function TdxBarItemControlStandardPainter.BarUseSystemNCBorder: Boolean; begin Result := True; end; class function TdxBarItemControlStandardPainter.SubMenuBeginGroupIndent: Integer; begin Result := 2; end; class procedure TdxBarItemControlStandardPainter.DrawButtonControlArrow(ABarItemControl: TdxBarItemControl; DC: HDC; R1: TRect; Brush: HBRUSH; ArrowColor: COLORREF; Selected, DrawDowned, DroppedDown, DropDownEnabled, IsDropDownMenuControlExist: Boolean; PaintType: TdxBarPaintType); const Borders: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER); Enables: array[Boolean] of Integer = (DFCS_INACTIVE, 0); var R: TRect; begin DrawBackground(ABarItemControl, DC, R1, Brush, (not IgnoreGlyphOpaque and (DroppedDown or DrawDowned or Selected)) or ABarItemControl.FNonRecent); if Selected then DrawEdge(DC, R1, Borders[DroppedDown], BF_RECT) else if PaintType = ptMenu then begin R := R1; Dec(R.Left); R.Right := R.Left + 2; DrawEdge(DC, R, EDGE_ETCHED, BF_LEFT or BF_RIGHT); end; if PaintType = ptMenu then begin if DroppedDown then OffsetRect(R1, 1, 1); DrawLargeItemArrow(DC, R1, atRight, ABarItemControl.Parent.MenuArrowHeight, False, ABarItemControl.Enabled and DropDownEnabled, False{Flat}); end else begin if DroppedDown and (R1.Right - R1.Left > 9) then OffsetRect(R1, 1, 1); DrawItemArrow(DC, R1, atDown, ABarItemControl.Enabled and DropDownEnabled, False, False{Flat}); end; end; class procedure TdxBarItemControlStandardPainter.OffsetCaptionBounds(ABarButtonControl: TdxBarButtonControl; APressed: Boolean; var R: TRect); begin if ABarButtonControl.Down then OffsetRect(R, 1, 1); if APressed then OffsetRect(R, 1, 1); end; class procedure TdxBarItemControlStandardPainter.OffsetEllipsisBounds(ABarItemControl: TdxBarItemControl; APressed: Boolean; var R: TRect); begin if APressed then OffsetRect(R, 1, 1); end; class procedure TdxBarItemControlStandardPainter.ComboControlDrawArrow(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; Selected: Boolean; PaintType: TdxBarPaintType); const Borders: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER); var Brush, SpaceBrush: HBRUSH; ArrowColor: COLORREF; X, Y, Size: Integer; begin with ARect do begin Left := Right - ABarComboControl.Parent.ComboBoxArrowWidth; ABarComboControl.FDropDownButtonRect := ARect; ComboControlGetArrowParams(ABarComboControl, PaintType, ABarComboControl.Enabled, Selected, ABarComboControl.DroppedDown, Brush, ArrowColor); if Selected and ABarComboControl.Enabled then begin DrawEdge(DC, ARect, Borders[ABarComboControl.DroppedDown], BF_RECT); SpaceBrush := ABarComboControl.Parent.BkBrush; end else begin if ABarComboControl.Enabled then SpaceBrush := GetSysColorBrush(COLOR_BTNHIGHLIGHT) else SpaceBrush := ABarComboControl.Parent.BkBrush; FrameRect(DC, ARect, SpaceBrush); end; FillRect(DC, Rect(Left - 1, Top, Left, Bottom), SpaceBrush); InflateRect(ARect, -1, -1); FillRect(DC, ARect, Brush); if ABarComboControl.DroppedDown then OffsetRect(ARect, 1, 1); with ARect do begin Size := (Right - Left) div 2; if not Odd(Size) then Inc(Size); X := (Left + Right - Size) div 2; Y := (Top + Bottom - Size div 2) div 2; if ABarComboControl.Enabled then ComboControlDrawOneArrow(ABarComboControl, DC, X, Y, Size, ArrowColor) else begin ComboControlDrawOneArrow(ABarComboControl, DC, X + 1, Y + 1, Size, COLOR_BTNHIGHLIGHT); ComboControlDrawOneArrow(ABarComboControl, DC, X, Y, Size, COLOR_BTNSHADOW); end; end; end; end; class function TdxBarItemControlStandardPainter.DropDownListBoxBorderSize: Integer; begin Result := 2; end; class procedure TdxBarItemControlStandardPainter.DropDownListBoxDrawBorder(ABarManager: TdxBarManager; DC: HDC; R: TRect); begin DrawEdge(DC, R, EDGE_RAISED, BF_RECT); end; class procedure TdxBarItemControlStandardPainter.SubMenuControlDrawItemFrame(ABarSubMenuControl: TdxBarSubMenuControl; AControl: TdxBarItemControl; DC: HDC; AItemRect: TRect; AIndex, LeftDelta: Integer); const BrushColors: array[Boolean] of COLORREF = (COLOR_BTNHIGHLIGHT, COLOR_BTNSHADOW); var R: TRect; begin if AControl.FChangeRecentGroup then begin R := AItemRect; if not AControl.FNonRecent and not IsRectEmpty(AControl.FBeginGroupRect) then R.Top := AControl.FBeginGroupRect.Top; with R do begin Bottom := Top; Dec(Top); Dec(Left, LeftDelta); Inc(Right); end; FillRect(DC, R, BrushColors[AControl.FNonRecent] + 1); end; if AControl.FNonRecent then with AItemRect do begin if (AIndex = 0) and not ABarSubMenuControl.Detachable then begin FillRect(DC, Rect(Left - LeftDelta, Top - 1, Right + 2, Top), ABarSubMenuControl.BkBrush); SetPixel(DC, Right + 1, Top - 2, GetSysColor(COLOR_BTNHIGHLIGHT)); end; FillRect(DC, Rect(Left - LeftDelta, Top, Left, Bottom), ABarSubMenuControl.BkBrush); FillRect(DC, Rect(Right, Top, Right + 2, Bottom), ABarSubMenuControl.BkBrush); if AIndex = AControl.ItemLink.Owner.VisibleItemCount - 1 then begin FillRect(DC, Rect(Left - LeftDelta, Bottom, Right + 2, ABarSubMenuControl.ClientHeight), ABarSubMenuControl.BkBrush); if LeftDelta <> 0 then SetPixel(DC, Left - 2, ABarSubMenuControl.ClientHeight - 1, GetSysColor(COLOR_BTNHIGHLIGHT)); end; end; end; class function TdxBarItemControlStandardPainter.SubMenuControlIsOffsetRecentGroupNeeded: Boolean; begin Result := True; end; class function TdxBarItemControlStandardPainter.SubMenuControlMarkRectOffset(ABarSubMenuControl: TdxBarSubMenuControl): Integer; begin Result := inherited SubMenuControlMarkRectOffset(ABarSubMenuControl) + 1; end; class procedure TdxBarItemControlStandardPainter.EditControlPrepareEditWnd(ABarEditControl: TdxBarEditControl; AHandle: HWND); begin SendMessage(AHandle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MakeLParam(2, 2)); end; class procedure TdxBarItemControlStandardPainter.DrawGlyphBorder(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, BarControlOwner, IsSplit: Boolean); const Borders: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER); begin if Down or (Selected and ((PaintType <> ptMenu) or not IsGlyphEmpty)) then DrawEdge(DC, R, Borders[Down or DrawDowned], BF_RECT) else if NeedBorder then DrawBackgroundFrameRect(ABarItemControl, DC, R, ABrush, Selected or Down or DrawDowned or ABarItemControl.FNonRecent); end; class procedure TdxBarItemControlStandardPainter.DrawGlyphCheckMark(ABarItemControl: TdxBarItemControl; DC: HDC; X, Y, DoubleSize: Integer); const Colors: array[Boolean] of TColor = (clBlack, clWhite); var OffsetY, I: Integer; procedure DrawOneMark; begin with ABarItemControl.Parent.Canvas do begin MoveTo(X + DoubleSize * 1, Y + OffsetY + DoubleSize * 2); LineTo(X + DoubleSize * 3, Y + OffsetY + DoubleSize * 4); LineTo(X + DoubleSize * 8, Y + OffsetY - DoubleSize * 1); end; Inc(OffsetY); end; begin with ABarItemControl.Parent.Canvas do if ABarItemControl.Enabled then begin OffsetY := 0; Pen.Color := clSilver; for I := 1 to DoubleSize do DrawOneMark; Pen.Color := Colors[GetSysColor(COLOR_BTNFACE) = 0]; for I := 1 to 2 * DoubleSize do DrawOneMark; Pen.Color := Colors[GetSysColor(COLOR_BTNFACE) <> 0]; for I := 1 to DoubleSize do DrawOneMark; MoveTo(X + DoubleSize - 1, Y + DoubleSize * 3 - (DoubleSize - 1)); LineTo(X + DoubleSize - 1, Y + DoubleSize * 5 + (DoubleSize - 1)); MoveTo(X + DoubleSize * 8, Y - DoubleSize * 1 + 2); LineTo(X + DoubleSize * 8, Y + DoubleSize * 3); end else begin OffsetY := 1; Pen.Color := GetSysColor(COLOR_BTNSHADOW); for I := 1 to 2 * DoubleSize do DrawOneMark; Pen.Color := GetSysColor(COLOR_BTNHIGHLIGHT); for I := 0 to DoubleSize - 1 do begin MoveTo(X + DoubleSize * 4 - (DoubleSize - 1), Y + DoubleSize * 6 + (DoubleSize - 1 - I)); LineTo(X + DoubleSize * 9, Y + DoubleSize * 1 - I); MoveTo(X + DoubleSize * 4, Y + DoubleSize * 7 - I); LineTo(X + DoubleSize * 9, Y + DoubleSize * 2 - I); end; end; end; class function TdxBarItemControlStandardPainter.IgnoreGlyphOpaque: Boolean; begin Result := True; end; class function TdxBarItemControlStandardPainter.BarIsBarSmall(ABarControl: TdxBarControl; const R: TRect): Boolean; begin Result := False; end; class procedure TdxBarItemControlStandardPainter.BarDrawMarkAtPos(ABarControl: TdxBarControl; DC: HDC; const ItemRect: TRect; Offset: Integer); var Pen: HPEN; X: Integer; begin if ABarControl.Horizontal then begin Pen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT))); X := Offset; MoveToEx(DC, X - 1, 1, nil); LineTo(DC, X + 2, 4); MoveToEx(DC, X + 3, 4, nil); LineTo(DC, X - 1, 8); DeleteObject(SelectObject(DC, Pen)); Pen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW))); MoveToEx(DC, X, 1, nil); LineTo(DC, X + 2, 3); LineTo(DC, X + 2, 4); LineTo(DC, X - 1, 7); DeleteObject(SelectObject(DC, Pen)); end else begin Pen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW))); X := ABarControl.ClientWidth - 8; MoveToEx(DC, X, Offset, nil); LineTo(DC, X + 4, Offset + 4); MoveToEx(DC, X + 4, Offset + 1, nil); LineTo(DC, X + 6, Offset - 1); DeleteObject(SelectObject(DC, Pen)); Pen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT))); MoveToEx(DC, X + 1, Offset, nil); LineTo(DC, X + 3, Offset + 2); LineTo(DC, X + 4, Offset + 2); LineTo(DC, X + 7, Offset - 1); DeleteObject(SelectObject(DC, Pen)); end; end; class procedure TdxBarItemControlStandardPainter.BarDrawMarkBackground(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); begin ABarControl.FillBackground(DC, ItemRect, AToolbarBrush, clNone, True); end; { TdxBarItemControlEnhancedPainter } class function TdxBarItemControlEnhancedPainter.BeforeFingersSize: Integer; begin Result := 1; end; class function TdxBarItemControlEnhancedPainter.FingersSize: Integer; begin Result := BeforeFingersSize + GripperSize + 2; end; class function TdxBarItemControlEnhancedPainter.SubMenuBeginGroupIndent: Integer; begin Result := 12; end; class function TdxBarItemControlEnhancedPainter.BarAllowQuickCustomizing: Boolean; begin Result := True; end; class procedure TdxBarItemControlEnhancedPainter.BarDrawDockedBarBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); procedure DrawFinger; begin with R do begin DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT); InflateRect(R, -1, -1); FillRect(DC, R, GetSysColorBrush(COLOR_BTNFACE)); InflateRect(R, 1, 1); ExcludeClipRect(DC, Left, Top, Right, Bottom); end; end; begin with R do begin DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT); InflateRect(R, -2, -2); if ABarControl.Bar.CanMoving then begin if ABarControl.Horizontal then begin Inc(Left, ABarControl.BarManager.BeforeFingersSize); Right := Left + ABarControl.PainterClass.GripperSize; InflateRect(R, 0, -1); end else begin Inc(Top, ABarControl.BarManager.BeforeFingersSize); Bottom := Top + ABarControl.PainterClass.GripperSize; InflateRect(R, -1, 0); end; DrawFinger; end; end; end; class function TdxBarItemControlEnhancedPainter.BarMarkItemRect(ABarControl: TdxBarControl): TRect; begin case ABarControl.DockingStyle of dsTop, dsBottom: with Result do begin Left := ABarControl.ClientWidth - MarkSizeX; Top := 0; Right := Left + MarkSizeX; Bottom := ABarControl.ClientHeight; end; dsLeft, dsRight: with Result do begin Left := 0; Top := ABarControl.ClientHeight - MarkSizeX; Right := ABarControl.ClientWidth; Bottom := Top + MarkSizeX; end; else Result := ABarControl.GetCaptionRect; with Result do Right := Left + 3 + 7 + 3; end; end; class procedure TdxBarItemControlEnhancedPainter.BarDrawMarkAtPos(ABarControl: TdxBarControl; DC: HDC; const ItemRect: TRect; Offset: Integer); var Pen: HPEN; X, Y: Integer; begin Pen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNTEXT))); if ABarControl.Horizontal then begin X := Offset; Y := 4 - Byte(BarIsBarSmall(ABarControl, ItemRect)); MoveToEx(DC, X, Y, nil); LineTo(DC, X + 2, Y + 2); LineTo(DC, X - 1, Y + 5); MoveToEx(DC, X + 1, Y, nil); LineTo(DC, X + 3, Y + 2); LineTo(DC, X, Y + 5); end else begin X := ABarControl.ClientWidth - 8; MoveToEx(DC, X, Offset, nil); LineTo(DC, X + 2, Offset + 2); LineTo(DC, X + 5, Offset - 1); MoveToEx(DC, X, Offset + 1, nil); LineTo(DC, X + 2, Offset + 3); LineTo(DC, X + 5, Offset); end; DeleteObject(SelectObject(DC, Pen)); end; class procedure TdxBarItemControlEnhancedPainter.BarDrawMarkBackground(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); const MarkEdges: array[msSelected..msPressed] of UINT = (BDR_RAISEDINNER, BDR_SUNKENOUTER); begin if ABarControl.MarkState = msNone then FrameRect(DC, ItemRect, AToolbarBrush) else DrawEdge(DC, ItemRect, MarkEdges[ABarControl.MarkState], BF_RECT); InflateRect(ItemRect, -1, -1); ABarControl.FillBackground(DC, ItemRect, AToolbarBrush, clNone, True); InflateRect(ItemRect, 1, 1); end; class procedure TdxBarItemControlEnhancedPainter.BarDrawMarkElements(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect); procedure DrawArrow(X, Y: Integer; Vertical: Boolean); var P: array[1..3] of TPoint; Pen: HPEN; Brush: HBRUSH; AColor: Integer; begin if Vertical then begin P[1] := Point(X, Y); P[2] := Point(X, Y + 4); P[3] := Point(X - 2, Y + 2); end else begin P[1] := Point(X, Y); P[2] := Point(X + 4, Y); P[3] := Point(X + 2, Y + 2); end; AColor := ABarControl.PainterClass.GetDrawMarkElementColor(ABarControl); Pen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(AColor))); Brush := SelectObject(DC, GetSysColorBrush(AColor)); Polygon(DC, P, 3); SelectObject(DC, Brush); DeleteObject(SelectObject(DC, Pen)); end; begin with ItemRect do begin if ABarControl.Horizontal then DrawArrow(Left + 3, Bottom - 7 + Byte(BarIsBarSmall(ABarControl, ItemRect)), False) else DrawArrow(Left + 5, Top + 3, True); end; inherited; end; { TdxBarItemControlFlatPainter } class procedure TdxBarItemControlFlatPainter.DrawGlyphAndTextInSubMenu(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Selected, ShowGlyph, Down: Boolean); var I: Integer; IconRect: TRect; IsGlyphEmpty, AOpaque: Boolean; Brush: HBRUSH; begin with R do begin AOpaque := Selected or ABarItemControl.FNonRecent; if Selected then FrameFlatSelRect(DC, R) else begin I := Left + Bottom - Top + 1; DrawBackground(ABarItemControl, DC, Rect(Left, Top, I, Top + 1), ABarItemControl.BarManager.FlatToolbarsBrush, AOpaque); DrawBackground(ABarItemControl, DC, Rect(Left, Bottom - 1, I, Bottom), ABarItemControl.BarManager.FlatToolbarsBrush, AOpaque); DrawBackground(ABarItemControl, DC, Rect(Left, Top + 1, Left + 1, Bottom - 1), ABarItemControl.BarManager.FlatToolbarsBrush, AOpaque); DrawBackground(ABarItemControl, DC, Rect(I, Top, Right, Top + 1), ABarItemControl.Parent.BkBrush, AOpaque); DrawBackground(ABarItemControl, DC, Rect(I, Bottom - 1, Right, Bottom), ABarItemControl.Parent.BkBrush, AOpaque); DrawBackground(ABarItemControl, DC, Rect(Right - 1, Top + 1, Right, Bottom - 1), ABarItemControl.Parent.BkBrush, AOpaque); end; InflateRect(R, -1, -1); IconRect := R; IconRect.Right := IconRect.Left + Bottom - Top; IsGlyphEmpty := not ABarItemControl.ImageExists or not ShowGlyph; DrawGlyph(ABarItemControl, IconRect, nil, ptMenu, IsGlyphEmpty, Selected, Down, False, False, False, False, False); if Selected then Brush := ABarItemControl.Parent.ToolbarSelBrush else Brush := ABarItemControl.BarManager.FlatToolbarsBrush; Left := IconRect.Right + 2; with IconRect do DrawBackground(ABarItemControl, DC, Rect(Right, Top, R.Left, Bottom), Brush, AOpaque); if Selected then Brush := ABarItemControl.Parent.ToolbarSelBrush else Brush := ABarItemControl.Parent.BkBrush; DrawBackground(ABarItemControl, DC, R, Brush, AOpaque); Inc(Left, 8); DrawItemText(ABarItemControl, DC, ABarItemControl.Caption, R, DT_LEFT, ABarItemControl.Enabled, Selected, False, False, not IsHighContrastWhite); end; end; class procedure TdxBarItemControlFlatPainter.DrawLowered(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect); begin FrameRect(DC, R, GetSysColorBrush(COLOR_BTNSHADOW)); InflateRect(R, -1, -1); // LoweredBorderSize(ABarItemControl) = 1 end; class procedure TdxBarItemControlFlatPainter.DrawStaticBorder(ABarItemControl: TdxBarItemControl; DC: HDC; var ARect: TRect; ABorderWidth: Integer; ABorderStyle: TdxBarStaticBorderStyle); var I: Integer; ABrush: HBRUSH; begin ABrush := StaticBorderBrush(ABarItemControl, ABorderStyle); for I := 1 to ABorderWidth do begin FrameRect(DC, ARect, ABrush); InflateRect(ARect, -1, -1); end; end; class procedure TdxBarItemControlFlatPainter.FrameAndFillRect(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Enabled, Selected, Pressed: Boolean); var Brush: HBRUSH; begin Brush := ABarItemControl.Parent.BkBrush; if Selected then begin FrameFlatSelRect(DC, R); if Pressed then Brush := ABarItemControl.Parent.ToolbarDownedSelBrush else Brush := ABarItemControl.Parent.ToolbarSelBrush; end else FrameRect(DC, R, ABarItemControl.Parent.BkBrush); InflateRect(R, -1, -1); FillRect(DC, R, Brush); end; class procedure TdxBarItemControlFlatPainter.GetArrowParams(ABarItemControl: TdxBarItemControl; APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); begin AArrowColor := COLOR_BTNTEXT; if ASelected then if ADroppedDown or IsHighContrastWhite then begin ABrush := ABarItemControl.Parent.ToolbarDownedSelBrush; AArrowColor := COLOR_HIGHLIGHTTEXT; end else ABrush := ABarItemControl.Parent.ToolbarSelBrush else ABrush := ABarItemControl.Parent.BkBrush end; class function TdxBarItemControlFlatPainter.GlyphBkgndBrush(ABarItemControl: TdxBarItemControl; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean): HBRUSH; begin if Selected then if Down or DrawDowned then if Down and BarControlOwner then Result := ABarItemControl.Parent.BarControlOwnerBrush else Result := ABarItemControl.Parent.ToolbarDownedSelBrush else Result := ABarItemControl.Parent.ToolbarSelBrush else if Down then Result := ABarItemControl.Parent.ToolbarDownedBrush else if (PaintType = ptMenu) and not ForceUseBkBrush then Result := ABarItemControl.BarManager.FlatToolbarsBrush else Result := ABarItemControl.Parent.BkBrush; end; class function TdxBarItemControlFlatPainter.IsFlatItemText: Boolean; begin Result := True; end; class function TdxBarItemControlFlatPainter.LoweredBorderSize(ABarItemControl: TdxBarItemControl): Integer; begin Result := 1; end; class function TdxBarItemControlFlatPainter.StaticBorderBrush(ABarItemControl: TdxBarItemControl; ABorderStyle: TdxBarStaticBorderStyle): HBRUSH; begin Result := GetSysColorBrush(COLOR_BTNSHADOW); end; class function TdxBarItemControlFlatPainter.TextAreaOffset(ABarItemControl: TdxBarItemControl): Integer; begin // WARNING!!! sync with Indent if ABarItemControl.Parent is TdxBarSubMenuControl then Result := 1 + ABarItemControl.Parent.TextSize + 2 else Result := 0; end; class function TdxBarItemControlFlatPainter.BeforeFingersSize: Integer; begin Result := 1; end; class function TdxBarItemControlFlatPainter.FingersSize: Integer; begin Result := BeforeFingersSize + GripperSize + 2; end; class function TdxBarItemControlFlatPainter.RealButtonArrowWidth(ABarManager: TdxBarManager): Integer; begin Result := inherited RealButtonArrowWidth(ABarManager); Dec(Result); end; class function TdxBarItemControlFlatPainter.RealLargeButtonArrowWidth(ABarManager: TdxBarManager): Integer; begin Result := inherited RealLargeButtonArrowWidth(ABarManager) - 1; end; class function TdxBarItemControlFlatPainter.SubMenuBeginGroupIndent: Integer; begin Result := 8; end; class function TdxBarItemControlFlatPainter.BarChildrenHaveShadows(ABarControl: TCustomdxBarControl): Boolean; begin Result := True; end; class procedure TdxBarItemControlFlatPainter.BarDrawBarControlOwner(ACustomBarControl: TCustomdxBarControl; DC: HDC; R: TRect; ABarControl: TCustomdxBarControl); begin BarDrawBarControlOwnerBorder(ACustomBarControl, DC, R, nil, ABarControl); InflateRect(R, -1, -1); FillRect(DC, R, ACustomBarControl.BarControlOwnerBrush); end; class procedure TdxBarItemControlFlatPainter.BarDrawBarControlOwnerBorder(ACustomBarControl: TCustomdxBarControl; DC: HDC; R: TRect; ABarItemControl: TdxBarItemControl; ABarControl: TCustomdxBarControl); procedure DrawBarControlOwnerLink; var ALinkR, ATempRect, CR, WR: TRect; AOrigin: TPoint; AHandle: HWND; begin ALinkR := ABarControl.OwnerLinkBounds[True]; if ABarControl.OwnerControl = nil then // !!! begin GetDCOrgEx(DC, AOrigin); OffsetRect(ALinkR, -AOrigin.X, -AOrigin.Y); end else begin AHandle := ABarControl.OwnerControl.Handle; GetClientRect(AHandle, CR); MapWindowPoints(AHandle, 0, CR, 2); if IntersectRect(ATempRect, CR, ALinkR) then // client area OffsetRect(ALinkR, -CR.Left, -CR.Top) else begin GetWindowRect(AHandle, WR); // NC OffsetRect(ALinkR, -WR.Left, -WR.Top); end; end; BarDrawBarControlOwnerLink(ACustomBarControl, DC, R, ALinkR, ABarItemControl); with ALinkR do ExcludeClipRect(DC, Left, Top, Right, Bottom); end; var AClipRgn: HRGN; AClipRgnExists: Boolean; begin AClipRgn := 0; if ABarControl.HandleAllocated then begin SaveClipRgn(DC, AClipRgn, AClipRgnExists); DrawBarControlOwnerLink; end; BarDrawBarControlOwnerFrame(ACustomBarControl, DC, R); if AClipRgn <> 0 then RestoreClipRgn(DC, AClipRgn, AClipRgnExists); end; class procedure TdxBarItemControlFlatPainter.BarDrawBarControlOwnerFrame(ACustomBarControl: TCustomdxBarControl; DC: HDC; R: TRect); begin FrameRect(DC, R, ACustomBarControl.BarManager.FlatToolbarsBorderBrush); end; class procedure TdxBarItemControlFlatPainter.BarDrawBarControlOwnerLink(ACustomBarControl: TCustomdxBarControl; DC: HDC; R, ALinkR: TRect; ABarItemControl: TdxBarItemControl); begin FillRect(DC, ALinkR, ACustomBarControl.BarControlOwnerBrush); end; class function TdxBarItemControlFlatPainter.BarHasShadow(ABarControl: TCustomdxBarControl): Boolean; begin Result := ABarControl.DockingStyle = dsNone; end; class function TdxBarItemControlFlatPainter.BarToolbarBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin Result := ABarControl.BarManager.FlatToolbarsBrush; end; class function TdxBarItemControlFlatPainter.BarToolbarBrushEx(ABarControl: TdxBarControl): HBRUSH; begin if not (ABarControl.Bar.IsMainMenu or ABarControl.Bar.IsStatusBar) then Result := inherited BarToolbarBrushEx(ABarControl) else Result := GetSysColorBrush(COLOR_BTNFACE); end; class function TdxBarItemControlFlatPainter.BarToolbarDownedBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin Result := ABarControl.BarManager.FlatToolbarsDownedBrush; end; class function TdxBarItemControlFlatPainter.BarToolbarDownedSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin Result := ABarControl.BarManager.FlatToolbarsDownedSelBrush; end; class function TdxBarItemControlFlatPainter.BarToolbarSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin Result := ABarControl.BarManager.FlatToolbarsSelBrush; end; class function TdxBarItemControlFlatPainter.EditBorderSize(DC: HDC): Integer; begin Result := (1 + 2) * 2 + 1; end; class function TdxBarItemControlFlatPainter.BarAllowHotTrack: Boolean; begin Result := True; end; class function TdxBarItemControlFlatPainter.BarAllowQuickCustomizing: Boolean; begin Result := True; end; class function TdxBarItemControlFlatPainter.BarBeginGroupSideSize: Integer; begin Result := (BarBeginGroupSize - 1{|}) div 2; end; class function TdxBarItemControlFlatPainter.BarBeginGroupSize: Integer; begin Result := 2 + 1{|} + 2; end; class procedure TdxBarItemControlFlatPainter.BarDrawBeginGroup(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH; AHorz: Boolean); begin with ItemRect do if AHorz then begin ABarControl.FillBackground(DC, Rect(Left, Top, Right, Top + BarBeginGroupSideSize), AToolbarBrush, clNone, True); ABarControl.FillBackground(DC, Rect(Left, Bottom - BarBeginGroupSideSize, Right, Bottom), AToolbarBrush, clNone, True); InflateRect(ItemRect, 0, -BarBeginGroupSideSize); FillRect(DC, Rect(Left, Top, Right, Top + 1), COLOR_BTNSHADOW + 1); end else begin ABarControl.FillBackground(DC, Rect(Left, Top, Left + BarBeginGroupSideSize, Bottom), AToolbarBrush, clNone, True); ABarControl.FillBackground(DC, Rect(Right - BarBeginGroupSideSize, Top, Right, Bottom), AToolbarBrush, clNone, True); InflateRect(ItemRect, -BarBeginGroupSideSize, 0); FillRect(DC, Rect(Left, Top, Left + 1, Bottom), COLOR_BTNSHADOW + 1); end; end; class procedure TdxBarItemControlFlatPainter.BarDrawCloseButton(ABarControl: TdxBarControl; DC: HDC; R: TRect); procedure DrawCross(var R: TRect); // const // CrossColors: array[Boolean] of Integer = (COLOR_CAPTIONTEXT, COLOR_BTNTEXT); var APen: HPEN; begin InflateRect(R, -3, -4); with R do begin if Odd(Right - Left) then Dec(Right); Bottom := Top + (Right - Left - 1); end; with R do begin // APen := SelectObject(DC, CreatePen(PS_SOLID, 1, // GetSysColor(CrossColors[ABarControl.CloseButtonState = msSelected]))); APen := SelectObject(DC, CreatePen(PS_SOLID, 1, BarMarkArrowColor(ABarControl, ABarControl.CloseButtonState))); MoveToEx(DC, Left, Top, nil); LineTo(DC, Right - 1, Bottom); MoveToEx(DC, Left + 1, Top, nil); LineTo(DC, Right, Bottom); MoveToEx(DC, Left, Bottom - 1, nil); LineTo(DC, Right - 1, Top - 1); MoveToEx(DC, Left + 1, Bottom - 1, nil); LineTo(DC, Right, Top - 1); DeleteObject(SelectObject(DC, APen)); end; end; begin BarDrawCaptionElement(ABarControl, DC, R, ABarControl.CloseButtonState); DrawCross(R); end; class procedure TdxBarItemControlFlatPainter.BarDrawDockedBarBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); procedure DrawFinger; var I: Integer; Brush: HBRUSH; begin with R do begin if ABarControl.Horizontal then for I := Top to Bottom - 1 do begin if Odd(I - Top) then Brush := AToolbarBrush else Brush := COLOR_BTNSHADOW + 1; FillRect(DC, Rect(Left, I, Right, I + 1), Brush); end else for I := Left to Right - 1 do begin if Odd(I - Left) then Brush := AToolbarBrush else Brush := COLOR_BTNSHADOW + 1; FillRect(DC, Rect(I, Top, I + 1, Bottom), Brush); end; end; end; begin with R do begin FrameRect(DC, R, GetSysColorBrush(COLOR_BTNFACE)); InflateRect(R, -1, -1); FillRect(DC, Rect(Left, Top, Left + 1, Top + 1), COLOR_BTNFACE + 1); FillRect(DC, Rect(Right - 1, Top, Right, Top + 1), COLOR_BTNFACE + 1); FillRect(DC, Rect(Left, Bottom - 1, Left + 1, Bottom), COLOR_BTNFACE + 1); FillRect(DC, Rect(Right - 1, Bottom - 1, Right, Bottom), COLOR_BTNFACE + 1); InflateRect(R, -1, -1); if ABarControl.Bar.CanMoving then begin if ABarControl.Horizontal then begin Inc(Left, ABarControl.BarManager.BeforeFingersSize); Right := Left + ABarControl.PainterClass.GripperSize; InflateRect(R, 0, -3); end else begin Inc(Top, ABarControl.BarManager.BeforeFingersSize); Bottom := Top + ABarControl.PainterClass.GripperSize; InflateRect(R, -3, 0); end; DrawFinger; end; end; end; class procedure TdxBarItemControlFlatPainter.BarDrawFloatingBarBorder(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); var I: Integer; begin FrameRect(DC, R, ABarControl.BarManager.FlatToolbarsBorderBrush); InflateRect(R, -1, -1); FrameRect(DC, R, GetSysColorBrush(COLOR_BTNHIGHLIGHT)); for I := R.Left + 1 to CR.Left - 1 do begin InflateRect(R, -1, -1); FrameRect(DC, R, AToolbarBrush); end; end; class procedure TdxBarItemControlFlatPainter.BarDrawMark(ABarControl: TdxBarControl; DC: HDC; MarkR: TRect); procedure DrawBackground; var R: TRect; ABrush: HBRUSH; begin if ABarControl.Bar.CanClose then begin R := MarkR; with R do begin Left := Right; Right := Left + FloatToolbarMarkIndent; end; ABrush := CreateSolidBrush(ABarControl.CaptionBkColor); FillRect(DC, R, ABrush); DeleteObject(ABrush); end; if ABarControl.MarkState = msPressed then BarDrawBarControlOwner(ABarControl, DC, MarkR, ABarControl.FQuickPopup) else BarDrawCaptionElement(ABarControl, DC, MarkR, ABarControl.MarkState); end; begin DrawBackground; inherited BarDrawMark(ABarControl, DC, MarkR); end; class procedure TdxBarItemControlFlatPainter.BarDrawMDIButton(ABarControl: TdxBarControl; AButton: TdxBarMDIButton; ASelected, APressed: Boolean; DC: HDC; R: TRect); const Enables: array[Boolean] of Integer = (DFCS_INACTIVE, 0); var ABitmap: TBitmap; ABrush: HBRUSH; begin ABitmap := TBitmap.Create; try InflateRect(R, -1, -1); ABitmap.Width := R.Right - R.Left; ABitmap.Height := R.Bottom - R.Top; DrawFrameControl(ABitmap.Canvas.Handle, Rect(-1, -1, ABitmap.Width + 1, ABitmap.Height + 1), DFC_CAPTION, MDIButtonStyles[AButton] or DFCS_FLAT or Enables[ABarControl.MDIButtonEnabled(AButton, MF_GRAYED)]); if not ASelected and not APressed then begin InflateRect(R, 1, 1); ABarControl.FillBackground(DC, R, ABarControl.BkBrush, clNone, True); InflateRect(R, -1, -1); end else begin if APressed then begin if ASelected then ABrush := ABarControl.ToolbarDownedSelBrush else ABrush := ABarControl.ToolbarDownedBrush; end else if ASelected then ABrush := ABarControl.ToolbarSelBrush else ABrush := ABarControl.ToolbarBrush; FillRect(DC, R, ABrush); end; TransparentDraw(DC, ABarControl.BkBrush, R, R, ABitmap, nil, -1, True, False, False{Flat}, False, False, False, False{Shadow}, True{Transparent}, clNone{Faded}, clNone); if ASelected or APressed then begin InflateRect(R, 1, 1); FrameFlatSelRect(DC, R); end; finally ABitmap.Free; end; end; class function TdxBarItemControlFlatPainter.BarMarkItemRect(ABarControl: TdxBarControl): TRect; begin case ABarControl.DockingStyle of dsTop, dsBottom: with Result do begin Left := ABarControl.ClientWidth - MarkSizeX; Top := 0; Right := Left + MarkSizeX; Bottom := ABarControl.ClientHeight; end; dsLeft, dsRight: with Result do begin Left := 0; Top := ABarControl.ClientHeight - MarkSizeX; Right := ABarControl.ClientWidth; Bottom := Top + MarkSizeX; end; else Result := ABarControl.GetCaptionRect; with Result do begin Left := Right - (Bottom - Top); if ABarControl.Bar.CanClose then with ABarControl.CloseButtonRect do OffsetRect(Result, -(Right - Left + FloatToolbarMarkIndent), 0); with ABarControl.GetCaptionRect do if Result.Left < Left{ - 3} then Result.Left := Left{ - 3}; end; end; end; class function TdxBarItemControlFlatPainter.BarToolbarBrushEx2(ABarControl: TdxBarControl): HBRUSH; begin Result := GetSysColorBrush(COLOR_WINDOW); end; class procedure TdxBarItemControlFlatPainter.DrawQuickCustItemFrame(ABarItemControl: TdxBarItemControl; DC: HDC; var R, ARect: TRect; Selected: Boolean); begin with R do begin if not Selected then DrawBackgroundFrameRect(ABarItemControl, DC, Rect(Left, Top, Left + (Bottom - Top), Bottom), ABarItemControl.BarManager.FlatToolbarsBrush, False); InflateRect(R, -1, -1); // inherited? Right := Left + Bottom - Top; end; ARect.Left := R.Right + 1; end; class procedure TdxBarItemControlFlatPainter.DrawQuickCustItemFrameSelected(ABarItemControl: TdxBarItemControl; DC: HDC; WholeR, R: TRect; Selected: Boolean); begin if Selected then begin FrameFlatSelRect(DC, WholeR); with R do begin Left := Right; Right := Left + 2; // paint over! end; FillRect(DC, R, ABarItemControl.Parent.ToolbarSelBrush); end; end; class function TdxBarItemControlFlatPainter.IsQuickControlPopupOnRight: Boolean; begin Result := True; end; class procedure TdxBarItemControlFlatPainter.CorrectButtonControlDefaultHeight(var DefaultHeight: Integer); begin Inc(DefaultHeight, 2); end; class procedure TdxBarItemControlFlatPainter.CorrectButtonControlDefaultWidth(ABarItemControl: TdxBarItemControl; var DefaultWidth: Integer); begin Inc(DefaultWidth, 2 + 1 + 6); end; class procedure TdxBarItemControlFlatPainter.DrawButtonControlArrow(ABarItemControl: TdxBarItemControl; DC: HDC; R1: TRect; Brush: HBRUSH; ArrowColor: COLORREF; Selected, DrawDowned, DroppedDown, DropDownEnabled, IsDropDownMenuControlExist: Boolean; PaintType: TdxBarPaintType); begin if PaintType <> ptMenu then Dec(R1.Left); if (PaintType = ptMenu) or not (DroppedDown and IsDropDownMenuControlExist) {not DroppedDownFlat} then begin if (PaintType = ptMenu) or Selected then if Selected then FrameFlatSelRect(DC, R1) else FrameRect(DC, R1, GetSysColorBrush(COLOR_BTNSHADOW)) else FrameRect(DC, R1, ABarItemControl.Parent.BkBrush); InflateRect(R1, -1, -1); DrawBackground(ABarItemControl, DC, R1, Brush, DroppedDown or DrawDowned or Selected or ABarItemControl.FNonRecent); InflateRect(R1, 1, 1); end; if PaintType = ptMenu then DrawLargeItemArrow(DC, R1, atRight, ABarItemControl.Parent.MenuArrowHeight, (IsHighContrastWhite and Selected) or DroppedDown, ABarItemControl.Enabled and DropDownEnabled, True{Flat}) else DrawItemArrow(DC, R1, atDown, ABarItemControl.Enabled and DropDownEnabled, Selected and not DroppedDown and IsHighContrastWhite, True{Flat}); end; class function TdxBarItemControlFlatPainter.IsDropDownRepaintNeeded: Boolean; begin Result := True; end; class procedure TdxBarItemControlFlatPainter.ComboControlDrawArrow(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; Selected: Boolean; PaintType: TdxBarPaintType); const Borders: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER); var Brush, SpaceBrush: HBRUSH; ArrowColor: COLORREF; X, Y, Size: Integer; begin with ARect do begin Left := Right - ABarComboControl.Parent.ComboBoxArrowWidth; ABarComboControl.FDropDownButtonRect := ARect; ComboControlGetArrowParams(ABarComboControl, PaintType, ABarComboControl.Enabled, Selected, ABarComboControl.DroppedDown, Brush, ArrowColor); if Selected then begin InflateRect(ARect, 1, 1); FrameFlatSelRect(DC, ARect); InflateRect(ARect, -1, -1); FillRect(DC, ARect, Brush); end else begin if Selected and ABarComboControl.Enabled then begin DrawEdge(DC, ARect, Borders[ABarComboControl.DroppedDown], BF_RECT); SpaceBrush := ABarComboControl.Parent.BkBrush; end else begin if ABarComboControl.Enabled then SpaceBrush := GetSysColorBrush(COLOR_BTNHIGHLIGHT) else SpaceBrush := ABarComboControl.Parent.BkBrush; FrameRect(DC, ARect, SpaceBrush); end; FillRect(DC, Rect(Left - 1, Top, Left, Bottom), SpaceBrush); InflateRect(ARect, -1, -1); FillRect(DC, ARect, Brush); if ABarComboControl.DroppedDown then OffsetRect(ARect, 1, 1); end; with ARect do begin Size := (Right - Left) div 2; if not Odd(Size) then Inc(Size); X := (Left + Right - Size) div 2; Y := (Top + Bottom - Size div 2) div 2; ComboControlDrawOneArrow(ABarComboControl, DC, X, Y, Size, ArrowColor); end; end; end; class procedure TdxBarItemControlFlatPainter.ComboControlGetArrowParams(ABarItemControl: TdxBarItemControl; APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); begin inherited; if (APaintType = ptMenu) and not ASelected then ABrush := ABarItemControl.Parent.ToolbarBrush; if not AEnabled then AArrowColor := COLOR_BTNSHADOW; end; class function TdxBarItemControlFlatPainter.DropDownListBoxBorderSize: Integer; begin Result := 2; end; class procedure TdxBarItemControlFlatPainter.DropDownListBoxDrawBorder(ABarManager: TdxBarManager; DC: HDC; R: TRect); begin FrameRect(DC, R, GetSysColorBrush(COLOR_BTNSHADOW)); InflateRect(R, -1, -1); FrameRect(DC, R, GetSysColorBrush(COLOR_WINDOW)); end; class function TdxBarItemControlFlatPainter.SubItemControlCaptionOffset(ABarSubItemControl: TdxBarSubItemControl): Integer; begin if (ABarSubItemControl.Parent as TdxBarControl).Bar.IsMainMenu then Result := 8 else Result := inherited SubItemControlCaptionOffset(ABarSubItemControl); end; class function TdxBarItemControlFlatPainter.SubItemControlDefaultHeight(ABarSubItemControl: TdxBarSubItemControl): Integer; begin Result := inherited SubItemControlDefaultHeight(ABarSubItemControl); if not (ABarSubItemControl.Parent is TdxBarControl) then Inc(Result, 2); end; class function TdxBarItemControlFlatPainter.SubItemControlDefaultWidth(ABarSubItemControl: TdxBarSubItemControl): Integer; begin Result := inherited SubItemControlDefaultWidth(ABarSubItemControl); if ABarSubItemControl.Parent is TdxBarSubMenuControl then Inc(Result, 2 + 1 + 6); end; class procedure TdxBarItemControlFlatPainter.SubItemControlDraw(ABarSubItemControl: TdxBarSubItemControl; DC: HDC; R: TRect; Selected, Down: Boolean; PaintType: TdxBarPaintType); procedure DrawArrow; var Size: Integer; begin if PaintType = ptMenu then Size := ABarSubItemControl.Parent.MenuArrowHeight else Size := ABarSubItemControl.Parent.MenuArrowHeight - 1; with R do case PaintType of ptMenu: begin Left := Right - ABarSubItemControl.Parent.TextSize + Size; DrawLargeItemArrow(DC, R, atRight, Size, Selected and IsHighContrastWhite, ABarSubItemControl.Enabled, True{Flat}); end; ptHorz: begin Left := Right - ABarSubItemControl.Parent.TextSize div 2 + ABarSubItemControl.Parent.Canvas.Font.Height div 2; DrawLargeItemArrow(DC, R, atDown, Size, Selected and not Down and IsHighContrastWhite, ABarSubItemControl.Enabled, True{Flat}); end; ptVert: begin Top := Bottom - ABarSubItemControl.Parent.TextSize div 2 + ABarSubItemControl.Parent.Canvas.Font.Height div 2; DrawLargeItemArrow(DC, R, atRight, Size, Selected and not Down and IsHighContrastWhite, ABarSubItemControl.Enabled, True{Flat}); end; end; end; begin with R do if PaintType = ptMenu then begin DrawGlyphAndTextInSubMenu(ABarSubItemControl, DC, R, Selected, True, False); DrawArrow; end else begin DrawGlyph(ABarSubItemControl, R, nil, PaintType, False, Selected, Down, False, False, False, True, False); if ABarSubItemControl.ImageExists or not ABarSubItemControl.Item.ShowCaption then if PaintType = ptHorz then Inc(Left, ABarSubItemControl.BarManager.ButtonWidth) else Inc(Top, ABarSubItemControl.BarManager.ButtonHeight) else if PaintType = ptHorz then Inc(Left, ABarSubItemControl.CaptionOffset) else Inc(Top, ABarSubItemControl.CaptionOffset); if ABarSubItemControl.Item.ShowCaption then DrawItemText(ABarSubItemControl, DC, ABarSubItemControl.Caption, R, DT_LEFT, ABarSubItemControl.Enabled, Selected and not Down and IsHighContrastWhite{False}, PaintType = ptVert, False, not IsHighContrastWhite{True}); if not TdxBarControl(ABarSubItemControl.Parent).Bar.IsMainMenu then DrawArrow; end; end; class function TdxBarItemControlFlatPainter.SubMenuControlBeginGroupSize: Integer; begin Result := 2 + 1 + 2; end; class function TdxBarItemControlFlatPainter.SubMenuControlBorderSize: Integer; begin Result := 2; end; class procedure TdxBarItemControlFlatPainter.SubMenuControlCalcDrawingConsts(ABarSubMenuControl: TdxBarSubMenuControl; var ATextSize, AMenuArrowWidth, AMarkSize, ANormalItemHeight: Integer); var Size: Integer; begin Inc(ATextSize); AMenuArrowWidth := ATextSize div 4 * 3 + 1; AMarkSize := ABarSubMenuControl.Canvas.TextHeight('0') + 1 {- 2}; Size := SubMenuControlMarkArrowSize(ABarSubMenuControl, AMarkSize - 2); if Odd(Size) then AMarkSize := (Size - 1) * 2 + 2 * 3; ANormalItemHeight := 19 + 1; end; class procedure TdxBarItemControlFlatPainter.SubMenuControlCalcRect(ABarSubMenuControl: TdxBarSubMenuControl; Size: PPoint; var R: TRect; var AClientHeight: Integer); begin with ABarSubMenuControl do begin R := Rect(1 + BarSize, 1, ClientWidth - 1, 1); if Size = nil then AClientHeight := ClientHeight - 1 - TextSize * Byte(MarkExists) else begin Size^.X := 0; AClientHeight := MaxInt; end; end; end; class procedure TdxBarItemControlFlatPainter.SubMenuControlCalcSize(ABarSubMenuControl: TdxBarSubMenuControl; Size: PPoint; var R: TRect); begin with ABarSubMenuControl do begin if Size^.X = 0 then Size^.X := 100 else Inc(Size^.X, 2 * 2 + BarSize); if (R.Top <= 2) or MarkExists then Inc(R.Top, TextSize); Size^.Y := 1 + R.Top + 2; if Detachable then Inc(Size^.Y, DetachCaptionAreaSize); end; end; class function TdxBarItemControlFlatPainter.SubMenuControlDetachCaptionAreaSize(ABarSubMenuControl: TdxBarSubMenuControl): Integer; begin Result := ABarSubMenuControl.DetachCaptionSize + 1; end; class procedure TdxBarItemControlFlatPainter.SubMenuControlDrawArrowsArea(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; ABrush: HBRUSH; AMaxVisibleCount: Integer); var R: TRect; AControl: TdxBarItemControl; begin with ABarSubMenuControl do begin if UpArrowExists then begin R := ItemLinks.VisibleItems[TopIndex].ItemRect; SubMenuControlDrawArrow(ABarSubMenuControl, DC, R, True); DrawBackground(ItemLinks.VisibleItems[TopIndex].Control, DC, R, ToolbarItemsBrush, False); SelectClipRgn(DC, 0); end; AControl := ItemLinks.VisibleItems[TopIndex + AMaxVisibleCount - 1].Control; R := GetItemRectEx(AControl, True); if DownArrowExists then begin SubMenuControlDrawArrow(ABarSubMenuControl, DC, R, False); DrawBackground(AControl, DC, R, ToolbarItemsBrush, False); end; R.Top := R.Bottom; R.Bottom := ClientHeight - 1; if MarkExists then Dec(R.Bottom, TextSize); DrawBackground(AControl, DC, R, ToolbarItemsBrush, False); if DownArrowExists then SelectClipRgn(DC, 0); if MarkExists then begin R.Top := R.Bottom; R.Bottom := R.Top + TextSize; Dec(R.Bottom, MarkSize); DrawBackground(AControl, DC, R, ToolbarItemsBrush, False); R.Top := R.Bottom; Inc(R.Bottom, MarkSize); with R do DrawBackground(AControl, DC, Rect(Left, Top, Left + 1, Bottom), ToolbarItemsBrush, False); if MarkState = msSelected then begin FrameFlatSelRect(DC, R); ABrush := ToolbarSelBrush; InflateRect(R, -1, -1); DrawBackground(AControl, DC, R, ABrush, True); InflateRect(R, 1, 1); end else DrawBackground(AControl, DC, R, ToolbarItemsBrush, False); SubMenuControlDrawMark(ABarSubMenuControl, DC, R, MarkState = msSelected); end; end; end; class procedure TdxBarItemControlFlatPainter.SubMenuControlDrawBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); procedure DrawFlatBorder; begin FrameRect(DC, R, ABarSubMenuControl.BarManager.FlatToolbarsBorderBrush); BarDrawOwnerLink(ABarSubMenuControl, DC); end; begin with R do begin DrawFlatBorder; if ABarSubMenuControl.Detachable then begin InflateRect(R, -1, -1); Bottom := Top + 1; FillRect(DC, R, COLOR_WINDOW + 1); Top := Bottom; Bottom := Top + ABarSubMenuControl.DetachCaptionSize; FillRect(DC, Rect(Left, Top, Left + 1, Bottom), COLOR_WINDOW + 1); FillRect(DC, Rect(Right - 1, Top, Right, Bottom), COLOR_WINDOW + 1); SubMenuControlDrawDetachCaption(ABarSubMenuControl, DC, ABarSubMenuControl.DetachCaptionRect); end; end end; class procedure TdxBarItemControlFlatPainter.SubMenuControlDrawClientBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; var R: TRect; ABrush: HBRUSH); begin FrameRect(DC, R, ABarSubMenuControl.ToolbarItemsBrush); with R do FillRect(DC, Rect(Left, Top + 1, Left + 1, Bottom - 1), ABrush); end; class procedure TdxBarItemControlFlatPainter.SubMenuControlDrawDetachCaption(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); const MarkSize = 33; Colors: array[Boolean] of COLORREF = (COLOR_BTNSHADOW, COLOR_BTNTEXT); var Brush: HBRUSH; I: Integer; begin if ABarSubMenuControl.DetachCaptionSelected then begin FrameFlatSelRect(DC, R); InflateRect(R, -1, -1); Brush := ABarSubMenuControl.ToolbarSelBrush; end else Brush := ABarSubMenuControl.BarManager.FlatToolbarsBrush; FillRect(DC, R, Brush); Brush := Colors[ABarSubMenuControl.DetachCaptionSelected] + 1; with R do begin InflateRect(R, -(Right - Left - MarkSize) div 2, -1); Right := Left + MarkSize; for I := Top to Bottom - 1 do if not Odd(I - Top) then FillRect(DC, Rect(Left, I, Right, I + 1), Brush); end; end; class procedure TdxBarItemControlFlatPainter.SubMenuControlDrawBeginGroup(ABarSubMenuControl: TdxBarSubMenuControl; AControl: TdxBarItemControl; DC: HDC; AItemRect: TRect; LeftDelta: Integer); var R: TRect; ABrush: HBRUSH; LD, RD: Integer; AOpaque: Boolean; begin R := AItemRect; if not IgnoreNonRecentColor and AControl.FChangeRecentGroup and AControl.FNonRecent then ABrush := SubMenuControlToolbarItemsBrush(ABarSubMenuControl) else ABrush := ABarSubMenuControl.BkBrush; AOpaque := not IgnoreNonRecentColor and AControl.FNonRecent and not AControl.FChangeRecentGroup; with R do begin Bottom := Top; Dec(R.Top, ABarSubMenuControl.BeginGroupSize); AControl.FBeginGroupRect := R; LD := Left + AControl.TextAreaOffset; DrawBackground(AControl, DC, Rect(Left, Top, LD, Bottom), ABarSubMenuControl.BarManager.FlatToolbarsBrush, AOpaque); DrawBackground(AControl, DC, Rect(LD, Top, Right, Bottom), ABrush, AOpaque); RD := (Top + Bottom) div 2; FillRect(DC, Rect(LD + ABarSubMenuControl.BarManager.SubMenuBeginGroupIndent, RD, Right + 1, RD + 1), SubMenuControlGroupSeparatorBrush(ABarSubMenuControl)); end; end; class function TdxBarItemControlFlatPainter.SubMenuControlGroupSeparatorBrush(ABarSubMenuControl: TdxBarSubMenuControl): HBRUSH; begin Result := GetSysColorBrush(COLOR_BTNSHADOW); end; class function TdxBarItemControlFlatPainter.SubMenuControlMarkArrowSize(ABarSubMenuControl: TdxBarSubMenuControl; AMarkSize: Integer): Integer; begin Result := (AMarkSize - 2 * 2) div 2; if (Result > 4) and Odd(Result) then Dec(Result); end; class procedure TdxBarItemControlFlatPainter.SubMenuControlOffsetDetachCaptionRect(ABarSubMenuControl: TdxBarSubMenuControl; var R: TRect); begin InflateRect(R, -2, -2); end; class procedure TdxBarItemControlFlatPainter.SubMenuControlPrepareBkBrush(ABarSubMenuControl: TdxBarSubMenuControl; var ABkBrush: HBRUSH); begin ABkBrush := SubMenuControlToolbarItemsBrush(ABarSubMenuControl); end; class function TdxBarItemControlFlatPainter.SubMenuControlToolbarItemsBrush(ABarSubMenuControl: TdxBarSubMenuControl): HBRUSH; begin Result := GetSysColorBrush(COLOR_WINDOW); end; class procedure TdxBarItemControlFlatPainter.CustomComboDrawItem(ABarCustomCombo: TdxBarCustomCombo; ACanvas: TCanvas; AIndex: Integer; ARect: TRect; AState: TOwnerDrawState; AInteriorIsDrawing: Boolean); var S: string; begin with ACanvas, ARect do begin if AIndex = -1 then S := ABarCustomCombo.Text else S := ABarCustomCombo.Items[AIndex]; FillRect(ARect); TextOut(Left + 2, Top + Byte(AInteriorIsDrawing) * 2, S); end; end; class function TdxBarItemControlFlatPainter.EditControlCaptionWidth(ABarEditControl: TdxBarEditControl; ATextWidth: Integer): Integer; begin Result := 1 + 5 + ATextWidth + 5; end; class procedure TdxBarItemControlFlatPainter.EditControlDrawBorder(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); begin if Selected then FrameFlatSelRect(DC, ARect) else if (PaintType = ptMenu) or not ABarEditControl.Enabled then if PaintType = ptMenu then FrameRect(DC, ARect, ABarEditControl.Parent.ToolbarBrush) else FrameRect(DC, ARect, GetSysColorBrush(COLOR_BTNSHADOW)) else DrawBackgroundFrameRect(ABarEditControl, DC, ARect, ABarEditControl.Parent.BkBrush, False); InflateRect(ARect, -1, -1); end; class procedure TdxBarItemControlFlatPainter.EditControlDrawCaption(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); var S: string; Size: TSize; R: TRect; Brush: HBRUSH; begin S := GetTextOf(ABarEditControl.Caption); GetTextExtentPoint32(DC, PChar(S), Length(S), Size); R := ARect; R.Right := R.Left + EditControlCaptionWidth(ABarEditControl, Size.cX); ARect.Left := R.Right; if Selected and (PaintType = ptMenu) then begin Inc(R.Right); FrameFlatSelRect(DC, R); InflateRect(R, -1, -1); end; if Selected and (PaintType = ptMenu) then Brush := ABarEditControl.Parent.ToolbarSelBrush else Brush := ABarEditControl.Parent.BkBrush; DrawBackground(ABarEditControl, DC, R, Brush, (PaintType = ptMenu) and (Selected or ABarEditControl.FNonRecent)); Dec(R.Right, 5); DrawItemText(ABarEditControl, DC, ABarEditControl.Caption, R, DT_RIGHT, ABarEditControl.Enabled, Selected and (PaintType = ptMenu), False, False, not IsHighContrastWhite); end; class procedure TdxBarItemControlFlatPainter.EditControlDrawTextField(ABarEditControl: TdxBarEditControl; DC: HDC; const ARect: TRect; AIgnoreEnabled: Boolean); begin inherited EditControlDrawTextField(ABarEditControl, DC, ARect, True); end; class function TdxBarItemControlFlatPainter.EditControlES_Style: Integer; begin Result := inherited EditControlES_Style or ES_MULTILINE; end; class procedure TdxBarItemControlFlatPainter.EditControlPrepareEditWnd(ABarEditControl: TdxBarEditControl; AHandle: HWND); var R: TRect; begin R := ABarEditControl.WindowRect; with R do begin OffsetRect(R, -Left, -Top); InflateRect(R, -2, -2); end; SendMessage(AHandle, EM_SETRECTNP, 0, LPARAM(@R)); end; class procedure TdxBarItemControlFlatPainter.EditControlUpdateWndText(ABarEditControl: TdxBarEditControl; AHandle: HWND; ANotEqual: Boolean); begin if ANotEqual then SendMessage(AHandle, WM_COMMAND, MAKEWPARAM(0, EN_CHANGE), AHandle); inherited EditControlUpdateWndText(ABarEditControl, AHandle, ANotEqual); end; class procedure TdxBarItemControlFlatPainter.SysPanelDraw(AHandle: HWND; AllowResizing, MouseAboveCloseButton, CloseButtonIsTracking: Boolean; var CloseButtonRect, GripRect: TRect; Corner: TdxCorner); begin dxBarPopupNCPaint(AHandle, AllowResizing, True, MouseAboveCloseButton, CloseButtonIsTracking, CloseButtonRect, GripRect, Corner); end; class function TdxBarItemControlFlatPainter.IsDateNavigatorFlat: Boolean; begin Result := True; end; class procedure TdxBarItemControlFlatPainter.DateNavigatorDrawButton(ABarItem: TdxBarItem; DC: HDC; R: TRect; const ACaption: string; APressed: Boolean); begin with R do begin FrameRect(DC, R, GetSysColorBrush(COLOR_BTNSHADOW)); InflateRect(R, -1, -1); FrameRect(DC, R, GetSysColorBrush(COLOR_BTNFACE)); InflateRect(R, -1, -1); end; DateNavigatorDrawButtonCaption(DC, R, 0, ACaption, True); end; class procedure TdxBarItemControlFlatPainter.SpinEditControlDrawButton(ABarEditControl: TdxBarEditControl; DC: HDC; ARect: TRect; XSize, YSize, Size: Integer; Selected: Boolean; AButton, AActiveButton: TdxBarSpinEditButton; AButtonPressed: Boolean); var R: TRect; AColor: Integer; begin R := ARect; with R do begin if AButton = sbUp then Bottom := Top + Size + 1 else Inc(Top, Size); FrameAndFillRect(ABarEditControl, DC, R, ABarEditControl.Enabled, Selected, (AActiveButton = AButton) and AButtonPressed); Inc(Left, YSize); Top := (Top + Bottom - YSize) div 2 + Byte(AButton = sbUp) * (YSize - 1); if ABarEditControl.Enabled then begin if IsHighContrastWhite and Selected then AColor := COLOR_BTNFACE else AColor := COLOR_BTNTEXT; SpinEditControlDrawOneArrow(DC, Left, Top, XSize, YSize, AColor, AButton); end else SpinEditControlDrawOneArrow(DC, Left, Top, XSize, YSize, COLOR_BTNSHADOW, AButton); end; end; class function TdxBarItemControlFlatPainter.ContainerControlSubMenuOffset: Integer; begin Result := 2 + 1 + 6; end; class procedure TdxBarItemControlFlatPainter.InPlaceSubItemControlDrawInMenu(ABarContainerItemControl: TdxBarContainerItemControl; DC: HDC; Selected, AItemExpanded: Boolean; ARect: TRect); const Arrows: array[Boolean] of TdxArrowType = (atRight, atDown); var R: TRect; Brush: HBRUSH; Size: Integer; begin R := ARect; R.Top := R.Bottom - 1; FillRect(DC, R, ABarContainerItemControl.Parent.BkBrush); R.Bottom := R.Top; R.Top := ARect.Top; if Selected then Brush := ABarContainerItemControl.Parent.ToolbarSelBrush else Brush := InPlaceSubItemControlBrush; if Selected then FrameFlatSelRect(DC, R) else FrameRect(DC, R, InPlaceSubItemControlBrush); InflateRect(R, -1, -1); FillRect(DC, R, Brush); Inc(R.Left, 5); DrawItemText(ABarContainerItemControl, DC, ABarContainerItemControl.Caption, R, DT_LEFT, True, True, False, False, Selected and not IsHighContrastWhite); if ABarContainerItemControl.Enabled then begin Size := ABarContainerItemControl.Parent.MenuArrowHeight; with R do Left := Right - ABarContainerItemControl.Parent.TextSize + Byte(not AItemExpanded) * Size; DrawLargeItemArrow(DC, R, Arrows[AItemExpanded], Size, not Selected or IsHighContrastWhite, True, True{Flat}); end; end; class procedure TdxBarItemControlFlatPainter.DrawGlyphBorder(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, BarControlOwner, IsSplit: Boolean); begin if Down or (Selected and (PaintType <> ptMenu)) then begin if Down and BarControlOwner then BarDrawBarControlOwnerBorder(ABarItemControl.Parent, DC, R, ABarItemControl, ABarItemControl.OwnedBarControl) else FrameFlatSelRect(DC, R); end else if NeedBorder then DrawBackgroundFrameRect(ABarItemControl, DC, R, ABrush, Selected or Down or DrawDowned or ABarItemControl.FNonRecent); end; class procedure TdxBarItemControlFlatPainter.DrawGlyphCheckMark(ABarItemControl: TdxBarItemControl; DC: HDC; X, Y, DoubleSize: Integer); //const // Colors: array[Boolean] of TColor = (clBlack, clWhite); var OffsetY, I: Integer; procedure DrawOneMark; begin with ABarItemControl.Parent.Canvas do begin MoveTo(X + DoubleSize * 1, Y + OffsetY + DoubleSize * 2); LineTo(X + DoubleSize * 3, Y + OffsetY + DoubleSize * 4); LineTo(X + DoubleSize * 8, Y + OffsetY - DoubleSize * 1); end; Inc(OffsetY); end; begin with ABarItemControl.Parent.Canvas do if ABarItemControl.Enabled then begin OffsetY := 0; if IsHighContrastWhite or IsHighContrast2 then Pen.Color := clWhite else{ if IsHighContrast2 then Pen.Color := clBlack else} Pen.Color := clBlack; // Pen.Color := Colors[GetSysColor(COLOR_BTNFACE) = 0]; for I := 1 to 2 * DoubleSize do DrawOneMark; end else begin OffsetY := 1; Pen.Color := GetSysColor(COLOR_BTNSHADOW); for I := 1 to 2 * DoubleSize do DrawOneMark; end; end; class procedure TdxBarItemControlFlatPainter.DrawGlyphImage(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; const GlyphRect: TRect; AGlyph: TBitmap; AImages: TCurImageList; AImageIndex: Integer; Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean; PaintType: TdxBarPaintType); var ATransparent: Boolean; begin if NeedBorder then InflateRect(R, -1, -1); ATransparent := not ABarItemControl.FNonRecent and ABarItemControl.Parent.IsTransparent; if ATransparent then DrawBackground(ABarItemControl, DC, R, ABrush, Down or DrawDowned or Selected or ABarItemControl.FNonRecent); TransparentDraw(DC, ABrush, R, GlyphRect, AGlyph, AImages, AImageIndex, ABarItemControl.GetImageEnabled(PaintType), GrayScale, True{Flat}, Selected, Down, DrawDowned, True{Shadow}, ATransparent, GetFadedColor(ABarItemControl.Parent){Faded}, ABarItemControl.Item.BarManager.ImageListBkColor); if NeedBorder then InflateRect(R, 1, 1); end; class procedure TdxBarItemControlFlatPainter.FrameFlatSelRect(DC: HDC; const R: TRect); begin if IsHighContrastBlack or IsHighContrast2 then FrameRectByColor(DC, R, clHighlightText) else dxBar.FrameFlatSelRect(DC, R); end; class function TdxBarItemControlFlatPainter.BarCaptionBkColor(ABarControl: TdxBarControl; AMainFormActive: Boolean): COLORREF; begin Result := inherited BarCaptionBkColor(ABarControl, False); end; class function TdxBarItemControlFlatPainter.BarMarkArrowColor(ABarControl: TdxBarControl; AState: TdxBarMarkState): COLORREF; begin if AState <> msNone then Result := GetSysColor(COLOR_BTNTEXT) else Result := inherited BarMarkArrowColor(ABarControl, AState); end; class procedure TdxBarItemControlFlatPainter.BarDrawMarkBackground(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); begin if ABarControl.MarkState = msPressed then BarDrawBarControlOwner(ABarControl, DC, ItemRect, ABarControl.FQuickPopup) else begin if ABarControl.MarkState = msNone then FrameRect(DC, ItemRect, AToolbarBrush) else FrameFlatSelRect(DC, ItemRect); InflateRect(ItemRect, -1, -1); if ABarControl.MarkState = msSelected then begin AToolbarBrush := ABarControl.ToolbarSelBrush; FillRect(DC, ItemRect, AToolbarBrush); end else ABarControl.FillBackground(DC, ItemRect, AToolbarBrush, clNone, True); InflateRect(ItemRect, 1, 1); end; end; class procedure TdxBarItemControlFlatPainter.BarDrawMarkElements(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect); begin TdxBarItemControlEnhancedPainter.BarDrawMarkElements(ABarControl, DC, ItemRect); end; class procedure TdxBarItemControlFlatPainter.BarOffsetFloatingBarCaption(ABarControl: TdxBarControl; var X: Integer; var R: TRect); begin Inc(X, 2); R.Right := ABarControl.MarkNCRect.Left; end; class function TdxBarItemControlFlatPainter.GetDrawMarkElementColor(ABarControl: TdxBarControl): Integer; begin if IsHighContrastWhite and (ABarControl.MarkState = msSelected) then Result := COLOR_BTNFACE else Result := inherited GetDrawMarkElementColor(ABarControl); end; class procedure TdxBarItemControlFlatPainter.EditOffsetInteriorRect(var R: TRect); begin Inc(R.Top, 2); end; { TdxBarItemControlOffice11Painter } class procedure TdxBarItemControlOffice11Painter.DrawGlyphAndTextInSubMenu(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Selected, ShowGlyph, Down: Boolean); var I: Integer; IconRect: TRect; IsGlyphEmpty, AOpaque: Boolean; ABrush: HBRUSH; begin with R do begin if Selected then begin AOpaque := True; Office11FrameSelectedRect(DC, R) end else begin AOpaque := False; I := Left + Bottom - Top + 1; ABrush := ABarItemControl.Parent.BkBrush; DrawBackground(ABarItemControl, DC, Rect(Left, Top, I, Top + 1), ABrush, AOpaque); DrawBackground(ABarItemControl, DC, Rect(Left, Bottom - 1, I, Bottom), ABrush, AOpaque); DrawBackground(ABarItemControl, DC, Rect(Left, Top + 1, Left + 1, Bottom - 1), ABrush, AOpaque); ABrush := ABarItemControl.Parent.BkBrush; DrawBackground(ABarItemControl, DC, Rect(I, Top, Right, Top + 1), ABrush, AOpaque); DrawBackground(ABarItemControl, DC, Rect(I, Bottom - 1, Right, Bottom), ABrush, AOpaque); DrawBackground(ABarItemControl, DC, Rect(Right - 1, Top + 1, Right, Bottom - 1), ABrush, AOpaque); end; InflateRect(R, -1, -1); IconRect := R; IconRect.Right := IconRect.Left + Bottom - Top; IsGlyphEmpty := not ABarItemControl.ImageExists or not ShowGlyph; DrawGlyph(ABarItemControl, IconRect, nil, ptMenu, IsGlyphEmpty, Selected, Down, False, False, False, False, False); if Selected then ABrush := ABarItemControl.Parent.ToolbarSelBrush else ABrush := ABarItemControl.Parent.BkBrush; Left := IconRect.Right + 2; with IconRect do DrawBackground(ABarItemControl, DC, Rect(Right, Top, R.Left, Bottom), ABrush, AOpaque); if Selected then ABrush := ABarItemControl.Parent.ToolbarSelBrush else ABrush := ABarItemControl.Parent.BkBrush; DrawBackground(ABarItemControl, DC, R, ABrush, AOpaque); Inc(Left, 8); DrawItemText(ABarItemControl, DC, ABarItemControl.Caption, R, DT_LEFT, ABarItemControl.Enabled, Selected, False, False, not IsHighContrastWhite); end; end; class procedure TdxBarItemControlOffice11Painter.FrameAndFillRect(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Enabled, Selected, Pressed: Boolean); var Brush: HBRUSH; begin if Selected then begin FrameFlatSelRect(DC, R); if Pressed then Brush := ABarItemControl.Parent.ToolbarDownedSelBrush else Brush := ABarItemControl.Parent.ToolbarSelBrush; end else begin if Enabled then begin FrameRect(DC, R, ABarItemControl.Parent.BkBrush); Brush := dxOffice11OwnerControlDownedBrush; end else begin FrameRectByColor(DC, R, dxOffice11TextDisabledColor); Brush := GetSysColorBrush(COLOR_BTNFACE); end; end; InflateRect(R, -1, -1); FillRect(DC, R, Brush); end; class procedure TdxBarItemControlOffice11Painter.GetArrowParams(ABarItemControl: TdxBarItemControl; APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); begin if AEnabled then begin AArrowColor := dxOffice11TextEnabledColor; // TODO: XP? if ASelected then begin if IsHighContrastWhite then AArrowColor := clWhite else if ADroppedDown and not IsXPStandardScheme then AArrowColor := ColorToRGB(clHighlightText); if ADroppedDown then ABrush := ABarItemControl.Parent.ToolbarDownedSelBrush else ABrush := ABarItemControl.Parent.ToolbarSelBrush; end else ABrush := ABarItemControl.Parent.BkBrush end else begin AArrowColor := dxOffice11TextDisabledColor; ABrush := GetSysColorBrush(COLOR_BTNFACE); end; end; class function TdxBarItemControlOffice11Painter.GlyphBkgndBrush(ABarItemControl: TdxBarItemControl; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean): HBRUSH; begin if Selected then if Down or DrawDowned then if Down and BarControlOwner then Result := ABarItemControl.Parent.BarControlOwnerBrush else Result := ABarItemControl.Parent.ToolbarDownedSelBrush else Result := ABarItemControl.Parent.ToolbarSelBrush else if Down then Result := ABarItemControl.Parent.ToolbarDownedBrush else if (PaintType = ptMenu) and not ForceUseBkBrush then Result := ABarItemControl.Parent.ToolbarBrush else Result := ABarItemControl.Parent.BkBrush; end; class function TdxBarItemControlOffice11Painter.IsItemTextSelectedInverted: Boolean; begin if IsXPStandardScheme then Result := False else Result := inherited IsItemTextSelectedInverted; end; class function TdxBarItemControlOffice11Painter.StaticBorderBrush(ABarItemControl: TdxBarItemControl; ABorderStyle: TdxBarStaticBorderStyle): HBRUSH; begin Result := dxOffice11StaticBorderBrush; end; class function TdxBarItemControlOffice11Painter.BeforeFingersSize: Integer; begin Result := inherited BeforeFingersSize + BarBeforeFingersIndent; end; class function TdxBarItemControlOffice11Painter.BorderSizeX: Integer; begin Result := 3; end; class function TdxBarItemControlOffice11Painter.BorderSizeY: Integer; begin Result := 3; end; class function TdxBarItemControlOffice11Painter.EmptyFingersSize: Integer; begin Result := 2; end; class procedure TdxBarItemControlOffice11Painter.DockControlFillBackground(ADockControl: TdxDockControl; DC: HDC; ADestR, ASourceR, AWholeR: TRect; ABrush: HBRUSH; AColor: TColor); procedure FillBackgroundTempBitmap(ABitmap: TBitmap); var AColor1, AColor2: TColor; begin with AWholeR do begin ABitmap.Width := Right - Left; ABitmap.Height := Bottom - Top; end; GetDockColors(ADockControl, AColor1, AColor2); FillGradientRect(ABitmap.Canvas.Handle, AWholeR, AColor1, AColor2, True); end; begin if ADockControl.BackgroundTempBitmap.Empty then FillBackgroundTempBitmap(ADockControl.BackgroundTempBitmap); with ADestR do BitBlt(DC, Left, Top, Right - Left, Bottom - Top, ADockControl.BackgroundTempBitmap.Canvas.Handle, ASourceR.Left, ASourceR.Top, SRCCOPY); end; class function TdxBarItemControlOffice11Painter.IsNativeBackground: Boolean; begin Result := True; end; class function TdxBarItemControlOffice11Painter.BarControlOwnerBrush(ABarManager: TdxBarManager): HBRUSH; begin Result := dxOffice11OwnerControlDownedBrush; end; class procedure TdxBarItemControlOffice11Painter.BarDrawBarControlOwnerFrame(ACustomBarControl: TCustomdxBarControl; DC: HDC; R: TRect); begin FrameRect(DC, R, dxOffice11DropDownBorderBrush1); end; class procedure TdxBarItemControlOffice11Painter.BarDrawBarControlOwnerLink(ACustomBarControl: TCustomdxBarControl; DC: HDC; R, ALinkR: TRect; ABarItemControl: TdxBarItemControl); var AColor: TColor; begin if (ABarItemControl = nil) or not IsMenuGradient(ABarItemControl) then inherited else begin if (ALinkR.Right - ALinkR.Left) > (ALinkR.Bottom - ALinkR.Top) then // Horz begin if ALinkR.Top > ((R.Bottom + R.Top) div 2) then // bottom AColor := dxOffice11MenuDownedColor2 else AColor := dxOffice11MenuDownedColor1; end else begin if ALinkR.Left > ((R.Right + R.Left) div 2) then // right AColor := dxOffice11MenuDownedColor2 else AColor := dxOffice11MenuDownedColor1; end; FillRectByColor(DC, ALinkR, AColor); end; end; class procedure TdxBarItemControlOffice11Painter.BarDrawDockedBackground(ABarControl: TCustomdxBarControl; DC: HDC; ADestR, ASourceR: TRect; ABrush: HBRUSH; AColor: TColor); var AWholeR: TRect; AClipRgn: HRGN; AClipRgnExists: Boolean; begin if (ABarControl is TdxBarControl) and ((TdxBarControl(ABarControl).Bar.BorderStyle = bbsNone) or TdxBarControl(ABarControl).Bar.IsMainMenu or ABarControl.IsBackgroundBitmap) then inherited else begin SaveClipRgn(DC, AClipRgn, AClipRgnExists); with ADestR do IntersectClipRect(DC, Left, Top, Right, Bottom); AWholeR := GetBarGradientRect(ABarControl); OffsetRect(AWholeR, -(ASourceR.Left - ADestR.Left), -(ASourceR.Top - ADestR.Top)); // NC offset FillTubeGradientRect(DC, AWholeR, dxOffice11ToolbarsColor1, dxOffice11ToolbarsColor2, (ABarControl is TdxBarControl) and TdxBarControl(ABarControl).Vertical); RestoreClipRgn(DC, AClipRgn, AClipRgnExists); end; end; class procedure TdxBarItemControlOffice11Painter.BarDrawFloatingBackground(ABarControl: TCustomdxBarControl; DC: HDC; ADestR, ASourceR: TRect; ABrush: HBRUSH; AColor: TColor); var R: TRect; AClipRgn: HRGN; AClipRgnExists: Boolean; begin if ABarControl.IsInternal or ABarControl.IsBackgroundBitmap then inherited else begin R := ABarControl.ClientRect; SaveClipRgn(DC, AClipRgn, AClipRgnExists); with ADestR do IntersectClipRect(DC, Left, Top, Right, Bottom); FillGradientRect(DC, R, dxOffice11ToolbarsColor1, dxOffice11ToolbarsColor2, False); RestoreClipRgn(DC, AClipRgn, AClipRgnExists); end; end; class procedure TdxBarItemControlOffice11Painter.BarDrawOwnerLink(ABarControl: TCustomdxBarControl; DC: HDC); var R: TRect; begin R := ABarControl.OwnerLinkBounds[False]; if not IsRectEmpty(R) then FillRect(DC, R, dxOffice11DropDownBorderBrush2); end; class function TdxBarItemControlOffice11Painter.BarHasShadow(ABarControl: TCustomdxBarControl): Boolean; begin if (ABarControl is TdxBarControl) and not (ABarControl is TdxBarQuickControl) then // TODO: !!! IsInternal ? Result := False else Result := inherited BarHasShadow(ABarControl); end; class function TdxBarItemControlOffice11Painter.BarToolbarBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin // TODO: ? Result := dxOffice11MenuBrush; end; class function TdxBarItemControlOffice11Painter.BarToolbarBrushEx(ABarControl: TdxBarControl): HBRUSH; begin // TODO if not (ABarControl.Bar.IsMainMenu or ABarControl.Bar.IsStatusBar) then Result := inherited BarToolbarBrushEx(ABarControl) else Result := GetSysColorBrush(COLOR_BTNFACE); end; class function TdxBarItemControlOffice11Painter.BarToolbarDownedBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin Result := dxOffice11DownedBrush; end; class function TdxBarItemControlOffice11Painter.BarToolbarDownedSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin Result := dxOffice11DownedSelectedBrush; end; class function TdxBarItemControlOffice11Painter.BarToolbarSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin Result := dxOffice11ToolbarSelectedBrush; end; class function TdxBarItemControlOffice11Painter.ComboBoxArrowWidth(ABarControl: TCustomdxBarControl; DC: HDC; cX: Integer): Integer; begin Result := 13; end; class function TdxBarItemControlOffice11Painter.BarBeforeFingersIndent: Integer; begin Result := 2; end; class procedure TdxBarItemControlOffice11Painter.BarBorderPaintSizes(ABarControl: TdxBarControl; var R: TRect); begin BarBorderSizes(ABarControl.Bar, ABarControl.DockingStyle, R); end; class procedure TdxBarItemControlOffice11Painter.BarBorderSizes(ABar: TdxBar; AStyle: TdxBarDockingStyle; var R: TRect); begin if ABar.IsMainMenu then // SetRectEmpty(R) begin if AStyle in [dsTop, dsBottom] then R := Rect(0, 2, 0, 2) else R := Rect(2, 0, 2, 0); end else inherited; end; class procedure TdxBarItemControlOffice11Painter.BarDrawBeginGroup(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH; AHorz: Boolean); begin ABarControl.FillBackground(DC, ItemRect, AToolbarBrush, clNone, True); with ItemRect do if AHorz then begin InflateRect(ItemRect, 0, -BarBeginGroupSideSize); FillRect(DC, Rect(Left + 3, Top, Right - 4, Top + 1), dxOffice11BarSeparatorBrush1); FillRect(DC, Rect(Left + 3 + 1, Top + 1, Right - 4 + 1, Top + 2), dxOffice11BarSeparatorBrush2); end else begin InflateRect(ItemRect, -BarBeginGroupSideSize, 0); FillRect(DC, Rect(Left, Top + 3, Left + 1, Bottom - 4), dxOffice11BarSeparatorBrush1); FillRect(DC, Rect(Left + 1, Top + 3 + 1, Left + 1 + 1, Bottom - 4 + 1), dxOffice11BarSeparatorBrush2); end; end; class procedure TdxBarItemControlOffice11Painter.BarDrawCaptionElement(ABarControl: TdxBarControl; DC: HDC; R: TRect; AState: TdxBarMarkState); var AColor: TColor; begin if AState <> msNone then begin Office11FrameSelectedRect(DC, R); InflateRect(R, -1, -1); if AState = msSelected then AColor := dxOffice11SelectedColor1 else AColor := dxOffice11SelectedColor2; FillRectByColor(DC, R, AColor); end else FillRectByColor(DC, R, ABarControl.CaptionBkColor); end; class procedure TdxBarItemControlOffice11Painter.BarDrawDockedBarBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); var B1: HBRUSH; AMarkColor1, AMarkColor2, AColor6, AColor9: TColor; procedure DrawFinger(ARect: TRect); begin // TODO: ! // if ABarControl.Bar.NotDocking = [Low(TdxBarDockingStyle)..High(TdxBarDockingStyle)] then Exit; InflateRect(ARect, -2, -2); with ARect do if ABarControl.Horizontal then begin Inc(Left, ABarControl.BarManager.BeforeFingersSize); Right := Left + ABarControl.PainterClass.GripperSize; InflateRect(ARect, 0, -3); end else begin Inc(Top, ABarControl.BarManager.BeforeFingersSize); Bottom := Top + ABarControl.PainterClass.GripperSize; InflateRect(ARect, -3, 0); end; BarDrawFingerElements(ABarControl, DC, ARect, ABarControl.Horizontal); end; procedure FillParentBackground(DC: HDC; const R: TRect); begin TdxBarItemControlPainter.BarDrawDockedBackground(ABarControl, DC, R, R, AToolbarBrush, clNone); end; procedure FillBackground(DC: HDC; const R: TRect); begin BarDrawDockedBackground(ABarControl, DC, R, R, AToolbarBrush, clNone); end; procedure DrawLeftBorder(var ARect: TRect); var ADockColor, AC11pxColor, AColor1, AColor2, AColor: TColor; R: TRect; begin GetDockColors(ABarControl.DockControl, AColor1, AColor2); with ARect do begin if ABarControl.Horizontal then begin FillParentBackground(DC, Rect(Left, Top, Left + BarBeforeFingersIndent, Bottom)); Inc(ARect.Left, BarBeforeFingersIndent); FillParentBackground(DC, Rect(Left, Top, Right, Top + 1)); Inc(ARect.Top); // only for Horizontal FillParentBackground(DC, Rect(Left, Bottom - 2, Left + 1, Bottom - 1)); FillParentBackground(DC, Rect(Left + 1, Bottom - 1, Left + 2, Bottom)); // left FillBackground(DC, Rect(Left, Top + 2, Left + 1, Bottom - 3)); // edge pixels SetPixel(DC, Left + 1, Bottom - 3, dxOffice11BarBorderColors[2]); // #3 = (Dock, #2, 50%) ADockColor := GetGradientColorRect(ABarControl.DockControl.ClientRect, ABarControl.PointBarToDock(Point(Left, Top)).X, AColor1, AColor2, True); AColor := GetMiddleRGB(ADockColor, dxOffice11BarBorderColors[2], 50); SetPixel(DC, Left, Bottom - 3, ColorToRGB(AColor)); SetPixel(DC, Left + 1, Bottom - 2, ColorToRGB(AColor)); // #4 = Dock, C1 + 1px ADockColor := GetGradientColorRect(ABarControl.DockControl.ClientRect, ABarControl.PointBarToDock(Point(Left, Top)).X, AColor1, AColor2, True); AC11pxColor := GetGradientColorRect(GetBarGradientRect(ABarControl), Top + 1, dxOffice11ToolbarsColor1, dxOffice11ToolbarsColor2, False); AColor := GetMiddleRGB(ADockColor, AC11pxColor, 50); SetPixel(DC, Left, Top + 1, AColor); SetPixel(DC, Left + 1, Top, AColor); end else begin FillParentBackground(DC, Rect(Left, Top, Right, Top + BarBeforeFingersIndent)); Inc(ARect.Top, BarBeforeFingersIndent); FillParentBackground(DC, Rect(Left, Top, Left + 1, Bottom)); Inc(ARect.Left); R := Rect(Left, Top + 2, Left + 1, Bottom - 2); if ABarControl.MarkExists then Dec(R.Bottom, MarkSizeX); FillBackground(DC, R); FillBackground(DC, Rect(Left + 2, Top, Right - 2, Top + 1)); // edge pixels SetPixel(DC, Right - 2, Top + 1, dxOffice11BarBorderColors[2]); // #3 = (Dock, #2, 50%) ADockColor := GetGradientColorRect(ABarControl.DockControl.ClientRect, ABarControl.PointBarToDock(Point(Left, Top)).X, AColor1, AColor2, True); AColor := GetMiddleRGB(ADockColor, dxOffice11BarBorderColors[2], 50); SetPixel(DC, Right - 2, Top, ColorToRGB(AColor)); SetPixel(DC, Right - 1, Top + 1, ColorToRGB(AColor)); // #4 = Dock, C1 + 1px ADockColor := GetGradientColorRect(ABarControl.DockControl.ClientRect, ABarControl.PointBarToDock(Point(Left, Top)).X, AColor1, AColor2, True); AC11pxColor := GetGradientColorRect(GetBarGradientRect(ABarControl), Left, dxOffice11ToolbarsColor1, dxOffice11ToolbarsColor2, True); AColor := GetMiddleRGB(ADockColor, AC11pxColor, 50); SetPixel(DC, Left, Top + 1, AColor); SetPixel(DC, Left + 1, Top, AColor); end; end; end; procedure DrawTopBorder(ARect: TRect); var ADockColor, AC11pxColor, AColor1, AColor2, AColor: TColor; R: TRect; begin GetDockColors(ABarControl.DockControl, AColor1, AColor2); with ARect do begin if ABarControl.Horizontal then begin R := Rect(Left + 2, Top, Right - 2, Top + 1); if ABarControl.MarkExists then Dec(R.Right, MarkSizeX); FillBackground(DC, R); ADockColor := GetGradientColorRect(ABarControl.DockControl.ClientRect, ABarControl.PointBarToDock(Point(Right, Top)).X, AColor1, AColor2, True); if ABarControl.MarkExists then begin // #6 SetPixel(DC, Right - MarkSizeX - 1, Top, AColor6); SetPixel(DC, Right - 2, Top + 1, AColor6); // #5 = #6, C1+1px AC11pxColor := GetGradientColorRect(GetBarGradientRect(ABarControl), Top + 1, dxOffice11ToolbarsColor1, dxOffice11ToolbarsColor2, False); AColor := GetMiddleRGB(AColor6, AC11pxColor, 50); SetPixel(DC, Right - MarkSizeX - 2, Top, AColor); // #7 = #6, Dock AColor := GetMiddleRGB(AColor6, ADockColor, 50); SetPixel(DC, Right - 2, Top, AColor); SetPixel(DC, Right - 1, Top + 1, AColor); end else begin // #5 = Dock, C1 + 1px AC11pxColor := GetGradientColorRect(GetBarGradientRect(ABarControl), Top + 1, dxOffice11ToolbarsColor1, dxOffice11ToolbarsColor2, False); AColor := GetMiddleRGB(ADockColor, AC11pxColor, 50); SetPixel(DC, Right - 2, Top, AColor); SetPixel(DC, Right - 1, Top + 1, AColor); end; end else begin ADockColor := GetGradientColorRect(ABarControl.DockControl.ClientRect, ABarControl.PointBarToDock(Point(Left, Bottom)).X, AColor1, AColor2, True); if ABarControl.MarkExists then begin // #5 = #6, C1+1px AC11pxColor := GetGradientColorRect(GetBarGradientRect(ABarControl), Left + 1, dxOffice11ToolbarsColor1, dxOffice11ToolbarsColor2, True); AColor := GetMiddleRGB(AColor6, AC11pxColor, 50); SetPixel(DC, Left, Bottom - MarkSizeX - 2, AColor); // #6 SetPixel(DC, Left, Bottom - MarkSizeX - 1, AColor6); SetPixel(DC, Left + 1, Bottom - 2, AColor6); // #7 = #6, Dock AColor := GetMiddleRGB(AColor6, ADockColor, 50); SetPixel(DC, Left, Bottom - 2, AColor); SetPixel(DC, Left + 1, Bottom - 1, AColor); end else begin // #5 = Dock, C1 + 1px AC11pxColor := GetGradientColorRect(GetBarGradientRect(ABarControl), Left + 1, dxOffice11ToolbarsColor1, dxOffice11ToolbarsColor2, True); AColor := GetMiddleRGB(ADockColor, AC11pxColor, 50); SetPixel(DC, Left, Bottom - 2, AColor); SetPixel(DC, Left + 1, Bottom - 1, AColor); end; end; end; end; procedure DrawRightBorder(ARect: TRect); var R: TRect; AClipRgn: HRGN; AClipRgnExists: Boolean; ADockColor, AColor1, AColor2, AColor: TColor; begin with ARect do begin if ABarControl.Horizontal then begin if not ABarControl.MarkExists then begin R := Rect(Right - 2, Top + 1, Right - 1, Bottom - 2); FillBackground(DC, R); end; end else begin R := Rect(Right - 2, Top + 2, Right - 1, Bottom - 2); if ABarControl.MarkExists then Dec(R.Bottom, MarkSizeX); FillBackground(DC, R); end; if ABarControl.MarkExists then begin SaveClipRgn(DC, AClipRgn, AClipRgnExists); if ABarControl.Horizontal then begin IntersectClipRect(DC, Right - MarkSizeX - 2 + 2, Top, Right - 2, Top + 1); AddClipRect(DC, Rect(Right - 2, Top + 2, Right, Bottom - 2)); AddClipRect(DC, Rect(Right - MarkSizeX - 1, Bottom - 1, Right - 2, Bottom)); AddClipRect(DC, Rect(Right - MarkSizeX, Bottom - 2, Right - 1, Bottom - 1)); R := Rect(Right - MarkSizeX - 1, Top, Right, Bottom); end else begin IntersectClipRect(DC, Left, Bottom - MarkSizeX, Left + 1, Bottom - 2); AddClipRect(DC, Rect(Left + 2, Bottom - 2, Right - 2, Bottom)); AddClipRect(DC, Rect(Right - 2, Bottom - MarkSizeX, Right - 1, Bottom - 1)); AddClipRect(DC, Rect(Right - 1, Bottom - MarkSizeX - 1, Right, Bottom - 2)); R := Rect(Left, Bottom - MarkSizeX - 1, Right, Bottom); end; FillTubeGradientRect(DC, R, AMarkColor1, AMarkColor2, not ABarControl.Horizontal); RestoreClipRgn(DC, AClipRgn, AClipRgnExists); // #8 = B, Dock GetDockColors(ABarControl.DockControl, AColor1, AColor2); ADockColor := GetGradientColorRect(ABarControl.DockControl.ClientRect, ABarControl.PointBarToDock(Point(Right, Bottom)).X, AColor1, AColor2, True); AColor := GetMiddleRGB(AMarkColor2, ADockColor, 50); SetPixel(DC, Right - 1, Bottom - 2, AColor); SetPixel(DC, Right - 2, Bottom - 1, AColor); end else begin if ABarControl.Horizontal then FillBackground(DC, Rect(Right - 1, Top + 2, Right, Bottom - 1)) else FillBackground(DC, Rect(Left + 2, Bottom - 1, Right - 1, Bottom)); end; end; end; procedure DrawBottomBorder(ARect: TRect); var ADockColor, AColor1, AColor2, AColor: TColor; R: TRect; begin with ARect do begin if ABarControl.Horizontal then begin R := Rect(Left + 2, Bottom - 2, Right - 2, Bottom - 1); if ABarControl.MarkExists then Dec(R.Right, MarkSizeX); FillBackground(DC, R); end else begin if not ABarControl.MarkExists then begin R := Rect(Left + 1, Bottom - 2, Right - 2, Bottom - 1); FillBackground(DC, R); end; end; if ABarControl.MarkExists then begin // #9 = B, #2 AColor := GetMiddleRGB(AMarkColor2, dxOffice11BarBorderColors[2], 50); if ABarControl.Horizontal then begin SetPixel(DC, Right - 2 - MarkSizeX, Bottom - 1, AColor); SetPixel(DC, Right - 1 - MarkSizeX, Bottom - 2, AColor); SetPixel(DC, Right - 2 - MarkSizeX, Bottom - 2, dxOffice11BarBorderColors[2]); FillRect(DC, Rect(Left + 2, Bottom - 1, Right - 2 - MarkSizeX, Bottom), B1); end else begin SetPixel(DC, Right - 2, Bottom - 1 - MarkSizeX, AColor); SetPixel(DC, Right - 1, Bottom - 2 - MarkSizeX, AColor); SetPixel(DC, Right - 2, Bottom - 2 - MarkSizeX, dxOffice11BarBorderColors[2]); FillRect(DC, Rect(Right - 1, Top + 2, Right, Bottom - MarkSizeX - 2), B1); end; end else begin // #9 = Dock, #2 GetDockColors(ABarControl.DockControl, AColor1, AColor2); ADockColor := GetGradientColorRect(ABarControl.DockControl.ClientRect, ABarControl.PointBarToDock(Point(Right, Bottom)).X, AColor1, AColor2, True); AColor := GetMiddleRGB(dxOffice11BarBorderColors[2], ADockColor, 50); SetPixel(DC, Right - 2, Bottom - 1, AColor); SetPixel(DC, Right - 1, Bottom - 2, AColor); SetPixel(DC, Right - 2, Bottom - 2, dxOffice11BarBorderColors[2]); if ABarControl.Horizontal then FillRect(DC, Rect(Left + 2, Bottom - 1, Right - 2, Bottom), B1) else FillRect(DC, Rect(Right - 1, Top + 2, Right, Bottom - 2), B1); end; end; end; procedure DrawBorder(ARect: TRect); begin DrawLeftBorder(ARect); DrawTopBorder(ARect); DrawRightBorder(ARect); DrawBottomBorder(ARect); with ARect do begin FillParentBackground(DC, Rect(Left, Top, Left + 1, Top + 1)); FillParentBackground(DC, Rect(Right - 1, Top, Right, Top + 1)); FillParentBackground(DC, Rect(Left, Bottom - 1, Left + 1, Bottom)); FillParentBackground(DC, Rect(Right - 1, Bottom - 1, Right, Bottom)); end; end; procedure DrawMainMenuBorder(ARect: TRect); begin with ARect do if ABarControl.Horizontal then begin FillParentBackground(DC, Rect(Left, Top, Right, Top + 2)); FillParentBackground(DC, Rect(Left, Bottom - 2, Right, Bottom)); end else begin FillParentBackground(DC, Rect(Left, Top, Left + 2, Bottom)); FillParentBackground(DC, Rect(Right - 2, Top, Right, Bottom)); end; end; begin B1 := CreateSolidBrush(dxOffice11BarBorderColors[1]); GetMarkColors(ABarControl, AMarkColor1, AMarkColor2, AColor6, AColor9); if ABarControl.Bar.IsMainMenu then DrawMainMenuBorder(R) else if ABarControl.Bar.BorderStyle = bbsSingle then DrawBorder(R); if ABarControl.Bar.CanMoving then DrawFinger(R); DeleteObject(B1); end; class procedure TdxBarItemControlOffice11Painter.BarDrawFloatingBarBorder(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); var I: Integer; B1, B2: HBRUSH; begin if not ABarControl.IsInternal then begin B1 := CreateSolidBrush(dxOffice11BarFloatingBorderColor1); B2 := CreateSolidBrush(dxOffice11BarFloatingBorderColor2); FrameRect(DC, R, B1); InflateRect(R, -1, -1); FrameRect(DC, R, B1); InflateRect(R, -1, -1); FrameRect(DC, R, B2); with R do begin FillRect(DC, Rect(Left, Top, Left + 1, Top + 1), B1); FillRect(DC, Rect(Right - 1, Top, Right, Top + 1), B1); FillRect(DC, Rect(Right - 1, Bottom - 1, Right, Bottom), B1); FillRect(DC, Rect(Left, Bottom - 1, Left + 1, Bottom), B1); end; DeleteObject(B2); DeleteObject(B1); end else begin FrameRect(DC, R, dxOffice11DropDownBorderBrush1); for I := R.Left + 1 to CR.Left - 1 do begin InflateRect(R, -1, -1); FrameRect(DC, R, AToolbarBrush); end; end; end; class procedure TdxBarItemControlOffice11Painter.BarDrawFloatingBarCaption(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); begin AToolbarBrush := CreateSolidBrush(dxOffice11BarFloatingBorderColor3); TdxBarItemControlFlatPainter.BarDrawFloatingBarCaption(ABarControl, DC, R, CR, AToolbarBrush); DeleteObject(AToolbarBrush); end; class procedure TdxBarItemControlOffice11Painter.BarDrawStatusBarGrip(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); begin if not ABarControl.BarManager.FThemeAvailable then inherited else TdxBarItemControlXPPainter.BarDrawStatusBarGrip(ABarControl, DC, R, AToolbarBrush); end; class procedure TdxBarItemControlOffice11Painter.BarDrawStatusBarTopBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); begin if not ABarControl.BarManager.FThemeAvailable then inherited else TdxBarItemControlXPPainter.BarDrawStatusBarTopBorder(ABarControl, DC, R, AToolbarBrush); end; class function TdxBarItemControlOffice11Painter.BarMarkRect(ABarControl: TdxBarControl): TRect; begin Result := inherited BarMarkRect(ABarControl); if not IsSimpleMark(ABarControl) then case ABarControl.DockingStyle of dsTop, dsBottom: begin Dec(Result.Top, 1); Inc(Result.Right, 2); Inc(Result.Bottom, 1); end; dsLeft, dsRight: begin Dec(Result.Left, 1); Inc(Result.Right, 1); Inc(Result.Bottom, 2); end; end; end; class procedure TdxBarItemControlOffice11Painter.BarMarkRectInvalidate(ABarControl: TdxBarControl); begin inherited; if ABarControl.DockingStyle <> dsNone then SendMessage(ABarControl.Handle, WM_NCPAINT, 0, 0); end; class procedure TdxBarItemControlOffice11Painter.StatusBarFillBackground(ABarControl: TdxBarControl; DC: HDC; ADestR, ASourceR, AWholeR: TRect; ABrush: HBRUSH; AColor: TColor); begin if not ABarControl.BarManager.FThemeAvailable then inherited else TdxBarItemControlXPPainter.StatusBarFillBackground(ABarControl, DC, ADestR, ASourceR, AWholeR, ABrush, AColor); end; class function TdxBarItemControlOffice11Painter.StatusBarGripSize(ABarManager: TdxBarManager): TSize; begin if not ABarManager.FThemeAvailable then Result := inherited StatusBarGripSize(ABarManager) else Result := TdxBarItemControlXPPainter.StatusBarGripSize(ABarManager); end; class function TdxBarItemControlOffice11Painter.StatusBarTopBorderSize(ABarManager: TdxBarManager): Integer; begin if not ABarManager.FThemeAvailable then Result := inherited StatusBarTopBorderSize(ABarManager) else Result := TdxBarItemControlXPPainter.StatusBarTopBorderSize(ABarManager); end; class function TdxBarItemControlOffice11Painter.IsSingleMenuBorder(ABarSubMenuControl: TdxBarSubMenuControl): Boolean; begin Result := not ABarSubMenuControl.GetBackgroundBitmap.Empty or (ABarSubMenuControl.BarSize <> 0); end; class procedure TdxBarItemControlOffice11Painter.SubMenuControlCalcDrawingConsts(ABarSubMenuControl: TdxBarSubMenuControl; var ATextSize, AMenuArrowWidth, AMarkSize, ANormalItemHeight: Integer); begin inherited; AMarkSize := dxOffice11SubMenuExpandBitmap.Height + 2; end; class procedure TdxBarItemControlOffice11Painter.SubMenuControlDrawBackground(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; ARect: TRect; ABrush: HBRUSH; AColor: TColor); var W1: Integer; W2: Integer; AColor1, AColor2: TColor; AClipRgn: HRGN; AClipRgnExists: Boolean; begin if not ABarSubMenuControl.GetBackgroundBitmap.Empty then inherited else begin W1 := ABarSubMenuControl.GetIndent1; W2 := ABarSubMenuControl.GetIndent2; SaveClipRgn(DC, AClipRgn, AClipRgnExists); with ARect do begin IntersectClipRect(DC, Left, Top, Right, Bottom); // fill if ABarSubMenuControl.FNonRecent then begin AColor1 := dxOffice11MenuNonRecentIndentColor1; AColor2 := dxOffice11MenuNonRecentIndentColor2; end else begin AColor1 := dxOffice11MenuIndentColor1; AColor2 := dxOffice11MenuIndentColor2; end; FillTubeGradientRect(DC, Rect(0, Top, W1, Bottom), AColor1, AColor2, True); if W2 <> 0 then FillRectByColor(DC, Rect(W1, Top, W1 + W2, Bottom), AColor2); if Right > (W1 + W2) then FillRect(DC, Rect(W1 + W2, Top, Right, Bottom), ABrush); end; RestoreClipRgn(DC, AClipRgn, AClipRgnExists); end; end; class procedure TdxBarItemControlOffice11Painter.SubMenuControlDrawClientBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; var R: TRect; ABrush: HBRUSH); begin if IsSingleMenuBorder(ABarSubMenuControl) then FrameRect(DC, R, dxOffice11MenuBrush) else with R do begin FillRect(DC, Rect(Left, Top, Right, Top + 1), dxOffice11MenuBrush); FillRect(DC, Rect(Right - 1, Top, Right, Bottom), dxOffice11MenuBrush); FillRect(DC, Rect(Left, Bottom - 1, Right, Bottom), dxOffice11MenuBrush); // Indent FillRectByColor(DC, Rect(Left, Top + 1, Left + 1, Bottom - 1), dxOffice11MenuIndentColor1); end; end; class function TdxBarItemControlOffice11Painter.SubMenuControlDetachCaptionAreaSize(ABarSubMenuControl: TdxBarSubMenuControl): Integer; begin Result := ABarSubMenuControl.DetachCaptionSize + 5; end; class procedure TdxBarItemControlOffice11Painter.SubMenuControlDrawBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); procedure DrawFlatBorder; var ARect: TRect; begin FrameRect(DC, R, dxOffice11DropDownBorderBrush1); ARect := ABarSubMenuControl.OwnerLinkBounds[False]; if not IsRectEmpty(ARect) then FillRect(DC, ARect, dxOffice11MenuBrush); end; begin with R do begin DrawFlatBorder; if ABarSubMenuControl.Detachable then begin InflateRect(R, -1, -1); Bottom := Top + ABarSubMenuControl.DetachCaptionSize + 3 + 2; FrameRect(DC, R, dxOffice11MenuBrush); InflateRect(R, 0, -1); FillRect(DC, Rect(Left, Top, Right, Top + 2), dxOffice11MenuBrush); FillRect(DC, Rect(Left, Bottom - 1, Right, Bottom), dxOffice11MenuBrush); SubMenuControlDrawDetachCaption(ABarSubMenuControl, DC, ABarSubMenuControl.DetachCaptionRect); end; end end; class procedure TdxBarItemControlOffice11Painter.SubMenuControlDrawDetachCaption(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); var ABrush: HBRUSH; DXY: Integer; begin if ABarSubMenuControl.DetachCaptionSelected then begin Office11FrameSelectedRect(DC, R); InflateRect(R, -1, -1); ABrush := dxOffice11DetachableSelectedBrush; DXY := 0; end else begin ABrush := dxOffice11DetachableBrush; DXY := 1; end; FillRect(DC, R, ABrush); // draw marks InflateRect(R, -(((R.Right - R.Left + DXY * 2) div 4)), -(DXY + 1)); BarDrawFingerElements(ABarSubMenuControl, DC, R, False); end; class function TdxBarItemControlOffice11Painter.SubMenuControlGroupSeparatorBrush(ABarSubMenuControl: TdxBarSubMenuControl): HBRUSH; begin Result := dxOffice11BarSeparatorBrush1; end; class procedure TdxBarItemControlOffice11Painter.SubMenuControlOffsetDetachCaptionRect(ABarSubMenuControl: TdxBarSubMenuControl; var R: TRect); begin InflateRect(R, -2, -4); end; class function TdxBarItemControlOffice11Painter.SubMenuControlToolbarItemsBrush(ABarSubMenuControl: TdxBarSubMenuControl): HBRUSH; begin Result := dxOffice11MenuBrush; end; class procedure TdxBarItemControlOffice11Painter.DropDownListBoxDrawBorder(ABarManager: TdxBarManager; DC: HDC; R: TRect); begin FrameRect(DC, R, dxOffice11DropDownBorderBrush1); InflateRect(R, -1, -1); FrameRect(DC, R, dxOffice11DropDownBorderBrush2); end; class function TdxBarItemControlOffice11Painter.BarToolbarBrushEx2(ABarControl: TdxBarControl): HBRUSH; begin Result := dxOffice11MenuBrush; end; class procedure TdxBarItemControlOffice11Painter.DrawQuickCustItemFrame(ABarItemControl: TdxBarItemControl; DC: HDC; var R, ARect: TRect; Selected: Boolean); begin with R do begin if not Selected then DrawBackgroundFrameRect(ABarItemControl, DC, Rect(Left, Top, Left + (Bottom - Top), Bottom), BarToolbarBrush(ABarItemControl.Parent), False); InflateRect(R, -1, -1); // inherited? Right := Left + Bottom - Top; end; ARect.Left := R.Right + 1; end; class procedure TdxBarItemControlOffice11Painter.DrawQuickCustItemFrameSelected(ABarItemControl: TdxBarItemControl; DC: HDC; WholeR, R: TRect; Selected: Boolean); begin if Selected then begin Office11FrameSelectedRect(DC, WholeR); with R do begin Left := Right; Right := Left + 2; // paint over! end; FillRect(DC, R, ABarItemControl.Parent.ToolbarSelBrush); end; end; class function TdxBarItemControlOffice11Painter.EditControlCaptionWidth(ABarEditControl: TdxBarEditControl; ATextWidth: Integer): Integer; begin Result := inherited EditControlCaptionWidth(ABarEditControl, ATextWidth); if ABarEditControl.Parent is TdxBarSubMenuControl then Result := Result + TdxBarSubMenuControl(ABarEditControl.Parent).GetIndent1 + 1; end; class procedure TdxBarItemControlOffice11Painter.EditControlDrawBorder(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); begin if Selected then Office11FrameSelectedRect(DC, ARect) else if not ABarEditControl.Enabled then FrameRectByColor(DC, ARect, dxOffice11TextDisabledColor) else if PaintType = ptMenu then FrameRect(DC, ARect, dxOffice11OwnerControlDownedBrush) else DrawBackgroundFrameRect(ABarEditControl, DC, ARect, ABarEditControl.Parent.BkBrush, False); InflateRect(ARect, -1, -1); end; class procedure TdxBarItemControlOffice11Painter.EditControlDrawCaption(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); var S: string; Size: TSize; R: TRect; Brush: HBRUSH; begin // TODO S := GetTextOf(ABarEditControl.Caption); GetTextExtentPoint32(DC, PChar(S), Length(S), Size); R := ARect; R.Right := R.Left + EditControlCaptionWidth(ABarEditControl, Size.cX); ARect.Left := R.Right; if Selected and (PaintType = ptMenu) then begin Inc(R.Right); Office11FrameSelectedRect(DC, R); InflateRect(R, -1, -1); end; if Selected and (PaintType = ptMenu) then Brush := ABarEditControl.Parent.ToolbarSelBrush else Brush := ABarEditControl.Parent.BkBrush; DrawBackground(ABarEditControl, DC, R, Brush, (PaintType = ptMenu) and Selected); Dec(R.Right, 5); DrawItemText(ABarEditControl, DC, ABarEditControl.Caption, R, DT_RIGHT, ABarEditControl.Enabled, Selected and (PaintType = ptMenu), False, False, not IsHighContrastWhite); end; class procedure TdxBarItemControlOffice11Painter.DrawButtonControlArrow(ABarItemControl: TdxBarItemControl; DC: HDC; R1: TRect; Brush: HBRUSH; ArrowColor: COLORREF; Selected, DrawDowned, DroppedDown, DropDownEnabled, IsDropDownMenuControlExist: Boolean; PaintType: TdxBarPaintType); begin if PaintType <> ptMenu then Dec(R1.Left); if (PaintType = ptMenu) or not (DroppedDown and IsDropDownMenuControlExist) then begin if (PaintType = ptMenu) or Selected then if Selected then Office11FrameSelectedRect(DC, R1) else FrameRect(DC, R1, dxOffice11BarSeparatorBrush1) else DrawBackgroundFrameRect(ABarItemControl, DC, R1, Brush, False); InflateRect(R1, -1, -1); DrawBackground(ABarItemControl, DC, R1, Brush, DroppedDown or DrawDowned or Selected or ABarItemControl.FNonRecent); InflateRect(R1, 1, 1); end; if PaintType = ptMenu then DrawLargeItemArrow(DC, R1, atRight, ABarItemControl.Parent.MenuArrowHeight, (IsHighContrastWhite and Selected) or DroppedDown, ABarItemControl.Enabled and DropDownEnabled, True{Flat}) else DrawItemArrow(DC, R1, atDown, ABarItemControl.Enabled and DropDownEnabled, Selected and not DroppedDown and IsHighContrastWhite, True{Flat}); end; class procedure TdxBarItemControlOffice11Painter.ComboControlDrawArrow(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; Selected: Boolean; PaintType: TdxBarPaintType); const Borders: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER); var Brush, SpaceBrush: HBRUSH; ArrowColor: COLORREF; X, Y, Size: Integer; AColor1, AColor2: TColor; begin with ARect do begin Left := Right - ABarComboControl.Parent.ComboBoxArrowWidth; ABarComboControl.FDropDownButtonRect := ARect; ComboControlGetArrowParams(ABarComboControl, PaintType, ABarComboControl.Enabled, Selected, ABarComboControl.DroppedDown, Brush, ArrowColor); if Selected then begin InflateRect(ARect, 1, 1); Office11FrameSelectedRect(DC, ARect); InflateRect(ARect, -1, -1); GetSelectedColors(ABarComboControl, ABarComboControl.DroppedDown, Selected, AColor1, AColor2); FillGradientRect(DC, ARect, AColor1, AColor2, False); end else begin if ABarComboControl.Enabled then SpaceBrush := GetSysColorBrush(COLOR_WINDOW) else SpaceBrush := Brush; FrameRect(DC, ARect, SpaceBrush); FillRect(DC, Rect(Left - 1, Top, Left, Bottom), SpaceBrush); InflateRect(ARect, -1, -1); if (PaintType = ptMenu) and ABarComboControl.Enabled then FillRect(DC, ARect, dxOffice11OwnerControlDownedBrush) else DrawBackground(ABarComboControl, DC, ARect, Brush, not ABarComboControl.Enabled); if ABarComboControl.DroppedDown then OffsetRect(ARect, 1, 1); end; if Selected then InflateRect(ARect, -1, -1); with ARect do begin Size := (Right - Left) div 2; if not Odd(Size) then Inc(Size); X := (Left + Right - Size) div 2; Y := (Top + Bottom - Size div 2) div 2; ComboControlDrawOneArrow(ABarComboControl, DC, X, Y, Size, ArrowColor); end; end; end; class procedure TdxBarItemControlOffice11Painter.ComboControlGetArrowParams(ABarItemControl: TdxBarItemControl; APaintType: TdxBarPaintType; AEnabled, ASelected, ADroppedDown: Boolean; var ABrush: HBRUSH; var AArrowColor: COLORREF); begin GetArrowParams(ABarItemControl, APaintType, AEnabled, ASelected, ADroppedDown, ABrush, AArrowColor); if AEnabled then begin if ASelected then ABrush := ABarItemControl.Parent.ToolbarSelBrush else if ADroppedDown then ABrush := ABarItemControl.Parent.ToolbarDownedSelBrush; end; end; class function TdxBarItemControlOffice11Painter.ProgressControlIndent(ABarItemControl: TdxBarItemControl): Integer; begin Result := 0; if not ABarItemControl.ImageExists then begin if ABarItemControl.Parent is TdxBarSubMenuControl then Inc(Result, TdxBarSubMenuControl(ABarItemControl.Parent).GetIndent1); end; end; class procedure TdxBarItemControlOffice11Painter.DateNavigatorDrawButton(ABarItem: TdxBarItem; DC: HDC; R: TRect; const ACaption: string; APressed: Boolean); begin if not ABarItem.BarManager.FThemeAvailable then inherited else TdxBarItemControlXPPainter.DateNavigatorDrawButton(ABarItem, DC, R, ACaption, APressed); end; class function TdxBarItemControlOffice11Painter.DateNavigatorHeaderColor: TColor; begin Result := dxOffice11DateHeaderColor; end; class function TdxBarItemControlOffice11Painter.InPlaceSubItemControlBrush: HBRUSH; begin Result := dxOffice11InPlaceSubItemBrush; end; class procedure TdxBarItemControlOffice11Painter.DrawGlyphBorder(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, BarControlOwner, IsSplit: Boolean); var AOpaque, AVertical: Boolean; AColor1, AColor2: TColor; begin if (PaintType = ptMenu) and Selected and IsGlyphEmpty and not Down then FillRect(DC, R, ABrush) else begin AOpaque := Selected or Down or DrawDowned; AVertical := IsRealVertical(ABarItemControl.Parent); if Down and IsMenuGradient(ABarItemControl) then FillGradientRect(DC, R, dxOffice11MenuDownedColor1, dxOffice11MenuDownedColor2, AVertical) else begin if (PaintType <> ptMenu) and (Selected or Down or DrawDowned) then begin GetSelectedColors(ABarItemControl, Down or DrawDowned, Selected, AColor1, AColor2); FillGradientRect(DC, R, AColor1, AColor2, AVertical); end else DrawBackground(ABarItemControl, DC, R, ABrush, AOpaque); end; if Down or (Selected and (PaintType <> ptMenu)) then begin if Down and BarControlOwner then BarDrawBarControlOwnerBorder(ABarItemControl.Parent, DC, R, ABarItemControl, ABarItemControl.OwnedBarControl) else if Selected or (Down and (ABarItemControl is TdxBarButtonControl) and TdxBarButtonControl(ABarItemControl).Down) then Office11FrameSelectedRect(DC, R) else FrameRect(DC, R, dxOffice11DropDownBorderBrush1); end else if NeedBorder then DrawBackgroundFrameRect(ABarItemControl, DC, R, ABrush, AOpaque); end; end; class procedure TdxBarItemControlOffice11Painter.DrawGlyphImage(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; const GlyphRect: TRect; AGlyph: TBitmap; AImages: TCurImageList; AImageIndex: Integer; Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean; PaintType: TdxBarPaintType); begin if NeedBorder then InflateRect(R, -1, -1); TransparentDraw(DC, ABrush, R, GlyphRect, AGlyph, AImages, AImageIndex, ABarItemControl.GetImageEnabled(PaintType), GrayScale, False{Flat}, Selected, Down, DrawDowned, False{Shadow}, True{Transparent}, GetFadedColor(ABarItemControl.Parent){Faded}, ABarItemControl.Item.BarManager.ImageListBkColor); if NeedBorder then InflateRect(R, 1, 1); end; class procedure TdxBarItemControlOffice11Painter.DrawItemArrow(DC: HDC; R: TRect; ArrowType: TdxArrowType; Enabled, Selected, Flat: Boolean); begin Office11DrawItemArrow(DC, R, ArrowType = atDown, Enabled, Selected, Flat); end; class procedure TdxBarItemControlOffice11Painter.DrawLargeItemArrow(DC: HDC; R: TRect; ArrowType: TdxArrowType; Size: Integer; Selected, Enabled, Flat: Boolean); begin Office11DrawLargeItemArrow(DC, R, ArrowType = atDown, Size, Selected, Enabled, Flat); end; class procedure TdxBarItemControlOffice11Painter.FrameFlatSelRect(DC: HDC; const R: TRect); begin Office11FrameSelectedRect(DC, R); end; class function TdxBarItemControlOffice11Painter.GetBarGradientRect(ABarControl: TCustomdxBarControl): TRect; begin Result := Rect(0, 0, ABarControl.Width, ABarControl.Height); if ABarControl is TdxBarControl then begin if TdxBarControl(ABarControl).Horizontal then InflateRect(Result, 0, -1) else InflateRect(Result, -1, 0); end; end; class procedure TdxBarItemControlOffice11Painter.GetDockColors(ADockControl: TdxDockControl; var AColor1, AColor2: TColor); begin AColor1 := dxOffice11DockColor1; AColor2 := dxOffice11DockColor2; if ADockControl.Align = alLeft then AColor2 := AColor1 else if ADockControl.Align = alRight then AColor1 := AColor2; end; class procedure TdxBarItemControlOffice11Painter.GetMarkColors(ABarControl: TdxBarControl; var AMarkColor1, AMarkColor2, AColor6, AColor9: TColor); var I: Integer; begin I := Integer(ABarControl.MarkState) + 1; AMarkColor1 := dxOffice11BarMarkColors1[I]; AMarkColor2 := dxOffice11BarMarkColors2[I]; AColor6 := dxOffice11BarBorderMarkColors[1, I]; AColor9 := dxOffice11BarBorderMarkColors[2, I]; end; class procedure TdxBarItemControlOffice11Painter.GetSelectedColors(ABarItemControl: TdxBarItemControl; ADown, ASelected: Boolean; var AColor1, AColor2: TColor); begin if ABarItemControl.Parent.IsInternal then begin if ADown then AColor1 := dxOffice11OwnerControlDownedColor else AColor1 := dxOffice11SelectedColor1; AColor2 := AColor1; end else begin if ADown then begin if not ASelected then begin AColor1 := dxOffice11SelectedDownColor1; AColor2 := dxOffice11SelectedDownColor2; if AColor1 = AColor2 then begin AColor1 := dxOffice11DownedColor; //dxOffice11SelectedColor1; AColor2 := AColor1; end; end else begin AColor1 := dxOffice11SelectedDownColor2; AColor2 := dxOffice11SelectedDownColor1; end; end else begin AColor1 := dxOffice11SelectedColor1; AColor2 := dxOffice11SelectedColor2; end; end; end; class procedure TdxBarItemControlOffice11Painter.GetEditColors(ABarItemControl: TdxBarItemControl; var ATextColor, ABkColor: COLORREF); begin if ABarItemControl.Enabled then begin ATextColor := dxOffice11TextEnabledColor; ABkColor := GetSysColor(COLOR_WINDOW); end else begin ATextColor := dxOffice11TextDisabledColor; ABkColor := GetSysColor(COLOR_BTNFACE); end; end; class function TdxBarItemControlOffice11Painter.GetFadedColor(ABarControl: TCustomdxBarControl): TColor; begin Result := dxOffice11BarMarkColors1[1]; end; class procedure TdxBarItemControlOffice11Painter.GetTextColors(ABarItemControl: TdxBarItemControl; AEnabled, ASelected, AFlat: Boolean; var AColor1, AColor2: TColor); begin if AEnabled then begin if (ABarItemControl.IsInvertTextColor or True) and ASelected and not AFlat then begin AColor1 := dxOffice11InPlaceSubItemTextColor; // GetSysColor(COLOR_HIGHLIGHTTEXT) if IsHighContrastWhite then AColor1 := clWhite; end else AColor1 := dxOffice11TextEnabledColor; end else AColor1 := dxOffice11TextDisabledColor; AColor2 := AColor1; end; class function TdxBarItemControlOffice11Painter.IgnoreNonRecentColor: Boolean; begin Result := True; end; class function TdxBarItemControlOffice11Painter.IsMenuGradient(ABarItemControl: TdxBarItemControl): Boolean; begin Result := not ABarItemControl.Parent.IsInternal and ((ABarItemControl is TdxBarSubItemControl) or ((ABarItemControl is TdxBarButtonControl) and TdxBarButtonControl(ABarItemControl).DroppedDownFlat)); end; class function TdxBarItemControlOffice11Painter.IsSimpleMark(ABarControl: TdxBarControl): Boolean; begin Result := (ABarControl.Bar.BorderStyle = bbsNone) or ABarControl.Bar.IsMainMenu; end; class function TdxBarItemControlOffice11Painter.BarCaptionBkColor(ABarControl: TdxBarControl; AMainFormActive: Boolean): COLORREF; begin Result := dxOffice11BarFloatingCaptionColor; end; class function TdxBarItemControlOffice11Painter.BarCaptionColor(ABarControl: TdxBarControl): COLORREF; begin Result := dxOffice11BarFloatingCaptionTextColor1; end; class function TdxBarItemControlOffice11Painter.BarMarkArrowColor(ABarControl: TdxBarControl; AState: TdxBarMarkState): COLORREF; begin case AState of msSelected: Result := dxOffice11BarFloatingCaptionTextColor2; msPressed: Result := dxOffice11BarFloatingCaptionTextColor3; else // msNone Result := dxOffice11BarFloatingCaptionTextColor1; end; end; class procedure TdxBarItemControlOffice11Painter.BarDrawFingerElements(ABarControl: TCustomdxBarControl; DC: HDC; ARect: TRect; AHorizontal: Boolean); begin Office11DrawFingerElements(DC, ARect, AHorizontal); end; class procedure TdxBarItemControlOffice11Painter.BarDrawMarkBackground(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); var R1, R2, R3: TRect; C1, C2, AColor6, C4: TColor; AC11pxColor, AColor: TColor; begin // TODO: states and colors GetMarkColors(ABarControl, C1, C2, AColor6, C4); if (ABarControl.Bar.BorderStyle = bbsNone) or ABarControl.Bar.IsMainMenu then begin R2 := ItemRect; { if ABarControl.Bar.IsMainMenu then begin InflateRect(R2, 0, -1); with R2 do begin ABarControl.FillBackground(DC, Rect(Left, Top - 1, Right, Top), AToolbarBrush, clNone, True); ABarControl.FillBackground(DC, Rect(Left, Bottom, Right, Bottom + 1), AToolbarBrush, clNone, True); end; end;} end else begin R1 := ItemRect; R2 := ItemRect; if ABarControl.Horizontal then begin R1.Right := R1.Left + 2; Inc(R2.Left, 2); InflateRect(R2, 0, 2); with R1 do R3 := Rect(Right - 1, Top, Right, Top + 1); AC11pxColor := GetGradientColorRect(GetBarGradientRect(ABarControl), R3.Top + 2, dxOffice11ToolbarsColor1, dxOffice11ToolbarsColor2, False); end else begin R1.Bottom := R1.Top + 2; Inc(R2.Top, 2); InflateRect(R2, 2, 0); with R1 do R3 := Rect(Left, Bottom - 1, Left + 1, Bottom); AC11pxColor := GetGradientColorRect(GetBarGradientRect(ABarControl), R3.Left + 2, dxOffice11ToolbarsColor1, dxOffice11ToolbarsColor2, True); end; ABarControl.FillBackground(DC, R1, AToolbarBrush, clNone, True); AColor := GetMiddleRGB(AColor6, AC11pxColor, 50); SetPixel(DC, R3.Left, R3.Top, AColor); end; FillTubeGradientRect(DC, R2, C1, C2, not ABarControl.Horizontal); end; class procedure TdxBarItemControlOffice11Painter.BarDrawMarkElements(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect); procedure DrawArrow(X, Y: Integer; AVertical: Boolean; AColor: COLORREF); const YOffset = 3; var P: array[1..3] of TPoint; APrevPen: HPEN; APrevBrush, ABrush: HBRUSH; begin ABrush := CreateSolidBrush(AColor); if AVertical then begin FillRect(DC, Rect(X, Y, X + 1, Y + 5), ABrush); P[1] := Point(X + YOffset, Y); P[2] := Point(X + YOffset, Y + 4); P[3] := Point(X + YOffset + 2, Y + 2); end else begin FillRect(DC, Rect(X, Y, X + 5, Y + 1), ABrush); P[1] := Point(X, Y + YOffset); P[2] := Point(X + 4, Y + YOffset); P[3] := Point(X + 2, Y + 2 + YOffset); end; APrevPen := SelectObject(DC, CreatePen(PS_SOLID, 1, AColor)); APrevBrush := SelectObject(DC, ABrush); Polygon(DC, P, 3); SelectObject(DC, APrevBrush); DeleteObject(SelectObject(DC, APrevPen)); DeleteObject(ABrush); end; procedure DrawArrows(X, Y: Integer; Vertical: Boolean); begin DrawArrow(X + 1, Y + 1, Vertical, dxOffice11BarMarkArrowColor2); DrawArrow(X, Y, Vertical, dxOffice11BarMarkArrowColor1); end; procedure DrawMark(X, Y: Integer; AVertical: Boolean; AColor: COLORREF); var P: array[1..3] of TPoint; APrevPen: HPEN; APrevBrush: HBRUSH; begin if AVertical then begin P[1] := Point(X, Y); P[2] := Point(X + 1, Y + 1); P[3] := Point(X + 2, Y); end else begin P[1] := Point(X, Y); P[2] := Point(X + 1, Y + 1); P[3] := Point(X, Y + 2); end; APrevPen := SelectObject(DC, CreatePen(PS_SOLID, 1, AColor)); APrevBrush := SelectObject(DC, CreateSolidBrush(AColor)); Polygon(DC, P, 3); DeleteObject(SelectObject(DC, APrevBrush)); DeleteObject(SelectObject(DC, APrevPen)); end; procedure DrawMarks(X, Y: Integer; Vertical: Boolean); var AOffsetX, AOffsetY: Integer; begin DrawMark(X + 1, Y + 1, Vertical, dxOffice11BarMarkArrowColor2); DrawMark(X, Y, Vertical, dxOffice11BarMarkArrowColor1); if Vertical then begin AOffsetX := 0; AOffsetY := 4; end else begin AOffsetX := 4; AOffsetY := 0; end; DrawMark(X + 1 + AOffsetX, Y + 1 + AOffsetY, Vertical, dxOffice11BarMarkArrowColor2); DrawMark(X + AOffsetX, Y + AOffsetY, Vertical, dxOffice11BarMarkArrowColor1); end; var AOffsetX, AOffsetY: Integer; begin with ItemRect do begin if (ABarControl.Bar.BorderStyle = bbsNone) or ABarControl.Bar.IsMainMenu then begin AOffsetX := 2; AOffsetY := 1; end else begin AOffsetX := 0; AOffsetY := 0; end; if ABarControl.Horizontal then begin DrawArrows(Right - 6 - AOffsetX, Bottom - 8 - AOffsetY, False); if ABarControl.FTruncated then DrawMarks(Right - 7 - AOffsetX, Top + 3 - AOffsetY, False); // TODO end else begin DrawArrows(Right - 8 - AOffsetY, Bottom - 6 - AOffsetX, True); if ABarControl.FTruncated then DrawMarks(Left + 3 - AOffsetX, Bottom - 7 - AOffsetY, True); // TODO end; end; end; class procedure TdxBarItemControlOffice11Painter.SubMenuControlDrawMark(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect; ASelected: Boolean); begin InflateRect(R, -1, -1); R.Left := (R.Right + R.Left) div 2 - dxOffice11SubMenuExpandBitmap.Width div 2; R.Right := R.Left + dxOffice11SubMenuExpandBitmap.Width; TransparentDraw(DC, ABarSubMenuControl.BkBrush, R, R, dxOffice11SubMenuExpandBitmap, nil, -1, True, False, False{Flat}, False, False, False, False{Shadow}, True{Transparent}, clNone{Faded}, clNone); end; class procedure TdxBarItemControlOffice11Painter.ComboControlDrawOneArrow(ABarItemControl: TdxBarItemControl; DC: HDC; X, Y, Size: Integer; Color: COLORREF); var Brush: HBRUSH; P: array[1..3] of TPoint; Pen: HPEN; begin P[1] := Point(X, Y); P[2] := Point(X + Size - 1, Y); P[3] := Point(X + Size div 2, Y + Size div 2); Pen := SelectObject(DC, CreatePen(PS_SOLID, 1, Color)); Brush := SelectObject(DC, CreateSolidBrush(Color)); Polygon(DC, P, 3); DeleteObject(SelectObject(DC, Brush)); DeleteObject(SelectObject(DC, Pen)); end; { TdxBarItemControlXPPainter } class procedure TdxBarItemControlXPPainter.DrawGlyphAndTextInSubMenu(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect; Selected, ShowGlyph, Down: Boolean); var IconRect: TRect; IsGlyphEmpty, AOpaque: Boolean; Brush: HBRUSH; begin // TODO: !!! with R do begin IconRect := R; IconRect.Right := IconRect.Left + Bottom - Top; IsGlyphEmpty := not ABarItemControl.ImageExists or not ShowGlyph; DrawGlyph(ABarItemControl, IconRect, nil, ptMenu, IsGlyphEmpty, Selected, Down, False, False, False, False, False); if Selected and (IsGlyphEmpty and not Down) then Brush := ABarItemControl.Parent.ToolbarSelBrush else Brush := ABarItemControl.Parent.BkBrush; Left := IconRect.Right + 1; AOpaque := Selected or ABarItemControl.FNonRecent; with IconRect do DrawBackground(ABarItemControl, DC, Rect(Right, Top, R.Left, Bottom), Brush, AOpaque); if Selected then Brush := ABarItemControl.Parent.ToolbarSelBrush else Brush := ABarItemControl.Parent.BkBrush; DrawBackground(ABarItemControl, DC, R, Brush, AOpaque); Inc(Left, 2); DrawItemText(ABarItemControl, DC, ABarItemControl.Caption, R, DT_LEFT, ABarItemControl.Enabled, Selected, False, False, False); end; end; class procedure TdxBarItemControlXPPainter.DrawLowered(ABarItemControl: TdxBarItemControl; DC: HDC; var R: TRect); begin TdxBarItemControlStandardPainter.DrawLowered(ABarItemControl, DC, R); end; class function TdxBarItemControlXPPainter.GlyphBkgndBrush(ABarItemControl: TdxBarItemControl; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean): HBRUSH; begin if Selected and (PaintType = ptMenu) and IsGlyphEmpty and not Down then // TODO: ref func Result := ABarItemControl.Parent.ToolbarSelBrush else Result := ABarItemControl.Parent.BkBrush; end; class function TdxBarItemControlXPPainter.GlyphDownShift(ABarItemControl: TdxBarItemControl): Integer; begin Result := 1; end; class function TdxBarItemControlXPPainter.GlyphDrawDownedShift(ABarItemControl: TdxBarItemControl; ADown: Boolean): Integer; begin if not ADown then Result := 1 else Result := 0; end; class function TdxBarItemControlXPPainter.BeforeFingersSize: Integer; begin // Result := 3; Result := 0; end; class function TdxBarItemControlXPPainter.FingersSize: Integer; begin Result := BeforeFingersSize + GripperSize + 2; end; class function TdxBarItemControlXPPainter.GripperSize: Integer; var ATheme: TdxTheme; DC: HDC; ASize: TSize; begin ATheme := OpenTheme(totRebar); DC := GetDC(0); GetThemePartSize(ATheme, DC, RP_GRIPPER, CHEVS_NORMAL, nil, TS_TRUE, @ASize); Result := ASize.cx; ReleaseDC(0, DC); end; class function TdxBarItemControlXPPainter.RealButtonArrowWidth(ABarManager: TdxBarManager): Integer; begin Result := inherited RealButtonArrowWidth(ABarManager); Inc(Result, 3); end; class function TdxBarItemControlXPPainter.RealLargeButtonArrowWidth(ABarManager: TdxBarManager): Integer; begin Result := inherited RealLargeButtonArrowWidth(ABarManager); Inc(Result, 3); end; class procedure TdxBarItemControlXPPainter.DockControlFillBackground(ADockControl: TdxDockControl; DC: HDC; ADestR, ASourceR, AWholeR: TRect; ABrush: HBRUSH; AColor: TColor); procedure FillBackgroundTempBitmap(ABitmap: TBitmap); var ATheme: TdxTheme; begin ATheme := OpenTheme(totRebar); with AWholeR do begin ABitmap.Width := Right - Left; ABitmap.Height := Bottom - Top; end; DrawThemeBackground(ATheme, ABitmap.Canvas.Handle, 0, CHEVS_NORMAL, @AWholeR); end; procedure DrawBarSeparators(DC: HDC); function GetRowBar(ARow: TdxDockRow): TdxBar; var I: Integer; ABar: TdxBar; begin if ARow.ColCount = 0 then begin Result := nil; Exit; end; Result := ARow.Cols[0].BarControl.Bar; if Result.BorderStyle = bbsNone then for I := 1 to ARow.ColCount - 1 do begin ABar := ARow.Cols[I].BarControl.Bar; if ABar.BorderStyle <> bbsNone then begin Result := ABar; Break; end; end; end; function IsNoBorder(ARow: TdxDockRow): Boolean; var ABar: TdxBar; begin ABar := GetRowBar(ARow); Result := (ABar <> nil) and ((ABar.BorderStyle = bbsNone) or ABar.IsStatusBar); end; procedure CalcLines(ARow: TdxDockRow; AHorz: Boolean; var AIsFirstLineNeeded, AIsLastLineNeeded: Boolean); var AIsTop, AIsBottom, AIsTopBottom, AIsLeft, AIsRight: Boolean; begin if IsNoBorder(ARow) then begin AIsFirstLineNeeded := False; AIsLastLineNeeded := False; end else begin AIsFirstLineNeeded := True; AIsLastLineNeeded := True; if AHorz then begin AIsTop := (ADockControl.DockingStyle = dsTop) and (ARow = ADockControl.Rows[0]); AIsBottom := (ADockControl.DockingStyle = dsBottom) and (ARow = ADockControl.Rows[ADockControl.RowCount - 1]); AIsTopBottom := (ADockControl.DockingStyle = dsTop) and (ARow = ADockControl.Rows[ADockControl.RowCount - 1]); if AIsTop then AIsFirstLineNeeded := False; if AIsBottom or AIsTopBottom then AIsLastLineNeeded := False; end else begin AIsLeft := (ADockControl.DockingStyle = dsLeft) and (ARow = ADockControl.Rows[0]); AIsRight := (ADockControl.DockingStyle = dsRight) and (ARow = ADockControl.Rows[ADockControl.RowCount - 1]); if AIsLeft then AIsFirstLineNeeded := False; if AIsRight then AIsLastLineNeeded := False; end; end; end; var I: Integer; R, R1, R2: TRect; AHorz: Boolean; AIsFirstLineNeeded, AIsLastLineNeeded: Boolean; begin AHorz := ADockControl.DockingStyle in [dsTop, dsBottom]; for I := 0 to ADockControl.RowCount - 1 do begin // rects R := ADockControl.GetRectForRow(I); if AHorz then begin R1 := Rect(R.Left, R.Top, R.Right, R.Top + 1); R2 := Rect(R.Left, R.Bottom - 1, R.Right, R.Bottom); end else begin R1 := Rect(R.Left, R.Top, R.Left + 1, R.Bottom); R2 := Rect(R.Right - 1, R.Top, R.Right, R.Bottom); end; // draw CalcLines(ADockControl.Rows[I], AHorz, AIsFirstLineNeeded, AIsLastLineNeeded); if AIsFirstLineNeeded then FillRect(DC, R1, GetSysColorBrush(COLOR_BTNHIGHLIGHT)); if AIsLastLineNeeded then FillRect(DC, R2, GetSysColorBrush(COLOR_BTNSHADOW)); // TODO: color? end; end; begin if ADockControl.BackgroundTempBitmap.Empty then begin FillBackgroundTempBitmap(ADockControl.BackgroundTempBitmap); DrawBarSeparators(ADockControl.BackgroundTempBitmap.Canvas.Handle); end; with ADestR do BitBlt(DC, Left, Top, Right - Left, Bottom - Top, ADockControl.BackgroundTempBitmap.Canvas.Handle, ASourceR.Left, ASourceR.Top, SRCCOPY); end; class function TdxBarItemControlXPPainter.IsNativeBackground: Boolean; begin Result := True; end; {class function TdxBarItemControlXPPainter.BarChildrenHaveShadows(ABarControl: TCustomdxBarControl): Boolean; begin Result := False; end;} class function TdxBarItemControlXPPainter.BarHasShadow(ABarControl: TCustomdxBarControl): Boolean; begin Result := ABarControl.DockingStyle = dsNone; end; class function TdxBarItemControlXPPainter.BarToolbarBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin Result := ABarControl.BarManager.ThemeToolbarsBrush; end; class function TdxBarItemControlXPPainter.BarToolbarBrushEx(ABarControl: TdxBarControl): HBRUSH; begin Result := BarToolbarBrush(ABarControl); end; class function TdxBarItemControlXPPainter.BarToolbarDownedBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin // TODO Result := PatternBrush; // Result := ABarControl.BarManager.FlatToolbarsDownedBrush; end; class function TdxBarItemControlXPPainter.BarToolbarDownedSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin // TODO Result := GetSysColorBrush(COLOR_BTNFACE); // Result := ABarControl.BarManager.FlatToolbarsDownedSelBrush; end; class function TdxBarItemControlXPPainter.BarToolbarSelBrush(ABarControl: TCustomdxBarControl): HBRUSH; begin // TODO Result := GetSysColorBrush(COLOR_HIGHLIGHT); // Result := ABarControl.BarManager.FlatToolbarsSelBrush; end; class function TdxBarItemControlXPPainter.ComboBoxArrowWidth(ABarControl: TCustomdxBarControl; DC: HDC; cX: Integer): Integer; var ATheme: TdxTheme; ASize: TSize; begin ATheme := OpenTheme(totComboBox); GetThemePartSize(ATheme, DC, CP_DROPDOWNBUTTON, CBXS_NORMAL, nil, TS_TRUE, @ASize); Result := ASize.cx; end; class function TdxBarItemControlXPPainter.EditBorderSize(DC: HDC): Integer; var ATheme: TdxTheme; R, CR: TRect; begin ATheme := OpenTheme(totEdit); R := Rect(0, 0, 100, 100); GetThemeBackgroundContentRect(ATheme, DC, EP_EDITTEXT, ETS_NORMAL, R, CR); Result := (R.Right - R.Left) - (CR.Right - CR.Left) + 2 * 2 + 1; end; class function TdxBarItemControlXPPainter.BarAllowHotTrack: Boolean; begin Result := True; end; class function TdxBarItemControlXPPainter.BarAllowQuickCustomizing: Boolean; begin Result := True; end; class function TdxBarItemControlXPPainter.BarBeginGroupSideSize: Integer; begin // don't use in xp painter Result := (BarBeginGroupSize - 1{|}) div 2; end; class function TdxBarItemControlXPPainter.BarBeginGroupSize: Integer; var ATheme: TdxTheme; DC: HDC; ASize: TSize; begin ATheme := OpenTheme(totToolBar); DC := GetDC(0); GetThemePartSize(ATheme, DC, TP_SEPARATOR, TS_NORMAL, nil, TS_MIN, @ASize); Result := ASize.cx; ReleaseDC(0, DC); end; class function TdxBarItemControlXPPainter.BarBorderSize: Integer; begin Result := 0; end; class procedure TdxBarItemControlXPPainter.BarCaptionFillBackground(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); const CaptionBkColors: array[Boolean] of Integer = (COLOR_INACTIVECAPTION, COLOR_ACTIVECAPTION); //const // CaptionStates: array[Boolean] of Integer = (CS_INACTIVE, CS_ACTIVE); //var // ATheme: TdxTheme; begin // ATheme := OpenTheme(totWindow); // DrawThemeBackground(ATheme, DC, WP_SMALLCAPTION, // CaptionStates[ABarControl.BarManager.MainFormActive], @R); FillRect(DC, R, GetSysColorBrush(CaptionBkColors[ABarControl.BarManager.MainFormActive])); end; {class function TdxBarItemControlXPPainter.BarCaptionSize: Integer; var ATheme: TdxTheme; DC: HDC; ASize: TSize; begin ATheme := OpenTheme(totWindow); DC := GetDC(0); GetThemePartSize(ATheme, DC, WP_SMALLCAPTION, CS_ACTIVE, nil, TS_TRUE, @ASize); Result := ASize.cy; ReleaseDC(0, DC); end;} class function TdxBarItemControlXPPainter.BarCaptionTransparent: Boolean; begin Result := True; end; class function TdxBarItemControlXPPainter.BarCloseButtonSize: TSize; var ATheme: TdxTheme; DC: HDC; begin ATheme := OpenTheme(totWindow); DC := GetDC(0); GetThemePartSize(ATheme, DC, WP_SMALLCLOSEBUTTON, CBS_NORMAL, nil, TS_TRUE, @Result); ReleaseDC(0, DC); end; class procedure TdxBarItemControlXPPainter.BarDrawBeginGroup(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH; AHorz: Boolean); var ATheme: TdxTheme; begin ATheme := OpenTheme(totToolBar); // * IsThemeBackgroundPartiallyTransparent ABarControl.FillBackground(DC, ItemRect, AToolbarBrush, clNone, True); if AHorz then DrawThemeBackground(ATheme, DC, TP_SEPARATORVERT, TS_NORMAL, @ItemRect) else DrawThemeBackground(ATheme, DC, TP_SEPARATOR, TS_NORMAL, @ItemRect); end; class procedure TdxBarItemControlXPPainter.BarDrawCloseButton(ABarControl: TdxBarControl; DC: HDC; R: TRect); const ButtonStates: array [TdxBarMarkState] of Integer = (CBS_NORMAL, CBS_HOT, CBS_PUSHED); var ATheme: TdxTheme; begin ATheme := OpenTheme(totWindow); // FillTransparent is not needed (BarCaptionTransparent) DrawThemeBackground(ATheme, DC, WP_SMALLCLOSEBUTTON, ButtonStates[ABarControl.CloseButtonState], @R); end; class procedure TdxBarItemControlXPPainter.BarDrawDockedBarBorder(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); const Grippers: array[Boolean] of Integer = (RP_GRIPPER, RP_GRIPPERVERT); var ATheme: TdxTheme; begin InflateRect(R, -2, -2); if not ABarControl.Bar.CanMoving then Exit; ATheme := OpenTheme(totRebar); with R do if ABarControl.Horizontal then begin Inc(Left, ABarControl.BarManager.BeforeFingersSize); Right := Left + ABarControl.PainterClass.GripperSize; InflateRect(R, 0, -0); end else begin Inc(Top, ABarControl.BarManager.BeforeFingersSize); Bottom := Top + ABarControl.PainterClass.GripperSize; InflateRect(R, -0, 0); end; // FillTransparent is not needed (FillBackgroundRgn) DrawThemeBackground(ATheme, DC, Grippers[ABarControl.Vertical], CHEVS_NORMAL, @R); end; class procedure TdxBarItemControlXPPainter.BarDrawFloatingBarBorder(ABarControl: TdxBarControl; DC: HDC; var R, CR: TRect; AToolbarBrush: HBRUSH); begin TdxBarItemControlFlatPainter.BarDrawFloatingBarBorder(ABarControl, DC, R, CR, AToolbarBrush); end; class function TdxBarItemControlXPPainter.StatusBarGripSize(ABarManager: TdxBarManager): TSize; var ATheme: TdxTheme; DC: HDC; begin ATheme := OpenTheme(totStatus); DC := GetDC(0); GetThemePartSize(ATheme, DC, SP_GRIPPER, 0, nil, TS_TRUE, @Result); ReleaseDC(0, DC); end; class procedure TdxBarItemControlXPPainter.BarDrawMDIButton(ABarControl: TdxBarControl; AButton: TdxBarMDIButton; ASelected, APressed: Boolean; DC: HDC; R: TRect); const Buttons: array[TdxBarMDIButton] of Integer = (WP_MDIMINBUTTON, WP_MDIRESTOREBUTTON, WP_MDICLOSEBUTTON); States: array[TdxBarMDIButton, 1..4] of Integer = ( (MINBS_DISABLED, MINBS_HOT, MINBS_NORMAL, MINBS_PUSHED), (RBS_DISABLED, RBS_HOT, RBS_NORMAL, RBS_PUSHED), (CBS_DISABLED, CBS_HOT, CBS_NORMAL, CBS_PUSHED)); var ATheme: TdxTheme; AState: Integer; begin ATheme := OpenTheme(totWindow); // * IsThemeBackgroundPartiallyTransparent // ABarControl.MDIButtonEnabled(AButton, MF_GRAYED) // MINBS_DISABLED, MINBS_HOT, MINBS_NORMAL, MINBS_PUSHED AState := 3; if not ABarControl.MDIButtonEnabled(AButton, MF_GRAYED) then AState := 1 else if ASelected then begin if APressed then AState := 4 else AState := 2; end; ABarControl.FillBackground(DC, R, ABarControl.ToolbarBrush, clNone, True); DrawThemeBackground(ATheme, DC, Buttons[AButton], States[AButton, AState], @R); end; class function TdxBarItemControlXPPainter.BarMarkItemRect(ABarControl: TdxBarControl): TRect; begin Result := TdxBarItemControlFlatPainter.BarMarkItemRect(ABarControl); end; class procedure TdxBarItemControlXPPainter.StatusBarFillBackground(ABarControl: TdxBarControl; DC: HDC; ADestR, ASourceR, AWholeR: TRect; ABrush: HBRUSH; AColor: TColor); procedure FillBackgroundTempBitmap(ABitmap: TBitmap); var ATheme: TdxTheme; begin ATheme := OpenTheme(totStatus); with AWholeR do begin ABitmap.Width := Right - Left; ABitmap.Height := Bottom - Top; end; DrawThemeBackground(ATheme, ABitmap.Canvas.Handle, 0, 0, @AWholeR); end; begin if ABarControl.BackgroundTempBitmap.Empty then FillBackgroundTempBitmap(ABarControl.BackgroundTempBitmap); with ADestR do BitBlt(DC, Left, Top, Right - Left, Bottom - Top, ABarControl.BackgroundTempBitmap.Canvas.Handle, ASourceR.Left, ASourceR.Top, SRCCOPY); end; class function TdxBarItemControlXPPainter.SubMenuControlArrowsOffset: Integer; begin Result := 1; end; class function TdxBarItemControlXPPainter.SubMenuControlBeginGroupSize: Integer; var ATheme: TdxTheme; DC: HDC; ASize: TSize; begin ATheme := OpenTheme(totToolBar); DC := GetDC(0); GetThemePartSize(ATheme, DC, TP_SEPARATORVERT, TS_NORMAL, nil, TS_TRUE, @ASize); Result := ASize.cy; ReleaseDC(0, DC); end; class function TdxBarItemControlXPPainter.SubMenuControlBorderSize: Integer; begin Result := 1; end; class procedure TdxBarItemControlXPPainter.SubMenuControlCalcRect(ABarSubMenuControl: TdxBarSubMenuControl; Size: PPoint; var R: TRect; var AClientHeight: Integer); begin with ABarSubMenuControl do begin R := Rect(1 + BarSize, 1, ClientWidth - 1, 1); if Size = nil then AClientHeight := ClientHeight - 1 - TextSize * Byte(MarkExists) else begin Size^.X := 0; AClientHeight := MaxInt; end; end; end; class procedure TdxBarItemControlXPPainter.SubMenuControlCalcSize(ABarSubMenuControl: TdxBarSubMenuControl; Size: PPoint; var R: TRect); begin with ABarSubMenuControl do begin if Size^.X = 0 then Size^.X := 100 else Inc(Size^.X, 2 * 2 + BarSize); // 2? if (R.Top <= 2) or MarkExists then Inc(R.Top, TextSize); Size^.Y := 1 + R.Top + 2; if Detachable then Inc(Size^.Y, DetachCaptionAreaSize); end; end; class function TdxBarItemControlXPPainter.SubMenuControlDetachCaptionAreaSize(ABarSubMenuControl: TdxBarSubMenuControl): Integer; begin Result := ABarSubMenuControl.DetachCaptionSize + 1; end; class procedure TdxBarItemControlXPPainter.SubMenuControlDrawBeginGroup(ABarSubMenuControl: TdxBarSubMenuControl; AControl: TdxBarItemControl; DC: HDC; AItemRect: TRect; LeftDelta: Integer); var R: TRect; ABrush: HBRUSH; ATheme: TdxTheme; begin R := AItemRect; ABrush := ABarSubMenuControl.BkBrush; R.Bottom := R.Top; Dec(R.Top, ABarSubMenuControl.BeginGroupSize); AControl.FBeginGroupRect := R; ATheme := OpenTheme(totToolBar); // * IsThemeBackgroundPartiallyTransparent DrawBackground(AControl, DC, R, ABrush, AControl.FNonRecent and not AControl.FChangeRecentGroup); DrawThemeBackground(ATheme, DC, TP_SEPARATORVERT, TS_NORMAL, @R); end; class procedure TdxBarItemControlXPPainter.SubMenuControlDrawBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; R: TRect); begin FrameRect(DC, R, GetSysColorBrush(COLOR_BTNSHADOW)); if ABarSubMenuControl.Detachable then begin InflateRect(R, -1, -1); R.Bottom := R.Top + ABarSubMenuControl.DetachCaptionAreaSize + 1; FrameRect(DC, R, ABarSubMenuControl.ToolbarItemsBrush); SubMenuControlDrawDetachCaption(ABarSubMenuControl, DC, ABarSubMenuControl.DetachCaptionRect); end; end; class procedure TdxBarItemControlXPPainter.SubMenuControlDrawClientBorder(ABarSubMenuControl: TdxBarSubMenuControl; DC: HDC; var R: TRect; ABrush: HBRUSH); begin FrameRect(DC, R, ABarSubMenuControl.ToolbarItemsBrush); end; class procedure TdxBarItemControlXPPainter.SubMenuControlOffsetDetachCaptionRect(ABarSubMenuControl: TdxBarSubMenuControl; var R: TRect); begin InflateRect(R, -2, -2); end; class procedure TdxBarItemControlXPPainter.SubMenuControlPrepareBkBrush(ABarSubMenuControl: TdxBarSubMenuControl; var ABkBrush: HBRUSH); begin ABkBrush := SubMenuControlToolbarItemsBrush(ABarSubMenuControl); end; class function TdxBarItemControlXPPainter.SubMenuControlToolbarItemsBrush(ABarSubMenuControl: TdxBarSubMenuControl): HBRUSH; begin Result := GetSysColorBrush(COLOR_MENU); end; class function TdxBarItemControlXPPainter.DropDownListBoxBorderSize: Integer; begin Result := TdxBarItemControlFlatPainter.DropDownListBoxBorderSize; end; class procedure TdxBarItemControlXPPainter.DropDownListBoxDrawBorder(ABarManager: TdxBarManager; DC: HDC; R: TRect); begin TdxBarItemControlFlatPainter.DropDownListBoxDrawBorder(ABarManager, DC, R); end; class procedure TdxBarItemControlXPPainter.ColorComboDrawCustomButton(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; var ACustomColorButtonRect: TRect; Selected, Pressed: Boolean); var DotSize, I: Integer; begin with ARect do begin DrawBackgroundFrameRect(ABarComboControl, DC, ARect, ABarComboControl.Parent.BkBrush, False); InflateRect(ARect, -1, -1); ACustomColorButtonRect := ARect; DrawGlyphBorder(ABarComboControl, DC, ABarComboControl.Parent.BkBrush, True, ARect, ptHorz, True, Selected, False, Pressed, False, False); // draw dots DotSize := (Right - Left) div 7; Right := Left; Dec(Bottom, 2 * DotSize); Top := Bottom - DotSize; OffsetEllipsisBounds(ABarComboControl, Pressed, ARect); for I := 0 to 2 do begin Left := Right + DotSize; Right := Left + DotSize; if ABarComboControl.Enabled then FillRect(DC, ARect, COLOR_BTNTEXT + 1) else DrawDisabledShadowRect(ABarComboControl, DC, ARect); end; end; end; class function TdxBarItemControlXPPainter.IsDateNavigatorFlat: Boolean; begin Result := True; end; class procedure TdxBarItemControlXPPainter.DateNavigatorDrawButton(ABarItem: TdxBarItem; DC: HDC; R: TRect; const ACaption: string; APressed: Boolean); var ATheme: TdxTheme; AState: Integer; AOffset: Integer; begin ATheme := OpenTheme(totToolbar); FillRect(DC, R, GetSysColorBrush(COLOR_WINDOW)); if APressed then begin AState := TS_PRESSED; AOffset := 1; end else begin AState := TS_HOT; AOffset := 0; end; DrawThemeBackground(ATheme, DC, TP_BUTTON, AState, @R); DateNavigatorDrawButtonCaption(DC, R, AOffset, ACaption, False); end; class procedure TdxBarItemControlXPPainter.SysPanelDraw(AHandle: HWND; AllowResizing, MouseAboveCloseButton, CloseButtonIsTracking: Boolean; var CloseButtonRect, GripRect: TRect; Corner: TdxCorner); var R, CR: TRect; B: Integer; BorderBrush: HBRUSH; DC: HDC; AStyle: Longint; begin DC := GetWindowDC(AHandle); try GetWindowRect(AHandle, R); CloseButtonRect := R; GripRect := R; GetClientRect(AHandle, CR); MapWindowPoints(0, AHandle, R, 2); B := -R.Left; OffsetRect(CR, -R.Left, -R.Top); OffsetRect(R, -R.Left, -R.Top); BorderBrush := GetSysColorBrush(COLOR_BTNSHADOW); FrameRect(DC, R, BorderBrush); if not AllowResizing then begin SetRectEmpty(CloseButtonRect); SetRectEmpty(GripRect); Exit; end; InflateRect(R, -B, -B); if Corner in [coBottomLeft, coBottomRight] then begin R.Top := R.Bottom - SysPanelSize + 1; FillRect(DC, Rect(R.Left, R.Top - 1, R.Right, R.Top), BorderBrush); end else begin R.Bottom := R.Top + SysPanelSize - 1; FillRect(DC, Rect(R.Left, R.Bottom, R.Right, R.Bottom + 1), BorderBrush); end; CR := R; ThemeDrawSizeGrip(DC, CR, Corner); // TODO: with CR do ExcludeClipRect(DC, Left, Top, Right, Bottom); InflateRect(CR, 2, 2); if CR.Top < R.Top then CR.Top := R.Top; if CR.Bottom > R.Bottom then CR.Bottom := R.Bottom; OffsetRect(CR, GripRect.Left, GripRect.Top); GripRect := CR; CR := R; ThemeDrawCloseButton(DC, CR, MouseAboveCloseButton or CloseButtonIsTracking, MouseAboveCloseButton and CloseButtonIsTracking, Corner); with CR do ExcludeClipRect(DC, Left, Top, Right, Bottom); with CloseButtonRect do OffsetRect(CR, Left, Top); CloseButtonRect := CR; FillRect(DC, R, COLOR_BTNFACE + 1); if Corner in [coBottomLeft, coBottomRight] then begin AStyle := GetWindowLong(AHandle, GWL_STYLE); if (AStyle and WS_HSCROLL <> 0) and (AStyle and WS_VSCROLL <> 0) then with R do begin Left := Right - GetSystemMetrics(SM_CXVSCROLL); Bottom := Top - 1; Top := Bottom - GetSystemMetrics(SM_CYHSCROLL); FillRect(DC, R, GetSysColorBrush(COLOR_BTNFACE)); end; end; finally ReleaseDC(AHandle, DC); end; end; class function TdxBarItemControlXPPainter.SysPanelSize: Integer; var DC: HDC; ASizeGripSize: Integer; begin DC := GetDC(0); Result := ThemeCloseButtonSize(DC).cy + 2 * 2; ASizeGripSize := ThemeSizeGripSize(DC).cy + 1; if Result < ASizeGripSize then Result := ASizeGripSize; ReleaseDC(0, DC); end; class procedure TdxBarItemControlXPPainter.SpinEditControlDrawButton(ABarEditControl: TdxBarEditControl; DC: HDC; ARect: TRect; XSize, YSize, Size: Integer; Selected: Boolean; AButton, AActiveButton: TdxBarSpinEditButton; AButtonPressed: Boolean); var ATheme: TdxTheme; APartId, AState: Integer; R: TRect; begin R := ARect; with R do begin if AButton = sbUp then Bottom := Top + Size + 1 else Inc(Top, Size); ATheme := OpenTheme(totSpin); // * IsThemeBackgroundPartiallyTransparent DrawBackground(ABarEditControl, DC, R, ABarEditControl.Parent.BkBrush, False); if AButton = sbUp then begin APartId := SPNP_UP; if not ABarEditControl.Enabled then AState := UPS_DISABLED else if AActiveButton = AButton then begin if AButtonPressed then AState := UPS_PRESSED else AState := UPS_HOT; end else AState := UPS_NORMAL; end else begin APartId := SPNP_DOWN; if not ABarEditControl.Enabled then AState := DNS_DISABLED else if AActiveButton = AButton then begin if AButtonPressed then AState := DNS_PRESSED else AState := DNS_HOT; end else AState := DNS_NORMAL; end; DrawThemeBackground(ATheme, DC, APartId, AState, @R); end; end; class procedure TdxBarItemControlXPPainter.SpinEditControlDrawFrame(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect); begin end; class function TdxBarItemControlXPPainter.ProgressControlBarBrushColor: TColorRef; var ATheme: TdxTheme; begin ATheme := OpenTheme(totProgress); if FAILED(GetThemeColor(ATheme, PP_CHUNK, 0, TMT_FILLCOLOR, Result)) then Result := inherited ProgressControlBarBrushColor; end; class function TdxBarItemControlXPPainter.ProgressControlBarHeight(ABarItemControl: TdxBarItemControl): Integer; var ATheme: TdxTheme; ASize: TSize; DC: HDC; R, CR: TRect; begin ATheme := OpenTheme(totProgress); DC := GetDC(0); GetThemePartSize(ATheme, DC, PP_CHUNK, 0, nil, TS_TRUE, @ASize); ReleaseDC(0, DC); GetThemeBackgroundContentRect(ATheme, DC, PP_BAR, 0, R, CR); Result := ASize.cy + (R.Right - R.Left) - (CR.Right - CR.Left); end; class procedure TdxBarItemControlXPPainter.ProgressControlDrawBar(ABarItemControl: TdxBarItemControl; DC: HDC; BarR: TRect; ABarBrushColor: TColorRef; PaintType: TdxBarPaintType; ASmooth: Boolean; Position, Min, Max: Integer); const BarParts: array[Boolean] of Integer = (PP_BAR, PP_BARVERT); ChunkParts: array[Boolean] of Integer = (PP_CHUNK, PP_CHUNKVERT); var ATheme: TdxTheme; ABarPartId, AChunkPartId: Integer; CR: TRect; ALeft, ARight: ^Integer; procedure DrawChunk; var ABarBrush: HBRUSH; begin if ASmooth then begin ABarBrush := CreateSolidBrush(ABarBrushColor); FillRect(DC, CR, ABarBrush); DeleteObject(ABarBrush); end else DrawThemeBackground(ATheme, DC, AChunkPartId, 0, @CR); end; begin ATheme := OpenTheme(totProgress); // * IsThemeBackgroundPartiallyTransparent ABarPartId := BarParts[PaintType = ptVert]; AChunkPartId := ChunkParts[PaintType = ptVert]; if IsThemeBackgroundPartiallyTransparent(ATheme, ABarPartId, 0) then DrawBackground(ABarItemControl, DC, BarR, ABarItemControl.Parent.BkBrush, False); GetThemeBackgroundContentRect(ATheme, DC, ABarPartId, 0, BarR, CR); // calc rect with CR do if PaintType = ptVert then begin ALeft := @Top; ARight := @Bottom; end else begin ALeft := @Left; ARight := @Right; end; ARight^ := ALeft^ + MulDiv(ARight^ - ALeft^, Position - Min, Max - Min); // draw chunk DrawThemeBackground(ATheme, DC, ABarPartId, 0, @BarR); DrawChunk; end; class function TdxBarItemControlXPPainter.IsQuickControlPopupOnRight: Boolean; begin Result := True; end; class function TdxBarItemControlXPPainter.ButtonBorderHeight: Integer; var ATheme: TdxTheme; DC: HDC; R, RC: TRect; begin ATheme := OpenTheme(totToolBar); DC := GetDC(0); R := Rect(0, 0, 100, 100); GetThemeBackgroundContentRect(ATheme, DC, TP_SPLITBUTTON, TS_NORMAL, R, RC); // ? Result := (R.Bottom - R.Top) - (RC.Bottom - RC.Top); ReleaseDC(0, DC); end; class function TdxBarItemControlXPPainter.ButtonBorderWidth: Integer; begin Result := ButtonBorderHeight; end; class procedure TdxBarItemControlXPPainter.CorrectButtonControlDefaultHeight(var DefaultHeight: Integer); begin // Inc(DefaultHeight, 2); // TODO: check!!! Inc(DefaultHeight, 1); end; class procedure TdxBarItemControlXPPainter.DrawButtonControlArrow(ABarItemControl: TdxBarItemControl; DC: HDC; R1: TRect; Brush: HBRUSH; ArrowColor: COLORREF; Selected, DrawDowned, DroppedDown, DropDownEnabled, IsDropDownMenuControlExist: Boolean; PaintType: TdxBarPaintType); var ATheme: TdxTheme; AState: Integer; begin ATheme := OpenTheme(totToolBar); // * IsThemeBackgroundPartiallyTransparent DrawBackground(ABarItemControl, DC, R1, Brush, ABarItemControl.FNonRecent); if not (ABarItemControl.Enabled and DropDownEnabled) then AState := TS_DISABLED else if DroppedDown or DrawDowned then AState := TS_PRESSED else if Selected then AState := TS_HOT else AState := TS_NORMAL; if PaintType = ptMenu then begin DrawThemeBackground(ATheme, DC, TP_BUTTON, AState, @R1); DrawLargeItemArrow(DC, R1, atRight, ABarItemControl.Parent.MenuArrowHeight, DroppedDown, ABarItemControl.Enabled and DropDownEnabled, True{Flat}) end else DrawThemeBackground(ATheme, DC, TP_SPLITBUTTONDROPDOWN, AState, @R1); end; class procedure TdxBarItemControlXPPainter.OffsetCaptionBounds(ABarButtonControl: TdxBarButtonControl; APressed: Boolean; var R: TRect); begin if ABarButtonControl.Down or APressed then OffsetRect(R, 1, 1); end; class procedure TdxBarItemControlXPPainter.OffsetEllipsisBounds(ABarItemControl: TdxBarItemControl; APressed: Boolean; var R: TRect); begin if APressed then OffsetRect(R, 1, 1); end; class function TdxBarItemControlXPPainter.EditControlCaptionWidth(ABarEditControl: TdxBarEditControl; ATextWidth: Integer): Integer; begin Result := 1 + 5 + ATextWidth + 5; end; class procedure TdxBarItemControlXPPainter.EditControlDrawBorder(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); var ATheme: TdxTheme; AClipRgn: HRGN; AClipRgnExists: Boolean; AEditState: Integer; R: TRect; begin ATheme := OpenTheme(totEdit); AEditState := ThemeEditState(ABarEditControl); R := ARect; GetThemeBackgroundContentRect(ATheme, DC, EP_EDITTEXT, AEditState, R, ARect); SaveClipRgn(DC, AClipRgn, AClipRgnExists); with ARect do ExcludeClipRect(DC, Left, Top, Right, Bottom); if not ABarEditControl.Enabled or Selected or (PaintType = ptMenu) then DrawThemeBackground(ATheme, DC, EP_EDITTEXT, AEditState, @R) else DrawBackground(ABarEditControl, DC, R, ABarEditControl.Parent.BkBrush, ABarEditControl.FNonRecent); RestoreClipRgn(DC, AClipRgn, AClipRgnExists); end; class procedure TdxBarItemControlXPPainter.EditControlDrawCaption(ABarEditControl: TdxBarEditControl; DC: HDC; var ARect: TRect; PaintType: TdxBarPaintType; Selected: Boolean); var S: string; Size: TSize; R: TRect; Brush: HBRUSH; begin S := GetTextOf(ABarEditControl.Caption); GetTextExtentPoint32(DC, PChar(S), Length(S), Size); R := ARect; R.Right := R.Left + EditControlCaptionWidth(ABarEditControl, Size.cX); ARect.Left := R.Right; if Selected and (PaintType = ptMenu) then Brush := ABarEditControl.Parent.ToolbarSelBrush else Brush := ABarEditControl.Parent.BkBrush; DrawBackground(ABarEditControl, DC, R, Brush, (PaintType = ptMenu) and (Selected or ABarEditControl.FNonRecent)); Dec(R.Right, 5); DrawItemText(ABarEditControl, DC, ABarEditControl.Caption, R, DT_RIGHT, ABarEditControl.Enabled, Selected and (PaintType = ptMenu), False, False, False); end; class procedure TdxBarItemControlXPPainter.EditControlDrawTextField(ABarEditControl: TdxBarEditControl; DC: HDC; const ARect: TRect; AIgnoreEnabled: Boolean); var ATheme: TdxTheme; AEditState: Integer; ATextColor, ABkColor: COLORREF; AClipRgn: HRGN; AClipRgnExists: Boolean; APrevFont: HFONT; begin ATheme := OpenTheme(totEdit); AEditState := ThemeEditState(ABarEditControl); ABkColor := ThemeEditColor(ATheme, AEditState); ATextColor := ThemeEditTextColor(ATheme, AEditState); SaveClipRgn(DC, AClipRgn, AClipRgnExists); try with ARect do IntersectClipRect(DC, Left, Top, Right, Bottom); SetTextColor(DC, ATextColor); with ABarEditControl.Parent.Canvas do begin Font.Color := ATextColor; Brush.Color := ABkColor; Handle; // RequiredState(csAllValid) end; APrevFont := SelectObject(DC, ABarEditControl.Parent.EditFontHandle); try ABarEditControl.Item.DrawInterior(ABarEditControl, ABarEditControl.Parent.Canvas, ARect, ABarEditControl.ItemLink); finally if GetObjectType(APrevFont) = OBJ_FONT then SelectObject(DC, APrevFont); end; finally RestoreClipRgn(DC, AClipRgn, AClipRgnExists); end; end; class function TdxBarItemControlXPPainter.EditControlES_Style: Integer; begin Result := TdxBarItemControlFlatPainter.EditControlES_Style; end; class procedure TdxBarItemControlXPPainter.EditControlPrepareEditWnd(ABarEditControl: TdxBarEditControl; AHandle: HWND); begin TdxBarItemControlFlatPainter.EditControlPrepareEditWnd(ABarEditControl, AHandle); end; class procedure TdxBarItemControlXPPainter.EditControlUpdateWndText(ABarEditControl: TdxBarEditControl; AHandle: HWND; ANotEqual: Boolean); begin TdxBarItemControlFlatPainter.EditControlUpdateWndText(ABarEditControl, AHandle, ANotEqual); end; class procedure TdxBarItemControlXPPainter.CustomComboDrawItem(ABarCustomCombo: TdxBarCustomCombo; ACanvas: TCanvas; AIndex: Integer; ARect: TRect; AState: TOwnerDrawState; AInteriorIsDrawing: Boolean); begin TdxBarItemControlFlatPainter.CustomComboDrawItem(ABarCustomCombo, ACanvas, AIndex, ARect, AState, AInteriorIsDrawing); end; class function TdxBarItemControlXPPainter.ComboControlArrowOffset: Integer; begin Result := 0; end; class procedure TdxBarItemControlXPPainter.ComboControlDrawArrow(ABarComboControl: TCustomdxBarComboControl; DC: HDC; ARect: TRect; Selected: Boolean; PaintType: TdxBarPaintType); var ATheme: TdxTheme; AState: Integer; begin with ARect do begin Left := Right - ABarComboControl.Parent.ComboBoxArrowWidth; ATheme := OpenTheme(totComboBox); ABarComboControl.FDropDownButtonRect := ARect; // * IsThemeBackgroundPartiallyTransparent if not ABarComboControl.Enabled then AState := CBXS_DISABLED else if ABarComboControl.DroppedDown then AState := CBXS_PRESSED else if Selected then AState := CBXS_HOT else AState := CBXS_NORMAL; DrawThemeBackground(ATheme, DC, CP_DROPDOWNBUTTON, AState, @ARect); end; end; class procedure TdxBarItemControlXPPainter.DrawGlyphBorder(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; PaintType: TdxBarPaintType; IsGlyphEmpty, Selected, Down, DrawDowned, BarControlOwner, IsSplit: Boolean); var ATheme: TdxTheme; AState: Integer; begin ATheme := OpenTheme(totToolBar); // * IsThemeBackgroundPartiallyTransparent if (PaintType = ptMenu) and (Selected or ABarItemControl.FNonRecent) and IsGlyphEmpty and not Down then FillRect(DC, R, ABrush) else begin DrawBackground(ABarItemControl, DC, R, ABrush, False); if IsMenuItem(ABarItemControl) and (PaintType <> ptMenu) and (Selected or DrawDowned or Down) then FillRect(DC, R, GetSysColorBrush(COLOR_HIGHLIGHT)) // *** else begin if not ABarItemControl.Enabled then AState := TS_DISABLED else if DrawDowned then AState := TS_PRESSED else if Down then AState := TS_CHECKED else if Selected then AState := TS_HOT else AState := TS_NORMAL; if IsSplit then DrawThemeBackground(ATheme, DC, TP_SPLITBUTTON, AState, @R) else DrawThemeBackground(ATheme, DC, TP_BUTTON, AState, @R); end; end; end; class procedure TdxBarItemControlXPPainter.DrawGlyphCheckMark(ABarItemControl: TdxBarItemControl; DC: HDC; X, Y, DoubleSize: Integer); begin TdxBarItemControlFlatPainter.DrawGlyphCheckMark(ABarItemControl, DC, X, Y, DoubleSize); end; class procedure TdxBarItemControlXPPainter.DrawGlyphImage(ABarItemControl: TdxBarItemControl; DC: HDC; ABrush: HBRUSH; NeedBorder: Boolean; R: TRect; const GlyphRect: TRect; AGlyph: TBitmap; AImages: TCurImageList; AImageIndex: Integer; Selected, Down, DrawDowned, ForceUseBkBrush, GrayScale, BarControlOwner: Boolean; PaintType: TdxBarPaintType); begin if NeedBorder then InflateRect(R, -1, -1); TransparentDraw(DC, ABrush, R, GlyphRect, AGlyph, AImages, AImageIndex, ABarItemControl.GetImageEnabled(PaintType), GrayScale, True{Flat}, Selected, Down, DrawDowned, False{Shadow}, True{Transparent}, GetFadedColor(ABarItemControl.Parent){Faded}, ABarItemControl.Item.BarManager.ImageListBkColor); if NeedBorder then InflateRect(R, 1, 1); end; class function TdxBarItemControlXPPainter.GetFadedColor(ABarControl: TCustomdxBarControl): TColor; begin Result := GetMiddleRGB(ThemeToolbarColor, clBtnShadow, 70); //ThemeToolbarColor; end; class function TdxBarItemControlXPPainter.IsMenuItem(ABarItemControl: TdxBarItemControl): Boolean; begin Result := (ABarItemControl.Parent is TdxBarControl) and TdxBarControl(ABarItemControl.Parent).Bar.IsMainMenu and (ABarItemControl is TdxBarSubItemControl); end; class procedure TdxBarItemControlXPPainter.BarDrawGrip(ABarControl: TdxBarControl; DC: HDC; R: TRect; AToolbarBrush: HBRUSH); var ATheme: TdxTheme; begin ATheme := OpenTheme(totStatus); // * IsThemeBackgroundPartiallyTransparent ABarControl.FillBackground(DC, R, AToolbarBrush, clNone, False); DrawThemeBackground(ATheme, DC, SP_GRIPPER, 0, @R); end; class procedure TdxBarItemControlXPPainter.BarDrawMarkBackground(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect; AToolbarBrush: HBRUSH); const States: array[TdxBarMarkState] of Integer = (TS_NORMAL, TS_HOT, TS_PRESSED); var ATheme: TdxTheme; begin ATheme := OpenTheme(totToolbar); // * IsThemeBackgroundPartiallyTransparent ABarControl.FillBackground(DC, ItemRect, AToolbarBrush, clNone, True); if ABarControl.Bar.BorderStyle = bbsNone then begin if ABarControl.Horizontal then InflateRect(ItemRect, 0, -2) else InflateRect(ItemRect, -2, 0); end; DrawThemeBackground(ATheme, DC, TP_BUTTON, States[ABarControl.MarkState], @ItemRect); end; class procedure TdxBarItemControlXPPainter.BarDrawMarkElements(ABarControl: TdxBarControl; DC: HDC; ItemRect: TRect); begin TdxBarItemControlFlatPainter.BarDrawMarkElements(ABarControl, DC, ItemRect); end; class procedure TdxBarItemControlXPPainter.BarOffsetFloatingBarCaption(ABarControl: TdxBarControl; var X: Integer; var R: TRect); begin Inc(X, 2); R.Right := ABarControl.MarkNCRect.Left; end; class procedure TdxBarItemControlXPPainter.EditOffsetInteriorRect(var R: TRect); begin Inc(R.Top, 2); end; { TdxBarItem } constructor TdxBarItem.Create(AOwner: TComponent); begin inherited Create(AOwner); if AOwner is TCustomForm then FBarManager := GetBarManagerByForm(TCustomForm(AOwner)); if (FBarManager = nil) and (dxBarManagerList.Count > 0) then FBarManager := TdxBarManager(dxBarManagerList[0]); if BarManager <> nil then BarManager.FItems.Add(Self); FLinks := TList.Create; FEnabled := True; FGlyph := TBitmap.Create; FGlyph.OnChange := OnGlyphChanged; FImageIndex := -1; FCategory := -1; FVisible := ivAlways; FLoadedVisible := ivAlways; end; destructor TdxBarItem.Destroy; begin if BarManager <> nil then begin BarManager.FItems.Remove(Self); if BarManager.FIsCustomizing and (Category > -1) then FullUpdateCustomizingBarItems; end; FLinks.Free; if FActionLink <> nil then begin FActionLink.Free; FActionLink := nil; end; FGlyph.Free; cxClearObjectLinks(Self); inherited Destroy; end; function TdxBarItem.GetAction: TBasicAction; begin if FActionLink = nil then Result := nil else Result := FActionLink.Action; end; function TdxBarItem.GetActuallyVisible: Boolean; begin Result := ((Visible = ivAlways) and (InternalActuallyVisible or BarManager.IsCustomizing) or (Visible = ivInCustomizing) and BarManager.IsCustomizing); end; function TdxBarItem.GetCurItemLink: TdxBarItemLink; var I: Integer; begin Result := nil; for I := 0 to LinkCount - 1 do if (Links[I].Control <> nil) and Links[I].Control.IsActive then begin Result := Links[I]; Break; end; end; function TdxBarItem.GetEnabled: Boolean; begin if not BarManager.Designing and BarManager.IsCustomizing and (Category > -1) then Result := True else Result := FEnabled; end; function TdxBarItem.GetFlat: Boolean; begin // TODO: obsolete Result := BarManager.Flat; end; function TdxBarItem.GetIndex: Integer; begin Result := BarManager.FItems.IndexOf(Self); end; function TdxBarItem.GetIsDesigning: Boolean; begin Result := csDesigning in ComponentState; end; function TdxBarItem.GetIsDestroying: Boolean; begin Result := csDestroying in ComponentState; end; function TdxBarItem.GetIsLoading: Boolean; begin Result := csLoading in ComponentState; end; function TdxBarItem.GetLinkCount: Integer; begin Result := FLinks.Count; end; function TdxBarItem.GetLinks(Index: Integer): TdxBarItemLink; begin Result := nil; if (Index > -1) and (Index < LinkCount) then Result := TdxBarItemLink(FLinks[Index]); end; function TdxBarItem.GetPainterClass: TdxBarItemControlPainterClass; begin Result := BarManager.PainterClass; end; function TdxBarItem.GetVisibleForUser: Boolean; var I: Integer; begin Result := True; for I := 0 to LinkCount - 1 do if Links[I].CanVisibleIndex <> -1 then Exit; Result := False; end; procedure TdxBarItem.SetAction(Value: TBasicAction); var APrevCanModifyDesigner: Boolean; begin if Action <> Value then if Value = nil then begin FActionLink.Free; FActionLink := nil; end else begin APrevCanModifyDesigner := BarManager.CanModifyDesigner; BarManager.CanModifyDesigner := not (csLoading in Value.ComponentState); if FActionLink = nil then FActionLink := GetActionLinkClass.Create(Self); FActionLink.Action := Value; FActionLink.OnChange := DoActionChange; ActionChange(Value, csLoading in Value.ComponentState); Value.FreeNotification(Self); BarManager.CanModifyDesigner := APrevCanModifyDesigner; end; end; procedure TdxBarItem.SetAlign(Value: TdxBarItemAlign); begin if FAlign <> Value then begin FAlign := Value; AlignChanged; end; end; procedure TdxBarItem.SetCaption(Value: string); var MakeHint: Boolean; S: string; begin if FCaption <> Value then begin MakeHint := not FCheckDefaults and not (Self is TCustomdxBarSubItem) and ((Hint = '') or IsHintFromCaption); FCaption := Value; if not IsLoading then begin if MakeHint then begin S := GetHintFromCaption; if Pos('|', Hint) = 0 then Hint := S else Hint := S + '|' + GetLongHint(Hint); end; CaptionChanged; end; end; end; procedure TdxBarItem.SetCategory(Value: Integer); begin if IsLoading then FCategory := Value else if (BarManager <> nil) and (Value > -1) and (Value < BarManager.Categories.Count) then begin FCategory := Value; if BarManager.IsCustomizing and IsDesigning and not (IsLoading or IsDestroying) and not FCreatingBarItem then UpdateCustomizingBarItemsEx(Self, True); BarManager.DesignerModified; end; end; procedure TdxBarItem.SetDescription(Value: string); begin if FDescription <> Value then begin FDescription := Value; BarManager.UpdateItems(Self); end; end; procedure TdxBarItem.SetEnabled(Value: Boolean); begin if FEnabled <> Value then begin FEnabled := Value; if not IsLoading then EnabledChanged; end; end; procedure TdxBarItem.SetGlyph(Value: TBitmap); begin FGlyph.Assign(Value); end; procedure TdxBarItem.SetShortCut(Value: TShortCut); begin if FShortCut <> Value then begin FShortCut := Value; if not IsLoading then ShortCutChanged; end; end; procedure TdxBarItem.SetVisible(Value: TdxBarItemVisible); begin if IsLoading then FLoadedVisible := Value else if FVisible <> Value then begin FVisible := Value; VisibleChanged; end; end; procedure TdxBarItem.DestroyLinks; function HasItemLinkOnUnlockedBar: Boolean; var I: Integer; begin Result := False; for I := 0 to LinkCount - 1 do if (Links[I].BarControl is TdxBarControl) and not TdxBarControl(Links[I].BarControl).Bar.LockUpdate then begin Result := True; Break; end; end; var Item: TdxBarItemLink; APrevLockUpdate, ALock: Boolean; begin APrevLockUpdate := BarManager.LockUpdate; ALock := not BarManager.IsDestroying and HasItemLinkOnUnlockedBar; if ALock then BarManager.LockUpdate := True; try while LinkCount > 0 do begin Item := TdxBarItemLink(FLinks.Last); FLinks.Remove(Item); if Item <> nil then Item.Free; end; finally if ALock then BarManager.LockUpdate := APrevLockUpdate; end; end; procedure TdxBarItem.DoActionChange(Sender: TObject); begin if Sender = Action then ActionChange(Sender, False); end; function TdxBarItem.IsCaptionStored: Boolean; begin Result := (FActionLink = nil) or not FActionLink.IsCaptionLinked; end; function TdxBarItem.IsEnabledStored: Boolean; begin Result := (FActionLink = nil) or not FActionLink.IsEnabledLinked; end; function TdxBarItem.IsHelpContextStored: Boolean; begin Result := (ActionLink = nil) or not FActionLink.IsHelpContextLinked; end; function TdxBarItem.IsHintStored: Boolean; begin Result := (FActionLink = nil) or not FActionLink.IsHintLinked; end; function TdxBarItem.IsImageIndexStored: Boolean; begin Result := (FActionLink = nil) or not FActionLink.IsImageIndexLinked; end; function TdxBarItem.IsShortCutStored: Boolean; begin Result := (FActionLink = nil) or not FActionLink.IsShortCutLinked; end; function TdxBarItem.IsVisibleStored: Boolean; begin Result := (FActionLink = nil) or not FActionLink.IsVisibleLinked; end; function TdxBarItem.IsOnClickStored: Boolean; begin Result := (FActionLink = nil) or not FActionLink.IsOnExecuteLinked; end; function TdxBarItem.GetHintFromCaption: string; var P: Integer; begin Result := Caption; P := Pos('&', Result); if P > 0 then Delete(Result, P, 1); P := Pos('...', Result); if P > 0 then Delete(Result, P, 3); end; procedure TdxBarItem.OnGlyphChanged(Sender: TObject); begin GlyphChanged; end; procedure TdxBarItem.AssignTo(Dest: TPersistent); begin if Dest is TCustomAction then with TCustomAction(Dest) do begin Caption := Self.Caption; if Self is TdxBarButton then Checked := TdxBarButton(Self).Down; Enabled := Self.Enabled; HelpContext := Self.HelpContext; Hint := Self.Hint; ImageIndex := Self.ImageIndex; ShortCut := Self.ShortCut; case Self.Visible of ivNever: Visible := False; ivAlways: Visible := True; end; OnExecute := Self.OnClick; end else inherited AssignTo(Dest); end; procedure TdxBarItem.Loaded; begin inherited; if Action <> nil then ActionChange(Action, True); if Assigned(FOnCreate) then FOnCreate(Self); end; procedure TdxBarItem.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = Action) then Action := nil; end; procedure TdxBarItem.ReadState(Reader: TReader); begin inherited ReadState(Reader); if Reader.Parent is TdxBarManager then begin FBarManager := TdxBarManager(Reader.Parent); BarManagerChanged; end; end; procedure TdxBarItem.SetName(const NewName: TComponentName); begin inherited; UpdateCustomizingAllCommands; UpdateGroupItems; end; procedure TdxBarItem.ActionChange(Sender: TObject; CheckDefaults: Boolean); begin if Action is TCustomAction then with TCustomAction(Sender) do begin FCheckDefaults := CheckDefaults; try if not CheckDefaults or (Self.Caption = '') then Self.Caption := Caption; finally FCheckDefaults := False; end; if (Self is TdxBarButton) and (not CheckDefaults or (TdxBarButton(Self).Down = False)) then TdxBarButton(Self).Down := Checked; if not CheckDefaults or (Self.Enabled = True) then Self.Enabled := Enabled; if not CheckDefaults or (Self.HelpContext = 0) then Self.HelpContext := HelpContext; if not CheckDefaults or (Self.Hint = '') then Self.Hint := Hint; if not CheckDefaults or (Self.ActionImageIndex = -1) then Self.ActionImageIndex := ImageIndex; if not CheckDefaults or (Self.ShortCut = scNone) then Self.ShortCut := ShortCut; if not CheckDefaults or (Self.Visible = ivAlways) then Self.Visible := VisibleTodxBarVisible(Visible); if not CheckDefaults or not Assigned(Self.OnClick) then Self.OnClick := OnExecute; end; end; procedure TdxBarItem.AlignChanged; var I: Integer; begin if IsLoading then Exit; for I := 0 to LinkCount - 1 do with Links[I] do if Control <> nil then Control.AlignChanged; end; procedure TdxBarItem.BarManagerChanged; begin end; function TdxBarItem.CanClicked: Boolean; begin Result := True; end; procedure TdxBarItem.CaptionChanged; var I: Integer; begin for I := 0 to LinkCount - 1 do if not (udCaption in Links[I].UserDefine) and (Links[I].Control <> nil) then Links[I].Control.CaptionChanged; BarManager.UpdateItems(Self); end; procedure TdxBarItem.EnabledChanged; var I: Integer; begin for I := 0 to LinkCount - 1 do if Links[I].Control <> nil then Links[I].Control.EnabledChanged; end; function TdxBarItem.GetActionLinkClass: TdxBarItemActionLinkClass; begin Result := TdxBarItemActionLink; end; function TdxBarItem.GetActionImageIndex: Integer; begin Result := ImageIndex; end; procedure TdxBarItem.SetActionImageIndex(Value: Integer); begin ImageIndex := Value; end; function TdxBarItem.GetHidden: Boolean; begin Result := False; end; procedure TdxBarItem.GlyphChanged; var I: Integer; begin for I := 0 to LinkCount - 1 do if not (udGlyph in Links[I].UserDefine) and (Links[I].Control <> nil) then Links[I].Control.GlyphChanged; BarManager.UpdateItems(Self); end; function TdxBarItem.HasAccel(AItemLink: TdxBarItemLink): Boolean; begin Result := Enabled;//True end; function TdxBarItem.HasControls: Boolean; var I: Integer; begin Result := True; for I := 0 to LinkCount - 1 do if Links[I].Control <> nil then Exit; Result := False; end; procedure TdxBarItem.HideControl(AControl: TdxBarItemControl); begin end; procedure TdxBarItem.HotGlyphChanged; begin end; function TdxBarItem.ImageIndexLinked: Boolean; begin with BarManager do Result := (GetCurImages{Images} <> nil) and (0 <= ImageIndex) and (ImageIndex < GetCurImages{Images}.Count); end; function TdxBarItem.InternalActuallyVisible: Boolean; begin Result := True; end; function TdxBarItem.IsHintFromCaption: Boolean; begin Result := GetShortHint(Hint) = GetHintFromCaption; end; procedure TdxBarItem.LargeGlyphChanged; begin end; function TdxBarItem.NeedToBeHidden: Boolean; begin Result := False; end; procedure TdxBarItem.ObjectNotification(AOperation: TOperation; AObject: TObject); begin end; procedure TdxBarItem.SetImageIndex(Value: Integer); begin if FImageIndex <> Value then begin FImageIndex := Value; GlyphChanged; end; end; procedure TdxBarItem.ShortCutChanged; var I: Integer; begin for I := 0 to LinkCount - 1 do if Links[I].Control <> nil then Links[I].Control.ShortCutChanged; BarManager.UpdateItems(Self); end; procedure TdxBarItem.Update; var I: Integer; begin for I := 0 to LinkCount - 1 do if Links[I].Control <> nil then with Links[I].Control do if not IsSelected or not Parent.IsActive then Repaint; end; procedure TdxBarItem.UpdateEx; var I: Integer; begin for I := 0 to LinkCount - 1 do if Links[I].Control <> nil then with Links[I].Control do if not IsSelected or not Parent.IsActive then Parent.RepaintBar; end; function TdxBarItem.UseHotImages: Boolean; begin Result := False; end; function TdxBarItem.UseLargeImages: Boolean; begin Result := False; end; procedure TdxBarItem.VisibleChanged; var I: Integer; PrevLockUpdate: Boolean; begin if IsDesigning then Exit; PrevLockUpdate := BarManager.LockUpdate; BarManager.LockUpdate := True; try for I := 0 to LinkCount - 1 do begin Links[I].Owner.RefreshVisibilityLists; if ActuallyVisible then begin Links[I].BringToTopInRecentList(False); if Links[I].Control = nil then Links[I].CreateControl; if Links[I].Control <> nil then Links[I].Control.VisibleChanged; end else begin Links[I].SendToBottomInRecentList; if Links[I].Control <> nil then begin Links[I].Control.VisibleChanged; Links[I].DestroyControl; end; end; end; finally BarManager.LockUpdate := PrevLockUpdate; BarManager.UpdateItems(Self); end; end; procedure TdxBarItem.BeforeDestruction; begin inherited; if Assigned(FOnDestroy) then FOnDestroy(Self); InternalItemList.Remove(Self); DestroyLinks; end; procedure TdxBarItem.Click; begin if CanClicked then DirectClick; end; procedure TdxBarItem.DirectClick; begin if Enabled then try BarManager.DoClickItem(Self); DoClick; except Application.HandleException(Self); end; end; procedure TdxBarItem.DoClick; begin if Assigned(FOnClick) and ((Action = nil) or (@FOnClick <> @Action.OnExecute)) then FOnClick(Self) else if not IsDesigning and (FActionLink <> nil) then FActionLink.Execute{$IFDEF DELPHI6}(Self){$ENDIF}; end; function TdxBarItem.GetParentComponent: TComponent; begin if HasParent then Result := FBarManager else Result := nil; end; function TdxBarItem.HasParent: Boolean; begin Result := FCategory > -1; end; procedure TdxBarItem.SetParentComponent(AParent: TComponent); begin if not IsLoading then begin FBarManager := AParent as TdxBarManager; BarManagerChanged; end; end; function TdxBarItem.GetCurImages: TCurImageList; begin Result := BarManager.Images; end; { TdxBarWindowItem } function TdxBarWindowItem.GetCurText: string; begin if CurItemLink = nil then Result := Text else if CurItemLink.Control is TdxBarWinControl then Result := TdxBarWinControl(CurItemLink.Control).Text; end; function TdxBarWindowItem.GetFocusedItemLink: TdxBarItemLink; begin if (CurItemLink <> nil) and (CurItemLink.Control is TdxBarWinControl) and TdxBarWinControl(CurItemLink.Control).Focused then Result := CurItemLink else Result := nil; end; procedure TdxBarWindowItem.SetCurText(Value: string); begin if CurItemLink = nil then Text := Value else if CurItemLink.Control is TdxBarWinControl then TdxBarWinControl(CurItemLink.Control).Text := Value; end; function TdxBarWindowItem.CanClicked: Boolean; begin Result := False; end; procedure TdxBarWindowItem.Change; begin if not IsLoading and Assigned(FOnChange) then FOnChange(Self); end; procedure TdxBarWindowItem.CurChange; begin if Assigned(FOnCurChange) then FOnCurChange(Self); end; procedure TdxBarWindowItem.DoEnter; begin if Assigned(FOnEnter) then FOnEnter(Self); end; procedure TdxBarWindowItem.DoExit; begin if Assigned(FOnExit) then FOnExit(Self); end; procedure TdxBarWindowItem.KeyDown(var Key: Word; Shift: TShiftState); begin if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift); end; procedure TdxBarWindowItem.KeyPress(var Key: Char); begin if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key); end; procedure TdxBarWindowItem.KeyUp(var Key: Word; Shift: TShiftState); begin if Assigned(FOnKeyUp) then FOnKeyUp(Self, Key, Shift); end; procedure TdxBarWindowItem.SetText(Value: string); begin if FText <> Value then begin FText := Value; { if (CurItemLink <> nil) and (CurItemLink.Control is TdxBarWinControl) then TdxBarWinControl(CurItemLink.Control).Text := FText;} Update; Change; Update; end; end; procedure TdxBarWindowItem.SetFocus(ACheckBarControlVisibility: Boolean = False); var I: Integer; begin for I := 0 to LinkCount - 1 do with Links[I] do if Control is TdxBarWinControl and (not ACheckBarControlVisibility or IsWindowVisible(BarControl.Handle)) then begin (BarControl as TdxBarControl).BarGetFocus(Control); Control.Click(False); Break; end; end; { TdxBar } constructor TdxBar.Create(Collection: TCollection); begin inherited Create(Collection); FAlphaBlendValue := 255; FBackgroundBitmap := TBitmap.Create; FBackgroundBitmap.OnChange := BitmapChanged; FAllowClose := True; FAllowCustomizing := True; FAllowQuickCustomizing := True; FAllowReset := True; FBorderStyle := bbsSingle; FBars := TdxBars(Collection); FDockedDockingStyle := dsTop; FColor := clDefault; FFont := TFont.Create; FFont.Assign(BarManager.Font); FFont.OnChange := FontChanged; FFreeNotificationItems := TList.Create; FItemLinks := TdxBarItemLinks.Create(BarManager); FItemLinks.FOwner := Self; FItemLinks.OnChange := ItemLinksChanged; FRotateWhenVertical := True; FShowMark := True; FSizeGrip := True; FUseRecentItems := True; if not BarManager.IsLoading then begin if Assigned(BarManager.FOnBarAdd) then BarManager.FOnBarAdd(BarManager, Self); BarManager.DesignerModified; end; end; destructor TdxBar.Destroy; begin if not BarManager.IsDestroying then begin BarManager.DesignerModified; if Assigned(BarManager.FOnBarDelete) then BarManager.FOnBarDelete(BarManager, Self); end; Visible := False; MakeFreeNotification; FFreeNotificationItems.Free; with BarManager do if MainMenuBar = Self then FMainMenuBar := nil; FItemLinks.Destroy; FFont.Free; if FEditFontHandle <> 0 then DeleteObject(FEditFontHandle); FBackgroundBitmap.Free; FBackgroundBitmap := nil; inherited Destroy; end; procedure TdxBar.BitmapChanged(Sender: TObject); begin if Control <> nil then Control.RebuildBar; end; function TdxBar.GetBarManager: TdxBarManager; begin Result := TdxBars(Collection).BarManager; end; function TdxBar.GetControl: TdxBarControl; begin Result := TdxBarControl(ItemLinks.FBarControl); end; function TdxBar.GetDockedDockingStyle: TdxBarDockingStyle; begin if FDockedDockControl = nil then Result := FDockedDockingStyle else Result := FDockedDockControl.DockingStyle; end; function TdxBar.GetDockingStyle: TdxBarDockingStyle; begin if FDockControl = nil then Result := FDockingStyle else Result := FDockControl.DockingStyle; end; function TdxBar.GetRealDockControl: TdxDockControl; begin Result := FDockControl; if (Result = nil) and (FDockingStyle <> dsNone) then Result := FBars.FDockControls[FDockingStyle]; end; procedure TdxBar.SetAllowClose(Value: Boolean); begin if FAllowClose <> Value then begin FAllowClose := Value; if (DockingStyle = dsNone) and (Control <> nil) then Control.CaptionChanged; UpdateCustomizingBars(Self); end; end; procedure TdxBar.SetAllowQuickCustomizing(Value: Boolean); begin if FAllowQuickCustomizing <> Value then begin FAllowQuickCustomizing := Value; if Control <> nil then if DockingStyle = dsNone then Control.CaptionChanged else if BarManager.CanShowRecentItems then Control.RepaintBar; end; end; procedure TdxBar.SetAlphaBlendValue(Value: Byte); begin if FAlphaBlendValue <> Value then begin FAlphaBlendValue := Value; if (Control <> nil) and (Control.DockingStyle = dsNone) then Control.SetLayeredAttributes; end; end; procedure TdxBar.SetBackgroundBitmap(Value: TBitmap); var AChanged: Boolean; begin AChanged := not ((Value = nil) and FBackgroundBitmap.Empty); FBackgroundBitmap.Assign(Value); if AChanged then BitmapChanged(nil); end; procedure TdxBar.SetBorderStyle(Value: TdxBarBorderStyle); begin if FBorderStyle <> Value then begin FBorderStyle := Value; if Control <> nil then Control.RebuildBar; end; end; procedure TdxBar.SetCaption(Value: string); begin if FCaption <> Value then begin if BarManager.BarByCaption(Value) <> nil then Exit; FCaption := Value; if Control <> nil then Control.CaptionChanged; if (FName = '') and not BarManager.IsLoading then CheckBarName(Value); UpdateCustomizingBars(Self); BarManager.DesignerModified; end; end; procedure TdxBar.SetColor(Value: TColor); begin if FColor <> Value then begin FColor := Value; if Control <> nil then Control.RebuildBar; end; end; procedure TdxBar.SetDockControl(Value: TdxBarDockControl); var PrevDockingStyle: TdxBarDockingStyle; NeedHiding: Boolean; begin if (Value <> nil) and (Value.BarManager <> BarManager) then Exit; if FDockControl <> Value then begin if BarManager.IsLoading then begin FLoadedDockControl := Value; Exit; end; PrevDockingStyle := DockingStyle; NeedHiding := not FChangingDockingStyle and (Control <> nil); if NeedHiding then if Value = nil then // NeedHiding := (DockingStyle <> dsNone) and (Control.DockControl <> Value) NeedHiding := (DockingStyle <> dsNone) and not ((Control.DockControl <> nil) and Control.DockControl.Main) else NeedHiding := Control.DockControl <> Value; if NeedHiding then Visible := False; FDockControl := Value; ItemLinks.RecentItemCount := -1; if not FChangingDockingStyle then begin FChangingDockingStyle := True; try if Value = nil then DockingStyle := PrevDockingStyle//dsNone else DockingStyle := Value.DockingStyle; finally FChangingDockingStyle := False; end; end; if NeedHiding then Visible := True; if Control <> nil then Control.DockControl := RealDockControl; if not FChangingDockingStyle then BarManager.DoBarDockingStyleChanged(Self); end; end; procedure TdxBar.SetDockedDockControl(Value: TdxBarDockControl); begin if (Value <> nil) and (Value.BarManager <> BarManager) then Exit; if FDockedDockControl <> Value then begin FDockedDockControl := Value; BarManager.DesignerModified; end; end; procedure TdxBar.SetDockedValue(Index: Integer; Value: Integer); var PrevValue: Integer; begin if Value < 0 then Value := 0; PrevValue := 0; case Index of 1: PrevValue := FDockedLeft; 2: PrevValue := FDockedTop; end; if PrevValue <> Value then begin case Index of 1: FDockedLeft := Value; 2: FDockedTop := Value; end; BarManager.DesignerModified; end; end; procedure TdxBar.SetDockingStyle(Value: TdxBarDockingStyle); var ControlExists: Boolean; begin if FDockingStyle <> Value then begin if BarManager.IsLoading then begin FLoadedDockingStyle := Value; Exit; end; ControlExists := not FChangingDockingStyle and (Control <> nil) and (Control.DockingStyle <> Value); if ControlExists then Visible := False; FDockingStyle := Value; if not FChangingDockingStyle then begin FChangingDockingStyle := True; try DockControl := nil; finally FChangingDockingStyle := False; end; end; ItemLinks.RecentItemCount := -1; if ControlExists then begin Visible := True; Control.DockingStyle := Value; end; if not FChangingDockingStyle then BarManager.DoBarDockingStyleChanged(Self); end; end; procedure TdxBar.SetFloatValue(Index: Integer; Value: Integer); var PrevValue: Integer; begin PrevValue := 0; case Index of 1: PrevValue := FFloatLeft; 2: PrevValue := FFloatTop; 3: PrevValue := FFloatClientWidth; 4: PrevValue := FFloatClientHeight; end; if PrevValue <> Value then begin case Index of 1: FFloatLeft := Value; 2: FFloatTop := Value; 3: FFloatClientWidth := Value; 4: FFloatClientHeight := Value; end; BarManager.DesignerModified; end; end; procedure TdxBar.SetFont(Value: TFont); begin FFont.Assign(Value); end; procedure TdxBar.SetHidden(Value: Boolean); begin if FHidden <> Value then begin FHidden := Value; BarManager.DesignerModified; end; end; procedure TdxBar.SetIsMainMenu(Value: Boolean); var PrevLockUpdate: Boolean; begin if FIsMainMenu <> Value then begin PrevLockUpdate := BarManager.LockUpdate; BarManager.LockUpdate := True; try if Value and (BarManager.MainMenuBar <> nil) then BarManager.MainMenuBar.IsMainMenu := False; FIsMainMenu := Value; if Value then begin BarManager.FMainMenuBar := Self; WholeRow := True; MultiLine := True; end else begin BarManager.FMainMenuBar := nil; MultiLine := False; WholeRow := False; end; if BarManager.IsLoading then Exit; if Control <> nil then if FDockingStyle = dsNone then Control.CaptionChanged else Control.RepaintBar; UpdateCustomizingBars(Self); finally BarManager.LockUpdate := PrevLockUpdate; end; end; end; procedure TdxBar.SetItemLinks(Value: TdxBarItemLinks); begin FItemLinks.Assign(Value); end; procedure TdxBar.SetLockUpdate(Value: Boolean); begin if FLockUpdate <> Value then begin FLockUpdate := Value; if not FLockUpdate and (Control <> nil) then Control.RepaintBar; end; end; procedure TdxBar.SetMultiLine(Value: Boolean); begin if (FMultiLine <> Value) and (Value or not IsMainMenu) then begin FMultiLine := Value; if (Control <> nil) and (DockingStyle <> dsNone) then Control.RepaintBar; end; end; procedure TdxBar.SetNotDocking(Value: TdxBarDockingStyles); begin if FNotDocking <> Value then begin FNotDocking := Value; if Control <> nil then Control.RepaintBar; end; end; procedure TdxBar.SetRotateWhenVertical(Value: Boolean); begin if FRotateWhenVertical <> Value then begin FRotateWhenVertical := Value; if Control <> nil then Control.Perform(CM_FONTCHANGED, 0, 0); end; end; procedure TdxBar.SetRow(Value: Integer); begin if Value < 0 then Value := 0; FRow := Value; end; procedure TdxBar.SetShowMark(Value: Boolean); begin if FShowMark <> Value then begin FShowMark := Value; if Control <> nil then Control.RepaintBar; end; end; procedure TdxBar.SetSizeGrip(Value: Boolean); begin if FSizeGrip <> Value then begin FSizeGrip := Value; if IsStatusBar and (Control <> nil) then Control.RebuildBar; end; end; procedure TdxBar.SetUseOwnFont(Value: Boolean); begin if FUseOwnFont <> Value then begin FUseOwnFont := Value; FInternalFontChange := True; try if FUseOwnFont then FontChanged(nil) else begin Font := BarManager.Font; DeleteObject(FEditFontHandle); FEditFontHandle := 0; end; finally FInternalFontChange := False; end; end; end; procedure TdxBar.SetUseRecentItems(Value: Boolean); begin if FUseRecentItems <> Value then begin FUseRecentItems := Value; FItemLinks.FUseRecentItems := FUseRecentItems; if Control <> nil then Control.RepaintBar; end; end; procedure TdxBar.SetUseRestSpace(Value: Boolean); begin if FUseRestSpace <> Value then begin FUseRestSpace := Value; if Control <> nil then Control.RepaintBar; end; end; procedure TdxBar.SetVisible(Value: Boolean); var P: TPoint; begin if Value and BarManager.IsDestroying then Exit; if not FVisible and not Value then BarManager.RemoveBarFromRestoringList(Self); if FVisible <> Value then begin FInternallyHidden := False; if BarManager.IsLoading then begin FLoadedVisible := Value; Exit; end; if not Value and (Control <> nil) then Control.SavePos; FVisible := Value; if FVisible then begin FItemLinks.CreateBarControl; if DockingStyle <> dsNone then begin Control.BeginInternal; try Control.ChangeStyleWinTo(DockingStyle, RealDockControl); P := Point(DockedLeft, DockedTop); Windows.ClientToScreen(RealDockControl.Handle, P); FBars.RegInDock(DockingStyle, RealDockControl, Control, P); finally Control.EndInternal; end; ShowWindow(Control.Handle, SW_SHOWNA); end else begin Control.BeginInternal; try Control.ChangeStyleWinTo(DockingStyle, nil); finally Control.EndInternal; end; P := Control.GetTrackSize(DockingStyle); Control.SetBounds(FloatLeft, FloatTop, P.X, P.Y); with BarManager do if IsWindowVisible(MainForm.Handle) and (not HideFloatingBarsWhenInactive or (MainForm.Handle = GetActiveWindow) or (TDummyForm(MainForm).FormStyle = fsMDIChild) and (Application.MainForm.Handle = GetActiveWindow) and (HWND(SendMessage(TDummyForm(Application.MainForm).ClientHandle, WM_MDIGETACTIVE, 0, 0)) = MainForm.Handle) or FIsCustomizing) then ShowWindow(Control.Handle, SW_SHOWNA); end; BarManager.RemoveBarFromRestoringList(Self); end else // Visible = False Control.Free; if not BarManager.IsDestroying then begin if BarManager.FIsCustomizing and not BarManager.FChangingStyle then UpdateCustomizingBars(Self); if Assigned(BarManager.FOnBarVisibleChange) then BarManager.FOnBarVisibleChange(BarManager, Self); end; end; end; procedure TdxBar.SetWholeRow(Value: Boolean); begin if FWholeRow <> Value then begin FWholeRow := Value; if (Control <> nil) and (DockingStyle <> dsNone) then begin Visible := False; Visible := True; end; end; end; procedure TdxBar.FontChanged(Sender: TObject); begin if not FInternalFontChange then FUseOwnFont := True; if FUseOwnFont then CreateEditFontHandle(FFont, FEditFontHandle, False); if Control <> nil then begin Control.Font := FFont; Control.Perform(CM_FONTCHANGED, 0, 0); end; end; procedure TdxBar.ItemLinksChanged(Sender: TObject); begin BarManager.DesignerModified; end; procedure TdxBar.ResetToolbarClick(Sender: TObject); begin ResetWithConfirmation; end; function TdxBar.IsDockedDockingStyleStored: Boolean; begin Result := FDockedDockControl = nil; end; function TdxBar.IsDockingStyleStored: Boolean; begin Result := FDockControl = nil; end; procedure TdxBar.AddFreeNotification(AItem: TdxBarItem); begin FFreeNotificationItems.Add(AItem); end; procedure TdxBar.RemoveFreeNotification(AItem: TdxBarItem); begin FFreeNotificationItems.Remove(AItem); end; procedure TdxBar.MakeFreeNotification; var I: Integer; begin for I := FFreeNotificationItems.Count - 1 downto 0 do TdxBarItem(FFreeNotificationItems[I]).ObjectNotification(opRemove, Self); end; procedure TdxBar.CheckBarName(const AName: string); function IsNameValid: Boolean; var ABar: TdxBar; begin Result := AName = ''; if not Result then begin ABar := BarManager.BarByName(AName); Result := (ABar = nil) or (ABar = Self); end; end; begin if IsNameValid then FName := AName else FName := Bars.GetUniqueToolbarName(AName); end; function TdxBar.BarNCSizeX(AStyle: TdxBarDockingStyle): Integer; var R: TRect; begin if AStyle = dsNone then begin Result := 2 * BarManager.BorderSizeX; Inc(Result, 2 * BarManager.PainterClass.BarHorSize); end else if FBorderStyle = bbsSingle then begin BarManager.PainterClass.BarBorderSizes(Self, AStyle, R); Result := R.Left + R.Right; if AStyle in [dsTop, dsBottom] then Inc(Result, BarManager.FingersSize(Self)); end else begin Result := 0; if HasSizeGrip then Inc(Result, BarManager.PainterClass.StatusBarGripSize(BarManager).cx); end; end; function TdxBar.BarNCSizeY(AStyle: TdxBarDockingStyle): Integer; var R: TRect; begin if AStyle = dsNone then begin Result := 2 * BarManager.BorderSizeY + BarManager.PainterClass.BarCaptionAreaSize; Inc(Result, BarManager.PainterClass.BarTopSize); Inc(Result, BarManager.PainterClass.BarBottomSize); end else if FBorderStyle = bbsSingle then begin BarManager.PainterClass.BarBorderSizes(Self, AStyle, R); Result := R.Top + R.Bottom; if AStyle in [dsLeft, dsRight] then Inc(Result, BarManager.FingersSize(Self)); end else begin Result := 0; if IsStatusBar then Inc(Result, BarManager.PainterClass.StatusBarTopBorderSize(BarManager)); end; end; function TdxBar.CanClose: Boolean; begin Result := FAllowClose and not FIsMainMenu and ((Control = nil) or Control.FHasCaption); end; function TdxBar.CanMoving: Boolean; const AllDockingStyles = [Low(TdxBarDockingStyle)..High(TdxBarDockingStyle)]; begin Result := (NotDocking <> AllDockingStyles) and (BarManager.NotDocking <> AllDockingStyles); end; function TdxBar.CanReset: Boolean; begin Result := FIsPredefined and FAllowReset; end; function TdxBar.HasSizeGrip: Boolean; var Parent: HWND; R, CR: TRect; function IsBottom(Control: HWND): Boolean; begin Parent := GetParent(Control); Result := (Parent = 0) or (FindControl(Control) is TCustomForm) and (TDummyForm(FindControl(Control)).FormStyle = fsMDIChild); if not Result then begin GetWindowRect(Control, R); MapWindowPoints(0, Parent, R, 2); GetClientRect(Parent, CR); Result := (R.Bottom = CR.Bottom) and IsBottom(Parent); end; end; begin Result := IsStatusBar and FSizeGrip and not IsZoomed(BarManager.MainForm.Handle) and ((Control = nil) or IsBottom(Control.Handle)); end; function TdxBar.IsShortCut(AShortCut: TShortCut): Boolean; begin Result := FItemLinks.IsShortCut(AShortCut); end; function TdxBar.IsStatusBar: Boolean; begin Result := (FBorderStyle = bbsNone) and (DockingStyle = dsBottom) and WholeRow; // !!! end; procedure TdxBar.Assign(Source: TPersistent); var Bar: TdxBar; begin if Source is TdxBar then begin Bar := TdxBar(Source); AllowClose := Bar.AllowClose; AllowCustomizing := Bar.AllowCustomizing; AllowQuickCustomizing := Bar.AllowQuickCustomizing; AllowReset := Bar.AllowReset; BorderStyle := Bar.BorderStyle; Caption := Bar.Caption; if csUpdating in BarManager.ComponentState then CheckBarName(Bar.Name); DockedDockControl := Bar.DockedDockControl; DockedDockingStyle := Bar.DockedDockingStyle; DockedLeft := Bar.DockedLeft; DockedTop := Bar.DockedTop; FloatLeft := Bar.FloatLeft; FloatTop := Bar.FloatTop; FloatClientWidth := Bar.FloatClientWidth; FloatClientHeight := Bar.FloatClientHeight; Hidden := Bar.Hidden; IsMainMenu := Bar.IsMainMenu; ItemLinks := Bar.ItemLinks; NotDocking := Bar.NotDocking; OneOnRow := Bar.OneOnRow; RotateWhenVertical := Bar.RotateWhenVertical; Row := Bar.Row; ShowMark := Bar.ShowMark; SizeGrip := Bar.SizeGrip; WholeRow := Bar.WholeRow; ChangeDockingStyle(Bar.DockingStyle, Bar.DockControl); UseRecentItems := Bar.UseRecentItems; UseRestSpace := Bar.UseRestSpace; Color := Bar.Color; Font := Bar.Font; UseOwnFont := Bar.UseOwnFont; Visible := Bar.Visible; end else inherited Assign(Source); end; procedure TdxBar.ChangeDockingStyle(AStyle: TdxBarDockingStyle; ADockControl: TdxDockControl); begin if (ADockControl <> nil) and ADockControl.Main then ADockControl := nil; if DockingStyle = AStyle then DockControl := TdxBarDockControl(ADockControl) else if DockControl = ADockControl then DockingStyle := AStyle else if ADockControl = nil then DockingStyle := AStyle else DockControl := TdxBarDockControl(ADockControl); end; procedure TdxBar.Reset; var PrevLockUpdate, PrevVisible: Boolean; TempForm: TForm; TempBarManager: TdxBarManager; procedure CheckItemLinks(AItemLinks: TdxBarItemLinks); var I: Integer; Item: TCustomdxBarSubItem; TempItem: TdxBarItem; begin for I := 0 to AItemLinks.Count - 1 do if AItemLinks[I].Item is TCustomdxBarSubItem then begin Item := TCustomdxBarSubItem(AItemLinks[I].Item); TempItem := TempBarManager.GetItemByName(Item.Name); if TempItem is TCustomdxBarSubItem then begin Item.ItemLinks.Assign(TCustomdxBarSubItem(TempItem).ItemLinks); Item.ItemLinks.AssignUsageData(TCustomdxBarSubItem(TempItem).ItemLinks); CheckItemLinks(Item.ItemLinks); end; end; end; begin TempForm := BarManager.LoadMainFormFromBin; if TempForm <> nil then try TempBarManager := TdxBarManager(TempForm.FindComponent(BarManager.Name)); if (TempBarManager <> nil) and (Index < TempBarManager.Bars.Count) then begin BarManager.DoBarBeforeReset(Self); if BarManager.UseFullReset then begin PrevLockUpdate := BarManager.LockUpdate; BarManager.LockUpdate := True; PrevVisible := Visible; Visible := False; ResettingToolbar := True; try Assign(TempBarManager.Bars[Index]); ItemLinks.AssignUsageData(TempBarManager.Bars[Index].ItemLinks); CheckItemLinks(ItemLinks); finally ResettingToolbar := False; Visible := PrevVisible; BarManager.LockUpdate := PrevLockUpdate; end; end else begin PrevLockUpdate := LockUpdate; LockUpdate := True; ResettingToolbar := True; try ItemLinks.Assign(TempBarManager.Bars[Index].ItemLinks); ItemLinks.AssignUsageData(TempBarManager.Bars[Index].ItemLinks); CheckItemLinks(ItemLinks); finally ResettingToolbar := False; LockUpdate := PrevLockUpdate; end; end; BarManager.DoBarAfterReset(Self); end; finally TempForm.Free; end; end; procedure TdxBar.ResetWithConfirmation; begin if Application.MessageBox(PChar(Format(cxGetResourceString(@dxSBAR_WANTTORESETTOOLBAR), [Caption])), PChar(Application.Title), MB_OKCANCEL or MB_ICONEXCLAMATION) = ID_OK then Reset; end; { TdxBars } constructor TdxBars.Create(ABarManager: TdxBarManager); var ADockingStyle: TdxBarDockingStyle; begin inherited Create(TdxBar); FBarManager := ABarManager; FDockingZoneSize := MinToolbarSize; for ADockingStyle := dsLeft to dsBottom do begin FDockControls[ADockingStyle] := TdxDockControl.CreateEx(nil, FBarManager, ADockingStyle); FDockControls[ADockingStyle].Parent := FBarManager.MainForm; end; end; destructor TdxBars.Destroy; var I: TdxBarDockingStyle; begin for I := dsLeft to dsBottom do if FDockControls[I] <> nil then FDockControls[I].Free; inherited; end; function TdxBars.GetDockControl(Index: TdxBarDockingStyle): TdxDockControl; begin Result := FDockControls[Index]; end; function TdxBars.GetItem(Index: Integer): TdxBar; begin Result := TdxBar(inherited Items[Index]); end; procedure TdxBars.SetItem(Index: Integer; Value: TdxBar); begin Items[Index].Assign(Value); end; function TdxBars.GetOwner: TPersistent; begin Result := FBarManager; end; procedure TdxBars.RegInDock(AStyle: TdxBarDockingStyle; ADockControl: TdxDockControl; ABarControl: TdxBarControl; APos: TPoint); begin if ADockControl <> nil then ADockControl.AddBarControl(ABarControl, APos, True) else if (AStyle <> dsNone) and (FDockControls[AStyle] <> nil) then FDockControls[AStyle].AddBarControl(ABarControl, APos, True); end; procedure TdxBars.UnregFromDock(AStyle: TdxBarDockingStyle; ADockControl: TdxDockControl; ABarControl: TdxBarControl); begin if ADockControl <> nil then ADockControl.DeleteBarControl(ABarControl, nil, True) else if (AStyle <> dsNone) and (FDockControls[AStyle] <> nil) then FDockControls[AStyle].DeleteBarControl(ABarControl, nil, True); end; procedure DockTimerProc(Wnd: HWND; Msg: UINT; idEvent: UINT; Time: DWORD); stdcall; var P: TPoint; begin KillTimer(0, FDockTimerID); FDockTimerID := 0; if FDockBarManager <> nil then with FDockBarManager.Bars do begin GetCursorPos(P); Inc(P.X, FMovingOffset.X); Inc(P.Y, FMovingOffset.Y); FDocking := True; ChangeBarControlPos(FMovingBarControl, P); FDocking := False; FDockBarManager := nil; end; end; procedure TdxBars.ChangeBarControlPos(ABarControl: TdxBarControl; APos: TPoint); var AStyle: TdxBarDockingStyle; ADockControl: TdxDockControl; ASize: TPoint; begin AStyle := GetDockingStyleAtPos(ABarControl.Bar, APos, ADockControl); if not FBarManager.DoDocking(ABarControl.Bar, AStyle, ADockControl) then Exit; if not FDocking and (ABarControl.DockingStyle = dsNone) and (AStyle <> dsNone) then begin if FDockTimerID > 0 then KillTimer(0, FDockTimerID); FDockBarManager := BarManager; FDockTimerID := SetTimer(0, 0, BarManager.WaitForDockingTime, @DockTimerProc); ADockControl := nil; AStyle := dsNone; end; if AStyle = dsNone then begin Dec(APos.X, FMovingOffset.X); Dec(APos.Y, FMovingOffset.Y); end; if (ABarControl.DockingStyle <> AStyle) or (ABarControl.DockControl <> ADockControl) then begin SetWindowPos(ABarControl.Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_HIDEWINDOW or SWP_NOACTIVATE); if ABarControl.DockingStyle <> dsNone then begin UnregFromDock(ABarControl.DockingStyle, ABarControl.DockControl, ABarControl); ABarControl.ItemLinks.RecentItemCount := -1; end; if AStyle <> dsNone then begin with ABarControl do begin BeginInternal; //!!! try ChangeStyleWinTo(AStyle, ADockControl); finally EndInternal; end; end; RegInDock(AStyle, ADockControl, ABarControl, APos); end else with ABarControl do begin BeginInternal; // for WMSize try ChangeStyleWinTo(AStyle, nil); finally EndInternal; end; ASize := GetTrackSize(AStyle); with GetDragPointOffset(AStyle) do SetWindowPos(Handle, 0, APos.X - X, APos.Y - Y, ASize.X, ASize.Y, SWP_NOZORDER or SWP_NOACTIVATE); end; Windows.ShowWindow(ABarControl.Handle, SW_SHOWNA); end else if ABarControl.DockingStyle <> dsNone then ADockControl.MoveBarControl(ABarControl, APos) else with ABarControl, GetDragPointOffset(AStyle) do SetWindowPos(Handle, 0, APos.X - X, APos.Y - Y, 0, 0, SWP_NOZORDER or SWP_NOSIZE or SWP_NOACTIVATE); end; function TdxBars.GetDockingStyleAtPos(Bar: TdxBar; Pos: TPoint; var DockControl: TdxDockControl): TdxBarDockingStyle; var ADockControl: TdxDockControl; function PtInControlRect(ADockControl: TWinControl; const R: TRect; P: TPoint): Boolean; var AParent: TWinControl; begin Result := PtInRect(R, P); if Result and ADockControl.HandleAllocated and (ADockControl.Parent <> nil) and (ADockControl.Parent.Parent <> nil) then begin AParent := ADockControl.Parent.Parent; P := AParent.ScreenToClient(P); Result := ADockControl.Parent.Handle = ChildWindowFromPointEx(AParent.Handle, P, CWP_SKIPINVISIBLE); end; end; function CheckDockZone(ADockingStyle: TdxBarDockingStyle): Boolean; var I: Integer; begin Result := False; for I := 0 to FBarManager.DockControlCount - 1 do begin ADockControl := FBarManager.DockControls[I]; with ADockControl do if (DockingStyle = ADockingStyle) and (CanFocus or BarManager.Designing) then begin Result := FBarManager.DoDocking(Bar, ADockingStyle, ADockControl) and PtInControlRect(ADockControl, GetDockZoneBounds, Pos); if Result then Break; end; end; if Result then begin DockControl := ADockControl; GetDockingStyleAtPos := ADockingStyle; end; end; begin DockControl := nil; Result := dsNone; if FMoving and (GetAsyncKeyState(VK_CONTROL) < 0) then Exit; if CheckDockZone(dsLeft) then Exit; if CheckDockZone(dsRight) then Exit; if CheckDockZone(dsTop) then Exit; if CheckDockZone(dsBottom) then Exit; if FMoving then begin Dec(Pos.X, FMovingOffset.X); Dec(Pos.Y, FMovingOffset.Y); end; if CheckDockZone(dsLeft) then Exit; if CheckDockZone(dsRight) then Exit; if CheckDockZone(dsTop) then Exit; if CheckDockZone(dsBottom) then Exit; end; procedure TdxBars.Moving(AMovingBarControl: TdxBarControl); var CaptureWnd: HWND; Msg: TMsg; PrevP, CalcP, P: TPoint; begin // --- if not AMovingBarControl.Bar.CanMoving then Exit; with AMovingBarControl, Bar do if DockingStyle <> dsNone then GetDockCol.FPos := Point(DockedLeft, DockedTop); FMoving := True; AMovingBarControl.Moving := True; GetCursorPos(PrevP); FMovingBarOriginalDockingStyle := FMovingBarControl.DockingStyle; FMovingOffset := Point(0, 0); FMovingStaticOffset := Point(0, 0); with FMovingBarControl, FBar do if DockingStyle <> dsNone then begin P := GetDockCol.Pos; Windows.ClientToScreen(RealDockControl.Handle, P); RealDockControl.DeleteBarControl(Control, nil, False); CalcP := PrevP; RealDockControl.GetPosForRow(Row, OneOnRow, CalcP); if Control.Vertical then FMovingOffset.X := CalcP.X - PrevP.X else FMovingOffset.Y := CalcP.Y - PrevP.Y; Control.BeginInternal; try RealDockControl.AddBarControl(Control, P, False); finally Control.EndInternal; end; FMovingStaticOffset := Point(Left, Top); Windows.ClientToScreen(RealDockControl.Handle, FMovingStaticOffset); with FMovingStaticOffset do begin X := PrevP.X - X; Y := PrevP.Y - Y; end; end; ProcessPaintMessages; CaptureWnd := BarManager.GetWindowForMouseCapturing; SetCapture(CaptureWnd); try while GetCapture = CaptureWnd do begin case Integer(GetMessage(Msg, 0, 0, 0)) of -1: Break; 0: begin PostQuitMessage(Msg.wParam); Break; end; end; with Msg do if ((message = WM_KEYDOWN) or (message = WM_KEYUP)) and (wParam = VK_CONTROL) then begin message := WM_MOUSEMOVE; hwnd := 0; GetCursorPos(P); lParam := Windows.LPARAM(PointToSmallPoint(P)); PrevP := Point(-1, -1); end; case Msg.message of WM_KEYDOWN, WM_KEYUP: if Msg.wParam = VK_ESCAPE then Break; WM_MOUSEMOVE: begin P := SmallPointToPoint(TSmallPoint(Msg.lParam)); ClientToScreen(Msg.hwnd, P); if (P.X <> PrevP.X) or (P.Y <> PrevP.Y) then begin CalcP := P; Inc(CalcP.X, FMovingOffset.X); Inc(CalcP.Y, FMovingOffset.Y); ChangeBarControlPos(FMovingBarControl, CalcP); //ProcessPaintMessages; PrevP := P; end; end; WM_LBUTTONUP: Break; else TranslateMessage(Msg); DispatchMessage(Msg); end; end; finally if FDockTimerID > 0 then begin KillTimer(0, FDockTimerID); FDockTimerID := 0; FDockBarManager := nil; end; if GetCapture = CaptureWnd then ReleaseCapture; AMovingBarControl := FMovingBarControl; FMovingBarControl.Moving := False; if AMovingBarControl.DockingStyle <> dsNone then AMovingBarControl.DockControl.AssignPositions; FMoving := False; end; end; procedure TdxBars.Update(Item: TCollectionItem); begin // BarManager.DesignerModified; <- end; function TdxBars.Add: TdxBar; begin Result := TdxBar(inherited Add); end; function TdxBars.GetUniqueToolbarName(const BaseName: string): string; var I: Integer; begin I := 0; repeat Inc(I); Result := BaseName + IntToStr(I); until BarManager.BarByName(Result) = nil; end; { TdxBarControl } constructor TdxBarControl.CreateEx(AOwner: TComponent; ABar: TdxBar); begin inherited Create(AOwner); FBar := ABar; FHasCaption := True; end; destructor TdxBarControl.Destroy; begin Destroying; if (FBar <> nil) and (FBar.FBars <> nil) and (DockingStyle <> dsNone) then FBar.FBars.UnregFromDock(FDockingStyle, FDockControl, Self); if WindowHandle = 0 then DestroyControls else DestroyHandle; inherited Destroy; end; function TdxBarControl.GetCaptionBkColor: COLORREF; begin Result := PainterClass.BarCaptionBkColor(Self, BarManager.MainFormActive); end; function TdxBarControl.GetCaptionColor: COLORREF; begin Result := PainterClass.BarCaptionColor(Self); end; function TdxBarControl.GetHorizontal: Boolean; begin Result := DockingStyle in [dsTop, dsBottom]; end; function TdxBarControl.GetInternallyLocked: Boolean; begin Result := FInternalLockCount <> 0; end; function TdxBarControl.GetMultiLine: Boolean; begin Result := (DockingStyle = dsNone) or FBar.MultiLine; end; function TdxBarControl.GetVertical: Boolean; begin Result := DockingStyle in [dsLeft, dsRight]; end; procedure TdxBarControl.SetCloseButtonState(Value: TdxBarMarkState); var DC: HDC; begin if FCloseButtonState <> Value then begin FCloseButtonState := Value; if HandleAllocated then begin DC := GetWindowDC(Handle); DrawCloseButton(DC); ReleaseDC(Handle, DC); end; end; end; procedure TdxBarControl.SetMoving(Value: Boolean); var I: Integer; KillingHandle: HWND; begin if FMoving <> Value then begin FMovingChanging := True; try FMoving := Value; if Value then FBar.Bars.FMovingBarControl := Self else FBar.Bars.FMovingBarControl := nil; // SetCursorForMoving(Value); for I := 0 to ItemLinks.CanVisibleItemCount - 1 do if ItemLinks.CanVisibleItems[I].Control.HasWindow then with TdxBarWinControl(ItemLinks.CanVisibleItems[I].Control) do if FMoving then DestroyWindowHandle else CreateWindowHandle; if FMoving then begin if FDockingStyle = dsNone then begin FFloatingHandle := Handle; FDockingStyle := dsLeft; FDockControl := FBar.FBars.FDockControls[dsLeft]; DestroyControls; WindowHandle := 0; CreateHandle; FDockedHandle := Handle; WindowHandle := 0; FDockingStyle := Bar.DockingStyle; FDockControl := nil; BeginInternal; try CreateHandle; finally EndInternal; end; Windows.SetParent(FDockedHandle, 0); end else begin FDockedHandle := Handle; FDockingStyle := dsNone; DestroyControls; WindowHandle := 0; CreateHandle; FFloatingHandle := Handle; WindowHandle := 0; FDockingStyle := Bar.DockingStyle; BeginInternal; try CreateHandle; finally EndInternal; end; end; // this code creates problems with other relative popups // SetWindowPos(FFloatingHandle, HWND_TOPMOST, 0, 0, 0, 0, // SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); end else begin // this code makes top-most windows normal //SetWindowPos(FFloatingHandle, HWND_NOTOPMOST, 0, 0, 0, 0, // SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); if FDockingStyle = dsNone then KillingHandle := FDockedHandle else KillingHandle := FFloatingHandle; SetWindowLong(KillingHandle, GWL_WNDPROC, Longint(DefWndProc)); DestroyWindow(KillingHandle); SavePos; end; SetCursorForMoving(Value); Perform(WM_SIZE, 0, 0); // to store normal size RepaintBar; finally FMovingChanging := False; end; end; end; procedure TdxBarControl.CalcControlsPositions; var I, FirstInRow, X, Y, ARowHeight, ABeginGroupSize, Size, VerSize, AWidth, AHeight: Integer; AMultiLine, AVertical, ItemControlAlignApplied: Boolean; AItemLink: TdxBarItemLink; procedure InitValues; begin ItemLinks.EmptyItemRects; X := 0; Y := 0; VerSize := 0; AItemLink := nil; AMultiLine := MultiLine; AVertical := Vertical; if AMultiLine then begin if AVertical then begin Size := ClientHeight; VerSize := ClientWidth; end else Size := ClientWidth; if MarkExists and (DockingStyle <> dsNone) then Dec(Size, MarkSizeX); ARowHeight := 0; FirstInRow := 0; end else if AVertical then begin Size := ClientHeight - Byte(MarkExists) * MarkSizeX - Byte(MDIButtonsOnBar) * GetMDIHeight; ARowHeight := ClientWidth; end else begin Size := ClientWidth - Byte(MarkExists) * MarkSizeX - Byte(MDIButtonsOnBar) * GetMDIWidth; ARowHeight := ClientHeight; end; end; procedure InitItemControlValues; begin with AItemLink.Control do begin FLastInRow := False; if AVertical then begin AWidth := Height; AHeight := Width; end else begin AWidth := Width; AHeight := Height; end; end; if AItemLink.BeginGroup and (X > 0) then ABeginGroupSize := BeginGroupSize else ABeginGroupSize := 0; end; function ItemControlBreaksRow: Boolean; begin Result := (X > 0) and (X + ABeginGroupSize + AWidth > Size) or AMultiLine and AItemLink.Control.FBreakingRow; end; procedure ArrangeControlsOnRow(const LastInRow: Integer); var I: Integer; begin for I := FirstInRow to LastInRow do with ItemLinks.VisibleItems[I], ItemRect do begin if AVertical then OffsetRect(FItemRect, -(ARowHeight - (Right - Left)) div 2, 0) else OffsetRect(FItemRect, 0, (ARowHeight - (Bottom - Top)) div 2); RowHeight := ARowHeight; end; FirstInRow := LastInRow + 1; end; function GetItemControlRect: TRect; procedure ApplyAlign; procedure CheckSize; var AMDISize: Integer; begin if AMultiLine and (AItemLink.Control.Align <> iaLeft) and MDIButtonsOnBar then begin if AVertical then AMDISize := GetMDIHeight else AMDISize := GetMDIWidth; if Result.Right + AMDISize <= Size then Dec(Size, AMDISize); end; end; begin CheckSize; ItemControlAlignApplied := True; case AItemLink.Control.Align of iaLeft: ItemControlAlignApplied := False; iaCenter: if AVertical then OffsetRect(Result, 0, (Size - Result.Bottom) div 2) else OffsetRect(Result, (Size - Result.Right) div 2, 0); iaRight: if AVertical then OffsetRect(Result, 0, Size - Result.Bottom) else OffsetRect(Result, Size - Result.Right, 0); iaClient: with Result do if AVertical then begin Bottom := Size; if Bottom - Top < AItemLink.Control.MinWidth then Bottom := Top + AItemLink.Control.MinWidth; end else begin Right := Size; if Right - Left < AItemLink.Control.MinWidth then Right := Left + AItemLink.Control.MinWidth; end; end; end; begin if AMultiLine then if AVertical then Result := Bounds(VerSize - Y - AHeight, X + ABeginGroupSize, AHeight, AWidth) else Result := Bounds(X + ABeginGroupSize, Y, AWidth, AHeight) else case DockingStyle of dsTop, dsBottom: Result := Bounds(X + ABeginGroupSize, (ARowHeight - AHeight) div 2, AWidth, AHeight); dsLeft, dsRight: Result := Bounds((ARowHeight - AHeight) div 2, X + ABeginGroupSize, AHeight, AWidth); end; ApplyAlign; end; procedure CalcX; begin if ItemControlAlignApplied then begin X := Size; if I < ItemLinks.VisibleItemCount - 1 then FTruncated := True; end else Inc(X, ABeginGroupSize + AWidth); end; begin InitValues; for I := 0 to ItemLinks.VisibleItemCount - 1 do begin AItemLink := ItemLinks.VisibleItems[I]; if AItemLink.Control = nil then AItemLink.CreateControl; InitItemControlValues; if ItemControlBreaksRow then if AMultiLine then begin ItemLinks.VisibleItems[I - 1].Control.FLastInRow := True; ArrangeControlsOnRow(I - 1); Inc(Y, ARowHeight + ABeginGroupSize); X := 0; ABeginGroupSize := 0; ARowHeight := 0; end else begin AItemLink := ItemLinks.VisibleItems[I - 1]; Break; end; AItemLink.ItemRect := GetItemControlRect; AItemLink.RowHeight := ARowHeight; CalcX; if ARowHeight < AHeight then ARowHeight := AHeight; end; if AItemLink <> nil then AItemLink.Control.FLastInRow := True; if AMultiLine then ArrangeControlsOnRow(ItemLinks.VisibleItemCount - 1); end; procedure TdxBarControl.ChangeStyleWinTo(AStyle: TdxBarDockingStyle; ADockControl: TdxDockControl); begin if (FBar = nil) or (FBar.FBars = nil) or IsDestroying then Exit; if FMoving then begin DockControl := ADockControl; DockingStyle := AStyle; WindowHandle := 0; BeginInternal; try CreateHandle; finally EndInternal; end; if FDockingStyle = dsNone then Windows.SetParent(FDockedHandle, 0) else Windows.SetParent(Handle, FDockControl.Handle); RepaintBar; end else begin BeginInternal; try DestroyHandle; finally EndInternal; end; DockControl := ADockControl; DockingStyle := AStyle; CreateHandle; FrameChanged; end; end; procedure TdxBarControl.DrawEditSizingFrame(AWidth: Integer); var DC: HDC; R: TRect; begin Inc(AWidth, TdxBarEditControl(SelectedItem).CaptionWidth); R := SelectedItem.ItemLink.ItemRect; DC := GetDC(0); if FRightBorderSizing then R.Right := R.Left + AWidth else R.Left := R.Right - AWidth; MapWindowPoints(Handle, 0, R, 2); with R do begin BitBlt(DC, Left, Top, Right - Left, 2, 0, 0, 0, DSTINVERT); BitBlt(DC, Left, Bottom - 2, Right - Left, 2, 0, 0, 0, DSTINVERT); BitBlt(DC, Left, Top + 2, 2, Bottom - Top - 4, 0, 0, 0, DSTINVERT); BitBlt(DC, Right - 2, Top + 2, 2, Bottom - Top - 4, 0, 0, 0, DSTINVERT); end; ReleaseDC(0, DC); end; function TdxBarControl.GetDragPointOffset(Style: TdxBarDockingStyle): TPoint; begin if (Style <> dsNone) and (Self = Bar.Bars.FMovingBarControl) and (Style = Bar.Bars.FMovingBarOriginalDockingStyle) then with Bar.Bars do if Vertical then Result := Point(-FMovingOffset.X, FMovingStaticOffset.Y) else Result := Point(FMovingStaticOffset.X, -FMovingOffset.Y) else with GetTrackSize(Style) do begin Result.X := MulDiv(X, RX.X, RX.Y); Result.Y := MulDiv(Y, RY.X, RY.Y); end; end; function TdxBarControl.GetCaptionNCRect: TRect; begin GetWindowRect(Result); with Result do begin OffsetRect(Result, -Left, -Top); InflateRect(Result, -BarManager.BorderSizeX, -BarManager.BorderSizeY); Bottom := Top + PainterClass.BarCaptionSize; end; end; function TdxBarControl.GetCaptionRect: TRect; var R: TRect; begin Result := GetCaptionNCRect; GetWindowRect(R); with R do OffsetRect(Result, Left, Top); MapWindowPoints(0, Handle, Result, 2); end; procedure TdxBarControl.DrawCloseButton(DC: HDC); begin PainterClass.BarDrawCloseButton(Self, DC, CloseButtonRectNC); end; procedure TdxBarControl.DrawMark(DC: HDC); begin PainterClass.BarDrawMark(Self, DC, MarkNCRect); end; procedure TdxBarControl.DrawMDIButton(AButton: TdxBarMDIButton; ASelected, APressed: Boolean); var R: TRect; DC: HDC; begin R := RectMDI(AButton); DC := Canvas.Handle; PainterClass.BarDrawMDIButton(Self, AButton, ASelected, APressed, DC, R); end; function TdxBarControl.GetMDIWidth: Integer; begin if RealMDIButtonsOnBar then if IsRealVertical(Self) then Result := MDIButtonWidth else Result := 3 * MDIButtonWidth + 2 else Result := MDIButtonWidth; end; function TdxBarControl.GetMDIHeight: Integer; begin if RealMDIButtonsOnBar then if IsRealVertical(Self) then Result := 3 * MDIButtonHeight + 2 else Result := MDIButtonHeight else Result := MDIButtonHeight; end; function TdxBarControl.RectMDI(Button: TdxBarMDIButton): TRect; var AVertical: Boolean; AWidth, AHeight, W, H, MDISize, Offset: Integer; function MDIButtonsHaveOwnRow: Boolean; var I, L: Integer; begin Result := False; L := ItemLinks.VisibleItemCount - 1; for I := L downto 0 do with ItemLinks.VisibleItems[I] do begin if Control.FLastInRow and (I <> L) then begin Result := True; Break; end; if AVertical then if ItemRect.Left < Offset then Break else else if ItemRect.Bottom > Offset then Break; if I = 0 then Result := True; end; end; begin SetRectEmpty(Result); AVertical := Vertical; if AVertical then begin AWidth := ClientHeight; AHeight := ClientWidth; W := MDIButtonHeight; H := MDIButtonWidth; MDISize := GetMDIHeight; end else begin AWidth := ClientWidth; AHeight := ClientHeight; W := MDIButtonWidth; H := MDIButtonHeight; MDISize := GetMDIWidth; end; if (DockingStyle <> dsNone) and MarkExists then Dec(AWidth, MarkSizeX); if MultiLine then begin if AVertical then Offset := H else Offset := AHeight - H; if not MDIButtonsHaveOwnRow then if ItemLinks.VisibleItemCount = 0 then Offset := (AHeight - H) div 2 else Offset := AHeight - (ItemLinks.VisibleItems[ItemLinks.VisibleItemCount - 1].RowHeight - H) div 2 - H else if AVertical then Offset := AHeight - Offset; end else Offset := (AHeight - H) div 2; if RealMDIButtonsOnBar then begin Result := Bounds(AWidth - MDISize + W * Ord(Button), Offset, W, H); if Button = mdibClose then OffsetRect(Result, 2, 0); end else Result := Bounds(AWidth - W, Offset, W, H); if AVertical then with Result do begin W := Left; Left := AHeight - Bottom; Bottom := Right; Right := AHeight - Top; Top := W; end; end; function TdxBarControl.RealMDIButtonsOnBar: Boolean; begin Result := (FBar <> nil) and FBar.IsMainMenu and BarManager.IsMDIMaximized and (GetSystemMenu(BarManager.ActiveMDIChild, False) <> 0); end; function TdxBarControl.MDIButtonsOnBar: Boolean; begin Result := RealMDIButtonsOnBar or (FBar <> nil) and FBar.IsMainMenu and BarManager.ShowCloseButton; end; function TdxBarControl.MDIButtonEnabled(AButton: TdxBarMDIButton; State: Integer): Boolean; begin Result := (AButton = mdibRestore) or (AButton = mdibClose) and not RealMDIButtonsOnBar and MDIButtonsOnBar or (GetMenuState(GetSystemMenu(BarManager.ActiveMDIChild, False), MDIButtonCommands[AButton], MF_BYCOMMAND) and State = 0); end; procedure MoreButtonsHintTimerProc(Wnd: HWND; Msg: UINT; idEvent: UINT; Time: DWORD); stdcall; var BarControl: TdxBarControl; P: TPoint; begin BarControl := TdxBarControl(FindControl(Wnd)); GetCursorPos(P); ScreenToClient(Wnd, P); with BarControl do if not IsWindowVisible(Handle) or not PtInRect(MarkRect, P) then FinishMoreButtonsHintTimer; end; procedure TdxBarControl.StartMoreButtonsHintTimer; begin FMoreButtonsHintTimer := SetTimer(Handle, 1, 50, @MoreButtonsHintTimerProc); end; procedure TdxBarControl.FinishMoreButtonsHintTimer; begin if FMoreButtonsHintTimer <> 0 then begin KillTimer(0, FMoreButtonsHintTimer); FMoreButtonsHintTimer := 0; if MarkState = msSelected then MarkState := msNone; end; end; procedure TdxBarControl.CheckMarkState(const P: TPoint); begin if BarManager.PainterClass.BarAllowQuickCustomizing and MarkExists and PtInRect(MarkRect, P) then if MarkState = msPressed then MarkState := msSelected else MarkState := msPressed; end; procedure TdxBarControl.WMCaptureChanged(var Message: TMessage); begin inherited; if FEditSizingCursor then begin FEditSizingCursor := False; if FSizingEditWidth > 0 then begin DrawEditSizingFrame(FSizingEditWidth); if SelectedItem <> nil then SelectedItem.Repaint; end; FSizingEditWidth := 0; end; end; procedure TdxBarControl.WMDestroy(var Message: TMessage); var ADockControl: TdxDockControl; begin ADockControl := DockControl; if ADockControl <> nil then ADockControl.IsBarHandleDestroying := True; try FinishMoreButtonsHintTimer; inherited; if (FBar <> nil) and not InternallyLocked and not IsInternal and FBar.Visible and not (csDestroying in BarManager.MainForm.ComponentState) then begin BarManager.AddBarToRestoringList(Bar); FBar.Visible := False; end; finally if ADockControl <> nil then ADockControl.IsBarHandleDestroying := False; end; end; procedure TdxBarControl.WMGetDlgCode(var Message: TWMGetDlgCode); begin Message.Result := DLGC_WANTALLKEYS or DLGC_WANTARROWS or DLGC_WANTTAB; end; procedure TdxBarControl.WMGetMinMaxInfo(var Message: TWMGetMinmaxInfo); begin inherited; with Message.MinMaxInfo^ do begin ptMinTrackSize := Point(10, 10); ptMaxTrackSize := Point(30000, 30000); // because of Win95/98 ptMaxSize := ptMaxTrackSize; ptMaxPosition := ptMaxSize; end; end; procedure TdxBarControl.WMKeyDown(var Message: TWMKeyDown); begin inherited; if (ActiveBarControl = nil) or SelectedItemWantsKey(Message.CharCode) then Exit; with Message do case CharCode of VK_ESCAPE: begin CharCode := 0; HideAll; end; VK_RETURN, VK_UP, VK_DOWN: begin if not IsDowned and (SelectedItem is TdxBarSubItemControl) and SelectedItem.Enabled then IsDowned := True; if (SelectedItem is TdxBarSubItemControl) or (CharCode = VK_RETURN) then SelectedItem.Click(False); end; end; end; procedure TdxBarControl.WMLButtonDblClk(var Message: TWMLButtonDblClk); begin CheckMarkState(Point(Message.XPos, Message.YPos)); inherited; end; procedure TdxBarControl.WMLButtonDown(var Message: TWMLButtonDown); var P: TPoint; AButton: TdxBarMDIButton; Item: TdxBarItemControl; R: TRect; function CheckMDIButton(AButton: TdxBarMDIButton): Boolean; begin Result := PtInRect(RectMDI(AButton), P); if Result then begin FIsMDIButtonPressed := True; FIsMouseOverMDIButton := True; FPressedMDIButton := AButton; FSelectedMDIButton := FPressedMDIButton; DrawMDIButtons(0, [AButton]); SetCapture(Handle); end end; begin if FIgnoreMouseClick then Exit; // !!! if not BarManager.HideFloatingBarsWhenInactive and (not IsInternal and (DockingStyle = dsNone)) then SetActiveWindow(BarManager.MainForm.Handle); P := Point(Message.XPos, Message.YPos); Item := ItemAtPos(P); if (Item <> nil) and (Item.Enabled and Item.WantMouse or BarManager.Designing) then if IsCustomizing then if not IsActive then BarGetFocus(Item) else else begin if IsActive and ((Item <> SelectedItem) or ((Item is TdxBarWinControl) and not TdxBarWinControl(Item).Focused)) then begin IsDowned := False; SetKeySelectedItem(Item); end else if IsActive and (SelectedItem is TdxBarWinControl) and TdxBarWinControl(SelectedItem).Focused then with TdxBarWinControl(SelectedItem) do begin P := SmallPointToPoint(Message.Pos); if not PtInRect(WindowRect, P) then begin MapWindowPoints(Parent.Handle, Handle, P, 1); Message.Result := SendMessage(Handle, WM_LBUTTONDOWN, Message.Keys, MakeLParam(P.X, P.Y)); end; Exit; end else if not (IsActive and ((Item is TdxBarButtonControl) or not IsDowned)) then if not IsActive then BarGetFocus(Item) else BarLostFocus; if IsActive and not Item.HasWindow then IsDowned := True; end else IsActive := False; if FEditSizingCursor then begin SetCapture(Handle); Exit; end; inherited; if not BarControlExists(Self) then Exit; if MDIButtonsOnBar and not BarManager.IsCustomizing then if RealMDIButtonsOnBar then for AButton := Low(TdxBarMDIButton) to High(TdxBarMDIButton) do if MDIButtonEnabled(AButton, MF_DISABLED or MF_GRAYED) and CheckMDIButton(AButton) then Exit else else if CheckMDIButton(mdibClose) then Exit; if FHitTest = HTCAPTION then begin P := SmallPointToPoint(Message.Pos); Windows.ClientToScreen(Handle, P); GetWindowRect(R); RX.X := P.X - R.Left; RY.X := P.Y - R.Top; { P := GetTrackSize(DockingStyle); RX.Y := P.X; RY.Y := P.Y;} RX.Y := R.Right - R.Left; RY.Y := R.Bottom - R.Top; FBar.Bars.Moving(Self); end else begin CheckMarkState(P); if not IsCustomizing and not PtInRect(ClientRect, P) then begin Windows.ClientToScreen(Handle, P); SendMessage(Handle, WM_NCLBUTTONDOWN, FHitTest, LPARAM(PointToSmallPoint(P))); end; end; end; procedure TdxBarControl.WMLButtonUp(var Message: TWMLButtonUp); var P: TPoint; AButton: TdxBarMDIButton; begin if FIgnoreMouseClick then begin FIgnoreMouseClick := False; Exit; end; if FEditSizingCursor then begin if FSizingEditWidth > 0 then begin DrawEditSizingFrame(FSizingEditWidth); with TdxBarEditControl(SelectedItem).ItemLink do if Width <> FSizingEditWidth then UserWidth := FSizingEditWidth else SelectedItem.Repaint; FSizingEditWidth := 0; end; ReleaseCapture; Exit; end; P := Point(Message.XPos, Message.YPos); if MDIButtonsOnBar and FIsMDIButtonPressed then begin ReleaseCapture; FIsMDIButtonPressed := False; FIsMouseOverMDIButton := False; RepaintMDIButtons; if not RealMDIButtonsOnBar then begin if PtInRect(RectMDI(mdibClose), P) then BarManager.DoCloseButtonClick; end else begin for AButton := Low(TdxBarMDIButton) to High(TdxBarMDIButton) do if PtInRect(RectMDI(AButton), P) then begin if AButton = FPressedMDIButton then SendMessage(BarManager.ActiveMDIChild, WM_SYSCOMMAND, MDIButtonCommands[AButton], 0); Break; end; end; end; inherited; end; procedure TdxBarControl.WMMouseActivate(var Message: TWMMouseActivate); begin inherited; if not IsActive and (DockingStyle = dsNone) then SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); //ProcessPaintMessages; end; procedure TdxBarControl.WMMouseLeave(var Message: TMessage); begin if not IsActive then begin inherited; CloseButtonState := msNone; // MDI if MDIButtonsOnBar then begin FIsMouseOverMDIButton := False; RepaintMDIButtons; end; end else if SelectedItem is TdxBarButtonControl then SelectedItem.Repaint; end; procedure TdxBarControl.WMMouseMove(var Message: TWMMouseMove); var PrevIsMouseOverMDIButton: Boolean; PrevSelectedMDIButton: TdxBarMDIButton; AButton: TdxBarMDIButton; AButtons: TdxBarMDIButtons; P: TPoint; R: TRect; PrevSizingEditWidth: Integer; ChangeMark: Boolean; begin if FIsMDIButtonPressed then with Message do begin PrevIsMouseOverMDIButton := FIsMouseOverMDIButton; FIsMouseOverMDIButton := PtInRect(RectMDI(FPressedMDIButton), Point(XPos, YPos)); if FIsMouseOverMDIButton <> PrevIsMouseOverMDIButton then DrawMDIButtons(0, [FPressedMDIButton]); end else begin P := SmallPointToPoint(Message.Pos); // check MDI if MDIButtonsOnBar then begin PrevIsMouseOverMDIButton := FIsMouseOverMDIButton; PrevSelectedMDIButton := FSelectedMDIButton; FIsMouseOverMDIButton := False; if not RealMDIButtonsOnBar then begin if MDIButtonEnabled(mdibClose, MF_GRAYED) and PtInRect(RectMDI(mdibClose), P) then begin FIsMouseOverMDIButton := True; FSelectedMDIButton := mdibClose; end end else begin for AButton := Low(TdxBarMDIButton) to High(TdxBarMDIButton) do if MDIButtonEnabled(AButton, MF_GRAYED) and PtInRect(RectMDI(AButton), P) then begin FIsMouseOverMDIButton := True; FSelectedMDIButton := AButton; Break; end; end; if (FIsMouseOverMDIButton <> PrevIsMouseOverMDIButton) or (FSelectedMDIButton <> PrevSelectedMDIButton) then begin AButtons := [PrevSelectedMDIButton]; if FSelectedMDIButton <> PrevSelectedMDIButton then AButtons := AButtons + [FSelectedMDIButton]; DrawMDIButtons(0, AButtons); end; end; if IsCustomizing and FEditSizingCursor and (GetCapture = Handle) then begin R := SelectedItem.ItemLink.ItemRect; PrevSizingEditWidth := FSizingEditWidth; if FRightBorderSizing then FSizingEditWidth := P.X - R.Left else FSizingEditWidth := R.Right - P.X; Dec(FSizingEditWidth, TdxBarEditControl(SelectedItem).CaptionWidth); CheckEditWidth(FSizingEditWidth); if FSizingEditWidth <> PrevSizingEditWidth then begin if PrevSizingEditWidth > 0 then DrawEditSizingFrame(PrevSizingEditWidth) else SelectedItem.Paint(GetItemRect(SelectedItem), ptHorz); DrawEditSizingFrame(FSizingEditWidth); end; end; ChangeMark := False; if not NotHandleMouseMove(P) and (ActiveBarControl = nil) then begin if BarManager.PainterClass.BarAllowQuickCustomizing and MarkExists and (MarkState <> msPressed) then if PtInRect(MarkRect, P) then MarkState := msSelected else ChangeMark := True; if (DockingStyle = dsNone) and Bar.CanClose and BarManager.PainterClass.BarAllowHotTrack then if PtInRect(CloseButtonRect, P) then if CloseButtonState <> msSelected then begin if not MouseTracking(Handle) then StartMouseTracking(Handle); CloseButtonState := msSelected; end else else CloseButtonState := msNone; end; inherited; if ChangeMark then MarkState := msNone; end; end; procedure TdxBarControl.WMNCCalcSize(var Message: TWMNCCalcSize); var R: TRect; begin if not FMovingChanging then FHasSizeGrip := FBar.HasSizeGrip; if DockingStyle = dsNone then begin if PainterClass.BarUseSystemNCBorder then inherited else InflateRect(Message.CalcSize_Params^.rgrc[0], -BarManager.BorderSizeX, -BarManager.BorderSizeY); if FHasCaption then with Message.CalcSize_Params^.rgrc[0] do begin Inc(Top, BarManager.PainterClass.BarCaptionAreaSize); Inc(Left, BarManager.PainterClass.BarHorSize); Dec(Right, BarManager.PainterClass.BarHorSize); Inc(Top, BarManager.PainterClass.BarTopSize); Dec(Bottom, BarManager.PainterClass.BarBottomSize); end; end else begin inherited; if FBar.BorderStyle = bbsSingle then with Message.CalcSize_Params^ do begin PainterClass.BarBorderSizes(FBar, DockingStyle, R); Inc(rgrc[0].Left, R.Left); Dec(rgrc[0].Right, R.Right); Inc(rgrc[0].Top, R.Top); Dec(rgrc[0].Bottom, R.Bottom); if Horizontal then Inc(rgrc[0].Left, BarManager.FingersSize(FBar)) else Inc(rgrc[0].Top, BarManager.FingersSize(FBar)); end else begin if FBar.IsStatusBar then with Message.CalcSize_Params^.rgrc[0] do begin Inc(Top, PainterClass.StatusBarTopBorderSize(BarManager)); if FHasSizeGrip then Dec(Right, PainterClass.StatusBarGripSize(BarManager).cx); end; end; end; end; procedure TdxBarControl.WMNCHitTest(var Message: TWMNCHitTest); var R: TRect; P: TPoint; AControl: TdxBarItemControl; NoControl: Boolean; function MouseAboveMDIButtons: Boolean; begin Result := MDIButtonsOnBar and (RealMDIButtonsOnBar and (PtInRect(RectMDI(mdibMinimize), P) or PtInRect(RectMDI(mdibRestore), P)) or PtInRect(RectMDI(mdibClose), P)); end; begin inherited; FHitTest := 0; GetWindowRect(R); P := SmallPointToPoint(Message.Pos); Windows.ScreenToClient(Handle, P); with Message do if DockingStyle = dsNone then case Result of HTTOPLEFT, HTTOPRIGHT: if YPos < R.Top + BarManager.BorderSizeY then begin FHitTest := HTTOP; Result := HTTOP; end else if Result = HTTOPLEFT then begin FHitTest := HTLEFT; Result := HTLEFT; end else begin FHitTest := HTRIGHT; Result := HTRIGHT; end; HTBOTTOMLEFT, HTBOTTOMRIGHT: if YPos > R.Bottom - BarManager.BorderSizeY then begin FHitTest := HTBOTTOM; Result := HTBOTTOM; end else if Result = HTBOTTOMLEFT then begin FHitTest := HTLEFT; Result := HTLEFT; end else begin FHitTest := HTRIGHT; Result := HTRIGHT; end; HTCLIENT: begin AControl := ItemAtPos(P); if ((AControl = nil) or not IsCustomizing and not AControl.WantMouse) and not MouseAboveMDIButtons then begin FHitTest := HTCAPTION; Result := HTCLIENT; end; end; HTNOWHERE: begin if not IsCustomizing and MarkExists and PtInRect(MarkRect, P) then FHitTest := HTCLIENT else if Bar.CanClose and PtInRect(CloseButtonRect, P) then if not PainterClass.BarUseSystemClose then FHitTest := HTCLOSE else begin FHitTest := HTCLIENT; Result := HTCLOSE; Exit; end else FHitTest := HTCAPTION; Result := HTCLIENT; end; else FHitTest := Result; end else // DockingStyle <> dsNone begin if Result = HTCLIENT then AControl := ItemAtPos(P) else AControl := nil; NoControl := (AControl = nil) or not IsCustomizing and not AControl.WantMouse; if (Result = HTCLIENT) and NoControl or (Result = HTNOWHERE) then begin if not Vertical and (P.X < 0) or Vertical and (P.Y < 0) or NoControl and not MouseAboveMDIButtons and (not MarkExists or not PtInRect(MarkRect, P)) then if FHasSizeGrip and PtInRect(SizeGripRect, P) then begin FHitTest := HTBOTTOMRIGHT; Result := HTBOTTOMRIGHT; end else begin FHitTest := HTCAPTION; Result := HTCLIENT; end; end else begin FHitTest := Result; Result := HTCLIENT; end; end; end; procedure TdxBarControl.WMNCLButtonDown(var Message: TWMNCLButtonDown); var SuccessfulDragging: Boolean; CaptureWnd: HWND; Msg: TMsg; P: TPoint; ABar: TdxBar; begin HideAll; if not BarControlExists(Self) then Exit; if Message.HitTest = HTCLOSE then begin if not BarManager.HideFloatingBarsWhenInactive then SetActiveWindow(BarManager.MainForm.Handle); CloseButtonState := msPressed; SuccessfulDragging := False; CaptureWnd := Handle; SetCapture(CaptureWnd); try while GetCapture = CaptureWnd do begin case Integer(GetMessage(Msg, 0, 0, 0)) of -1: Break; 0: begin PostQuitMessage(Msg.wParam); Break; end; end; with Msg do case message of WM_LBUTTONUP: begin SuccessfulDragging := CloseButtonState = msPressed; Break; end; WM_MOUSEMOVE: begin GetCursorPos(P); Windows.ScreenToClient(Handle, P); if PtInRect(CloseButtonRect, P) then CloseButtonState := msPressed else CloseButtonState := msSelected; end; else TranslateMessage(Msg); DispatchMessage(Msg); end; end; finally if GetCapture = CaptureWnd then ReleaseCapture; CloseButtonState := msNone; if SuccessfulDragging then begin ABar := FBar; Bar.Visible := False; ABar.BarManager.DesignerModified; ABar.BarManager.DoBarClose(ABar); end; end; Exit; end; inherited; end; procedure TdxBarControl.WMNCPaint(var Message: TMessage); var WR, R, CR: TRect; Rgn, Rgn1: HRGN; DC: HDC; AToolbarBrush: HBRUSH; BR: TRect; procedure DrawStatusBar; var R1: TRect; begin DC := GetWindowDC(Handle); // separator R1 := R; R1.Bottom := R1.Top + PainterClass.StatusBarTopBorderSize(BarManager); PainterClass.BarDrawStatusBarTopBorder(Self, DC, R1, AToolbarBrush); // grip if FHasSizeGrip then begin R1 := R; Inc(R1.Top, PainterClass.StatusBarTopBorderSize(BarManager)); R1.Left := R1.Right - PainterClass.StatusBarGripSize(BarManager).cx; PainterClass.BarDrawStatusBarGrip(Self, DC, R1, AToolbarBrush); end; ReleaseDC(Handle, DC); end; procedure DrawFloatingBarBorder; begin DC := GetWindowDC(Handle); PainterClass.BarDrawFloatingBarBorder(Self, DC, R, CR, AToolbarBrush); ReleaseDC(Handle, DC); end; procedure DrawFloatingBarCaption; begin if not FHasCaption then Exit; R := GetCaptionNCRect; CR := R; DC := GetWindowDC(Handle); PainterClass.BarDrawFloatingBarCaption(Self, DC, R, CR, AToolbarBrush); ReleaseDC(Handle, DC); end; begin inherited; GetWindowRect(WR); R := WR; Windows.GetClientRect(Handle, CR); with ClientToScreen(Point(0, 0)), WR do OffsetRect(CR, X - Left, Y - Top); OffsetRect(R, -R.Left, -R.Top); AToolbarBrush := ToolbarBrush; if (DockingStyle <> dsNone) and (FBar.BorderStyle = bbsNone) then begin if FBar.IsStatusBar then DrawStatusBar; Exit; end; with R do if DockingStyle = dsNone then begin DrawFloatingBarBorder; R := CR; if FHasCaption then begin Dec(Left, BarManager.PainterClass.BarHorSize); Inc(Right, BarManager.PainterClass.BarHorSize); Dec(Top, BarManager.PainterClass.BarTopSize); Inc(Bottom, BarManager.PainterClass.BarBottomSize); end; Rgn := CreateRectRgn(Left, Top, Right, Bottom); end else begin PainterClass.BarBorderPaintSizes(Self, BR); Rgn := CreateRectRgn(Left + BR.Left, Top + BR.Top, Right - BR.Right, Bottom - BR.Bottom); end; with CR do Rgn1 := CreateRectRgn(Left, Top, Right, Bottom); CombineRgn(Rgn, Rgn1, Rgn, RGN_XOR); DeleteObject(Rgn1); DC := GetWindowDC(Handle); FillBackgroundRgn(DC, Rgn, AToolbarBrush, False); DeleteObject(Rgn); if DockingStyle <> dsNone then PainterClass.BarDrawDockedBarBorder(Self, DC, R, AToolbarBrush); ReleaseDC(Handle, DC); if DockingStyle = dsNone then DrawFloatingBarCaption; end; procedure TdxBarControl.WMRButtonDown(var Message: TWMRButtonDown); var P: TPoint; begin ReleaseCapture; if IsCustomizing then IsActive := False else {HideAll};//BarLostFocus; inherited; if BarManager.IsCustomizing then Exit; //SetMouseSelectedItem(nil); with Message do P := ClientToScreen(Point(XPos, YPos)); ShowToolbarsPopup(Self, BarManager, P); end; procedure TdxBarControl.WMSetCursor(var Message: TWMSetCursor); var P: TPoint; R: TRect; begin if GetCapture = 0 then begin GetCursorPos(P); Windows.ScreenToClient(Handle, P); FEditSizingCursor := False; if IsCustomizing and (SelectedItem is TdxBarEditControl) then begin R := SelectedItem.ItemLink.ItemRect; with R do if PtInRect(Rect(Left, Top, Left + EditSizingZoneSize, Bottom), P) then begin FEditSizingCursor := True; FRightBorderSizing := False; end else if PtInRect(Rect(Right - EditSizingZoneSize, Top, Right, Bottom), P) then begin FEditSizingCursor := True; FRightBorderSizing := True; end; end; if not Moving and not FEditSizingCursor and Bar.CanMoving then // --- SetCursorForMoving(PtInRect(GetSizeAllCursorBounds, P)); end; if FEditSizingCursor then SetCursor(Screen.Cursors[crdxBarEditSizing]) else inherited; end; procedure TdxBarControl.WMSize(var Message: TWMSize); begin if IsDestroying then Exit; inherited; end; procedure TdxBarControl.WMSizing(var Message: TMessage); var Size: TPoint; NCSize: Integer; begin inherited; if DockingStyle = dsNone then with Message, PRect(lParam)^ do begin case wParam of WMSZ_LEFT, WMSZ_RIGHT: begin NCSize := Bar.BarNCSizeX(dsNone); Size := GetSizeForWidth(DockingStyle, Right - Left - NCSize); if wParam = WMSZ_LEFT then Left := Right - Size.X - NCSize else Right := Left + Size.X + NCSize; Bottom := Top + Size.Y + Bar.BarNCSizeY(dsNone); end; WMSZ_TOP, WMSZ_BOTTOM: begin NCSize := Bar.BarNCSizeY(dsNone); Size := GetSizeForHeight(DockingStyle, Bottom - Top - NCSize); Right := Left + Size.X + Bar.BarNCSizeX(dsNone); if wParam = WMSZ_TOP then Top := Bottom - Size.Y - NCSize else Bottom := Top + Size.Y + NCSize; end; else PRect(lParam)^ := BoundsRect; Result := 1; end; // against windows' bug: if Top < -15 then OffsetRect(PRect(lParam)^, 0, -15 - Top); Result := 1; end; end; procedure TdxBarControl.WMWindowPosChanged(var Message: TWMWindowPosChanged); begin inherited; if (FBar = nil) or InternallyLocked or IsDestroying then Exit; FBar.ChangeDockingStyle(DockingStyle, DockControl); SavePos; with Message.WindowPos^ do begin if ((flags and SWP_NOSIZE = 0) or (flags and SWP_NOMOVE = 0)) and (FQuickPopup <> nil) then begin FQuickPopup.OwnerBounds := MarkScreenRect; FQuickPopup.ResizeShadow; SendMessage(FQuickPopup.Handle, WM_NCPAINT, 0, 0); end; if (flags and SWP_NOSIZE <> 0) and (flags and SWP_NOMOVE = 0) and (FHasSizeGrip <> FBar.HasSizeGrip) then RebuildBar; end; end; procedure TdxBarControl.WMWindowPosChanging(var Message: TWMWindowPosChanging); procedure CalcCoords(const AWindowPos: TWindowPos; var ALeft, ATop, AWidth, AHeight: Integer); begin if AWindowPos.flags and SWP_NOMOVE = 0 then begin ALeft := AWindowPos.x; ATop := AWindowPos.y; end else begin ALeft := Left; ATop := Top; end; if AWindowPos.flags and SWP_NOSIZE = 0 then begin AWidth := AWindowPos.cx; AHeight := AWindowPos.cy; end else begin AWidth := Width; AHeight := Height; end; end; var L, T, W, H: Integer; I: Integer; AIntersect: Boolean; P: TPoint; R, ABarRect, ARect: TRect; begin inherited; if DockingStyle <> dsNone then Exit; if (Message.WindowPos^.flags and SWP_NOMOVE = 0) or (Message.WindowPos^.flags and SWP_NOSIZE = 0) then begin CalcCoords(Message.WindowPos^, L, T, W, H); ABarRect := Bounds(L, T, W, H); AIntersect := False; for I := 0 to Screen.MonitorCount - 1 do begin // begin BoundsRect P := Point(Screen.Monitors[I].Left, Screen.Monitors[I].Top); R := GetWorkArea(P); // end BoundsRect if IntersectRect(ARect, R, ABarRect) then begin AIntersect := True; Break; end; end; if not AIntersect then begin GetCursorPos(P); R := GetWorkArea(P); with Message.WindowPos^ do begin with R do begin if L + W <= Left then begin x := Left; y := T; flags := flags and not SWP_NOMOVE; end; if T + H <= Top then begin x := L; y := Top; flags := flags and not SWP_NOMOVE; end; if L >= Right then begin x := Right - W; y := T; flags := flags and not SWP_NOMOVE; end; if T >= Bottom then begin x := L; y := Bottom - H; flags := flags and not SWP_NOMOVE; end; end; end; end; end; end; procedure TdxBarControl.CMFontChanged(var Message: TMessage); var LogFont: TLogFont; begin if IsVertical(Self) and not FSettingFont then begin FSettingFont := True; GetObject(Font.Handle, SizeOf(LogFont), @LogFont); with LogFont do begin lfEscapement := -900; lfOrientation := lfEscapement; lfOutPrecision := OUT_TT_ONLY_PRECIS; end; Canvas.Font.Handle := CreateFontIndirect(LogFont); FSettingFont := False; end else Canvas.Font := Font; CalcDrawingConsts; if not InternallyLocked then begin SetMouseSelectedItem(nil); RepaintBar; end; inherited; end; procedure TdxBarControl.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin Style := WS_CLIPCHILDREN or WS_CLIPSIBLINGS; WindowClass.Style := CS_DBLCLKS or CS_HREDRAW or CS_VREDRAW; ExStyle := 0;//WS_EX_TOOLWINDOW; if DockingStyle = dsNone then begin Style := Style or WS_POPUPWINDOW or WS_SIZEBOX; // WndParent := BarManager.MainForm.Handle; WndParent := GetMainForm.Handle; end else begin Style := Style or WS_CHILD; WndParent := FDockControl.Handle; end; end; end; procedure TdxBarControl.CreateWnd; begin if FMoving and InternallyLocked then if FDockingStyle = dsNone then WindowHandle := FFloatingHandle else WindowHandle := FDockedHandle else inherited; Text := Bar.Caption; SendMessage(Handle, WM_NCACTIVATE, Longint(True), 0); // don't remove (AV in ntdll.dll) end; procedure TdxBarControl.Paint; var DC: HDC; I: Integer; AItemLink: TdxBarItemLink; ItemRect: TRect; Rgn: HRGN; AButtons: TdxBarMDIButtons; AToolbarBrush: HBRUSH; AVertical: Boolean; begin inherited; if {not IsWindowVisible(BarManager.MainForm.Handle) or} FDestroyFlag then Exit; // recalc positions of items CalcControlsPositions; // hide invisible items that require that if not BarManager.Designing then for I := 0 to FItemLinks.CanVisibleItemCount - 1 do begin AItemLink := FItemLinks.CanVisibleItems[I]; with AItemLink do if Item.NeedToBeHidden and (VisibleIndex = -1) then Item.HideControl(Control); end; AToolbarBrush := ToolbarBrush; Rgn := CreateRectRgnIndirect(ClientRect); DC := Canvas.Handle; // paint items and "BeginGroups" for I := 0 to FItemLinks.VisibleItemCount - 1 do begin AItemLink := FItemLinks.VisibleItems[I]; ItemRect := GetItemRect(AItemLink.Control); PaintItem(AItemLink.Control); ExcludeRect(Rgn, ItemRect); if AItemLink.BeginGroup and not IsRectEmpty(ItemRect) then begin AVertical := Vertical; if not AVertical and (ItemRect.Left = 0) and (ItemRect.Top > 0) or AVertical and (ItemRect.Top > 0) then begin // begin group in vertical direction with ItemRect do begin if AVertical then ItemRect := Bounds( Left - (AItemLink.FRowHeight - (Right - Left)) div 2, Top - BeginGroupSize, AItemLink.FRowHeight, BeginGroupSize) else ItemRect := Bounds( 0, Top - (AItemLink.FRowHeight - (Bottom - Top)) div 2 - BeginGroupSize, ClientWidth - Byte((DockingStyle <> dsNone) and MarkExists) * MarkSizeX, BeginGroupSize); end; ExcludeRect(Rgn, ItemRect); AItemLink.Control.FBeginGroupRect := ItemRect; PainterClass.BarDrawBeginGroup(Self, DC, ItemRect, AToolbarBrush, True); end else begin // begin group in horizontal direction with ItemRect do begin if AVertical then ItemRect := Bounds( Right + (AItemLink.FRowHeight - (Right - Left)) div 2, 0, BeginGroupSize, ClientHeight - Byte((DockingStyle <> dsNone) and MarkExists) * MarkSizeX) else ItemRect := Bounds( Left - BeginGroupSize, Top - (AItemLink.FRowHeight - (Bottom - Top)) div 2, BeginGroupSize, AItemLink.FRowHeight); end; ExcludeRect(Rgn, ItemRect); AItemLink.Control.FBeginGroupRect := ItemRect; PainterClass.BarDrawBeginGroup(Self, DC, ItemRect, AToolbarBrush, False); end; end else SetRectEmpty(AItemLink.Control.FBeginGroupRect); end; // draw MDI buttons if MDIButtonsOnBar then begin if RealMDIButtonsOnBar then AButtons := [mdibMinimize, mdibRestore, mdibClose] else AButtons := [mdibClose]; DrawMDIButtons(Rgn, AButtons); end; // draw mark(s) if (DockingStyle <> dsNone) and MarkExists then begin ItemRect := MarkItemRect; PainterClass.BarDrawMarks(Self, DC, ItemRect, AToolbarBrush); ExcludeRect(Rgn, ItemRect); end; FillBackgroundRgn(DC, Rgn, AToolbarBrush, True); DeleteObject(Rgn); end; procedure TdxBarControl.BeginInternal; begin Inc(FInternalLockCount); end; procedure TdxBarControl.EndInternal; begin if FInternalLockCount > 0 then Dec(FInternalLockCount); end; procedure TdxBarControl.CalcDrawingConsts; begin inherited; FMDIButtonWidth := GetSystemMetrics(SM_CXMENUSIZE) - 2; FMDIButtonHeight := GetSystemMetrics(SM_CYMENUSIZE) - 2 * 2; end; function TdxBarControl.CanAlignControl(AControl: TdxBarItemControl): Boolean; begin with AControl.ItemLink do Result := (CanVisibleIndex = Owner.CanVisibleItemCount - 1); end; function TdxBarControl.CanCallInheritedNCCalcSize: Boolean; // obsolete begin Result := (DockingStyle <> dsNone) or not Flat; end; function TdxBarControl.CanCustomizing: Boolean; begin Result := inherited CanCustomizing or FBar.AllowCustomizing; end; function TdxBarControl.CanFinishMouseTracking(const Message: TWMNCHitTest): Boolean; begin Result := inherited CanFinishMouseTracking(Message) and (CloseButtonState <> msSelected); end; function TdxBarControl.CloseButtonRect: TRect; var ASize: TSize; RW, RH: Integer; begin Result := GetCaptionRect; with Result do Left := Right - PainterClass.BarCaptionSize; ASize := PainterClass.BarCloseButtonSize; RW := Result.Right - Result.Left; if ASize.cx < RW then begin Result.Left := Result.Left + (RW div 2) - (ASize.cx div 2); Result.Right := Result.Left + ASize.cx; end; RH := Result.Bottom - Result.Top; if ASize.cy < RH then begin Result.Top := Result.Top + (RH div 2) - (ASize.cy div 2); Result.Bottom := Result.Top + ASize.cy; end; end; function TdxBarControl.CloseButtonRectNC: TRect; var WR: TRect; begin Result := CloseButtonRect; MapWindowPoints(Handle, 0, Result, 2); GetWindowRect(WR); OffsetRect(Result, -WR.Left, -WR.Top); end; function TdxBarControl.GetAlphaBlendValue: Byte; begin if {not FMovingChanging and }(DockingStyle = dsNone) then Result := 200 else Result := 255; end; function TdxBarControl.GetBeginGroupSize: Integer; begin Result := PainterClass.BarBeginGroupSize; end; function TdxBarControl.GetCol: Integer; var I, J: Integer; begin Result := 0; if (FBar = nil) or (FBar.FBars = nil) or (DockingStyle = dsNone) or (FDockControl = nil) then Exit; with FDockControl do for I := 0 to FRowList.Count - 1 do for J := 0 to TdxDockRow(FRowList[I]).ColList.Count - 1 do if TdxDockCol(TdxDockRow(FRowList[I]).ColList[J]).BarControl = Self then begin Result := J; Exit; end; end; procedure TdxBarControl.WndProc(var Message: TMessage); var AStyle: TdxBarDockingStyle; ADockControl: TdxDockControl; begin with Message do begin if Msg = WM_SETFOCUS then begin Exit; end; if (FIsMDIButtonPressed or FIsMouseOverMDIButton) and (Msg = WM_CANCELMODE) then begin ReleaseCapture; FIsMDIButtonPressed := False; FIsMouseOverMDIButton := False; RepaintMDIButtons; end; if (Msg = WM_LBUTTONDBLCLK) and (FHitTest = HTCAPTION) then begin if not BarManager.Designing then with Bar do begin ADockControl := nil; if DockingStyle = dsNone then if DockedDockingStyle <> dsNone then begin AStyle := DockedDockingStyle; ADockControl := DockedDockControl; if ADockControl = nil then ADockControl := FBars.FDockControls[AStyle]; end else begin AStyle := dsTop; ADockControl := FBars.FDockControls[dsTop]; end else AStyle := dsNone; if BarManager.DoDocking(Bar, AStyle, ADockControl) then begin Visible := False; if DockingStyle = dsNone then begin ChangeDockingStyle(AStyle, ADockControl); if DockedDockingStyle = dsNone then begin OneOnRow := True; Row := ADockControl.RowCount; end; end else DockingStyle := dsNone; Visible := True; end; end; Exit; end; end; inherited; end; function TdxBarControl.GetDockCol: TdxDockCol; var I, J: Integer; begin Result := nil; if (FBar = nil) or (FBar.FBars = nil) or (DockingStyle = dsNone) or (FDockControl = nil) then Exit; with FDockControl do for I := 0 to RowCount - 1 do for J := 0 to Rows[I].ColCount - 1 do if Rows[I].Cols[J].BarControl = Self then begin Result := Rows[I].Cols[J]; Exit; end; end; function TdxBarControl.GetRow: Integer; var I, J: Integer; begin Result := 0; if (FBar = nil) or (FBar.FBars = nil) or (DockingStyle = dsNone) or (FDockControl = nil) then Exit; with FDockControl do for I := 0 to RowCount - 1 do for J := 0 to Rows[I].ColCount - 1 do if Rows[I].Cols[J].BarControl = Self then begin Result := I; Exit; end; end; function TdxBarControl.GetMainForm: TCustomForm; begin if DockControl <> nil then Result := DockControl.GetMainForm else Result := BarManager.MainForm; end; function TdxBarControl.GetMinWidth(AStyle: TdxBarDockingStyle): Integer; var I, AWidth: Integer; begin if (AStyle in [dsLeft, dsRight]) or MultiLine then begin if ItemLinks.CanVisibleItemCount = 0 then Result := BarManager.ButtonWidth else begin Result := 0; for I := 0 to ItemLinks.CanVisibleItemCount - 1 do begin AWidth := ItemLinks.CanVisibleItems[I].Control.Width; if Result < AWidth then Result := AWidth; end; end; if MDIButtonsOnBar and (Result < GetMDIWidth) then Result := GetMDIWidth; end else begin if ItemLinks.CanVisibleItemCount = 0 then Result := BarManager.ButtonWidth else begin ItemLinks.RecentItemCount := 1; Result := ItemLinks.VisibleItems[0].Control.Width; ItemLinks.RestoreRecentItemCount; end; if MDIButtonsOnBar then Inc(Result, GetMDIWidth); end; if Horizontal and MarkExists then Inc(Result, MarkSizeX); end; function TdxBarControl.GetMinHeight(AStyle: TdxBarDockingStyle): Integer; var I, AHeight: Integer; begin if (AStyle in [dsTop, dsBottom]) or MultiLine then begin if ItemLinks.CanVisibleItemCount = 0 then Result := BarManager.ButtonHeight else begin Result := 0; for I := 0 to ItemLinks.CanVisibleItemCount - 1 do begin AHeight := ItemLinks.CanVisibleItems[I].Control.Height; if Result < AHeight then Result := AHeight; end; end; if MDIButtonsOnBar and (Result < GetMDIHeight) then Result := GetMDIHeight; end else begin if ItemLinks.CanVisibleItemCount = 0 then Result := BarManager.ButtonHeight else begin ItemLinks.RecentItemCount := 1; Result := ItemLinks.VisibleItems[0].Control.Height; ItemLinks.RestoreRecentItemCount; end; if MDIButtonsOnBar then Inc(Result, GetMDIHeight); end; if Vertical and MarkExists then Inc(Result, MarkSizeX); end; function TdxBarControl.GetMaxWidth(AStyle: TdxBarDockingStyle): Integer; var AWidth, I: Integer; AItemLink: TdxBarItemLink; begin Result := GetMinWidth(AStyle); AWidth := 0; if (AStyle in [dsTop, dsBottom]) or MultiLine then begin ItemLinks.RecentItemCount := -1; for I := 0 to ItemLinks.VisibleItemCount - 1 do begin AItemLink := ItemLinks.VisibleItems[I]; if AItemLink.BeginGroup then Inc(AWidth, BeginGroupSize); Inc(AWidth, AItemLink.Control.Width); end; ItemLinks.RestoreRecentItemCount; if MDIButtonsOnBar then Inc(AWidth, GetMDIWidth); if Horizontal and MarkExists then Inc(AWidth, MarkSizeX); end else begin for I := 0 to ItemLinks.CanVisibleItemCount - 1 do begin AItemLink := ItemLinks.CanVisibleItems[I]; if AWidth < AItemLink.Control.Width then AWidth := AItemLink.Control.Width; end; if MDIButtonsOnBar and (AWidth < GetMDIWidth) then AWidth := GetMDIWidth; end; if Result < AWidth then Result := AWidth; end; function TdxBarControl.GetMaxHeight(AStyle: TdxBarDockingStyle): Integer; var AHeight, I: Integer; AItemLink: TdxBarItemLink; begin Result := GetMinHeight(AStyle); AHeight := 0; if (AStyle in [dsLeft, dsRight]) or MultiLine then begin ItemLinks.RecentItemCount := -1; for I := 0 to ItemLinks.VisibleItemCount - 1 do begin AItemLink := ItemLinks.VisibleItems[I]; if AItemLink.BeginGroup then Inc(AHeight, BeginGroupSize); Inc(AHeight, AItemLink.Control.Height); end; ItemLinks.RestoreRecentItemCount; if MDIButtonsOnBar then Inc(AHeight, GetMDIHeight); if Vertical and MarkExists then Inc(AHeight, MarkSizeX); end else begin for I := 0 to ItemLinks.CanVisibleItemCount - 1 do begin AItemLink := ItemLinks.CanVisibleItems[I]; if AHeight < AItemLink.Control.Height then AHeight := AItemLink.Control.Height; end; if MDIButtonsOnBar and (AHeight < GetMDIHeight) then AHeight := GetMDIHeight; end; if Result < AHeight then Result := AHeight; end; procedure TdxBarControl.GetMultiLineBarSize(AStyle: TdxBarDockingStyle; ASize: Integer; var Result: TPoint); var CurX, CurY, CurRowHeight, MaxSize, ACount, I, ABeginGroupSize, W, H, LastItemLinkWithBeginGroupCurX, LastItemLinkWithBeginGroupCurRowHeight: Integer; LastItemLinkWithBeginGroup, AItemLink: TdxBarItemLink; AVertical, BreakingRow, EntireRow: Boolean; begin AVertical := Vertical; if AVertical then if ASize < Result.Y then ASize := Result.Y else else if ASize < Result.X then ASize := Result.X; if (AStyle <> dsNone) and MarkExists then Dec(ASize, MarkSizeX); CurX := 0; CurY := 0; CurRowHeight := 0; MaxSize := 0; LastItemLinkWithBeginGroup := nil; LastItemLinkWithBeginGroupCurX := 0; LastItemLinkWithBeginGroupCurRowHeight := 0; BreakingRow := False; EntireRow := True; ACount := ItemLinks.VisibleItemCount; I := 0; while I < ACount do begin AItemLink := ItemLinks.VisibleItems[I]; if AItemLink.BeginGroup and (CurX > 0) then begin ABeginGroupSize := BeginGroupSize; LastItemLinkWithBeginGroup := AItemLink; LastItemLinkWithBeginGroupCurX := CurX; LastItemLinkWithBeginGroupCurRowHeight := CurRowHeight; end else ABeginGroupSize := 0; with AItemLink.Control do if AVertical then begin W := Height; H := Width; end else begin W := Width; H := Height; end; if (CurX > 0) and (CurX + ABeginGroupSize + W > ASize) or BreakingRow or (ABeginGroupSize > 0) and not EntireRow then begin EntireRow := True; AItemLink.Control.FBreakingRow := True; if LastItemLinkWithBeginGroup = nil then EntireRow := False else if BreakingRow then begin LastItemLinkWithBeginGroup := nil; BreakingRow := False; end else begin I := LastItemLinkWithBeginGroup.VisibleIndex; CurX := LastItemLinkWithBeginGroupCurX; CurRowHeight := LastItemLinkWithBeginGroupCurRowHeight; BreakingRow := True; Continue; end; Inc(CurY, ABeginGroupSize + CurRowHeight); CurRowHeight := 0; if MaxSize < CurX then MaxSize := CurX; CurX := W; end else begin AItemLink.Control.FBreakingRow := False; Inc(CurX, ABeginGroupSize + W); end; if CurRowHeight < H then CurRowHeight := H; Inc(I); end; if ItemLinks.VisibleItemCount > 0 then if AVertical then Result.X := CurY + CurRowHeight else Result.Y := CurY + CurRowHeight; if MDIButtonsOnBar then begin if AVertical then I := GetMDIHeight else I := GetMDIWidth; if CurX + I <= ASize then Inc(CurX, I) else if AVertical then Inc(Result.X, GetMDIWidth) else Inc(Result.Y, GetMDIHeight); end; if MaxSize < CurX then MaxSize := CurX; if AVertical then if Result.Y < MaxSize then Result.Y := MaxSize else else if Result.X < MaxSize then Result.X := MaxSize; CalcControlsPositions; // because of a FBreakingRow end; function TdxBarControl.GetSizeAllCursorBounds: TRect; begin if (DockingStyle = dsNone) or (Bar.BorderStyle = bbsNone) then SetRectEmpty(Result) else if Horizontal then Result := Rect(-100, -100, 0, 100) else Result := Rect(-100, -100, 100, 0); end; function TdxBarControl.GetSizeForWidth(AStyle: TdxBarDockingStyle; AWidth: Integer): TPoint; var J, ABeginGroupSize: Integer; AItemLink: TdxBarItemLink; Found: Boolean; PrevSize, Size: TPoint; function CalcSize(var Size: TPoint): Boolean; var I: Integer; begin Result := False; Size.X := 0; Size.Y := 0; for I := 0 to ItemLinks.VisibleItemCount - 1 do begin AItemLink := ItemLinks.VisibleItems[I]; if AItemLink.BeginGroup then ABeginGroupSize := BeginGroupSize else ABeginGroupSize := 0; with AItemLink.Control do begin if (Size.X + ABeginGroupSize + Width > AWidth) and (I <> 0) then begin Result := True; Break; end; Inc(Size.X, ABeginGroupSize + Width); if Size.Y < Height then Size.Y := Height; end; end; end; begin ItemLinks.RecentItemCount := -1; CalcControlsPositions; ItemLinks.RestoreRecentItemCount; if MultiLine then if Vertical then begin Size := GetSizeForHeight(AStyle, GetMaxHeight(AStyle)); repeat if Size.X >= AWidth then Break; PrevSize := Size; Dec(Size.Y); Size := GetSizeForHeight(AStyle, Size.Y); until Size.Y = PrevSize.Y; Result := Size; end else begin Result := Point(GetMinWidth(AStyle), GetMinHeight(AStyle)); GetMultiLineBarSize(AStyle, AWidth, Result); end else case AStyle of dsTop, dsBottom: begin Result := Point(GetMinWidth(AStyle), GetMinHeight(AStyle)); if AWidth < Result.X then AWidth := Result.X; if MDIButtonsOnBar then Dec(AWidth, GetMDIWidth); ItemLinks.RecentItemCount := -1; if ItemLinks.CanVisibleItemCount > 0 then begin if MarkExists then Dec(AWidth, MarkSizeX); if ItemLinks.CanUseRecentItems and not BarManager.Designing then begin PrevSize := Result; if MarkExists then Dec(PrevSize.X, MarkSizeX); Found := False; for J := 1 to ItemLinks.CanVisibleItemCount do begin ItemLinks.RecentItemCount := J; Found := CalcSize(Size); if Found then begin ItemLinks.RecentItemCount := J - 1; Size := PrevSize; Break; end; PrevSize := Size; end; if not Found then ItemLinks.RecentItemCount := -1; end else CalcSize(Size); if MarkExists then Inc(Size.X, MarkSizeX); if Result.X < Size.X then Result.X := Size.X; Result.Y := Size.Y; if MDIButtonsOnBar then begin Inc(Result.X, GetMDIWidth); if Result.Y < GetMDIHeight then Result.Y := GetMDIHeight; end; end; end; dsLeft, dsRight: Result := Point(GetMinWidth(AStyle), GetMaxHeight(AStyle)); end; end; function TdxBarControl.GetSizeForHeight(AStyle: TdxBarDockingStyle; AHeight: Integer): TPoint; var J, ABeginGroupSize: Integer; AItemLink: TdxBarItemLink; Found: Boolean; PrevSize, Size: TPoint; function CalcSize(var Size: TPoint): Boolean; var I: Integer; begin Result := False; Size.X := 0; Size.Y := 0; for I := 0 to ItemLinks.VisibleItemCount - 1 do begin AItemLink := ItemLinks.VisibleItems[I]; if AItemLink.BeginGroup then ABeginGroupSize := BeginGroupSize else ABeginGroupSize := 0; with AItemLink.Control do begin if (Size.Y + ABeginGroupSize + Height > AHeight) and (I <> 0) then begin Result := True; Break; end; Inc(Size.Y, ABeginGroupSize + Height); if Size.X < Width then Size.X := Width; end; end; end; begin ItemLinks.RecentItemCount := -1; CalcControlsPositions; ItemLinks.RestoreRecentItemCount; if MultiLine then if Vertical then begin Result := Point(GetMinWidth(AStyle), GetMinHeight(AStyle)); GetMultiLineBarSize(AStyle, AHeight, Result); end else begin Size := GetSizeForWidth(AStyle, GetMaxWidth(AStyle)); repeat if Size.Y >= AHeight then Break; PrevSize := Size; Dec(Size.X); Size := GetSizeForWidth(AStyle, Size.X); until Size.X = PrevSize.X; Result := Size; end else case AStyle of dsTop, dsBottom: Result := Point(GetMaxWidth(AStyle), GetMinHeight(AStyle)); dsLeft, dsRight: begin Result := Point(GetMinWidth(AStyle), GetMinHeight(AStyle)); if AHeight < Result.Y then AHeight := Result.Y; if MDIButtonsOnBar then Dec(AHeight, GetMDIHeight); ItemLinks.RecentItemCount := -1; if ItemLinks.CanVisibleItemCount > 0 then begin if MarkExists then Dec(AHeight, MarkSizeX); if ItemLinks.CanUseRecentItems and not BarManager.Designing then begin PrevSize := Result; if MarkExists then Dec(PrevSize.Y, MarkSizeX); Found := False; for J := 1 to ItemLinks.CanVisibleItemCount do begin ItemLinks.RecentItemCount := J; Found := CalcSize(Size); if Found then begin ItemLinks.RecentItemCount := J - 1; Size := PrevSize; Break; end; PrevSize := Size; end; if not Found then ItemLinks.RecentItemCount := -1; end else CalcSize(Size); if MarkExists then Inc(Size.Y, MarkSizeX); if Result.Y < Size.Y then Result.Y := Size.Y; Result.X := Size.X; if MDIButtonsOnBar then begin Inc(Result.Y, GetMDIHeight); if Result.X < GetMDIWidth then Result.X := GetMDIWidth; end; end; end; end; end; function TdxBarControl.GetTrackSize(AStyle: TdxBarDockingStyle): TPoint; var PrevRecentItemCount: Integer; begin Result.X := 0; Result.Y := 0; PrevRecentItemCount := ItemLinks.RecentItemCount; case AStyle of dsNone: begin Result := GetSizeForWidth(AStyle, Bar.FloatClientWidth); Inc(Result.X, Bar.BarNCSizeX(AStyle)); Inc(Result.Y, Bar.BarNCSizeY(AStyle)); end; dsTop, dsBottom: begin if (FBar <> nil) and FBar.WholeRow then Result.X := FDockControl.ClientWidth - FBar.BarNCSizeX(AStyle) else Result.X := GetMaxWidth(AStyle); Result := GetSizeForWidth(AStyle, Result.X); if (FBar <> nil) and FBar.WholeRow then Result.X := FDockControl.ClientWidth else Inc(Result.X, Bar.BarNCSizeX(AStyle)); Inc(Result.Y, Bar.BarNCSizeY(AStyle)); end; dsLeft, dsRight: begin if (FBar <> nil) and FBar.WholeRow then Result.Y := FDockControl.ClientHeight - FBar.BarNCSizeY(AStyle) else Result.Y := GetMaxHeight(AStyle); Result := GetSizeForHeight(AStyle, Result.Y); Inc(Result.X, Bar.BarNCSizeX(AStyle)); if (FBar <> nil) and FBar.WholeRow then Result.Y := FDockControl.ClientHeight else Inc(Result.Y, Bar.BarNCSizeY(AStyle)); end; end; ItemLinks.RecentItemCount := PrevRecentItemCount; CalcControlsPositions; end; procedure TdxBarControl.InvalidateMark; begin PainterClass.BarMarkRectInvalidate(Self); end; function TdxBarControl.MarkExists: Boolean; begin Result := Bar.ShowMark and (FTruncated or (BarManager.PainterClass.BarAllowQuickCustomizing and Bar.AllowQuickCustomizing)); end; function TdxBarControl.MarkNCRect: TRect; var WR: TRect; begin Result := MarkScreenRect; GetWindowRect(WR); OffsetRect(Result, -WR.Left, -WR.Top); end; function TdxBarControl.MarkRect: TRect; begin Result := PainterClass.BarMarkRect(Self); end; function TdxBarControl.MarkItemRect: TRect; begin Result := PainterClass.BarMarkItemRect(Self); end; function TdxBarControl.MarkScreenRect: TRect; begin Result := MarkRect; MapWindowPoints(Handle, 0, Result, 2); end; function TdxBarControl.SizeGripRect: TRect; begin with Result do begin Left := ClientWidth; Right := Left + PainterClass.StatusBarGripSize(BarManager).cx; Bottom := ClientHeight; Top := Bottom - PainterClass.StatusBarGripSize(BarManager).cy; end; end; procedure TdxBarControl.BarManagerStyleChanged; var ABar: TdxBar; begin UpdateControlStyle; CalcDrawingConsts; if DockingStyle = dsNone then begin ABar := Bar; ABar.Visible := False; ABar.Visible := True; end else RebuildBar; end; procedure TdxBarControl.CaptionChanged; begin Text := Bar.Caption; SendMessage(Handle, WM_NCPAINT, 0, 0); end; procedure TdxBarControl.DrawMDIButtons(ARgn: HRGN; AButtons: TdxBarMDIButtons); var AButton: TdxBarMDIButton; begin for AButton := Low(TdxBarMDIButton) to High(TdxBarMDIButton) do if AButton in AButtons then begin DrawMDIButton(AButton, FIsMouseOverMDIButton and (AButton = FSelectedMDIButton), FIsMDIButtonPressed and (AButton = FPressedMDIButton)); if ARgn <> 0 then ExcludeRect(ARgn, RectMDI(AButton)); end; end; procedure TdxBarControl.FrameChanged; begin SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_FRAMECHANGED); end; function TdxBarControl.GetEditFontHandle: HFONT; begin if FBar.UseOwnFont then Result := FBar.FEditFontHandle else Result := inherited GetEditFontHandle; end; function TdxBarControl.GetFullItemRect(Item: TdxBarItemControl): TRect; begin Result := GetItemRect(Item); with Item.ItemLink, Result do if Vertical then begin Dec(Left, (RowHeight - (Right - Left)) div 2); Right := Left + RowHeight; end else begin Dec(Top, (RowHeight - (Bottom - Top)) div 2); Bottom := Top + RowHeight; end; end; function TdxBarControl.GetItemRegion(Item: TdxBarItemControl): HRGN; var Rgn: HRGN; begin Result := CreateRectRgnIndirect(GetFullItemRect(Item)); if not IsRectEmpty(Item.FBeginGroupRect) then begin Rgn := CreateRectRgnIndirect(Item.FBeginGroupRect); CombineRgn(Result, Result, Rgn, RGN_OR); DeleteObject(Rgn); end; end; function TdxBarControl.GetToolbarBrush: HBRUSH; begin Result := PainterClass.BarToolbarBrushEx(Self); end; function TdxBarControl.ItemAtPosEx(Pos: TPoint; var IsBeginGroup, IsFirstPart, IsVerticalDirection: Boolean): TdxBarItemControl; var I: Integer; Control: TdxBarItemControl; R: TRect; AVertical: Boolean; begin Result := inherited ItemAtPosEx(Pos, IsBeginGroup, IsFirstPart, IsVerticalDirection); if (Result = nil) and PtInRect(ClientRect, Pos) then begin IsBeginGroup := False; IsFirstPart := False; for I := 0 to ItemLinks.VisibleItemCount - 1 do begin Control := ItemLinks.VisibleItems[I].Control; if Control.CanCustomize and Control.FLastInRow then begin R := GetItemRect(Control); AVertical := Vertical; if AVertical and (R.Left <= Pos.X) and (Pos.X < R.Right) or not AVertical and (R.Top <= Pos.Y) and (Pos.Y < R.Bottom) then begin if AVertical and (Pos.Y < R.Top) or not AVertical and (Pos.X < R.Left) then begin IsFirstPart := True; if Control.Align in [iaCenter, iaRight] then Result := Control else Result := ItemLinks.VisibleItems[1].Control; end else Result := Control; Break; end; end; end; end; end; function TdxBarControl.NotHandleMouseMove(P: TPoint): Boolean; function ControlContainerActive: Boolean; {var Control: TWinControl;} begin {Control := FindControl(GetActiveWindow); Result := (Control is TCustomdxBarControl) and (TCustomdxBarControl(Control).BarManager = BarManager);} Result := HasAsParent(GetActiveWindow, {GetMainForm}BarManager.MainForm.Handle); end; begin with TDummyForm(BarManager.MainForm) do // with TDummyForm(GetMainForm) do Result := inherited NotHandleMouseMove(P) or (DockingStyle <> dsNone) and ((FormStyle = fsMDIForm) and not Application.Active or (FormStyle <> fsMDIForm) and not Active and not ControlContainerActive); end; procedure TdxBarControl.PaintItem(AControl: TdxBarItemControl); var AItemRect: TRect; DC: HDC; PrevClipRgn: HRGN; ClipRgnExists: Boolean; begin inherited; if (AControl = nil) or (AControl.ItemLink = nil) or (Bar <> nil) and Bar.LockUpdate then Exit; AItemRect := GetItemRect(AControl); // TODO: !!! if FInRepaint then begin Windows.InvalidateRect(Handle, @AItemRect, False); // FInRepaint := False; // Windows.UpdateWindow(Handle); Exit; end; DC := Canvas.Handle; SaveClipRgn(DC, PrevClipRgn, ClipRgnExists); with AItemRect do IntersectClipRect(DC, Left, Top, Right, Bottom); try if IsVertical(Self) then AControl.Paint(AItemRect, ptVert) else AControl.Paint(AItemRect, ptHorz); DrawSelectedItem(AControl); finally RestoreClipRgn(DC, PrevClipRgn, ClipRgnExists); end; end; procedure TdxBarControl.RebuildBar; begin UpdateDoubleBuffered; FrameChanged; RepaintBar; end; procedure TdxBarControl.RefreshShadow; begin FShadow.Refresh; end; procedure TdxBarControl.RepaintMDIButtons; var AButtons: TdxBarMDIButtons; begin if RealMDIButtonsOnBar then AButtons := [mdibMinimize, mdibRestore, mdibClose] else AButtons := [mdibClose]; DrawMDIButtons(0, AButtons); end; procedure TdxBarControl.SavePos; begin if FBar.Visible and not FMoving and not BarManager.IsDestroying then if DockingStyle = dsNone then with Bar do begin FloatLeft := Self.Left; FloatTop := Self.Top; FloatClientWidth := ClientWidth; FloatClientHeight := ClientHeight; end else if (DockControl <> nil) and not DockControl.IsBarHandleDestroying and not BarManager.IsHandleCreating then begin FBar.DockedDockingStyle := DockingStyle; if FDockControl.Main then FBar.DockedDockControl := nil else FBar.DockedDockControl := TdxBarDockControl(FDockControl); FBar.Row := GetRow; if GetDockCol <> nil then begin FBar.OneOnRow := GetDockCol.DockRow.ColList.Count = 1; FBar.DockedLeft := Left; FBar.DockedTop := Top; end; end; end; procedure TdxBarControl.SetFont; begin Font := Bar.Font; end; procedure TdxBarControl.SetIsActive(Value: Boolean); begin if not Value then begin if IsCustomizing and (SelectedItem <> nil) then SetMouseSelectedItem(nil); if IsActive and (SelectedItem is TdxBarButtonControl) and TdxBarButtonControl(SelectedItem).DroppedDown then SelectedItem.ControlInactivate(True); if IsDowned then begin IsDowned := False; if not IsCustomizing then {HideAll;//}BarLostFocus; end; end; inherited SetIsActive(Value); BarLostFocus; // !!! end; procedure TdxBarControl.SetDockingStyle(Value: TdxBarDockingStyle); begin if DockingStyle <> Value then FTruncated := False; inherited; end; procedure TdxBarControl.SetKeySelectedItem(Value: TdxBarItemControl); var PrevSelectedItem: TdxBarItemControl; begin PrevSelectedItem := FSelectedItem; inherited SetKeySelectedItem(Value); if (FSelectedItem <> PrevSelectedItem) and (SelectedItem <> nil) and not SelectedItem.IsActive and not IsCustomizing then if SelectedItem is TdxBarSubItemControl then SelectedItem.ControlClick(False) else SelectedItem.ControlActivate(True); end; procedure TdxBarControl.FillBackground(DC: HDC; ARect: TRect; ABrush: HBRUSH; AColor: TColor; AIsClientArea: Boolean); var R: TRect; ANCOffset: TPoint; begin // calc rect R := ARect; if AIsClientArea then begin ANCOffset := NCOffset; OffsetRect(R, ANCOffset.X, ANCOffset.Y); end; // check background if not Bar.BackgroundBitmap.Empty then FillBackgroundRect(DC, ARect, R, ABrush, AColor, Bar.BackgroundBitmap) else begin if Bar.IsStatusBar and BarManager.Backgrounds.Bar.Empty then PainterClass.StatusBarFillBackground(Self, DC, ARect, R, Rect(0, 0, Width, Height), ABrush, AColor) else begin if Bar.Color = clDefault then inherited FillBackground(DC, ARect, ABrush, AColor, AIsClientArea) else begin FillRectByColor(DC, ARect, Bar.Color); // TODO end; end; end; end; function TdxBarControl.IsBackgroundBitmap: Boolean; begin Result := inherited IsBackgroundBitmap or not Bar.BackgroundBitmap.Empty or not BarManager.Backgrounds.Bar.Empty; end; function TdxBarControl.IsTransparent: Boolean; begin Result := (Bar.Color <> clDefault) or not Bar.BackgroundBitmap.Empty or not BarManager.Backgrounds.Bar.Empty or inherited IsTransparent; end; function TdxBarControl.NCOffset: TPoint; var WR: TRect; P: TPoint; begin Result := inherited NCOffset; // if DockingStyle <> dsNone then begin GetWindowRect(WR); P := ClientToScreen(Point(0, 0)); Inc(Result.X, P.X - WR.Left); Inc(Result.Y, P.Y - WR.Top); end; end; procedure TdxBarControl.SetLayeredAttributes; var AAlphaBlendValue: Byte; begin if FMoving or ((DockingStyle = dsNone) and not IsInternal) then AAlphaBlendValue := Bar.AlphaBlendValue else AAlphaBlendValue := 255; if FMoving then SetLayeredWndAttributes(FFloatingHandle, AAlphaBlendValue) else SetLayeredWndAttributes(Handle, AAlphaBlendValue); end; procedure TdxBarControl.SetMarkState(Value: TdxBarMarkState); var R: TRect; begin if IsCustomizing then Exit; if FMarkState <> Value then begin FMarkState := Value; FinishMoreButtonsHintTimer; R := MarkRect; if FMarkState = msPressed then begin //PlaySound(psMenuPopup); MapWindowPoints(Handle, 0, R, 2); FQuickPopup := TdxBarQuickControl.CreateWithOwnerBar(BarManager, Self); TdxBarQuickControl(FQuickPopup).Popup(R); PlaySound(psMenuPopup); end else begin if FQuickPopup <> nil then begin FQuickPopup.Free; FQuickPopup := nil; end; if FMarkState = msSelected then begin if DockingStyle = dsNone then StartMoreButtonsHintTimer; BarManager.HintActivate(True, cxGetResourceString(@dxSBAR_MOREBUTTONS)); end else if SelectedItem = nil then BarManager.HintActivate(False, ''); end; InvalidateMark; end; end; procedure TdxBarControl.BarGetFocus(ASelectedItem: TdxBarItemControl); var P: TPoint; AControl: TWinControl; ItemLink: TdxBarItemLink; begin //if (ItemLinks.First <> nil) and (ItemLinks.First.Control <> nil) then begin GetCursorPos(P); AControl := FindControl(WindowFromPointEx(P)); if (AControl is TCustomdxBarControl) and (AControl <> Self) then FinishMouseTracking(AControl.Handle); GetMainForm.SendCancelMode(nil); BeforeBarGetFocusFocusedWnd := GetFocus; if not IsCustomizing and not ((Self is TdxBarQuickControl) and TdxBarQuickControl(Self).FOwnerBar.Focused) then SetWindowPos(GetMainForm.Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); if ASelectedItem = nil then begin ItemLink := nil; repeat ItemLink := ItemLinks.Next(ItemLink); until (ItemLink = nil) or (ItemLink.Control <> nil) and not (ItemLink.Control is TSystemMenuSubItemControl); // !!! if ItemLink <> nil then ASelectedItem := ItemLink.Control; end; SetKeySelectedItem(ASelectedItem); IsActive := True; BarManager.FFocusedBarControl := Self; end; end; procedure TdxBarControl.BarLostFocus; var P: TPoint; AControl: TWinControl; begin if BarManager.FocusedBarControl = Self then begin BarManager.FFocusedBarControl := nil; SetKeySelectedItem(nil); IsActive := False; GetCursorPos(P); AControl := FindControl(WindowFromPointEx(P)); if AControl is TCustomdxBarControl then with TCustomdxBarControl(AControl) do begin Windows.ScreenToClient(Handle, P); FLastMousePos := Point(-1, -1); PostMessage(Handle, WM_MOUSEMOVE, 0, MakeLParam(P.X, P.Y)); end; if Application.Active and GetMainForm.Active and // -> bug with toolbars' hiding (without Application.Active) IsWindowVisible(BeforeBarGetFocusFocusedWnd) then Windows.SetFocus(BeforeBarGetFocusFocusedWnd); end; end; procedure TdxBarControl.HideAll; begin BarLostFocus; inherited HideAll; { if not BarManager.IsDestroying then ProcessPaintMessages;} end; procedure TdxBarControl.Repaint; begin if not ((Bar <> nil) and Bar.LockUpdate) then inherited; end; procedure TdxBarControl.RepaintBar; var PrevSelectedItemLink: TdxBarItemLink; P: TPoint; begin if FDestroyFlag or (Bar <> nil) and Bar.LockUpdate or not HandleAllocated then Exit; PrevSelectedItemLink := nil; if IsCustomizing then begin if (BarManager.SelectedItem <> nil) and (BarManager.SelectedItem.Parent = Self) then begin PrevSelectedItemLink := BarManager.SelectedItem.ItemLink; BarManager.FSelectedItem := nil; end; FSelectedItem := nil; end; DestroyControls; CreateControls; if IsCustomizing and (PrevSelectedItemLink <> nil) then SetKeySelectedItem(PrevSelectedItemLink.Control); if DockingStyle = dsNone then if HandleAllocated then begin P := GetSizeForWidth(DockingStyle, ClientWidth); ClientWidth := P.X; ClientHeight := P.Y; end else else FDockControl.UpdateDock; //Repaint; CalcControlsPositions; Invalidate; if IsTransparent then SendMessage(Handle, WM_NCPAINT, 0, 0); end; initialization FUser32DLL := LoadLibrary('USER32'); if FUser32DLL > 32 then begin @TrackMouseEvent := GetProcAddress(FUser32DLL, 'TrackMouseEvent'); @UpdateLayeredWindow := GetProcAddress(FUser32DLL, 'UpdateLayeredWindow'); @AnimateWindowProc := GetProcAddress(FUser32DLL, 'AnimateWindow'); @SetLayeredWindowAttributes := GetProcAddress(FUser32DLL, 'SetLayeredWindowAttributes'); end; GetMem(AClassName, 256); InternalItemList := TList.Create; dxBarManagerList := TdxBarManagerList.Create; RefreshDeviceConsts; CreatePatternBrush; RegisterClass(TdxBarGroup); FRegItemList := TList.Create; FBarControls := TList.Create; dxBarRegisterItem(TdxBarButton, TdxBarButtonControl, True); dxBarRegisterItem(TdxBarEdit, TdxBarEditControl, True); dxBarRegisterItem(TCustomdxBarCombo, TCustomdxBarComboControl, True); dxBarRegisterItem(TdxBarCombo, TdxBarComboControl, True); dxBarRegisterItem(TdxBarSubItem, TdxBarSubItemControl, True); dxBarRegisterItem(TdxBarListItem, TdxBarContainerItemControl, True); dxBarRegisterItem(TdxBarContainerItem, TdxBarContainerItemControl, True); dxBarRegisterItem(TdxBarQuickCustExtButton, TdxBarQuickCustExtButtonControl, False); dxBarRegisterItem(TdxBarQuickCustItem, TdxBarQuickCustItemControl, False); dxBarRegisterItem(TdxBarQuickSubItem, TdxBarSubItemControl, False); dxBarRegisterItem(TSystemMenuSubItem, TSystemMenuSubItemControl, False); Screen.Cursors[crdxBarDrag] := LoadCursor(HInstance, 'DXBARDRAGCURSOR'); Screen.Cursors[crdxBarDragCopy] := LoadCursor(HInstance, 'DXBARDRAGCOPYCURSOR'); Screen.Cursors[crdxBarDragNoDrop] := LoadCursor(HInstance, 'DXBARDRAGNODROPCURSOR'); Screen.Cursors[crdxBarEditSizing] := LoadCursor(HInstance, 'DXBAREDITSIZINGCURSOR'); finalization dxBarUnregisterItem(TSystemMenuSubItem); dxBarUnregisterItem(TdxBarQuickSubItem); dxBarUnregisterItem(TdxBarQuickCustItem); dxBarUnregisterItem(TdxBarQuickCustExtButton); dxBarUnregisterItem(TdxBarContainerItem); dxBarUnregisterItem(TdxBarListItem); dxBarUnregisterItem(TdxBarSubItem); dxBarUnregisterItem(TdxBarCombo); dxBarUnregisterItem(TCustomdxBarCombo); dxBarUnregisterItem(TdxBarEdit); dxBarUnregisterItem(TdxBarButton); FBarControls.Free; with FRegItemList do begin while Count > 0 do begin TRegItemRecord(Last).Free; Remove(Last); end; Free; end; DeleteObject(PatternBrush); dxBarManagerList.Free; dxBarManagerList := nil; InternalItemList.Free; FreeMem(AClassName, 256); if FUser32DLL > 32 then FreeLibrary(FUser32DLL); end.