☆幅を指定したDocking

タイトルだけでは、よくわからないと思いますが、実現したい処理としては上のようなフォームにおいて、起動時にForm2とForm3の幅を指定して表示させたいというだけのことです。ただそれだけのことなのに、ここ数日ずっと悩んでいました。例のごとく力技ですけど、なんとか動くようになりましたので載せておきますね。

ポイントとしては、Form2,Form3を指定サイズに設定後、それらの間に表示されるSplitter？をメッセージで所定の位置に移動させているところです。でもこんな単純なこと、もっと簡単に設定する方法があるかも知れませんね。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Tabs, DockTabSet;

type
  Taa = class(TDockTree);
  TForm1 = class(TForm)
    Memo1: TMemo;
    DockTabSet1: TDockTabSet;
    Panel1: TPanel;
    procedure FormShow(Sender: TObject);
    procedure DockTabSet1DockDrop(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer);
    procedure DockTabSet1TabRemoved(Sender: TObject);
    procedure Panel1DockOver(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer; State: TDragState; var Accept: Boolean);
    procedure Panel1DockDrop(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer);
    procedure Panel1UnDock(Sender: TObject; Client: TControl;
      NewTarget: TWinControl; var Allow: Boolean);
  private
  public
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3, Unit4, Unit5;

{$R *.dfm}

const
  DockPanelHeight = 100;

procedure TForm1.DockTabSet1DockDrop(Sender: TObject; Source: TDragDockObject;
  X, Y: Integer);
begin
  DockTabSet1.Visible := True;
  DockTabSet1.Top := Height - (DockTabSet1.Height) +1;
end;

procedure TForm1.DockTabSet1TabRemoved(Sender: TObject);
begin
  DockTabSet1.Visible := DockTabSet1.Tabs.Count > 0;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  I: Integer;
begin
  { ドッキング設定 }

  // フォームの高さ---必須処理ではありません。
  Form2.Height := DockPanelHeight;
  Form3.Height := DockPanelHeight;
  Form4.Height := DockPanelHeight;
  Form5.Height := DockPanelHeight;

  // フォームが一瞬表示されてしまうので、画面の外に表示させます。
  Form2.Left := -2000;
  Form3.Left := -2000;
  Form4.Left := -2000;
  Form5.Left := -2000;

  // フォームの表示
  Form2.Show;
  Form3.Show;
  Form4.Show;
  Form5.Show;

  // ドッキング処理---Panel1
  Form2.ManualDock(Panel1,Panel1,alLeft);
  Form3.ManualDock(Panel1,Panel1,alClient);

  I := Panel1.Width div 3;

  Panel1.DockClients[0].Left := 0;
  Panel1.DockClients[0].Width := I;

  // ドッキングによって表示されるSplitter？を力技で移動させます。
  Panel1.Perform(WM_LBUTTONDOWN,0,MakeLParam(Panel1.Width div 2,1));
  Panel1.Perform(WM_MOUSEMOVE,0,MakeLParam(I,1));
  Panel1.Perform(WM_LBUTTONUP,0,MakeLParam(I,1));
  Panel1.DockManager.ResetBounds(False);
                                        
  // ドッキング処理--DockTabSet1
  Form4.ManualDock(DockTabSet1);
  Form5.ManualDock(DockTabSet1);

  // 表示位置の修正
  DockTabSet1.Top := Height - DockTabSet1.Height;  
end;


procedure TForm1.Panel1DockDrop(Sender: TObject; Source: TDragDockObject; X,
  Y: Integer);
begin
  if Panel1.Height = 0 then
    Panel1.Height := DockPanelHeight;
  DockTabSet1.Top := Height+1;
end;

