I'm using some code I found on the net to make all forms in my application snap to each other's edges. This is working great, but I'd also like the forms to remain snapped together so that when I move one, all other forms snapped to it move with it, and any forms snapped to those forms move with those ones etc etc. I had a shot at it myself but I couldn't get much working... the form just gets stuck to the side of another form and I can't move it anymore.
This is the code I have so far:
procedure TMyForm.WindowPosChange(var Msg: TWMwindowposchanging);
var
rWorkArea: TRect;
StickAt : integer;
wnd,parentwnd:HWND;
sr:TRect;
snapped:boolean;
P:TPoint;
begin
// =========================================================
// SNAP TO OTHER FORMS
stickat := 10;
wnd := findwindowex(0,0,'TMyForm', nil);
snapped:=false;
parentwnd := 0;
while(wnd <> 0) do begin
if (wnd<>0) and (wnd<>self.Handle) and (GetWindowRect(wnd,sr)) then with Msg.WindowPos^ do begin
//if we're within the snap stickatold then snap
if ( (x <= (sr.right+stickat)) and
(x >= (sr.right-stickat)) ) then begin
if (((y > sr.top)or(y+height>sr.top)) and ((y < sr.bottom)or(y+height<sr.bottom))) then begin
//disallow "open air" snaps
snapped:=true;
x := sr.right;
end;
end else if (((x + cx) >= (sr.left-stickat)) and
((x + cx) <= (sr.left+stickat))) then begin
if (((y > sr.top)or(y+height > sr.top)) and (((y < sr.bottom)or(y+height < sr.bottom)))) then begin
snapped:=true;
x := sr.left-cx;
end;
end;
if ( (y <= (sr.bottom+stickat)) and
(y >= (sr.bottom-stickat)) ) then begin
if (((x > sr.left)or(x+width > sr.left)) and ((x < sr.right)or(x+width < sr.right))) then begin
snapped:=true;
y := sr.bottom;
end;
end
else if (((y + cy) <= (sr.top+stickat)) and
((y + cy) >= (sr.top-stickat))) then begin
if (((x > sr.left)or(x+width > sr.left)) and ((x < sr.right)or(x+width < sr.right))) then begin
snapped:=true;
y := sr.top-cy;
end;
end;
end;
if snapped then break;
// next window
wnd := findwindowex(parentwnd, wnd, 'TMyForm', nil);
end;
// =========================================================
// =========================================================
/// KEEP FORMS SNAPPED TOGETHER
wnd := findwindowex(0,0,'TMyForm', nil);
snapped:=false;
parentwnd := 0;
while(wnd <> 0) do begin
if (wnd<>0) and (wnd<>self.Handle) and (GetWindowRect(wnd,sr)) then begin
// test to try and get the form to stay snapped to the right-hand side of another form
if message.XPos = sr.Right then
setwindowpos(wnd,0,sr.Left+message.XPos-left,sr.Top+message.YPos-top,0,0,SWP_NOZORDER or SWP_NOSIZE);
end;
if snapped then break;
// next window
wnd := findwindowex(parentwnd, wnd, 'TMyForm', nil);
end;
// =========================================================
end;
Any help appreciated :)
My form's width and height are small, and there is One TCheckBox named "CheckBoxDock" which is checked if the form os to Dock, and unchecked if NO docking. . . and two TButtons, one named "but_Close" which will just close that form, and one named "but_CloseAll" which will close all of the Forms logged in the Mem mapped file. There is a TLabel, which just give some information. I have a TDockRec type that is the information for the forms in the mem mapped file. There is also a TaryDockRec type that is an Array to hold up to 9 forms information, I limited this to 9 forms, just to keep it easy.
There is a WM_MOVING message where i do the DeferWindowPos( ) thing for all of the windows in the mem mapped array.
I did not have time to put many comments in this to tell you what it is doing, ask questions if you need more information - -
unit DockForms;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;
type
PDockRec = ^TDockRec;
TDockRec = packed record
Handle: THandle;
Info: Cardinal;
//OffSet: TPoint;
// you can include an offSet point if you want to
end;
ParyDockRec = ^TaryDockRec;
TaryDockRec = Array[0..8] of TDockRec;
TForm1 = class(TForm)
CheckBoxDock: TCheckBox;
but_Close: TButton;
Label1: TLabel;
but_CloseAll: TButton;
procedure but_CloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure CheckBoxDockClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure but_CloseAllClick(Sender: TObject);
private
{ Private declarations }
hMemFile: Integer;
ParyDR1: ParyDockRec;
// this ParyDR1 is a memMapped file for an array to keep the handles
// of all the form windows in
aryOffSets: Array[0..8] of TPoint;
// this aryOffSets has 9 points for the position of each form
function FindIndex: Integer;
procedure WMMoving(var Msg: TMessage); message WM_MOVING;
procedure ClosedMsg(var Msg: TMessage); message WM_USER+123;
// Closed message is sent whenever a Form is destroyed
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.ClosedMsg(var Msg: TMessage);
var
aLeft, aTop: SmallInt;
aRect: TRect;
i: Integer;
begin
if (ParyDR1 <> nil) and (ParyDR1[0].Handle = Handle) then
if Msg.WParam = 555 then
begin
if ParyDR1[0].Info > 0 then
begin
GetWindowRect(Handle, aRect);
for i := 1 to ParyDR1[0].Info do
if ParyDR1[i].Info = 1 then
MoveWindow(ParyDR1[i].Hand
aRect.Top+aryOffSets[i].y,
end;
end else
if Msg.Wparam = 3456 then
begin
CheckBoxDock.Hide;
but_CloseAll.Show;
aTop := SmallInt(Msg.LParam and $FFFF);
aLeft := SmallInt((Msg.LParam and $FFFF0000) shr 16);
MoveWindow(Handle, aLeft, aTop, Width, Height, True);
if ParyDR1[0].Info > 0 then
for i := 1 to ParyDR1[0].Info do
if ParyDR1[i].Info = 1 then
MoveWindow(ParyDR1[i].Hand
aTop+aryOffSets[i].y, Width, Height, True);
end;
end;
procedure TForm1.WMMoving(var Msg: TMessage);
var
Index, i, Hdwp1: Integer;
begin
if ParyDR1 <> nil then
begin
if ParyDR1[0].Info > 0 then
begin
Index := FindIndex;
if Index > -1 then
begin
if ParyDR1[Index].Info > 0 then
begin
Hdwp1 := BeginDeferWindowPos(ParyDR
for i := 0 to ParyDR1[0].Info do
begin
if (i > 0) and (ParyDR1[i].Info = 0) then Continue;
DeferWindowPos(Hdwp1, ParyDR1[i].Handle, HWND_BOTTOM,
PRect(Msg.LParam)^.Left+ar
PRect(Msg.LParam)^.Top+ary
SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
end;
EndDeferWindowPos(Hdwp1);
Exit;
end;
end;
end;
end;
inherited;
end;
procedure TForm1.but_CloseClick(Send
begin
Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
LErr: Integer;
begin
{I did not even try to do a drag and drop Dock operation,
because of the math I would need to for that, I just Dock these
forms in a position relative to their array index number, it
is more easy to do
the aryOffSets holds the 9 positions of each form as an offset to
the Left and Top of the FIRST form}
aryOffSets[0].x := 0;
aryOffSets[0].y := 0;
aryOffSets[1].x := 0; // under first
aryOffSets[1].y := Height;
aryOffSets[2].x := Width;
aryOffSets[2].y := 0; // right side of first
aryOffSets[3].x := 0; // above first
aryOffSets[3].y := -Height;
aryOffSets[4].x := -Width;
aryOffSets[4].y := 0; // left side of first
aryOffSets[5].x := -Width;
aryOffSets[5].y := Height; // left and under first
aryOffSets[6].x := Width;
aryOffSets[6].y := Height; // right and under first
aryOffSets[7].x := Width;
aryOffSets[7].y := -Height; // right and above first
aryOffSets[8].x := -Width;
aryOffSets[8].y := -Height; // left and above first
hMemFile := CreateFileMapping(MaxDWord
SizeOf(TaryDockRec), 'yU7B8L+A8?');
LErr := GetLastError;
ParyDR1 := MapViewOfFile(hMemFile, FILE_MAP_WRITE, 0, 0, 0);
if ParyDR1 = nil then
Label1.Caption := 'Docking NOT Availible'
else
if LErr = 0 then
begin
CheckBoxDock.Hide;
but_CloseAll.Show;
ZeroMemory(ParyDR1, SizeOf(TaryDockRec));
ParyDR1[0].Handle := Handle;
ParyDR1[0].Info := 0;
//ParyDR1[0].OffSet.x := 0;
//ParyDR1[0].OffSet.y := 0;
Label1.Caption := 'FIRST Form Form Handle '+IntToStr(Handle);
end else
begin
but_CloseAll.Hide;
if ParyDR1[0].Info = 8 then
begin
CheckBoxDock.Hide;
Exit;
end;
Inc(ParyDR1[0].Info);
ParyDR1[ParyDR1[0].Info].H
ParyDR1[ParyDR1[0].Info].I
//ParyDR1[ParyDR1[0].Info]
//ParyDR1[ParyDR1[0].Info]
// if you want to try and do a drag Dock, you may need these OffSet values
Label1.Caption := 'Form number '+IntToStr(ParyDR1[0].Info
IntToStr(Handle);
end;
end;
function TForm1.FindIndex: Integer;
var
i: Integer;
begin
Result := -1;
if ParyDR1 = nil then
Exit;
if ParyDR1[0].Info = 0 then
begin
Result := 0;
Exit;
end;
for i := 0 to ParyDR1[0].Info do
if ParyDR1[i].Handle = Handle then
begin
Result := i;
Break;
end;
end;
procedure TForm1.CheckBoxDockClick(S
var
Index: Integer;
aRect: TRect;
begin
Index := FindIndex;
if Index < 1 then
begin
CheckBoxDock.Hide;
Exit;
end;
if CheckBoxDock.Checked then
begin
ParyDR1[Index].Info := 1;
GetWindowRect(ParyDR1[0].H
MoveWindow(Handle, aRect.Left+aryOffSets[Inde
aRect.Top+aryOffSets[Index
end else
ParyDR1[Index].Info := 0;
end;
procedure TForm1.FormDestroy(Sender:
var
Hold: Cardinal;
Index, sendI: Integer;
aRect: TRect;
begin
if ParyDR1 <> nil then
begin
if ParyDR1[0].Info > 0 then
Hold := ParyDR1[0].Info-1
else
Hold := 0;
Index := FindIndex;
if Index > -1 then
begin
if Index = Integer(ParyDR1[0].Info) then
begin
ParyDR1[Index].Handle := 0;
if Index > 0 then
Dec(ParyDR1[0].Info);
end else
begin
MoveMemory(@ParyDR1[Index]
(ParyDR1[0].Info - Cardinal(Index)) * SizeOf(TDockRec));
ParyDR1[Hold+1].Handle := 0;
ParyDR1[0].Info := Hold;
end;
Sleep(10);
if (Index = 0) and (ParyDR1[0].Handle <> 0) then
begin
GetWindowRect(Handle, aRect);
sendI := (Word(SmallInt(aRect.Left)
PostMessage(ParyDR1[0].Han
end;
if Index > 0 then
PostMessage(ParyDR1[0].Han
end;
end;
UnmapViewOfFile(ParyDR1);
CloseHandle(hMemFile);
end;
procedure TForm1.but_CloseAllClick(S
var
i: Integer;
begin
for i := ParyDR1[0].Info DownTo 0 do
PostMessage(ParyDR1[i].Han
end;
end.
- - - - - - - - - - - - - - - -- - - - - - - - - - - - - -
I did not have time to fully test this , but it seems to work for me. . . it should give you some ideas on a way to try and do what you have described