Home: Code Repository: Mastering Delphi 5

Project DOCKTEST

Project Structure

DOCKTEST.DPR
DOCKFORM.PAS
DOCKHOST.PAS
DOCKFORM.DFM
DOCKHOST.DFM

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.

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.

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.

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

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