Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 08 - Project DockTest

Project Structure

DockTest.dpr
program DockTest;

uses
  Forms,
  DockForm in 'DockForm.pas' {Form1},
  DockHost in 'DockHost.pas' {Form2};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
DockForm.pas
unit DockForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Menus;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button2: TButton;
    Button3: TButton;
    Memo1: TMemo;
    Splitter1: TSplitter;
    PopupMenu1: TPopupMenu;
    DocktoPanel1: TMenuItem;
    DocktoForm1: TMenuItem;
    Floating1: TMenuItem;
    Splitter2: TSplitter;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure Panel1DockDrop(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer);
    procedure ControlStartDock(Sender: TObject;
      var DragObject: TDragDockObject);
    procedure Panel1DockOver(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer; State: TDragState; var Accept: Boolean);
    procedure DocktoPanel1Click(Sender: TObject);
    procedure DocktoForm1Click(Sender: TObject);
    procedure Floating1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    DockFileName: string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  DockHost;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  FileStr: TFileStream;
begin
  // Panel1.DockOrientation := doHorizontal;
  Memo1.FloatingDockSiteClass := TForm2;
  ListBox1.FloatingDockSiteClass := TCustomDockForm;

  // relaod the settings
  DockFileName := ExtractFilePath (Application.Exename) +
    'dock.dck';
  if FileExists (DockFileName) then
  begin
    FileStr := TFileStream.Create (DockFileName, fmOpenRead);
    try
      Panel1.DockManager.LoadFromStream (FileStr);
    finally
      FileStr.Free;
    end;
  end;
  Panel1.DockManager.ResetBounds (True);
end;

procedure TForm1.Panel1DockDrop(Sender: TObject; Source: TDragDockObject;
  X, Y: Integer);
begin
  Caption := 'Docked: ' + IntToStr (Panel1.DockClientCount);
end;

procedure TForm1.ControlStartDock(Sender: TObject;
  var DragObject: TDragDockObject);
begin
  Caption := 'Docking ' + (Sender as TComponent).Name;
end;

procedure TForm1.Panel1DockOver(Sender: TObject; Source: TDragDockObject;
  X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Caption := 'Docking: ' + Source.Control.Name;
  Accept := True;
end;

procedure TForm1.DocktoPanel1Click(Sender: TObject);
begin
  // dock to the panel
  ListBox1.ManualDock (Panel1, Panel1, alBottom);
end;

procedure TForm1.DocktoForm1Click(Sender: TObject);
begin
  // dock to the current form
  ListBox1.Dock (Self, Rect (200, 100, 100, 100));
end;

procedure TForm1.Floating1Click(Sender: TObject);
begin
  // toggle the floating status
  if ListBox1.Floating then
    ListBox1.ManualDock (Panel1, Panel1, alBottom)
  else
    ListBox1.ManualFloat (Rect (100, 100, 200, 300));
  Floating1.Checked := ListBox1.Floating;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  FileStr: TFileStream;
begin
  if Panel1.DockClientCount > 0 then
  begin
    FileStr := TFileStream.Create (DockFileName,
      fmCreate or fmOpenWrite);
    try
      Panel1.DockManager.SaveToStream (FileStr);
    finally
      FileStr.Free;
    end;
  end
  else
    // remove the file
    DeleteFile (DockFileName);
end;

end.
DockHost.pas
unit DockHost;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm2 = class(TForm)
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDockDrop(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

uses DockForm;

{$R *.DFM}

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if DockClientCount > 0 then
    DockClients [0].ManualDock (Form1.Panel1);
end;

procedure TForm2.FormDockDrop(Sender: TObject; Source: TDragDockObject; X,
  Y: Integer);
begin
  Show;
end;

end.
DockForm.dfm
object Form1: TForm1
  Left = 188
  Top = 107
  Width = 474
  Height = 480
  Caption = 'DockTest'
  Color = clBtnFace
  UseDockManager = True
  DragKind = dkDock
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 129
    Top = 0
    Width = 3
    Height = 453
    Cursor = crHSplit
  end
  object Splitter2: TSplitter
    Left = 132
    Top = 0
    Width = 3
    Height = 453
    Cursor = crHSplit
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 129
    Height = 453
    Align = alLeft
    BorderWidth = 1
    DockSite = True
    DragKind = dkDock
    TabOrder = 0
    OnDockDrop = Panel1DockDrop
    OnDockOver = Panel1DockOver
  end
  object Panel2: TPanel
    Left = 136
    Top = 0
    Width = 329
    Height = 41
    DragKind = dkDock
    DragMode = dmAutomatic
    TabOrder = 1
    OnStartDock = ControlStartDock
    object Button2: TButton
      Left = 16
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Button2'
      TabOrder = 0
    end
    object Button3: TButton
      Left = 96
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Button3'
      TabOrder = 1
    end
  end
  object Memo1: TMemo
    Left = 0
    Top = 340
    Width = 465
    Height = 113
    DragKind = dkDock
    DragMode = dmAutomatic
    Lines.Strings = (
      'Memo1')
    TabOrder = 2
    OnStartDock = ControlStartDock
  end
  object ListBox1: TListBox
    Left = 136
    Top = 40
    Width = 329
    Height = 297
    DragKind = dkDock
    DragMode = dmAutomatic
    ItemHeight = 13
    Items.Strings = (
      'one'
      'two'
      'three')
    PopupMenu = PopupMenu1
    TabOrder = 3
    OnStartDock = ControlStartDock
  end
  object PopupMenu1: TPopupMenu
    Left = 400
    Top = 152
    object DocktoPanel1: TMenuItem
      Caption = 'Dock to Panel'
      OnClick = DocktoPanel1Click
    end
    object DocktoForm1: TMenuItem
      Caption = 'Dock to Form'
      OnClick = DocktoForm1Click
    end
    object Floating1: TMenuItem
      Caption = 'Floating'
      OnClick = Floating1Click
    end
  end
end
DockHost.dfm
object Form2: TForm2
  Left = 636
  Top = 220
  Width = 194
  Height = 190
  BorderStyle = bsSizeToolWin
  Caption = 'Form2'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnDockDrop = FormDockDrop
  PixelsPerInch = 96
  TextHeight = 13
end