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

4671 lines
149 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: JvDockVIDVCStyle.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):
devedit
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: JvDockVIDVCStyle.pas 11274 2007-04-24 19:09:06Z remkobonte $
unit JvDockVIDVCStyle;
{$I jvcl.inc}
interface
uses
{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}
Windows, Messages, Classes, Controls, Graphics, ComCtrls, ImgList,
JvDockControlForm, JvDockSupportControl, JvDockTree, JvDockAdvTree;
const
VIDDefaultDockGrabbersSize = 18;
VIDDefaultDockSplitterWidth = 4;
HTEXPAND = 31;
type
TJvDockVIDVCConjoinServerOption = class(TJvDockBasicConjoinServerOption)
private
FTextEllipsis: Boolean;
FTextAlignment: TAlignment;
FInactiveTitleEndColor: TColor;
FInactiveTitleStartColor: TColor;
FActiveTitleEndColor: TColor;
FActiveTitleStartColor: TColor;
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);
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
{ (rb) these properties are all *not* used. }
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 InactiveTitleStartColor: TColor read FInactiveTitleStartColor write SetInactiveTitleStartColor stored IsNotSystemInfo;
property InactiveTitleEndColor: TColor read FInactiveTitleEndColor write SetInactiveTitleEndColor stored IsNotSystemInfo;
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;
TJvDockZoneSizeStyle = (zssMinimum, zssNormal, zssMaximum);
TJvDockVIDVCTabServerOption = class(TJvDockBasicTabServerOption)
private
FActiveFont: TFont;
FActiveSheetColor: TColor;
FHotTrackColor: TColor;
FInactiveFont: TFont;
FInactiveSheetColor: TColor;
FShowTabImages: 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);
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;
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;
end;
TJvDockSystemInfoChange = procedure(Value: Boolean) of object;
TJvDockVIDVCStyle = class(TJvDockAdvStyle)
private
FSystemInfoChange: TJvDockSystemInfoChange;
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 SystemInfoChange: TJvDockSystemInfoChange read FSystemInfoChange
write FSystemInfoChange;
property ConjoinServerOption;
property TabServerOption;
end;
TJvDockVIDVCSplitter = class(TJvDockSplitter)
protected
procedure Paint; override;
end;
TJvDockVIDVCPanel = 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;
TJvDockVIDVCConjoinPanel = 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;
TJvDockVIDVCZone = class(TJvDockAdvZone)
private
FExpandButtonDown: Boolean;
FZoneSizeStyle: TJvDockZoneSizeStyle;
procedure DoSetChildSizeStyle(ZoneSizeStyle: TJvDockZoneSizeStyle);
protected
function GetSplitterLimit(IsMin: Boolean): Integer; override;
public
property ExpandButtonDown: Boolean read FExpandButtonDown write FExpandButtonDown;
property ZoneSizeStyle: TJvDockZoneSizeStyle read FZoneSizeStyle write FZoneSizeStyle;
procedure Insert(DockSize: Integer; Hide: Boolean); override;
procedure Remove(DockSize: Integer; Hide: Boolean); override;
end;
TJvDockVIDVCTree = class(TJvDockAdvTree)
private
FDropOnZone: TJvDockZone;
FExpandBtnZone: TJvDockVIDVCZone;
FLockDropDockSizeCount: Integer;
FCaptionLeftOffset: Integer;
FCaptionRightOffset: Integer;
procedure LockDropDockSize;
procedure UnlockDropDockSize;
procedure SetCaptionLeftOffset(const Value: Integer);
procedure SetCaptionRightOffset(const Value: Integer);
protected
procedure DoLButtonUp(var Msg: TWMMouse;
var Zone: TJvDockZone; out HTFlag: Integer); override;
procedure ResetDockZoneSizeStyle(Parent: TJvDockZone;
ZoneSizeStyle: TJvDockZoneSizeStyle; Exclude: TJvDockZone);
function GetLeftGrabbersHTFlag(const MousePos: TPoint;
out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone; override;
function GetTopGrabbersHTFlag(const MousePos: TPoint;
out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone; override;
procedure DoMouseMove(var Msg: TWMMouse;
var Zone: TJvDockZone; out HTFlag: Integer); override;
function DoLButtonDown(var Msg: TWMMouse;
var Zone: TJvDockZone; out HTFlag: Integer): Boolean; override;
procedure InsertControlFromConjoinHost(Control: TControl;
InsertAt: TAlign; DropCtl: TControl); virtual;
procedure IgnoreZoneInfor(Stream: TMemoryStream); virtual;
// procedure AdjustDockRect(Control: TControl; var ARect: TRect); override;
procedure WindowProc(var Msg: TMessage); override;
procedure SplitterMouseUp; 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: TControl;
const ARect: TRect); 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;
property CaptionLeftOffset: Integer read FCaptionLeftOffset write SetCaptionLeftOffset;
property CaptionRightOffset: Integer read FCaptionRightOffset write SetCaptionRightOffset;
public
constructor Create(DockSite: TWinControl; DockZoneClass: TJvDockZoneClass; ADockStyle: TJvDockObservableStyle); override;
end;
TJvDockVIDVCTabPageControl = class;
TJvDockVIDVCTabSheet = class(TJvDockTabSheet)
private
FTabWidth: Integer;
FShowTabWidth: Integer;
FIsSourceDockClient: Boolean;
// FZoneSizeStyle: TJvDockZoneSizeStyle;
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
FPage: TJvDockVIDVCTabPageControl;
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: TJvDockVIDVCTabSheet;
FTempPages: TList;
FSelectHotIndex: Integer;
FShowTabImages: Boolean;
procedure SetPage(const Value: TJvDockVIDVCTabPageControl);
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): TJvDockVIDVCTabSheet;
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]: TJvDockVIDVCTabSheet 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: TJvDockVIDVCTabSheet);
property Page: TJvDockVIDVCTabPageControl read FPage write SetPage;
property SelectSheet: TJvDockVIDVCTabSheet read FSelectSheet write FSelectSheet;
property ShowTabImages: Boolean read FShowTabImages write SetShowTabImages;
end;
TJvDockTabPanelClass = class of TJvDockTabPanel;
TJvDockVIDVCTabPageControl = class(TJvDockAdvTabPageControl)
private
FTabPanelClass: TJvDockTabPanelClass;
FPanel: TJvDockTabPanel;
FTempSheet: TJvDockVIDVCTabSheet;
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): TJvDockVIDVCTabSheet;
function GetActiveVIDPage: TJvDockVIDVCTabSheet;
procedure SetActiveVIDPage(const Value: TJvDockVIDVCTabSheet);
protected
procedure AdjustClientRect(var Rect: TRect); override;
procedure CreatePanel; virtual;
procedure Change; 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;
property TabPanelClass: TJvDockTabPanelClass read FTabPanelClass write FTabPanelClass;
public
constructor Create(AOwner: TComponent); override;
procedure AfterConstruction; override;
property ActiveVIDPage: TJvDockVIDVCTabSheet read GetActiveVIDPage write SetActiveVIDPage;
destructor Destroy; override;
procedure DockDrop(Source: TDragDockObject; X, Y: Integer); override;
procedure UpdateCaption(Exclude: TControl); override;
procedure Resize; override;
property Pages[Index: Integer]: TJvDockVIDVCTabSheet read GetPage;
property Panel: TJvDockTabPanel read FPanel;
property TempSheet: TJvDockVIDVCTabSheet 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;
TJvDockVIDVCDragDockObject = class(TJvDockDragDockObject)
private
FOldDropAlign: TAlign;
FCurrState: TDragState;
FOldState: TDragState;
FOldTarget: Pointer;
FSourceDockClientList: TList;
FDropTabControl: TJvDockVIDVCTabPageControl;
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);
{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvDockVIDVCStyle.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}
Consts, SysUtils, Math, Forms, ExtCtrls,
JvDockSupportProc, JvDockGlobals;
type
TWinControlAccessProtected = class(TWinControl);
// (rom) such global variables are problematic
var
gi_DockRect: TRect;
{ (rb) Compare to PaintGradientBackground in JvDockVIDStyle.pas }
procedure PaintGradientBackground(Canvas: TCanvas; ARect: TRect;
StartColor, EndColor: TColor);
const
D = 256;
var
X, C1, C2, R1, G1, B1, W: Integer;
DR, DG, DB, DH: 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);
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
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: TJvDockVIDVCDragDockObject;
TabControl: TJvDockVIDVCTabPageControl;
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 := TJvDockVIDVCTabSheet.Create(TabControl);
TabControl.FTempSheet.PageControl := TabControl;
TabControl.FTempSheet.Caption := TWinControlAccessProtected(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 TJvDockVIDVCTabSheet(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;
*)
//=== { TJvDockVIDVCStyle } ==================================================
constructor TJvDockVIDVCStyle.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
DockPanelClass := TJvDockVIDVCPanel;
DockSplitterClass := TJvDockVIDVCSplitter;
ConjoinPanelClass := TJvDockVIDVCConjoinPanel;
TabDockClass := TJvDockVIDVCTabPageControl;
DockPanelTreeClass := TJvDockVIDVCTree;
DockPanelZoneClass := TJvDockVIDVCZone;
ConjoinPanelTreeClass := TJvDockVIDVCTree;
ConjoinPanelZoneClass := TJvDockVIDVCZone;
ConjoinServerOptionClass := TJvDockVIDVCConjoinServerOption;
TabServerOptionClass := TJvDockVIDVCTabServerOption;
end;
procedure TJvDockVIDVCStyle.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 TJvDockVIDVCDragDockObject then
begin
TJvDockVIDVCDragDockObject(Source).OldState := TJvDockVIDVCDragDockObject(Source).CurrState;
TJvDockVIDVCDragDockObject(Source).CurrState := State;
end;
end;
end;
procedure TJvDockVIDVCStyle.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
begin
Dec(InfluenceRect.Top, TJvDockCustomPanel(ParentForm.HostDockSite).JvDockManager.GrabberSize);
end;
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 TJvDockVIDVCStyle.FormDockDrop(DockClient: TJvDockClient;
Source: TJvDockDragDockObject; X, Y: Integer);
var
ARect, DRect: TRect;
DockType: TAlign;
Host: TJvDockableForm;
APanelDock: TWinControl;
VIDSource: TJvDockVIDVCDragDockObject;
I: Integer;
begin
if Source is TJvDockVIDVCDragDockObject then
begin
TJvDockVIDVCDragDockObject(Source).CurrState := dsDragEnter;
TJvDockVIDVCDragDockObject(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 TJvDockVIDVCDragDockObject then
begin
VIDSource := TJvDockVIDVCDragDockObject(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 TJvDockVIDVCStyle.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 TJvDockVIDVCStyle.FormStartDock(DockClient: TJvDockClient;
var Source: TJvDockDragDockObject);
begin
inherited FormStartDock(DockClient, Source);
Source := TJvDockVIDVCDragDockObject.Create(DockClient.ParentForm);
end;
procedure TJvDockVIDVCStyle.FormGetDockEdge(DockClient: TJvDockClient;
Source: TJvDockDragDockObject; MousePos: TPoint; var DropAlign: TAlign);
var
ARect: TRect;
begin
DropAlign := ComputeVIDDockingRect(DockClient.ParentForm, Source.Control, ARect, MousePos);
end;
function TJvDockVIDVCStyle.DockClientWindowProc(DockClient: TJvDockClient;
var Msg: TMessage): Boolean;
begin
Result := inherited DockClientWindowProc(DockClient, Msg);
end;
procedure TJvDockVIDVCStyle.DoSystemInfoChange(Value: Boolean);
begin
if Assigned(FSystemInfoChange) then
FSystemInfoChange(Value);
end;
//=== { TJvDockVIDVCPanel } ==================================================
procedure TJvDockVIDVCPanel.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 TJvDockVIDVCPanel.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 TJvDockVIDVCDragDockObject) then
if State = dsDragMove then
begin
DropAlign := Source.DropAlign;
JvDockManager.GetDockEdge(Source.DockRect, Source.DragPos, DropAlign, Source.Control);
end;
end;
procedure TJvDockVIDVCPanel.CustomGetDockEdge(Source: TJvDockDragDockObject;
MousePos: TPoint; var DropAlign: TAlign);
begin
end;
procedure TJvDockVIDVCPanel.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 TJvDockVIDVCPanel.CustomStartDock(var Source: TJvDockDragDockObject);
begin
Source := TJvDockVIDVCDragDockObject.Create(Self);
end;
procedure TJvDockVIDVCPanel.DockDrop(Source: TDragDockObject; X, Y: Integer);
begin
inherited DockDrop(Source, X, Y);
end;
procedure TJvDockVIDVCPanel.UpdateCaption(Exclude: TControl);
begin
inherited UpdateCaption(Exclude);
Invalidate;
end;
//=== { TJvDockVIDVCTree } ===================================================
constructor TJvDockVIDVCTree.Create(DockSite: TWinControl;
DockZoneClass: TJvDockZoneClass; ADockStyle: TJvDockObservableStyle);
begin
inherited Create(DockSite, DockZoneClass, ADockStyle);
FDropOnZone := nil;
ButtonHeight := 11;
ButtonWidth := 13;
LeftOffset := 2;
RightOffset := 2;
TopOffset := 4;
BottomOffset := 3;
ButtonSplitter := 2;
BorderWidth := 4;
MinSize := 20;
CaptionLeftOffset := 0;
CaptionRightOffset := 0;
end;
procedure TJvDockVIDVCTree.InsertControl(Control: TControl; InsertAt: TAlign;
DropCtl: TControl);
var
I: Integer;
Host: TJvDockTabHostForm;
ChildCount: Integer;
VIDSource: TJvDockVIDVCDragDockObject;
TempControl: TControl;
ARect: TRect;
AZone: TJvDockZone;
function CreateDockPageControl(Client: TControl): TJvDockTabHostForm;
var
Zone: TJvDockZone;
TempCtl: TControl;
TempPanel: TJvDockConjoinPanel;
DockClient: TJvDockClient;
APoint: TPoint;
begin
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
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 := TJvDockVIDVCDragDockObject.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 := TJvDockVIDVCDragDockObject.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
TWinControlAccessProtected(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 TJvDockVIDVCTree.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];
// (rom) is this rock solid?
while True do
begin
ReadZone(True);
if Level = TreeStreamEndFlag then
Break;
end;
finally
Stream.Free;
EndUpdate;
end;
SetNewBounds(nil);
end;
procedure TJvDockVIDVCTree.DrawDockGrabber(Control: TWinControl; const ARect: TRect);
var
lbVCDockZone: TJvDockVIDVCZone;
DrawRect: TRect;
procedure DrawCloseButton(Left, Top: Integer);
var
ADockClient: TJvDockClient;
begin
if lbVCDockZone <> nil then
begin
ADockClient := FindDockClient(Control);
if (ADockClient <> nil) and (not ADockClient.EnableCloseButton) then
Exit;
DrawFrameControl(Canvas.Handle, Rect(Left, Top, Left + ButtonWidth,
Top + ButtonHeight), DFC_CAPTION, DFCS_CAPTIONCLOSE or Integer(lbVCDockZone.CloseBtnDown) * DFCS_PUSHED)
end;
end;
procedure DrawExpendBotton(Left, Top: Integer);
const
{$IFDEF COMPILER6_UP}
ArrowOrient: array [TAlign] of DWORD =
(0, DFCS_SCROLLUP, DFCS_SCROLLDOWN, DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT, 0, 0);
{$ELSE}
ArrowOrient: array [TAlign] of DWORD =
(0, DFCS_SCROLLUP, DFCS_SCROLLDOWN, DFCS_SCROLLLEFT, DFCS_SCROLLRIGHT, 0);
{$ENDIF COMPILER6_UP}
CurrArrow: array [Boolean, TDockOrientation] of TAlign =
((alNone, alLeft, alTop), (alNone, alRight, alBottom));
var
InActive: Boolean;
IsMaximum: Boolean;
begin
if lbVCDockZone <> nil then
begin
InActive := not ((lbVCDockZone.ParentZone.Orientation <> DockSiteOrientation) and
(lbVCDockZone.ParentZone.VisibleChildCount >= 2));
IsMaximum := lbVCDockZone.ZoneSizeStyle in [zssMaximum];
DrawFrameControl(Canvas.Handle, Rect(Left, Top, Left + ButtonWidth,
Top + ButtonHeight), DFC_SCROLL,
ArrowOrient[CurrArrow[IsMaximum, DockSiteOrientation]] +
Cardinal(InActive) * (DFCS_INACTIVE) + Cardinal(lbVCDockZone.ExpandButtonDown) * DFCS_PUSHED);
end;
end;
procedure DrawGrabberLine(Left, Top, Right, Bottom: Integer);
begin
if (Left >= Right) or (Top >= Bottom) then
Exit;
with Canvas do
begin
Pen.Color := clBtnHighlight;
MoveTo(Right, Top);
LineTo(Left, Top);
LineTo(Left, Bottom);
Pen.Color := clBtnShadow;
LineTo(Right, Bottom);
LineTo(Right, Top - 1);
end;
end;
begin
lbVCDockZone := TJvDockVIDVCZone(FindControlZone(Control));
DrawRect := ARect;
Canvas.Brush.Color := TWinControlAccessProtected(DockSite).Color;
Canvas.FillRect(DrawRect);
with ARect do
case GrabbersPosition of
gpLeft:
begin
DrawExpendBotton(Left + BorderWidth + LeftOffset, Top + TopOffset + ButtonHeight + ButtonSplitter +
BorderWidth);
DrawCloseButton(Left + BorderWidth + LeftOffset, Top + TopOffset + BorderWidth);
DrawGrabberLine(Left + BorderWidth + LeftOffset + 3, Top + 2 * ButtonHeight + TopOffset + ButtonSplitter +
BottomOffset + BorderWidth + 3, Left + BorderWidth + LeftOffset + 5, Bottom - BorderWidth - 2);
DrawGrabberLine(Left + BorderWidth + LeftOffset + 7, Top + 2 * ButtonHeight + TopOffset + ButtonSplitter +
BottomOffset + BorderWidth + 3, Left + BorderWidth + LeftOffset + 9, Bottom - BorderWidth - 2);
end;
gpTop:
begin
DrawExpendBotton(Right - LeftOffset - 2 * ButtonWidth - ButtonSplitter - BorderWidth, Top + TopOffset +
BorderWidth);
DrawCloseButton(Right - LeftOffset - ButtonWidth - BorderWidth, Top + TopOffset + BorderWidth);
DrawGrabberLine(Left + BorderWidth, Top + BorderWidth + TopOffset + 3, Right - 2 * ButtonWidth - RightOffset -
ButtonSplitter - LeftOffset - BorderWidth - 3, Top + BorderWidth + TopOffset + 5);
DrawGrabberLine(Left + BorderWidth, Top + BorderWidth + TopOffset + 7, Right - 2 * ButtonWidth - RightOffset -
ButtonSplitter - LeftOffset - BorderWidth - 3, Top + BorderWidth + TopOffset + 9);
end;
gpBottom:
begin
end;
gpRight:
begin
end;
end;
end;
procedure TJvDockVIDVCTree.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 TJvDockVIDVCTree.DrawSplitterRect(const ARect: TRect);
var
Rect: TRect;
begin
inherited DrawSplitterRect(ARect);
Rect := ARect;
InflateRect(Rect, 1, 1);
DrawFrameControl(Canvas.Handle, Rect, DFC_BUTTON, DFCS_BUTTONPUSH or DFCS_ADJUSTRECT);
end;
procedure TJvDockVIDVCTree.WindowProc(var Msg: TMessage);
var
Align: TAlign;
begin
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 TJvDockVIDVCTree.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 TJvDockVIDVCTree.InsertSibling(NewZone, SiblingZone: TJvDockZone;
InsertLast, Update: Boolean);
begin
if FDropOnZone <> nil then
SiblingZone := FDropOnZone;
inherited InsertSibling(NewZone, SiblingZone, InsertLast, Update);
end;
{procedure TJvDockVIDVCTree.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;
MousePos := JvGlobalDockManager.DragObject.DragPos;
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 TJvDockVIDVCDragDockObject then
TJvDockVIDVCDragDockObject(JvGlobalDockManager.DragObject).FDropTabControl :=
TJvDockVIDVCTabPageControl(TJvDockTabHostForm(Zone.ChildControl).PageControl);
end
else
begin
if JvGlobalDockManager.DragObject is TJvDockVIDVCDragDockObject then
TJvDockVIDVCDragDockObject(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;
if DropAlign in [alLeft, alRight] then
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;
if DropAlign in [alLeft, alRight] then
Dec(CtrlRect.Top, GrabberSize);
end;
//if DropAlign in [alLeft, alRight] then
OffsetRect(CtrlRect, 0, GrabberSize);
end;
end
else
begin
CtrlRect := DropCtl.BoundsRect;
//Dec(CtrlRect.Top, GrabberSize);
//OffsetRect(CtrlRect, 0, GrabberSize);
end;
NewX := CtrlRect.Left;
if DropAlign in [alTop, alBottom] then
NewY := CtrlRect.Top
else
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 TJvDockVIDVCTree.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;
function TJvDockVIDVCTree.GetLeftGrabbersHTFlag(const MousePos: TPoint;
out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone;
begin
if (MousePos.X >= Zone.Left + BorderWidth) and (MousePos.X <= Zone.Left + BorderWidth + GrabberSize) and
(MousePos.Y >= Zone.Top) and (MousePos.Y <= Zone.Top + Zone.Height) then
begin
Result := Zone;
with Zone.ChildControl do
begin
if PtInRect(Rect(
Left - GrabberSize + LeftOffset,
Top + TopOffset,
Left - GrabberSize + LeftOffset + ButtonWidth,
Top + TopOffset + ButtonHeight), MousePos) then
HTFlag := HTCLOSE
else
if PtInRect(Rect(
Left - GrabberSize + LeftOffset,
Top + ButtonHeight + TopOffset + ButtonSplitter,
Left - GrabberSize + LeftOffset + ButtonWidth,
Top + 2 * ButtonHeight + TopOffset + ButtonSplitter), MousePos) then
HTFlag := HTEXPAND
else
HTFlag := HTCAPTION;
end;
end
else
Result := nil;
end;
function TJvDockVIDVCTree.GetTopGrabbersHTFlag(const MousePos: TPoint;
out HTFlag: Integer; Zone: TJvDockZone): TJvDockZone;
begin
if (MousePos.Y >= Zone.Top + BorderWidth) and (MousePos.Y <= Zone.Top + BorderWidth + 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
if PtInRect(Rect(
Left + Width - 2 * ButtonWidth - RightOffset - ButtonSplitter,
Top - GrabberSize + TopOffset,
Left + Width - ButtonWidth - RightOffset - ButtonSplitter,
Top - GrabberSize + TopOffset + ButtonHeight), MousePos) then
HTFlag := HTEXPAND
else
HTFlag := HTCAPTION;
end;
end
else
Result := nil;
end;
procedure TJvDockVIDVCTree.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 TJvDockVIDVCTree.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 TJvDockVIDVCSplitter.Paint;
var
Rect: TRect;
begin
Rect := ClientRect;
Inc(Rect.Right, 2);
case Align of
alLeft:
InflateRect(Rect, 0, 2);
alRight:
begin
OffsetRect(Rect, -1, 0);
InflateRect(Rect, 0, 2);
end;
alTop:
begin
Inc(Rect.Bottom, 2);
InflateRect(Rect, 2, 0);
end;
alBottom:
begin
Dec(Rect.Top, 2);
InflateRect(Rect, 2, 1);
end;
end;
Canvas.Brush.Color := Color;
DrawFrameControl(Canvas.Handle, Rect, DFC_BUTTON, DFCS_BUTTONPUSH or DFCS_ADJUSTRECT);
end;
procedure TJvDockVIDVCTree.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 TJvDockVIDVCTree.LockDropDockSize;
begin
Inc(FLockDropDockSizeCount);
end;
procedure TJvDockVIDVCTree.UnlockDropDockSize;
begin
Dec(FLockDropDockSizeCount);
if FLockDropDockSizeCount < 0 then
FLockDropDockSizeCount := 0;
end;
procedure TJvDockVIDVCTree.PaintDockGrabberRect(Canvas: TCanvas;
Control: TControl; const ARect: TRect);
begin
end;
procedure TJvDockVIDVCTree.SetCaptionLeftOffset(const Value: Integer);
begin
FCaptionLeftOffset := Value;
end;
procedure TJvDockVIDVCTree.SetCaptionRightOffset(const Value: Integer);
begin
FCaptionRightOffset := Value;
end;
procedure TJvDockVIDVCTree.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 < 14 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 TJvDockVIDVCTree.GetCaptionRect(var Rect: TRect);
begin
case GrabbersPosition of
gpTop:
Rect.Bottom := Rect.Top + GrabberSize + 2;
gpLeft:
Rect.Right := Rect.Left + GrabberSize + 2;
end;
end;
{procedure TJvDockVIDVCTree.AdjustDockRect(Control: TControl;
var ARect: TRect);
begin
if (DockSite.Align <> alClient) or (TopZone.VisibleChildTotal > 1) then
inherited AdjustDockRect(Control, ARect);
end; }
procedure TJvDockVIDVCTree.IgnoreZoneInfor(Stream: TMemoryStream);
var
CompName: string;
begin
Stream.Position := Stream.Position + 6;
ReadControlName(Stream, CompName);
end;
//=== { TJvDockVIDVCConjoinPanel } ===========================================
procedure TJvDockVIDVCConjoinPanel.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 TJvDockVIDVCConjoinPanel.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 TJvDockVIDVCDragDockObject) then
if State = dsDragMove then
begin
DropAlign := Source.DropAlign;
JvDockManager.GetDockEdge(Source.EraseDockRect, Source.DragPos, DropAlign, Source.Control);
end;
end;
procedure TJvDockVIDVCConjoinPanel.CustomGetDockEdge(Source: TJvDockDragDockObject;
MousePos: TPoint; var DropAlign: TAlign);
begin
end;
procedure TJvDockVIDVCConjoinPanel.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 TJvDockVIDVCConjoinPanel.CustomUnDock(Source: TJvDockDragDockObject; NewTarget: TWinControl;
Client: TControl): Boolean;
begin
Result := inherited CustomUnDock(Source, NewTarget, Client);
end;
procedure TJvDockVIDVCConjoinPanel.DockDrop(Source: TDragDockObject;
X, Y: Integer);
begin
inherited DockDrop(Source, X, Y);
end;
procedure TJvDockVIDVCConjoinPanel.UpdateCaption(Exclude: TControl);
begin
if VisibleDockClientCount > 1 then
ParentForm.Caption := ''
else
inherited UpdateCaption(Exclude);
Invalidate;
end;
//=== { TJvDockNewTabPageControl } ===========================================
constructor TJvDockVIDVCTabPageControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPanel := nil;
TabWidth := 1;
MultiLine := True;
TabSheetClass := TJvDockVIDVCTabSheet;
TabPanelClass := TJvDockTabPanel;
FTempSheet := nil;
TabPosition := tpBottom;
FTabImageList := nil;
Images := nil;
if AOwner is TJvDockTabHostForm then
begin
FTabImageList := TCustomImageList.Create(AOwner);
Images := FTabImageList;
end;
end;
destructor TJvDockVIDVCTabPageControl.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 TJvDockVIDVCTabPageControl.AfterConstruction;
begin
inherited AfterConstruction;
CreatePanel;
end;
procedure TJvDockVIDVCTabPageControl.Loaded;
begin
inherited Loaded;
CreatePanel;
end;
procedure TJvDockVIDVCTabPageControl.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 TJvDockVIDVCTabPageControl.CreateWnd;
begin
inherited CreateWnd;
end;
procedure TJvDockVIDVCTabPageControl.CustomDockDrop(Source: TJvDockDragDockObject;
X, Y: Integer);
var
ARect: TRect;
I: Integer;
VIDSource: TJvDockVIDVCDragDockObject;
DockClient: TJvDockClient;
Host: TJvDockConjoinHostForm;
Index: Integer;
begin
if Source.DropAlign in [alClient, alNone] then
begin
if Source is TJvDockVIDVCDragDockObject then
begin
BeginDockLoading;
try
DoFloatForm(Source.Control);
FreeAllDockableForm;
VIDSource := TJvDockVIDVCDragDockObject(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 TJvDockVIDVCTabPageControl.CustomDockOver(Source: TJvDockDragDockObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
var
ARect: TRect;
begin
{ This procedure is called when a dockable form is dragged over a
undocked (stand-alone) tab page controls }
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 TJvDockVIDVCTabPageControl.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 TJvDockVIDVCTabPageControl.Change;
begin
inherited Change;
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 TJvDockVIDVCTabPageControl.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 TJvDockVIDVCTabPageControl.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
end;
procedure TJvDockVIDVCTabPageControl.DrawTab(TabIndex: Integer;
const Rect: TRect; Active: Boolean);
begin
inherited DrawTab(TabIndex, Rect, Active);
end;
function TJvDockVIDVCTabPageControl.GetActiveFont: TFont;
begin
Result := FPanel.FActiveFont;
end;
function TJvDockVIDVCTabPageControl.GetActiveSheetColor: TColor;
begin
Result := FPanel.FActiveSheetColor;
end;
function TJvDockVIDVCTabPageControl.GetInactiveFont: TFont;
begin
Result := FPanel.FInactiveFont;
end;
function TJvDockVIDVCTabPageControl.GetInactiveSheetColor: TColor;
begin
Result := FPanel.Color;
end;
function TJvDockVIDVCTabPageControl.GetTabBottomOffset: Integer;
begin
Result := FPanel.TabBottomOffset;
end;
function TJvDockVIDVCTabPageControl.GetTabLeftOffset: Integer;
begin
Result := FPanel.TabLeftOffset;
end;
function TJvDockVIDVCTabPageControl.GetTabRightOffset: Integer;
begin
Result := FPanel.TabRightOffset;
end;
function TJvDockVIDVCTabPageControl.GetTabTopOffset: Integer;
begin
Result := FPanel.TabTopOffset;
end;
procedure TJvDockVIDVCTabPageControl.Paint;
begin
inherited Paint;
end;
procedure TJvDockVIDVCTabPageControl.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 TJvDockVIDVCTabPageControl.SetActiveFont(Value: TFont);
begin
FPanel.FActiveFont.Assign(Value);
if ActivePage <> nil then
TJvDockVIDVCTabSheet(ActivePage).SetSheetSort(ActivePage.Caption);
FPanel.Invalidate;
end;
procedure TJvDockVIDVCTabPageControl.SetActiveSheetColor(const Value: TColor);
begin
FPanel.FActiveSheetColor := Value;
FPanel.Invalidate;
end;
procedure TJvDockVIDVCTabPageControl.SetInactiveFont(Value: TFont);
var
I: Integer;
begin
FPanel.FInactiveFont.Assign(Value);
for I := 0 to Count - 1 do
if Pages[I] <> ActivePage then
TJvDockVIDVCTabSheet(Pages[I]).SetSheetSort(Pages[I].Caption);
FPanel.Invalidate;
end;
procedure TJvDockVIDVCTabPageControl.SetInactiveSheetColor(const Value: TColor);
begin
if FPanel.Color <> Value then
begin
FPanel.Color := Value;
FPanel.Invalidate;
end;
end;
procedure TJvDockVIDVCTabPageControl.SetTabBottomOffset(const Value: Integer);
begin
if FPanel.TabBottomOffset <> Value then
begin
FPanel.TabBottomOffset := Value;
FPanel.Invalidate;
end;
end;
procedure TJvDockVIDVCTabPageControl.SetTabHeight(Value: Smallint);
begin
inherited SetTabHeight(Value);
if Panel.FTabHeight <> Value then
begin
Panel.FTabHeight := Value;
FPanel.Invalidate;
end;
end;
procedure TJvDockVIDVCTabPageControl.SetTabLeftOffset(const Value: Integer);
begin
if FPanel.TabLeftOffset <> Value then
begin
FPanel.TabLeftOffset := Value;
FPanel.Invalidate;
end;
end;
procedure TJvDockVIDVCTabPageControl.SetTabPosition(Value: TTabPosition);
begin
Assert(Value in [tpTop, tpBottom], RsEDockCannotSetTabPosition);
inherited SetTabPosition(Value);
Resize;
end;
procedure TJvDockVIDVCTabPageControl.SetTabRightOffset(const Value: Integer);
begin
if FPanel.TabRightOffset <> Value then
begin
FPanel.TabRightOffset := Value;
FPanel.Invalidate;
end;
end;
procedure TJvDockVIDVCTabPageControl.SetTabTopOffset(const Value: Integer);
begin
if FPanel.TabTopOffset <> Value then
begin
FPanel.TabTopOffset := Value;
FPanel.Invalidate;
end;
end;
procedure TJvDockVIDVCTabPageControl.SetActivePage(Page: TJvDockTabSheet);
begin
inherited SetActivePage(Page);
FPanel.Invalidate;
end;
procedure TJvDockVIDVCTabPageControl.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 TJvDockVIDVCTabPageControl.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 TJvDockVIDVCTabPageControl.CustomGetDockEdge(Source: TJvDockDragDockObject;
MousePos: TPoint; var DropAlign: TAlign);
var
ARect: TRect;
begin
DropAlign := ComputeVIDDockingRect(Self, Source.Control, ARect, MousePos);
end;
function TJvDockVIDVCTabPageControl.GetVisibleSheetCount: Integer;
var
I: Integer;
begin
Result := 0;
for I := 0 to Count - 1 do
if Pages[I].TabVisible then
Inc(Result);
end;
procedure TJvDockVIDVCTabPageControl.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 TJvDockVIDVCTabPageControl.SetHotTrack(Value: Boolean);
begin
inherited SetHotTrack(Value);
end;
procedure TJvDockVIDVCTabPageControl.SetImages(Value: TCustomImageList);
begin
inherited SetImages(Value);
if Panel <> nil then
begin
Panel.ShowTabImages := Value <> nil;
Panel.Invalidate;
end;
end;
function TJvDockVIDVCTabPageControl.GetHotTrackColor: TColor;
begin
Result := Panel.FHotTrackColor;
end;
procedure TJvDockVIDVCTabPageControl.SetHotTrackColor(const Value: TColor);
begin
if Panel.FHotTrackColor <> Value then
begin
Panel.FHotTrackColor := Value;
Panel.Invalidate;
end;
end;
function TJvDockVIDVCTabPageControl.GetShowTabImages: Boolean;
begin
Result := FPanel.FShowTabImages;
end;
procedure TJvDockVIDVCTabPageControl.SetShowTabImages(const Value: Boolean);
begin
FPanel.ShowTabImages := Value;
end;
function TJvDockVIDVCTabPageControl.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
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 TJvDockVIDVCTabPageControl.GetPage(Index: Integer): TJvDockVIDVCTabSheet;
begin
Result := TJvDockVIDVCTabSheet(inherited Pages[Index]);
end;
function TJvDockVIDVCTabPageControl.GetActiveVIDPage: TJvDockVIDVCTabSheet;
begin
Result := TJvDockVIDVCTabSheet(inherited ActivePage);
end;
procedure TJvDockVIDVCTabPageControl.SetActiveVIDPage(const Value: TJvDockVIDVCTabSheet);
begin
ActivePage := Value;
end;
//=== { TJvDockTabPanel } ====================================================
constructor TJvDockTabPanel.Create(AOwner: TComponent);
begin
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: TJvDockVIDVCTabSheet);
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 TJvDockVIDVCTabSheet(Pages[I]).TabVisible then
Continue;
CurrTabWidth := TJvDockVIDVCTabSheet(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): TJvDockVIDVCTabSheet;
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: TJvDockVIDVCTabSheet;
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 := TJvDockVIDVCTabSheet(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
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;
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 := TJvDockVIDVCTabSheet(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: TJvDockVIDVCTabPageControl);
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;
//=== { TJvDockVIDVCTabSheet } ===============================================
constructor TJvDockVIDVCTabSheet.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIsSourceDockClient := False;
end;
destructor TJvDockVIDVCTabSheet.Destroy;
begin
if (PageControl is TJvDockVIDVCTabPageControl) and (PageControl <> nil) then
TJvDockVIDVCTabPageControl(PageControl).Panel.DeleteSorts(Self);
inherited Destroy;
end;
procedure TJvDockVIDVCTabSheet.Loaded;
begin
inherited Loaded;
SetSheetSort(Caption);
end;
procedure TJvDockVIDVCTabSheet.SetPageControl(APageControl: TJvDockPageControl);
begin
inherited SetPageControl(APageControl);
end;
procedure TJvDockVIDVCTabSheet.SetSheetSort(const CaptionStr: string);
var
TabPanel: TJvDockTabPanel;
TempWidth: Integer;
procedure DoSetSheetSort;
var
I: Integer;
begin
TJvDockVIDVCTabPageControl(PageControl).Panel.FSortList.Remove(Self);
for I := 0 to TJvDockVIDVCTabPageControl(PageControl).Panel.FSortList.Count - 1 do
if TJvDockVIDVCTabPageControl(PageControl).Panel.Sorts[I].TabWidth > TempWidth then
begin
TJvDockVIDVCTabPageControl(PageControl).Panel.FSortList.Insert(I, Self);
Exit;
end;
TJvDockVIDVCTabPageControl(PageControl).Panel.FSortList.Add(Self);
end;
begin
if (PageControl is TJvDockVIDVCTabPageControl) and (PageControl <> nil) then
begin
TabPanel := TJvDockVIDVCTabPageControl(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 TJvDockVIDVCTabSheet.SetTabWidth(const Value: Integer);
begin
FTabWidth := Value;
end;
procedure TJvDockVIDVCTabSheet.UpdateTabShowing;
begin
inherited UpdateTabShowing;
TJvDockVIDVCTabPageControl(PageControl).Panel.SetShowTabWidth;
end;
procedure TJvDockVIDVCTabSheet.WMSetText(var Msg: TMessage);
begin
inherited;
SetSheetSort(PChar(Msg.LParam));
end;
{$IFNDEF USEJVCL}
function TJvDockVIDVCStyle.GetControlName: string;
begin
Result := Format(RsDockLikeVIDStyle, [inherited GetControlName]);
end;
{$ENDIF !USEJVCL}
//=== { TJvDockVIDVCDragDockObject } =========================================
constructor TJvDockVIDVCDragDockObject.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 TJvDockVIDVCDragDockObject.Destroy;
begin
FDropTabControl := nil;
FSourceDockClientList.Free;
inherited Destroy;
end;
procedure TJvDockVIDVCDragDockObject.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 TJvDockVIDVCDragDockObject.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 TJvDockVIDVCDragDockObject.DragFindWindow(const Pos: TPoint): THandle;
begin
Result := 0;
end;
function TJvDockVIDVCDragDockObject.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 TJvDockVIDVCDragDockObject.GetSourceDockClient(Index: Integer): TControl;
begin
Result := TControl(FSourceDockClientList[Index]);
end;
function TJvDockVIDVCDragDockObject.GetSourceDockClientCount: Integer;
begin
Result := FSourceDockClientList.Count;
end;
procedure TJvDockVIDVCDragDockObject.MouseMsg(var Msg: TMessage);
var
APos: TPoint;
Page: TJvDockVIDVCTabPageControl;
begin
inherited MouseMsg(Msg);
case Msg.Msg of
WM_CAPTURECHANGED:
if JvGlobalDockClient.ParentForm.HostDockSite is TJvDockVIDVCTabPageControl then
TJvDockVIDVCTabPageControl(JvGlobalDockClient.ParentForm.HostDockSite).Panel.MouseUp(mbLeft, [], 0, 0)
else
if TWinControl(JvGlobalDockManager.DragObject.DragTarget) is TJvDockVIDVCTabPageControl then
TJvDockVIDVCTabPageControl(JvGlobalDockManager.DragObject.TargetControl).Panel.MouseUp(mbLeft, [], 0, 0);
WM_MOUSEMOVE:
if JvGlobalDockManager.DragObject.TargetControl is TJvDockVIDVCTabPageControl then
begin
Page := TJvDockVIDVCTabPageControl(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 TJvDockVIDVCDragDockObject.SetOldState(const Value: TDragState);
begin
FOldState := Value;
end;
procedure TJvDockVIDVCDragDockObject.SetCurrState(const Value: TDragState);
begin
FCurrState := Value;
end;
function TJvDockVIDVCDragDockObject.CanLeave(NewTarget: TWinControl): Boolean;
begin
Result := inherited CanLeave(NewTarget);
end;
//=== { TJvDockVIDVCZone } ===================================================
function TJvDockVIDVCZone.GetSplitterLimit(IsMin: Boolean): Integer;
begin
if IsMin then
Result := ZoneLimit
else
Result := LimitBegin;
end;
procedure TJvDockVIDVCZone.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 := TJvDockVIDVCTree(Tree).BorderWidth * Integer(AfterClosestVisibleZone <> nil) div 2;
TempSize := ParentZone.HeightWidth[ParentZone.Orientation] + BorderSize;
Visibled := False;
if DockSize >= TempSize - (ParentZone.VisibleChildCount) * TJvDockVIDVCTree(Tree).MinSize then
DockSize := (TempSize - (ParentZone.VisibleChildCount) * TJvDockVIDVCTree(Tree).MinSize) div 2;
if DockSize < TJvDockVIDVCTree(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 TJvDockVIDVCTree(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 < TJvDockVIDVCTree(Tree).MinSize then
BeforeVisibleZone.ZoneLimit := BeforeVisibleZone.LimitBegin + TJvDockVIDVCTree(Tree).MinSize;
end;
if NextShift <> 0 then
with TJvDockVIDVCTree(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 TJvDockVIDVCZone.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 := TJvDockVIDVCTree(Tree).BorderWidth * Integer(AfterClosestVisibleZone <> nil) div 2;
TempSize := ParentZone.HeightWidth[ParentZone.Orientation] + BorderSize;
if DockSize > TempSize - (ParentZone.VisibleChildCount - 1) * TJvDockVIDVCTree(Tree).MinSize then
DockSize := TempSize - (ParentZone.VisibleChildCount - 1) * TJvDockVIDVCTree(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 TJvDockVIDVCTree(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 < TJvDockVIDVCTree(Tree).MinSize then
BeforeVisibleZone.ZoneLimit := BeforeVisibleZone.LimitBegin + TJvDockVIDVCTree(Tree).MinSize;
end;
if NextShift <> 0 then
with TJvDockVIDVCTree(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;
//=== { TJvDockVIDVCTabServerOption } ========================================
constructor TJvDockVIDVCTabServerOption.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;
end;
destructor TJvDockVIDVCTabServerOption.Destroy;
begin
FActiveFont.Free;
FInactiveFont.Free;
inherited Destroy;
end;
procedure TJvDockVIDVCTabServerOption.Assign(Source: TPersistent);
var
Src: TJvDockVIDVCTabServerOption;
begin
if Source is TJvDockVIDVCTabServerOption then
begin
BeginUpdate;
try
Src := TJvDockVIDVCTabServerOption(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 TJvDockVIDVCTabServerOption.FontChanged(Sender: TObject);
begin
Changed;
end;
procedure TJvDockVIDVCTabServerOption.SetActiveFont(Value: TFont);
begin
FActiveFont.Assign(Value);
end;
procedure TJvDockVIDVCTabServerOption.SetActiveSheetColor(const Value: TColor);
begin
if FActiveSheetColor <> Value then
begin
FActiveSheetColor := Value;
Changed;
end;
end;
procedure TJvDockVIDVCTabServerOption.SetHotTrackColor(const Value: TColor);
begin
if FHotTrackColor <> Value then
begin
FHotTrackColor := Value;
Changed;
end;
end;
procedure TJvDockVIDVCTabServerOption.SetInactiveFont(Value: TFont);
begin
FInactiveFont.Assign(Value);
end;
procedure TJvDockVIDVCTabServerOption.SetInactiveSheetColor(const Value: TColor);
begin
if FInactiveSheetColor <> Value then
begin
FInactiveSheetColor := Value;
Changed;
end;
end;
procedure TJvDockVIDVCTabServerOption.SetShowTabImages(const Value: Boolean);
begin
if FShowTabImages <> Value then
begin
FShowTabImages := Value;
Changed;
end;
end;
procedure TJvDockVIDVCTabServerOption.SetTabPosition(const Value: TTabPosition);
begin
if Value = tpBottom then
inherited SetTabPosition(Value)
else
raise Exception.CreateRes(@RsEDockTabPositionMustBetpBottom);
end;
///=== { TJvDockVIDVCConjoinServerOption } ===================================
constructor TJvDockVIDVCConjoinServerOption.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 TJvDockVIDVCConjoinServerOption.Destroy;
begin
{ Make sure we unregister, can be called more than once }
UnRegisterSettingChangeClient(Self);
FActiveFont.Free;
FInactiveFont.Free;
inherited Destroy;
end;
procedure TJvDockVIDVCConjoinServerOption.Assign(Source: TPersistent);
var
Src: TJvDockVIDVCConjoinServerOption;
begin
if Source is TJvDockVIDVCConjoinServerOption then
begin
BeginUpdate;
try
Src := TJvDockVIDVCConjoinServerOption(Source);
TextEllipsis := Src.TextEllipsis;
TextAlignment := Src.TextAlignment;
InactiveTitleEndColor := Src.InactiveTitleEndColor;
InactiveTitleStartColor := Src.InactiveTitleStartColor;
ActiveTitleEndColor := Src.ActiveTitleEndColor;
ActiveTitleStartColor := Src.ActiveTitleStartColor;
ActiveFont := Src.ActiveFont;
InactiveFont := Src.InactiveFont;
SystemInfo := Src.SystemInfo;
inherited Assign(Source);
finally
EndUpdate;
end;
end
else
inherited Assign(Source);
end;
procedure TJvDockVIDVCConjoinServerOption.SetActiveTitleEndColor(const Value: TColor);
begin
if FActiveTitleEndColor <> Value then
begin
FActiveTitleEndColor := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDVCConjoinServerOption.SetActiveTitleStartColor(const Value: TColor);
begin
if FActiveTitleStartColor <> Value then
begin
FActiveTitleStartColor := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDVCConjoinServerOption.SetInactiveTitleEndColor(const Value: TColor);
begin
if FInactiveTitleEndColor <> Value then
begin
FInactiveTitleEndColor := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDVCConjoinServerOption.SetInactiveTitleStartColor(const Value: TColor);
begin
if FInactiveTitleStartColor <> Value then
begin
FInactiveTitleStartColor := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDVCConjoinServerOption.SetSystemInfo(const Value: Boolean);
begin
if FSystemInfo <> Value then
begin
if FSystemInfo then
UnRegisterSettingChangeClient(Self);
FSystemInfo := Value;
if FSystemInfo then
begin
RegisterSettingChangeClient(Self, SettingChange);
SetDefaultSystemCaptionInfo;
end;
end;
end;
procedure TJvDockVIDVCConjoinServerOption.SetTextAlignment(
const Value: TAlignment);
begin
if FTextAlignment <> Value then
begin
FTextAlignment := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDVCConjoinServerOption.SetTextEllipsis(const Value: Boolean);
begin
if FTextEllipsis <> Value then
begin
FTextEllipsis := Value;
SystemInfo := False;
Changed;
end;
end;
procedure TJvDockVIDVCConjoinServerOption.SetDefaultSystemCaptionInfo;
var
Saved: Boolean;
begin
{ We use a trick to temporarily disable changing of SystemInfo; by
setting FSystemInfo to false.
}
Saved := SystemInfo;
BeginUpdate;
FSystemInfo := False;
try
UpdateDefaultSystemCaptionInfo;
finally
FSystemInfo := Saved;
EndUpdate;
end;
end;
procedure TJvDockVIDVCConjoinServerOption.SetActiveFont(Value: TFont);
begin
FActiveFont.Assign(Value);
end;
procedure TJvDockVIDVCConjoinServerOption.SetInactiveFont(Value: TFont);
begin
FInactiveFont.Assign(Value);
end;
procedure TJvDockVIDVCConjoinServerOption.FontChanged(Sender: TObject);
begin
SystemInfo := False;
Changed;
end;
procedure TJvDockVIDVCConjoinServerOption.UpdateDefaultSystemCaptionInfo;
begin
ActiveTitleStartColor := JvDockGetActiveTitleBeginColor;
ActiveTitleEndColor := JvDockGetActiveTitleEndColor;
InactiveTitleStartColor := JvDockGetInactiveTitleBeginColor;
InactiveTitleEndColor := JvDockGetInactiveTitleEndColor;
TextAlignment := taLeftJustify;
TextEllipsis := True;
ActiveFont := JvDockGetTitleFont;
ActiveFont.Style := ActiveFont.Style + [fsBold];
InactiveFont := ActiveFont;
ActiveFont.Color := JvDockGetActiveTitleFontColor;
InactiveFont.Color := JvDockGetInactiveTitleFontColor;
GrabbersSize := VIDDefaultDockGrabbersSize;
SplitterWidth := VIDDefaultDockSplitterWidth;
end;
function TJvDockVIDVCConjoinServerOption.IsNotSystemInfo: Boolean;
begin
Result := not SystemInfo;
end;
procedure TJvDockVIDVCConjoinServerOption.SettingChange(Sender: TObject);
begin
{ ?? }
//DockStyle.ParentForm.Caption := '';
if SystemInfo then
SetDefaultSystemCaptionInfo;
end;
procedure TJvDockVIDVCConjoinServerOption.Changed;
begin
inherited Changed;
SystemInfo := SystemInfo and (GrabbersSize = VIDDefaultDockGrabbersSize) and
(SplitterWidth = VIDDefaultDockSplitterWidth);
TJvDockVIDVCStyle(DockStyle).DoSystemInfoChange(SystemInfo);
end;
procedure TJvDockVIDVCTree.DrawDockSiteRect;
var
Rect: TRect;
begin
inherited DrawDockSiteRect;
Rect := DockSite.ClientRect;
InflateRect(Rect, BorderWidth, 0);
if DockSite.Align = alTop then
Inc(Rect.Bottom, BorderWidth)
else
if DockSite.Align = alBottom then
Dec(Rect.Top, BorderWidth);
Frame3D(Canvas, Rect, clBtnShadow, clBtnHighlight, 1);
Frame3D(Canvas, Rect, clBtnHighlight, clBtnShadow, 1);
Canvas.Pen.Color := clBlack;
if DockSite.Align = alRight then
begin
Canvas.MoveTo(0, 0);
Canvas.LineTo(0, DockSite.Height);
end
else
if DockSite.Align = alBottom then
begin
Canvas.MoveTo(0, 0);
Canvas.LineTo(DockSite.Width, 0);
end;
end;
function TJvDockVIDVCTree.DoLButtonDown(var Msg: TWMMouse;
var Zone: TJvDockZone; out HTFlag: Integer): Boolean;
var
TempZone: TJvDockVIDVCZone;
Active: Boolean;
begin
Result := inherited DoLButtonDown(Msg, Zone, HTFlag);
if (Zone <> nil) and (HTFlag = HTEXPAND) then
begin
TempZone := TJvDockVIDVCZone(Zone);
Active := ((TempZone.ParentZone.Orientation <> DockSiteOrientation) and
(TempZone.ParentZone.VisibleChildCount >= 2));
if Active then
begin
TempZone.ExpandButtonDown := True;
TempZone.MouseDown := True;
FExpandBtnZone := TempZone;
DockSite.Invalidate;
end;
end;
end;
procedure TJvDockVIDVCTree.DoMouseMove(var Msg: TWMMouse;
var Zone: TJvDockZone; out HTFlag: Integer);
var
TempZone: TJvDockVIDVCZone;
begin
inherited DoMouseMove(Msg, Zone, HTFlag);
if SizingZone = nil then
begin
TempZone := TJvDockVIDVCZone(Zone);
if ((TempZone <> nil) and (TempZone.ExpandButtonDown <> (HTFlag = HTEXPAND)) and
((FExpandBtnZone = TempZone) and FExpandBtnZone.MouseDown)) then
begin
TempZone.ExpandButtonDown := (HTFlag = HTEXPAND) and FExpandBtnZone.MouseDown;
DockSite.Invalidate;
end;
end;
end;
procedure TJvDockVIDVCTree.DoLButtonUp(var Msg: TWMMouse;
var Zone: TJvDockZone; out HTFlag: Integer);
var
TempZone: TJvDockVIDVCZone;
begin
inherited DoLButtonUp(Msg, Zone, HTFlag);
if (SizingZone = nil) and (FExpandBtnZone <> nil) then
begin
FExpandBtnZone := nil;
if (Zone <> nil) and (HTFlag = HTEXPAND) then
begin
TempZone := TJvDockVIDVCZone(Zone);
TempZone.ExpandButtonDown := False;
if TempZone.ZoneSizeStyle in [zssMaximum] then
TJvDockVIDVCZone(TempZone.ParentZone).DoSetChildSizeStyle(zssNormal)
else
begin
TJvDockVIDVCZone(TempZone.ParentZone).DoSetChildSizeStyle(zssMinimum);
TempZone.ZoneSizeStyle := zssMaximum;
end;
ResetDockZoneSizeStyle(TempZone.ParentZone, TempZone.ZoneSizeStyle, nil);
DockSite.Invalidate;
end;
end;
end;
procedure TJvDockVIDVCZone.DoSetChildSizeStyle(ZoneSizeStyle: TJvDockZoneSizeStyle);
var
Zone: TJvDockVIDVCZone;
begin
Zone := TJvDockVIDVCZone(ChildZones);
while Zone <> nil do
begin
Zone.ZoneSizeStyle := ZoneSizeStyle;
Zone := TJvDockVIDVCZone(Zone.AfterClosestVisibleZone);
end;
end;
procedure TJvDockVIDVCTree.ResetDockZoneSizeStyle(Parent: TJvDockZone;
ZoneSizeStyle: TJvDockZoneSizeStyle; Exclude: TJvDockZone);
var
Zone: TJvDockVIDVCZone;
ChildCount: Integer;
AverageSize: Integer;
begin
ChildCount := Parent.VisibleChildCount - Integer((Exclude <> nil) and (Exclude.ParentZone = Parent));
AverageSize := DockSiteSizeAlternate div ChildCount;
Assert(AverageSize > 0);
Zone := TJvDockVIDVCZone(Parent.FirstVisibleChildZone);
while Zone <> nil do
begin
if Exclude <> Zone then
begin
Dec(ChildCount);
if ZoneSizeStyle in [zssMaximum] then
begin
if Zone.ZoneSizeStyle = zssMinimum then
Zone.ZoneLimit := Zone.LimitBegin + MinSize
else
if Zone.ZoneSizeStyle = zssMaximum then
Zone.ZoneLimit := DockSiteSizeAlternate - ChildCount * MinSize;
end
else
if ZoneSizeStyle in [zssNormal] then
Zone.ZoneLimit := Zone.LimitBegin + AverageSize;
end
else
if Exclude <> nil then
Exclude.ZoneLimit := Exclude.LimitBegin;
Zone := TJvDockVIDVCZone(Zone.AfterClosestVisibleZone);
end;
SetNewBounds(Parent);
ForEachAt(Parent, UpdateZone, tskForward);
end;
{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
RegisterUnitVersion(HInstance, UnitVersioning);
finalization
UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}
end.