关于 Delphi 中窗体的停靠
对于停靠技术，网络上已有大篇的文件在述说。比较：高级停靠(Dock)技术的实现 ，这个是实现最复杂的（个人认为）。当然，我所使用的方法是参考了 Using the TDockTabSet component by Jeremy North . 这个方法是使用了自Delphi2005之后出现的TDockTabSet控件，对于其使用方法,有兴趣的朋友可以在网上搜索下。
OK,下面来看下效果
接下来，就要到代码了。哈哈，大家关心的可能就是这个。不过在这之前你还是先把上面的那个“Using the TDockTabSet component by Jeremy North ”理解下.
代码实现其实很简单，我这里主要是使用接口及类封装
先看下接口部分
IDockForm
这个就是需要被显示的窗体需实现的接口。其实接口的方法，属性有些窗体本身的方法，属性已经实现了，必要的是（你只需要把下面的部分代码抄过去就OK了）
procedure TForm12.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ManualFloat(Rect(0, 0, 0, 0));
Action := caFree;
end;
procedure TForm12.FormStartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
DragObject := TDragDockObjectEx.Create(Self);
DragObject.Brush.Color := clAqua;
end;
function TForm12.GetDockSite: TWinControl;
begin
Result := FDockSite;
end;
function TForm12.ManualDock(NewDockSite: TWinControl; DropControl: TControl;
ControlSide: TAlign): Boolean;
begin
Result := inherited ManualDock(NewDockSite, DropControl, ControlSide);
end;
procedure TForm12.SetBorderSytle(const Value: TFormBorderStyle);
begin
if BorderStyle <> Value then
BorderStyle:=Value;
end;
procedure TForm12.SetDockSite(const Value: TWinControl);
begin
FDockSite := Value;
end;
procedure TForm12.SetDragKind(const Value: TDragKind);
begin
if DragKind <> Value then
DragKind:=Value;
end;
procedure TForm12.SetDragMode2(const Value: TDragMode);
begin
if DragMode <> Value then
DragMode:=Value;
end;
IDockSite , IDockManagenmnet
这两个接口无需你来实现，它们是用来管理停靠和实现停靠位置的。
原理
首先创建的IDockManagenmnet 根据停靠的方位TDockSiteAlign,来创建停靠点IDockSite,有了停靠点就可以添加停靠窗体IDockForm了。
1、创建 DockManagenment
2、
3、
=============================代码实现部分(20100410放出)======================================
1、FunctionLibrary.UIDApi.Dock.pas 接口声明
{ --------------------------------窗体停止支持接口函数库概述--------------------------------
CreateTime : 2009-10-11
Platform : Windows 7 (7600.16385.090713-1255) 简体中文旗舰版
IDE : Embarcadero Delphi 2010 Version 14.0.3513.24210
Description : 函数库(FunctionLibrary.*.pas)是一些常函数单元文件,基于win7及
RAD2010的基础上开发,可能存在向下兼容的问题.
关于单元内变量,常量,类型及函数、过程的定义以"组"为标准,即作为同
一处理函数的数据定义在一起.
Example :
}
unit Core.Dock;
interface
uses
Forms,Controls,Classes;
type
TDockSiteAlign = (dsaLeft,dsaBottom,dsaRight);
IDockForm = interface
['{FFE9B72A-EEBD-4201-9346-98D513F0E207}']
procedure SetBorderSytle(const Value:TFormBorderStyle);
property BorderStyle:TFormBorderStyle write SetBorderSytle;
procedure SetDragKind(const Value:TDragKind);
property DragKind:TDragKind write SetDragKind;
procedure SetDragMode2(const Value:TDragMode);
property DragMode:TDragMode write SetDragMode2;
function GetDockSite:TWinControl;
procedure SetDockSite(const Value:TWinControl);
property DockSite:TWinControl read GetDockSite write SetDockSite;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormStartDock(Sender: TObject; var DragObject: TDragDockObject);
function ManualDock(NewDockSite: TWinControl; DropControl: TControl = nil;
ControlSide: TAlign = alNone): Boolean;
procedure Show;
procedure Close;
end;
IDockSite = interface
['{CDD2B1D8-63AE-494A-85A1-768D34D970A4}']
function AddDockForm(const DockForm:IDockForm):Boolean;
function GetVisible:Boolean;
procedure SetVisible(const Value:Boolean);
property Visible:Boolean read GetVisible write SetVisible;
function GetWidth:Integer;
procedure SetWidth(const Value:Integer);
property Width:Integer read GetWidth write SetWidth;
procedure SetAlign(const Value:TDockSiteAlign);
property Align:TDockSiteAlign write SetAlign;
end;
IDockManagemnet = interface
['{3754DE0D-425B-4A43-AF02-616A1A5C46EC}']
function AddDockSite(const Align:TDockSiteAlign):IDockSite;
function GetDockSite(const Align:TDockSiteAlign):IDockSite;
end;
const
DockFormGUID:TGUID='{FFE9B72A-EEBD-4201-9346-98D513F0E207}';
implementation
end.
2、FunctionLibrary.UIDApi.Impl.pas 接口实现
{ --------------------------------窗体停止支持主程序实现函数库概述--------------------------------
CreateTime : 2009-10-11
Platform : Windows 7 (7600.16385.090713-1255) 简体中文旗舰版
IDE : Embarcadero Delphi 2010 Version 14.0.3513.24210
Description : 函数库(FunctionLibrary.*.pas)是一些常函数单元文件,基于win7及
RAD2010的基础上开发,可能存在向下兼容的问题.
关于单元内变量,常量,类型及函数、过程的定义以"组"为标准,即作为同
一处理函数的数据定义在一起.
Example :
}
unit Core.Dock.Impl;
interface
uses
FunctionLibrary.UIDApi.Dock, Classes, Controls,
DockTabSet, ExtCtrls, Tabs, ComCtrls, Types, SysUtils;
type
TDockSiteControl = class
strict private
FOwner: IDockSite;
FDockTabSet: TDockTabSet;
FDockSplitter: TSplitter;
FDockPanel: TPanel;
procedure SetDockPanel(const Value: TPanel);
procedure SetDockSplitter(const Value: TSplitter);
procedure SetDockTabSet(const Value: TDockTabSet);
public
constructor Create(const AOwner: IDockSite);
destructor Destroy; override;
property DockTabSet: TDockTabSet read FDockTabSet write SetDockTabSet;
property DockPanel: TPanel read FDockPanel write SetDockPanel;
property DockSplitter: TSplitter read FDockSplitter write SetDockSplitter;
end;
TDockSite = class(TInterfacedObject, IDockSite)
strict private
FOwner: IDockManagemnet;
FHost:TWinControl;
FVisible: Boolean;
FWidth: Integer;
FDockSiteControl: TDockSiteControl;
FAlign: TDockSiteAlign;
FCount: Integer;
FDockFormList: array of IDockForm;
function GetDockFormIndex(const DockForm: IDockForm): Integer;
// Events for inner controls
procedure OnDockTabSetTabAdded(Sender: TObject);
procedure OnDockPanelDockDrop(Sender: TObject; Source: TDragDockObject;
X, Y: Integer);
procedure OnDockPanelUnDock(Sender: TObject; Client: TControl;
NewTarget: TWinControl; var Allow: Boolean);
procedure OnDockPanelDockOver(Sender: TObject; Source: TDragDockObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure OnDockTabSetDragDrop(Sender, Source: TObject; X, Y: Integer);
procedure OnDockTabSetTabRemoved(Sender: TObject);
strict protected
function GetVisible: Boolean;
function GetWidth: Integer;
procedure SetVisible(const Value: Boolean);
procedure SetWidth(const Value: Integer);
procedure SetAlign(const Value: TDockSiteAlign);
public
constructor Create(const AOwner: IDockManagemnet; const Host: TWinControl);
destructor Destroy; override;
function AddDockForm(const DockForm: IDockForm): Boolean;
end;
TDockManagement = class(TInterfacedObject, IDockManagemnet)
strict private
FAOwner: TComponent;
DockSiteList: array [TDockSiteAlign] of IDockSite;
public
constructor Create(AOwner: TComponent);
destructor Destroy; override;
function AddDockSite(const Align: TDockSiteAlign): IDockSite;
function GetDockSite(const Align: TDockSiteAlign): IDockSite;
end;
implementation
{$REGION ' TDockManagement '}
{ TDockManagement }
function TDockManagement.AddDockSite(const Align: TDockSiteAlign): IDockSite;
begin
if Assigned(DockSiteList[Align]) then
Exit(DockSiteList[Align]);
Result := TDockSite.Create(Self, TWinControl(FAOwner));
DockSiteList[Align] := Result;
Result.Align := Align;
end;
constructor TDockManagement.Create(AOwner: TComponent);
begin
FAOwner := AOwner;
end;
destructor TDockManagement.Destroy;
begin
DockSiteList[dsaRight] := nil;
DockSiteList[dsaLeft] := nil;
DockSiteList[dsaBottom] := nil;
FAOwner := nil;
inherited;
end;
function TDockManagement.GetDockSite(const Align: TDockSiteAlign): IDockSite;
begin
Result := nil;
if Assigned(DockSiteList[Align]) then
Result := DockSiteList[Align];
end;
{$ENDREGION}
{ TDockSite }
function TDockSite.AddDockForm(const DockForm: IDockForm): Boolean;
var
Len, Index: Integer;
begin
Result := False;
Index := GetDockFormIndex(DockForm);
if Index > -1 then
Exit;
DockForm.DockSite := FDockSiteControl.DockPanel;
Len := Length(FDockFormList);
if Len = 0 then
SetLength(FDockFormList, 4)
else if Len = FCount then
SetLength(FDockFormList, Len * 2);
FDockFormList[FCount] := DockForm;
Inc(FCount);
Result := True;
end;
constructor TDockSite.Create(const AOwner: IDockManagemnet;
const Host: TWinControl);
begin
FDockSiteControl := TDockSiteControl.Create(Self);
FOwner := AOwner;
FHost:=Host;
with FDockSiteControl do
begin
DockTabSet := TDockTabSet.Create(Host);
with DockTabSet do
begin
Parent := TWinControl(Host);
Visible := False;
DockSite := False;
ShrinkToFit := True;
Style := tsModernTabs;
DestinationDockSite := nil;
OnDragDrop := OnDockTabSetDragDrop;
OnTabRemoved := OnDockTabSetTabRemoved;
OnTabAdded:=OnDockTabSetTabAdded;
end;
DockPanel := TPanel.Create(Host);
with DockPanel do
begin
Parent := TWinControl(Host);
Caption := '';
Visible := False;
Width := 0;
BevelOuter := bvNone;
DockSite := True;
OnDockDrop := OnDockPanelDockDrop;
onDockOver := OnDockPanelDockOver;
OnUnDock := OnDockPanelUnDock;
end;
DockTabSet.DestinationDockSite := DockPanel;
DockSplitter := TSplitter.Create(Host);
with DockSplitter do
begin
Parent := TWinControl(Host);
Visible := False;
Width := 4;
end;
end;
end;
destructor TDockSite.Destroy;
var
Item: IDockForm;
begin
for Item in FDockFormList do
if Assigned(Item) then
Item.Close;
SetLength(FDockFormList, 0);
FDockSiteControl.Free;
FOwner := nil;
FHost:=nil;
inherited;
end;
procedure TDockSite.OnDockTabSetTabAdded(Sender: TObject);
begin
FDockSiteControl.DockTabSet.Visible:=True;
end;
function TDockSite.GetDockFormIndex(const DockForm: IDockForm): Integer;
var
i: Integer;
begin
Result := -1;
for i := 0 to FCount - 1 do
if FDockFormList[i] = DockForm then
Result := i;
end;
function TDockSite.GetVisible: Boolean;
begin
Result := FVisible;
end;
function TDockSite.GetWidth: Integer;
begin
Result := FWidth;
end;
procedure TDockSite.OnDockPanelDockDrop
(Sender: TObject; Source: TDragDockObject; X, Y: Integer);
begin
with FDockSiteControl do
begin
if not DockPanel.Visible then
DockPanel.Visible:=True;
case FAlign of
dsaLeft, dsaRight:
begin
if DockPanel.Width = 0 then
DockPanel.Width := FWidth;
end;
dsaBottom:
begin
if DockPanel.Height = 0 then
DockPanel.Height := FWidth;
end;
end;
case FAlign of
dsaBottom:
begin
DockPanel.Top:=DockTabSet.Top - DockPanel.Height;
DockSplitter.Top:=DockPanel.Height - 4;
end;
dsaLeft:
begin
DockPanel.Left:=DockTabSet.Width;
DockSplitter.Left:=DockPanel.Width + DockPanel.Left;
end;
dsaRight:
begin
DockPanel.Left:=DockTabSet.Left - DockPanel.Width;
DockSplitter.Left:=DockPanel.Left - 4;
end;
end;
DockSplitter.Visible := True;
end;
end;
procedure TDockSite.OnDockPanelDockOver
(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState;
var Accept: Boolean);
var
lRect: TRect;
begin
Accept := Supports(Source.Control, DockFormGUID);
if Accept then
begin
with FDockSiteControl do
begin
case FAlign of
dsaLeft:
begin
lRect.TopLeft := DockPanel.ClientToScreen(Point(0, 0));
lRect.BottomRight := DockPanel.ClientToScreen(Point(150,DockPanel.Height));
end;
dsaBottom:
begin
lRect.TopLeft := DockPanel.ClientToScreen(Point(0, 0));
lRect.BottomRight := DockPanel.ClientToScreen(Point(DockPanel.Width,-150));
end;
dsaRight:
begin
lRect.TopLeft := DockPanel.ClientToScreen(Point(-150,0));
lRect.BottomRight := DockPanel.ClientToScreen(Point(0 ,DockPanel.Height));
end;
end;
end;
Source.DockRect := lRect;
end;
end;
procedure TDockSite.OnDockPanelUnDock(Sender: TObject; Client: TControl;
NewTarget: TWinControl; var Allow: Boolean);
begin
with FDockSiteControl do
begin
if DockPanel.DockClientCount = 1 then
begin
case FAlign of
dsaLeft, dsaRight:
DockPanel.Width := 0;
dsaBottom:
DockPanel.Height := 0;
end;
DockSplitter.Visible := False;
end;
end;
end;
procedure TDockSite.OnDockTabSetDragDrop(Sender, Source: TObject;
X, Y: Integer);
begin
FDockSiteControl.DockTabSet.Visible := True;
end;
procedure TDockSite.OnDockTabSetTabRemoved(Sender: TObject);
begin
FDockSiteControl.DockTabSet.Visible :=
FDockSiteControl.DockTabSet.Tabs.Count > 0;
end;
procedure TDockSite.SetAlign(const Value: TDockSiteAlign);
procedure SetControlAlign(const Alg: TAlign);
begin
with FDockSiteControl do
begin
with DockTabSet do
begin
Align := Alg;
case Alg of
alBottom:
begin
TabPosition := tpBottom;
DockPanel.Top:=Top - DockPanel.Height;
DockSplitter.Top:=DockPanel.Height - 4;
end;
alLeft:
begin
TabPosition := tpLeft;
DockPanel.Left:=Width;
DockSplitter.Left:=DockPanel.Width + DockPanel.Left;
end;
alRight:
begin
TabPosition := tpRight;
DockPanel.Left:=Left - DockPanel.Width;
DockSplitter.Left:=DockPanel.Left - 4;
end;
end;
DockPanel.Align := Alg;
DockSplitter.Align := Alg;
end;
end;
end;
begin
if FAlign <> Value then
FAlign := Value;
with FDockSiteControl do
begin
case Value of
dsaLeft:
begin
DockTabSet.Width := 25;
SetControlAlign(alLeft);
end;
dsaBottom:
begin
DockTabSet.Height := 25;
DockPanel.Height := 0;
SetControlAlign(alBottom);
end;
dsaRight:
begin
DockTabSet.Width := 25;
SetControlAlign(alRight);
end;
end;
end;
end;
procedure TDockSite.SetVisible(const Value: Boolean);
begin
if FVisible <> Value then
begin
FVisible := Value;
with FDockSiteControl do
begin
DockTabSet.Visible := Value;
DockPanel.Visible := Value;
// DockSplitter.Visible := Value;
end;
end;
end;
procedure TDockSite.SetWidth(const Value: Integer);
begin
if FWidth <> Value then
FWidth := Value;
end;
{$REGION ' TDockSiteControl '}
{ TDockSiteControl }
constructor TDockSiteControl.Create(const AOwner: IDockSite);
begin
FOwner := AOwner;
end;
destructor TDockSiteControl.Destroy;
begin
FOwner := nil;
if Assigned(FDockPanel) then
FDockPanel.Free;
if Assigned(FDockTabSet) then
FDockTabSet.Free;
if Assigned(FDockSplitter) then
FDockSplitter.Free;
inherited;
end;
procedure TDockSiteControl.SetDockPanel(const Value: TPanel);
begin
FDockPanel := Value;
end;
procedure TDockSiteControl.SetDockSplitter(const Value: TSplitter);
begin
FDockSplitter := Value;
end;
procedure TDockSiteControl.SetDockTabSet(const Value: TDockTabSet);
begin
FDockTabSet := Value;
end;
{$ENDREGION}
end.
浙公网安备 33010602011771号