☆幅を指定した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.
| 固定リンク