unit TB2Dock; { Toolbar2000 Copyright (C) 1998-2008 by Jordan Russell All rights reserved. The contents of this file are subject to the "Toolbar2000 License"; you may not use or distribute this file except in compliance with the "Toolbar2000 License". A copy of the "Toolbar2000 License" may be found in TB2k-LICENSE.txt or at: http://www.jrsoftware.org/files/tb2k/TB2k-LICENSE.txt Alternatively, the contents of this file may be used under the terms of the GNU General Public License (the "GPL"), in which case the provisions of the GPL are applicable instead of those in the "Toolbar2000 License". A copy of the GPL may be found in GPL-LICENSE.txt or at: http://www.jrsoftware.org/files/tb2k/GPL-LICENSE.txt If you wish to allow use of your version of this file only under the terms of the GPL and not to allow others to use your version of this file under the "Toolbar2000 License", indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL. If you do not delete the provisions above, a recipient may use your version of this file under either the "Toolbar2000 License" or the GPL. $jrsoftware: tb2k/Source/TB2Dock.pas,v 1.127 2008/09/17 20:12:25 jr Exp $ } interface {x$DEFINE TB2Dock_DisableLock} { Remove the 'x' to enable the define. It will disable calls to LockWindowUpdate, which it calls to disable screen updates while dragging. You may want to temporarily enable the define while debugging so you are able to see your code window while stepping through the dragging routines. } {$I TB2Ver.inc} uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, IniFiles; type TTBCustomForm = {$IFDEF JR_D3} TCustomForm {$ELSE} TForm {$ENDIF}; { TTBDock } TTBDockBoundLinesValues = (blTop, blBottom, blLeft, blRight); TTBDockBoundLines = set of TTBDockBoundLinesValues; TTBDockPosition = (dpTop, dpBottom, dpLeft, dpRight); TTBDockType = (dtNotDocked, dtFloating, dtTopBottom, dtLeftRight); TTBDockableTo = set of TTBDockPosition; TTBCustomDockableWindow = class; TTBBasicBackground = class; TTBInsertRemoveEvent = procedure(Sender: TObject; Inserting: Boolean; Bar: TTBCustomDockableWindow) of object; TTBRequestDockEvent = procedure(Sender: TObject; Bar: TTBCustomDockableWindow; var Accept: Boolean) of object; TTBDock = class(TCustomControl) private { Property values } FPosition: TTBDockPosition; FAllowDrag: Boolean; FBoundLines: TTBDockBoundLines; FBackground: TTBBasicBackground; FBkgOnToolbars: Boolean; FFixAlign: Boolean; FCommitNewPositions: Boolean; FLimitToOneRow: Boolean; FOnInsertRemoveBar: TTBInsertRemoveEvent; FOnRequestDock: TTBRequestDockEvent; {$IFNDEF JR_D4} FOnResize: TNotifyEvent; {$ENDIF} { Internal } FDisableArrangeToolbars: Integer; { Increment to disable ArrangeToolbars } FArrangeToolbarsNeeded: Boolean; FNonClientWidth, FNonClientHeight: Integer; DockList: TList; { List of the toolbars docked, and those floating and have LastDock pointing to the dock. Items are casted in TTBCustomDockableWindow's. } DockVisibleList: TList; { Similar to DockList, but lists only docked and visible toolbars } { Property access methods } //function GetVersion: TToolbar97Version; procedure SetAllowDrag(Value: Boolean); procedure SetBackground(Value: TTBBasicBackground); procedure SetBackgroundOnToolbars(Value: Boolean); procedure SetBoundLines(Value: TTBDockBoundLines); procedure SetFixAlign(Value: Boolean); procedure SetPosition(Value: TTBDockPosition); //procedure SetVersion(const Value: TToolbar97Version); function GetToolbarCount: Integer; function GetToolbars(Index: Integer): TTBCustomDockableWindow; { Internal } procedure BackgroundChanged(Sender: TObject); procedure ChangeDockList(const Insert: Boolean; const Bar: TTBCustomDockableWindow); procedure ChangeWidthHeight(const NewWidth, NewHeight: Integer); procedure CommitPositions; procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); function GetDesignModeRowOf(const XY: Integer): Integer; function HasVisibleToolbars: Boolean; procedure RelayMsgToFloatingBars({$IFNDEF CLR}var{$ELSE}const{$ENDIF} Message: TMessage); function ToolbarVisibleOnDock(const AToolbar: TTBCustomDockableWindow): Boolean; procedure ToolbarVisibilityChanged(const Bar: TTBCustomDockableWindow; const ForceRemove: Boolean); { Messages } procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR; procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY; procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMMove(var Message: TWMMove); message WM_MOVE; {$IFNDEF JR_D4} procedure WMSize(var Message: TWMSize); message WM_SIZE; {$ENDIF} procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; procedure WMPrint(var Message: TMessage); message WM_PRINT; procedure WMPrintClient(var Message: {$IFNDEF CLR} TMessage {$ELSE} TWMPrintClient {$ENDIF}); message WM_PRINTCLIENT; procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND; protected procedure AlignControls(AControl: TControl; var Rect: TRect); override; procedure CreateParams(var Params: TCreateParams); override; procedure DrawBackground(DC: HDC; const DrawRect: TRect); virtual; function GetPalette: HPALETTE; override; procedure InvalidateBackgrounds; procedure Loaded; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SetParent(AParent: TWinControl); override; procedure Paint; override; function UsingBackground: Boolean; virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure ArrangeToolbars; procedure BeginUpdate; procedure EndUpdate; function GetCurrentRowSize(const Row: Integer; var AFullSize: Boolean): Integer; function GetHighestRow(const HighestEffective: Boolean): Integer; function GetMinRowSize(const Row: Integer; const ExcludeControl: TTBCustomDockableWindow): Integer; property CommitNewPositions: Boolean read FCommitNewPositions write FCommitNewPositions; property NonClientWidth: Integer read FNonClientWidth; property NonClientHeight: Integer read FNonClientHeight; property ToolbarCount: Integer read GetToolbarCount; property Toolbars[Index: Integer]: TTBCustomDockableWindow read GetToolbars; published property AllowDrag: Boolean read FAllowDrag write SetAllowDrag default True; property Background: TTBBasicBackground read FBackground write SetBackground; property BackgroundOnToolbars: Boolean read FBkgOnToolbars write SetBackgroundOnToolbars default True; property BoundLines: TTBDockBoundLines read FBoundLines write SetBoundLines default []; property Color default clBtnFace; property FixAlign: Boolean read FFixAlign write SetFixAlign default False; property LimitToOneRow: Boolean read FLimitToOneRow write FLimitToOneRow default False; property PopupMenu; property Position: TTBDockPosition read FPosition write SetPosition default dpTop; //property Version: TToolbar97Version read GetVersion write SetVersion stored False; property Visible; {$IFDEF JR_D5} property OnContextPopup; {$ENDIF} property OnInsertRemoveBar: TTBInsertRemoveEvent read FOnInsertRemoveBar write FOnInsertRemoveBar; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnRequestDock: TTBRequestDockEvent read FOnRequestDock write FOnRequestDock; {$IFDEF JR_D4} property OnResize; {$ELSE} property OnResize: TNotifyEvent read FOnResize write FOnResize; {$ENDIF} end; { TTBFloatingWindowParent - internal } TTBToolWindowNCRedrawWhatElement = (twrdBorder, twrdCaption, twrdCloseButton); TTBToolWindowNCRedrawWhat = set of TTBToolWindowNCRedrawWhatElement; TTBFloatingWindowParentClass = class of TTBFloatingWindowParent; TTBFloatingWindowParent = class(TCustomForm) private FCloseButtonDown: Boolean; { True if Close button is currently depressed } FDockableWindow: TTBCustomDockableWindow; FParentForm: TTBCustomForm; FShouldShow: Boolean; procedure CallRecreateWnd; function GetCaptionRect(const AdjustForBorder, MinusCloseButton: Boolean): TRect; function GetCloseButtonRect(const AdjustForBorder: Boolean): TRect; procedure SetCloseButtonState(Pushed: Boolean); procedure RedrawNCArea(const RedrawWhat: TTBToolWindowNCRedrawWhat); procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED; procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY; procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE; procedure WMClose(var Message: TWMClose); message WM_CLOSE; procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO; procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE; procedure WMMove(var Message: TWMMove); message WM_MOVE; procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; procedure WMNCLButtonDblClk(var Message: TWMNCLButtonDblClk); message WM_NCLBUTTONDBLCLK; procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN; procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; procedure WMNCRButtonUp(var Message: TWMNCRButtonUp); message WM_NCRBUTTONUP; procedure WMPrint(var Message: TMessage); message WM_PRINT; procedure WMPrintClient(var Message: {$IFNDEF CLR} TMessage {$ELSE} TWMPrintClient {$ENDIF}); message WM_PRINTCLIENT; protected procedure AlignControls(AControl: TControl; var Rect: TRect); override; procedure CreateParams(var Params: TCreateParams); override; procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN; RedrawWhat: TTBToolWindowNCRedrawWhat); dynamic; procedure Notification(AComponent: TComponent; Operation: TOperation); override; property DockableWindow: TTBCustomDockableWindow read FDockableWindow; property CloseButtonDown: Boolean read FCloseButtonDown; public property ParentForm: TTBCustomForm read FParentForm; end; { TTBCustomDockableWindow } TTBDockChangingEvent = procedure(Sender: TObject; Floating: Boolean; DockingTo: TTBDock) of object; TTBDragHandleStyle = (dhDouble, dhNone, dhSingle); TTBDockMode = (dmCanFloat, dmCannotFloat, dmCannotFloatOrChangeDocks); TTBFloatingMode = (fmOnTopOfParentForm, fmOnTopOfAllForms); TTBSizeHandle = (twshLeft, twshRight, twshTop, twshTopLeft, twshTopRight, twshBottom, twshBottomLeft, twshBottomRight); { ^ must be in same order as HTLEFT..HTBOTTOMRIGHT } TTBPositionExtraData = {$IFNDEF CLR} Pointer {$ELSE} TObject {$ENDIF}; TTBPositionReadIntProc = function(const ToolbarName, Value: String; const Default: Longint; const ExtraData: TTBPositionExtraData): Longint; TTBPositionReadStringProc = function(const ToolbarName, Value, Default: String; const ExtraData: TTBPositionExtraData): String; TTBPositionWriteIntProc = procedure(const ToolbarName, Value: String; const Data: Longint; const ExtraData: TTBPositionExtraData); TTBPositionWriteStringProc = procedure(const ToolbarName, Value, Data: String; const ExtraData: TTBPositionExtraData); TTBReadPositionData = record ReadIntProc: TTBPositionReadIntProc; ReadStringProc: TTBPositionReadStringProc; ExtraData: TTBPositionExtraData; end; TTBWritePositionData = record WriteIntProc: TTBPositionWriteIntProc; WriteStringProc: TTBPositionWriteStringProc; ExtraData: TTBPositionExtraData; end; TTBDockableWindowStyles = set of (tbdsResizeEightCorner, tbdsResizeClipCursor); TTBShrinkMode = (tbsmNone, tbsmWrap, tbsmChevron); TTBCustomDockableWindow = class(TCustomControl) private { Property variables } FAutoResize: Boolean; FDockPos, FDockRow, FEffectiveDockPos, FEffectiveDockRow: Integer; FDocked: Boolean; FCurrentDock, FDefaultDock, FLastDock: TTBDock; FCurrentSize: Integer; FFloating: Boolean; FOnClose, FOnDockChanged, FOnMove, FOnRecreated, FOnRecreating, {$IFNDEF JR_D4} FOnResize, {$ENDIF} FOnVisibleChanged: TNotifyEvent; FOnCloseQuery: TCloseQueryEvent; FOnDockChanging, FOnDockChangingHidden: TTBDockChangingEvent; FActivateParent, FHideWhenInactive, FCloseButton, FCloseButtonWhenDocked, FFullSize, FResizable, FShowCaption, FStretch, FUseLastDock: Boolean; FBorderStyle: TBorderStyle; FDockMode: TTBDockMode; FDragHandleStyle: TTBDragHandleStyle; FDockableTo: TTBDockableTo; FFloatingMode: TTBFloatingMode; FSmoothDrag: Boolean; FDockableWindowStyles: TTBDockableWindowStyles; FLastRowSize: Integer; FInsertRowBefore: Boolean; { Misc. } FUpdatingBounds, { Incremented while internally changing the bounds. This allows it to move the toolbar freely in design mode and prevents the SizeChanging protected method from begin called } FDisableArrange, { Incremented to disable Arrange } FDisableOnMove, { Incremented to prevent WM_MOVE handler from calling the OnMoved handler } FHidden: Integer; { Incremented while the toolbar is temporarily hidden } FArrangeNeeded, FMoved: Boolean; FInactiveCaption: Boolean; { True when the caption of the toolbar is currently the inactive color } FFloatingPosition: TPoint; FDockForms: TList; FSavedAtRunTime: Boolean; //FNonClientWidth, FNonClientHeight: Integer; FDragMode, FDragSplitting, FDragCanSplit: Boolean; FSmoothDragging: Boolean; { When floating. These are not used in design mode } FCloseButtonDown: Boolean; { True if Close button is currently depressed } FCloseButtonHover: Boolean; FFloatParent: TTBFloatingWindowParent; { Run-time only: The actual Parent of the toolbar when it is floating } { Property access methods } //function GetVersion: TToolbar97Version; function GetNonClientWidth: Integer; function GetNonClientHeight: Integer; function IsLastDockStored: Boolean; function IsWidthAndHeightStored: Boolean; procedure SetAutoResize(Value: Boolean); procedure SetBorderStyle(Value: TBorderStyle); procedure SetCloseButton(Value: Boolean); procedure SetCloseButtonWhenDocked(Value: Boolean); procedure SetCurrentDock(Value: TTBDock); procedure SetDefaultDock(Value: TTBDock); procedure SetDockPos(Value: Integer); procedure SetDockRow(Value: Integer); procedure SetDragHandleStyle(Value: TTBDragHandleStyle); procedure SetFloating(Value: Boolean); procedure SetFloatingMode(Value: TTBFloatingMode); procedure SetFloatingPosition(Value: TPoint); procedure SetFullSize(Value: Boolean); procedure SetLastDock(Value: TTBDock); procedure SetResizable(Value: Boolean); procedure SetShowCaption(Value: Boolean); procedure SetStretch(Value: Boolean); procedure SetUseLastDock(Value: Boolean); //procedure SetVersion(const Value: TToolbar97Version); { Internal } procedure CancelNCHover; procedure DrawDraggingOutline(const DC: HDC; const NewRect, OldRect: TRect; const NewDocking, OldDocking: Boolean); procedure RedrawNCArea; procedure SetCloseButtonState(Pushed: Boolean); procedure ShowNCContextMenu(const PosX, PosY: Smallint); procedure Moved; function GetShowingState: Boolean; procedure UpdateCaptionState; procedure UpdateTopmostFlag; procedure UpdateVisibility; procedure ReadSavedAtRunTime(Reader: TReader); procedure WriteSavedAtRunTime(Writer: TWriter); { Messages } procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED; procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED; procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED; procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED; {$IFDEF JR_D5} procedure WMContextMenu(var Message: TWMContextMenu); message WM_CONTEXTMENU; {$ENDIF} procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMMove(var Message: TWMMove); message WM_MOVE; 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 WMNCMouseLeave(var Message: TMessage); message $2A2 {WM_NCMOUSELEAVE}; procedure WMNCMouseMove(var Message: TWMNCMouseMove); message WM_NCMOUSEMOVE; procedure WMNCLButtonDblClk(var Message: TWMNCLButtonDblClk); message WM_NCLBUTTONDBLCLK; procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN; procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; procedure WMNCRButtonUp(var Message: TWMNCRButtonUp); message WM_NCRBUTTONUP; procedure WMPrint(var Message: TMessage); message WM_PRINT; procedure WMPrintClient(var Message: {$IFNDEF CLR} TMessage {$ELSE} TWMPrintClient {$ENDIF}); message WM_PRINTCLIENT; procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR; {$IFNDEF JR_D4} procedure WMSize(var Message: TWMSize); message WM_SIZE; {$ENDIF} protected property ActivateParent: Boolean read FActivateParent write FActivateParent default True; property AutoResize: Boolean read FAutoResize write SetAutoResize default True; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle; property Color default clBtnFace; property CloseButton: Boolean read FCloseButton write SetCloseButton default True; property CloseButtonDown: Boolean read FCloseButtonDown; property CloseButtonHover: Boolean read FCloseButtonHover; property CloseButtonWhenDocked: Boolean read FCloseButtonWhenDocked write SetCloseButtonWhenDocked default False; property DefaultDock: TTBDock read FDefaultDock write SetDefaultDock; property DockableTo: TTBDockableTo read FDockableTo write FDockableTo default [dpTop, dpBottom, dpLeft, dpRight]; property DockableWindowStyles: TTBDockableWindowStyles read FDockableWindowStyles write FDockableWindowStyles; property DockMode: TTBDockMode read FDockMode write FDockMode default dmCanFloat; property DragHandleStyle: TTBDragHandleStyle read FDragHandleStyle write SetDragHandleStyle default dhSingle; property FloatingMode: TTBFloatingMode read FFloatingMode write SetFloatingMode default fmOnTopOfParentForm; property FullSize: Boolean read FFullSize write SetFullSize default False; property InactiveCaption: Boolean read FInactiveCaption; property HideWhenInactive: Boolean read FHideWhenInactive write FHideWhenInactive default True; property Resizable: Boolean read FResizable write SetResizable default True; property ShowCaption: Boolean read FShowCaption write SetShowCaption default True; property SmoothDrag: Boolean read FSmoothDrag write FSmoothDrag default True; property Stretch: Boolean read FStretch write SetStretch default False; property UseLastDock: Boolean read FUseLastDock write SetUseLastDock default True; //property Version: TToolbar97Version read GetVersion write SetVersion stored False; property OnClose: TNotifyEvent read FOnClose write FOnClose; property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery; property OnDockChanged: TNotifyEvent read FOnDockChanged write FOnDockChanged; property OnDockChanging: TTBDockChangingEvent read FOnDockChanging write FOnDockChanging; property OnDockChangingHidden: TTBDockChangingEvent read FOnDockChangingHidden write FOnDockChangingHidden; property OnMove: TNotifyEvent read FOnMove write FOnMove; property OnRecreated: TNotifyEvent read FOnRecreated write FOnRecreated; property OnRecreating: TNotifyEvent read FOnRecreating write FOnRecreating; {$IFNDEF JR_D4} property OnResize: TNotifyEvent read FOnResize write FOnResize; {$ENDIF} property OnVisibleChanged: TNotifyEvent read FOnVisibleChanged write FOnVisibleChanged; { Overridden methods } procedure CreateParams(var Params: TCreateParams); override; procedure DefineProperties(Filer: TFiler); override; function GetPalette: HPALETTE; override; procedure Loaded; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; function PaletteChanged(Foreground: Boolean): Boolean; override; procedure SetParent(AParent: TWinControl); override; { Methods accessible to descendants } procedure Arrange; function CalcNCSizes: TPoint; virtual; procedure ChangeSize(AWidth, AHeight: Integer); function ChildControlTransparent(Ctl: TControl): Boolean; dynamic; procedure Close; procedure ControlExistsAtPos(const P: TPoint; var ControlExists: Boolean); virtual; function DoArrange(CanMoveControls: Boolean; PreviousDockType: TTBDockType; NewFloating: Boolean; NewDock: TTBDock): TPoint; virtual; abstract; procedure DoDockChangingHidden(NewFloating: Boolean; DockingTo: TTBDock); dynamic; procedure DoubleClick; procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); virtual; procedure GetBaseSize(var ASize: TPoint); virtual; abstract; function GetDockedCloseButtonRect(LeftRight: Boolean): TRect; virtual; function GetFloatingWindowParentClass: TTBFloatingWindowParentClass; dynamic; procedure GetMinShrinkSize(var AMinimumSize: Integer); virtual; procedure GetMinMaxSize(var AMinClientWidth, AMinClientHeight, AMaxClientWidth, AMaxClientHeight: Integer); virtual; function GetShrinkMode: TTBShrinkMode; virtual; procedure InitializeOrdering; dynamic; function IsAutoResized: Boolean; procedure ResizeBegin(SizeHandle: TTBSizeHandle); dynamic; procedure ResizeEnd; dynamic; procedure ResizeTrack(var Rect: TRect; const OrigRect: TRect); dynamic; procedure ResizeTrackAccept; dynamic; procedure SizeChanging(const AWidth, AHeight: Integer); virtual; public property Docked: Boolean read FDocked; property Canvas; property CurrentDock: TTBDock read FCurrentDock write SetCurrentDock stored False; property CurrentSize: Integer read FCurrentSize write FCurrentSize; property DockPos: Integer read FDockPos write SetDockPos default -1; property DockRow: Integer read FDockRow write SetDockRow default 0; property DragMode: Boolean read FDragMode; property DragSplitting: Boolean read FDragSplitting; property EffectiveDockPos: Integer read FEffectiveDockPos; property EffectiveDockRow: Integer read FEffectiveDockRow; property Floating: Boolean read FFloating write SetFloating default False; property FloatingPosition: TPoint read FFloatingPosition write SetFloatingPosition; property LastDock: TTBDock read FLastDock write SetLastDock stored IsLastDockStored; property NonClientWidth: Integer read GetNonClientWidth; property NonClientHeight: Integer read GetNonClientHeight; constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetParentComponent: TComponent; override; function HasParent: Boolean; override; procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; procedure AddDockForm(const Form: TTBCustomForm); procedure AddDockedNCAreaToSize(var S: TPoint; const LeftRight: Boolean); procedure AddFloatingNCAreaToSize(var S: TPoint); procedure BeginMoving(const InitX, InitY: Integer); procedure BeginSizing(const ASizeHandle: TTBSizeHandle); procedure BeginUpdate; procedure DoneReadingPositionData(const Data: TTBReadPositionData); dynamic; procedure EndUpdate; procedure GetDockedNCArea(var TopLeft, BottomRight: TPoint; const LeftRight: Boolean); function GetFloatingBorderSize: TPoint; virtual; procedure GetFloatingNCArea(var TopLeft, BottomRight: TPoint); function IsMovable: Boolean; procedure MoveOnScreen(const OnlyIfFullyOffscreen: Boolean); procedure ReadPositionData(const Data: TTBReadPositionData); dynamic; procedure RemoveDockForm(const Form: TTBCustomForm); procedure WritePositionData(const Data: TTBWritePositionData); dynamic; published property Height stored IsWidthAndHeightStored; property Width stored IsWidthAndHeightStored; end; TTBBasicBackground = class(TComponent) protected procedure Draw(DC: HDC; const DrawRect: TRect); virtual; abstract; function GetPalette: HPALETTE; virtual; abstract; procedure RegisterChanges(Proc: TNotifyEvent); virtual; abstract; procedure SysColorChanged; virtual; abstract; procedure UnregisterChanges(Proc: TNotifyEvent); virtual; abstract; function UsingBackground: Boolean; virtual; abstract; end; TTBBackground = class(TTBBasicBackground) private FBitmap, FBitmapCache: TBitmap; FBkColor: TColor; FNotifyList: TList; FTransparent: Boolean; procedure BitmapChanged(Sender: TObject); procedure SetBitmap(Value: TBitmap); procedure SetBkColor(Value: TColor); procedure SetTransparent(Value: Boolean); protected procedure Draw(DC: HDC; const DrawRect: TRect); override; function GetPalette: HPALETTE; override; procedure RegisterChanges(Proc: TNotifyEvent); override; procedure SysColorChanged; override; procedure UnregisterChanges(Proc: TNotifyEvent); override; function UsingBackground: Boolean; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Bitmap: TBitmap read FBitmap write SetBitmap; property BkColor: TColor read FBkColor write SetBkColor default clBtnFace; property Transparent: Boolean read FTransparent write SetTransparent default False; end; procedure TBRegLoadPositions(const OwnerComponent: TComponent; const RootKey: DWORD; const BaseRegistryKey: String); procedure TBRegSavePositions(const OwnerComponent: TComponent; const RootKey: DWORD; const BaseRegistryKey: String); procedure TBIniLoadPositions(const OwnerComponent: TComponent; const Filename, SectionNamePrefix: String); overload; procedure TBIniLoadPositions(const OwnerComponent: TComponent; const IniFile: TCustomIniFile; const SectionNamePrefix: String); overload; procedure TBIniSavePositions(const OwnerComponent: TComponent; const Filename, SectionNamePrefix: String); overload; procedure TBIniSavePositions(const OwnerComponent: TComponent; const IniFile: TCustomIniFile; const SectionNamePrefix: String); overload; procedure TBCustomLoadPositions(const OwnerComponent: TComponent; const ReadIntProc: TTBPositionReadIntProc; const ReadStringProc: TTBPositionReadStringProc; const ExtraData: TTBPositionExtraData); procedure TBCustomSavePositions(const OwnerComponent: TComponent; const WriteIntProc: TTBPositionWriteIntProc; const WriteStringProc: TTBPositionWriteStringProc; const ExtraData: TTBPositionExtraData); function TBGetDockTypeOf(const Control: TTBDock; const Floating: Boolean): TTBDockType; function TBGetToolWindowParentForm(const ToolWindow: TTBCustomDockableWindow): TTBCustomForm; function TBValidToolWindowParentForm(const ToolWindow: TTBCustomDockableWindow): TTBCustomForm; implementation uses {$IFDEF CLR} Types, System.Runtime.InteropServices, {$ENDIF} Registry, Consts, Menus, TB2Common, TB2Hook, TB2Consts; type TControlAccess = class(TControl); const DockedBorderSize = 2; DockedBorderSize2 = DockedBorderSize*2; DragHandleSizes: array[Boolean, TTBDragHandleStyle] of Integer = ((9, 0, 6), (14, 14, 14)); DragHandleXOffsets: array[Boolean, TTBDragHandleStyle] of Integer = ((2, 0, 1), (3, 0, 5)); HT_TB2k_Border = 2000; HT_TB2k_Close = 2001; HT_TB2k_Caption = 2002; DefaultBarWidthHeight = 8; ForceDockAtTopRow = 0; ForceDockAtLeftPos = -8; PositionLeftOrRight = [dpLeft, dpRight]; twrdAll = [Low(TTBToolWindowNCRedrawWhatElement)..High(TTBToolWindowNCRedrawWhatElement)]; { Constants for TTBCustomDockableWindow registry values/data. Don't localize any of these names! } rvRev = 'Rev'; rdCurrentRev = 2000; rvVisible = 'Visible'; rvDockedTo = 'DockedTo'; rdDockedToFloating = '+'; rvLastDock = 'LastDock'; rvDockRow = 'DockRow'; rvDockPos = 'DockPos'; rvFloatLeft = 'FloatLeft'; rvFloatTop = 'FloatTop'; threadvar FloatingToolWindows: TList; { Misc. functions } function GetSmallCaptionHeight: Integer; { Returns height of the caption of a small window } begin Result := GetSystemMetrics(SM_CYSMCAPTION); end; function GetMDIParent(const Form: TTBCustomForm): TTBCustomForm; { Returns the parent of the specified MDI child form. But, if Form isn't a MDI child, it simply returns Form. } var I, J: Integer; begin Result := Form; if Form = nil then Exit; if {$IFDEF JR_D3} (Form is TForm) and {$ENDIF} (TForm(Form).FormStyle = fsMDIChild) then for I := 0 to Screen.FormCount-1 do with Screen.Forms[I] do begin if FormStyle <> fsMDIForm then Continue; for J := 0 to MDIChildCount-1 do if MDIChildren[J] = Form then begin Result := Screen.Forms[I]; Exit; end; end; end; function TBGetDockTypeOf(const Control: TTBDock; const Floating: Boolean): TTBDockType; begin if Floating then Result := dtFloating else if Control = nil then Result := dtNotDocked else begin if not(Control.Position in PositionLeftOrRight) then Result := dtTopBottom else Result := dtLeftRight; end; end; function TBGetToolWindowParentForm(const ToolWindow: TTBCustomDockableWindow): TTBCustomForm; var Ctl: TWinControl; begin Result := nil; Ctl := ToolWindow; while Assigned(Ctl.Parent) do begin if Ctl.Parent is TTBCustomForm then Result := TTBCustomForm(Ctl.Parent); Ctl := Ctl.Parent; end; { ^ for compatibility with ActiveX controls, that code is used instead of GetParentForm because it returns nil unless the form is the *topmost* parent } if Result is TTBFloatingWindowParent then Result := TTBFloatingWindowParent(Result).ParentForm; end; function TBValidToolWindowParentForm(const ToolWindow: TTBCustomDockableWindow): TTBCustomForm; begin Result := TBGetToolWindowParentForm(ToolWindow); if Result = nil then raise EInvalidOperation.{$IFDEF JR_D3}CreateFmt{$ELSE}CreateResFmt{$ENDIF} (SParentRequired, [ToolWindow.Name]); end; procedure SetWindowOwner(const Wnd, NewOwnerWnd: HWND); begin SetWindowLong(Wnd, GWL_HWNDPARENT, {$IFDEF JR_D11} LONG_PTR {$ELSE} Longint {$ENDIF} (NewOwnerWnd)); end; procedure ToolbarHookProc(Code: THookProcCode; Wnd: HWND; WParam: WPARAM; LParam: LPARAM); var I: Integer; ToolWindow: TTBCustomDockableWindow; WindowPos: {$IFNDEF CLR} PWindowPos {$ELSE} TWindowPos {$ENDIF}; Form: TTBCustomForm; begin case Code of hpSendActivate, hpSendActivateApp: begin if Assigned(FloatingToolWindows) then for I := 0 to FloatingToolWindows.Count-1 do { Hide or restore toolbars when a form or the application is deactivated or activated, and/or update their caption state (active/inactive) } TTBCustomDockableWindow(FloatingToolWindows[I]).UpdateVisibility; end; hpSendWindowPosChanged: begin if Assigned(FloatingToolWindows) then begin {$IFNDEF CLR} WindowPos := PWindowPos(LParam); {$ELSE} WindowPos := TWindowPos(Marshal.PtrToStructure(IntPtr(LParam), TypeOf(TWindowPos))); {$ENDIF} for I := 0 to FloatingToolWindows.Count-1 do begin ToolWindow := TTBCustomDockableWindow(FloatingToolWindows[I]); if (ToolWindow.FFloatingMode = fmOnTopOfParentForm) and ToolWindow.HandleAllocated then begin { Call UpdateVisibility if parent form's visibility has changed, or if it has been minimized or restored } if ((WindowPos.flags and (SWP_SHOWWINDOW or SWP_HIDEWINDOW) <> 0) or (WindowPos.flags and SWP_FRAMECHANGED <> 0)) then begin Form := TBGetToolWindowParentForm(ToolWindow); if Assigned(Form) and Form.HandleAllocated and ((Wnd = Form.Handle) or IsChild(Wnd, Form.Handle)) then ToolWindow.UpdateVisibility; end; end; end; end; end; hpPreDestroy: begin if Assigned(FloatingToolWindows) then for I := 0 to FloatingToolWindows.Count-1 do begin with TTBCustomDockableWindow(FloatingToolWindows[I]) do { It must remove the form window's ownership of the tool window *before* the form gets destroyed, otherwise Windows will destroy the tool window's handle. } if Assigned(Parent) and Parent.HandleAllocated and (HWND(GetWindowLong(Parent.Handle, GWL_HWNDPARENT)) = Wnd) then SetWindowOwner(Parent.Handle, Application.Handle); { ^ Restore GWL_HWNDPARENT back to Application.Handle } end; end; end; end; type {$IFNDEF CLR} PFindWindowData = ^TFindWindowData; TFindWindowData = record {$ELSE} TFindWindowData = class private {$ENDIF} TaskActiveWindow, TaskFirstWindow, TaskFirstTopMost: HWND; {$IFDEF CLR} function DoFindWindow(Wnd: HWND; Param: LPARAM): BOOL; {$ENDIF} end; {$IFNDEF CLR} function DoFindWindow(Wnd: HWND; Param: LPARAM): BOOL; stdcall; {$ELSE} function TFindWindowData.DoFindWindow(Wnd: HWND; Param: LPARAM): BOOL; {$ENDIF} begin {$IFNDEF CLR} with PFindWindowData(Param)^ do {$ENDIF} if (Wnd <> TaskActiveWindow) and (Wnd <> Application.Handle) and IsWindowVisible(Wnd) and IsWindowEnabled(Wnd) then begin if GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOPMOST = 0 then begin if TaskFirstWindow = 0 then TaskFirstWindow := Wnd; end else begin if TaskFirstTopMost = 0 then TaskFirstTopMost := Wnd; end; end; Result := True; end; function FindTopLevelWindow(ActiveWindow: HWND): HWND; var FindData: TFindWindowData; begin {$IFDEF CLR} FindData := TFindWindowData.Create; {$ENDIF} with FindData do begin TaskActiveWindow := ActiveWindow; TaskFirstWindow := 0; TaskFirstTopMost := 0; {$IFNDEF CLR} EnumThreadWindows(GetCurrentThreadID, @DoFindWindow, LPARAM(@FindData)); {$ELSE} EnumThreadWindows(GetCurrentThreadID, DoFindWindow, 0); {$ENDIF} if TaskFirstWindow <> 0 then Result := TaskFirstWindow else Result := TaskFirstTopMost; end; end; function IsAncestorOfWindow(const ParentWnd: HWND; Wnd: HWND): Boolean; { Returns True if Wnd is a child of, is owned by, or is the same window as ParentWnd } begin while Wnd <> 0 do begin if Wnd = ParentWnd then begin Result := True; Exit; end; Wnd := GetParent(Wnd); end; Result := False; end; procedure RecalcNCArea(const Ctl: TWinControl); begin if Ctl.HandleAllocated then SetWindowPos(Ctl.Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER); end; procedure InvalidateAll(const Ctl: TWinControl); { Invalidate both non-client and client area, and erase. } begin if Ctl.HandleAllocated then RedrawWindow(Ctl.Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE or RDW_NOCHILDREN); end; type TSetCloseButtonStateProc = procedure(Pushed: Boolean) of object; function CloseButtonLoop(const Wnd: HWND; const ButtonRect: TRect; const SetCloseButtonStateProc: TSetCloseButtonStateProc): Boolean; function MouseInButton: Boolean; var P: TPoint; begin GetCursorPos(P); Result := PtInRect(ButtonRect, P); end; var Msg: TMsg; begin Result := False; SetCloseButtonStateProc(MouseInButton); SetCapture(Wnd); try while GetCapture = Wnd do begin case Integer(GetMessage(Msg, 0, 0, 0)) of -1: Break; { if GetMessage failed } 0: begin { Repost WM_QUIT messages } PostQuitMessage(ClipToLongint(Msg.wParam)); Break; end; end; case Msg.Message of WM_KEYDOWN, WM_KEYUP: { Ignore all keystrokes while in a close button loop } ; WM_MOUSEMOVE: begin { Note to self: WM_MOUSEMOVE messages should never be dispatched here to ensure no hints get shown } SetCloseButtonStateProc(MouseInButton); end; WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: { Make sure it doesn't begin another loop } Break; WM_LBUTTONUP: begin if MouseInButton then Result := True; Break; end; WM_RBUTTONDOWN..WM_MBUTTONDBLCLK: { Ignore all other mouse up/down messages } ; else TranslateMessage(Msg); DispatchMessage(Msg); end; end; finally if GetCapture = Wnd then ReleaseCapture; SetCloseButtonStateProc(False); end; end; { TTBDock - internal } constructor TTBDock.Create(AOwner: TComponent); begin inherited; ControlStyle := ControlStyle + [csAcceptsControls, csMenuEvents] - [csClickEvents, csCaptureMouse, csOpaque]; FAllowDrag := True; FBkgOnToolbars := True; DockList := TList.Create; DockVisibleList := TList.Create; Color := clBtnFace; Position := dpTop; end; procedure TTBDock.CreateParams(var Params: TCreateParams); begin inherited; { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker and are not necessary for this control at run time } if not(csDesigning in ComponentState) then with Params.WindowClass do Style := Style and not(CS_HREDRAW or CS_VREDRAW); end; destructor TTBDock.Destroy; begin if Assigned(FBackground) then FBackground.UnregisterChanges(BackgroundChanged); inherited; DockVisibleList.Free; DockList.Free; end; procedure TTBDock.SetParent(AParent: TWinControl); begin if (AParent is TTBCustomDockableWindow) or (AParent is TTBDock) then raise EInvalidOperation.Create(STBDockParentNotAllowed); inherited; end; procedure TTBDock.BeginUpdate; begin Inc(FDisableArrangeToolbars); end; procedure TTBDock.EndUpdate; begin Dec(FDisableArrangeToolbars); if FArrangeToolbarsNeeded and (FDisableArrangeToolbars = 0) then ArrangeToolbars; end; function TTBDock.HasVisibleToolbars: Boolean; var I: Integer; begin Result := False; for I := 0 to DockList.Count-1 do if ToolbarVisibleOnDock(TTBCustomDockableWindow(DockList[I])) then begin Result := True; Break; end; end; function TTBDock.ToolbarVisibleOnDock(const AToolbar: TTBCustomDockableWindow): Boolean; begin Result := (AToolbar.Parent = Self) and (AToolbar.Visible or (csDesigning in AToolbar.ComponentState)); end; function TTBDock.GetCurrentRowSize(const Row: Integer; var AFullSize: Boolean): Integer; var I, J: Integer; T: TTBCustomDockableWindow; begin Result := 0; AFullSize := False; if Row < 0 then Exit; for I := 0 to DockList.Count-1 do begin T := TTBCustomDockableWindow(DockList[I]); if (T.FEffectiveDockRow = Row) and ToolbarVisibleOnDock(T) then begin AFullSize := T.FullSize; if not(Position in PositionLeftOrRight) then J := T.Height else J := T.Width; if J > Result then Result := J; end; end; end; function TTBDock.GetMinRowSize(const Row: Integer; const ExcludeControl: TTBCustomDockableWindow): Integer; var I, J: Integer; T: TTBCustomDockableWindow; begin Result := 0; if Row < 0 then Exit; for I := 0 to DockList.Count-1 do begin T := TTBCustomDockableWindow(DockList[I]); if (T <> ExcludeControl) and (T.FEffectiveDockRow = Row) and ToolbarVisibleOnDock(T) then begin J := T.FLastRowSize; if J > Result then Result := J; end; end; end; function TTBDock.GetDesignModeRowOf(const XY: Integer): Integer; { Similar to GetRowOf, but is a little different to accomidate design mode better } var HighestRowPlus1, R, CurY, CurRowSize: Integer; FullSize: Boolean; begin Result := 0; HighestRowPlus1 := GetHighestRow(True)+1; CurY := 0; for R := 0 to HighestRowPlus1 do begin Result := R; if R = HighestRowPlus1 then Break; CurRowSize := GetCurrentRowSize(R, FullSize); if CurRowSize = 0 then Continue; Inc(CurY, CurRowSize); if XY < CurY then Break; end; end; function TTBDock.GetHighestRow(const HighestEffective: Boolean): Integer; { Returns highest used row number, or -1 if no rows are used } var I, J: Integer; begin Result := -1; for I := 0 to DockList.Count-1 do with TTBCustomDockableWindow(DockList[I]) do begin if HighestEffective then J := FEffectiveDockRow else J := FDockRow; if J > Result then Result := J; end; end; procedure TTBDock.ChangeWidthHeight(const NewWidth, NewHeight: Integer); { Same as setting Width/Height directly, but does not lose Align position. Specifically, it ensures that a bottom-aligned dock stays above a bottom-aligned TStatusBar when the only toolbar on the dock is undocked and then redocked. } begin case Align of alNone, alTop, alLeft: SetBounds(Left, Top, NewWidth, NewHeight); alBottom: SetBounds(Left, Top-NewHeight+Height, NewWidth, NewHeight); alRight: SetBounds(Left-NewWidth+Width, Top, NewWidth, NewHeight); end; end; procedure TTBDock.AlignControls(AControl: TControl; var Rect: TRect); begin ArrangeToolbars; end; function CompareDockRowPos(Item1, Item2: TListItemType): Integer; begin Result := TTBCustomDockableWindow(Item1).FDockRow - TTBCustomDockableWindow(Item2).FDockRow; if Result = 0 then Result := TTBCustomDockableWindow(Item1).FDockPos - TTBCustomDockableWindow(Item2).FDockPos; end; procedure TTBDock.ArrangeToolbars; { The main procedure to arrange all the toolbars docked to it } type TPosDataRec = record Row, ActualRow, PrecSpace, FullSize, MinimumSize, Size, Overlap, Pos: Integer; ShrinkMode: TTBShrinkMode; NeedArrange: Boolean; end; var NewDockList: TList; PosData: array of TPosDataRec; function IndexOfDraggingToolbar(const List: TList): Integer; { Returns index of toolbar in List that's currently being dragged, or -1 } var I: Integer; begin for I := 0 to List.Count-1 do if TTBCustomDockableWindow(List[I]).FDragMode then begin Result := I; Exit; end; Result := -1; end; function ShiftLeft(const Row, StartIndex, MaxSize: Integer): Integer; { Removes PrecSpace pixels from toolbars at or before StartIndex until the right edge of the toolbar at StartIndex is <= MaxSize. Returns the total number of PrecSpace pixels removed from toolbars. } var PixelsOffEdge, I, J: Integer; begin Result := 0; PixelsOffEdge := -MaxSize; for I := 0 to StartIndex do begin if PosData[I].Row = Row then begin Inc(PixelsOffEdge, PosData[I].PrecSpace); Inc(PixelsOffEdge, PosData[I].Size); end; end; if PixelsOffEdge > 0 then for I := StartIndex downto 0 do begin if PosData[I].Row = Row then begin J := PixelsOffEdge; if PosData[I].PrecSpace < J then J := PosData[I].PrecSpace; Dec(PosData[I].PrecSpace, J); Dec(PixelsOffEdge, J); Inc(Result, J); if PixelsOffEdge = 0 then Break; end; end; end; function GetNextToolbar(const GoForward: Boolean; const Row: Integer; const StartIndex: Integer): Integer; var I: Integer; begin Result := -1; I := StartIndex; while True do begin if GoForward then begin Inc(I); if I >= NewDockList.Count then Break; end else begin Dec(I); if I < 0 then Break; end; if PosData[I].Row = Row then begin Result := I; Break; end; end; end; var LeftRight: Boolean; EmptySize, HighestRow, R, CurPos, CurRowPixel, I, J, K, L, ClientW, ClientH, MaxSize, TotalSize, PixelsPastMaxSize, Offset, CurRealPos, DragIndex, MinRealPos, DragIndexPos, ToolbarsOnRow, CurRowSize: Integer; T: TTBCustomDockableWindow; S: TPoint; RowIsEmpty: Boolean; label FoundNextToolbar; begin if (FDisableArrangeToolbars > 0) or (csLoading in ComponentState) then begin FArrangeToolbarsNeeded := True; Exit; end; NewDockList := nil; Inc(FDisableArrangeToolbars); try { Work around VCL alignment bug when docking toolbars taller or wider than the client height or width of the form. } {if not(csDesigning in ComponentState) and HandleAllocated then SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);} LeftRight := Position in PositionLeftOrRight; if not HasVisibleToolbars then begin EmptySize := Ord(FFixAlign); if csDesigning in ComponentState then EmptySize := 9; if not LeftRight then ChangeWidthHeight(Width, EmptySize) else ChangeWidthHeight(EmptySize, Height); Exit; end; { It can't read the ClientWidth and ClientHeight properties because they attempt to create a handle, which requires Parent to be set. "ClientW" and "ClientH" are calculated instead. } ClientW := Width - FNonClientWidth; if ClientW < 0 then ClientW := 0; ClientH := Height - FNonClientHeight; if ClientH < 0 then ClientH := 0; { Remove toolbars from DockList & DockVisibleList that are destroying, so that no methods on these toolbars will be called. This is needed because in certain rare cases ArrangeToolbars can be indirectly called while a docked toolbar is being destroyed. } for I := DockList.Count-1 downto 0 do begin T := TTBCustomDockableWindow(DockList[I]); if csDestroying in T.ComponentState then begin DockList.Delete(I); DockVisibleList.Remove(T); end; end; { If LimitToOneRow is True, only use the first row } if FLimitToOneRow then for I := 0 to DockList.Count-1 do with TTBCustomDockableWindow(DockList[I]) do FDockRow := 0; { Copy DockList to NewDockList, and ensure it is in correct ordering according to DockRow/DockPos } NewDockList := TList.Create; NewDockList.Count := DockList.Count; for I := 0 to NewDockList.Count-1 do NewDockList[I] := DockList[I]; I := IndexOfDraggingToolbar(NewDockList); NewDockList.Sort(CompareDockRowPos); DragIndex := IndexOfDraggingToolbar(NewDockList); if (I <> -1) and TTBCustomDockableWindow(NewDockList[DragIndex]).FDragSplitting then begin { When splitting, don't allow the toolbar being dragged to change positions in the dock list } NewDockList.Move(DragIndex, I); DragIndex := I; end; DockVisibleList.Sort(CompareDockRowPos); { Find highest row number } HighestRow := GetHighestRow(False); { Create a temporary array that holds new position data for the toolbars } SetLength(PosData, NewDockList.Count); for I := 0 to NewDockList.Count-1 do begin T := TTBCustomDockableWindow(NewDockList[I]); PosData[I].ActualRow := T.FDockRow; if ToolbarVisibleOnDock(T) then PosData[I].Row := T.FDockRow else PosData[I].Row := -1; PosData[I].Pos := T.FDockPos; end; { Find FInsertRowBefore=True and FullSize=True toolbars and make sure there aren't any other toolbars on the same row. If there are, shift them down a row. } for L := 0 to 1 do begin R := 0; while R <= HighestRow do begin for I := 0 to NewDockList.Count-1 do begin T := TTBCustomDockableWindow(NewDockList[I]); if (PosData[I].ActualRow = R) and (((L = 0) and T.FInsertRowBefore and not LimitToOneRow) or ((L = 1) and T.FullSize)) then for J := 0 to NewDockList.Count-1 do if (J <> I) and (PosData[J].ActualRow = R) then begin for K := 0 to NewDockList.Count-1 do begin if K <> I then begin if PosData[K].ActualRow >= R then Inc(PosData[K].ActualRow); if PosData[K].Row >= R then Inc(PosData[K].Row); end; end; Inc(HighestRow); Break; end; end; Inc(R); end; end; { Remove blank rows. Note that rows that contain only invisible or currently floating toolbars are intentionally not removed, so that when the toolbars are shown again, they stay on their own row. } R := 0; while R <= HighestRow do begin RowIsEmpty := True; for I := 0 to NewDockList.Count-1 do if PosData[I].ActualRow = R then begin RowIsEmpty := False; Break; end; if RowIsEmpty then begin { Shift all ones higher than R back one } for I := 0 to NewDockList.Count-1 do begin if PosData[I].ActualRow > R then Dec(PosData[I].ActualRow); if PosData[I].Row > R then Dec(PosData[I].Row); end; Dec(HighestRow); end else Inc(R); end; { Calculate positions and sizes of each row } R := 0; while R <= HighestRow do begin if not LeftRight then MaxSize := ClientW else MaxSize := ClientH; { Set initial sizes } TotalSize := 0; ToolbarsOnRow := 0; MinRealPos := 0; for I := 0 to NewDockList.Count-1 do begin if PosData[I].Row = R then begin T := TTBCustomDockableWindow(NewDockList[I]); T.GetBaseSize(S); if not LeftRight then J := S.X + T.NonClientWidth else J := S.Y + T.NonClientHeight; PosData[I].FullSize := J; PosData[I].Size := J; PosData[I].ShrinkMode := T.GetShrinkMode; PosData[I].MinimumSize := 0; T.GetMinShrinkSize(PosData[I].MinimumSize); if PosData[I].MinimumSize > PosData[I].FullSize then { don't allow minimum shrink size to be less than full size } PosData[I].MinimumSize := PosData[I].FullSize; if PosData[I].ShrinkMode = tbsmChevron then Inc(MinRealPos, PosData[I].MinimumSize) else Inc(MinRealPos, PosData[I].FullSize); { If the toolbar isn't the first toolbar on the row, and the toolbar would go off the edge even after it's shrunk, then move it onto a row of its own } if (ToolbarsOnRow > 0) and (MinRealPos > MaxSize) and not LimitToOneRow then begin for K := I to NewDockList.Count-1 do begin if PosData[K].ActualRow >= R then Inc(PosData[K].ActualRow); if PosData[K].Row >= R then Inc(PosData[K].Row); end; Inc(HighestRow); Break; end; Inc(TotalSize, J); Inc(ToolbarsOnRow); end; end; PixelsPastMaxSize := TotalSize - MaxSize; { Set initial arrangement; don't shrink toolbars yet } DragIndexPos := 0; CurPos := 0; CurRealPos := 0; MinRealPos := 0; for I := 0 to NewDockList.Count-1 do begin T := TTBCustomDockableWindow(NewDockList[I]); if PosData[I].Row = R then begin if (CurPos = 0) and (T.FullSize or T.Stretch) then { Force to left } J := 0 else J := T.FDockPos; if I = DragIndex then DragIndexPos := J; { Don't let this toolbar overlap preceding toolbars by more than the sum of their minimum sizes } if J < MinRealPos then J := MinRealPos; if J > CurPos then begin { There's a gap between the left edge or previous toolbar and this toolbar } if PixelsPastMaxSize <= 0 then begin PosData[I].PrecSpace := J - CurPos; CurPos := J; end else { Don't allow a gap if exceeding MaxSize } J := CurPos; end else begin if J < CurRealPos then PosData[I].Overlap := CurRealPos - J; end; Inc(CurPos, PosData[I].Size); CurRealPos := J + PosData[I].Size; Inc(MinRealPos, PosData[I].MinimumSize); end; end; { If we aren't exceeding MaxSize, allow the toolbar being dragged to push other toolbars to the left } if (PixelsPastMaxSize < 0) and (DragIndex <> -1) and (PosData[DragIndex].Row = R) then begin I := GetNextToolbar(False, R, DragIndex); if I <> -1 then begin J := ShiftLeft(R, I, DragIndexPos); if J > 0 then begin { Ensure that toolbars that follow the toolbar being dragged stay at the same place by increasing PrecSpace on the next toolbar } I := GetNextToolbar(True, R, DragIndex); if I <> -1 then Inc(PosData[I].PrecSpace, J); end; end; end; { If any toolbars are going off the edge of the dock, try to make them at least partially visible by shifting preceding toolbars left } I := GetNextToolbar(False, R, NewDockList.Count); if I <> -1 then ShiftLeft(R, I, MaxSize); { Shrink toolbars that overlap other toolbars (Overlaps[x] > 0) } if PixelsPastMaxSize > 0 then begin Offset := 0; for I := 0 to NewDockList.Count-1 do begin if PosData[I].Row <> R then Continue; T := TTBCustomDockableWindow(NewDockList[I]); if (ToolbarsOnRow > 1) and T.FDragMode then T.FDragCanSplit := True; Inc(Offset, PosData[I].Overlap); if Offset > PixelsPastMaxSize then Offset := PixelsPastMaxSize; if Offset > 0 then for J := I-1 downto 0 do begin if PosData[J].Row <> R then Continue; { How much can we shrink this toolbar J to get toolbar I to its preferred position? } if PosData[J].ShrinkMode = tbsmChevron then L := Offset else L := 0; K := -(PosData[J].Size - L - PosData[J].MinimumSize); { the number of pixels that exceed the minimum size } if K > 0 then { Don't shrink a toolbar below its minimum allowed size } Dec(L, K); Dec(PosData[J].Size, L); Dec(PixelsPastMaxSize, L); Dec(Offset, L); if (Offset = 0) or { This is needed so toolbars can push other toolbars to the right when splitting: } (J = DragIndex) then Break; end; end; end; { Still exceeding MaxSize? Make sure the rightmost toolbar(s) are at least partially visible with a width of MinimumSize } if PixelsPastMaxSize > 0 then begin for I := NewDockList.Count-1 downto 0 do begin if (PosData[I].Row <> R) or (PosData[I].ShrinkMode = tbsmNone) or ((PosData[I].ShrinkMode = tbsmWrap) and (ToolbarsOnRow > 1)) then Continue; J := PosData[I].Size - PosData[I].MinimumSize; if J > 0 then begin { can we shrink this toolbar any? } if J > PixelsPastMaxSize then J := PixelsPastMaxSize; Dec(PosData[I].Size, J); Dec(PixelsPastMaxSize, J); end; if PixelsPastMaxSize = 0 then Break; end; end; { Set Poses, and adjust size of FullSize & Stretch toolbars } CurPos := 0; for I := 0 to NewDockList.Count-1 do begin T := TTBCustomDockableWindow(NewDockList[I]); if PosData[I].Row = R then begin if T.FullSize or T.Stretch then begin { Remove any preceding space from this toolbar } Inc(PosData[I].Size, PosData[I].PrecSpace); PosData[I].PrecSpace := 0; end; Inc(CurPos, PosData[I].PrecSpace); if T.FullSize then begin { Claim all space } if PosData[I].Size < MaxSize then PosData[I].Size := MaxSize; end else if T.Stretch then begin { Steal any preceding space from the next toolbar } for J := I+1 to NewDockList.Count-1 do if PosData[J].Row = R then begin Inc(PosData[I].Size, PosData[J].PrecSpace); PosData[J].PrecSpace := 0; goto FoundNextToolbar; end; { or claim any remaining space } if PosData[I].Size < MaxSize - CurPos then PosData[I].Size := MaxSize - CurPos; FoundNextToolbar: end; PosData[I].Pos := CurPos; Inc(CurPos, PosData[I].Size); end; end; Inc(R); end; for I := 0 to NewDockList.Count-1 do begin T := TTBCustomDockableWindow(NewDockList[I]); T.FEffectiveDockRow := PosData[I].ActualRow; T.FEffectiveDockPos := PosData[I].Pos; { If FCommitNewPositions is True, update all the toolbars' DockPos and DockRow properties to match the actual positions. Also update the ordering of DockList to match NewDockList } if FCommitNewPositions then begin T.FDockRow := T.FEffectiveDockRow; T.FDockPos := T.FEffectiveDockPos; DockList[I] := NewDockList[I]; end; end; { Now actually move the toolbars } CurRowPixel := 0; for R := 0 to HighestRow do begin CurRowSize := -1; for I := 0 to NewDockList.Count-1 do begin T := TTBCustomDockableWindow(NewDockList[I]); if PosData[I].Row = R then begin K := T.FCurrentSize; T.FCurrentSize := PosData[I].Size; if PosData[I].Size >= PosData[I].FullSize then begin T.FCurrentSize := 0; { Reason: so that if new items are added to a non-shrunk toolbar at run-time (causing its width to increase), the toolbar won't shrink unnecessarily } end; if (PosData[I].ShrinkMode <> tbsmNone) and (T.FCurrentSize <> K) then begin { If Size is changing and we are to display a chevron or wrap, call DoArrange to get an accurate row size } S := T.DoArrange(False, TBGetDockTypeOf(Self, False), False, Self); { Force a rearrange in case the actual size isn't changing but the chevron visibility might have changed (which can happen if items are added to a FullSize=True toolbar at run-time) } PosData[I].NeedArrange := True; end else begin if (PosData[I].ShrinkMode = tbsmWrap) and (PosData[I].Size < PosData[I].FullSize) then begin { Preserve existing height (or width) on a wrapped toolbar whose size isn't changing now } S.X := T.Width - T.NonClientWidth; S.Y := T.Height - T.NonClientHeight; end else T.GetBaseSize(S); end; if not LeftRight then K := S.Y else K := S.X; T.FLastRowSize := K; if K > CurRowSize then CurRowSize := K; end; end; if CurRowSize <> -1 then Inc(CurRowSize, DockedBorderSize2) else CurRowSize := 0; for I := 0 to NewDockList.Count-1 do begin T := TTBCustomDockableWindow(NewDockList[I]); if PosData[I].Row = R then begin Inc(T.FUpdatingBounds); try K := T.FCurrentSize; if PosData[I].NeedArrange then T.FArrangeNeeded := True; if not LeftRight then T.SetBounds(PosData[I].Pos, CurRowPixel, PosData[I].Size, CurRowSize) else T.SetBounds(CurRowPixel, PosData[I].Pos, CurRowSize, PosData[I].Size); if T.FArrangeNeeded then { ^ don't arrange again if SetBounds call already caused one } T.Arrange; { Restore FCurrentSize since TTBToolbarView.DoUpdatePositions clears it } T.FCurrentSize := K; finally Dec(T.FUpdatingBounds); end; end; end; Inc(CurRowPixel, CurRowSize); end; { Set the size of the dock } if not LeftRight then ChangeWidthHeight(Width, CurRowPixel + FNonClientHeight) else ChangeWidthHeight(CurRowPixel + FNonClientWidth, Height); finally Dec(FDisableArrangeToolbars); FArrangeToolbarsNeeded := False; FCommitNewPositions := False; NewDockList.Free; end; end; procedure TTBDock.CommitPositions; { Copies docked toolbars' EffectiveDockRow and EffectiveDockPos properties into DockRow and DockPos respectively. Note that this does not reorder DockList like ArrangeToolbars does when FCommitNewPositions=True. } var I: Integer; T: TTBCustomDockableWindow; begin for I := 0 to DockVisibleList.Count-1 do begin T := TTBCustomDockableWindow(DockVisibleList[I]); T.FDockRow := T.FEffectiveDockRow; T.FDockPos := T.FEffectiveDockPos; end; end; procedure TTBDock.ChangeDockList(const Insert: Boolean; const Bar: TTBCustomDockableWindow); { Inserts or removes Bar from DockList } var I: Integer; begin I := DockList.IndexOf(Bar); if Insert then begin if I = -1 then begin Bar.FreeNotification(Self); DockList.Add(Bar); end; end else begin if I <> -1 then DockList.Delete(I); end; ToolbarVisibilityChanged(Bar, False); end; procedure TTBDock.ToolbarVisibilityChanged(const Bar: TTBCustomDockableWindow; const ForceRemove: Boolean); var Modified, VisibleOnDock: Boolean; I: Integer; begin Modified := False; I := DockVisibleList.IndexOf(Bar); VisibleOnDock := not ForceRemove and ToolbarVisibleOnDock(Bar); if VisibleOnDock then begin if I = -1 then begin DockVisibleList.Add(Bar); Modified := True; end; end else begin if I <> -1 then begin DockVisibleList.Remove(Bar); Modified := True; end; end; if Modified then begin ArrangeToolbars; if Assigned(FOnInsertRemoveBar) then FOnInsertRemoveBar(Self, VisibleOnDock, Bar); end; end; procedure TTBDock.Loaded; begin inherited; { Rearranging is disabled while the component is loading, so now that it's loaded, rearrange it. } ArrangeToolbars; end; procedure TTBDock.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if Operation = opRemove then begin if AComponent = FBackground then Background := nil else if AComponent is TTBCustomDockableWindow then begin DockList.Remove(AComponent); DockVisibleList.Remove(AComponent); end; end; end; function TTBDock.GetPalette: HPALETTE; begin if UsingBackground and Assigned(FBackground) then { ^ by default UsingBackground returns False if FBackground isn't assigned, but UsingBackground may be overridden and return True when it isn't } Result := FBackground.GetPalette else Result := 0; end; procedure TTBDock.WMEraseBkgnd(var Message: TWMEraseBkgnd); var R, R2: TRect; P1, P2: TPoint; SaveIndex: Integer; begin { Draw the Background if there is one, otherwise use default erasing behavior } if UsingBackground then begin R := ClientRect; R2 := R; { Make up for nonclient area } P1 := ClientToScreen(Point(0, 0)); P2 := Parent.ClientToScreen(BoundsRect.TopLeft); Dec(R2.Left, Left + (P1.X-P2.X)); Dec(R2.Top, Top + (P1.Y-P2.Y)); SaveIndex := SaveDC(Message.DC); IntersectClipRect(Message.DC, R.Left, R.Top, R.Right, R.Bottom); DrawBackground(Message.DC, R2); RestoreDC(Message.DC, SaveIndex); Message.Result := 1; end else inherited; end; procedure TTBDock.Paint; var R: TRect; begin inherited; { Draw dotted border in design mode } if csDesigning in ComponentState then begin R := ClientRect; with Canvas do begin Pen.Style := psDot; Pen.Color := clBtnShadow; Brush.Style := bsClear; Rectangle(R.Left, R.Top, R.Right, R.Bottom); Pen.Style := psSolid; end; end; end; procedure TTBDock.WMMove(var Message: TWMMove); begin inherited; if UsingBackground then InvalidateBackgrounds; end; {$IFNDEF JR_D4} procedure TTBDock.WMSize(var Message: TWMSize); begin inherited; if not(csLoading in ComponentState) and Assigned(FOnResize) then FOnResize(Self); end; {$ENDIF} procedure TTBDock.WMNCCalcSize(var Message: TWMNCCalcSize); procedure ApplyToRect(var R: TRect); begin if blTop in BoundLines then Inc(R.Top); if blBottom in BoundLines then Dec(R.Bottom); if blLeft in BoundLines then Inc(R.Left); if blRight in BoundLines then Dec(R.Right); end; {$IFDEF CLR} var Params: TNCCalcSizeParams; {$ENDIF} begin inherited; { note to self: non-client size is stored in FNonClientWidth & FNonClientHeight } {$IFNDEF CLR} ApplyToRect(Message.CalcSize_Params.rgrc[0]); {$ELSE} Params := Message.CalcSize_Params; ApplyToRect(Params.rgrc0); Message.CalcSize_Params := Params; {$ENDIF} end; procedure TTBDock.DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); procedure DrawLine(const DC: HDC; const X1, Y1, X2, Y2: Integer); begin MoveToEx(DC, X1, Y1, nil); LineTo(DC, X2, Y2); end; var RW, R, R2, RC: TRect; DC: HDC; HighlightPen, ShadowPen, SavePen: HPEN; FillBrush: HBRUSH; label SkipFillRect; begin { This works around WM_NCPAINT problem described at top of source code } {no! R := Rect(0, 0, Width, Height);} GetWindowRect(Handle, RW); R := RW; OffsetRect(R, -R.Left, -R.Top); if not DrawToDC then DC := GetWindowDC(Handle) else DC := ADC; try { Use update region } if not DrawToDC then SelectNCUpdateRgn(Handle, DC, Clip); { Draw BoundLines } R2 := R; if (BoundLines <> []) and ((csDesigning in ComponentState) or HasVisibleToolbars) then begin HighlightPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT)); ShadowPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW)); SavePen := SelectObject(DC, ShadowPen); if blTop in BoundLines then begin DrawLine(DC, R.Left, R.Top, R.Right, R.Top); Inc(R2.Top); end; if blLeft in BoundLines then begin DrawLine(DC, R.Left, R.Top, R.Left, R.Bottom); Inc(R2.Left); end; SelectObject(DC, HighlightPen); if blBottom in BoundLines then begin DrawLine(DC, R.Left, R.Bottom-1, R.Right, R.Bottom-1); Dec(R2.Bottom); end; if blRight in BoundLines then begin DrawLine(DC, R.Right-1, R.Top, R.Right-1, R.Bottom); Dec(R2.Right); end; SelectObject(DC, SavePen); DeleteObject(ShadowPen); DeleteObject(HighlightPen); end; Windows.GetClientRect(Handle, RC); if not IsRectEmpty(RC) then begin { ^ ExcludeClipRect can't be passed rectangles that have (Bottom < Top) or (Right < Left) since it doesn't treat them as empty } MapWindowPoints(Handle, 0, RC, 2); OffsetRect(RC, -RW.Left, -RW.Top); if EqualRect(RC, R2) then { Skip FillRect because there would be nothing left after ExcludeClipRect } goto SkipFillRect; ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom); end; FillBrush := CreateSolidBrush(ColorToRGB(Color)); FillRect(DC, R2, FillBrush); DeleteObject(FillBrush); SkipFillRect: finally if not DrawToDC then ReleaseDC(Handle, DC); end; end; procedure TTBDock.WMNCPaint(var Message: TMessage); begin DrawNCArea(False, 0, HRGN(Message.WParam)); end; procedure DockNCPaintProc(Wnd: HWND; DC: HDC; AppData: TObject); begin TTBDock(AppData).DrawNCArea(True, DC, 0); end; procedure TTBDock.WMPrint(var Message: TMessage); begin HandleWMPrint(Handle, Message, DockNCPaintProc, Self); end; procedure TTBDock.WMPrintClient(var Message: {$IFNDEF CLR} TMessage {$ELSE} TWMPrintClient {$ENDIF}); begin HandleWMPrintClient(PaintHandler, Message); end; procedure TTBDock.CMSysColorChange(var Message: TMessage); begin inherited; if Assigned(FBackground) then FBackground.SysColorChanged; end; procedure TTBDock.RelayMsgToFloatingBars({$IFNDEF CLR}var{$ELSE}const{$ENDIF} Message: TMessage); var I: Integer; T: TTBCustomDockableWindow; begin for I := 0 to DockList.Count-1 do begin T := TTBCustomDockableWindow(DockList[I]); { Note: We must be careful about relaying WM_SYSCOMMAND. We can't send it to classes that don't have special handling for it (as indicated by the csMenuEvents style, which TTBToolWindow lacks) because the VCL's default handling would send it back to the main form, resulting in infinite recursion. } if ((Message.Msg <> WM_SYSCOMMAND) or (csMenuEvents in T.ControlStyle)) and T.Floating and T.CanFocus then begin Message.Result := T.Perform(Message.Msg, Message.WParam, Message.LParam); if Message.Result <> 0 then Exit; end; end; end; procedure TTBDock.WMSysCommand(var Message: TWMSysCommand); begin { Relay WM_SYSCOMMAND messages to floating toolbars which were formerly docked. That way, items on floating menu bars can be accessed with Alt. } if Message.CmdType and $FFF0 = SC_KEYMENU then RelayMsgToFloatingBars({$IFNDEF CLR} TMessage(Message) {$ELSE} Message.OriginalMessage {$ENDIF}); end; procedure TTBDock.CMDialogKey(var Message: TCMDialogKey); begin RelayMsgToFloatingBars({$IFNDEF CLR} TMessage(Message) {$ELSE} Message.OriginalMessage {$ENDIF}); if Message.Result = 0 then inherited; end; procedure TTBDock.CMDialogChar(var Message: TCMDialogChar); begin RelayMsgToFloatingBars({$IFNDEF CLR} TMessage(Message) {$ELSE} Message.OriginalMessage {$ENDIF}); if Message.Result = 0 then inherited; end; { TTBDock - property access methods } procedure TTBDock.SetAllowDrag(Value: Boolean); var I: Integer; begin if FAllowDrag <> Value then begin FAllowDrag := Value; for I := 0 to ControlCount-1 do if Controls[I] is TTBCustomDockableWindow then RecalcNCArea(TTBCustomDockableWindow(Controls[I])); end; end; function TTBDock.UsingBackground: Boolean; begin Result := Assigned(FBackground) and FBackground.UsingBackground; end; procedure TTBDock.DrawBackground(DC: HDC; const DrawRect: TRect); begin FBackground.Draw(DC, DrawRect); end; procedure TTBDock.InvalidateBackgrounds; { Called after background is changed } var I: Integer; T: TTBCustomDockableWindow; begin Invalidate; { Synchronize child toolbars also } for I := 0 to DockList.Count-1 do begin T := TTBCustomDockableWindow(DockList[I]); if ToolbarVisibleOnDock(T) then { Invalidate both non-client and client area } InvalidateAll(T); end; end; procedure TTBDock.SetBackground(Value: TTBBasicBackground); begin if FBackground <> Value then begin if Assigned(FBackground) then FBackground.UnregisterChanges(BackgroundChanged); FBackground := Value; if Assigned(Value) then begin Value.FreeNotification(Self); Value.RegisterChanges(BackgroundChanged); end; InvalidateBackgrounds; end; end; procedure TTBDock.BackgroundChanged(Sender: TObject); begin InvalidateBackgrounds; end; procedure TTBDock.SetBackgroundOnToolbars(Value: Boolean); begin if FBkgOnToolbars <> Value then begin FBkgOnToolbars := Value; InvalidateBackgrounds; end; end; procedure TTBDock.SetBoundLines(Value: TTBDockBoundLines); var X, Y: Integer; B: TTBDockBoundLines; begin if FBoundLines <> Value then begin FBoundLines := Value; X := 0; Y := 0; B := BoundLines; { optimization } if blTop in B then Inc(Y); if blBottom in B then Inc(Y); if blLeft in B then Inc(X); if blRight in B then Inc(X); FNonClientWidth := X; FNonClientHeight := Y; RecalcNCArea(Self); end; end; procedure TTBDock.SetFixAlign(Value: Boolean); begin if FFixAlign <> Value then begin FFixAlign := Value; ArrangeToolbars; end; end; procedure TTBDock.SetPosition(Value: TTBDockPosition); begin if (FPosition <> Value) and (ControlCount <> 0) then raise EInvalidOperation.Create(STBDockCannotChangePosition); FPosition := Value; case Position of dpTop: Align := alTop; dpBottom: Align := alBottom; dpLeft: Align := alLeft; dpRight: Align := alRight; end; end; function TTBDock.GetToolbarCount: Integer; begin Result := DockVisibleList.Count; end; function TTBDock.GetToolbars(Index: Integer): TTBCustomDockableWindow; begin Result := TTBCustomDockableWindow(DockVisibleList[Index]); end; (*function TTBDock.GetVersion: TToolbar97Version; begin Result := Toolbar97VersionPropText; end; procedure TTBDock.SetVersion(const Value: TToolbar97Version); begin { write method required for the property to show up in Object Inspector } end;*) { TTBFloatingWindowParent - Internal } procedure TTBFloatingWindowParent.CreateParams(var Params: TCreateParams); const ThickFrames: array[Boolean] of DWORD = (0, WS_THICKFRAME); begin inherited; { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker and are not necessary for this control at run time } if not(csDesigning in ComponentState) then with Params.WindowClass do Style := Style and not(CS_HREDRAW or CS_VREDRAW); with Params do begin { Note: WS_THICKFRAME and WS_BORDER styles are included to ensure that sizing grips are displayed on child controls with scrollbars. The thick frame or border is not drawn by Windows; TCustomToolWindow97 handles all border drawing by itself. } if not(csDesigning in ComponentState) then Style := WS_POPUP or WS_BORDER or ThickFrames[FDockableWindow.FResizable] else Style := Style or WS_BORDER or ThickFrames[FDockableWindow.FResizable]; { The WS_EX_TOOLWINDOW style is needed so there isn't a taskbar button for the toolbar when FloatingMode = fmOnTopOfAllForms. } ExStyle := WS_EX_TOOLWINDOW; end; end; procedure TTBFloatingWindowParent.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if (Operation = opRemove) and (AComponent = FParentForm) then FParentForm := nil; end; procedure TTBFloatingWindowParent.AlignControls(AControl: TControl; var Rect: TRect); begin { ignore Align setting of the child toolbar } end; procedure TTBFloatingWindowParent.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); {$IFDEF CLR} var Temp: TMinMaxInfo; {$ENDIF} begin inherited; { Because the window uses the WS_THICKFRAME style (but not for the usual purpose), it must process the WM_GETMINMAXINFO message to remove the minimum and maximum size limits it imposes by default. } {$IFNDEF CLR} with Message.MinMaxInfo^ do begin {$ELSE} Temp := Message.MinMaxInfo; with Temp do begin {$ENDIF} with ptMinTrackSize do begin X := 1; Y := 1; { Note to self: Don't put GetMinimumSize code here, since ClientWidth/Height values are sometimes invalid during a RecreateWnd } end; with ptMaxTrackSize do begin { Because of the 16-bit (signed) size limitations of Windows 95, Smallints must be used instead of Integers or Longints } X := High(Smallint); Y := High(Smallint); end; end; {$IFDEF CLR} Message.MinMaxInfo := Temp; {$ENDIF} end; procedure TTBFloatingWindowParent.CMShowingChanged(var Message: TMessage); const ShowFlags: array[Boolean] of UINT = ( SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW, SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW); begin { Must override TCustomForm/TForm's CM_SHOWINGCHANGED handler so that the form doesn't get activated when Visible is set to True. } SetWindowPos(WindowHandle, 0, 0, 0, 0, 0, ShowFlags[Showing and FShouldShow]); end; procedure TTBFloatingWindowParent.CMDialogKey(var Message: TCMDialogKey); begin { If Escape if pressed on a floating toolbar, return focus to the form } if (Message.CharCode = VK_ESCAPE) and (KeyDataToShiftState(ClipToLongint(Message.KeyData)) = []) and Assigned(ParentForm) then begin ParentForm.SetFocus; Message.Result := 1; end else inherited; end; procedure TTBFloatingWindowParent.CMTextChanged(var Message: TMessage); begin inherited; RedrawNCArea([twrdCaption]); end; function TTBFloatingWindowParent.GetCaptionRect(const AdjustForBorder, MinusCloseButton: Boolean): TRect; var P: TPoint; begin Result := Rect(0, 0, ClientWidth, GetSmallCaptionHeight-1); if MinusCloseButton then Dec(Result.Right, Result.Bottom); if AdjustForBorder then begin P := FDockableWindow.GetFloatingBorderSize; OffsetRect(Result, P.X, P.Y); end; end; function TTBFloatingWindowParent.GetCloseButtonRect(const AdjustForBorder: Boolean): TRect; begin Result := GetCaptionRect(AdjustForBorder, False); Result.Left := Result.Right - (GetSmallCaptionHeight-1); end; procedure TTBFloatingWindowParent.WMNCCalcSize(var Message: TWMNCCalcSize); procedure ApplyToRect(var R: TRect); var TL, BR: TPoint; begin FDockableWindow.GetFloatingNCArea(TL, BR); Inc(R.Left, TL.X); Inc(R.Top, TL.Y); Dec(R.Right, BR.X); Dec(R.Bottom, BR.Y); end; {$IFDEF CLR} var Params: TNCCalcSizeParams; {$ENDIF} begin { Doesn't call inherited since it overrides the normal NC sizes } Message.Result := 0; {$IFNDEF CLR} ApplyToRect(Message.CalcSize_Params.rgrc[0]); {$ELSE} Params := Message.CalcSize_Params; ApplyToRect(Params.rgrc0); Message.CalcSize_Params := Params; {$ENDIF} end; procedure TTBFloatingWindowParent.WMNCPaint(var Message: TMessage); begin { Don't call inherited because it overrides the default NC painting } DrawNCArea(False, 0, HRGN(Message.WParam), twrdAll); end; procedure FloatingWindowParentNCPaintProc(Wnd: HWND; DC: HDC; AppData: TObject); begin with TTBFloatingWindowParent(AppData) do DrawNCArea(True, DC, 0, twrdAll); end; procedure TTBFloatingWindowParent.WMPrint(var Message: TMessage); begin HandleWMPrint(Handle, Message, FloatingWindowParentNCPaintProc, Self); end; procedure TTBFloatingWindowParent.WMPrintClient(var Message: {$IFNDEF CLR} TMessage {$ELSE} TWMPrintClient {$ENDIF}); begin HandleWMPrintClient(PaintHandler, Message); end; procedure TTBFloatingWindowParent.WMNCHitTest(var Message: TWMNCHitTest); var P: TPoint; R: TRect; BorderSize: TPoint; C: Integer; begin inherited; with Message do begin P := SmallPointToPoint(Pos); GetWindowRect(Handle, R); Dec(P.X, R.Left); Dec(P.Y, R.Top); if Result <> HTCLIENT then begin Result := HTNOWHERE; if FDockableWindow.ShowCaption and PtInRect(GetCaptionRect(True, False), P) then begin if FDockableWindow.FCloseButton and PtInRect(GetCloseButtonRect(True), P) then Result := HT_TB2k_Close else Result := HT_TB2k_Caption; end else if FDockableWindow.Resizable then begin BorderSize := FDockableWindow.GetFloatingBorderSize; if not(tbdsResizeEightCorner in FDockableWindow.FDockableWindowStyles) then begin if (P.Y >= 0) and (P.Y < BorderSize.Y) then Result := HTTOP else if (P.Y < Height) and (P.Y >= Height-BorderSize.Y-1) then Result := HTBOTTOM else if (P.X >= 0) and (P.X < BorderSize.X) then Result := HTLEFT else if (P.X < Width) and (P.X >= Width-BorderSize.X-1) then Result := HTRIGHT; end else begin C := BorderSize.X + (GetSmallCaptionHeight-1); if (P.X >= 0) and (P.X < BorderSize.X) then begin Result := HTLEFT; if (P.Y < C) then Result := HTTOPLEFT else if (P.Y >= Height-C) then Result := HTBOTTOMLEFT; end else if (P.X < Width) and (P.X >= Width-BorderSize.X-1) then begin Result := HTRIGHT; if (P.Y < C) then Result := HTTOPRIGHT else if (P.Y >= Height-C) then Result := HTBOTTOMRIGHT; end else if (P.Y >= 0) and (P.Y < BorderSize.Y) then begin Result := HTTOP; if (P.X < C) then Result := HTTOPLEFT else if (P.X >= Width-C) then Result := HTTOPRIGHT; end else if (P.Y < Height) and (P.Y >= Height-BorderSize.Y-1) then begin Result := HTBOTTOM; if (P.X < C) then Result := HTBOTTOMLEFT else if (P.X >= Width-C) then Result := HTBOTTOMRIGHT; end; end; end; end; end; end; procedure TTBFloatingWindowParent.SetCloseButtonState(Pushed: Boolean); begin if FCloseButtonDown <> Pushed then begin FCloseButtonDown := Pushed; RedrawNCArea([twrdCloseButton]); end; end; procedure TTBFloatingWindowParent.WMNCLButtonDown(var Message: TWMNCLButtonDown); var P: TPoint; R, BR: TRect; begin case ClipToLongint(Message.HitTest) of HT_TB2k_Caption: begin P := FDockableWindow.ScreenToClient(Point(Message.XCursor, Message.YCursor)); FDockableWindow.BeginMoving(P.X, P.Y); end; HTLEFT..HTBOTTOMRIGHT: if FDockableWindow.Resizable then FDockableWindow.BeginSizing(TTBSizeHandle(ClipToLongint(Message.HitTest) - HTLEFT)); HT_TB2k_Close: begin GetWindowRect(Handle, R); BR := GetCloseButtonRect(True); OffsetRect(BR, R.Left, R.Top); if CloseButtonLoop(Handle, BR, SetCloseButtonState) then FDockableWindow.Close; end; else inherited; end; end; procedure TTBFloatingWindowParent.WMNCLButtonDblClk(var Message: TWMNCLButtonDblClk); begin if ClipToLongint(Message.HitTest) = HT_TB2k_Caption then FDockableWindow.DoubleClick; end; procedure TTBFloatingWindowParent.WMNCRButtonUp(var Message: TWMNCRButtonUp); begin FDockableWindow.ShowNCContextMenu(Message.XCursor, Message.YCursor); end; procedure TTBFloatingWindowParent.WMClose(var Message: TWMClose); var MDIParentForm: TTBCustomForm; begin { A floating toolbar does not use WM_CLOSE messages when its close button is clicked, but Windows still sends a WM_CLOSE message if the user presses Alt+F4 while one of the toolbar's controls is focused. Inherited is not called since we do not want Windows' default processing - which destroys the window. Instead, relay the message to the parent form. } MDIParentForm := GetMDIParent(TBGetToolWindowParentForm(FDockableWindow)); if Assigned(MDIParentForm) and MDIParentForm.HandleAllocated then SendMessage(MDIParentForm.Handle, WM_CLOSE, 0, 0); { Note to self: MDIParentForm is used instead of OwnerForm since MDI childs don't process Alt+F4 as Close } end; procedure TTBFloatingWindowParent.WMActivate(var Message: TWMActivate); var ParentForm: TTBCustomForm; begin if csDesigning in ComponentState then begin inherited; Exit; end; ParentForm := GetMDIParent(TBGetToolWindowParentForm(FDockableWindow)); if Assigned(ParentForm) and ParentForm.HandleAllocated then SendMessage(ParentForm.Handle, WM_NCACTIVATE, Ord(Message.Active <> WA_INACTIVE), 0); if Message.Active <> WA_INACTIVE then begin { This works around a "gotcha" in TCustomForm.CMShowingChanged. When a form is hidden, it uses the internal VCL function FindTopMostWindow to find a new active window. The problem is that handles of floating toolbars on the form being hidden can be returned by FindTopMostWindow, so the following code is used to prevent floating toolbars on the hidden form from being left active. } if not IsWindowVisible(Handle) then { ^ Calling IsWindowVisible with a floating toolbar handle will always return False if its parent form is hidden since the WH_CALLWNDPROC hook automatically updates the toolbars' visibility. } { Find and activate a window besides this toolbar } SetActiveWindow(FindTopLevelWindow(Handle)) else { If the toolbar is being activated and the previous active window wasn't its parent form, the form is activated instead. This is done so that if the application is deactivated while a floating toolbar was active and the application is reactivated again, it returns focus to the form. } if Assigned(ParentForm) and ParentForm.HandleAllocated and (Message.ActiveWindow <> ParentForm.Handle) then SetActiveWindow(ParentForm.Handle); end; end; procedure TTBFloatingWindowParent.WMMouseActivate(var Message: TWMMouseActivate); var ParentForm, MDIParentForm: TTBCustomForm; begin if csDesigning in ComponentState then begin inherited; Exit; end; { When floating, prevent the toolbar from activating when clicked. This is so it doesn't take the focus away from the window that had it } Message.Result := MA_NOACTIVATE; { Similar to calling BringWindowToTop, but doesn't activate it } SetWindowPos(Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE); { Since it is returning MA_NOACTIVATE, activate the form instead. } ParentForm := TBGetToolWindowParentForm(FDockableWindow); MDIParentForm := GetMDIParent(ParentForm); if (FDockableWindow.FFloatingMode = fmOnTopOfParentForm) and FDockableWindow.FActivateParent and Assigned(MDIParentForm) and (GetActiveWindow <> Handle) then begin { ^ Note to self: The GetActiveWindow check must be in there so that double-clicks work properly on controls like Edits } if MDIParentForm.HandleAllocated then SetActiveWindow(MDIParentForm.Handle); if (MDIParentForm <> ParentForm) and { if it's an MDI child form } ParentForm.HandleAllocated then BringWindowToTop(ParentForm.Handle); end; end; procedure TTBFloatingWindowParent.WMMove(var Message: TWMMove); begin inherited; FDockableWindow.Moved; end; procedure TTBFloatingWindowParent.DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN; RedrawWhat: TTBToolWindowNCRedrawWhat); { Redraws all the non-client area (the border, title bar, and close button) of the toolbar when it is floating. } const BorderColors: array[Boolean] of Integer = (COLOR_ACTIVEBORDER, COLOR_INACTIVEBORDER); CaptionBkColors: array[Boolean, Boolean] of Integer = ((COLOR_ACTIVECAPTION, COLOR_INACTIVECAPTION), (COLOR_GRADIENTACTIVECAPTION, COLOR_GRADIENTINACTIVECAPTION)); CloseButtonState: array[Boolean] of UINT = (0, DFCS_PUSHED); var DC: HDC; R, R2: TRect; Gradient: Boolean; SavePen: HPEN; SaveIndex: Integer; S: TPoint; begin if not HandleAllocated then Exit; if not DrawToDC then DC := GetWindowDC(Handle) else DC := ADC; try { Use update region } if not DrawToDC then SelectNCUpdateRgn(Handle, DC, Clip); { Work around an apparent NT 4.0 & 2000 bug. If the width of the DC is greater than the width of the screen, then any call to ExcludeClipRect inexplicably shrinks the clipping rectangle to the screen width. I've found that calling IntersectClipRect as done below magically fixes the problem (but I'm not sure why). } GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top); IntersectClipRect(DC, R.Left, R.Top, R.Right, R.Bottom); Gradient := GetSystemParametersInfoBool(SPI_GETGRADIENTCAPTIONS, False); { Border } if twrdBorder in RedrawWhat then begin { This works around WM_NCPAINT problem described at top of source code } {no! R := Rect(0, 0, Width, Height);} GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top); R2 := R; DrawEdge(DC, R, EDGE_RAISED, BF_RECT or BF_ADJUST); S := FDockableWindow.GetFloatingBorderSize; InflateRect(R2, -(S.X - 1), -(S.Y - 1)); FrameRect(DC, R2, GetSysColorBrush(COLOR_BTNFACE)); SaveIndex := SaveDC(DC); ExcludeClipRect(DC, R2.Left, R2.Top, R2.Right, R2.Bottom); FillRect(DC, R, GetSysColorBrush(BorderColors[FDockableWindow.FInactiveCaption])); RestoreDC(DC, SaveIndex); end; if FDockableWindow.ShowCaption then begin if (twrdCaption in RedrawWhat) and FDockableWindow.FCloseButton and (twrdCloseButton in RedrawWhat) then SaveIndex := SaveDC(DC) else SaveIndex := 0; try if SaveIndex <> 0 then with GetCloseButtonRect(True) do { Reduces flicker } ExcludeClipRect(DC, Left, Top, Right, Bottom); { Caption } if twrdCaption in RedrawWhat then begin R := GetCaptionRect(True, FDockableWindow.FCloseButton); DrawSmallWindowCaption(Handle, DC, R, Caption, not FDockableWindow.FInactiveCaption); { Line below caption } R := GetCaptionRect(True, False); SavePen := SelectObject(DC, CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNFACE))); MoveToEx(DC, R.Left, R.Bottom, nil); LineTo(DC, R.Right, R.Bottom); DeleteObject(SelectObject(DC, SavePen)); end; finally if SaveIndex <> 0 then RestoreDC(DC, SaveIndex); end; { Close button } if FDockableWindow.FCloseButton then begin R := GetCloseButtonRect(True); R2 := R; InflateRect(R2, 0, -2); Dec(R2.Right, 2); if twrdCaption in RedrawWhat then begin SaveIndex := SaveDC(DC); ExcludeClipRect(DC, R2.Left, R2.Top, R2.Right, R2.Bottom); FillRect(DC, R, GetSysColorBrush(CaptionBkColors[Gradient, FDockableWindow.FInactiveCaption])); RestoreDC(DC, SaveIndex); end; if twrdCloseButton in RedrawWhat then DrawFrameControl(DC, R2, DFC_CAPTION, DFCS_CAPTIONCLOSE or CloseButtonState[FCloseButtonDown]); end; end; finally if not DrawToDC then ReleaseDC(Handle, DC); end; end; procedure TTBFloatingWindowParent.RedrawNCArea(const RedrawWhat: TTBToolWindowNCRedrawWhat); begin { Note: IsWindowVisible is called as an optimization. There's no need to draw on invisible windows. } if HandleAllocated and IsWindowVisible(Handle) then DrawNCArea(False, 0, 0, RedrawWhat); end; procedure TTBFloatingWindowParent.CallRecreateWnd; { This method exists for Delphi.NET: If we try to call RecreateWnd directly in TTBCustomDockableWindow.SetResizable, we get this compiler error: "Only methods of descendant types may access protected member [Borland.Vcl]TWinControl.RecreateWnd across assembly boundaries" } begin RecreateWnd; end; { TTBCustomDockableWindow } constructor TTBCustomDockableWindow.Create(AOwner: TComponent); begin inherited; ControlStyle := ControlStyle + [csAcceptsControls, csClickEvents, csDoubleClicks, csSetCaption] - [csCaptureMouse{capturing is done manually}, csOpaque]; FAutoResize := True; FActivateParent := True; FBorderStyle := bsSingle; FCloseButton := True; FDockableTo := [dpTop, dpBottom, dpLeft, dpRight]; FDockableWindowStyles := [tbdsResizeEightCorner, tbdsResizeClipCursor]; FDockPos := -1; FDragHandleStyle := dhSingle; FEffectiveDockRow := -1; FHideWhenInactive := True; FResizable := True; FShowCaption := True; FSmoothDrag := True; FUseLastDock := True; Color := clBtnFace; if not(csDesigning in ComponentState) then InstallHookProc(Self, ToolbarHookProc, [hpSendActivate, hpSendActivateApp, hpSendWindowPosChanged, hpPreDestroy]); InitTrackMouseEvent; end; destructor TTBCustomDockableWindow.Destroy; begin inherited; FreeAndNil(FDockForms); { must be done after 'inherited' because Notification accesses FDockForms } FreeAndNil(FFloatParent); UninstallHookProc(Self, ToolbarHookProc); end; function TTBCustomDockableWindow.HasParent: Boolean; begin if Parent is TTBFloatingWindowParent then Result := False else Result := inherited HasParent; end; function TTBCustomDockableWindow.GetParentComponent: TComponent; begin if Parent is TTBFloatingWindowParent then Result := nil else Result := inherited GetParentComponent; end; procedure TTBCustomDockableWindow.Moved; begin if not(csLoading in ComponentState) and Assigned(FOnMove) and (FDisableOnMove <= 0) then FOnMove(Self); end; procedure TTBCustomDockableWindow.WMMove(var Message: TWMMove); procedure Redraw; { Redraws the control using an off-screen bitmap to avoid flicker } var CR, R: TRect; W: HWND; DC, BmpDC: HDC; Bmp: HBITMAP; begin if not HandleAllocated then Exit; CR := ClientRect; W := Handle; if GetUpdateRect(W, R, False) and EqualRect(R, CR) then begin { The client area is already completely invalid, so don't bother using an off-screen bitmap } InvalidateAll(Self); Exit; end; ValidateRect(W, nil); BmpDC := 0; Bmp := 0; DC := GetDC(W); try BmpDC := CreateCompatibleDC(DC); Bmp := CreateCompatibleBitmap(DC, CR.Right, CR.Bottom); SelectObject(BmpDC, Bmp); SendMessage(W, WM_NCPAINT, 0, 0); SendMessage(W, WM_ERASEBKGND, WPARAM(BmpDC), 0); SendMessage(W, WM_PAINT, WPARAM(BmpDC), 0); BitBlt(DC, 0, 0, CR.Right, CR.Bottom, BmpDC, 0, 0, SRCCOPY); finally if BmpDC <> 0 then DeleteDC(BmpDC); if Bmp <> 0 then DeleteObject(Bmp); ReleaseDC(W, DC); end; end; begin inherited; FMoved := True; if Docked and CurrentDock.UsingBackground then begin { Needs to redraw so that the background is lined up with the dock at the new position. } Redraw; end; Moved; end; {$IFNDEF JR_D4} procedure TTBCustomDockableWindow.WMSize(var Message: TWMSize); begin inherited; if not(csLoading in ComponentState) and Assigned(FOnResize) then FOnResize(Self); end; {$ENDIF} procedure TTBCustomDockableWindow.UpdateCaptionState; { Updates the caption active/inactive state of a floating tool window. Called when the tool window is visible or is about to be shown. } function IsPopupWindowActive: Boolean; const IID_ITBPopupWindow: TGUID = '{E45CBE74-1ECF-44CB-B064-6D45B1924708}'; var Ctl: TWinControl; {$IFDEF CLR} Intfs: array of System.Type; I: Integer; {$ENDIF} begin Ctl := FindControl(GetActiveWindow); { Instead of using "is TTBPopupWindow", which would require linking to the TB2Item unit, check if the control implements the ITBPopupWindow interface. This will tell us if it's a TTBPopupWindow or descendant. } {$IFNDEF CLR} Result := Assigned(Ctl) and Assigned(Ctl.GetInterfaceEntry(IID_ITBPopupWindow)); {$ELSE} Result := False; if Assigned(Ctl) then begin Intfs := TypeOf(Ctl).GetInterfaces; for I := Low(Intfs) to High(Intfs) do begin if Intfs[I].GUID = IID_ITBPopupWindow then begin Result := True; Break; end; end; end; {$ENDIF} end; function GetActiveFormWindow: HWND; var Ctl: TWinControl; begin Result := GetActiveWindow; { If the active window is a TTBFloatingWindowParent (i.e. a control on a floating toolbar is focused), return the parent form handle instead } Ctl := FindControl(Result); if Assigned(Ctl) and (Ctl is TTBFloatingWindowParent) then begin Ctl := TTBFloatingWindowParent(Ctl).ParentForm; if Assigned(Ctl) and Ctl.HandleAllocated then Result := Ctl.Handle; end; end; var Inactive: Boolean; ActiveWnd: HWND; begin { Update caption state if floating, but not if a control on a popup window (e.g. a TTBEditItem) is currently focused; we don't want the captions on all floating toolbars to turn gray in that case. (The caption state will get updated when we're called the next time the active window changes, i.e. when the user dismisses the popup window.) } if (Parent is TTBFloatingWindowParent) and Parent.HandleAllocated and not IsPopupWindowActive then begin Inactive := False; if not ApplicationIsActive then Inactive := True else if (FFloatingMode = fmOnTopOfParentForm) and (HWND(GetWindowLong(Parent.Handle, GWL_HWNDPARENT)) <> Application.Handle) then begin { Use inactive caption if the active window doesn't own the float parent (directly or indirectly). Note: For compatibility with browser-embedded TActiveForms, we use IsAncestorOfWindow instead of checking TBGetToolWindowParentForm. } ActiveWnd := GetActiveFormWindow; if (ActiveWnd = 0) or not IsAncestorOfWindow(ActiveWnd, Parent.Handle) then Inactive := True; end; if FInactiveCaption <> Inactive then begin FInactiveCaption := Inactive; TTBFloatingWindowParent(Parent).RedrawNCArea(twrdAll); end; end; end; function TTBCustomDockableWindow.GetShowingState: Boolean; function IsWindowVisibleAndNotMinimized(Wnd: HWND): Boolean; begin Result := IsWindowVisible(Wnd); if Result then begin { Wnd may not be a top-level window (e.g. in the case of an MDI child form, or an ActiveForm embedded in a web page), so go up the chain of parent windows and see if any of them are minimized } repeat if IsIconic(Wnd) then begin Result := False; Break; end; { Stop if we're at a top-level window (no need to check owner windows) } if GetWindowLong(Wnd, GWL_STYLE) and WS_CHILD = 0 then Break; Wnd := GetParent(Wnd); until Wnd = 0; end; end; var HideFloatingToolbars: Boolean; ParentForm: TTBCustomForm; begin Result := Showing and (FHidden = 0); if Floating and not(csDesigning in ComponentState) then begin HideFloatingToolbars := FFloatingMode = fmOnTopOfParentForm; if HideFloatingToolbars then begin ParentForm := TBGetToolWindowParentForm(Self); if Assigned(ParentForm) and ParentForm.HandleAllocated and IsWindowVisibleAndNotMinimized(ParentForm.Handle) then HideFloatingToolbars := False; end; Result := Result and not (HideFloatingToolbars or (FHideWhenInactive and not ApplicationIsActive)); end; end; procedure TTBCustomDockableWindow.UpdateVisibility; { Updates the visibility of the tool window, and additionally the caption state if floating and showing } var IsVisible: Boolean; begin if HandleAllocated then begin IsVisible := IsWindowVisible(Handle); if IsVisible <> GetShowingState then begin Perform(CM_SHOWINGCHANGED, 0, 0); { Note: CMShowingChanged will call UpdateCaptionState automatically when floating and showing } end else if IsVisible and Floating then begin { If we're floating and we didn't send the CM_SHOWINGCHANGED message then we have to call UpdateCaptionState manually } UpdateCaptionState; end; end; end; function IsTopmost(const Wnd: HWND): Boolean; begin Result := GetWindowLong(Wnd, GWL_EXSTYLE) and WS_EX_TOPMOST <> 0; end; procedure TTBCustomDockableWindow.UpdateTopmostFlag; const Wnds: array[Boolean] of HWND = (HWND_NOTOPMOST, HWND_TOPMOST); var ShouldBeTopmost: Boolean; begin if HandleAllocated then begin if FFloatingMode = fmOnTopOfAllForms then ShouldBeTopmost := True else ShouldBeTopmost := IsTopmost(HWND(GetWindowLong(Parent.Handle, GWL_HWNDPARENT))); if ShouldBeTopmost <> IsTopmost(Parent.Handle) then { ^ it must check if it already was topmost or non-topmost or else it causes problems on Win95/98 for some reason } SetWindowPos(Parent.Handle, Wnds[ShouldBeTopmost], 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE); end; end; procedure TTBCustomDockableWindow.CMShowingChanged(var Message: TMessage); function GetPrevWnd(W: HWND): HWND; var WasTopmost, Done: Boolean; ParentWnd: HWND; begin WasTopmost := IsTopmost(Parent.Handle); Result := W; repeat Done := True; Result := GetWindow(Result, GW_HWNDPREV); ParentWnd := Result; while ParentWnd <> 0 do begin if WasTopmost and not IsTopmost(ParentWnd) then begin Done := False; Break; end; ParentWnd := HWND(GetWindowLong(ParentWnd, GWL_HWNDPARENT)); if ParentWnd = W then begin Done := False; Break; end; end; until Done; end; const ShowFlags: array[Boolean] of UINT = ( SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW, SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW); var Show: Boolean; Form: TTBCustomForm; begin { inherited isn't called since TTBCustomDockableWindow handles CM_SHOWINGCHANGED itself. For reference, the original TWinControl implementation is: const ShowFlags: array[Boolean] of Word = ( SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_HIDEWINDOW, SWP_NOSIZE + SWP_NOMOVE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_SHOWWINDOW); begin SetWindowPos(FHandle, 0, 0, 0, 0, 0, ShowFlags[FShowing]); end; } if HandleAllocated then begin Show := GetShowingState; if Parent is TTBFloatingWindowParent then begin if Show then begin { If the toolbar is floating, set its "owner window" to the parent form so that the toolbar window always stays on top of the form } if FFloatingMode = fmOnTopOfParentForm then begin Form := GetMDIParent(TBGetToolWindowParentForm(Self)); if Assigned(Form) and Form.HandleAllocated and (HWND(GetWindowLong(Parent.Handle, GWL_HWNDPARENT)) <> Form.Handle) then begin SetWindowOwner(Parent.Handle, Form.Handle); { Following is necessarily to make it immediately realize the GWL_HWNDPARENT change } SetWindowPos(Parent.Handle, GetPrevWnd(Form.Handle), 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE); end; end else begin SetWindowOwner(Parent.Handle, Application.Handle); end; { Initialize caption state after setting owner but before showing } UpdateCaptionState; end; UpdateTopmostFlag; { Show/hide the TTBFloatingWindowParent. The following lines had to be added to fix a problem that was in 1.65d/e. In 1.65d/e, it always kept TTBFloatingWindowParent visible (this change was made to improve compatibility with D4's Actions), but this for some odd reason would cause a Stack Overflow error if the program's main form was closed while a floating toolwindow was focused. (This problem did not occur on NT.) } TTBFloatingWindowParent(Parent).FShouldShow := Show; Parent.Perform(CM_SHOWINGCHANGED, 0, 0); end; SetWindowPos(Handle, 0, 0, 0, 0, 0, ShowFlags[Show]); if not Show and (GetActiveWindow = Handle) then { If the window is hidden but is still active, find and activate a different window } SetActiveWindow(FindTopLevelWindow(Handle)); end; end; procedure TTBCustomDockableWindow.CreateParams(var Params: TCreateParams); begin inherited; { Disable complete redraws when size changes. CS_H/VREDRAW cause flicker and are not necessary for this control at run time } if not(csDesigning in ComponentState) then with Params.WindowClass do Style := Style and not(CS_HREDRAW or CS_VREDRAW); end; procedure TTBCustomDockableWindow.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; if Operation = opRemove then begin if AComponent = FDefaultDock then FDefaultDock := nil else if AComponent = FLastDock then FLastDock := nil else RemoveFromList(FDockForms, AComponent); end; end; procedure TTBCustomDockableWindow.MoveOnScreen(const OnlyIfFullyOffscreen: Boolean); { Moves the (floating) toolbar so that it is fully (or at least mostly) in view on the screen } var R, S, Test: TRect; begin if Floating then begin R := Parent.BoundsRect; S := GetRectOfMonitorContainingRect(R, True); if OnlyIfFullyOffscreen and IntersectRect(Test, R, S) then Exit; if R.Right > S.Right then OffsetRect(R, S.Right - R.Right, 0); if R.Bottom > S.Bottom then OffsetRect(R, 0, S.Bottom - R.Bottom); if R.Left < S.Left then OffsetRect(R, S.Left - R.Left, 0); if R.Top < S.Top then OffsetRect(R, 0, S.Top - R.Top); Parent.BoundsRect := R; end; end; procedure TTBCustomDockableWindow.ReadPositionData(const Data: TTBReadPositionData); begin end; procedure TTBCustomDockableWindow.DoneReadingPositionData(const Data: TTBReadPositionData); begin end; procedure TTBCustomDockableWindow.WritePositionData(const Data: TTBWritePositionData); begin end; procedure TTBCustomDockableWindow.InitializeOrdering; begin end; procedure TTBCustomDockableWindow.SizeChanging(const AWidth, AHeight: Integer); begin end; procedure TTBCustomDockableWindow.ReadSavedAtRunTime(Reader: TReader); begin FSavedAtRunTime := Reader.ReadBoolean; end; procedure TTBCustomDockableWindow.WriteSavedAtRunTime(Writer: TWriter); begin { WriteSavedAtRunTime only called when not(csDesigning in ComponentState) } Writer.WriteBoolean(True); end; procedure TTBCustomDockableWindow.DefineProperties(Filer: TFiler); begin inherited; Filer.DefineProperty('SavedAtRunTime', ReadSavedAtRunTime, WriteSavedAtRunTime, not(csDesigning in ComponentState)); end; procedure TTBCustomDockableWindow.Loaded; var R: TRect; begin inherited; { Adjust coordinates if it was initially floating } if not FSavedAtRunTime and not(csDesigning in ComponentState) and (Parent is TTBFloatingWindowParent) then begin R := BoundsRect; MapWindowPoints(TBValidToolWindowParentForm(Self).Handle, 0, R, 2); BoundsRect := R; MoveOnScreen(False); end; InitializeOrdering; { Arranging is disabled while component was loading, so arrange now } Arrange; end; procedure TTBCustomDockableWindow.BeginUpdate; begin Inc(FDisableArrange); end; procedure TTBCustomDockableWindow.EndUpdate; begin Dec(FDisableArrange); if FArrangeNeeded and (FDisableArrange = 0) then Arrange; end; procedure TTBCustomDockableWindow.AddDockForm(const Form: TTBCustomForm); begin if Form = nil then Exit; if AddToList(FDockForms, Form) then Form.FreeNotification(Self); end; procedure TTBCustomDockableWindow.RemoveDockForm(const Form: TTBCustomForm); begin RemoveFromList(FDockForms, Form); end; function TTBCustomDockableWindow.IsAutoResized: Boolean; begin Result := AutoResize or Assigned(CurrentDock) or Floating; end; procedure TTBCustomDockableWindow.ChangeSize(AWidth, AHeight: Integer); var S: TPoint; begin if Docked then CurrentDock.ArrangeToolbars else begin S := CalcNCSizes; Inc(AWidth, S.X); Inc(AHeight, S.Y); { Leave the width and/or height alone if the control is Anchored (or Aligned) } if not Floating then begin if (akLeft in Anchors) and (akRight in Anchors) then AWidth := Width; if (akTop in Anchors) and (akBottom in Anchors) then AHeight := Height; end; Inc(FUpdatingBounds); try SetBounds(Left, Top, AWidth, AHeight); finally Dec(FUpdatingBounds); end; end; end; procedure TTBCustomDockableWindow.Arrange; var Size: TPoint; begin if (FDisableArrange > 0) or { Prevent flicker while loading } (csLoading in ComponentState) or { Don't call DoArrangeControls when Parent is nil. The VCL sets Parent to 'nil' during destruction of a component; we can't have an OrderControls call after a descendant control has freed its data. } (Parent = nil) then begin FArrangeNeeded := True; Exit; end; FArrangeNeeded := False; Size := DoArrange(True, TBGetDockTypeOf(CurrentDock, Floating), Floating, CurrentDock); if IsAutoResized then ChangeSize(Size.X, Size.Y); end; procedure TTBCustomDockableWindow.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); begin if not(csDesigning in ComponentState) and Floating then begin { Force Top & Left to 0 if floating } ALeft := 0; ATop := 0; if Parent is TTBFloatingWindowParent then with Parent do SetBounds(Left, Top, (Width-ClientWidth) + AWidth, (Height-ClientHeight) + AHeight); end; if (FUpdatingBounds = 0) and ((AWidth <> Width) or (AHeight <> Height)) then SizeChanging(AWidth, AHeight); { This allows you to drag the toolbar around the dock at design time } if (csDesigning in ComponentState) and not(csLoading in ComponentState) and Docked and (FUpdatingBounds = 0) and ((ALeft <> Left) or (ATop <> Top)) then begin if not(CurrentDock.Position in PositionLeftOrRight) then begin FDockRow := CurrentDock.GetDesignModeRowOf(ATop+(Height div 2)); FDockPos := ALeft; end else begin FDockRow := CurrentDock.GetDesignModeRowOf(ALeft+(Width div 2)); FDockPos := ATop; end; inherited SetBounds(Left, Top, AWidth, AHeight); { only pass any size changes } CurrentDock.ArrangeToolbars; { let ArrangeToolbars take care of position changes } end else begin inherited; {if not(csLoading in ComponentState) and Floating and (FUpdatingBounds = 0) then FFloatingPosition := BoundsRect.TopLeft;} end; end; procedure TTBCustomDockableWindow.SetParent(AParent: TWinControl); procedure UpdateFloatingToolWindows; begin if Parent is TTBFloatingWindowParent then begin AddToList(FloatingToolWindows, Self); Parent.SetBounds(FFloatingPosition.X, FFloatingPosition.Y, Parent.Width, Parent.Height); end else RemoveFromList(FloatingToolWindows, Self); end; function ParentToCurrentDock(const Ctl: TWinControl): TTBDock; begin if Ctl is TTBDock then Result := TTBDock(Ctl) else Result := nil; end; var OldCurrentDock, NewCurrentDock: TTBDock; NewFloating: Boolean; SaveHandle: HWND; begin OldCurrentDock := ParentToCurrentDock(Parent); NewCurrentDock := ParentToCurrentDock(AParent); NewFloating := AParent is TTBFloatingWindowParent; if AParent = Parent then begin { Even though AParent is the same as the current Parent, this code is necessary because when the VCL destroys the parent of the tool window, it calls TWinControl.Remove to set FParent instead of using SetParent. However TControl.Destroy does call SetParent(nil), so it is eventually notified of the change before it is destroyed. } FCurrentDock := NewCurrentDock; FFloating := NewFloating; FDocked := Assigned(FCurrentDock); UpdateFloatingToolWindows; end else begin if not(csDestroying in ComponentState) and Assigned(AParent) then begin if Assigned(FOnDockChanging) then FOnDockChanging(Self, NewFloating, NewCurrentDock); if Assigned(FOnRecreating) then FOnRecreating(Self); end; { Before changing between docked and floating state (and vice-versa) or between docks, increment FHidden and call UpdateVisibility to hide the toolbar. This prevents any flashing while it's being moved } Inc(FHidden); Inc(FDisableOnMove); try UpdateVisibility; if Assigned(OldCurrentDock) then OldCurrentDock.BeginUpdate; if Assigned(NewCurrentDock) then NewCurrentDock.BeginUpdate; Inc(FUpdatingBounds); try if Assigned(AParent) then DoDockChangingHidden(NewFloating, NewCurrentDock); BeginUpdate; try { FCurrentSize probably won't be valid after changing Parents, so reset it to zero } FCurrentSize := 0; if Parent is TTBDock then begin if not FUseLastDock or (FLastDock <> Parent) then TTBDock(Parent).ChangeDockList(False, Self); TTBDock(Parent).ToolbarVisibilityChanged(Self, True); end; { By default, the VCL destroys a control's window handle when it changes parents. Prevent that from happening by capturing the current handle, detaching the control from its current parent, then restoring the handle back. } SaveHandle := 0; if Assigned(AParent) then begin SaveHandle := WindowHandle; WindowHandle := 0; end; inherited SetParent(nil); FCurrentDock := NewCurrentDock; FFloating := NewFloating; FDocked := Assigned(FCurrentDock); try if SaveHandle <> 0 then begin WindowHandle := SaveHandle; Windows.SetParent(SaveHandle, AParent.Handle); SetWindowPos(SaveHandle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER); end; inherited; except { Failure is rare, but just in case, restore these back. } FCurrentDock := ParentToCurrentDock(Parent); FFloating := Parent is TTBFloatingWindowParent; FDocked := Assigned(FCurrentDock); raise; end; { FEffectiveDockRow probably won't be valid on the new Parent, so reset it to -1 so that GetMinRowSize will temporarily ignore this toolbar } FEffectiveDockRow := -1; { To conserve resources, free FFloatParent if it's no longer the Parent. But don't do this while FSmoothDragging=True, because destroying the window the user initially clicked down on causes Windows to stop delivering mouse-move messages when the cursor is moved over other applications' windows, even if we still have the mouse capture. } if not FSmoothDragging and Assigned(FFloatParent) and (Parent <> FFloatParent) then FreeAndNil(FFloatParent); if Parent is TTBDock then begin if FUseLastDock and not FSmoothDragging then begin LastDock := TTBDock(Parent); { calls ChangeDockList if LastDock changes } TTBDock(Parent).ToolbarVisibilityChanged(Self, False); end else TTBDock(Parent).ChangeDockList(True, Self); end; UpdateFloatingToolWindows; { Schedule an arrange } Arrange; finally EndUpdate; end; finally Dec(FUpdatingBounds); if Assigned(NewCurrentDock) then NewCurrentDock.EndUpdate; if Assigned(OldCurrentDock) then OldCurrentDock.EndUpdate; end; finally Dec(FDisableOnMove); Dec(FHidden); UpdateVisibility; { ^ The above UpdateVisibility call not only updates the tool window's visibility after decrementing FHidden, it also sets the active/inactive state of the caption. } end; if Assigned(Parent) then Moved; if not(csDestroying in ComponentState) and Assigned(AParent) then begin if Assigned(FOnRecreated) then FOnRecreated(Self); if Assigned(FOnDockChanged) then FOnDockChanged(Self); end; end; end; procedure TTBCustomDockableWindow.AddDockedNCAreaToSize(var S: TPoint; const LeftRight: Boolean); var TopLeft, BottomRight: TPoint; begin GetDockedNCArea(TopLeft, BottomRight, LeftRight); Inc(S.X, TopLeft.X + BottomRight.X); Inc(S.Y, TopLeft.Y + BottomRight.Y); end; procedure TTBCustomDockableWindow.AddFloatingNCAreaToSize(var S: TPoint); var TopLeft, BottomRight: TPoint; begin GetFloatingNCArea(TopLeft, BottomRight); Inc(S.X, TopLeft.X + BottomRight.X); Inc(S.Y, TopLeft.Y + BottomRight.Y); end; procedure TTBCustomDockableWindow.GetDockedNCArea(var TopLeft, BottomRight: TPoint; const LeftRight: Boolean); var Z: Integer; begin Z := DockedBorderSize; { code optimization... } TopLeft.X := Z; TopLeft.Y := Z; BottomRight.X := Z; BottomRight.Y := Z; if not LeftRight then begin Inc(TopLeft.X, DragHandleSizes[CloseButtonWhenDocked, DragHandleStyle]); //if FShowChevron then // Inc(BottomRight.X, tbChevronSize); end else begin Inc(TopLeft.Y, DragHandleSizes[CloseButtonWhenDocked, DragHandleStyle]); //if FShowChevron then // Inc(BottomRight.Y, tbChevronSize); end; end; function TTBCustomDockableWindow.GetFloatingBorderSize: TPoint; { Returns size of a thick border. Note that, depending on the Windows version, this may not be the same as the actual window metrics since it draws its own border } const XMetrics: array[Boolean] of Integer = (SM_CXDLGFRAME, SM_CXFRAME); YMetrics: array[Boolean] of Integer = (SM_CYDLGFRAME, SM_CYFRAME); begin Result.X := GetSystemMetrics(XMetrics[Resizable]); Result.Y := GetSystemMetrics(YMetrics[Resizable]); end; procedure TTBCustomDockableWindow.GetFloatingNCArea(var TopLeft, BottomRight: TPoint); begin with GetFloatingBorderSize do begin TopLeft.X := X; TopLeft.Y := Y; if ShowCaption then Inc(TopLeft.Y, GetSmallCaptionHeight); BottomRight.X := X; BottomRight.Y := Y; end; end; function TTBCustomDockableWindow.GetDockedCloseButtonRect(LeftRight: Boolean): TRect; var X, Y, Z: Integer; begin Z := DragHandleSizes[CloseButtonWhenDocked, FDragHandleStyle] - 3; if not LeftRight then begin X := DockedBorderSize+1; Y := DockedBorderSize; end else begin X := (ClientWidth + DockedBorderSize) - Z; Y := DockedBorderSize+1; end; Result := Bounds(X, Y, Z, Z); end; function TTBCustomDockableWindow.CalcNCSizes: TPoint; var Z: Integer; begin if not Docked then begin Result.X := 0; Result.Y := 0; end else begin Result.X := DockedBorderSize2; Result.Y := DockedBorderSize2; if CurrentDock.FAllowDrag then begin Z := DragHandleSizes[FCloseButtonWhenDocked, FDragHandleStyle]; if not(CurrentDock.Position in PositionLeftOrRight) then Inc(Result.X, Z) else Inc(Result.Y, Z); end; end; end; procedure TTBCustomDockableWindow.WMNCCalcSize(var Message: TWMNCCalcSize); procedure ApplyToRect(var R: TRect); var Z: Integer; begin InflateRect(R, -DockedBorderSize, -DockedBorderSize); if CurrentDock.FAllowDrag then begin Z := DragHandleSizes[FCloseButtonWhenDocked, FDragHandleStyle]; if not(CurrentDock.Position in PositionLeftOrRight) then Inc(R.Left, Z) else Inc(R.Top, Z); end; end; {$IFDEF CLR} var Params: TNCCalcSizeParams; {$ENDIF} begin { Doesn't call inherited since it overrides the normal NC sizes } Message.Result := 0; if Docked then begin {$IFNDEF CLR} ApplyToRect(Message.CalcSize_Params.rgrc[0]); {$ELSE} Params := Message.CalcSize_Params; ApplyToRect(Params.rgrc0); Message.CalcSize_Params := Params; {$ENDIF} end; end; procedure TTBCustomDockableWindow.WMSetCursor(var Message: TWMSetCursor); var P: TPoint; R: TRect; I: Integer; begin if Docked and CurrentDock.FAllowDrag and (Message.CursorWnd = WindowHandle) and (Smallint(Message.HitTest) = HT_TB2k_Border) and (DragHandleStyle <> dhNone) then begin GetCursorPos(P); GetWindowRect(Handle, R); if not(CurrentDock.Position in PositionLeftOrRight) then I := P.X - R.Left else I := P.Y - R.Top; if I < DockedBorderSize + DragHandleSizes[CloseButtonWhenDocked, DragHandleStyle] then begin SetCursor(LoadCursor(0, IDC_SIZEALL)); Message.Result := 1; Exit; end; end; inherited; end; procedure TTBCustomDockableWindow.DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); { Redraws all the non-client area of the toolbar when it is docked. } var DC: HDC; R: TRect; VerticalDock: Boolean; X, Y, Y2, Y3, YO, S, SaveIndex: Integer; R2, R3, R4: TRect; P1, P2: TPoint; Brush: HBRUSH; Clr: TColorRef; UsingBackground, B: Boolean; procedure DrawRaisedEdge(R: TRect; const FillInterior: Boolean); const FillMiddle: array[Boolean] of UINT = (0, BF_MIDDLE); begin DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT or FillMiddle[FillInterior]); end; function CreateCloseButtonBitmap: HBITMAP; const Pattern: array[0..15] of Byte = (0, 0, $CC, 0, $78, 0, $30, 0, $78, 0, $CC, 0, 0, 0, 0, 0); begin Result := CreateMonoBitmap(8, 8, Pattern); end; procedure DrawButtonBitmap(const Bmp: HBITMAP); var TempBmp: TBitmap; begin TempBmp := TBitmap.Create; try TempBmp.Handle := Bmp; SetTextColor(DC, clBlack); SetBkColor(DC, clWhite); SelectObject(DC, GetSysColorBrush(COLOR_BTNTEXT)); BitBlt(DC, R2.Left, R2.Top, R2.Right - R2.Left, R2.Bottom - R2.Top, TempBmp.Canvas.Handle, 0, 0, $00E20746 {ROP_DSPDxax}); finally TempBmp.Free; end; end; const CloseButtonState: array[Boolean] of UINT = (0, DFCS_PUSHED); begin if not Docked or not HandleAllocated then Exit; if not DrawToDC then DC := GetWindowDC(Handle) else DC := ADC; try { Use update region } if not DrawToDC then SelectNCUpdateRgn(Handle, DC, Clip); { This works around WM_NCPAINT problem described at top of source code } {no! R := Rect(0, 0, Width, Height);} GetWindowRect(Handle, R); OffsetRect(R, -R.Left, -R.Top); VerticalDock := CurrentDock.Position in PositionLeftOrRight; Brush := CreateSolidBrush(ColorToRGB(Color)); UsingBackground := CurrentDock.UsingBackground and CurrentDock.FBkgOnToolbars; { Border } if BorderStyle = bsSingle then DrawRaisedEdge(R, False) else FrameRect(DC, R, Brush); R2 := R; InflateRect(R2, -1, -1); if not UsingBackground then FrameRect(DC, R2, Brush); { Draw the Background } if UsingBackground then begin R2 := R; P1 := CurrentDock.ClientToScreen(Point(0, 0)); P2 := CurrentDock.Parent.ClientToScreen(CurrentDock.BoundsRect.TopLeft); Dec(R2.Left, Left + CurrentDock.Left + (P1.X-P2.X)); Dec(R2.Top, Top + CurrentDock.Top + (P1.Y-P2.Y)); InflateRect(R, -1, -1); GetWindowRect(Handle, R4); R3 := ClientRect; with ClientToScreen(Point(0, 0)) do OffsetRect(R3, X-R4.Left, Y-R4.Top); SaveIndex := SaveDC(DC); IntersectClipRect(DC, R.Left, R.Top, R.Right, R.Bottom); ExcludeClipRect(DC, R3.Left, R3.Top, R3.Right, R3.Bottom); CurrentDock.DrawBackground(DC, R2); RestoreDC(DC, SaveIndex); end; { The drag handle at the left, or top } if CurrentDock.FAllowDrag then begin SaveIndex := SaveDC(DC); if not VerticalDock then Y2 := ClientHeight else Y2 := ClientWidth; Inc(Y2, DockedBorderSize); S := DragHandleSizes[FCloseButtonWhenDocked, FDragHandleStyle]; if FDragHandleStyle <> dhNone then begin Y3 := Y2; X := DockedBorderSize + DragHandleXOffsets[FCloseButtonWhenDocked, FDragHandleStyle]; Y := DockedBorderSize; YO := Ord(FDragHandleStyle = dhSingle); if FCloseButtonWhenDocked then begin if not VerticalDock then Inc(Y, S - 2) else Dec(Y3, S - 2); end; Clr := GetSysColor(COLOR_BTNHIGHLIGHT); for B := False to (FDragHandleStyle = dhDouble) do begin if not VerticalDock then R2 := Rect(X, Y+YO, X+3, Y2-YO) else R2 := Rect(Y+YO, X, Y3-YO, X+3); DrawRaisedEdge(R2, True); if not VerticalDock then SetPixelV(DC, X, Y2-1-YO, Clr) else SetPixelV(DC, Y3-1-YO, X, Clr); ExcludeClipRect(DC, R2.Left, R2.Top, R2.Right, R2.Bottom); Inc(X, 3); end; end; if not UsingBackground then begin if not VerticalDock then R2 := Rect(DockedBorderSize, DockedBorderSize, DockedBorderSize+S, Y2) else R2 := Rect(DockedBorderSize, DockedBorderSize, Y2, DockedBorderSize+S); FillRect(DC, R2, Brush); end; RestoreDC(DC, SaveIndex); { Close button } if FCloseButtonWhenDocked then begin R2 := GetDockedCloseButtonRect(VerticalDock); if FCloseButtonDown then DrawEdge(DC, R2, BDR_SUNKENOUTER, BF_RECT) else if FCloseButtonHover then DrawRaisedEdge(R2, False); InflateRect(R2, -2, -2); if FCloseButtonDown then OffsetRect(R2, 1, 1); DrawButtonBitmap(CreateCloseButtonBitmap); end; end; DeleteObject(Brush); finally if not DrawToDC then ReleaseDC(Handle, DC); end; end; procedure TTBCustomDockableWindow.RedrawNCArea; begin { Note: IsWindowVisible is called as an optimization. There's no need to draw on invisible windows. } if HandleAllocated and IsWindowVisible(Handle) then DrawNCArea(False, 0, 0); end; procedure TTBCustomDockableWindow.WMNCPaint(var Message: TMessage); begin { Don't call inherited because it overrides the default NC painting } DrawNCArea(False, 0, HRGN(Message.WParam)); end; procedure DockableWindowNCPaintProc(Wnd: HWND; DC: HDC; AppData: TObject); begin with TTBCustomDockableWindow(AppData) do DrawNCArea(True, DC, 0) end; procedure TTBCustomDockableWindow.WMPrint(var Message: TMessage); begin HandleWMPrint(Handle, Message, DockableWindowNCPaintProc, Self); end; procedure TTBCustomDockableWindow.WMPrintClient(var Message: {$IFNDEF CLR} TMessage {$ELSE} TWMPrintClient {$ENDIF}); begin HandleWMPrintClient(PaintHandler, Message); end; procedure TTBCustomDockableWindow.WMEraseBkgnd(var Message: TWMEraseBkgnd); var R, R2, R3: TRect; P1, P2: TPoint; SaveIndex: Integer; begin if Docked and CurrentDock.UsingBackground and CurrentDock.FBkgOnToolbars then begin R := ClientRect; R2 := R; P1 := CurrentDock.ClientToScreen(Point(0, 0)); P2 := CurrentDock.Parent.ClientToScreen(CurrentDock.BoundsRect.TopLeft); Dec(R2.Left, Left + CurrentDock.Left + (P1.X-P2.X)); Dec(R2.Top, Top + CurrentDock.Top + (P1.Y-P2.Y)); GetWindowRect(Handle, R3); with ClientToScreen(Point(0, 0)) do begin Inc(R2.Left, R3.Left-X); Inc(R2.Top, R3.Top-Y); end; SaveIndex := SaveDC(Message.DC); IntersectClipRect(Message.DC, R.Left, R.Top, R.Right, R.Bottom); CurrentDock.DrawBackground(Message.DC, R2); RestoreDC(Message.DC, SaveIndex); Message.Result := 1; end else inherited; end; function TTBCustomDockableWindow.GetPalette: HPALETTE; begin if Docked then Result := CurrentDock.GetPalette else Result := 0; end; function TTBCustomDockableWindow.PaletteChanged(Foreground: Boolean): Boolean; begin Result := inherited PaletteChanged(Foreground); if Result and not Foreground then begin { There seems to be a bug in Delphi's palette handling. When the form is inactive and another window realizes a palette, docked TToolbar97s weren't getting redrawn. So this workaround code was added. } InvalidateAll(Self); end; end; procedure TTBCustomDockableWindow.DrawDraggingOutline(const DC: HDC; const NewRect, OldRect: TRect; const NewDocking, OldDocking: Boolean); var NewSize, OldSize: TSize; begin with GetFloatingBorderSize do begin if NewDocking then NewSize.cx := 1 else NewSize.cx := X; NewSize.cy := NewSize.cx; if OldDocking then OldSize.cx := 1 else OldSize.cx := X; OldSize.cy := OldSize.cx; end; DrawHalftoneInvertRect(DC, NewRect, OldRect, NewSize, OldSize); end; procedure TTBCustomDockableWindow.CMColorChanged(var Message: TMessage); begin { Make sure non-client area is redrawn } InvalidateAll(Self); inherited; { the inherited handler calls Invalidate } end; procedure TTBCustomDockableWindow.CMTextChanged(var Message: TMessage); begin inherited; if Parent is TTBFloatingWindowParent then TTBFloatingWindowParent(Parent).Caption := Caption; end; procedure TTBCustomDockableWindow.CMVisibleChanged(var Message: TMessage); begin if not(csDesigning in ComponentState) and Docked then CurrentDock.ToolbarVisibilityChanged(Self, False); inherited; if Assigned(FOnVisibleChanged) then FOnVisibleChanged(Self); end; type TRowSize = record Size: Integer; FullSizeRow: Boolean; end; TDockedSize = class Dock: TTBDock; BoundsRect: TRect; Size: TPoint; RowSizes: array of TRowSize; end; procedure TTBCustomDockableWindow.BeginMoving(const InitX, InitY: Integer); const SplitCursors: array[Boolean] of {$IFNDEF CLR} PChar {$ELSE} Integer {$ENDIF} = (IDC_SIZEWE, IDC_SIZENS); var UseSmoothDrag: Boolean; DockList: TList; NewDockedSizes: TList; OriginalDock, MouseOverDock: TTBDock; MoveRect: TRect; StartDocking, PreventDocking, PreventFloating, WatchForSplit, SplitVertical: Boolean; ScreenDC: HDC; OldCursor: HCURSOR; NPoint, DPoint: TPoint; OriginalDockRow, OriginalDockPos: Integer; FirstPos, LastPos, CurPos: TPoint; function FindDockedSize(const ADock: TTBDock): TDockedSize; var I: Integer; begin for I := 0 to NewDockedSizes.Count-1 do begin Result := TDockedSize(NewDockedSizes[I]); if Result.Dock = ADock then Exit; end; Result := nil; end; function GetRowOf(const RowSizes: array of TRowSize; const XY: Integer; var Before: Boolean): Integer; { Returns row number of the specified coordinate. Before is set to True if it was in the top (or left) quarter of the row. } var HighestRow, R, CurY, NextY, CurRowSize, EdgeSize: Integer; FullSizeRow: Boolean; begin Before := False; HighestRow := High(RowSizes); CurY := 0; for R := 0 to HighestRow do begin CurRowSize := RowSizes[R].Size; FullSizeRow := FullSize or RowSizes[R].FullSizeRow; if CurRowSize = 0 then Continue; NextY := CurY + CurRowSize; if not FullSizeRow then EdgeSize := CurRowSize div 4 else EdgeSize := CurRowSize div 2; if XY < CurY + EdgeSize then begin Result := R; Before := True; Exit; end; if not FullSizeRow and (XY < NextY - EdgeSize) then begin Result := R; Exit; end; CurY := NextY; end; Result := HighestRow+1; end; procedure Dropped; var NewDockRow: Integer; Before: Boolean; MoveRectClient: TRect; C: Integer; DockedSize: TDockedSize; begin if MouseOverDock <> nil then begin DockedSize := FindDockedSize(MouseOverDock); MoveRectClient := MoveRect; OffsetRect(MoveRectClient, -DockedSize.BoundsRect.Left, -DockedSize.BoundsRect.Top); if not FDragSplitting then begin if not(MouseOverDock.Position in PositionLeftOrRight) then C := (MoveRectClient.Top+MoveRectClient.Bottom) div 2 else C := (MoveRectClient.Left+MoveRectClient.Right) div 2; NewDockRow := GetRowOf(DockedSize.RowSizes, C, Before); if Before then WatchForSplit := False; end else begin NewDockRow := FDockRow; Before := False; end; if WatchForSplit then begin if (MouseOverDock <> OriginalDock) or (NewDockRow <> OriginalDockRow) then WatchForSplit := False else begin if not SplitVertical then C := FirstPos.X - LastPos.X else C := FirstPos.Y - LastPos.Y; if Abs(C) >= 10 then begin WatchForSplit := False; FDragSplitting := True; SetCursor(LoadCursor(0, SplitCursors[SplitVertical])); end; end; end; FDockRow := NewDockRow; if not(MouseOverDock.Position in PositionLeftOrRight) then FDockPos := MoveRectClient.Left else FDockPos := MoveRectClient.Top; Parent := MouseOverDock; if not FSmoothDragging then CurrentDock.CommitNewPositions := True; FInsertRowBefore := Before; try CurrentDock.ArrangeToolbars; finally FInsertRowBefore := False; end; end else begin WatchForSplit := False; FloatingPosition := MoveRect.TopLeft; Floating := True; { Make sure it doesn't go completely off the screen } MoveOnScreen(True); end; { Make sure it's repainted immediately (looks better on really slow computers when smooth dragging is enabled) } Update; end; procedure MouseMoved; var OldMouseOverDock: TTBDock; OldMoveRect: TRect; Pos: TPoint; function GetDockRect(Control: TTBDock): TRect; var I: Integer; begin for I := 0 to NewDockedSizes.Count-1 do with TDockedSize(NewDockedSizes[I]) do begin if Dock <> Control then Continue; Result := Bounds(Pos.X-MulDiv(Size.X-1, NPoint.X, DPoint.X), Pos.Y-MulDiv(Size.Y-1, NPoint.Y, DPoint.Y), Size.X, Size.Y); Exit; end; SetRectEmpty(Result); end; function CheckIfCanDockTo(Control: TTBDock; R: TRect): Boolean; const DockSensX = 25; DockSensY = 25; var S, Temp: TRect; Sens: Integer; begin with Control do begin Result := False; InflateRect(R, 3, 3); S := GetDockRect(Control); { Like Office, distribute ~25 pixels of extra dock detection area to the left side if the toolbar was grabbed at the left, both sides if the toolbar was grabbed at the middle, or the right side if toolbar was grabbed at the right. If outside, don't try to dock. } Sens := MulDiv(DockSensX, NPoint.X, DPoint.X); if (Pos.X < R.Left-(DockSensX-Sens)) or (Pos.X >= R.Right+Sens) then Exit; { Don't try to dock to the left or right if pointer is above or below the boundaries of the dock } if (Control.Position in PositionLeftOrRight) and ((Pos.Y < R.Top) or (Pos.Y >= R.Bottom)) then Exit; { And also distribute ~25 pixels of extra dock detection area to the top or bottom side } Sens := MulDiv(DockSensY, NPoint.Y, DPoint.Y); if (Pos.Y < R.Top-(DockSensY-Sens)) or (Pos.Y >= R.Bottom+Sens) then Exit; Result := IntersectRect(Temp, R, S); end; end; var R, R2: TRect; I: Integer; Dock: TTBDock; Accept: Boolean; TL, BR: TPoint; begin OldMouseOverDock := MouseOverDock; OldMoveRect := MoveRect; GetCursorPos(Pos); if FDragSplitting then MouseOverDock := CurrentDock else begin { Check if it can dock } MouseOverDock := nil; if StartDocking and not PreventDocking then for I := 0 to DockList.Count-1 do begin Dock := TTBDock(DockList[I]); if CheckIfCanDockTo(Dock, FindDockedSize(Dock).BoundsRect) then begin MouseOverDock := Dock; Accept := True; if Assigned(MouseOverDock.FOnRequestDock) then MouseOverDock.FOnRequestDock(MouseOverDock, Self, Accept); if Accept then Break else MouseOverDock := nil; end; end; end; { If not docking, clip the point so it doesn't get dragged under the taskbar } if MouseOverDock = nil then begin R := GetRectOfMonitorContainingPoint(Pos, True); if Pos.X < R.Left then Pos.X := R.Left; if Pos.X > R.Right then Pos.X := R.Right; if Pos.Y < R.Top then Pos.Y := R.Top; if Pos.Y > R.Bottom then Pos.Y := R.Bottom; end; MoveRect := GetDockRect(MouseOverDock); { Make sure title bar (or at least part of the toolbar) is still accessible if it's dragged almost completely off the screen. This prevents the problem seen in Office 97 where you drag it offscreen so that only the border is visible, sometimes leaving you no way to move it back short of resetting the toolbar. } if MouseOverDock = nil then begin R2 := GetRectOfMonitorContainingPoint(Pos, True); R := R2; with GetFloatingBorderSize do InflateRect(R, -(X+4), -(Y+4)); if MoveRect.Bottom < R.Top then OffsetRect(MoveRect, 0, R.Top-MoveRect.Bottom); if MoveRect.Top > R.Bottom then OffsetRect(MoveRect, 0, R.Bottom-MoveRect.Top); if MoveRect.Right < R.Left then OffsetRect(MoveRect, R.Left-MoveRect.Right, 0); if MoveRect.Left > R.Right then OffsetRect(MoveRect, R.Right-MoveRect.Left, 0); GetFloatingNCArea(TL, BR); I := R2.Top + 4 - TL.Y; if MoveRect.Top < I then OffsetRect(MoveRect, 0, I-MoveRect.Top); end; { Empty MoveRect if it's wanting to float but it's not allowed to, and set the mouse cursor accordingly. } if PreventFloating and not Assigned(MouseOverDock) then begin SetRectEmpty(MoveRect); SetCursor(LoadCursor(0, IDC_NO)); end else begin if FDragSplitting then SetCursor(LoadCursor(0, SplitCursors[SplitVertical])) else SetCursor(OldCursor); end; { Update the dragging outline } if not UseSmoothDrag then DrawDraggingOutline(ScreenDC, MoveRect, OldMoveRect, MouseOverDock <> nil, OldMouseOverDock <> nil) else if not IsRectEmpty(MoveRect) then Dropped; end; procedure BuildDockList; function AcceptableDock(const D: TTBDock): Boolean; begin Result := D.FAllowDrag and (D.Position in DockableTo); end; procedure Recurse(const ParentCtl: TWinControl); var D: TTBDockPosition; I: Integer; begin if ContainsControl(ParentCtl) or not ParentCtl.HandleAllocated or not IsWindowVisible(ParentCtl.Handle) then Exit; with ParentCtl do begin for D := Low(D) to High(D) do for I := 0 to ParentCtl.ControlCount-1 do if (Controls[I] is TTBDock) and (TTBDock(Controls[I]).Position = D) then Recurse(TWinControl(Controls[I])); for I := 0 to ParentCtl.ControlCount-1 do if (Controls[I] is TWinControl) and not(Controls[I] is TTBDock) then Recurse(TWinControl(Controls[I])); end; if (ParentCtl is TTBDock) and AcceptableDock(TTBDock(ParentCtl)) and (DockList.IndexOf(ParentCtl) = -1) then DockList.Add(ParentCtl); end; var ParentForm: TTBCustomForm; DockFormsList: TList; I, J: Integer; begin { Manually add CurrentDock to the DockList first so that it gets priority over other docks } if Assigned(CurrentDock) and AcceptableDock(CurrentDock) then DockList.Add(CurrentDock); ParentForm := TBGetToolWindowParentForm(Self); DockFormsList := TList.Create; try if Assigned(FDockForms) then begin for I := 0 to Screen.{$IFDEF JR_D3}CustomFormCount{$ELSE}FormCount{$ENDIF}-1 do begin J := FDockForms.IndexOf(Screen.{$IFDEF JR_D3}CustomForms{$ELSE}Forms{$ENDIF}[I]); if (J <> -1) and (FDockForms[J] <> ParentForm) then DockFormsList.Add(FDockForms[J]); end; end; if Assigned(ParentForm) then DockFormsList.Insert(0, ParentForm); for I := 0 to DockFormsList.Count-1 do Recurse(TWinControl(DockFormsList[I])); finally DockFormsList.Free; end; end; var Accept: Boolean; R: TRect; Msg: TMsg; NewDockedSize: TDockedSize; I, J: Integer; begin Accept := False; SplitVertical := False; WatchForSplit := False; OriginalDock := CurrentDock; OriginalDockRow := FDockRow; OriginalDockPos := FDockPos; try FDragMode := True; FDragSplitting := False; if Docked then begin FDragCanSplit := False; CurrentDock.CommitNewPositions := True; CurrentDock.ArrangeToolbars; { needed for WatchForSplit assignment below } SplitVertical := CurrentDock.Position in PositionLeftOrRight; WatchForSplit := FDragCanSplit; end; DockList := nil; NewDockedSizes := nil; try UseSmoothDrag := FSmoothDrag; FSmoothDragging := UseSmoothDrag; NPoint := Point(InitX, InitY); { Adjust for non-client area } if not(Parent is TTBFloatingWindowParent) then begin GetWindowRect(Handle, R); R.BottomRight := ClientToScreen(Point(0, 0)); DPoint := Point(Width-1, Height-1); end else begin GetWindowRect(Parent.Handle, R); R.BottomRight := Parent.ClientToScreen(Point(0, 0)); DPoint := Point(Parent.Width-1, Parent.Height-1); end; Dec(NPoint.X, R.Left-R.Right); Dec(NPoint.Y, R.Top-R.Bottom); PreventDocking := GetKeyState(VK_CONTROL) < 0; PreventFloating := DockMode <> dmCanFloat; { Build list of all TTBDock's on the form } DockList := TList.Create; if DockMode <> dmCannotFloatOrChangeDocks then BuildDockList else if Docked then DockList.Add(CurrentDock); { Ensure positions of each possible dock are committed } for I := 0 to DockList.Count-1 do TTBDock(DockList[I]).CommitPositions; { Set up potential sizes for each dock type } NewDockedSizes := TList.Create; for I := -1 to DockList.Count-1 do begin NewDockedSizes.Expand; NewDockedSize := TDockedSize.Create; try with NewDockedSize do begin if I = -1 then begin { -1 adds the floating size } Dock := nil; SetRectEmpty(BoundsRect); Size := DoArrange(False, TBGetDockTypeOf(CurrentDock, Floating), True, nil); AddFloatingNCAreaToSize(Size); end else begin Dock := TTBDock(DockList[I]); BoundsRect := Dock.ClientRect; MapWindowPoints(Dock.Handle, 0, BoundsRect, 2); if Dock <> CurrentDock then begin Size := DoArrange(False, TBGetDockTypeOf(CurrentDock, Floating), False, Dock); AddDockedNCAreaToSize(Size, Dock.Position in PositionLeftOrRight); end else Size := Point(Width, Height); end; end; if Assigned(NewDockedSize.Dock) then begin SetLength(NewDockedSize.RowSizes, NewDockedSize.Dock.GetHighestRow(True) + 1); for J := 0 to High(NewDockedSize.RowSizes) do begin NewDockedSize.RowSizes[J].Size := NewDockedSize.Dock.GetCurrentRowSize(J, NewDockedSize.RowSizes[J].FullSizeRow); end; end; except NewDockedSize.Free; raise; end; NewDockedSizes.Add(NewDockedSize); end; { Before locking, make sure all pending paint messages are processed } ProcessPaintMessages; { Save the original mouse cursor } OldCursor := GetCursor; SetRectEmpty(MoveRect); if not UseSmoothDrag then begin { This uses LockWindowUpdate to suppress all window updating so the dragging outlines doesn't sometimes get garbled. (This is safe, and in fact, is the main purpose of the LockWindowUpdate function) IMPORTANT! While debugging you might want to enable the 'TB2Dock_DisableLock' conditional define (see top of the source code). } {$IFNDEF TB2Dock_DisableLock} LockWindowUpdate(GetDesktopWindow); {$ENDIF} { Get a DC of the entire screen. Works around the window update lock by specifying DCX_LOCKWINDOWUPDATE. } ScreenDC := GetDCEx(GetDesktopWindow, 0, DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW); end else ScreenDC := 0; try SetCapture(Handle); { Initialize } StartDocking := Docked; MouseOverDock := nil; GetCursorPos(FirstPos); LastPos := FirstPos; MouseMoved; StartDocking := True; { Stay in message loop until capture is lost. Capture is removed either by this procedure manually doing it, or by an outside influence (like a message box or menu popping up) } while GetCapture = Handle do begin case Integer(GetMessage(Msg, 0, 0, 0)) of -1: Break; { if GetMessage failed } 0: begin { Repost WM_QUIT messages } PostQuitMessage(ClipToLongint(Msg.wParam)); Break; end; end; case Msg.Message of WM_KEYDOWN, WM_KEYUP: { Ignore all keystrokes while dragging. But process Ctrl and Escape } case Word(Msg.wParam) of VK_CONTROL: if PreventDocking <> (Msg.Message = WM_KEYDOWN) then begin PreventDocking := Msg.Message = WM_KEYDOWN; MouseMoved; end; VK_ESCAPE: Break; end; WM_MOUSEMOVE: begin { Note to self: WM_MOUSEMOVE messages should never be dispatched here to ensure no hints get shown during the drag process } CurPos := GetMessagePosAsPoint; if (LastPos.X <> CurPos.X) or (LastPos.Y <> CurPos.Y) then begin MouseMoved; LastPos := CurPos; end; end; WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: { Make sure it doesn't begin another loop } Break; WM_LBUTTONUP: begin Accept := True; Break; end; WM_RBUTTONDOWN..WM_MBUTTONDBLCLK: { Ignore all other mouse up/down messages } ; else TranslateMessage(Msg); DispatchMessage(Msg); end; end; finally { Since it sometimes breaks out of the loop without capture being released } if GetCapture = Handle then ReleaseCapture; if not UseSmoothDrag then begin { Hide dragging outline. Since NT will release a window update lock if another thread comes to the foreground, it has to release the DC and get a new one for erasing the dragging outline. Otherwise, the DrawDraggingOutline appears to have no effect when this happens. } ReleaseDC(GetDesktopWindow, ScreenDC); ScreenDC := GetDCEx(GetDesktopWindow, 0, DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW); SetRectEmpty(R); DrawDraggingOutline(ScreenDC, R, MoveRect, True, MouseOverDock <> nil); ReleaseDC(GetDesktopWindow, ScreenDC); { Release window update lock } {$IFNDEF TB2Dock_DisableLock} LockWindowUpdate(0); {$ENDIF} end; end; { Move to new position only if MoveRect isn't empty } FSmoothDragging := False; if Accept and not IsRectEmpty(MoveRect) then { Note: Dropped must be called again after FSmoothDragging is reset to False so that TTBDock.ArrangeToolbars makes the DockPos changes permanent } Dropped; { LastDock isn't automatically updated while FSmoothDragging=True, so update it now that it's back to False } if FUseLastDock and Assigned(CurrentDock) then LastDock := CurrentDock; { To conserve resources, free FFloatParent if it's no longer the Parent. (SetParent doesn't do this automatically when FSmoothDragging=True.) } if Assigned(FFloatParent) and (Parent <> FFloatParent) then FreeAndNil(FFloatParent); finally FSmoothDragging := False; if not Docked then begin { If we didn't end up docking, restore the original DockRow & DockPos values } FDockRow := OriginalDockRow; FDockPos := OriginalDockPos; end; if Assigned(NewDockedSizes) then begin for I := NewDockedSizes.Count-1 downto 0 do TDockedSize(NewDockedSizes[I]).Free; NewDockedSizes.Free; end; DockList.Free; end; finally FDragMode := False; FDragSplitting := False; end; end; function TTBCustomDockableWindow.ChildControlTransparent(Ctl: TControl): Boolean; begin Result := False; end; procedure TTBCustomDockableWindow.ControlExistsAtPos(const P: TPoint; var ControlExists: Boolean); var I: Integer; begin for I := 0 to ControlCount-1 do if not ChildControlTransparent(Controls[I]) and Controls[I].Visible and PtInRect(Controls[I].BoundsRect, P) then begin ControlExists := True; Break; end; end; procedure TTBCustomDockableWindow.DoubleClick; begin if Docked then begin if DockMode = dmCanFloat then begin Floating := True; MoveOnScreen(True); end; end else if Assigned(LastDock) then Parent := LastDock else if Assigned(DefaultDock) then begin FDockRow := ForceDockAtTopRow; FDockPos := ForceDockAtLeftPos; Parent := DefaultDock; end; end; function TTBCustomDockableWindow.IsMovable: Boolean; begin Result := (Docked and CurrentDock.FAllowDrag) or Floating; end; procedure TTBCustomDockableWindow.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var P: TPoint; CtlExists: Boolean; begin inherited; if (Button <> mbLeft) or not IsMovable then Exit; { Ignore message if user clicked on a child control } P := Point(X, Y); if PtInRect(ClientRect, P) then begin CtlExists := False; ControlExistsAtPos(P, CtlExists); if CtlExists then Exit; end; if not(ssDouble in Shift) then begin BeginMoving(X, Y); MouseUp(mbLeft, [], -1, -1); end else { Handle double click } DoubleClick; end; procedure TTBCustomDockableWindow.WMNCHitTest(var Message: TWMNCHitTest); var P: TPoint; R: TRect; begin inherited; if Docked then with Message do begin P := SmallPointToPoint(Pos); GetWindowRect(Handle, R); Dec(P.X, R.Left); Dec(P.Y, R.Top); if Result <> HTCLIENT then begin Result := HTNOWHERE; if FCloseButtonWhenDocked and CurrentDock.FAllowDrag and PtInRect(GetDockedCloseButtonRect( TBGetDockTypeOf(CurrentDock, Floating) = dtLeftRight), P) then Result := HT_TB2k_Close else Result := HT_TB2k_Border; end; end; end; procedure TTBCustomDockableWindow.WMNCMouseMove(var Message: TWMNCMouseMove); var InArea: Boolean; begin inherited; { Note: TME_NONCLIENT was introduced in Windows 98 and 2000 } if (Win32MajorVersion >= 5) or (Win32MajorVersion = 4) and (Win32MinorVersion >= 10) then CallTrackMouseEvent(Handle, TME_LEAVE or $10 {TME_NONCLIENT}); InArea := (ClipToLongint(Message.HitTest) = HT_TB2k_Close); if FCloseButtonHover <> InArea then begin FCloseButtonHover := InArea; RedrawNCArea; end; end; procedure TTBCustomDockableWindow.WMNCMouseLeave(var Message: TMessage); begin if not MouseCapture then CancelNCHover; inherited; end; procedure TTBCustomDockableWindow.CMMouseLeave(var Message: TMessage); begin inherited; { On Windows versions that can't send a WM_NCMOUSELEAVE message, trap CM_MOUSELEAVE to detect when the mouse moves from the non-client area to another control. } CancelNCHover; end; procedure TTBCustomDockableWindow.WMMouseMove(var Message: TWMMouseMove); begin { On Windows versions that can't send a WM_NCMOUSELEAVE message, trap WM_MOUSEMOVE to detect when the mouse moves from the non-client area to the client area. Note: We are overriding WM_MOUSEMOVE instead of MouseMove so that our processing always gets done first. } CancelNCHover; inherited; end; procedure TTBCustomDockableWindow.CancelNCHover; begin if FCloseButtonHover then begin FCloseButtonHover := False; RedrawNCArea; end; end; procedure TTBCustomDockableWindow.Close; var Accept: Boolean; begin Accept := True; if Assigned(FOnCloseQuery) then FOnCloseQuery(Self, Accept); { Did the CloseQuery event return True? } if Accept then begin Hide; if Assigned(FOnClose) then FOnClose(Self); end; end; procedure TTBCustomDockableWindow.SetCloseButtonState(Pushed: Boolean); begin if FCloseButtonDown <> Pushed then begin FCloseButtonDown := Pushed; RedrawNCArea; end; end; procedure TTBCustomDockableWindow.WMNCLButtonDown(var Message: TWMNCLButtonDown); var R, BR: TRect; P: TPoint; begin case ClipToLongint(Message.HitTest) of HT_TB2k_Close: begin GetWindowRect(Handle, R); BR := GetDockedCloseButtonRect( TBGetDockTypeOf(CurrentDock, Floating) = dtLeftRight); OffsetRect(BR, R.Left, R.Top); if CloseButtonLoop(Handle, BR, SetCloseButtonState) then Close; end; HT_TB2k_Border: begin P := ScreenToClient(GetMessagePosAsPoint); if IsMovable then BeginMoving(P.X, P.Y); end; else inherited; end; end; procedure TTBCustomDockableWindow.WMNCLButtonDblClk(var Message: TWMNCLButtonDblClk); begin if ClipToLongint(Message.HitTest) = HT_TB2k_Border then begin if IsMovable then DoubleClick; end else inherited; end; procedure TTBCustomDockableWindow.ShowNCContextMenu(const PosX, PosY: Smallint); {$IFNDEF JR_D5} { Note: this is identical to TControl.CheckMenuPopup (from Delphi 4), except where noted. TControl.CheckMenuPopup is unfortunately 'private', so it can't be called outside of the Controls unit. } procedure CheckMenuPopup; var Control: TControl; PopupMenu: TPopupMenu; begin if csDesigning in ComponentState then Exit; Control := Self; while Control <> nil do begin { Added TControlAccess cast because GetPopupMenu is 'protected' } PopupMenu := TControlAccess(Control).GetPopupMenu; if (PopupMenu <> nil) then begin if not PopupMenu.AutoPopup then Exit; SendCancelMode(nil); PopupMenu.PopupComponent := Control; { Changed the following. LPARAM of WM_NCRBUTTONUP is in screen coordinates, not client coordinates } {with ClientToScreen(SmallPointToPoint(Pos)) do PopupMenu.Popup(X, Y);} PopupMenu.Popup(PosX, PosY); Exit; end; Control := Control.Parent; end; end; {$ENDIF} begin {$IFDEF JR_D5} { Delphi 5 and later use the WM_CONTEXTMENU message for popup menus } SendMessage(Handle, WM_CONTEXTMENU, WPARAM(Handle), MAKELPARAM(Word(PosX), Word(PosY))); {$ELSE} CheckMenuPopup; {$ENDIF} end; procedure TTBCustomDockableWindow.WMNCRButtonUp(var Message: TWMNCRButtonUp); begin ShowNCContextMenu(Message.XCursor, Message.YCursor); end; {$IFDEF JR_D5} procedure TTBCustomDockableWindow.WMContextMenu(var Message: TWMContextMenu); { Unfortunately TControl.WMContextMenu ignores clicks in the non-client area. On docked toolbars, we need right clicks on the border, part of the non-client area, to display the popup menu. The only way I see to have it do that is to create a new version of WMContextMenu specifically for the non-client area, and that is what this method is. Note: This is identical to Delphi 2006's TControl.WMContextMenu, except where noted. } var Pt, Temp: TPoint; Handled: Boolean; PopupMenu: TPopupMenu; begin { Added 'inherited;' here } inherited; if Message.Result <> 0 then Exit; if csDesigning in ComponentState then begin inherited; Exit; end; Pt := SmallPointToPoint(Message.Pos); if InvalidPoint(Pt) then Temp := Pt else begin Temp := ScreenToClient(Pt); { Changed the following. We're only interested in the non-client area } {if not PtInRect(ClientRect, Temp) then} if PtInRect(ClientRect, Temp) then begin {inherited;} Exit; end; end; Handled := False; DoContextPopup(Temp, Handled); Message.Result := Ord(Handled); if Handled then Exit; PopupMenu := GetPopupMenu; if (PopupMenu <> nil) and PopupMenu.AutoPopup then begin SendCancelMode(Self); PopupMenu.PopupComponent := Self; if InvalidPoint(Pt) then Pt := ClientToScreen(Point(0, 0)); PopupMenu.Popup(Pt.X, Pt.Y); Message.Result := 1; end; if Message.Result = 0 then inherited; end; {$ENDIF} procedure TTBCustomDockableWindow.GetMinShrinkSize(var AMinimumSize: Integer); begin end; function TTBCustomDockableWindow.GetFloatingWindowParentClass: TTBFloatingWindowParentClass; begin Result := TTBFloatingWindowParent; end; procedure TTBCustomDockableWindow.GetMinMaxSize(var AMinClientWidth, AMinClientHeight, AMaxClientWidth, AMaxClientHeight: Integer); begin end; function TTBCustomDockableWindow.GetShrinkMode: TTBShrinkMode; begin Result := tbsmNone; end; procedure TTBCustomDockableWindow.ResizeBegin; begin end; procedure TTBCustomDockableWindow.ResizeTrack(var Rect: TRect; const OrigRect: TRect); begin end; procedure TTBCustomDockableWindow.ResizeTrackAccept; begin end; procedure TTBCustomDockableWindow.ResizeEnd; begin end; procedure TTBCustomDockableWindow.BeginSizing(const ASizeHandle: TTBSizeHandle); var UseSmoothDrag, DragX, DragY, ReverseX, ReverseY: Boolean; MinWidth, MinHeight, MaxWidth, MaxHeight: Integer; DragRect, OrigDragRect: TRect; ScreenDC: HDC; OrigPos, OldPos: TPoint; procedure DoResize; begin BeginUpdate; try ResizeTrackAccept; Parent.BoundsRect := DragRect; SetBounds(Left, Top, Parent.ClientWidth, Parent.ClientHeight); finally EndUpdate; end; { Make sure it doesn't go completely off the screen } MoveOnScreen(True); end; procedure MouseMoved; var Pos: TPoint; OldDragRect: TRect; begin GetCursorPos(Pos); { It needs to check if the cursor actually moved since last time. This is because a call to LockWindowUpdate (apparently) generates a mouse move message even when mouse hasn't moved. } if (Pos.X = OldPos.X) and (Pos.Y = OldPos.Y) then Exit; OldPos := Pos; OldDragRect := DragRect; DragRect := OrigDragRect; if DragX then begin if not ReverseX then Inc(DragRect.Right, Pos.X-OrigPos.X) else Inc(DragRect.Left, Pos.X-OrigPos.X); end; if DragY then begin if not ReverseY then Inc(DragRect.Bottom, Pos.Y-OrigPos.Y) else Inc(DragRect.Top, Pos.Y-OrigPos.Y); end; if DragRect.Right-DragRect.Left < MinWidth then begin if not ReverseX then DragRect.Right := DragRect.Left + MinWidth else DragRect.Left := DragRect.Right - MinWidth; end; if (MaxWidth > 0) and (DragRect.Right-DragRect.Left > MaxWidth) then begin if not ReverseX then DragRect.Right := DragRect.Left + MaxWidth else DragRect.Left := DragRect.Right - MaxWidth; end; if DragRect.Bottom-DragRect.Top < MinHeight then begin if not ReverseY then DragRect.Bottom := DragRect.Top + MinHeight else DragRect.Top := DragRect.Bottom - MinHeight; end; if (MaxHeight > 0) and (DragRect.Bottom-DragRect.Top > MaxHeight) then begin if not ReverseY then DragRect.Bottom := DragRect.Top + MaxHeight else DragRect.Top := DragRect.Bottom - MaxHeight; end; ResizeTrack(DragRect, OrigDragRect); if not UseSmoothDrag then DrawDraggingOutline(ScreenDC, DragRect, OldDragRect, False, False) else DoResize; end; var Accept: Boolean; Msg: TMsg; R: TRect; begin if not Floating then Exit; Accept := False; UseSmoothDrag := FSmoothDrag; MinWidth := 0; MinHeight := 0; MaxWidth := 0; MaxHeight := 0; GetMinMaxSize(MinWidth, MinHeight, MaxWidth, MaxHeight); Inc(MinWidth, Parent.Width-Width); Inc(MinHeight, Parent.Height-Height); if MaxWidth > 0 then Inc(MaxWidth, Parent.Width-Width); if MaxHeight > 0 then Inc(MaxHeight, Parent.Height-Height); DragX := ASizeHandle in [twshLeft, twshRight, twshTopLeft, twshTopRight, twshBottomLeft, twshBottomRight]; ReverseX := ASizeHandle in [twshLeft, twshTopLeft, twshBottomLeft]; DragY := ASizeHandle in [twshTop, twshTopLeft, twshTopRight, twshBottom, twshBottomLeft, twshBottomRight]; ReverseY := ASizeHandle in [twshTop, twshTopLeft, twshTopRight]; ResizeBegin(ASizeHandle); try { Before locking, make sure all pending paint messages are processed } ProcessPaintMessages; if not UseSmoothDrag then begin { This uses LockWindowUpdate to suppress all window updating so the dragging outlines doesn't sometimes get garbled. (This is safe, and in fact, is the main purpose of the LockWindowUpdate function) IMPORTANT! While debugging you might want to enable the 'TB2Dock_DisableLock' conditional define (see top of the source code). } {$IFNDEF TB2Dock_DisableLock} LockWindowUpdate(GetDesktopWindow); {$ENDIF} { Get a DC of the entire screen. Works around the window update lock by specifying DCX_LOCKWINDOWUPDATE. } ScreenDC := GetDCEx(GetDesktopWindow, 0, DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW); end else ScreenDC := 0; try SetCapture(Handle); if (tbdsResizeClipCursor in FDockableWindowStyles) and not UsingMultipleMonitors then begin R := GetRectOfPrimaryMonitor(False); ClipCursor({$IFNDEF CLR}@{$ENDIF} R); end; { Initialize } OrigDragRect := Parent.BoundsRect; DragRect := OrigDragRect; if not UseSmoothDrag then begin SetRectEmpty(R); DrawDraggingOutline(ScreenDC, DragRect, R, False, False); end; GetCursorPos(OrigPos); OldPos := OrigPos; { Stay in message loop until capture is lost. Capture is removed either by this procedure manually doing it, or by an outside influence (like a message box or menu popping up) } while GetCapture = Handle do begin case Integer(GetMessage(Msg, 0, 0, 0)) of -1: Break; { if GetMessage failed } 0: begin { Repost WM_QUIT messages } PostQuitMessage(ClipToLongint(Msg.wParam)); Break; end; end; case Msg.Message of WM_KEYDOWN, WM_KEYUP: { Ignore all keystrokes while sizing except for Escape } if Word(Msg.wParam) = VK_ESCAPE then Break; WM_MOUSEMOVE: { Note to self: WM_MOUSEMOVE messages should never be dispatched here to ensure no hints get shown during the drag process } MouseMoved; WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: { Make sure it doesn't begin another loop } Break; WM_LBUTTONUP: begin Accept := True; Break; end; WM_RBUTTONDOWN..WM_MBUTTONDBLCLK: { Ignore all other mouse up/down messages } ; else TranslateMessage(Msg); DispatchMessage(Msg); end; end; finally { Since it sometimes breaks out of the loop without capture being released } if GetCapture = Handle then ReleaseCapture; ClipCursor(nil); if not UseSmoothDrag then begin { Hide dragging outline. Since NT will release a window update lock if another thread comes to the foreground, it has to release the DC and get a new one for erasing the dragging outline. Otherwise, the DrawDraggingOutline appears to have no effect when this happens. } ReleaseDC(GetDesktopWindow, ScreenDC); ScreenDC := GetDCEx(GetDesktopWindow, 0, DCX_LOCKWINDOWUPDATE or DCX_CACHE or DCX_WINDOW); SetRectEmpty(R); DrawDraggingOutline(ScreenDC, R, DragRect, False, False); ReleaseDC(GetDesktopWindow, ScreenDC); { Release window update lock } {$IFNDEF TB2Dock_DisableLock} LockWindowUpdate(0); {$ENDIF} end; end; if not UseSmoothDrag and Accept then DoResize; finally ResizeEnd; end; end; procedure TTBCustomDockableWindow.DoDockChangingHidden(NewFloating: Boolean; DockingTo: TTBDock); begin if not(csDestroying in ComponentState) and Assigned(FOnDockChangingHidden) then FOnDockChangingHidden(Self, NewFloating, DockingTo); end; { TTBCustomDockableWindow - property access methods } function TTBCustomDockableWindow.GetNonClientWidth: Integer; begin Result := CalcNCSizes.X; end; function TTBCustomDockableWindow.GetNonClientHeight: Integer; begin Result := CalcNCSizes.Y; end; function TTBCustomDockableWindow.IsLastDockStored: Boolean; begin Result := FCurrentDock = nil; {}{should this be changed to 'Floating'?} end; function TTBCustomDockableWindow.IsWidthAndHeightStored: Boolean; begin Result := (CurrentDock = nil) and not Floating; end; procedure TTBCustomDockableWindow.SetCloseButton(Value: Boolean); begin if FCloseButton <> Value then begin FCloseButton := Value; { Update the close button's visibility } if Parent is TTBFloatingWindowParent then TTBFloatingWindowParent(Parent).RedrawNCArea([twrdCaption, twrdCloseButton]); end; end; procedure TTBCustomDockableWindow.SetCloseButtonWhenDocked(Value: Boolean); begin if FCloseButtonWhenDocked <> Value then begin FCloseButtonWhenDocked := Value; if Docked then RecalcNCArea(Self); end; end; procedure TTBCustomDockableWindow.SetDefaultDock(Value: TTBDock); begin if FDefaultDock <> Value then begin FDefaultDock := Value; if Assigned(Value) then Value.FreeNotification(Self); end; end; procedure TTBCustomDockableWindow.SetCurrentDock(Value: TTBDock); begin if not(csLoading in ComponentState) then begin if Assigned(Value) then Parent := Value else Parent := TBValidToolWindowParentForm(Self); end; end; procedure TTBCustomDockableWindow.SetDockPos(Value: Integer); begin FDockPos := Value; if Docked then CurrentDock.ArrangeToolbars; end; procedure TTBCustomDockableWindow.SetDockRow(Value: Integer); begin FDockRow := Value; if Docked then CurrentDock.ArrangeToolbars; end; procedure TTBCustomDockableWindow.SetAutoResize(Value: Boolean); begin if FAutoResize <> Value then begin FAutoResize := Value; if Value then Arrange; end; end; procedure TTBCustomDockableWindow.SetBorderStyle(Value: TBorderStyle); begin if FBorderStyle <> Value then begin FBorderStyle := Value; if Docked then RecalcNCArea(Self); end; end; procedure TTBCustomDockableWindow.SetDragHandleStyle(Value: TTBDragHandleStyle); begin if FDragHandleStyle <> Value then begin FDragHandleStyle := Value; if Docked then RecalcNCArea(Self); end; end; procedure TTBCustomDockableWindow.SetFloating(Value: Boolean); var ParentFrm: TTBCustomForm; NewFloatParent: TTBFloatingWindowParent; begin if FFloating <> Value then begin if Value and not(csDesigning in ComponentState) then begin ParentFrm := TBValidToolWindowParentForm(Self); if FFloatParent = nil then begin NewFloatParent := GetFloatingWindowParentClass.CreateNew(nil); try with NewFloatParent do begin FDockableWindow := Self; BorderStyle := bsToolWindow; ShowHint := True; Visible := True; { Note: The above line doesn't actually make it visible at this point since FShouldShow is still False. } end; except NewFloatParent.Free; raise; end; FFloatParent := NewFloatParent; end; ParentFrm.FreeNotification(FFloatParent); FFloatParent.FParentForm := ParentFrm; FFloatParent.Caption := Caption; Parent := FFloatParent; SetBounds(0, 0, Width, Height); end else Parent := TBValidToolWindowParentForm(Self); end; end; procedure TTBCustomDockableWindow.SetFloatingMode(Value: TTBFloatingMode); begin if FFloatingMode <> Value then begin FFloatingMode := Value; if HandleAllocated then Perform(CM_SHOWINGCHANGED, 0, 0); end; end; procedure TTBCustomDockableWindow.SetFloatingPosition(Value: TPoint); begin FFloatingPosition := Value; if Floating and Assigned(Parent) then Parent.SetBounds(Value.X, Value.Y, Parent.Width, Parent.Height); end; procedure TTBCustomDockableWindow.SetFullSize(Value: Boolean); begin if FFullSize <> Value then begin FFullSize := Value; if Docked then CurrentDock.ArrangeToolbars; end; end; procedure TTBCustomDockableWindow.SetLastDock(Value: TTBDock); begin if FUseLastDock and Assigned(FCurrentDock) then { When docked, LastDock must be equal to DockedTo } Value := FCurrentDock; if FLastDock <> Value then begin if Assigned(FLastDock) and (FLastDock <> Parent) then FLastDock.ChangeDockList(False, Self); FLastDock := Value; if Assigned(Value) then begin FUseLastDock := True; Value.FreeNotification(Self); Value.ChangeDockList(True, Self); end; end; end; procedure TTBCustomDockableWindow.SetResizable(Value: Boolean); begin if FResizable <> Value then begin FResizable := Value; if Floating and (Parent is TTBFloatingWindowParent) then begin { Recreate the window handle because Resizable affects whether the tool window is created with a WS_THICKFRAME style } TTBFloatingWindowParent(Parent).CallRecreateWnd; end; end; end; procedure TTBCustomDockableWindow.SetShowCaption(Value: Boolean); begin if FShowCaption <> Value then begin FShowCaption := Value; if Floating then begin { Recalculate FloatingWindowParent's NC area, and resize the toolbar accordingly } RecalcNCArea(Parent); Arrange; end; end; end; procedure TTBCustomDockableWindow.SetStretch(Value: Boolean); begin if FStretch <> Value then begin FStretch := Value; if Docked then CurrentDock.ArrangeToolbars; end; end; procedure TTBCustomDockableWindow.SetUseLastDock(Value: Boolean); begin if FUseLastDock <> Value then begin FUseLastDock := Value; if not Value then LastDock := nil else LastDock := FCurrentDock; end; end; (*function TTBCustomDockableWindow.GetVersion: TToolbar97Version; begin Result := Toolbar97VersionPropText; end; procedure TTBCustomDockableWindow.SetVersion(const Value: TToolbar97Version); begin { write method required for the property to show up in Object Inspector } end;*) { TTBBackground } {$IFNDEF CLR} type PNotifyEvent = ^TNotifyEvent; {$ENDIF} constructor TTBBackground.Create(AOwner: TComponent); begin inherited; FBkColor := clBtnFace; FBitmap := TBitmap.Create; FBitmap.OnChange := BitmapChanged; end; destructor TTBBackground.Destroy; {$IFNDEF CLR} var I: Integer; {$ENDIF} begin inherited; FBitmapCache.Free; FBitmap.Free; if Assigned(FNotifyList) then begin {$IFNDEF CLR} for I := FNotifyList.Count-1 downto 0 do Dispose(PNotifyEvent(FNotifyList[I])); {$ENDIF} FNotifyList.Free; end; end; procedure TTBBackground.BitmapChanged(Sender: TObject); var I: Integer; begin { Erase the cache and notify } FreeAndNil(FBitmapCache); if Assigned(FNotifyList) then for I := 0 to FNotifyList.Count-1 do {$IFNDEF CLR} PNotifyEvent(FNotifyList[I])^(Self); {$ELSE} TNotifyEvent(FNotifyList[I])(Self); {$ENDIF} end; procedure TTBBackground.Draw(DC: HDC; const DrawRect: TRect); var UseBmp: TBitmap; R2: TRect; SaveIndex: Integer; DC2: HDC; Brush: HBRUSH; P: TPoint; begin if FBitmapCache = nil then begin FBitmapCache := TBitmap.Create; FBitmapCache.Palette := CopyPalette(FBitmap.Palette); FBitmapCache.Width := FBitmap.Width; FBitmapCache.Height := FBitmap.Height; if not FTransparent then begin { Copy from a possible DIB to our DDB } BitBlt(FBitmapCache.Canvas.Handle, 0, 0, FBitmapCache.Width, FBitmapCache.Height, FBitmap.Canvas.Handle, 0, 0, SRCCOPY); end else begin with FBitmapCache do begin Canvas.Brush.Color := FBkColor; R2 := Rect(0, 0, Width, Height); Canvas.BrushCopy(R2, FBitmap, R2, FBitmap.Canvas.Pixels[0, Height-1] or $02000000); end; end; FBitmap.Dormant; end; UseBmp := FBitmapCache; DC2 := 0; SaveIndex := SaveDC(DC); try if UseBmp.Palette <> 0 then begin SelectPalette(DC, UseBmp.Palette, True); RealizePalette(DC); end; { Note: versions of Toolbar97 prior to 1.68 used 'UseBmp.Canvas.Handle' instead of DC2 in the BitBlt call. This was changed because there seems to be a bug in D2/BCB1's Graphics.pas: if you called .Background.LoadFromFile() twice the background would not be shown. } if (UseBmp.Width = 8) and (UseBmp.Height = 8) then begin { Use pattern brushes to draw 8x8 bitmaps. Note: Win9x can't use bitmaps <8x8 in size for pattern brushes } Brush := CreatePatternBrush(UseBmp.Handle); GetWindowOrgEx(DC, P); SetBrushOrgEx(DC, DrawRect.Left - P.X, DrawRect.Top - P.Y, nil); FillRect(DC, DrawRect, Brush); DeleteObject(Brush); end else begin { BitBlt is faster than pattern brushes on large bitmaps } DC2 := CreateCompatibleDC(DC); SelectObject(DC2, UseBmp.Handle); R2 := DrawRect; while R2.Left < R2.Right do begin while R2.Top < R2.Bottom do begin BitBlt(DC, R2.Left, R2.Top, UseBmp.Width, UseBmp.Height, DC2, 0, 0, SRCCOPY); Inc(R2.Top, UseBmp.Height); end; R2.Top := DrawRect.Top; Inc(R2.Left, UseBmp.Width); end; end; finally if DC2 <> 0 then DeleteDC(DC2); { Restore the palette and brush origin back } RestoreDC(DC, SaveIndex); end; end; function TTBBackground.GetPalette: HPALETTE; begin Result := FBitmap.Palette; end; procedure TTBBackground.SysColorChanged; begin if FTransparent and (FBkColor < 0) then BitmapChanged(nil); end; function TTBBackground.UsingBackground: Boolean; begin Result := (FBitmap.Width <> 0) and (FBitmap.Height <> 0); end; procedure TTBBackground.RegisterChanges(Proc: TNotifyEvent); var I: Integer; {$IFNDEF CLR} P: PNotifyEvent; {$ENDIF} begin if FNotifyList = nil then FNotifyList := TList.Create; for I := 0 to FNotifyList.Count-1 do begin {$IFNDEF CLR} P := FNotifyList[I]; if MethodsEqual(TMethod(P^), TMethod(Proc)) then {$ELSE} if @TNotifyEvent(FNotifyList[I]) = @Proc then {$ENDIF} Exit; end; {$IFNDEF CLR} FNotifyList.Expand; New(P); P^ := Proc; FNotifyList.Add(P); {$ELSE} FNotifyList.Add(@Proc); {$ENDIF} end; procedure TTBBackground.UnregisterChanges(Proc: TNotifyEvent); var I: Integer; {$IFNDEF CLR} P: PNotifyEvent; {$ENDIF} begin if FNotifyList = nil then Exit; for I := 0 to FNotifyList.Count-1 do begin {$IFNDEF CLR} P := FNotifyList[I]; if MethodsEqual(TMethod(P^), TMethod(Proc)) then begin {$ELSE} if @TNotifyEvent(FNotifyList[I]) = @Proc then begin {$ENDIF} FNotifyList.Delete(I); {$IFNDEF CLR} Dispose(P); {$ENDIF} Break; end; end; end; procedure TTBBackground.SetBkColor(Value: TColor); begin if FBkColor <> Value then begin FBkColor := Value; if FTransparent then BitmapChanged(nil); end; end; procedure TTBBackground.SetBitmap(Value: TBitmap); begin FBitmap.Assign(Value); end; procedure TTBBackground.SetTransparent(Value: Boolean); begin if FTransparent <> Value then begin FTransparent := Value; BitmapChanged(nil); end; end; { Global procedures } procedure TBCustomLoadPositions(const OwnerComponent: TComponent; const ReadIntProc: TTBPositionReadIntProc; const ReadStringProc: TTBPositionReadStringProc; const ExtraData: TTBPositionExtraData); var Rev: Integer; function FindDock(AName: String): TTBDock; var I: Integer; begin Result := nil; for I := 0 to OwnerComponent.ComponentCount-1 do if (OwnerComponent.Components[I] is TTBDock) and {$IFNDEF CLR} (CompareText(OwnerComponent.Components[I].Name, AName) = 0) then begin {$ELSE} SameText(OwnerComponent.Components[I].Name, AName, loInvariantLocale) then begin {$ENDIF} Result := TTBDock(OwnerComponent.Components[I]); Break; end; end; procedure ReadValues(const Toolbar: TTBCustomDockableWindow; const NewDock: TTBDock); var Pos: TPoint; Data: TTBReadPositionData; LastDockName: String; ADock: TTBDock; begin with Toolbar do begin DockRow := ReadIntProc(Name, rvDockRow, DockRow, ExtraData); DockPos := ReadIntProc(Name, rvDockPos, DockPos, ExtraData); Pos.X := ReadIntProc(Name, rvFloatLeft, 0, ExtraData); Pos.Y := ReadIntProc(Name, rvFloatTop, 0, ExtraData); Data.ReadIntProc := ReadIntProc; Data.ReadStringProc := ReadStringProc; Data.ExtraData := ExtraData; ReadPositionData(Data); FloatingPosition := Pos; if Assigned(NewDock) then Parent := NewDock else begin //Parent := Form; Floating := True; MoveOnScreen(True); if (Rev >= 3) and FUseLastDock then begin LastDockName := ReadStringProc(Name, rvLastDock, '', ExtraData); if LastDockName <> '' then begin ADock := FindDock(LastDockName); if Assigned(ADock) then LastDock := ADock; end; end; end; Arrange; DoneReadingPositionData(Data); end; end; var DocksDisabled: TList; I: Integer; ToolWindow: TComponent; ADock: TTBDock; DockedToName: String; begin DocksDisabled := TList.Create; try with OwnerComponent do for I := 0 to ComponentCount-1 do if Components[I] is TTBDock then begin TTBDock(Components[I]).BeginUpdate; DocksDisabled.Add(Components[I]); end; for I := 0 to OwnerComponent.ComponentCount-1 do begin ToolWindow := OwnerComponent.Components[I]; if ToolWindow is TTBCustomDockableWindow then with TTBCustomDockableWindow(ToolWindow) do begin {}{should skip over toolbars that are neither Docked nor Floating } if Name = '' then Continue; Rev := ReadIntProc(Name, rvRev, 0, ExtraData); if Rev = 2000 then begin Visible := ReadIntProc(Name, rvVisible, Ord(Visible), ExtraData) <> 0; DockedToName := ReadStringProc(Name, rvDockedTo, '', ExtraData); if DockedToName <> '' then begin if DockedToName <> rdDockedToFloating then begin ADock := FindDock(DockedToName); if (ADock <> nil) and (ADock.FAllowDrag) then ReadValues(TTBCustomDockableWindow(ToolWindow), ADock); end else ReadValues(TTBCustomDockableWindow(ToolWindow), nil); end; end; end; end; finally for I := DocksDisabled.Count-1 downto 0 do TTBDock(DocksDisabled[I]).EndUpdate; DocksDisabled.Free; end; end; procedure TBCustomSavePositions(const OwnerComponent: TComponent; const WriteIntProc: TTBPositionWriteIntProc; const WriteStringProc: TTBPositionWriteStringProc; const ExtraData: TTBPositionExtraData); var I: Integer; N, L: String; Data: TTBWritePositionData; begin for I := 0 to OwnerComponent.ComponentCount-1 do if OwnerComponent.Components[I] is TTBCustomDockableWindow then with TTBCustomDockableWindow(OwnerComponent.Components[I]) do begin if Name = '' then Continue; if Floating then N := rdDockedToFloating else if Docked then begin if CurrentDock.FAllowDrag then begin N := CurrentDock.Name; if N = '' then raise Exception.Create(STBToolwinDockedToNameNotSet); end else N := ''; end else Continue; { skip if it's neither floating nor docked } L := ''; if Assigned(FLastDock) then L := FLastDock.Name; WriteIntProc(Name, rvRev, rdCurrentRev, ExtraData); WriteIntProc(Name, rvVisible, Ord(Visible), ExtraData); WriteStringProc(Name, rvDockedTo, N, ExtraData); WriteStringProc(Name, rvLastDock, L, ExtraData); WriteIntProc(Name, rvDockRow, FDockRow, ExtraData); WriteIntProc(Name, rvDockPos, FDockPos, ExtraData); WriteIntProc(Name, rvFloatLeft, FFloatingPosition.X, ExtraData); WriteIntProc(Name, rvFloatTop, FFloatingPosition.Y, ExtraData); Data.WriteIntProc := WriteIntProc; Data.WriteStringProc := WriteStringProc; Data.ExtraData := ExtraData; WritePositionData(Data); end; end; type TIniReadWriteData = class private IniFile: TCustomIniFile; SectionNamePrefix: String; end; function IniReadInt(const ToolbarName, Value: String; const Default: Longint; const ExtraData: TTBPositionExtraData): Longint; begin Result := TIniReadWriteData(ExtraData).IniFile.ReadInteger( TIniReadWriteData(ExtraData).SectionNamePrefix + ToolbarName, Value, Default); end; function IniReadString(const ToolbarName, Value, Default: String; const ExtraData: TTBPositionExtraData): String; begin Result := TIniReadWriteData(ExtraData).IniFile.ReadString( TIniReadWriteData(ExtraData).SectionNamePrefix + ToolbarName, Value, Default); end; procedure IniWriteInt(const ToolbarName, Value: String; const Data: Longint; const ExtraData: TTBPositionExtraData); begin TIniReadWriteData(ExtraData).IniFile.WriteInteger( TIniReadWriteData(ExtraData).SectionNamePrefix + ToolbarName, Value, Data); end; procedure IniWriteString(const ToolbarName, Value, Data: String; const ExtraData: TTBPositionExtraData); begin TIniReadWriteData(ExtraData).IniFile.WriteString( TIniReadWriteData(ExtraData).SectionNamePrefix + ToolbarName, Value, Data); end; procedure TBIniLoadPositions(const OwnerComponent: TComponent; const IniFile: TCustomIniFile; const SectionNamePrefix: String); var Data: TIniReadWriteData; begin Data := TIniReadWriteData.Create; try Data.IniFile := IniFile; Data.SectionNamePrefix := SectionNamePrefix; TBCustomLoadPositions(OwnerComponent, IniReadInt, IniReadString, Data); finally Data.Free; end; end; procedure TBIniLoadPositions(const OwnerComponent: TComponent; const Filename, SectionNamePrefix: String); var IniFile: TIniFile; begin IniFile := TIniFile.Create(Filename); try TBIniLoadPositions(OwnerComponent, IniFile, SectionNamePrefix); finally IniFile.Free; end; end; procedure TBIniSavePositions(const OwnerComponent: TComponent; const IniFile: TCustomIniFile; const SectionNamePrefix: String); var Data: TIniReadWriteData; begin Data := TIniReadWriteData.Create; try Data.IniFile := IniFile; Data.SectionNamePrefix := SectionNamePrefix; TBCustomSavePositions(OwnerComponent, IniWriteInt, IniWriteString, Data); finally Data.Free; end; end; procedure TBIniSavePositions(const OwnerComponent: TComponent; const Filename, SectionNamePrefix: String); var IniFile: TIniFile; begin IniFile := TIniFile.Create(Filename); try TBIniSavePositions(OwnerComponent, IniFile, SectionNamePrefix); finally IniFile.Free; end; end; function RegReadInt(const ToolbarName, Value: String; const Default: Longint; const ExtraData: TTBPositionExtraData): Longint; begin Result := TRegIniFile(ExtraData).ReadInteger(ToolbarName, Value, Default); end; function RegReadString(const ToolbarName, Value, Default: String; const ExtraData: TTBPositionExtraData): String; begin Result := TRegIniFile(ExtraData).ReadString(ToolbarName, Value, Default); end; procedure RegWriteInt(const ToolbarName, Value: String; const Data: Longint; const ExtraData: TTBPositionExtraData); begin TRegIniFile(ExtraData).WriteInteger(ToolbarName, Value, Data); end; procedure RegWriteString(const ToolbarName, Value, Data: String; const ExtraData: TTBPositionExtraData); begin TRegIniFile(ExtraData).WriteString(ToolbarName, Value, Data); end; procedure TBRegLoadPositions(const OwnerComponent: TComponent; const RootKey: DWORD; const BaseRegistryKey: String); var Reg: TRegIniFile; begin Reg := TRegIniFile.Create(''); try {$IFDEF JR_D5} Reg.Access := KEY_QUERY_VALUE; {$ENDIF} Reg.RootKey := RootKey; if Reg.OpenKey(BaseRegistryKey, False) then TBCustomLoadPositions(OwnerComponent, RegReadInt, RegReadString, Reg); finally Reg.Free; end; end; procedure TBRegSavePositions(const OwnerComponent: TComponent; const RootKey: DWORD; const BaseRegistryKey: String); var Reg: TRegIniFile; begin Reg := TRegIniFile.Create(''); try Reg.RootKey := RootKey; Reg.CreateKey(BaseRegistryKey); if Reg.OpenKey(BaseRegistryKey, True) then TBCustomSavePositions(OwnerComponent, RegWriteInt, RegWriteString, Reg); finally Reg.Free; end; end; end.