Componentes.Terceros.jvcl/official/3.32/run/JvDockVIDStyle.pas

4741 lines
151 KiB
ObjectPascal

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvDockVIDStyle.pas, released on 2003-12-31.
The Initial Developer of the Original Code is luxiaoban.
Portions created by luxiaoban are Copyright (C) 2002,2003 luxiaoban.
All Rights Reserved.
Contributor(s):
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net
Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvDockVIDStyle.pas 11274 2007-04-24 19:09:06Z remkobonte $
unit JvDockVIDStyle;
{$I jvcl.inc}
interface
uses
{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}
Windows, Messages, Classes, Graphics, Controls, ComCtrls, ImgList,
JvDockControlForm, JvDockSupportControl, JvDockTree, JvDockAdvTree,
JvDockGlobals;
type
TJvDockVIDConjoinServerOption = class(TJvDockBasicConjoinServerOption)
private
FTextEllipsis: Boolean;
FTextAlignment: TAlignment;
FInactiveTitleEndColor: TColor;
FInactiveTitleStartColor: TColor;
FInactiveTitleVerticalGradient: Boolean;
FActiveTitleEndColor: TColor;
FActiveTitleStartColor: TColor;
FActiveTitleVerticalGradient: Boolean;
FActiveDockGrabber: Boolean;
FSystemInfo: Boolean;
FActiveFont: TFont;
FInactiveFont: TFont;
procedure SetActiveTitleEndColor(const Value: TColor);
procedure SetActiveTitleStartColor(const Value: TColor);
procedure SetInactiveTitleEndColor(const Value: TColor);
procedure SetInactiveTitleStartColor(const Value: TColor);
procedure SetTextAlignment(const Value: TAlignment);
procedure SetTextEllipsis(const Value: Boolean);
procedure SetSystemInfo(const Value: Boolean);
procedure SetActiveFont(Value: TFont);
procedure SetInactiveFont(Value: TFont);
procedure SetActiveTitleVerticalGradient(const Value: Boolean);
procedure SetInactiveTitleVerticalGradient(const Value: Boolean);
procedure SetActiveDockGrabber(const Value: Boolean);
protected
procedure FontChanged(Sender: TObject);
function IsNotSystemInfo: Boolean;
procedure SettingChange(Sender: TObject);
procedure Changed; override;
procedure UpdateDefaultSystemCaptionInfo; virtual;
procedure SetDefaultSystemCaptionInfo;
public
constructor Create(ADockStyle: TJvDockObservableStyle); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property ActiveFont: TFont read FActiveFont write SetActiveFont stored IsNotSystemInfo;
property InactiveFont: TFont read FInactiveFont write SetInactiveFont stored IsNotSystemInfo;
property TextAlignment: TAlignment read FTextAlignment write SetTextAlignment default taLeftJustify;
property ActiveTitleStartColor: TColor read FActiveTitleStartColor write SetActiveTitleStartColor stored
IsNotSystemInfo;
property ActiveTitleEndColor: TColor read FActiveTitleEndColor write SetActiveTitleEndColor stored
IsNotSystemInfo;
property ActiveTitleVerticalGradient: Boolean read FActiveTitleVerticalGradient write
SetActiveTitleVerticalGradient default False;
property ActiveDockGrabber: Boolean read FActiveDockGrabber write SetActiveDockGrabber default False;
property InactiveTitleStartColor: TColor read FInactiveTitleStartColor write SetInactiveTitleStartColor stored
IsNotSystemInfo;
property InactiveTitleEndColor: TColor read FInactiveTitleEndColor write SetInactiveTitleEndColor stored
IsNotSystemInfo;
property InactiveTitleVerticalGradient: Boolean read FInactiveTitleVerticalGradient write
SetInactiveTitleVerticalGradient default False;
property TextEllipsis: Boolean read FTextEllipsis write SetTextEllipsis default True;
property SystemInfo: Boolean read FSystemInfo write SetSystemInfo default True;
property GrabbersSize default VIDDefaultDockGrabbersSize;
property SplitterWidth default VIDDefaultDockSplitterWidth;
end;
TJvDockVIDTabServerOption = class(TJvDockBasicTabServerOption)
private
FActiveFont: TFont;
FActiveSheetColor: TColor;
FHotTrackColor: TColor;
FInactiveFont: TFont;
FInactiveSheetColor: TColor;
FShowTabImages: Boolean;
{ NEW! if true, shows invididual close buttons on tabs. If false, you get the old VID behaviour. }
FShowCloseButtonOnTabs: Boolean;
{NEW! default is true, which is the old VID Style behaviour. False is a new behaviour added by Warren. }
FShowCloseButtonOnGrabber: Boolean;
procedure SetActiveFont(Value: TFont);
procedure SetActiveSheetColor(const Value: TColor);
procedure SetHotTrackColor(const Value: TColor);
procedure SetInactiveFont(Value: TFont);
procedure SetInactiveSheetColor(const Value: TColor);
procedure SetShowTabImages(const Value: Boolean);
procedure SetShowCloseButtonOnGrabber(const Value: Boolean);
procedure SetShowCloseButtonOnTabs(const Value: Boolean);
protected
procedure FontChanged(Sender: TObject);
public
constructor Create(ADockStyle: TJvDockObservableStyle); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure SetTabPosition(const Value: TTabPosition); override;
published
property ActiveSheetColor: TColor read FActiveSheetColor write SetActiveSheetColor default clBtnFace;
property InactiveSheetColor: TColor read FInactiveSheetColor write SetInactiveSheetColor default clBtnShadow;
property ActiveFont: TFont read FActiveFont write SetActiveFont;
property InactiveFont: TFont read FInactiveFont write SetInactiveFont;
property HotTrackColor: TColor read FHotTrackColor write SetHotTrackColor default clBlue;
property ShowTabImages: Boolean read FShowTabImages write SetShowTabImages default False;
property TabPosition default tpBottom;
{ NEW! If true, shows invididual close buttons on tabs.
If false, you get the old VID behaviour. }
property ShowCloseButtonOnTabs: Boolean read FShowCloseButtonOnTabs write SetShowCloseButtonOnTabs;
{NEW! Default is true, which is the old VID Style behaviour.
False is a new behaviour added by Warren. }
property ShowCloseButtonOnGrabber: Boolean read FShowCloseButtonOnGrabber write
SetShowCloseButtonOnGrabber default True;
end;
TJvDockSystemInfoChange = procedure(Value: Boolean) of object;
TJvDockVIDStyle = class(TJvDockAdvStyle)
private
FAlwaysShowGrabber: Boolean;
FSystemInfoChange: TJvDockSystemInfoChange;
procedure SetAlwaysShowGrabber(const Value: Boolean);
protected
function DockClientWindowProc(DockClient: TJvDockClient; var Msg: TMessage): Boolean; override;
procedure FormDockDrop(DockClient: TJvDockClient;
Source: TJvDockDragDockObject; X, Y: Integer); override;
procedure FormGetSiteInfo(Source: TJvDockDragDockObject; DockClient: TJvDockClient;
Client: TControl; var InfluenceRect: TRect; MousePos: TPoint;
var CanDock: Boolean); override;
procedure FormDockOver(DockClient: TJvDockClient; Source: TJvDockDragDockObject; X, Y: Integer;
State: TDragState; var Accept: Boolean); override;
procedure FormStartDock(DockClient: TJvDockClient;
var Source: TJvDockDragDockObject); override;
procedure FormGetDockEdge(DockClient: TJvDockClient; Source: TJvDockDragDockObject;
MousePos: TPoint; var DropAlign: TAlign); override;
procedure DoSystemInfoChange(Value: Boolean);
public
constructor Create(AOwner: TComponent); override;
{$IFNDEF USEJVCL}
function GetControlName: string; override;
{$ENDIF !USEJVCL}
procedure SetDockBaseControl(IsCreate: Boolean; DockBaseControl: TJvDockBaseControl); override;
published
property AlwaysShowGrabber: Boolean read FAlwaysShowGrabber write SetAlwaysShowGrabber; {NEW}
property SystemInfoChange: TJvDockSystemInfoChange read FSystemInfoChange write FSystemInfoChange;
property ConjoinServerOption;
property TabServerOption;
end;
TJvDockVIDSplitter = class(TJvDockSplitter);
TJvDockVIDPanel = class(TJvDockAdvPanel)
protected
procedure CustomGetSiteInfo(Source: TJvDockDragDockObject;
Client: TControl; var InfluenceRect: TRect; MousePos: TPoint;
var CanDock: Boolean); override;
procedure CustomStartDock(var Source: TJvDockDragDockObject); override;
procedure CustomDockDrop(Source: TJvDockDragDockObject; X, Y: Integer); override;
procedure CustomDockOver(Source: TJvDockDragDockObject; X, Y: Integer;
State: TDragState; var Accept: Boolean); override;
procedure CustomGetDockEdge(Source: TJvDockDragDockObject; MousePos: TPoint;
var DropAlign: TAlign); override;
public
procedure DockDrop(Source: TDragDockObject; X, Y: Integer); override;
procedure UpdateCaption(Exclude: TControl); override;
end;
TJvDockVIDConjoinPanel = class(TJvDockAdvConjoinPanel)
protected
procedure CustomGetSiteInfo(Source: TJvDockDragDockObject;
Client: TControl; var InfluenceRect: TRect; MousePos: TPoint;
var CanDock: Boolean); override;
procedure CustomDockOver(Source: TJvDockDragDockObject; X, Y: Integer;
State: TDragState; var Accept: Boolean); override;
procedure CustomGetDockEdge(Source: TJvDockDragDockObject; MousePos: TPoint; var DropAlign: TAlign); override;
function CustomUnDock(Source: TJvDockDragDockObject; NewTarget: TWinControl; Client: TControl): Boolean; override;
procedure CustomDockDrop(Source: TJvDockDragDockObject; X, Y: Integer); override;
public
procedure UpdateCaption(Exclude: TControl); override;
procedure DockDrop(Source: TDragDockObject; X, Y: Integer); override;
end;
TJvDockVIDZone = class(TJvDockAdvZone)
protected
function GetSplitterLimit(IsMin: Boolean): Integer; override;
public
destructor Destroy; override;
procedure Insert(DockSize: Integer; Hide: Boolean); override;
procedure Remove(DockSize: Integer; Hide: Boolean); override;
end;
TJvDockVIDTree = class(TJvDockAdvTree)
private
FDropOnZone: TJvDockZone;
FLockDropDockSizeCount: Integer;
FCaptionLeftOffset: Integer;
FCaptionRightOffset: Integer;
FShowCloseButtonOnGrabber: Boolean;
FAlwaysShowGrabber: Boolean;
procedure LockDropDockSize;
procedure UnlockDropDockSize;
procedure SetCaptionLeftOffset(const Value: Integer);
procedure SetCaptionRightOffset(const Value: Integer);
procedure SetShowCloseButtonOnGrabber(const Value: Boolean);
procedure SetAlwaysShowGrabber(const Value: Boolean);
procedure InvalidateDockSite(const Client: TControl);
protected
procedure InsertControlFromConjoinHost(Control: TControl;
InsertAt: TAlign; DropCtl: TControl); virtual;
procedure IgnoreZoneInfor(Stream: TMemoryStream); virtual;
{ [ERROR] Method 'AdjustDockRect' not found in base class.
if you get this error here, it is a Delphi compiler issue. }
procedure AdjustDockRect(Control: TControl; var ARect: TRect); override;
procedure WindowProc(var Msg: TMessage); override;
procedure SplitterMouseUp; override;
function GetTopGrabbersHTFlag(const MousePos: TPoint;
out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone; override;
function GetDockGrabbersPosition: TJvDockGrabbersPosition; override;
procedure GetSiteInfo(Client: TControl;
var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean); override;
procedure InsertControl(Control: TControl; InsertAt: TAlign;
DropCtl: TControl); override;
procedure InsertSibling(NewZone, SiblingZone: TJvDockZone;
InsertLast, Update: Boolean); override;
procedure InsertNewParent(NewZone, SiblingZone: TJvDockZone;
ParentOrientation: TDockOrientation; InsertLast, Update: Boolean); override;
procedure DrawDockGrabber(Control: TWinControl; const ARect: TRect); override;
procedure DrawSplitterRect(const ARect: TRect); override;
procedure PaintDockGrabberRect(Canvas: TCanvas; Control: TWinControl;
const ARect: TRect; PaintAlways: Boolean = False); virtual;
procedure DrawCloseButton(Canvas: TCanvas; Zone: TJvDockZone;
Left, Top: Integer); virtual;
procedure ResetBounds(Force: Boolean); override;
procedure DrawDockSiteRect; override;
procedure PositionDockRect(Client, DropCtl: TControl; DropAlign: TAlign;
var DockRect: TRect); override;
function GetDockEdge(DockRect: TRect; MousePos: TPoint;
var DropAlign: TAlign; Control: TControl): TControl; override;
procedure RemoveZone(Zone: TJvDockZone; Hide: Boolean = True); override;
procedure GetCaptionRect(var Rect: TRect); override;
procedure SyncWithStyle; override;
property CaptionLeftOffset: Integer read FCaptionLeftOffset write SetCaptionLeftOffset;
property CaptionRightOffset: Integer read FCaptionRightOffset write SetCaptionRightOffset;
public
constructor Create(DockSite: TWinControl; DockZoneClass: TJvDockZoneClass;
ADockStyle: TJvDockObservableStyle); override;
property ShowCloseButtonOnGrabber: Boolean read FShowCloseButtonOnGrabber write SetShowCloseButtonOnGrabber;
property AlwaysShowGrabber: Boolean read FAlwaysShowGrabber write SetAlwaysShowGrabber;
end;
TJvDockVIDTabPageControl = class;
TJvDockVIDTabSheet = class(TJvDockTabSheet)
private
FTabWidth: Integer;
FShowTabWidth: Integer;
FIsSourceDockClient: Boolean;
procedure SetTabWidth(const Value: Integer);
procedure WMSetText(var Msg: TMessage); message WM_SETTEXT;
procedure SetSheetSort(const CaptionStr: string);
protected
procedure SetPageControl(APageControl: TJvDockPageControl); override;
property TabWidth: Integer read FTabWidth write SetTabWidth;
property ShowTabWidth: Integer read FShowTabWidth;
procedure Loaded; override;
procedure UpdateTabShowing; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property BorderWidth;
property Caption;
property DragMode;
property Enabled;
property Font;
property Height stored False;
property Highlighted;
property ImageIndex;
property Left stored False;
property Constraints;
property PageIndex;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabVisible;
property Top stored False;
property Visible stored False;
property Width stored False;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnHide;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnShow;
property OnStartDrag;
end;
TJvDockTabPanel = class(TCustomControl)
private
FDockPanel: TJvDockPanel; // If docked to a dock panel, this is it. nil is floating.
FPage: TJvDockVIDTabPageControl;
FActiveSheetColor: TColor;
FHotTrackColor: TColor;
FActiveFont: TFont;
FInactiveFont: TFont;
FTabLeftOffset: Integer;
FTabRightOffset: Integer;
FTabTopOffset: Integer;
FTabBottomOffset: Integer;
FCaptionLeftOffset: Integer;
FCaptionRightOffset: Integer;
FCaptionTopOffset: Integer;
FTabSplitterWidth: Integer;
FTabHeight: Integer;
FSortList: TList;
FSelectSheet: TJvDockVIDTabSheet;
FTempPages: TList;
FSelectHotIndex: Integer;
FShowTabImages: Boolean;
procedure SetPage(const Value: TJvDockVIDTabPageControl);
function GetTotalTabWidth: Integer;
procedure SetTotalTabWidth(const Value: Integer);
function GetMinTabWidth: TJvDockTabSheet;
function GetMaxTabWidth: TJvDockTabSheet;
procedure SetTabBottomOffset(const Value: Integer);
procedure SetTabLeftOffset(const Value: Integer);
procedure SetTabRightOffset(const Value: Integer);
procedure SetTabTopOffset(const Value: Integer);
procedure SetCaptionLeftOffset(const Value: Integer);
procedure SetCaptionRightOffset(const Value: Integer);
procedure SetCaptionTopOffset(const Value: Integer);
procedure SetTabSplitterWidth(const Value: Integer);
function GetSorts(Index: Integer): TJvDockVIDTabSheet;
function GetPanelHeight: Integer;
function GetPanelWidth: Integer;
procedure SetPanelHeight(const Value: Integer);
function FindSheetWithPos(cX, cY, cTopOffset, cBottomOffset: Integer): Integer;
function GetDockClientFromPageIndex(Index: Integer): TControl;
procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
procedure SetShowTabImages(const Value: Boolean);
procedure SetTabHeight(const Value: Integer);
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
function GetPageIndexFromMousePos(X, Y: Integer): Integer; virtual;
procedure SetShowTabWidth;
property TotalTabWidth: Integer read GetTotalTabWidth write SetTotalTabWidth;
property MinTabWidth: TJvDockTabSheet read GetMinTabWidth;
property MaxTabWidth: TJvDockTabSheet read GetMaxTabWidth;
property TabLeftOffset: Integer read FTabLeftOffset write SetTabLeftOffset default 5;
property TabRightOffset: Integer read FTabRightOffset write SetTabRightOffset default 5;
property TabTopOffset: Integer read FTabTopOffset write SetTabTopOffset default 2;
property TabBottomOffset: Integer read FTabBottomOffset write SetTabBottomOffset default 3;
property TabSplitterWidth: Integer read FTabSplitterWidth write SetTabSplitterWidth default 2;
property CaptionTopOffset: Integer read FCaptionTopOffset write SetCaptionTopOffset default 0;
property CaptionLeftOffset: Integer read FCaptionLeftOffset write SetCaptionLeftOffset default 5;
property CaptionRightOffset: Integer read FCaptionRightOffset write SetCaptionRightOffset default 5;
property Sorts[Index: Integer]: TJvDockVIDTabSheet read GetSorts;
property PanelHeight: Integer read GetPanelHeight write SetPanelHeight;
property PanelWidth: Integer read GetPanelWidth;
property TabHeight: Integer read FTabHeight write SetTabHeight;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Resize; override;
procedure DeleteSorts(Sheet: TJvDockVIDTabSheet);
property Page: TJvDockVIDTabPageControl read FPage write SetPage;
property SelectSheet: TJvDockVIDTabSheet read FSelectSheet write FSelectSheet;
property ShowTabImages: Boolean read FShowTabImages write SetShowTabImages;
{NEW! If docked to a TJvDockPanel, this is it. if not (nil) then it is floating.}
property DockPanel: TJvDockPanel read FDockPanel write FDockPanel;
end;
TJvDockTabPanelClass = class of TJvDockTabPanel;
TJvDockVIDTabPageControl = class(TJvDockAdvTabPageControl)
private
FTabPanelClass: TJvDockTabPanelClass;
FPanel: TJvDockTabPanel;
FTempSheet: TJvDockVIDTabSheet;
FTabImageList: TCustomImageList;
procedure SetActiveSheetColor(const Value: TColor);
procedure SetInactiveSheetColor(const Value: TColor);
procedure SetTabBottomOffset(const Value: Integer);
procedure SetTabLeftOffset(const Value: Integer);
procedure SetTabRightOffset(const Value: Integer);
procedure SetTabTopOffset(const Value: Integer);
procedure SetActiveFont(Value: TFont);
procedure SetInactiveFont(Value: TFont);
procedure SetHotTrackColor(const Value: TColor);
function GetTabBottomOffset: Integer;
function GetTabLeftOffset: Integer;
function GetTabRightOffset: Integer;
function GetTabTopOffset: Integer;
function GetInactiveSheetColor: TColor;
function GetActiveSheetColor: TColor;
function GetActiveFont: TFont;
function GetInactiveFont: TFont;
function GetVisibleSheetCount: Integer;
function GetHotTrackColor: TColor;
function GetShowTabImages: Boolean;
procedure SetShowTabImages(const Value: Boolean);
function GetPage(Index: Integer): TJvDockVIDTabSheet;
function GetActiveVIDPage: TJvDockVIDTabSheet;
procedure SetActiveVIDPage(const Value: TJvDockVIDTabSheet);
procedure CMDockNotification(var Msg: TCMDockNotification); message CM_DOCKNOTIFICATION;
protected
procedure AdjustClientRect(var Rect: TRect); override;
procedure CreatePanel; virtual;
procedure Change; override;
procedure DoRemoveDockClient(Client: TControl); override;
procedure CustomDockOver(Source: TJvDockDragDockObject; X, Y: Integer; State: TDragState;
var Accept: Boolean); override;
procedure CustomGetSiteInfo(Source: TJvDockDragDockObject; Client: TControl; var InfluenceRect: TRect;
MousePos: TPoint; var CanDock: Boolean); override;
procedure CustomDockDrop(Source: TJvDockDragDockObject; X, Y: Integer); override;
procedure CustomGetDockEdge(Source: TJvDockDragDockObject; MousePos: TPoint; var DropAlign: TAlign); override;
function CustomUnDock(Source: TJvDockDragDockObject; NewTarget: TWinControl; Client: TControl): Boolean; override;
procedure DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean); override;
procedure CreateParams(var Params: TCreateParams); override;
function GetDockClientFromMousePos(MousePos: TPoint): TControl; override;
procedure Paint; override;
procedure SetActivePage(Page: TJvDockTabSheet); override;
procedure SetTabHeight(Value: Smallint); override;
procedure SetTabPosition(Value: TTabPosition); override;
procedure CreateWnd; override;
procedure Loaded; override;
procedure SetHotTrack(Value: Boolean); override;
procedure SetImages(Value: TCustomImageList); override;
procedure SyncWithStyle; override;
property TabPanelClass: TJvDockTabPanelClass read FTabPanelClass write FTabPanelClass;
public
constructor Create(AOwner: TComponent); override;
procedure AfterConstruction; override;
property ActiveVIDPage: TJvDockVIDTabSheet read GetActiveVIDPage write SetActiveVIDPage;
destructor Destroy; override;
procedure DockDrop(Source: TDragDockObject; X, Y: Integer); override;
function DoUnDock(NewTarget: TWinControl; Client: TControl): Boolean; override;
procedure UpdateCaption(Exclude: TControl); override;
procedure Resize; override;
property Pages[Index: Integer]: TJvDockVIDTabSheet read GetPage;
property Panel: TJvDockTabPanel read FPanel;
property TempSheet: TJvDockVIDTabSheet read FTempSheet write FTempSheet;
property VisibleSheetCount: Integer read GetVisibleSheetCount;
published
property ActiveSheetColor: TColor read GetActiveSheetColor write SetActiveSheetColor;
property InactiveSheetColor: TColor read GetInactiveSheetColor write SetInactiveSheetColor;
property TabLeftOffset: Integer read GetTabLeftOffset write SetTabLeftOffset default 5;
property TabRightOffset: Integer read GetTabRightOffset write SetTabRightOffset default 5;
property TabTopOffset: Integer read GetTabTopOffset write SetTabTopOffset default 2;
property TabBottomOffset: Integer read GetTabBottomOffset write SetTabBottomOffset default 3;
property ActiveFont: TFont read GetActiveFont write SetActiveFont;
property InactiveFont: TFont read GetInactiveFont write SetInactiveFont;
property HotTrackColor: TColor read GetHotTrackColor write SetHotTrackColor;
property ShowTabImages: Boolean read GetShowTabImages write SetShowTabImages;
property ActivePage;
property Align;
property Anchors;
property BiDiMode;
property Constraints;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HotTrack;
property Images;
property MultiLine;
property OwnerDraw;
property ParentBiDiMode;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property RaggedRight;
property ScrollOpposite;
property ShowHint;
property Style;
property TabHeight;
property TabIndex;
property TabOrder;
property TabPosition;
property TabStop;
property TabWidth;
property Visible;
property OnChange;
property OnChanging;
property OnContextPopup;
property OnDockDrop;
property OnDockOver;
property OnDragDrop;
property OnDragOver;
property OnDrawTab;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetImageIndex;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
TJvDockVIDDragDockObject = class(TJvDockDragDockObject)
private
FOldDropAlign: TAlign;
FCurrState: TDragState;
FOldState: TDragState;
FOldTarget: Pointer;
FSourceDockClientList: TList;
FDropTabControl: TJvDockVIDTabPageControl;
FIsTabDockOver: Boolean;
FErase: Boolean;
function GetSourceDockClient(Index: Integer): TControl;
function GetSourceDockClientCount: Integer;
procedure SetOldState(const Value: TDragState);
procedure SetCurrState(const Value: TDragState);
protected
procedure GetBrush_PenSize_DrawRect(var ABrush: TBrush; var PenSize: Integer;
var DrawRect: TRect; Erase: Boolean); override;
procedure MouseMsg(var Msg: TMessage); override;
procedure DefaultDockImage(Erase: Boolean); override;
function CanLeave(NewTarget: TWinControl): Boolean; override;
public
constructor Create(AControl: TControl); override;
destructor Destroy; override;
function DragFindWindow(const Pos: TPoint): THandle; override;
function GetDropCtl: TControl; override;
property SourceDockClients[Index: Integer]: TControl read GetSourceDockClient;
property SourceDockClientCount: Integer read GetSourceDockClientCount;
property CurrState: TDragState read FCurrState write SetCurrState;
property OldState: TDragState read FOldState write SetOldState;
end;
procedure PaintGradientBackground(Canvas: TCanvas; ARect: TRect; StartColor, EndColor: TColor;
Vertical: Boolean = False);
{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvDockVIDStyle.pas $';
Revision: '$Revision: 11274 $';
Date: '$Date: 2007-04-24 21:09:06 +0200 (mar., 24 avr. 2007) $';
LogPath: 'JVCL\run'
);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}
implementation
uses
{$IFDEF JVCLThemesEnabled}
JvThemes,
{$ENDIF JVCLThemesEnabled}
SysUtils, Math, Forms,
JvDockSupportProc;
type
TJvTempWinControl = class(TWinControl);
var
gi_DockRect: TRect;
{ (rb) Compare to PaintGradientBackground in JvDockVIDVCStyle.pas }
procedure PaintGradientBackground(Canvas: TCanvas; ARect: TRect;
StartColor, EndColor: TColor; Vertical: Boolean = False);
const
D = 256;
var
X, Y, C1, C2, R1, G1, B1, W, H: Integer;
DR, DG, DB, DH, DW: Real;
procedure InitRGBValues(C1, C2: Integer);
begin
R1 := GetRValue(C1);
G1 := GetGValue(C1);
B1 := GetBValue(C1);
DR := (GetRValue(C2) - R1) / D;
DG := (GetGValue(C2) - G1) / D;
DB := (GetBValue(C2) - B1) / D;
end;
begin
with Canvas do
begin
Lock;
try
Brush.Style := bsSolid;
{ !! GetRValue etc. assume that the input param is a RGB value thus
NO system color, such as clWindowText etc. }
C1 := ColorToRGB(StartColor);
C2 := ColorToRGB(EndColor);
if C1 <> C2 then
begin
InitRGBValues(C1, C2);
if not Vertical then
begin
DH := (ARect.Right - ARect.Left) / D;
for X := 0 to 255 do
begin
Brush.Color := RGB(R1 + Round(DR * X), G1 + Round(DG * X),
B1 + Round(DB * X));
with ARect do
begin
if Right <= Left + Round((X + 1) * DH) then
W := Right
else
W := Left + Round((X + 1) * DH);
FillRect(Rect(Left + Round(X * DH), Top, W, Bottom));
end;
end;
end
else
begin
DW := (ARect.Bottom - ARect.Top) / D;
for Y := 0 to 255 do
begin
Brush.Color := RGB(R1 + Round(DR * Y), G1 + Round(DG * Y),
B1 + Round(DB * Y));
with ARect do
begin
if Bottom <= Top + Round((Y + 1) * DW) then
H := Bottom
else
H := Top + Round((Y + 1) * DW);
FillRect(Rect(Left, Top + Round(Y * DW), Right, H));
end;
end;
end;
end
else
begin
Brush.Color := StartColor;
FillRect(ARect);
end;
finally
Unlock;
end;
end;
end;
procedure AssignList(FromList, ToList: TList);
var
I: Integer;
begin
ToList.Clear;
for I := 0 to FromList.Count - 1 do
ToList.Add(FromList[I]);
end;
function ComputeVIDDockingRect(Target, Control: TControl; var DockRect: TRect; MousePos: TPoint): TAlign;
var
DockTopRect: TRect;
DockLeftRect: TRect;
DockBottomRect: TRect;
DockRightRect: TRect;
DockCenterRect: TRect;
DockTabRect: TRect;
begin
Result := alNone;
if Target = nil then
Exit;
with Target do
begin
DockLeftRect.TopLeft := Point(0, 0);
DockLeftRect.BottomRight := Point(ClientWidth div 5, ClientHeight);
DockTopRect.TopLeft := Point(ClientWidth div 5, 0);
DockTopRect.BottomRight := Point(ClientWidth div 5 * 4, ClientHeight div 5);
DockRightRect.TopLeft := Point(ClientWidth div 5 * 4, 0);
DockRightRect.BottomRight := Point(ClientWidth, ClientHeight);
if Target is TJvDockCustomTabControl then
begin
DockBottomRect.TopLeft := Point(ClientWidth div 5, ClientWidth div 5 * 4);
DockBottomRect.BottomRight := Point(ClientWidth div 5 * 4, ClientHeight - JvDockGetSysCaptionHeight);
end
else
begin
DockBottomRect.TopLeft := Point(0, ClientHeight div 5 * 4);
DockBottomRect.BottomRight := Point(ClientWidth, ClientHeight);
end;
DockCenterRect.TopLeft := Point(0, -JvDockGetSysCaptionHeight);
DockCenterRect.BottomRight := Point(ClientWidth, 0);
if Target is TJvDockCustomTabControl then
begin
DockTabRect.TopLeft := Point(0, ClientHeight - JvDockGetSysCaptionHeight);
DockTabRect.BottomRight := Point(ClientWidth, ClientHeight);
end
else
DockTabRect := Rect(0, 0, 0, 0);
if PtInRect(DockCenterRect, MousePos) or
PtInRect(DockTabRect, MousePos) then
begin
Result := alClient;
DockRect := DockCenterRect;
DockRect.BottomRight := Point(ClientWidth, ClientHeight);
end
else
if PtInRect(DockLeftRect, MousePos) then
begin
Result := alLeft;
DockRect := DockLeftRect;
DockRect.Right := Min(ClientWidth div 2, Control.ClientWidth);
end
else
if PtInRect(DockTopRect, MousePos) then
begin
Result := alTop;
DockRect := DockTopRect;
DockRect.Left := 0;
DockRect.Right := ClientWidth;
DockRect.Bottom := Min(ClientHeight div 2, Control.ClientHeight);
end
else
if PtInRect(DockRightRect, MousePos) then
begin
Result := alRight;
DockRect := DockRightRect;
DockRect.Left := Max(ClientWidth div 2, ClientWidth - Control.ClientWidth);
end
else
if PtInRect(DockBottomRect, MousePos) then
begin
Result := alBottom;
DockRect := DockBottomRect;
DockRect.Top := Max(ClientHeight div 2, ClientHeight - Control.ClientHeight);
end;
if Result = alNone then
Exit;
DockRect.TopLeft := ClientToScreen(DockRect.TopLeft);
DockRect.BottomRight := ClientToScreen(DockRect.BottomRight);
end;
end;
(* (ahuser) not used - make Delphi 5 happy
procedure SetTabControlPreview(VIDSource: TJvDockVIDDragDockObject;
TabControl: TJvDockVIDTabPageControl;
State: TDragState; DropAlign: TAlign);
var
I: Integer;
Index: Integer;
begin
if TabControl <> nil then
begin
if DropAlign = alClient then
begin
if TabControl.FTempSheet = nil then
begin
for I := VIDSource.SourceDockClientCount - 1 downto 0 do
begin
TabControl.FTempSheet := TJvDockVIDTabSheet.Create(TabControl);
TabControl.FTempSheet.PageControl := TabControl;
TabControl.FTempSheet.Caption := TJvTempWinControl(VIDSource.SourceDockClients[I]).Caption;
Index := TabControl.FTabImageList.AddIcon(TForm(VIDSource.SourceDockClients[I]).Icon);
if Index <> -1 then
TabControl.FTempSheet.ImageIndex := Index;
TabControl.FTempSheet.FIsSourceDockClient := True;
end;
TabControl.ActivePage := TabControl.FTempSheet;
TabControl.Panel.SelectSheet := TabControl.FTempSheet;
{$IFDEF COMPILER6_UP}
TabControl.Panel.FTempPages.Assign(TabControl.PageSheets);
{$ELSE}
AssignList(TabControl.PageSheets, TabControl.Panel.FTempPages);
{$ENDIF COMPILER6_UP}
TabControl.ActivePage.Invalidate;
end;
end;
if ((State = dsDragLeave) or (VIDSource.DropAlign <> alClient)) and (TabControl.FTempSheet <> nil) then
begin
for I := TabControl.PageCount - 1 downto 0 do
begin
if TJvDockVIDTabSheet(TabControl.Pages[I]).FIsSourceDockClient then
begin
Index := TabControl.Panel.FTempPages.IndexOf(TabControl.Pages[I]);
if Index >= 0 then
begin
TabControl.Panel.FTempPages.Delete(Index);
if TabControl.FTabImageList.Count > Index then
TabControl.FTabImageList.Delete(Index);
end;
TabControl.Pages[I].Free;
end;
end;
TabControl.FTempSheet := nil;
end;
TabControl.ParentForm.Caption := TabControl.ActivePage.Caption;
if TabControl.ParentForm.HostDockSite is TJvDockCustomPanel then
TabControl.ParentForm.HostDockSite.Invalidate;
end;
end;
*)
//=== { TJvDockVIDStyle } ====================================================
constructor TJvDockVIDStyle.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
DockPanelClass := TJvDockVIDPanel;
DockSplitterClass := TJvDockVIDSplitter;
ConjoinPanelClass := TJvDockVIDConjoinPanel;
TabDockClass := TJvDockVIDTabPageControl;
DockPanelTreeClass := TJvDockVIDTree;
DockPanelZoneClass := TJvDockVIDZone;
ConjoinPanelTreeClass := TJvDockVIDTree;
ConjoinPanelZoneClass := TJvDockVIDZone;
ConjoinServerOptionClass := TJvDockVIDConjoinServerOption;
TabServerOptionClass := TJvDockVIDTabServerOption;
end;
procedure TJvDockVIDStyle.FormDockOver(DockClient: TJvDockClient; Source: TJvDockDragDockObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
ARect: TRect;
begin
with DockClient do
begin
Accept := EnableDock and EachOtherDock and
IsDockable(ParentForm, Source.Control, Source.DropOnControl, Source.DropAlign);
if State = dsDragMove then
begin
Source.DropAlign := ComputeVIDDockingRect(ParentForm, Source.Control, ARect, Point(X, Y));
if Accept and (Source.DropAlign <> alNone) then
begin
if Source.DropAlign = alClient then
Inc(ARect.Top, JvDockGetSysCaptionHeightAndBorderWidth + 1);
Source.DockRect := ARect;
end;
gi_DockRect := ARect;
end
else
if State = dsDragLeave then
Source.DropAlign := alNone;
if Source is TJvDockVIDDragDockObject then
begin
TJvDockVIDDragDockObject(Source).OldState := TJvDockVIDDragDockObject(Source).CurrState;
TJvDockVIDDragDockObject(Source).CurrState := State;
end;
end;
end;
procedure TJvDockVIDStyle.FormGetSiteInfo(Source: TJvDockDragDockObject; DockClient: TJvDockClient;
Client: TControl; var InfluenceRect: TRect; MousePos: TPoint;
var CanDock: Boolean);
const
DefExpandoRect = 20;
var
CH_BW: Integer;
ARect: TRect;
begin
with DockClient do
begin
CanDock := IsDockable(ParentForm, Client, Source.DropOnControl, Source.DropAlign);
if CanDock then
begin
GetWindowRect(ParentForm.Handle, InfluenceRect);
if ParentForm.HostDockSite is TJvDockCustomPanel then
Dec(InfluenceRect.Top, TJvDockCustomPanel(ParentForm.HostDockSite).JvDockManager.GrabberSize);
if PtInRect(InfluenceRect, MousePos) then
begin
ARect := InfluenceRect;
InflateRect(ARect, -DefExpandoRect, -DefExpandoRect);
CH_BW := JvDockGetSysCaptionHeightAndBorderWidth;
Inc(ARect.Top, CH_BW + 1);
if PtInRect(ARect, MousePos) then
begin
InfluenceRect := Rect(0, 0, 0, 0);
CanDock := False;
end;
end;
end;
end;
end;
procedure TJvDockVIDStyle.FormDockDrop(DockClient: TJvDockClient;
Source: TJvDockDragDockObject; X, Y: Integer);
var
ARect, DRect: TRect;
DockType: TAlign;
Host: TJvDockableForm;
APanelDock: TWinControl;
VIDSource: TJvDockVIDDragDockObject;
I: Integer;
begin
if Source is TJvDockVIDDragDockObject then
begin
TJvDockVIDDragDockObject(Source).CurrState := dsDragEnter;
TJvDockVIDDragDockObject(Source).OldState := dsDragEnter;
end;
if IsDockable(DockClient.ParentForm, Source.Control, Source.DropOnControl, Source.DropAlign) then
begin
Host := nil;
JvDockLockWindow(nil);
try
with DockClient do
begin
DockType := ComputeVIDDockingRect(DockClient.ParentForm, Source.Control, ARect, Point(X, Y));
if ParentForm.HostDockSite is TJvDockPanel then
begin
if DockType = alClient then
begin
if Source.Control is TJvDockTabHostForm then
begin
APanelDock := ParentForm.HostDockSite;
ARect := ParentForm.BoundsRect;
ParentForm.ManualDock(TJvDockTabHostForm(Source.Control).PageControl, nil, alClient);
TJvDockTabHostForm(Source.Control).PageControl.ActivePage.PageIndex := 0;
Source.Control.BoundsRect := ARect;
Source.Control.ManualDock(APanelDock, nil, alClient);
if ParentForm.FormStyle = fsStayOnTop then
TForm(Source.Control).FormStyle := fsStayOnTop;
end
else
begin
APanelDock := ParentForm.HostDockSite;
DRect.TopLeft := ParentForm.HostDockSite.ClientToScreen(Point(0, 0));
Host := CreateTabHostAndDockControl(ParentForm, Source.Control);
SetDockSite(ParentForm, False);
SetDockSite(TWinControl(Source.Control), False);
Host.Top := DRect.Top;
Host.Left := DRect.Left;
Host.Visible := True;
Host.ManualDock(APanelDock, nil, alClient);
end;
end
else
begin
DRect := ParentForm.HostDockSite.BoundsRect;
Source.Control.ManualDock(ParentForm.HostDockSite, nil, DockType);
ParentForm.HostDockSite.BoundsRect := DRect;
SetDockSite(TWinControl(Source.Control), False);
end;
Exit;
end;
if DockType = alClient then
begin
if Source.Control is TJvDockTabHostForm then
begin
APanelDock := ParentForm.HostDockSite;
ARect := ParentForm.BoundsRect;
ParentForm.ManualDock(TJvDockTabHostForm(Source.Control).PageControl, nil, alClient);
TJvDockTabHostForm(Source.Control).PageControl.ActivePage.PageIndex := 0;
Source.Control.BoundsRect := ARect;
Source.Control.ManualDock(APanelDock, nil, alClient);
if ParentForm.FormStyle = fsStayOnTop then
TForm(Source.Control).FormStyle := fsStayOnTop;
Exit;
end
else
begin
if Source is TJvDockVIDDragDockObject then
begin
VIDSource := TJvDockVIDDragDockObject(Source);
DoFloatForm(Source.Control);
FreeAllDockableForm;
for I := 0 to VIDSource.SourceDockClientCount - 1 do
begin
VIDSource.Control := VIDSource.SourceDockClients[I];
if Host = nil then
Host := DockClient.CreateTabHostAndDockControl(DockClient.ParentForm, Source.Control)
else
Source.Control.ManualDock(TJvDockTabHostForm(Host).PageControl, nil, alClient);
end;
Host.Visible := True;
end;
end;
end
else
if DockType <> alNone then
begin
Host := CreateConjoinHostAndDockControl(ParentForm, Source.Control, DockType);
SetDockSite(ParentForm, False);
SetDockSite(TWinControl(Source.Control), False);
Host.Visible := True;
end;
if Host <> nil then
begin
Host.LRDockWidth := Source.Control.LRDockWidth;
Host.TBDockHeight := Source.Control.TBDockHeight;
end;
end;
finally
JvDockUnLockWindow;
end;
end;
end;
procedure TJvDockVIDStyle.SetDockBaseControl(IsCreate: Boolean;
DockBaseControl: TJvDockBaseControl);
var
ADockClient: TJvDockClient;
begin
if DockBaseControl is TJvDockClient then
begin
ADockClient := TJvDockClient(DockBaseControl);
if IsCreate then
ADockClient.DirectDrag := False;
end;
end;
procedure TJvDockVIDStyle.FormStartDock(DockClient: TJvDockClient;
var Source: TJvDockDragDockObject);
begin
inherited FormStartDock(DockClient, Source);
Source := TJvDockVIDDragDockObject.Create(DockClient.ParentForm);
{allows DockClient.OnCheckIsDockable event to fire once before docking, to block or allow drag/drop to this site. }
// Source.DockClient := DockClient;
end;
procedure TJvDockVIDStyle.FormGetDockEdge(DockClient: TJvDockClient;
Source: TJvDockDragDockObject; MousePos: TPoint; var DropAlign: TAlign);
var
ARect: TRect;
begin
DropAlign := ComputeVIDDockingRect(DockClient.ParentForm, Source.Control, ARect, MousePos);
end;
function TJvDockVIDStyle.DockClientWindowProc(DockClient: TJvDockClient;
var Msg: TMessage): Boolean;
begin
Result := inherited DockClientWindowProc(DockClient, Msg);
end;
procedure TJvDockVIDStyle.DoSystemInfoChange(Value: Boolean);
begin
if Assigned(FSystemInfoChange) then
FSystemInfoChange(Value);
end;
procedure TJvDockVIDStyle.SetAlwaysShowGrabber(const Value: Boolean);
begin
if Value <> FAlwaysShowGrabber then
begin
FAlwaysShowGrabber := Value;
Changed;
end;
end;
//=== { TJvDockVIDPanel } ====================================================
procedure TJvDockVIDPanel.CustomDockDrop(Source: TJvDockDragDockObject; X, Y: Integer);
begin
if Source.Control is TJvDockableForm then
ShowDockPanel(True, Source.Control);
if not ((Source.Control.HostDockSite <> nil) and
(Source.DropOnControl = Source.Control.HostDockSite.Parent) and
(Source.DropAlign = alClient)) then
begin
inherited CustomDockDrop(Source, X, Y);
{$IFNDEF COMPILER9_UP}
InvalidateDockHostSiteOfControl(Source.Control, False);
{$ENDIF !COMPILER9_UP}
if (Source.Control is TWinControl) and TWinControl(Source.Control).CanFocus then
TWinControl(Source.Control).SetFocus;
end;
end;
procedure TJvDockVIDPanel.CustomDockOver(Source: TJvDockDragDockObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
var
DropAlign: TAlign;
begin
inherited CustomDockOver(Source, X, Y, State, Accept);
if Accept and (Source is TJvDockVIDDragDockObject) then
if State = dsDragMove then
begin
DropAlign := Source.DropAlign;
JvDockManager.GetDockEdge(Source.DockRect, Source.DragPos, DropAlign, Source.Control);
end;
end;
procedure TJvDockVIDPanel.CustomGetDockEdge(Source: TJvDockDragDockObject;
MousePos: TPoint; var DropAlign: TAlign);
begin
end;
procedure TJvDockVIDPanel.CustomGetSiteInfo(Source: TJvDockDragDockObject;
Client: TControl; var InfluenceRect: TRect; MousePos: TPoint;
var CanDock: Boolean);
begin
if VisibleDockClientCount = 0 then
inherited CustomGetSiteInfo(Source, Client, InfluenceRect, MousePos, CanDock)
else
begin
CanDock := IsDockable(Self, Client, Source.DropOnControl, Source.DropAlign);
if CanDock then
JvDockManager.GetSiteInfo(Client, InfluenceRect, MousePos, CanDock);
end;
end;
procedure TJvDockVIDPanel.CustomStartDock(var Source: TJvDockDragDockObject);
begin
Source := TJvDockVIDDragDockObject.Create(Self);
end;
procedure TJvDockVIDPanel.DockDrop(Source: TDragDockObject; X, Y: Integer);
begin
inherited DockDrop(Source, X, Y);
end;
procedure TJvDockVIDPanel.UpdateCaption(Exclude: TControl);
begin
inherited UpdateCaption(Exclude);
Invalidate;
end;
//=== { TJvDockVIDTree } =====================================================
constructor TJvDockVIDTree.Create(DockSite: TWinControl;
DockZoneClass: TJvDockZoneClass; ADockStyle: TJvDockObservableStyle);
begin
inherited Create(DockSite, DockZoneClass, ADockStyle);
FDropOnZone := nil;
ButtonHeight := 11;
ButtonWidth := 13;
LeftOffset := 4;
RightOffset := 4;
TopOffset := 4;
BottomOffset := 3;
ButtonSplitter := 2;
BorderWidth := 0;
MinSize := 20;
CaptionLeftOffset := 0;
CaptionRightOffset := 0;
end;
function TJvDockVIDTree.GetDockGrabbersPosition: TJvDockGrabbersPosition;
begin
Result := gpTop;
end;
function TJvDockVIDTree.GetTopGrabbersHTFlag(const MousePos: TPoint;
out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone;
begin
if (MousePos.Y >= Zone.Top) and (MousePos.Y <= Zone.Top + GrabberSize) and
(MousePos.X >= Zone.Left) and (MousePos.X <= Zone.Left + Zone.Width) then
begin
Result := Zone;
with Zone.ChildControl do
begin
if PtInRect(Rect(
Left + Width - ButtonWidth - RightOffset,
Top - GrabberSize + TopOffset,
Left + Width - RightOffset,
Top - GrabberSize + TopOffset + ButtonHeight), MousePos) then
HTFlag := HTCLOSE
else
HTFlag := HTCAPTION;
end;
end
else
Result := nil;
end;
procedure TJvDockVIDTree.InsertControl(Control: TControl; InsertAt: TAlign;
DropCtl: TControl);
var
I: Integer;
Host: TJvDockTabHostForm;
ChildCount: Integer;
VIDSource: TJvDockVIDDragDockObject;
TempControl: TControl;
ARect: TRect;
AZone: TJvDockZone;
function CreateDockPageControl(Client: TControl): TJvDockTabHostForm;
var
Zone: TJvDockZone;
TempCtl: TControl;
TempPanel: TJvDockConjoinPanel;
DockClient: TJvDockClient;
APoint: TPoint;
begin
{$IFDEF JVDOCK_DEBUG}
OutputDebugString('TJvDockVIDTree.InsertControl.CreateDockPageControl');
{$ENDIF JVDOCK_DEBUG}
Result := nil;
Zone := FindControlZone(DropCtl);
DockClient := FindDockClient(DropCtl);
if (DockClient <> nil) and (Zone <> nil) then
begin
TempCtl := DropCtl;
if Zone.ParentZone.Orientation = doHorizontal then
begin
if Zone.PrevSibling = nil then
begin
if Zone.NextSibling <> nil then
DropCtl := Zone.NextSibling.ChildControl;
InsertAt := alTop;
end
else
begin
DropCtl := Zone.PrevSibling.ChildControl;
InsertAt := alBottom;
end;
end
else
if Zone.ParentZone.Orientation = doVertical then
begin
if Zone.PrevSibling = nil then
begin
if Zone.NextSibling <> nil then
DropCtl := Zone.NextSibling.ChildControl;
InsertAt := alLeft;
end
else
begin
DropCtl := Zone.PrevSibling.ChildControl;
InsertAt := alRight;
end;
end;
if TempCtl.HostDockSite is TJvDockConjoinPanel then
TempPanel := TJvDockConjoinPanel(TempCtl.HostDockSite)
else
TempPanel := nil;
Result := DockClient.CreateTabHostAndDockControl(TempCtl, Client);
if TempPanel <> nil then
TempPanel.ParentForm.UnDockControl := Result;
SetDockSite(TWinControl(TempCtl), False);
SetDockSite(TWinControl(Client), False);
if DockSite.Align = alBottom then
APoint := Point(0, -TempCtl.TBDockHeight)
else
if DockSite.Align = alRight then
APoint := Point(-TempCtl.LRDockWidth, 0)
else
APoint := Point(0, 0);
APoint := DockSite.ClientToScreen(APoint);
Result.Left := APoint.X;
Result.Top := APoint.Y;
Result.UndockWidth := TempCtl.UndockWidth;
Result.UndockHeight := TempCtl.UndockHeight;
Result.LRDockWidth := TempCtl.LRDockWidth;
Result.TBDockHeight := TempCtl.TBDockHeight + GrabberSize;
Result.Visible := True;
end;
end;
begin
{$IFDEF JVDOCK_DEBUG}
OutputDebugString('TJvDockVIDTree.InsertControl');
{$ENDIF JVDOCK_DEBUG}
if not JvGlobalDockIsLoading then
JvDockLockWindow(nil);
try
VIDSource := nil;
if Control is TJvDockableForm then
begin
if InsertAt in [alClient] then
begin
if DropCtl is TJvDockTabHostForm then
begin
try
VIDSource := TJvDockVIDDragDockObject.Create(Control);
DoFloatForm(Control);
FreeAllDockableForm;
for I := VIDSource.SourceDockClientCount - 1 downto 0 do
begin
TempControl := VIDSource.SourceDockClients[I];
TempControl.ManualDock(TJvDockTabHostForm(DropCtl).PageControl);
if TempControl is TForm then
begin
TForm(TempControl).ActiveControl := nil;
SetDockSite(TForm(TempControl), False);
end;
end;
finally
VIDSource.Free;
JvGlobalDockManager.DragObject.Control := nil;
end;
end
else
begin
if (DockSite is TJvDockCustomPanel) and (DockSite.VisibleDockClientCount > 1) and (DropCtl <> nil) then
begin
try
VIDSource := TJvDockVIDDragDockObject.Create(Control);
DoFloatForm(Control);
FreeAllDockableForm;
Host := CreateDockPageControl(VIDSource.SourceDockClients[0]);
if Host <> nil then
begin
for I := VIDSource.SourceDockClientCount - 1 downto 1 do
begin
TempControl := VIDSource.SourceDockClients[I];
TempControl.ManualDock(Host.PageControl);
if TempControl is TForm then
begin
TForm(TempControl).ActiveControl := nil;
SetDockSite(TForm(TempControl), False);
end;
end;
Host.ManualDock(DockSite, nil, InsertAt);
end;
finally
VIDSource.Free;
JvGlobalDockManager.DragObject.Control := nil;
end;
end
else
inherited InsertControl(Control, InsertAt, DropCtl);
end;
end
else
if Control is TJvDockConjoinHostForm then
begin
TJvTempWinControl(TJvDockableForm(Control).DockableControl).DockManager.ResetBounds(True);
InsertControlFromConjoinHost(Control, InsertAt, DropCtl);
end
else
inherited InsertControl(Control, InsertAt, DropCtl);
end
else
begin
if InsertAt in [alLeft, alTop] then
DropDockSize := DropDockSize + SplitterWidth div 2;
if InsertAt in [alClient] then
begin
if DropCtl is TJvDockTabHostForm then
Control.ManualDock(TJvDockTabHostForm(DropCtl).PageControl, nil, alClient)
else
if TopZone.ChildZones <> nil then
begin
ChildCount := TopZone.ChildCount;
if DropCtl <> nil then
begin
ARect := DropCtl.BoundsRect;
AZone := FindControlZone(DropCtl);
if DropCtl.DockOrientation = doHorizontal then
begin
if ((AZone <> nil) and (AZone.ZoneLimit <> DockSite.Height)) then
ARect.Bottom := ARect.Bottom + SplitterWidth;
end
else
begin
if ((AZone <> nil) and (AZone.ZoneLimit <> DockSite.Width)) then
ARect.Right := ARect.Right + SplitterWidth;
end;
DockRect := ARect;
end
else
DockRect := Rect(0, 0, TopZone.Width, TopZone.Height);
Host := CreateDockPageControl(Control);
if Host <> nil then
if (ChildCount >= 2) or (DockSite is TJvDockPanel) then
begin
if InsertAt in [alLeft, alRight] then
DropDockSize := DockRect.Right - DockRect.Left
else
DropDockSize := DockRect.Bottom - DockRect.Top + GrabberSize;
LockDropDockSize;
Host.ManualDock(DockSite, DropCtl, InsertAt);
UnlockDropDockSize;
end
else
Host.BoundsRect := DockSite.Parent.BoundsRect;
end
else
inherited InsertControl(Control, InsertAt, DropCtl);
end
else
inherited InsertControl(Control, InsertAt, DropCtl);
{ (rb) no idea what gi_DockRect should be doing, but prevent it is used
before it is set (by checking whether it is empty). Using it when the rect
is empty causes align problems }
if not IsRectEmpty(gi_DockRect) then
DockRect := gi_DockRect;
end;
ForEachAt(nil, UpdateZone);
finally
if not JvGlobalDockIsLoading then
JvDockUnLockWindow;
end;
end;
procedure TJvDockVIDTree.InsertControlFromConjoinHost(Control: TControl;
InsertAt: TAlign; DropCtl: TControl);
const
{$IFDEF COMPILER6_UP}
OrientArray: array [TAlign] of TDockOrientation =
(doNoOrient, doHorizontal, doHorizontal, doVertical, doVertical, doNoOrient, doNoOrient);
MakeLast: array [TAlign] of Boolean =
(False, False, True, False, True, False, False);
ReverseAt: array [TAlign] of TAlign =
(alClient, alBottom, alTop, alRight, alLeft, alNone, alCustom);
{$ELSE}
OrientArray: array [TAlign] of TDockOrientation =
(doNoOrient, doHorizontal, doHorizontal, doVertical, doVertical, doNoOrient);
MakeLast: array [TAlign] of Boolean =
(False, False, True, False, True, False);
ReverseAt: array [TAlign] of TAlign =
(alClient, alBottom, alTop, alRight, alLeft, alNone);
{$ENDIF COMPILER6_UP}
var
Stream: TMemoryStream;
TopOrientation: TDockOrientation;
InsertOrientation: TDockOrientation;
CurrentOrientation: TDockOrientation;
ZoneLimit: Integer;
Level, LastLevel, I: Integer;
Zone, NextZone: TJvDockZone;
DropCtlZone, LastZone: TJvDockZone;
OffsetXYLimitArr: array [TDockOrientation] of Integer;
ControlXYLimitArr: array [TDockOrientation] of Integer;
procedure ReadZone(SetZone: Boolean);
var
I: Integer;
begin
with Stream do
begin
Read(Level, SizeOf(Level));
if Level = TreeStreamEndFlag then
Exit;
Zone := DockZoneClass.Create(Self);
CustomLoadZone(Stream, Zone);
ZoneLimit := Zone.ZoneLimit;
end;
if SetZone then
begin
if Level = LastLevel then
begin
Zone.NextSibling := LastZone.NextSibling;
if LastZone.NextSibling <> nil then
LastZone.NextSibling.PrevSibling := Zone;
LastZone.NextSibling := Zone;
Zone.PrevSibling := LastZone;
Zone.ParentZone := LastZone.ParentZone;
end
else
if Level > LastLevel then
begin
LastZone.ChildZones := Zone;
Zone.ParentZone := LastZone;
InsertOrientation := LastZone.Orientation;
end
else
if Level < LastLevel then
begin
NextZone := LastZone;
for I := 1 to LastLevel - Level do
NextZone := NextZone.ParentZone;
Zone.NextSibling := NextZone.NextSibling;
if NextZone.NextSibling <> nil then
NextZone.NextSibling.PrevSibling := Zone;
NextZone.NextSibling := Zone;
Zone.PrevSibling := NextZone;
Zone.ParentZone := NextZone.ParentZone;
InsertOrientation := Zone.ParentZone.Orientation;
end;
Zone.ZoneLimit := OffsetXYLimitArr[InsertOrientation] + ZoneLimit;
end;
LastLevel := Level;
LastZone := Zone;
end;
begin
ControlXYLimitArr[doNoOrient] := 0;
ControlXYLimitArr[doHorizontal] := DockRect.Bottom - DockRect.Top;
ControlXYLimitArr[doVertical] := DockRect.Right - DockRect.Left;
Stream := TMemoryStream.Create;
if Control is TJvDockConjoinHostForm then
TJvDockConjoinHostForm(Control).Panel.JvDockManager.SaveToStream(Stream);
Stream.Position := 0;
BeginUpdate;
try
Stream.Read(I, SizeOf(I));
Stream.Position := Stream.Position + 8;
Stream.Read(TopOrientation, SizeOf(TopOrientation));
Stream.Read(ZoneLimit, SizeOf(ZoneLimit));
IgnoreZoneInfor(Stream);
if (DropCtl = nil) and (TopZone.ChildCount = 1) then
DropCtl := TopZone.ChildZones.ChildControl;
DropCtlZone := FindControlZone(DropCtl);
if InsertAt in [alClient, alNone] then
InsertAt := alRight;
InsertOrientation := OrientArray[InsertAt];
if TopZone.ChildCount = 0 then
begin
TopZone.Orientation := TopOrientation;
InsertOrientation := TopOrientation;
end
else
if TopZone.ChildCount = 1 then
begin
TopZone.Orientation := InsertOrientation;
case InsertOrientation of
doHorizontal:
begin
TopZone.ZoneLimit := TopZone.ChildZones.Width;
TopXYLimit := TopZone.ChildZones.Height;
end;
doVertical:
begin
TopZone.ZoneLimit := TopZone.ChildZones.Height;
TopXYLimit := TopZone.ChildZones.Width;
end;
end;
end;
if DropCtlZone <> nil then
CurrentOrientation := DropCtlZone.ParentZone.Orientation
else
CurrentOrientation := TopZone.Orientation;
if InsertOrientation = doHorizontal then
DropDockSize := DockRect.Bottom - DockRect.Top
else
if InsertOrientation = doVertical then
DropDockSize := DockRect.Right - DockRect.Left
else
DropDockSize := 0;
OffsetXYLimitArr[doNoOrient] := 0;
if DropCtlZone <> nil then
begin
OffsetXYLimitArr[doHorizontal] := DropCtlZone.TopLeft[doHorizontal] +
Integer(MakeLast[InsertAt]) * (DropCtlZone.HeightWidth[doHorizontal] - ControlXYLimitArr[doHorizontal]);
if (FDropOnZone <> nil) and (InsertOrientation = doHorizontal) then
OffsetXYLimitArr[doHorizontal] := FDropOnZone.ZoneLimit - Round((FDropOnZone.ZoneLimit -
FDropOnZone.ParentZone.ChildZones.LimitBegin) * (DropDockSize + BorderWidth) /
(FDropOnZone.ParentZone.Height));
OffsetXYLimitArr[doVertical] := DropCtlZone.TopLeft[doVertical] +
Integer(MakeLast[InsertAt]) * (DropCtlZone.HeightWidth[doVertical] - ControlXYLimitArr[doVertical]);
if (FDropOnZone <> nil) and (InsertOrientation = doVertical) then
OffsetXYLimitArr[doVertical] := FDropOnZone.ZoneLimit - Round((FDropOnZone.ZoneLimit -
FDropOnZone.ParentZone.ChildZones.LimitBegin) * (DropDockSize + BorderWidth) /
(FDropOnZone.ParentZone.Width));
end
else
begin
if TopZone.VisibleChildCount = 0 then
begin
OffsetXYLimitArr[doHorizontal] := 0;
OffsetXYLimitArr[doVertical] := 0;
end
else
begin
OffsetXYLimitArr[doHorizontal] := Integer(MakeLast[InsertAt]) * ControlXYLimitArr[doHorizontal];
OffsetXYLimitArr[doVertical] := Integer(MakeLast[InsertAt]) * ControlXYLimitArr[doVertical];
end;
end;
if TopOrientation <> InsertOrientation then
begin
LastZone := DockZoneClass.Create(Self);
if InsertOrientation <> CurrentOrientation then
InsertNewParent(LastZone, DropCtlZone, InsertOrientation, MakeLast[InsertAt], True)
else
InsertSibling(LastZone, DropCtlZone, MakeLast[InsertAt], True);
LastZone.Orientation := TopOrientation;
LastLevel := 0;
end
else
begin
LastLevel := 1;
if TopZone.ChildCount > 0 then
begin
ReadZone(False);
if InsertOrientation <> CurrentOrientation then
InsertNewParent(LastZone, DropCtlZone, InsertOrientation, MakeLast[InsertAt], True)
else
InsertSibling(LastZone, DropCtlZone, MakeLast[InsertAt], True);
LastZone.ZoneLimit := ZoneLimit + OffsetXYLimitArr[InsertOrientation];
end
else
begin
LastLevel := 0;
LastZone := TopZone;
end;
end;
OffsetXYLimitArr[doHorizontal] := LastZone.TopLeft[doHorizontal];
OffsetXYLimitArr[doVertical] := LastZone.TopLeft[doVertical];
while True do
begin
ReadZone(True);
if Level = TreeStreamEndFlag then
Break;
end;
finally
Stream.Free;
EndUpdate;
end;
SetNewBounds(nil);
end;
procedure TJvDockVIDTree.DrawDockGrabber(Control: TWinControl; const ARect: TRect);
const
TextAlignment: array [TAlignment] of UINT =
(DT_LEFT, DT_RIGHT, DT_CENTER);
var
Option: TJvDockVIDConjoinServerOption;
DrawRect: TRect;
uFormat: UINT;
IsActive: Boolean;
begin
Assert(Assigned(Control));
case GrabbersPosition of
gpTop:
with ARect do
if Assigned(DockStyle) and (DockStyle.ConjoinServerOption is TJvDockVIDConjoinServerOption) then
begin
Option := TJvDockVIDConjoinServerOption(DockStyle.ConjoinServerOption);
IsActive := Assigned(Screen.ActiveControl) and Screen.ActiveControl.Focused and
Control.ContainsControl(Screen.ActiveControl);
DrawRect := ARect;
Inc(DrawRect.Top, 2);
DrawRect.Bottom := DrawRect.Top + GrabberSize - 3;
if IsActive then
PaintGradientBackground(Canvas, DrawRect, Option.ActiveTitleStartColor,
Option.ActiveTitleEndColor, Option.ActiveTitleVerticalGradient)
else
PaintGradientBackground(Canvas, DrawRect, Option.InactiveTitleStartColor,
Option.InactiveTitleEndColor, Option.InactiveTitleVerticalGradient);
Canvas.Brush.Style := bsClear; // body already painted
PaintDockGrabberRect(Canvas, Control, DrawRect, Option.ActiveDockGrabber);
if IsActive then
Canvas.Font.Assign(Option.ActiveFont)
else
Canvas.Font.Assign(Option.InactiveFont);
Canvas.Brush.Style := bsClear;
GetCaptionRect(DrawRect);
uFormat := DT_VCENTER or DT_SINGLELINE or
(Cardinal(Ord(Option.TextEllipsis)) * DT_END_ELLIPSIS) or TextAlignment[Option.TextAlignment];
{ DIRTY cast }
DrawText(Canvas.Handle, PChar(TForm(Control).Caption), -1, DrawRect, uFormat);
if ShowCloseButtonOnGrabber or not (Control is TJvDockTabHostForm) then
DrawCloseButton(Canvas, FindControlZone(Control), Right - RightOffset - ButtonWidth, Top + TopOffset);
end;
{$IFDEF JVDOCK_DEBUG}
gpBottom:
OutputDebugString('GrabbersPosition = gpBottom - Not supported');
gpRight:
OutputDebugString('GrabbersPosition = gpRight - Not supported');
gpLeft:
OutputDebugString('GrabbersPosition=gpLeft - Not supported');
{$ENDIF JVDOCK_DEBUG}
end;
end;
procedure TJvDockVIDTree.ResetBounds(Force: Boolean);
var
R: TRect;
begin
if not (csLoading in DockSite.ComponentState) and
(TopZone <> nil) and (DockSite.DockClientCount > 0) then
begin
R := DockSite.ClientRect;
if DockSite is TJvDockConjoinPanel then
begin
if R.Right = R.Left then
Inc(R.Right, DockSite.Parent.UndockWidth);
if R.Bottom = R.Top then
Inc(R.Bottom, DockSite.Parent.UndockHeight);
end;
if Force or (not CompareMem(@R, @PreviousRect, SizeOf(TRect))) then
begin
case TopZone.Orientation of
doHorizontal:
begin
if R.Right - R.Left > 0 then
TopZone.ZoneLimit := R.Right - R.Left;
if R.Bottom - R.Top > 0 then
TopXYLimit := R.Bottom - R.Top;
end;
doVertical:
begin
if R.Bottom - R.Top > 0 then
TopZone.ZoneLimit := R.Bottom - R.Top;
if R.Right - R.Left > 0 then
TopXYLimit := R.Right - R.Left;
end;
end;
if DockSite.DockClientCount > 0 then
begin
if not JvGlobalDockIsLoading then
begin
if (R.Bottom - R.Top > 0) and (PreviousRect.Bottom - PreviousRect.Top > 0) then
ScaleBy := (R.Bottom - R.Top) / (PreviousRect.Bottom - PreviousRect.Top)
else
ScaleBy := 1;
ShiftScaleOrientation := doHorizontal;
if (UpdateCount = 0) and (ScaleBy <> 1) then
ForEachAt(nil, ScaleZone, tskForward);
if (R.Right - R.Left > 0) and (PreviousRect.Right - PreviousRect.Left > 0) then
ScaleBy := (R.Right - R.Left) / (PreviousRect.Right - PreviousRect.Left)
else
ScaleBy := 1;
ShiftScaleOrientation := doVertical;
if (UpdateCount = 0) and (ScaleBy <> 1) then
ForEachAt(nil, ScaleZone, tskForward);
end;
SetNewBounds(nil);
if UpdateCount = 0 then
ForEachAt(nil, UpdateZone, tskForward);
PreviousRect := R;
end;
end;
end;
end;
procedure TJvDockVIDTree.DrawSplitterRect(const ARect: TRect);
begin
inherited DrawSplitterRect(ARect);
end;
procedure TJvDockVIDTree.WindowProc(var Msg: TMessage);
var
Align: TAlign;
begin
if Msg.Msg = CM_DOCKNOTIFICATION then
begin
with TCMDockNotification(Msg) do
begin
if NotifyRec.ClientMsg = CM_INVALIDATEDOCKHOST then
InvalidateDockSite(TControl(NotifyRec.MsgWParam))
else
inherited;
end;
end
else
if Msg.Msg = CM_DOCKCLIENT then
begin
{ (rb) no idea what gi_DockRect should be doing, but prevent it is used
before it is set (by checking whether it is empty). Using it when the rect
is empty causes align problems }
if not IsRectEmpty(gi_DockRect) then
begin
Align := TCMDockClient(Msg).DockSource.DropAlign;
TCMDockClient(Msg).DockSource.DockRect := gi_DockRect;
GetDockEdge(gi_DockRect, TCMDockClient(Msg).DockSource.DragPos, Align, TCMDockClient(Msg).DockSource.Control);
end;
end;
inherited WindowProc(Msg);
end;
procedure TJvDockVIDTree.SplitterMouseUp;
var
OldLimit: Integer;
Zone: TJvDockZone;
begin
Mouse.Capture := 0;
DrawSizeSplitter;
ReleaseDC(SizingWnd, SizingDC);
OldLimit := SizingZone.ZoneLimit;
ShiftScaleOrientation := SizingZone.ParentZone.Orientation;
if SizingZone.ParentZone.Orientation = doHorizontal then
SizingZone.ZoneLimit := SizePos.Y + (SplitterWidth div 2)
else
SizingZone.ZoneLimit := SizePos.X + (SplitterWidth div 2);
ParentLimit := SizingZone.LimitBegin;
if OldLimit - ParentLimit > 0 then
ScaleBy := (SizingZone.ZoneLimit - ParentLimit) / (OldLimit - ParentLimit)
else
ScaleBy := 1;
if SizingZone.ChildZones <> nil then
ForEachAt(SizingZone.ChildZones, ScaleChildZone, tskForward);
Zone := SizingZone;
while (Zone.NextSibling <> nil) and (not Zone.NextSibling.Visibled) do
begin
Zone.NextSibling.ZoneLimit := SizingZone.ZoneLimit;
Zone := Zone.NextSibling;
end;
if SizingZone.NextSibling <> nil then
begin
if SizingZone.NextSibling.ZoneLimit - OldLimit > 0 then
ScaleBy := (SizingZone.NextSibling.ZoneLimit - SizingZone.ZoneLimit) / (SizingZone.NextSibling.ZoneLimit -
OldLimit)
else
ScaleBy := 1;
ParentLimit := SizingZone.NextSibling.ZoneLimit;
if SizingZone.NextSibling.ChildZones <> nil then
ForEachAt(SizingZone.NextSibling.ChildZones, ScaleSiblingZone, tskForward);
end;
SetNewBounds(SizingZone.ParentZone);
ForEachAt(SizingZone.ParentZone, UpdateZone, tskForward);
SizingZone := nil;
end;
procedure TJvDockVIDTree.DrawDockSiteRect;
begin
end;
procedure TJvDockVIDTree.InsertSibling(NewZone, SiblingZone: TJvDockZone;
InsertLast, Update: Boolean);
begin
if FDropOnZone <> nil then
SiblingZone := FDropOnZone;
inherited InsertSibling(NewZone, SiblingZone, InsertLast, Update);
end;
procedure TJvDockVIDTree.PositionDockRect(Client, DropCtl: TControl;
DropAlign: TAlign; var DockRect: TRect);
label
LBDropCtlExist;
var
VisibleClients, NewX, NewY, NewWidth, NewHeight: Integer;
Zone: TJvDockZone;
HTFlag: Integer;
MousePos: TPoint;
Scale: Double;
CtrlRect: TRect;
procedure DockOverSplitter;
begin
NewX := Zone.ParentZone.Left;
NewY := Zone.ParentZone.Top;
NewWidth := Zone.ParentZone.Width;
NewHeight := Zone.ParentZone.Height;
case Zone.ParentZone.Orientation of
doHorizontal:
begin
Scale := (Zone.ZoneLimit - Zone.ParentZone.ChildZones.LimitBegin) / NewHeight;
NewHeight := Min(NewHeight div 2, Client.ClientHeight);
NewY := Zone.ZoneLimit - Round(NewHeight * Scale);
end;
doVertical:
begin
Scale := (Zone.ZoneLimit - Zone.ParentZone.ChildZones.LimitBegin) / NewWidth;
NewWidth := Min(NewWidth div 2, Client.ClientWidth);
NewX := Zone.ZoneLimit - Round(NewWidth * Scale);
end;
end;
DockRect := Bounds(NewX, NewY, NewWidth, NewHeight);
if Zone.Visibled then
begin
if Zone.ParentZone.Orientation = doHorizontal then
JvGlobalDockManager.DragObject.DropAlign := alBottom
else
if Zone.ParentZone.Orientation = doVertical then
JvGlobalDockManager.DragObject.DropAlign := alRight;
JvGlobalDockManager.DragObject.DropOnControl := Zone.ChildControl;
FDropOnZone := Zone;
end;
end;
begin
if DropAlign = alNone then
DropAlign := alClient;
VisibleClients := DockSite.VisibleDockClientCount;
FDropOnZone := nil;
if JvGlobalDockManager.DragObject <> nil then
MousePos := JvGlobalDockManager.DragObject.DragPos
else
MousePos := Client.ScreenToClient(Mouse.CursorPos);
MapWindowPoints(0, DockSite.Handle, MousePos, 2);
Zone := InternalHitTest(MousePos, HTFlag);
if Zone <> nil then
if Zone.ChildControl <> nil then
if (HTFlag = HTCAPTION) or (HTFlag = HTCLOSE) then
begin
DockRect := Zone.ChildControl.BoundsRect;
JvGlobalDockManager.DragObject.DropAlign := alClient;
if Zone.ChildControl is TJvDockTabHostForm then
begin
if JvGlobalDockManager.DragObject is TJvDockVIDDragDockObject then
TJvDockVIDDragDockObject(JvGlobalDockManager.DragObject).FDropTabControl :=
TJvDockVIDTabPageControl(TJvDockTabHostForm(Zone.ChildControl).PageControl);
end
else
begin
if JvGlobalDockManager.DragObject is TJvDockVIDDragDockObject then
TJvDockVIDDragDockObject(JvGlobalDockManager.DragObject).FDropTabControl := nil;
end;
end;
if DropCtl = nil then
begin
if Zone <> nil then
begin
if Zone.ChildControl <> nil then
begin
if (HTFlag = HTCAPTION) or (HTFlag = HTCLOSE) then
JvGlobalDockManager.DragObject.DropOnControl := Zone.ChildControl
else
if HTFlag = HTCLIENT then
begin
DropCtl := Zone.ChildControl;
goto LBDropCtlExist;
end
else
if HTFlag = HTSPLITTER then
DockOverSplitter;
end
else
if HTFlag = HTSPLITTER then
begin
DockOverSplitter;
end
else
Exit;
end
else
begin
DockRect := Rect(0, 0, DockSite.ClientWidth, DockSite.ClientHeight);
if VisibleClients > 0 then
with DockRect do
case DropAlign of
alLeft:
Right := Right div 2;
alRight:
Left := Right div 2;
alTop:
Bottom := Bottom div 2;
alBottom:
Top := Bottom div 2;
end;
end;
end
else
begin
LBDropCtlExist:
Zone := FindControlZone(DropCtl);
CtrlRect := DockRect;
MapWindowPoints(0, DockSite.Handle, CtrlRect, 2);
if Zone <> nil then
begin
if Zone.ParentZone.Orientation = doVertical then
begin
if (DropAlign = alRight) and (Zone.NextSibling <> nil) then
begin
DockOverSplitter;
MapWindowPoints(DockSite.Handle, 0, DockRect, 2);
Exit;
end
else
if (DropAlign = alLeft) and (Zone.PrevSibling <> nil) then
begin
Zone := Zone.PrevSibling;
DockOverSplitter;
MapWindowPoints(DockSite.Handle, 0, DockRect, 2);
Exit;
end
else
begin
if DropAlign in [alLeft, alRight] then
CtrlRect := Bounds(Zone.ParentZone.Left, Zone.ParentZone.Top, Zone.ParentZone.Width, Zone.ParentZone.Height)
else
if DropAlign in [alTop, alBottom, alClient] then
begin
CtrlRect := DropCtl.BoundsRect;
Dec(CtrlRect.Top, GrabberSize);
end;
OffsetRect(CtrlRect, 0, GrabberSize);
end;
end
else
if Zone.ParentZone.Orientation = doHorizontal then
begin
if (DropAlign = alBottom) and (Zone.NextSibling <> nil) then
begin
DockOverSplitter;
MapWindowPoints(DockSite.Handle, 0, DockRect, 2);
Exit;
end
else
if (DropAlign = alTop) and (Zone.PrevSibling <> nil) then
begin
Zone := Zone.PrevSibling;
DockOverSplitter;
MapWindowPoints(DockSite.Handle, 0, DockRect, 2);
Exit;
end
else
begin
if DropAlign in [alTop, alBottom] then
CtrlRect := Bounds(Zone.ParentZone.Left, Zone.ParentZone.Top, Zone.ParentZone.Width, Zone.ParentZone.Height)
else
if DropAlign in [alLeft, alRight, alClient] then
begin
CtrlRect := DropCtl.BoundsRect;
Dec(CtrlRect.Top, GrabberSize);
end;
OffsetRect(CtrlRect, 0, GrabberSize);
end;
end
else
begin
CtrlRect := DropCtl.BoundsRect;
Dec(CtrlRect.Top, GrabberSize);
OffsetRect(CtrlRect, 0, GrabberSize);
end;
NewX := CtrlRect.Left;
NewY := CtrlRect.Top - GrabberSize;
NewWidth := CtrlRect.Right - CtrlRect.Left;
NewHeight := CtrlRect.Bottom - CtrlRect.Top;
if DropAlign in [alLeft, alRight] then
NewWidth := Min(Client.UndockWidth, NewWidth div 2)
else
if DropAlign in [alTop, alBottom] then
NewHeight := Min(Client.UndockHeight, NewHeight div 2);
case DropAlign of
alRight:
Inc(NewX, CtrlRect.Right - CtrlRect.Left - NewWidth);
alBottom:
Inc(NewY, CtrlRect.Bottom - CtrlRect.Top - NewHeight);
end;
DockRect := Bounds(NewX, NewY, NewWidth, NewHeight);
if DropAlign = alClient then
DockRect := Bounds(NewX, NewY, NewWidth, NewHeight);
if DropAlign = alNone then
begin
end;
end;
end;
MapWindowPoints(DockSite.Handle, 0, DockRect, 2);
end;
function TJvDockVIDTree.GetDockEdge(DockRect: TRect; MousePos: TPoint;
var DropAlign: TAlign; Control: TControl): TControl;
begin
Result := inherited GetDockEdge(DockRect, MousePos, DropAlign, Control);
if FLockDropDockSizeCount = 0 then
begin
if DropAlign in [alLeft, alRight] then
DropDockSize := DockRect.Right - DockRect.Left
else
if DropAlign in [alTop, alBottom] then
DropDockSize := DockRect.Bottom - DockRect.Top
else
DropDockSize := 0;
Self.DockRect := DockRect;
end;
end;
procedure TJvDockVIDTree.InsertNewParent(NewZone, SiblingZone: TJvDockZone;
ParentOrientation: TDockOrientation; InsertLast, Update: Boolean);
begin
if FDropOnZone <> nil then
begin
SiblingZone := FDropOnZone;
InsertSibling(NewZone, SiblingZone, InsertLast, Update);
end
else
inherited InsertNewParent(NewZone, SiblingZone, ParentOrientation,
InsertLast, Update);
end;
procedure TJvDockVIDTree.RemoveZone(Zone: TJvDockZone; Hide: Boolean);
begin
if (FDropOnZone <> nil) and
((FDropOnZone.NextSibling = Zone) or (FDropOnZone = Zone)) then
FDropOnZone := nil;
inherited RemoveZone(Zone, Hide);
end;
procedure TJvDockVIDTree.GetSiteInfo(Client: TControl;
var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
var
Zone: TJvDockZone;
HTFlag: Integer;
Pos: TPoint;
Align: TAlign;
begin
Pos := DockSite.ScreenToClient(MousePos);
Zone := InternalHitTest(Pos, HTFlag);
if Zone <> nil then
begin
if HTFlag = HTSPLITTER then
begin
InfluenceRect := GetSplitterRect(Zone);
MapWindowPoints(DockSite.Handle, 0, InfluenceRect, 2);
end
else
begin
Pos := MousePos;
if Zone.ChildControl <> nil then
Pos := Zone.ChildControl.ScreenToClient(MousePos);
Align := ComputeVIDDockingRect(Zone.ChildControl, Client, InfluenceRect, Pos);
if (Align = alNone) or (Client = Zone.ChildControl) then
begin
InfluenceRect := Rect(0, 0, 0, 0);
CanDock := False;
end
else
begin
if Zone.ParentZone.Orientation = doVertical then
begin
if (Align = alRight) and (Zone.NextSibling <> nil) and (Zone.NextSibling.Visibled) then
begin
InfluenceRect := GetSplitterRect(Zone);
InflateRect(InfluenceRect, DefExpandoRect, 0);
end
else
if (Align = alLeft) and (Zone.PrevSibling <> nil) and (Zone.PrevSibling.Visibled) then
begin
InfluenceRect := GetSplitterRect(Zone.PrevSibling);
InflateRect(InfluenceRect, DefExpandoRect, 0);
end
else
Exit;
end
else
if Zone.ParentZone.Orientation = doHorizontal then
begin
if (Align = alBottom) and (Zone.NextSibling <> nil) and (Zone.NextSibling.Visibled) then
begin
InfluenceRect := GetSplitterRect(Zone);
InflateRect(InfluenceRect, 0, DefExpandoRect);
end
else
if (Align = alTop) and (Zone.PrevSibling <> nil) and (Zone.PrevSibling.Visibled) then
begin
InfluenceRect := GetSplitterRect(Zone.PrevSibling);
InflateRect(InfluenceRect, 0, DefExpandoRect);
end
else
Exit;
end
else
Exit;
end;
MapWindowPoints(DockSite.Handle, 0, InfluenceRect, 2);
end;
end
else
begin
InfluenceRect := Rect(0, 0, 0, 0);
CanDock := False;
end;
end;
procedure TJvDockVIDTree.LockDropDockSize;
begin
Inc(FLockDropDockSizeCount);
end;
procedure TJvDockVIDTree.UnlockDropDockSize;
begin
Dec(FLockDropDockSizeCount);
if FLockDropDockSizeCount < 0 then
FLockDropDockSizeCount := 0;
end;
procedure TJvDockVIDTree.PaintDockGrabberRect(Canvas: TCanvas;
Control: TWinControl; const ARect: TRect; PaintAlways: Boolean = False);
begin
end;
procedure TJvDockVIDTree.SetCaptionLeftOffset(const Value: Integer);
begin
FCaptionLeftOffset := Value;
end;
procedure TJvDockVIDTree.SetCaptionRightOffset(const Value: Integer);
begin
FCaptionRightOffset := Value;
end;
procedure TJvDockVIDTree.DrawCloseButton(Canvas: TCanvas; Zone: TJvDockZone; Left, Top: Integer);
var
AZone: TJvDockAdvZone;
ADockClient: TJvDockClient;
{$IFDEF JVCLThemesEnabled}
Details: TThemedElementDetails;
CurrentThemeType: TThemedWindow;
{$ENDIF JVCLThemesEnabled}
begin
AZone := TJvDockAdvZone(Zone);
if AZone <> nil then
begin
ADockClient := FindDockClient(Zone.ChildControl);
if (ADockClient <> nil) and not ADockClient.EnableCloseButton then
Exit;
{$IFDEF JVCLThemesEnabled}
if ThemeServices.ThemesAvailable and ThemeServices.ThemesEnabled then
begin
if GrabberSize <= 18 then
begin
CurrentThemeType := twSmallCloseButtonNormal;
if AZone.CloseBtnDown then
CurrentThemeType := twSmallCloseButtonPushed;
end
else
begin
CurrentThemeType := twCloseButtonNormal;
if AZone.CloseBtnDown then
CurrentThemeType := twCloseButtonPushed;
end;
Details := ThemeServices.GetElementDetails(CurrentThemeType);
ThemeServices.DrawElement(Canvas.Handle, Details, Rect(Left, Top, Left + ButtonWidth, Top + ButtonHeight));
end
else
{$ENDIF JVCLThemesEnabled}
DrawFrameControl(Canvas.Handle, Rect(Left, Top, Left + ButtonWidth,
Top + ButtonHeight), DFC_CAPTION, DFCS_CAPTIONCLOSE or Integer(AZone.CloseBtnDown) * DFCS_PUSHED)
end;
end;
procedure TJvDockVIDTree.GetCaptionRect(var Rect: TRect);
begin
Inc(Rect.Left, 2 + CaptionLeftOffset);
Inc(Rect.Top, 1);
Dec(Rect.Right, ButtonWidth + CaptionRightOffset - 1);
Dec(Rect.Bottom, 2);
end;
{ Adjust docking area rectangle to compensante for Grabber control }
procedure TJvDockVIDTree.AdjustDockRect(Control: TControl; var ARect: TRect);
begin
if AlwaysShowGrabber or (DockSite.Align <> alClient) or (TopZone.VisibleChildTotal > 1) then
inherited AdjustDockRect(Control, ARect);
end;
procedure TJvDockVIDTree.IgnoreZoneInfor(Stream: TMemoryStream);
var
CompName: string;
begin
Stream.Position := Stream.Position + 6;
ReadControlName(Stream, CompName);
end;
procedure TJvDockVIDTree.SyncWithStyle;
begin
inherited SyncWithStyle;
if DockStyle is TJvDockVIDStyle then
AlwaysShowGrabber := TJvDockVIDStyle(DockStyle).AlwaysShowGrabber;
if DockStyle.TabServerOption is TJvDockVIDTabServerOption then
begin
ShowCloseButtonOnGrabber := TJvDockVIDTabServerOption(DockStyle.TabServerOption).ShowCloseButtonOnGrabber;
end;
{ Not all properties are copied (See TJvDockVIDTree.DrawDockGrabber) so we
must invalidate the DockSite so it gets repainted. }
DockSite.Invalidate;
end;
procedure TJvDockVIDTree.SetShowCloseButtonOnGrabber(const Value: Boolean);
begin
if Value <> FShowCloseButtonOnGrabber then
begin
FShowCloseButtonOnGrabber := Value;
UpdateAll;
DockSite.Invalidate;
end;
end;
procedure TJvDockVIDTree.SetAlwaysShowGrabber(const Value: Boolean);
begin
if Value <> FAlwaysShowGrabber then
begin
FAlwaysShowGrabber := Value;
UpdateAll;
DockSite.Invalidate;
end;
end;
//=== { TJvDockVIDConjoinPanel } =============================================
procedure TJvDockVIDConjoinPanel.CustomDockDrop(Source: TJvDockDragDockObject;
X, Y: Integer);
begin
if not ((Source.Control.HostDockSite <> nil) and
(Source.DropOnControl = Source.Control.HostDockSite.Parent) and
(Source.DropAlign = alClient)) then
begin
inherited CustomDockDrop(Source, X, Y);
ParentForm.Caption := '';
{$IFNDEF COMPILER9_UP}
InvalidateDockHostSiteOfControl(Source.Control, False);
{$ENDIF !COMPILER9_UP}
if (Source.Control is TWinControl) and Source.Control.Visible and
TWinControl(Source.Control).CanFocus then
TWinControl(Source.Control).SetFocus;
end;
end;
procedure TJvDockVIDConjoinPanel.CustomDockOver(Source: TJvDockDragDockObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
var
DropAlign: TAlign;
begin
inherited CustomDockOver(Source, X, Y, State, Accept);
if Accept and (Source is TJvDockVIDDragDockObject) then
if State = dsDragMove then
begin
DropAlign := Source.DropAlign;
JvDockManager.GetDockEdge(Source.EraseDockRect, Source.DragPos, DropAlign, Source.Control);
end;
end;
procedure TJvDockVIDConjoinPanel.CustomGetDockEdge(Source: TJvDockDragDockObject;
MousePos: TPoint; var DropAlign: TAlign);
begin
end;
procedure TJvDockVIDConjoinPanel.CustomGetSiteInfo(Source: TJvDockDragDockObject; Client: TControl;
var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
begin
JvDockManager.GetSiteInfo(Client, InfluenceRect, MousePos, CanDock);
CanDock := IsDockable(Self, Client, Source.DropOnControl, Source.DropAlign);
end;
function TJvDockVIDConjoinPanel.CustomUnDock(Source: TJvDockDragDockObject; NewTarget: TWinControl;
Client: TControl): Boolean;
begin
Result := inherited CustomUnDock(Source, NewTarget, Client);
end;
procedure TJvDockVIDConjoinPanel.DockDrop(Source: TDragDockObject;
X, Y: Integer);
begin
inherited DockDrop(Source, X, Y);
end;
procedure TJvDockVIDConjoinPanel.UpdateCaption(Exclude: TControl);
begin
if VisibleDockClientCount > 1 then
ParentForm.Caption := ''
else
inherited UpdateCaption(Exclude);
Invalidate;
end;
// TJvDockVIDTabPageControl ==================================================
function TJvDockVIDTabPageControl.DoUnDock(NewTarget: TWinControl; Client: TControl): Boolean;
begin
Result := inherited DoUnDock(NewTarget, Client);
if Assigned(ParentForm) then
ParentForm.Caption := ActivePage.Caption;
end;
constructor TJvDockVIDTabPageControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPanel := nil;
TabWidth := 1;
MultiLine := True;
TabSheetClass := TJvDockVIDTabSheet;
TabPanelClass := TJvDockTabPanel;
FTempSheet := nil;
TabPosition := tpTop; // Warren changed! was tpBottom;
FTabImageList := nil;
Images := nil;
if AOwner is TJvDockTabHostForm then
begin
FTabImageList := TCustomImageList.Create(AOwner);
Images := FTabImageList;
end;
end;
destructor TJvDockVIDTabPageControl.Destroy;
begin
if FTabImageList <> nil then
begin
FTabImageList.Free;
FTabImageList := nil;
end;
if FPanel <> nil then
begin
FPanel.Free;
FPanel := nil;
end;
inherited Destroy;
end;
procedure TJvDockVIDTabPageControl.AfterConstruction;
begin
// we must create the panel before the inherited call, because
// TJvDockTabPageControl.AfterConstruction calls SyncWithStyle which needs
// a panel.
CreatePanel;
inherited AfterConstruction;
end;
procedure TJvDockVIDTabPageControl.Loaded;
begin
inherited Loaded;
CreatePanel;
end;
procedure TJvDockVIDTabPageControl.CreatePanel;
begin
if FPanel = nil then
begin
FPanel := TabPanelClass.Create(Self);
FPanel.Page := Self;
FPanel.Parent := Self;
FPanel.TabLeftOffset := 5;
FPanel.TabRightOffset := 5;
FPanel.TabTopOffset := 3;
FPanel.TabBottomOffset := 3;
ActiveSheetColor := clBtnFace;
InactiveSheetColor := clBtnShadow;
end;
Resize;
end;
procedure TJvDockVIDTabPageControl.CreateWnd;
begin
inherited CreateWnd;
end;
procedure TJvDockVIDTabPageControl.CMDockNotification(
var Msg: TCMDockNotification);
begin
if Msg.Msg = CM_DOCKNOTIFICATION then
begin
with TCMDockNotification(Msg) do
begin
if NotifyRec.ClientMsg = CM_INVALIDATEDOCKHOST then
{$IFDEF COMPILER9_UP}
Self.InvalidateDockHostSite(Boolean(NotifyRec.MsgLParam))
{$ELSE}
InvalidateDockHostSiteOfControl(Self, Boolean(NotifyRec.MsgLParam))
{$ENDIF COMPILER9_UP}
else
inherited;
end;
end
else
inherited;
end;
procedure TJvDockVIDTabPageControl.CustomDockDrop(Source: TJvDockDragDockObject;
X, Y: Integer);
var
ARect: TRect;
I: Integer;
VIDSource: TJvDockVIDDragDockObject;
DockClient: TJvDockClient;
Host: TJvDockConjoinHostForm;
Index: Integer;
begin
if Source.DropAlign in [alClient, alNone] then
begin
if Source is TJvDockVIDDragDockObject then
begin
BeginDockLoading;
try
DoFloatForm(Source.Control);
FreeAllDockableForm;
VIDSource := TJvDockVIDDragDockObject(Source);
for I := 0 to VIDSource.SourceDockClientCount - 1 do
begin
Source.Control := VIDSource.SourceDockClients[I];
inherited CustomDockDrop(Source, X, Y);
if Source.Control is TCustomForm then
if FTabImageList <> nil then
begin
Index := FTabImageList.AddIcon(TForm(Source.Control).Icon);
if Index <> -1 then
ActivePage.ImageIndex := Index;
end;
end;
finally
EndDockLoading;
JvGlobalDockManager.DragObject.Control := nil;
end;
end;
end
else
begin
DockClient := FindDockClient(ParentForm);
if DockClient <> nil then
begin
ARect := ParentForm.BoundsRect;
Host := DockClient.CreateConjoinHostAndDockControl(ParentForm, Source.Control, Source.DropAlign);
Host.BoundsRect := ARect;
SetDockSite(ParentForm, False);
SetDockSite(TWinControl(Source.Control), False);
Host.Visible := True;
end;
end;
FPanel.SelectSheet := nil;
ParentForm.Caption := ActivePage.Caption;
end;
procedure TJvDockVIDTabPageControl.CustomDockOver(Source: TJvDockDragDockObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
var
ARect: TRect;
begin
Accept := IsDockable(Self, Source.Control, Source.DropOnControl, Source.DropAlign);
if Accept then
begin
if ParentForm.HostDockSite = nil then
begin
Source.DropAlign := ComputeVIDDockingRect(Self, Source.Control, ARect, Point(X, Y));
if Source.DropAlign = alClient then
ARect.Top := ARect.Top + JvDockGetSysCaptionHeight;
if Accept and (Source.DropAlign <> alNone) then
begin
Source.DockRect := ARect;
gi_DockRect := ARect;
end;
end
else
begin
if ParentForm.HostDockSite is TJvDockCustomPanel then
begin
ARect := Source.DockRect;
TJvDockCustomPanel(ParentForm.HostDockSite).JvDockManager.PositionDockRect(Source.Control, Source.DropOnControl,
Source.DropAlign, ARect);
Source.DockRect := ARect;
end;
end;
end;
end;
procedure TJvDockVIDTabPageControl.CustomGetSiteInfo(Source: TJvDockDragDockObject; Client: TControl;
var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
const
DefExpandoRect = 20;
var
CH_BW: Integer;
ARect: TRect;
begin
CanDock := IsDockable(Self, Client, Source.DropOnControl, Source.DropAlign);
if ParentForm.HostDockSite <> nil then
CanDock := False;
if CanDock then
begin
GetWindowRect(Parent.Handle, InfluenceRect);
if PtInRect(InfluenceRect, MousePos) then
begin
ARect := InfluenceRect;
InflateRect(ARect, -DefExpandoRect, -DefExpandoRect);
CH_BW := JvDockGetSysCaptionHeightAndBorderWidth;
Inc(ARect.Top, CH_BW + 1);
Dec(ARect.Bottom, TabHeight);
if PtInRect(ARect, MousePos) then
InfluenceRect := Rect(0, 0, 0, 0);
end;
end;
end;
procedure TJvDockVIDTabPageControl.DoRemoveDockClient(Client: TControl);
begin
inherited DoRemoveDockClient(Client);
if Assigned(ParentForm) then
ParentForm.Caption := ActivePage.Caption; {bugfix FEB 14, 2005 - WPostma.}
end;
procedure TJvDockVIDTabPageControl.Change;
begin
Assert(Assigned(ParentForm));
inherited Change;
{ During closing/undocking of a form,
ActivePage is actually going to be wrong.
See above in DoRemoveDockClient for where we fix
this problem. }
ParentForm.Caption := ActivePage.Caption;
if ParentForm.HostDockSite is TJvDockCustomPanel then
begin
// if ParentForm.Visible and ParentForm.CanFocus then
// ParentForm.SetFocus;
ParentForm.HostDockSite.Invalidate;
end;
// if (ActivePage <> nil) and (ActivePage.Visible) and (ActivePage.CanFocus) then
// if ParentForm.Visible and ParentForm.CanFocus then
// ActivePage.SetFocus;
end;
procedure TJvDockVIDTabPageControl.AdjustClientRect(var Rect: TRect);
begin
Rect := ClientRect;
if (Parent is TJvDockTabHostForm) and (VisibleDockClientCount = 1) then
Exit;
case TabPosition of
tpTop:
Inc(Rect.Top, Panel.FTabHeight - 1);
tpBottom:
Dec(Rect.Bottom, Panel.FTabHeight - 1);
tpLeft:
Inc(Rect.Left, Panel.FTabHeight - 1);
tpRight:
Dec(Rect.Right, Panel.FTabHeight - 1);
end;
end;
procedure TJvDockVIDTabPageControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
end;
procedure TJvDockVIDTabPageControl.DrawTab(TabIndex: Integer;
const Rect: TRect; Active: Boolean);
begin
inherited DrawTab(TabIndex, Rect, Active);
end;
function TJvDockVIDTabPageControl.GetActiveFont: TFont;
begin
Result := FPanel.FActiveFont;
end;
function TJvDockVIDTabPageControl.GetActiveSheetColor: TColor;
begin
Result := FPanel.FActiveSheetColor;
end;
function TJvDockVIDTabPageControl.GetInactiveFont: TFont;
begin
Result := FPanel.FInactiveFont;
end;
function TJvDockVIDTabPageControl.GetInactiveSheetColor: TColor;
begin
Result := FPanel.Color;
end;
function TJvDockVIDTabPageControl.GetTabBottomOffset: Integer;
begin
Result := FPanel.TabBottomOffset;
end;
function TJvDockVIDTabPageControl.GetTabLeftOffset: Integer;
begin
Result := FPanel.TabLeftOffset;
end;
function TJvDockVIDTabPageControl.GetTabRightOffset: Integer;
begin
Result := FPanel.TabRightOffset;
end;
function TJvDockVIDTabPageControl.GetTabTopOffset: Integer;
begin
Result := FPanel.TabTopOffset;
end;
procedure TJvDockVIDTabPageControl.Paint;
begin
inherited Paint;
end;
procedure TJvDockVIDTabPageControl.Resize;
begin
inherited Resize;
if FPanel = nil then
Exit;
case TabPosition of
tpLeft:
begin
FPanel.Left := 0;
FPanel.Width := Panel.FTabHeight;
FPanel.Top := 0;
FPanel.Height := Height;
end;
tpRight:
begin
FPanel.Left := Width - Panel.FTabHeight;
FPanel.Top := 0;
FPanel.Width := Panel.FTabHeight;
FPanel.Height := Height;
end;
tpTop:
begin
FPanel.Left := 0;
FPanel.Top := 0;
FPanel.Width := Width;
FPanel.Height := Panel.FTabHeight;
end;
tpBottom:
begin
FPanel.Left := 0;
FPanel.Top := Height - Panel.FTabHeight;
FPanel.Width := Width;
FPanel.Height := Panel.FTabHeight;
end;
end;
end;
procedure TJvDockVIDTabPageControl.SetActiveFont(Value: TFont);
begin
FPanel.FActiveFont.Assign(Value);
if ActivePage <> nil then
TJvDockVIDTabSheet(ActivePage).SetSheetSort(ActivePage.Caption);
FPanel.Invalidate;
end;
procedure TJvDockVIDTabPageControl.SetActiveSheetColor(const Value: TColor);
begin
FPanel.FActiveSheetColor := Value;
FPanel.Invalidate;
end;
procedure TJvDockVIDTabPageControl.SetInactiveFont(Value: TFont);
var
I: Integer;
begin
FPanel.FInactiveFont.Assign(Value);
for I := 0 to Count - 1 do
if Pages[I] <> ActivePage then
TJvDockVIDTabSheet(Pages[I]).SetSheetSort(Pages[I].Caption);
FPanel.Invalidate;
end;
procedure TJvDockVIDTabPageControl.SetInactiveSheetColor(const Value: TColor);
begin
if FPanel.Color <> Value then
begin
FPanel.Color := Value;
FPanel.Invalidate;
end;
end;
procedure TJvDockVIDTabPageControl.SetTabBottomOffset(const Value: Integer);
begin
if FPanel.TabBottomOffset <> Value then
begin
FPanel.TabBottomOffset := Value;
FPanel.Invalidate;
end;
end;
procedure TJvDockVIDTabPageControl.SetTabHeight(Value: Smallint);
begin
inherited SetTabHeight(Value);
if Panel.FTabHeight <> Value then
begin
Panel.FTabHeight := Value;
FPanel.Invalidate;
end;
end;
procedure TJvDockVIDTabPageControl.SetTabLeftOffset(const Value: Integer);
begin
if FPanel.TabLeftOffset <> Value then
begin
FPanel.TabLeftOffset := Value;
FPanel.Invalidate;
end;
end;
procedure TJvDockVIDTabPageControl.SetTabPosition(Value: TTabPosition);
begin
Assert(Value in [tpTop, tpBottom], RsEDockCannotSetTabPosition);
inherited SetTabPosition(Value);
Resize;
end;
procedure TJvDockVIDTabPageControl.SetTabRightOffset(const Value: Integer);
begin
if FPanel.TabRightOffset <> Value then
begin
FPanel.TabRightOffset := Value;
FPanel.Invalidate;
end;
end;
procedure TJvDockVIDTabPageControl.SetTabTopOffset(const Value: Integer);
begin
if FPanel.TabTopOffset <> Value then
begin
FPanel.TabTopOffset := Value;
FPanel.Invalidate;
end;
end;
procedure TJvDockVIDTabPageControl.SetActivePage(Page: TJvDockTabSheet);
begin
inherited SetActivePage(Page);
FPanel.Invalidate;
end;
procedure TJvDockVIDTabPageControl.DockDrop(Source: TDragDockObject;
X, Y: Integer);
var
Index: Integer;
NewPage: TJvDockTabSheet;
begin
inherited DockDrop(Source, X, Y);
FPanel.SelectSheet := nil;
if ActivePage <> nil then
ParentForm.Caption := ActivePage.Caption;
if Source.Control is TCustomForm then
begin
if Source.Control.Parent is TJvDockTabSheet then
NewPage := TJvDockTabSheet(Source.Control.Parent)
else
NewPage := nil;
if Source.Control.Visible and Assigned(NewPage) then
ActivePage := NewPage;
if FTabImageList <> nil then
begin
Index := FTabImageList.AddIcon(TForm(Source.Control).Icon);
if (Index <> -1) and Assigned(NewPage) then
NewPage.ImageIndex := Index;
end;
end;
end;
function TJvDockVIDTabPageControl.GetDockClientFromMousePos(MousePos: TPoint): TControl;
var
PageIndex: Integer;
begin
Result := nil;
case TabPosition of
tpTop:
PageIndex := Panel.FindSheetWithPos(MousePos.X, MousePos.Y, 0, Panel.Height - TabBottomOffset);
tpBottom:
PageIndex := Panel.FindSheetWithPos(MousePos.X, MousePos.Y, TabBottomOffset, Panel.Height);
tpLeft:
PageIndex := Panel.FindSheetWithPos(MousePos.Y, MousePos.X, 0, Panel.Height - TabBottomOffset);
tpRight:
PageIndex := Panel.FindSheetWithPos(MousePos.Y, MousePos.X, TabBottomOffset, Panel.Height);
else
PageIndex := -1;
end;
if PageIndex >= 0 then
begin
Result := Pages[PageIndex].Controls[0];
if Result.HostDockSite <> Self then
Result := nil;
end;
end;
procedure TJvDockVIDTabPageControl.CustomGetDockEdge(Source: TJvDockDragDockObject;
MousePos: TPoint; var DropAlign: TAlign);
var
ARect: TRect;
begin
DropAlign := ComputeVIDDockingRect(Self, Source.Control, ARect, MousePos);
end;
function TJvDockVIDTabPageControl.GetVisibleSheetCount: Integer;
var
I: Integer;
begin
Result := 0;
for I := 0 to Count - 1 do
if Pages[I].TabVisible then
Inc(Result);
end;
procedure TJvDockVIDTabPageControl.UpdateCaption(Exclude: TControl);
begin
ParentForm.Caption := ActivePage.Caption;
if Parent <> nil then
begin
Parent.Invalidate;
if Parent.HostDockSite <> nil then
Parent.HostDockSite.Invalidate;
end;
end;
procedure TJvDockVIDTabPageControl.SetHotTrack(Value: Boolean);
begin
inherited SetHotTrack(Value);
end;
procedure TJvDockVIDTabPageControl.SetImages(Value: TCustomImageList);
begin
inherited SetImages(Value);
if Panel <> nil then
begin
Panel.ShowTabImages := Value <> nil;
Panel.Invalidate;
end;
end;
function TJvDockVIDTabPageControl.GetHotTrackColor: TColor;
begin
Result := Panel.FHotTrackColor;
end;
procedure TJvDockVIDTabPageControl.SetHotTrackColor(const Value: TColor);
begin
if Panel.FHotTrackColor <> Value then
begin
Panel.FHotTrackColor := Value;
Panel.Invalidate;
end;
end;
function TJvDockVIDTabPageControl.GetShowTabImages: Boolean;
begin
Result := FPanel.FShowTabImages;
end;
procedure TJvDockVIDTabPageControl.SetShowTabImages(const Value: Boolean);
begin
FPanel.ShowTabImages := Value;
end;
function TJvDockVIDTabPageControl.CustomUnDock(Source: TJvDockDragDockObject;
NewTarget: TWinControl; Client: TControl): Boolean;
var
CurrPage: TJvDockTabSheet;
I: Integer;
begin
if not ((Source.Control.HostDockSite <> nil) and
(Source.DropOnControl = Source.Control.HostDockSite.Parent) and
(Source.DropAlign = alClient)) then
begin
CurrPage := GetPageFromDockClient(Client);
if CurrPage <> nil then
begin
//if (FTabImageList <> nil) and ShowTabImages and
// (FTabImageList.Count > CurrPage.ImageIndex) then
//prevent AV
if Assigned(FTabImageList) then
if ShowTabImages and
(FTabImageList.Count > CurrPage.ImageIndex) and
(CurrPage.ImageIndex >= 0) then
begin
FTabImageList.Delete(CurrPage.ImageIndex);
for I := 0 to Count - 1 do
if Pages[I].ImageIndex > CurrPage.ImageIndex then
Pages[I].ImageIndex := Pages[I].ImageIndex - 1;
end;
end;
Result := inherited CustomUnDock(Source, NewTarget, Client);
end
else
Result := True;
end;
function TJvDockVIDTabPageControl.GetPage(Index: Integer): TJvDockVIDTabSheet;
begin
Result := TJvDockVIDTabSheet(inherited Pages[Index]);
end;
function TJvDockVIDTabPageControl.GetActiveVIDPage: TJvDockVIDTabSheet;
begin
Result := TJvDockVIDTabSheet(inherited ActivePage);
end;
procedure TJvDockVIDTabPageControl.SetActiveVIDPage(const Value: TJvDockVIDTabSheet);
begin
ActivePage := Value;
end;
procedure TJvDockVIDTabPageControl.SyncWithStyle;
var
VIDTabServerOption: TJvDockVIDTabServerOption;
begin
inherited SyncWithStyle;
// panel must be created
if FPanel = nil then
Exit;
if DockStyle.TabServerOption is TJvDockVIDTabServerOption then
begin
VIDTabServerOption := TJvDockVIDTabServerOption(DockStyle.TabServerOption);
ActiveFont := VIDTabServerOption.ActiveFont;
ActiveSheetColor := VIDTabServerOption.ActiveSheetColor;
HotTrackColor := VIDTabServerOption.HotTrackColor;
InactiveFont := VIDTabServerOption.InactiveFont;
InactiveSheetColor := VIDTabServerOption.InactiveSheetColor;
ShowTabImages := VIDTabServerOption.ShowTabImages;
TabPosition := VIDTabServerOption.TabPosition;
end;
end;
//=== { TJvDockTabPanel } ====================================================
constructor TJvDockTabPanel.Create(AOwner: TComponent);
begin
{$IFDEF JVDOCK_DEBUG}
OutputDebugString('JvDockVIDStyle.pas: TJvDockTabPanel.Create');
{$ENDIF JVDOCK_DEBUG}
inherited Create(AOwner);
Page := nil;
FCaptionTopOffset := 0;
FCaptionLeftOffset := 5;
FCaptionRightOffset := 5;
FTabBottomOffset := 3;
FTabSplitterWidth := 3;
FTabHeight := 22;
FSortList := TList.Create;
FActiveFont := TFont.Create;
FActiveFont.Color := clBlack;
FInactiveFont := TFont.Create;
FInactiveFont.Color := clWhite;
FHotTrackColor := clBlue;
FTempPages := TList.Create;
FSelectHotIndex := -1;
FShowTabImages := False;
FSelectSheet := nil;
end;
destructor TJvDockTabPanel.Destroy;
begin
FActiveFont.Free;
FInactiveFont.Free;
FSortList.Free;
FTempPages.Free;
inherited Destroy;
end;
procedure TJvDockTabPanel.DeleteSorts(Sheet: TJvDockVIDTabSheet);
var
SheetIndex: Integer;
begin
SheetIndex := FSortList.IndexOf(Sheet);
if SheetIndex >= 0 then
FSortList.Delete(SheetIndex);
if Sheet <> nil then
Sheet.TabVisible := False;
SetShowTabWidth;
Page.Invalidate;
end;
function TJvDockTabPanel.FindSheetWithPos(cX, cY, cTopOffset, cBottomOffset: Integer): Integer;
var
I: Integer;
CompleteWidth, CurrTabWidth: Integer;
Pages: TList;
begin
Result := -1;
if (cY > cBottomOffset) or (cY < cTopOffset) then
Exit;
CompleteWidth := 0;
if FSelectSheet = nil then
Pages := Page.PageSheets
else
Pages := FTempPages;
for I := 0 to Pages.Count - 1 do
begin
if not TJvDockVIDTabSheet(Pages[I]).TabVisible then
Continue;
CurrTabWidth := TJvDockVIDTabSheet(Pages[I]).ShowTabWidth;
if (cX >= FTabLeftOffset + CompleteWidth) and (cX <= FTabLeftOffset + CurrTabWidth + CompleteWidth +
FTabSplitterWidth) then
begin
Result := I;
Exit;
end;
Inc(CompleteWidth, CurrTabWidth + FTabSplitterWidth);
end;
end;
function TJvDockTabPanel.GetPageIndexFromMousePos(X, Y: Integer): Integer;
begin
Result := -1;
case Page.TabPosition of
tpTop:
Result := FindSheetWithPos(X, Y, 0, Height - TabBottomOffset);
tpBottom:
Result := FindSheetWithPos(X, Y, TabBottomOffset, Height);
tpLeft:
Result := FindSheetWithPos(Y, X, 0, Height - TabBottomOffset);
tpRight:
Result := FindSheetWithPos(Y, X, TabBottomOffset, Height);
end;
end;
function TJvDockTabPanel.GetMaxTabWidth: TJvDockTabSheet;
var
I: Integer;
MaxWidth, CurrWidth: Integer;
begin
Result := nil;
MaxWidth := 0;
if Page = nil then
Exit;
for I := 0 to Page.Count - 1 do
begin
CurrWidth := Canvas.TextWidth(Page.Tabs[I]);
if MaxWidth < CurrWidth then
begin
Result := Page.Pages[I];
MaxWidth := CurrWidth;
end;
end;
end;
function TJvDockTabPanel.GetMinTabWidth: TJvDockTabSheet;
var
I: Integer;
MinWidth, CurrWidth: Integer;
begin
Result := nil;
MinWidth := 0;
for I := 0 to Page.Count - 1 do
begin
CurrWidth := Canvas.TextWidth(Page.Tabs[I]);
if MinWidth > CurrWidth then
begin
Result := Page.Pages[I];
MinWidth := CurrWidth;
end;
end;
end;
function TJvDockTabPanel.GetPanelHeight: Integer;
begin
case Page.TabPosition of
tpLeft, tpRight:
Result := Width;
tpTop, tpBottom:
Result := Height;
else
Result := 0;
end;
end;
function TJvDockTabPanel.GetPanelWidth: Integer;
begin
case Page.TabPosition of
tpLeft, tpRight:
Result := Height;
tpTop, tpBottom:
Result := Width;
else
Result := 0;
end;
end;
function TJvDockTabPanel.GetSorts(Index: Integer): TJvDockVIDTabSheet;
begin
Result := FSortList[Index];
end;
function TJvDockTabPanel.GetTotalTabWidth: Integer;
var
I: Integer;
begin
Result := 0;
if FSortList = nil then
Exit;
for I := 0 to FSortList.Count - 1 do
Inc(Result, Sorts[I].TabWidth + Integer(I <> FSortList.Count - 1) * FTabSplitterWidth);
end;
procedure TJvDockTabPanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
Ctrl: TControl;
Index: Integer;
Msg: TWMMouse;
Sheet: TJvDockVIDTabSheet;
AParentForm: TCustomForm;
begin
inherited MouseDown(Button, Shift, X, Y);
if Page = nil then
Exit;
Index := GetPageIndexFromMousePos(X, Y);
if Index >= 0 then
begin
if Index <> Page.ActivePageIndex then
begin
if Assigned(Page.ActivePage) and Page.ActivePage.CanFocus then
begin
AParentForm := GetParentForm(Page);
if Assigned(AParentForm) then
AParentForm.ActiveControl := Page.ActivePage;
end;
Sheet := Page.ActiveVIDPage;
Page.ActivePageIndex := Index;
Sheet.SetSheetSort(Sheet.Caption);
Page.ActiveVIDPage.SetSheetSort(Page.ActiveVIDPage.Caption);
Page.Change;
Invalidate;
end;
if Button = mbLeft then
begin
FSelectSheet := TJvDockVIDTabSheet(Page.ActivePage);
{$IFDEF COMPILER6_UP}
FTempPages.Assign(Page.PageSheets);
{$ELSE}
AssignList(Page.PageSheets, FTempPages);
{$ENDIF COMPILER6_UP}
end;
Ctrl := GetDockClientFromPageIndex(Index);
if Ctrl <> nil then
begin
JvGlobalDockClient := FindDockClient(Ctrl);
if JvGlobalDockClient <> nil then
begin
Msg.Msg := WM_NCLBUTTONDOWN + Integer(Button) * 3 + Integer(ssDouble in Shift) * 2;
Msg.Pos.x := X;
Msg.Pos.y := Y;
if not (ssDouble in Shift) then
JvGlobalDockClient.DoNCButtonDown(Page.DoMouseEvent(Msg, Page), Button, msTabPage)
else
begin
JvGlobalDockClient.DoNCButtonDblClk(Page.DoMouseEvent(Msg, Page), Button, msTabPage);
if (Button = mbLeft) and JvGlobalDockClient.CanFloat then
Ctrl.ManualDock(nil, nil, alNone);
end;
end;
end;
end;
end;
procedure TJvDockTabPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
Index: Integer;
Ctrl: TControl;
ARect: TRect;
begin
inherited MouseMove(Shift, X, Y);
Index := GetPageIndexFromMousePos(X, Y);
if Page.HotTrack and (Index <> FSelectHotIndex) then
begin
FSelectHotIndex := Index;
Invalidate;
end;
if Assigned(FSelectSheet) then
begin
Index := GetPageIndexFromMousePos(X, Y);
if Index >= 0 then
begin
if (Index <> Page.ActivePageIndex) and (Page.Count > Index) then
begin
FSelectSheet.PageIndex := Index;
Invalidate;
end;
end
else
begin
case Page.TabPosition of
tpTop:
ARect := Rect(0, 0, Width, Height - FTabBottomOffset);
tpBottom:
ARect := Rect(0, FTabBottomOffset, Width, Height);
tpLeft:
ARect := Rect(0, 0, Width - FTabBottomOffset, Height);
tpRight:
ARect := Rect(FTabBottomOffset, 0, Width, Height);
else
ARect := Rect(0, 0, 0, 0);
end;
if PtInRect(ARect, Point(X, Y)) then
Exit;
if Page.FTempSheet = nil then
begin
Ctrl := GetDockClientFromPageIndex(FSelectSheet.PageIndex);
if Ctrl <> nil then
JvGlobalDockManager.BeginDrag(Ctrl, False, 1);
end;
end;
end;
end;
procedure TJvDockTabPanel.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
Ctrl: TControl;
Index: Integer;
Msg: TWMMouse;
begin
{$IFDEF JVDOCK_DEBUG}
OutputDebugString('JvDockVIDStyle.pas: TJvDockTabPanel.MouseUp');
{$ENDIF JVDOCK_DEBUG}
inherited MouseUp(Button, Shift, X, Y);
FSelectSheet := nil;
if Page = nil then
Exit;
Index := GetPageIndexFromMousePos(X, Y);
Ctrl := GetDockClientFromPageIndex(Index);
if Ctrl <> nil then
begin
JvGlobalDockClient := FindDockClient(Ctrl);
if JvGlobalDockClient <> nil then
begin
Msg.Msg := WM_NCLBUTTONUP + Integer(Button) * 3 + Integer(ssDouble in Shift) * 2;
Msg.Pos := PointToSmallPoint(Page.ScreenToClient(ClientToScreen(Point(X, Y))));
if not (ssDouble in Shift) then
JvGlobalDockClient.DoNCButtonUp(Page.DoMouseEvent(Msg, Page), Button, msTabPage);
end;
end;
end;
{ TJvDockTabPanel.Paint,etc.
TODO-LIST-ITEM:
---------------
VID style has a bit of a problem with what to do in
case of a lot of tabs. It keeps making the text shorter via
text drawn with ellipsis but doesn't EVER display the left/right
buttons that allow you to scroll through a long list of tabs.
To fix this is non-trivial. -WPostma.
}
procedure TJvDockTabPanel.Paint;
var
ARect: TRect;
CurrTabWidth: Integer;
I, CompleteWidth: Integer;
ImageWidth: Integer;
CaptionString: string;
begin
inherited Paint;
if Page = nil then
Exit;
if (Page.Images <> nil) and (Page.ShowTabImages) then
ImageWidth := Page.Images.Width
else
ImageWidth := 0;
Canvas.Brush.Color := Page.ActiveSheetColor;
case Page.TabPosition of
tpLeft:
Canvas.FillRect(Rect(PanelHeight - FTabBottomOffset, 0, PanelHeight, PanelWidth));
tpRight:
Canvas.FillRect(Rect(0, 0, FTabBottomOffset, PanelWidth));
tpTop:
Canvas.FillRect(Rect(0, PanelHeight - FTabBottomOffset, PanelWidth, PanelHeight));
tpBottom:
Canvas.FillRect(Rect(0, 0, PanelWidth, FTabBottomOffset));
end;
case Page.TabPosition of
tpTop, tpLeft:
Canvas.Pen.Color := clWhite;
tpBottom, tpRight:
Canvas.Pen.Color := clBlack;
end;
case Page.TabPosition of
tpLeft:
begin
Canvas.MoveTo(PanelHeight - FTabBottomOffset, 0);
Canvas.LineTo(PanelHeight - FTabBottomOffset, PanelWidth);
end;
tpRight:
begin
Canvas.MoveTo(FTabBottomOffset, 0);
Canvas.LineTo(FTabBottomOffset, PanelWidth);
end;
tpTop:
begin
Canvas.MoveTo(0, PanelHeight - FTabBottomOffset);
Canvas.LineTo(PanelWidth, PanelHeight - FTabBottomOffset);
end;
tpBottom:
begin
Canvas.MoveTo(0, FTabBottomOffset);
Canvas.LineTo(PanelWidth, FTabBottomOffset);
end;
end;
CompleteWidth := 0;
Canvas.Brush.Style := bsClear;
for I := 0 to Page.Count - 1 do
begin
if not Page.Pages[I].TabVisible then
Continue;
CurrTabWidth := TJvDockVIDTabSheet(Page.Pages[I]).ShowTabWidth;
if Page.ActivePageIndex = I then
begin
Canvas.Brush.Color := Page.ActiveSheetColor;
case Page.TabPosition of
tpLeft:
Canvas.FillRect(Rect(FTabTopOffset, CompleteWidth + FTabLeftOffset,
PanelHeight, CompleteWidth + FTabLeftOffset + CurrTabWidth));
tpRight:
Canvas.FillRect(Rect(FTabBottomOffset, CompleteWidth + FTabLeftOffset,
PanelHeight - FTabTopOffset, CompleteWidth + FTabLeftOffset + CurrTabWidth));
tpTop:
Canvas.FillRect(Rect(CompleteWidth + FTabLeftOffset, FTabTopOffset,
CompleteWidth + FTabLeftOffset + CurrTabWidth, PanelHeight));
tpBottom:
Canvas.FillRect(Rect(CompleteWidth + FTabLeftOffset, FTabBottomOffset,
CompleteWidth + FTabLeftOffset + CurrTabWidth, PanelHeight - FTabTopOffset));
end;
Canvas.Pen.Color := clWhite;
case Page.TabPosition of
tpLeft:
begin
Canvas.MoveTo(PanelHeight - FTabBottomOffset, CompleteWidth + FTabLeftOffset);
Canvas.LineTo(FTabTopOffset, CompleteWidth + FTabLeftOffset);
Canvas.LineTo(FTabTopOffset, CompleteWidth + FTabLeftOffset + CurrTabWidth);
Canvas.Pen.Color := clBlack;
Canvas.LineTo(PanelHeight - FTabBottomOffset, CompleteWidth + FTabLeftOffset + CurrTabWidth);
end;
tpRight:
begin
Canvas.MoveTo(FTabTopOffset, CompleteWidth + FTabLeftOffset);
Canvas.LineTo(PanelHeight - FTabBottomOffset, CompleteWidth + FTabLeftOffset);
Canvas.Pen.Color := clBlack;
Canvas.LineTo(PanelHeight - FTabBottomOffset, CompleteWidth + FTabLeftOffset + CurrTabWidth);
Canvas.LineTo(FTabTopOffset, CompleteWidth + FTabLeftOffset + CurrTabWidth);
end;
tpTop:
begin
Canvas.MoveTo(CompleteWidth + FTabLeftOffset, PanelHeight - FTabBottomOffset);
Canvas.LineTo(CompleteWidth + FTabLeftOffset, FTabTopOffset);
Canvas.LineTo(CompleteWidth + FTabLeftOffset + CurrTabWidth, FTabTopOffset);
Canvas.Pen.Color := clBlack;
Canvas.LineTo(CompleteWidth + FTabLeftOffset + CurrTabWidth, PanelHeight - FTabTopOffset);
end;
tpBottom:
begin
Canvas.MoveTo(CompleteWidth + FTabLeftOffset, FTabBottomOffset);
Canvas.LineTo(CompleteWidth + FTabLeftOffset, PanelHeight - FTabTopOffset);
Canvas.Pen.Color := clBlack;
Canvas.LineTo(CompleteWidth + FTabLeftOffset + CurrTabWidth, PanelHeight - FTabTopOffset);
Canvas.LineTo(CompleteWidth + FTabLeftOffset + CurrTabWidth, FTabBottomOffset);
end;
end;
Canvas.Font.Assign(FActiveFont);
end
else
begin
if (I < Page.ActivePageIndex - 1) or (I > Page.ActivePageIndex) then
begin
Canvas.Pen.Color := Page.InactiveFont.Color;
case Page.TabPosition of
tpLeft, tpRight:
begin
Canvas.MoveTo(PanelHeight - FTabBottomOffset - 3, CompleteWidth + FTabLeftOffset + CurrTabWidth);
Canvas.LineTo(FTabTopOffset + 2, CompleteWidth + FTabLeftOffset + CurrTabWidth);
end;
tpTop, tpBottom:
begin
Canvas.MoveTo(CompleteWidth + FTabLeftOffset + CurrTabWidth, PanelHeight - FTabBottomOffset - 3);
Canvas.LineTo(CompleteWidth + FTabLeftOffset + CurrTabWidth, FTabTopOffset + 2);
end;
end;
end;
Canvas.Brush.Color := Page.InactiveSheetColor;
Canvas.Font.Assign(FInactiveFont);
end;
if FSelectHotIndex = I then
Canvas.Font.Color := FHotTrackColor;
case Page.TabPosition of
tpLeft:
ARect := Rect(FTabTopOffset + FCaptionTopOffset + 1,
CompleteWidth + FTabLeftOffset + FCaptionLeftOffset,
PanelHeight,
CompleteWidth + FTabLeftOffset + CurrTabWidth - FCaptionRightOffset);
tpRight:
ARect := Rect(FTabBottomOffset + FCaptionTopOffset + 1,
CompleteWidth + FTabLeftOffset + FCaptionLeftOffset,
PanelHeight,
CompleteWidth + FTabLeftOffset + CurrTabWidth - FCaptionRightOffset);
tpTop:
ARect := Rect(CompleteWidth + FTabLeftOffset + FCaptionLeftOffset +
Integer(FShowTabImages) * (ImageWidth + FCaptionLeftOffset),
FTabTopOffset + FCaptionTopOffset + 1,
CompleteWidth + FTabLeftOffset + CurrTabWidth - FCaptionRightOffset,
PanelHeight);
tpBottom:
ARect := Rect(CompleteWidth + FTabLeftOffset + FCaptionLeftOffset +
Integer(FShowTabImages) * (ImageWidth + FCaptionLeftOffset),
FTabBottomOffset + FCaptionTopOffset + 1,
CompleteWidth + FTabLeftOffset + CurrTabWidth - FCaptionRightOffset,
PanelHeight);
end;
CaptionString := Page.Pages[I].Caption;
DrawText(Canvas.Handle, PChar(CaptionString), Length(CaptionString),
ARect, DT_LEFT or DT_SINGLELINE or DT_END_ELLIPSIS);
if FShowTabImages and (Page.Images <> nil) and (CurrTabWidth > ImageWidth + 2 * FCaptionLeftOffset) then
Page.Images.Draw(Canvas, CompleteWidth + FTabLeftOffset + FCaptionLeftOffset,
FTabBottomOffset + FCaptionTopOffset + 1, Page.Pages[I].ImageIndex, True);
Inc(CompleteWidth, CurrTabWidth + FTabSplitterWidth);
end;
Canvas.Brush.Color := Page.ActiveSheetColor;
ARect := ClientRect;
Canvas.FrameRect(ARect);
end;
procedure TJvDockTabPanel.Resize;
begin
inherited Resize;
SetShowTabWidth;
end;
procedure TJvDockTabPanel.SetCaptionLeftOffset(const Value: Integer);
begin
if FCaptionLeftOffset <> Value then
begin
FCaptionLeftOffset := Value;
Invalidate;
end;
end;
procedure TJvDockTabPanel.SetCaptionRightOffset(const Value: Integer);
begin
if FCaptionRightOffset <> Value then
begin
FCaptionRightOffset := Value;
Invalidate;
end;
end;
procedure TJvDockTabPanel.SetCaptionTopOffset(const Value: Integer);
begin
if FCaptionTopOffset <> Value then
begin
FCaptionTopOffset := Value;
Invalidate;
end;
end;
procedure TJvDockTabPanel.SetPage(const Value: TJvDockVIDTabPageControl);
begin
FPage := Value;
end;
procedure TJvDockTabPanel.SetPanelHeight(const Value: Integer);
begin
if PanelHeight <> Value then
begin
case Page.TabPosition of
tpLeft, tpRight:
Width := Value;
tpTop, tpBottom:
Height := Value;
end;
SetShowTabWidth;
end;
end;
procedure TJvDockTabPanel.SetTabBottomOffset(const Value: Integer);
begin
if FTabBottomOffset <> Value then
begin
FTabBottomOffset := Value;
Invalidate;
end;
end;
procedure TJvDockTabPanel.SetTabLeftOffset(const Value: Integer);
begin
if FTabLeftOffset <> Value then
begin
FTabLeftOffset := Value;
Invalidate;
end;
end;
procedure TJvDockTabPanel.SetTabRightOffset(const Value: Integer);
begin
if FTabRightOffset <> Value then
begin
FTabRightOffset := Value;
Invalidate;
end;
end;
procedure TJvDockTabPanel.SetTabSplitterWidth(const Value: Integer);
begin
if FTabSplitterWidth <> Value then
begin
FTabSplitterWidth := Value;
Invalidate;
end;
end;
procedure TJvDockTabPanel.SetTabTopOffset(const Value: Integer);
begin
if FTabTopOffset <> Value then
begin
FTabTopOffset := Value;
Invalidate;
end;
end;
procedure TJvDockTabPanel.SetTotalTabWidth(const Value: Integer);
begin
end;
function TJvDockTabPanel.GetDockClientFromPageIndex(Index: Integer): TControl;
begin
Result := nil;
if Index >= 0 then
if Page.Pages[Index].ControlCount = 1 then
begin
Result := Page.Pages[Index].Controls[0];
if Result.HostDockSite <> Page then
Result := nil;
end;
end;
procedure TJvDockTabPanel.SetShowTabWidth;
var
I, J, TempWidth: Integer;
PanelWidth, VisibleCount: Integer;
ImageWidth: Integer;
begin
if Page = nil then
Exit;
if FSortList = nil then
Exit;
PanelWidth := 0;
case Page.TabPosition of
tpTop, tpBottom:
PanelWidth := Width;
tpLeft, tpRight:
PanelWidth := Height;
end;
TempWidth := PanelWidth - FCaptionLeftOffset - FCaptionRightOffset;
if Page.ShowTabImages then
ImageWidth := Page.Images.Width + FCaptionLeftOffset
else
ImageWidth := 0;
VisibleCount := Page.VisibleSheetCount;
J := 0;
for I := 0 to FSortList.Count - 1 do
begin
if not Sorts[I].TabVisible then
Continue;
if (VisibleCount - J) * (Sorts[I].TabWidth + FTabSplitterWidth + ImageWidth) > TempWidth then
Sorts[I].FShowTabWidth := TempWidth div (VisibleCount - J) - FTabSplitterWidth
else
Sorts[I].FShowTabWidth := Sorts[I].TabWidth + ImageWidth;
Dec(TempWidth, Sorts[I].FShowTabWidth + FTabSplitterWidth);
Inc(J);
end;
end;
procedure TJvDockTabPanel.CMMouseLeave(var Msg: TMessage);
begin
inherited;
if FSelectHotIndex <> -1 then
begin
FSelectHotIndex := -1;
Invalidate;
end;
end;
procedure TJvDockTabPanel.SetShowTabImages(const Value: Boolean);
begin
if FShowTabImages <> Value then
begin
FShowTabImages := Value;
SetShowTabWidth;
Invalidate;
end;
end;
procedure TJvDockTabPanel.SetTabHeight(const Value: Integer);
begin
FTabHeight := Value;
Height := FTabHeight + FTabTopOffset + FTabBottomOffset;
end;
//=== { TJvDockVIDTabSheet } =================================================
constructor TJvDockVIDTabSheet.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIsSourceDockClient := False;
end;
destructor TJvDockVIDTabSheet.Destroy;
begin
if (PageControl is TJvDockVIDTabPageControl) and (PageControl <> nil) then
TJvDockVIDTabPageControl(PageControl).Panel.DeleteSorts(Self);
inherited Destroy;
end;
procedure TJvDockVIDTabSheet.Loaded;
begin
inherited Loaded;
SetSheetSort(Caption);
end;
procedure TJvDockVIDTabSheet.SetPageControl(APageControl: TJvDockPageControl);
begin
inherited SetPageControl(APageControl);
end;
procedure TJvDockVIDTabSheet.SetSheetSort(const CaptionStr: string);
var
TabPanel: TJvDockTabPanel;
TempWidth: Integer;
procedure DoSetSheetSort;
var
I: Integer;
begin
TJvDockVIDTabPageControl(PageControl).Panel.FSortList.Remove(Self);
for I := 0 to TJvDockVIDTabPageControl(PageControl).Panel.FSortList.Count - 1 do
if TJvDockVIDTabPageControl(PageControl).Panel.Sorts[I].TabWidth > TempWidth then
begin
TJvDockVIDTabPageControl(PageControl).Panel.FSortList.Insert(I, Self);
Exit;
end;
TJvDockVIDTabPageControl(PageControl).Panel.FSortList.Add(Self);
end;
begin
if (PageControl is TJvDockVIDTabPageControl) and (PageControl <> nil) then
begin
TabPanel := TJvDockVIDTabPageControl(PageControl).Panel;
if PageControl.ActivePage = Self then
TabPanel.Canvas.Font.Assign(TabPanel.Page.ActiveFont)
else
TabPanel.Canvas.Font.Assign(TabPanel.Page.InactiveFont);
TempWidth := TabPanel.Canvas.TextWidth(
CaptionStr) + TabPanel.CaptionLeftOffset + TabPanel.CaptionRightOffset;
if TempWidth <> FTabWidth then
begin
DoSetSheetSort;
FTabWidth := TempWidth;
TabPanel.SetShowTabWidth;
TabPanel.Invalidate;
end;
end;
end;
procedure TJvDockVIDTabSheet.SetTabWidth(const Value: Integer);
begin
FTabWidth := Value;
end;
procedure TJvDockVIDTabSheet.UpdateTabShowing;
begin
inherited UpdateTabShowing;
TJvDockVIDTabPageControl(PageControl).Panel.SetShowTabWidth;
end;
procedure TJvDockVIDTabSheet.WMSetText(var Msg: TMessage);
begin
inherited;
SetSheetSort(PChar(Msg.LParam));
end;
{$IFNDEF USEJVCL}
function TJvDockVIDStyle.GetControlName: string;
begin
Result := Format(RsDockLikeVIDStyle, [inherited GetControlName]);
end;
{$ENDIF !USEJVCL}
//=== { TJvDockVIDDragDockObject } ===========================================
constructor TJvDockVIDDragDockObject.Create(AControl: TControl);
procedure DoGetSourceDockClients(Control: TControl);
var
I: Integer;
DockableControl: TWinControl;
begin
if Control is TJvDockableForm then
begin
DockableControl := TJvDockableForm(Control).DockableControl;
for I := 0 to DockableControl.DockClientCount - 1 do
DoGetSourceDockClients(DockableControl.DockClients[I]);
end
else
FSourceDockClientList.Add(Control);
end;
begin
inherited Create(AControl);
FSourceDockClientList := TList.Create;
DoGetSourceDockClients(AControl);
FDropTabControl := nil;
FIsTabDockOver := False;
CurrState := dsDragEnter;
OldState := CurrState;
end;
destructor TJvDockVIDDragDockObject.Destroy;
begin
FDropTabControl := nil;
FSourceDockClientList.Free;
inherited Destroy;
end;
procedure TJvDockVIDDragDockObject.GetBrush_PenSize_DrawRect(var ABrush: TBrush;
var PenSize: Integer; var DrawRect: TRect; Erase: Boolean);
begin
if DragTarget = nil then
DropAlign := alNone;
inherited GetBrush_PenSize_DrawRect(ABrush, PenSize, DrawRect, Erase);
FIsTabDockOver := ((FOldDropAlign = alClient) and FErase) or
((DropAlign = alClient) and not FErase);
FOldDropAlign := DropAlign;
FOldTarget := DragTarget;
end;
// (rom) unused writeable const option removed
procedure TJvDockVIDDragDockObject.DefaultDockImage(Erase: Boolean);
const
LeftOffset = 4;
var
DesktopWindow: HWND;
DC: HDC;
OldBrush: HBrush;
DrawRect: TRect;
PenSize: Integer;
ABrush: TBrush;
ButtomOffset: Integer;
MaxTabWidth: Integer;
procedure DoDrawDefaultImage;
begin
with DrawRect do
begin
PatBlt(DC, Left + PenSize, Top, Right - Left - PenSize, PenSize, PATINVERT);
PatBlt(DC, Right - PenSize, Top + PenSize, PenSize, Bottom - Top - PenSize, PATINVERT);
PatBlt(DC, Left, Bottom - PenSize, Right - Left - PenSize, PenSize, PATINVERT);
PatBlt(DC, Left, Top, PenSize, Bottom - Top - PenSize, PATINVERT);
end;
end;
procedure DoDrawTabImage;
begin
with DrawRect do
begin
ButtomOffset := 15;
MaxTabWidth := 30;
PatBlt(DC, Left + PenSize, Top, Right - Left - PenSize, PenSize, PATINVERT);
PatBlt(DC, Right - PenSize, Top + PenSize, PenSize, Bottom - Top - 2 * PenSize - ButtomOffset, PATINVERT);
if DrawRect.Right - DrawRect.Left - 2 * PenSize < LeftOffset + 2 * PenSize + 2 * MaxTabWidth then
MaxTabWidth := (DrawRect.Right - DrawRect.Left - 4 * PenSize - LeftOffset) div 2;
if DrawRect.Bottom - DrawRect.Top - 2 * PenSize < 2 * ButtomOffset then
ButtomOffset := Max((DrawRect.Bottom - DrawRect.Top - 2 * PenSize) div 2, 0);
PatBlt(DC, Left, Bottom - PenSize - ButtomOffset, 2 * PenSize + LeftOffset, PenSize, PATINVERT);
PatBlt(DC, Left + PenSize + LeftOffset, Bottom - ButtomOffset, PenSize, ButtomOffset, PATINVERT);
PatBlt(DC, Left + 2 * PenSize + LeftOffset, Bottom - PenSize, MaxTabWidth, PenSize, PATINVERT);
PatBlt(DC, Left + 2 * PenSize + LeftOffset + MaxTabWidth, Bottom - PenSize - ButtomOffset, PenSize, PenSize +
ButtomOffset, PATINVERT);
PatBlt(DC, Left + 3 * PenSize + LeftOffset + MaxTabWidth, Bottom - PenSize - ButtomOffset, Right - Left - 3 *
PenSize - LeftOffset - MaxTabWidth, PenSize, PATINVERT);
PatBlt(DC, Left, Top, PenSize, Bottom - Top - PenSize - ButtomOffset, PATINVERT);
end;
end;
begin
FErase := Erase;
GetBrush_PenSize_DrawRect(ABrush, PenSize, DrawRect, Erase);
DesktopWindow := GetDesktopWindow;
DC := GetDCEx(DesktopWindow, 0, DCX_CACHE or DCX_LOCKWINDOWUPDATE);
try
OldBrush := SelectObject(DC, ABrush.Handle);
if not FIsTabDockOver then
DoDrawDefaultImage
else
DoDrawTabImage;
SelectObject(DC, OldBrush);
finally
ReleaseDC(DesktopWindow, DC);
end;
end;
function TJvDockVIDDragDockObject.DragFindWindow(const Pos: TPoint): THandle;
begin
Result := 0;
end;
function TJvDockVIDDragDockObject.GetDropCtl: TControl;
var
ARect: TRect;
I: Integer;
begin
Result := inherited GetDropCtl;
if (Result = nil) and (TargetControl is TJvDockCustomPanel) then
for I := 0 to TargetControl.DockClientCount - 1 do
if TargetControl.DockClients[I].Visible then
begin
ARect := TJvDockCustomPanel(DragTarget).JvDockManager.GetFrameRectEx(TargetControl.DockClients[I]);
if PtInRect(ARect, DragPos) then
begin
Result := TargetControl.DockClients[I];
Exit;
end;
end;
end;
function TJvDockVIDDragDockObject.GetSourceDockClient(Index: Integer): TControl;
begin
Result := TControl(FSourceDockClientList[Index]);
end;
function TJvDockVIDDragDockObject.GetSourceDockClientCount: Integer;
begin
Result := FSourceDockClientList.Count;
end;
procedure TJvDockVIDDragDockObject.MouseMsg(var Msg: TMessage);
var
APos: TPoint;
Page: TJvDockVIDTabPageControl;
begin
inherited MouseMsg(Msg);
// Warren added assertions:
Assert(Assigned(JvGlobalDockClient));
Assert(Assigned(JvGlobalDockManager));
case Msg.Msg of
WM_CAPTURECHANGED:
begin
// Warren added Assertions:
Assert(Assigned(JvGlobalDockClient.ParentForm));
// Assert(Assigned(JvGlobalDockClient.ParentForm.HostDockSite));
if Assigned( JvGlobalDockClient.ParentForm.HostDockSite) and
(JvGlobalDockClient.ParentForm.HostDockSite is TJvDockVIDTabPageControl) then
TJvDockVIDTabPageControl(JvGlobalDockClient.ParentForm.HostDockSite).Panel.MouseUp(mbLeft, [], 0, 0)
else
if TWinControl(JvGlobalDockManager.DragObject.DragTarget) is TJvDockVIDTabPageControl then
TJvDockVIDTabPageControl(JvGlobalDockManager.DragObject.TargetControl).Panel.MouseUp(mbLeft, [], 0, 0);
end;
WM_MOUSEMOVE:
if JvGlobalDockManager.DragObject.TargetControl is TJvDockVIDTabPageControl then
begin
Page := TJvDockVIDTabPageControl(JvGlobalDockManager.DragObject.TargetControl);
if Page.FTempSheet <> nil then
begin
APos := Point(TWMMouse(Msg).XPos, TWMMouse(Msg).YPos);
APos := Page.Panel.ScreenToClient(APos);
Page.Panel.MouseMove([], APos.X, APos.Y);
end;
end;
end;
end;
procedure TJvDockVIDDragDockObject.SetOldState(const Value: TDragState);
begin
FOldState := Value;
end;
procedure TJvDockVIDDragDockObject.SetCurrState(const Value: TDragState);
begin
FCurrState := Value;
end;
function TJvDockVIDDragDockObject.CanLeave(NewTarget: TWinControl): Boolean;
begin
Result := inherited CanLeave(NewTarget);
end;
//=== { TJvDockVIDZone } =====================================================
destructor TJvDockVIDZone.Destroy;
begin
inherited Destroy;
end;
function TJvDockVIDZone.GetSplitterLimit(IsMin: Boolean): Integer;
begin
if IsMin then
Result := ZoneLimit
else
Result := LimitBegin;
end;
procedure TJvDockVIDZone.Insert(DockSize: Integer; Hide: Boolean);
var
PrevShift: Integer;
NextShift: Integer;
TempSize: Integer;
BorderSize: Integer;
BeforeVisibleZone: TJvDockZone;
AfterVisibleZone: TJvDockZone;
BeginSize: Integer;
begin
if (ParentZone <> nil) and (ParentZone.VisibleChildCount = 0) then
ParentZone.Insert(ParentZone.VisibleSize, Hide);
if (ParentZone = nil) or ((ParentZone = Tree.TopZone) and (ParentZone.ChildCount <= 1)) then
begin
Visibled := True;
Exit;
end;
if (ParentZone <> nil) and (ParentZone.ChildZones <> nil) then
BeginSize := ParentZone.ChildZones.LimitBegin
else
BeginSize := 0;
BeforeVisibleZone := BeforeClosestVisibleZone;
AfterVisibleZone := AfterClosestVisibleZone;
BorderSize := TJvDockVIDTree(Tree).BorderWidth * Integer(AfterClosestVisibleZone <> nil) div 2;
TempSize := ParentZone.HeightWidth[ParentZone.Orientation] + BorderSize;
Visibled := False;
if DockSize >= TempSize - (ParentZone.VisibleChildCount) * TJvDockVIDTree(Tree).MinSize then
DockSize := (TempSize - (ParentZone.VisibleChildCount) * TJvDockVIDTree(Tree).MinSize) div 2;
if DockSize < TJvDockVIDTree(Tree).MinSize then
DockSize := TempSize div 2;
if (BeforeVisibleZone = nil) and (AfterVisibleZone = nil) then
begin
PrevShift := 0;
NextShift := 0;
ZoneLimit := TempSize + BeginSize;
end
else
if BeforeVisibleZone = nil then
begin
PrevShift := 0;
NextShift := DockSize + BorderSize;
ZoneLimit := DockSize + LimitBegin + BorderSize;
if ParentZone.VisibleChildCount = 1 then
AfterVisibleZone.ZoneLimit := TempSize + BeginSize;
end
else
if AfterVisibleZone = nil then
begin
PrevShift := DockSize + BorderSize;
NextShift := 0;
if (ParentZone.VisibleChildCount = 1) and (ParentZone = Tree.TopZone) then
BeforeVisibleZone.ZoneLimit := Tree.TopXYLimit - PrevShift
else
BeforeVisibleZone.ZoneLimit := BeforeVisibleZone.ZoneLimit - PrevShift;
ZoneLimit := TempSize + BeginSize;
end
else
begin
PrevShift := Round((BeforeVisibleZone.ZoneLimit - BeginSize) * (DockSize + BorderSize) / TempSize);
NextShift := DockSize - PrevShift;
if (ParentZone.VisibleChildCount = 1) and (ParentZone = Tree.TopZone) then
BeforeVisibleZone.ZoneLimit := Tree.TopXYLimit - PrevShift
else
BeforeVisibleZone.ZoneLimit := BeforeVisibleZone.ZoneLimit - PrevShift;
ZoneLimit := BeforeVisibleZone.ZoneLimit + DockSize;
end;
if PrevShift <> 0 then
begin
with TJvDockVIDTree(Tree) do
begin
ReplacementZone := BeforeVisibleZone;
try
if (BeforeVisibleZone.ZoneLimit - BeginSize) * (BeforeVisibleZone.ZoneLimit - BeginSize + PrevShift) <> 0 then
ScaleBy := (BeforeVisibleZone.ZoneLimit - BeginSize) / (BeforeVisibleZone.ZoneLimit - BeginSize + PrevShift)
else
ScaleBy := 1;
ParentLimit := BeginSize;
ShiftScaleOrientation := ParentZone.Orientation;
if ScaleBy <> 1 then
ForEachAt(ParentZone.ChildZones, ScaleChildZone, tskMiddle, tspChild);
finally
ReplacementZone := nil;
end;
end;
if BeforeVisibleZone.LimitSize < TJvDockVIDTree(Tree).MinSize then
BeforeVisibleZone.ZoneLimit := BeforeVisibleZone.LimitBegin + TJvDockVIDTree(Tree).MinSize;
end;
if NextShift <> 0 then
with TJvDockVIDTree(Tree) do
begin
if (TempSize + BeginSize - LimitBegin - NextShift) * (TempSize + BeginSize - LimitBegin) <> 0 then
ScaleBy := (TempSize + BeginSize - LimitBegin - NextShift) / (TempSize + BeginSize - LimitBegin)
else
ScaleBy := 1;
ParentLimit := TempSize + BeginSize;
ShiftScaleOrientation := ParentZone.Orientation;
if ScaleBy <> 1 then
ForEachAt(AfterVisibleZone, ScaleSiblingZone, tskForward);
end;
Visibled := True;
end;
procedure TJvDockVIDZone.Remove(DockSize: Integer; Hide: Boolean);
var
PrevShift: Integer;
NextShift: Integer;
TempSize: Integer;
BorderSize: Integer;
BeforeVisibleZone: TJvDockZone;
AfterVisibleZone: TJvDockZone;
BeginSize: Integer;
begin
if (ParentZone <> nil) and (ParentZone.VisibleChildCount = 1) and (ParentZone <> Tree.TopZone) then
ParentZone.Remove(ParentZone.LimitSize, Hide);
if (ParentZone = nil) or ((ParentZone = Tree.TopZone) and (ParentZone.ChildCount <= 1)) then
begin
Visibled := False;
Exit;
end;
if (ParentZone <> nil) and (ParentZone.ChildZones <> nil) then
BeginSize := ParentZone.ChildZones.LimitBegin
else
BeginSize := 0;
BeforeVisibleZone := BeforeClosestVisibleZone;
AfterVisibleZone := AfterClosestVisibleZone;
BorderSize := TJvDockVIDTree(Tree).BorderWidth * Integer(AfterClosestVisibleZone <> nil) div 2;
TempSize := ParentZone.HeightWidth[ParentZone.Orientation] + BorderSize;
if DockSize > TempSize - (ParentZone.VisibleChildCount - 1) * TJvDockVIDTree(Tree).MinSize then
DockSize := TempSize - (ParentZone.VisibleChildCount - 1) * TJvDockVIDTree(Tree).MinSize;
if DockSize = 0 then
DockSize := TempSize div 2;
Visibled := False;
if (BeforeVisibleZone = nil) and (AfterVisibleZone = nil) then
Exit;
if BeforeVisibleZone = nil then
begin
PrevShift := 0;
NextShift := -DockSize + BorderSize;
ZoneLimit := -DockSize + BorderSize + BeginSize;
end
else
if AfterVisibleZone = nil then
begin
PrevShift := -DockSize + BorderSize;
NextShift := 0;
BeforeVisibleZone.ZoneLimit := BeforeVisibleZone.ZoneLimit - PrevShift;
ZoneLimit := TempSize + BeginSize;
end
else
begin
PrevShift := -Round((BeforeVisibleZone.ZoneLimit - BeginSize) * (DockSize + BorderSize) / (TempSize - (DockSize +
BorderSize)));
NextShift := -DockSize - PrevShift;
BeforeVisibleZone.ZoneLimit := BeforeVisibleZone.ZoneLimit - PrevShift;
ZoneLimit := BeforeVisibleZone.ZoneLimit;
end;
if PrevShift <> 0 then
begin
with TJvDockVIDTree(Tree) do
begin
ReplacementZone := BeforeVisibleZone;
try
if (BeforeVisibleZone.ZoneLimit - BeginSize) * (BeforeVisibleZone.ZoneLimit - BeginSize + PrevShift) <> 0 then
ScaleBy := (BeforeVisibleZone.ZoneLimit - BeginSize) / (BeforeVisibleZone.ZoneLimit - BeginSize + PrevShift)
else
ScaleBy := 1;
ParentLimit := BeginSize;
ShiftScaleOrientation := ParentZone.Orientation;
if ScaleBy <> 1 then
ForEachAt(ParentZone.ChildZones, ScaleChildZone, tskMiddle, tspChild);
finally
ReplacementZone := nil;
end;
end;
if BeforeVisibleZone.LimitSize < TJvDockVIDTree(Tree).MinSize then
BeforeVisibleZone.ZoneLimit := BeforeVisibleZone.LimitBegin + TJvDockVIDTree(Tree).MinSize;
end;
if NextShift <> 0 then
with TJvDockVIDTree(Tree) do
begin
if (TempSize + BeginSize - LimitBegin) * (TempSize + BeginSize - LimitBegin + NextShift) <> 0 then
ScaleBy := (TempSize + BeginSize - LimitBegin) / (TempSize + BeginSize - LimitBegin + NextShift)
else
ScaleBy := 1;
ParentLimit := TempSize + BeginSize;
ShiftScaleOrientation := ParentZone.Orientation;
if ScaleBy <> 1 then
ForEachAt(AfterVisibleZone, ScaleSiblingZone, tskForward);
end;
end;
//=== { TJvDockVIDTabServerOption } ==========================================
constructor TJvDockVIDTabServerOption.Create(ADockStyle: TJvDockObservableStyle);
begin
inherited Create(ADockStyle);
TabPosition := tpBottom;
FActiveFont := TFont.Create;
FActiveFont.OnChange := FontChanged;
FActiveSheetColor := clBtnFace;
FHotTrackColor := clBlue;
FInactiveFont := TFont.Create;
FInactiveFont.Color := clWhite;
FInactiveFont.OnChange := FontChanged;
FInactiveSheetColor := clBtnShadow;
FShowTabImages := False;
FShowCloseButtonOnGrabber := True;
FShowCloseButtonOnTabs := False;
end;
destructor TJvDockVIDTabServerOption.Destroy;
begin
FActiveFont.Free;
FInactiveFont.Free;
inherited Destroy;
end;
procedure TJvDockVIDTabServerOption.Assign(Source: TPersistent);
var
Src: TJvDockVIDTabServerOption;
begin
if Source is TJvDockVIDTabServerOption then
begin
BeginUpdate;
try
Src := TJvDockVIDTabServerOption(Source);
ActiveFont := Src.ActiveFont;
ActiveSheetColor := Src.ActiveSheetColor;
HotTrackColor := Src.HotTrackColor;
InactiveFont := Src.InactiveFont;
InactiveSheetColor := Src.InactiveSheetColor;
ShowTabImages := Src.ShowTabImages;
inherited Assign(Source);
finally
EndUpdate;
end;
end
else
inherited Assign(Source);
end;
procedure TJvDockVIDTabServerOption.FontChanged(Sender: TObject);
begin
Changed;
end;
procedure TJvDockVIDTabServerOption.SetActiveFont(Value: TFont);
begin
FActiveFont.Assign(Value);
end;
procedure TJvDockVIDTabServerOption.SetActiveSheetColor(const Value: TColor);
begin
if FActiveSheetColor <> Value then
begin
FActiveSheetColor := Value;
Changed;
end;
end;
procedure TJvDockVIDTabServerOption.SetHotTrackColor(const Value: TColor);
begin
if FHotTrackColor <> Value then
begin
FHotTrackColor := Value;
Changed;
end;
end;
procedure TJvDockVIDTabServerOption.SetInactiveFont(Value: TFont);
begin
FInactiveFont.Assign(Value);
end;
procedure TJvDockVIDTabServerOption.SetInactiveSheetColor(const Value: TColor);
begin
if FInactiveSheetColor <> Value then
begin
FInactiveSheetColor := Value;
Changed;
end;
end;
procedure TJvDockVIDTabServerOption.SetShowTabImages(const Value: Boolean);
begin
if FShowTabImages <> Value then
begin
FShowTabImages := Value;
Changed;
end;
end;
procedure TJvDockVIDTabServerOption.SetTabPosition(const Value: TTabPosition);
begin
// if Value = tpBottom then
inherited SetTabPosition(Value)
// else // TabPosition property must be tpBottom.
// raise Exception.CreateRes(@RsEDockTabPositionMustBetpBottom);
end;
procedure TJvDockVIDTabServerOption.SetShowCloseButtonOnGrabber(
const Value: Boolean);
begin
if FShowCloseButtonOnGrabber <> Value then
begin
FShowCloseButtonOnGrabber := Value;
Changed;
end;
end;
procedure TJvDockVIDTabServerOption.SetShowCloseButtonOnTabs(
const Value: Boolean);
begin
if FShowCloseButtonOnTabs <> Value then
begin
FShowCloseButtonOnTabs := Value;
Changed;
end;
end;
//=== { TJvDockVIDConjoinServerOption } ======================================
constructor TJvDockVIDConjoinServerOption.Create(ADockStyle: TJvDockObservableStyle);
begin
inherited Create(ADockStyle);
GrabbersSize := VIDDefaultDockGrabbersSize;
SplitterWidth := VIDDefaultDockSplitterWidth;
FActiveFont := TFont.Create;
FActiveFont.OnChange := FontChanged;
FInactiveFont := TFont.Create;
FInactiveFont.OnChange := FontChanged;
SystemInfo := True;
end;
destructor TJvDockVIDConjoinServerOption.Destroy;
begin
{ Make sure we unregister, can be called more than once }
UnRegisterSettingChangeClient(Self);
FActiveFont.Free;
FInactiveFont.Free;
inherited Destroy;
end;
procedure TJvDockVIDConjoinServerOption.Assign(Source: TPersistent);
var
Src: TJvDockVIDConjoinServerOption;
begin
if Source is TJvDockVIDConjoinServerOption then
begin
BeginUpdate;
try
Src := TJvDockVIDConjoinServerOption(Source);
TextEllipsis := Src.TextEllipsis;
TextAlignment := Src.TextAlignment;
InactiveTitleEndColor := Src.InactiveTitleEndColor;
InactiveTitleStartColor := Src.InactiveTitleStartColor;
InactiveTitleVerticalGradient := Src.InactiveTitleVerticalGradient;
ActiveTitleEndColor := Src.ActiveTitleEndColor;
ActiveTitleStartColor := Src.ActiveTitleStartColor;
ActiveTitleVerticalGradient := Src.ActiveTitleVerticalGradient;
ActiveDockGrabber := Src.ActiveDockGrabber;
ActiveFont := Src.ActiveFont;
InactiveFont := Src.InactiveFont;
SystemInfo := Src.SystemInfo;
inherited Assign(Source);
finally
EndUpdate;
end;
end
else
inherited Assign(Source);
end;
procedure TJvDockVIDConjoinServerOption.SetActiveTitleEndColor(const Value: TColor);
begin
if Value <> FActiveTitleEndColor then
begin
FActiveTitleEndColor := Value;
// setting SystemInfo to False does not trigger a Changed call
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDConjoinServerOption.SetActiveTitleStartColor(const Value: TColor);
begin
if Value <> FActiveTitleStartColor then
begin
FActiveTitleStartColor := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDConjoinServerOption.SetActiveTitleVerticalGradient(const Value: Boolean);
begin
if Value <> FActiveTitleVerticalGradient then
begin
FActiveTitleVerticalGradient := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDConjoinServerOption.SetActiveDockGrabber(
const Value: Boolean);
begin
if Value <> FActiveDockGrabber then
begin
FActiveDockGrabber := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDConjoinServerOption.SetInactiveTitleEndColor(const Value: TColor);
begin
if Value <> FInactiveTitleEndColor then
begin
FInactiveTitleEndColor := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDConjoinServerOption.SetInactiveTitleStartColor(const Value: TColor);
begin
if Value <> FInactiveTitleStartColor then
begin
FInactiveTitleStartColor := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDConjoinServerOption.SetInactiveTitleVerticalGradient(const Value: Boolean);
begin
if Value <> FInactiveTitleVerticalGradient then
begin
FInactiveTitleVerticalGradient := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDConjoinServerOption.SetSystemInfo(const Value: Boolean);
begin
if Value <> FSystemInfo then
begin
if FSystemInfo then
UnRegisterSettingChangeClient(Self);
FSystemInfo := Value;
if FSystemInfo then
begin
RegisterSettingChangeClient(Self, SettingChange);
SetDefaultSystemCaptionInfo;
// If necessary Changed is called via SetDefaultSystemCaptionInfo
end;
end;
end;
procedure TJvDockVIDConjoinServerOption.SetTextAlignment(
const Value: TAlignment);
begin
if Value <> FTextAlignment then
begin
FTextAlignment := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDConjoinServerOption.SetTextEllipsis(const Value: Boolean);
begin
if Value <> FTextEllipsis then
begin
FTextEllipsis := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDConjoinServerOption.SetDefaultSystemCaptionInfo;
var
Saved: Boolean;
begin
Saved := SystemInfo;
BeginUpdate;
FSystemInfo := False;
try
UpdateDefaultSystemCaptionInfo;
finally
FSystemInfo := Saved;
EndUpdate;
end;
end;
procedure TJvDockVIDConjoinServerOption.UpdateDefaultSystemCaptionInfo;
begin
ActiveTitleStartColor := JvDockGetActiveTitleBeginColor;
ActiveTitleEndColor := JvDockGetActiveTitleEndColor;
ActiveTitleVerticalGradient := False;
InactiveTitleStartColor := JvDockGetInactiveTitleBeginColor;
InactiveTitleEndColor := JvDockGetInactiveTitleEndColor;
InactiveTitleVerticalGradient := False;
ActiveDockGrabber := False;
TextAlignment := taLeftJustify;
TextEllipsis := True;
ActiveFont := JvDockGetTitleFont;
ActiveFont.Style := FActiveFont.Style + [fsBold];
InactiveFont := FActiveFont;
ActiveFont.Color := JvDockGetActiveTitleFontColor;
InactiveFont.Color := JvDockGetInactiveTitleFontColor;
GrabbersSize := VIDDefaultDockGrabbersSize;
SplitterWidth := VIDDefaultDockSplitterWidth;
end;
procedure TJvDockVIDConjoinServerOption.SetActiveFont(Value: TFont);
begin
FActiveFont.Assign(Value);
end;
procedure TJvDockVIDConjoinServerOption.SetInactiveFont(Value: TFont);
begin
FInactiveFont.Assign(Value);
end;
procedure TJvDockVIDConjoinServerOption.Changed;
begin
inherited Changed;
SystemInfo := SystemInfo and (GrabbersSize = VIDDefaultDockGrabbersSize) and
(SplitterWidth = VIDDefaultDockSplitterWidth);
TJvDockVIDStyle(DockStyle).DoSystemInfoChange(SystemInfo);
end;
function TJvDockVIDConjoinServerOption.IsNotSystemInfo: Boolean;
begin
Result := not SystemInfo;
end;
procedure TJvDockVIDConjoinServerOption.FontChanged(Sender: TObject);
begin
// setting SystemInfo to False does not trigger a Changed call
SystemInfo := False;
Changed;
end;
procedure TJvDockVIDConjoinServerOption.SettingChange(Sender: TObject);
begin
{ ?? }
{DockStyle.ParentForm.Caption := '';}
if SystemInfo then
SetDefaultSystemCaptionInfo;
end;
{$IFNDEF COMPILER9_UP}
function GetRealParentForm(Control: TControl): TCustomForm;
begin
while not (Control is TCustomForm) and (Control.Parent <> nil) do
Control := Control.Parent;
if Control is TCustomForm then
Result := TCustomForm(Control)
else
Result := nil;
end;
{$ENDIF !COMPILER9_UP}
{$IFNDEF COMPILER9_UP}
type
TWinControlAccessProtected = class(TWinControl);
{$ENDIF !COMPILER9_UP}
function GetDockManager(Control: TWinControl; out ADockManager: IDockManager): Boolean;
begin
ADockManager := nil;
{$IFDEF COMPILER9_UP}
with Control do
if UseDockManager then
ADockManager := DockManager;
{$ELSE}
with TWinControlAccessProtected(Control) do
if UseDockManager then
ADockManager := DockManager;
{$ENDIF COMPILER9_UP}
Result := Assigned(ADockManager);
end;
procedure TJvDockVIDTree.InvalidateDockSite(const Client: TControl);
var
ParentForm: TCustomForm;
Rect: TRect;
ADockManager: IDockManager;
begin
{$IFDEF COMPILER9_UP}
ParentForm := GetParentForm(Client, False);
{$ELSE}
ParentForm := GetRealParentForm(Client);
{$ENDIF COMPILER9_UP}
{ Just invalidate the parent form's rect in the HostDockSite
so that we can "follow focus" on docked items. }
if (ParentForm <> nil) and (ParentForm.HostDockSite <> nil) then
begin
if GetDockManager(ParentForm.HostDockSite, ADockManager) then
begin
ADockManager.GetControlBounds(ParentForm, Rect);
InvalidateRect(ParentForm.HostDockSite.Handle, @Rect, False);
end;
end;
end;
{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
RegisterUnitVersion(HInstance, UnitVersioning);
finalization
UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}
end.