procedure TForm1.Panel1DockOver(Sender: TObject; Source: TDragDockObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  Rect: TRect;
begin
  Accept := (Source.Control = Form2) or (Source.Control = Form3) or
            (Source.Control = Form4) or (Source.Control = Form5);
  if Accept then
  begin
    Rect.TopLeft := Panel1.ClientToScreen(Point(0, 0));

   if Panel1.DockClientCount = 0 then
      // Panel1に何もドッキングされていない状態だと枠がフォームの下に
      // 表示されてしまうため、この処理をしています。
      Rect.BottomRight := Panel1.ClientToScreen(Point(Panel1.Width, -DockPanelHeight))
    else
      Rect.BottomRight := Panel1.ClientToScreen(Point(Panel1.Width, DockPanelHeight));

    Source.DockRect := Rect;
  end;
end;

procedure TForm1.Panel1UnDock(Sender: TObject; Client: TControl;
  NewTarget: TWinControl; var Allow: Boolean);
begin
  if Panel1.DockClientCount = 1 then
    Panel1.Height := 0;
end;

end.

☆ドッキングされたフォーム上のコンポーネントにフォーカスを当てる。

☆TDockTabSetを使ってみる。 で、作ったサンプルで、Form3にパネルとボタンを貼り付け、次のような処理を行います。

procedure TForm3.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  I := ListBox1.Items.Add('NewItem');
  ListBox1.ItemIndex := I;
  ActiveControl := ListBox1;
end;

実行するとこんな感じです。（ドッキング時）

（フローティング時）

コードを見ていただくとわかって頂けるかと思いますが、追加したアイテムにフォーカスを当てる処理です。 この処理は、ドッキングしていない状態の時は、動作しますが、ドッキングしているときは 次のようなメッセージが表示されます。

この問題を解決するために、ドッキングしているかどうかを判断させて次のような処理を行いました。

Form1への追加処理

type
  TForm1 = class(TForm)
  　(略)
  public
    procedure FocusOnListBox;
  end;

    (略)

procedure TForm1.FocusOnListBox;
begin
  ActiveControl := Form3.ListBox1;
end;

Button1Clickを次のように変更します。 フォームがドッキングしているかどうかは、Parentがnilかどうかで判断させます。

procedure TForm3.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  I := ListBox1.Items.Add('NewItem');
  ListBox1.ItemIndex := I;
if Self.Parent = nil then
    ActiveControl := ListBox1
  else
    Form1.FocusOnListBox;
end;

これで問題なく動作しました。

☆TDockTabSetを使ってみる。

Delphiを使っておられる方なら、新コンポーネントの仕様通りに動作しない点やメモリ違反に 悩まされた方も多いと思います。私、昔は率先して新コンポーネント採用してきた方なのですが、 ひどい経験を積み重ねる内に、新コンポーネントの採用は敬遠するようになっていました(笑)

このTDockTabSetも同様で、全く使っていなかったのですが、 Delphi2005で登場してから２世代経って、問題なく動作しているようですね。 （当初から問題なかったのかどうかは知りませんが）

CodeGearのサイトに左側にTDockTabSetを表示するサンプルがあるのですが、 今回は右側に表示させてみました。（ほとんどサンプルのままですけど）

Memo1、Splitter1、Panel1、DockTabSet1を図のように配置します。

次にコードです。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Tabs, DockTabSet, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Splitter1: TSplitter;
    Panel1: TPanel;
    DockTabSet1: TDockTabSet;
    procedure FormShow(Sender: TObject);
    procedure DockTabSet1TabRemoved(Sender: TObject);
    procedure DockTabSet1DockDrop(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer);
    procedure Panel1DockDrop(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer);
    procedure Panel1DockOver(Sender: TObject; Source: TDragDockObject; X,
      Y: Integer; State: TDragState; var Accept: Boolean);
    procedure Panel1UnDock(Sender: TObject; Client: TControl;
      NewTarget: TWinControl; var Allow: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2, Unit3,
   ComCtrls; // ←tpLeftが宣言されています。

{$R *.dfm}

const
  FormWidth = 180;

// 初期設定
procedure TForm1.FormCreate(Sender: TObject);
begin
  // Panel1の設定
  Panel1.DockSite := True;
  Panel1.Width := 0;

  // DockTabSet1の設定
  DockTabSet1.Width := 25;
  DockTabSet1.DockSite := False;
  DockTabSet1.ShrinkToFit := True;
  DockTabSet1.Style := tsModernTabs;
  DockTabSet1.DestinationDockSite := Panel1;
  DockTabSet1.TabPosition := tpLeft;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Panel1.Caption := '';

  // フォームの幅
  Form2.Width := FormWidth;
  Form3.Width := FormWidth;

  // フォームが一瞬表示されてしまうので、画面の外に表示させます。
  Form2.Left := -2000;
  Form3.Left := -2000;

  // フォームの表示
  Form2.Show;
  Form3.Show;

  Form2.ManualDock(Panel1);


  // 収納して表示
  Form3.ManualDock(DockTabSet1);
  //Form3.ManualDock(Panel1, nil, alBottom);
end;

procedure TForm1.DockTabSet1DockDrop(Sender: TObject; Source: TDragDockObject;
  X, Y: Integer);
begin
  DockTabSet1.Visible := True;
  // 次の処理をしないとPanel1の左側に表示される
  DockTabSet1.Left := Form1.Width;
end;

procedure TForm1.DockTabSet1TabRemoved(Sender: TObject);
begin
  DockTabSet1.Visible := DockTabSet1.Tabs.Count > 0;
end;

procedure TForm1.Panel1DockDrop(Sender: TObject; Source: TDragDockObject; X,
  Y: Integer);
begin
  if Panel1.Width = 0 then
    Panel1.Width := FormWidth;
  Splitter1.Visible := True;
  Splitter1.Left :=  Self.Width -(Panel1.Width + DockTabSet1.Width)-1;
  DockTabSet1.Left := Form1.Width;
end;

procedure TForm1.Panel1DockOver(Sender: TObject; Source: TDragDockObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  Rect: TRect;
begin
  Accept := (Source.Control = Form2) or (Source.Control = Form3);
  if Accept then
  begin
    Rect.TopLeft := Panel1.ClientToScreen(Point(0, 0));
    Rect.BottomRight := Panel1.ClientToScreen(Point(FormWidth, Panel1.Height));
    Source.DockRect := Rect;
  end;
end;

procedure TForm1.Panel1UnDock(Sender: TObject; Client: TControl;
  NewTarget: TWinControl; var Allow: Boolean);
begin
  if Panel1.DockClientCount = 1 then
  begin
    Panel1.Width := 0;
    Splitter1.Visible := False;
  end;
end;

end.

Unit2には、前回作成したTCategoryButtonsを使ったフォーム、 Unit3には、ListBoxを一つ配置したものを使いました。
// Unit2, Unit3の設定

  BorderStyle := bsSizeToolWin;
  DragKind := dkDock;
  DragMode := dmAutomatic;

実行するとこんな感じです。

DockTabSet1のStyleをtsOwnerDrawにすれば、タブにアイコンを描画することができました。
しかしながら、フォームのキャプション部分にはできませんでした。DelphiのIDEでは、 表示されているので何か方法があると思うのですけどね。


参考にしたサイト

CodeGear
Using the TDockTabSet component by Jeremy North