关于 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.