閉じるボタンを表示しないようにするには？
解決プロパティを設定し閉じるボタンの無いフォームをパネルにドッキングさせるとドッキング状態で閉じるボタンが表示されてしまいます。
ドッキング時に閉じるボタンを表示しないようにするにはどうすればいいでしょうか？
教えてください。
その、元のコードを示してもらわんと、
答える側が、非常に答えにくいと思うんですけど、、、
Form2をForm1のパネルにドッキングしています。
どちらも静的に生成したものです。
コードらしいもはほとんど書いていないのですが、
//Unit2（Form2）で
procedure TForm2.FormCreate(Sender: TObject);
begin
Form2.Show;
end;
として
プロパティは
Form1.Panel1.AlgnをalLeft
Form1Panel1.DockSiteをTrue
Form1Panel1.UseDockManagerをTrue
Form2.BorderIconsをすべてFalse
Form2.BorderStyleをbsSizeToolWin
Form2.DragKindをTrue
Form2.DragModeをdmAutomatic
というようににすべてオブジェクトインスベクタで
設定しています。
> Form2.DragKindをTrue
dkDock ですね。
それはともかく、質問への回答として、「できないことはない（否定の否定）」と思います。
TDockTree クラスが二本のバー？と閉じるボタンを描画しています。
Pro以上なら、ソースがあるはずなので Controls.pas ユニットのTDockTree.PaintDockFrame を見てください。
また、同ユニットの、TDock〜やら、TDrag〜が、ドッキング関連のクラスのようです。
UseDockManager=Trueにしたとき、DockManagerのインスタンスにTDockTreeの継承クラスを使用します。
このとき、どのクラスを使用するかは、Controls.pasのグローバルな変数
DefaultDockTreeClassにより決定されます。
Controls.pas より一部抜粋
> TDockTreeClass = class of TDockTree;
> DefaultDockTreeClass: TDockTreeClass = TDockTree;
つまり、DefaultDockTreeClassを自分の好きな動作になるように作った
TDockTreeからの継承クラスを指定すると、閉じるボタンも消えるのです。
具体的には、以下のような感じのクラスを作成
例：TMyDockTree=class(TDockTree)
(1)PaintDockFrameで、閉じるボタンを描画しないようにする。
(2)TDockTree.WindowProc の別名メソッドを作成し、FDockSite.WindowProc に割り当てる(例：TMyDockTree.MyWindowProc)。
TDockTree.Createで、TDockTree.WindowProc を割り当てているので、直接
FDockSite.WindowProc := TMyDockTree.MyWindowProc; と放り込むだけでいいでしょう。
(3)TMyDockTree.MyWindowProcの記述
ここでは、WM_LBUTTONDBLCLKの応答のみ記述する。
(たぶん)TDockTree.InternalHitTestで、閉じるボタンであるという判定が返ってきますが、
これを握りつぶし、HTBORDERになるようなマウス座標に変換。
あとは、TDockTree.WindowProc に、そのまま処理を放り投げ。
(4)プログラム起動時に、DefaultDockTreeClass変数に、TMyDockTree を指定。
と、頭の中で描いてみました。
ただし、(3)の握りつぶしについては、もっといい方法があるかもしれません。
訂正
> TDockTree.Createで、TDockTree.WindowProc を割り当てているので、直接
> FDockSite.WindowProc := TMyDockTree.MyWindowProc; と放り込むだけでいいでしょう。
TDockTree.WindowProc は、Privateメソッドなので、別ユニットに記述するTMyDockTreeからは使用できません。
TDockTree.Createでの記述同様、FOrgWndProc: TWndMethod; あたりを用意して、メソッドの差し替えが必要になるでしょう。
こんなとこかな〜
type
TMyDockTree =class(TDockTree)
protected
FOrgWndProc: TWndMethod;
public
constructor Create(DockSite: TWinControl); override;
destructor Destroy; override;
protected
procedure PaintDockFrame(Canvas: TCanvas; Control: TControl;
const ARect: TRect); override;
procedure MyWindowProc(var Message: TMessage);
end;
constructor TMyDockTree.Create(DockSite: TWinControl);
begin
inherited Create(DockSite);
if not (csDesigning in DockSite.ComponentState) then begin
FOrgWndProc := DockSite.WindowProc;
DockSite.WindowProc := MyWindowProc;
end;
end;
destructor TMyDockTree.Destroy;
begin
if @FOrgWndProc <> nil then DockSite.WindowProc := FOrgWndProc;
inherited Destroy;
end;
procedure TMyDockTree.PaintDockFrame(Canvas: TCanvas; Control: TControl; const ARect: TRect);
procedure DrawGrabberLine(Left, Top, Right, Bottom: Integer);
begin
with Canvas do begin
Pen.Color := clBtnHighlight;
MoveTo(Right, Top);
LineTo(Left, Top);
LineTo(Left, Bottom);
Pen.Color := clBtnShadow;
LineTo(Right, Bottom);
LineTo(Right, Top-1);
end;
end;
begin
with ARect do begin
if DockSite.Align in [alTop, alBottom] then begin
DrawGrabberLine(Left+3, Top+1, Left+5, Bottom-2);
DrawGrabberLine(Left+6, Top+1, Left+8, Bottom-2);
end
else begin
DrawGrabberLine(Left+2, Top+3, Right-2, Top+5);
DrawGrabberLine(Left+2, Top+6, Right-2, Top+8);
end;
end;
end;
procedure TMyDockTree.MyWindowProc(var Message: TMessage);
var
mp: TPoint;
hitTestValue: Integer;
begin
case Message.Msg of
WM_LBUTTONDBLCLK,
WM_LBUTTONDOWN:begin
mp := SmallPointToPoint(TWMMouse(Message).Pos);
HitTest(mp, hitTestValue);
while hitTestValue = HTCLOSE do begin
if DockSite.Align in [alTop, alBottom] then begin
mp.Y := mp.Y + 10{これは適当};
end
else begin
mp.X := mp.X - 10{これも適当};
end;
HitTest(mp, hitTestValue);
end;
TWMMouse(Message).Pos.x := mp.X;
TWMMouse(Message).Pos.y := mp.Y;
end;
end;
{処理を(TDockTree.WindowProcに放り投げ)}
FOrgWndProc(Message);
end;
initialization
Controls.DefaultDockTreeClass := TMyDockTree;
ん？さん。
親切なコードをいただきありがとうございます。
実行したところすばらしいものでした。
ドッキング状態で閉じるボタンが表示されていると、
不用意に閉じるボタンを押してしまうことがあるので
ずっと悩んでいました。本当にありがとうございました。
| ツイート |  |