Keep forms snapped together

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 :)
nem2k4Asked:
Who is Participating?
Advertise Here
 
Slick812Connect With a Mentor Commented:
If you want to do a multiple program form docking, I would set up some kind of interprocess communication, I will use a Memory Mapped file and WM_USER messages. Here is some code for a program that will run several times, each time you run the program it will produce a form that will log into a Memory Mapped file an place it's form handle there, there is also an "Info" member that will be set to One if the form is to be docked.
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].Handle, aRect.Left+aryOffSets[i].x,
                   aRect.Top+aryOffSets[i].y, Width, Height, True);
      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].Handle, aLeft+aryOffSets[i].x,
                     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(ParyDR1[0].Info+1);
        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+aryOffSets[i].x-aryOffSets[Index].x,
          PRect(Msg.LParam)^.Top+aryOffSets[i].y-aryOffSets[Index].y, 1, 1,
          SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
          end;
        EndDeferWindowPos(Hdwp1);
        Exit;
        end;
      end;
    end;

  end;
inherited;
end;

procedure TForm1.but_CloseClick(Sender: TObject);
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, nil, PAGE_READWRITE, 0,
                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].Handle := Handle;
    ParyDR1[ParyDR1[0].Info].Info := 0;
    //ParyDR1[ParyDR1[0].Info].OffSet.x := yourXoffset;
    //ParyDR1[ParyDR1[0].Info].OffSet.y := yourYoffset;
  // if you want to try and do a drag Dock, you may need these OffSet values
    Label1.Caption := 'Form number '+IntToStr(ParyDR1[0].Info)+'  Form Handle '+
                      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(Sender: TObject);
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].Handle, aRect);
  MoveWindow(Handle, aRect.Left+aryOffSets[Index].x,
             aRect.Top+aryOffSets[Index].y, Width, Height, True);
  end else
  ParyDR1[Index].Info := 0;

end;

procedure TForm1.FormDestroy(Sender: TObject);
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[Index+1],
                 (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)) shl 16) or Word(SmallInt(aRect.Top));
     PostMessage(ParyDR1[0].Handle, WM_USER+123, 3456, sendI);
     end;
   if Index > 0 then
     PostMessage(ParyDR1[0].Handle, WM_USER+123, 555, 0);
   end;
  end;
UnmapViewOfFile(ParyDR1);
CloseHandle(hMemFile);
end;

procedure TForm1.but_CloseAllClick(Sender: TObject);
var
i: Integer;
begin
for i := ParyDR1[0].Info DownTo 0 do
  PostMessage(ParyDR1[i].Handle, WM_CLOSE, 0, 0);
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
0
 
sftwengCommented:
Have you considered creating your application as a MDI application with FormStyle set to "tile" the child forms? If you have rejected that option, is it because the "child" forms are of different sizes?
0
 
sftwengCommented:
You might like to have a look at the docking demo in %DELPHI%/Demos/Docking/dockex.dpr.
0
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

Go Premium
 
nem2k4Author Commented:
Whoops sorry I didn't mention this (I didn't think it would matter); I'm actually running lots of copies of the same application (each having only one form) and I want those forms to be able to dock together. And the forms can be of different sizes.
0
 
WyverexCommented:
It seems like you are trying to change the position of windows in other processes in the " /// KEEP FORMS SNAPPED TOGETHER" Part. As far as I know setwindowpos only works for windows running in the same process.
So if you want to change the position of a window in another process you have to use some kind of interprocess communication like sockets or pipes. You must then notify the other process that you want to move its window to a desired position.
0
 
nem2k4Author Commented:
Well SetWindowPos works if I use

setwindowpos(wnd,0,0,0,0,0,SWP_NOZORDER or SWP_NOSIZE);

It moves the window to (0,0).

I just need to work out where to move it, and also I'm not sure if WM_WINDOWPOSCHANGING is the right message to handle here; I need to shift the snapped form whenever the form I am dragging is moved (even if by just one pixel)
0
 
Slick812Commented:
hello  nem2k4 , , I have used the API  DeferWindowPos( )  function to move several windows "Together" as I move the Main Window, however your request for moving any window and having all the other windows follow will complicate this effort. . . The  DeferWindowPos was made for moving more than 2 windows at the same time, and works well for me, I used the WM_MOVE message for this particular code


  private
    { Private declarations }
    procedure WMMove(var Message: TWMMOVE); message WM_MOVE;


procedure TForm1.WMMove(var Message: TWMMOVE);
var
Hdwp1: THandle;
NumForms: Integer;
begin
NumForms := 0;
if (Form2 <> nil) and Active then
  Inc(NumForms);

if (Form3 <> nil) and Active then
  Inc(NumForms);

Label1.Caption := 'NumForms is '+IntToStr(NumForms)+' '+IntToStr(F2Top);
if NumForms = 0 then Exit;
if (NumForms = 1) and (Form2 <> nil) then
  MoveWindow(Form2.Handle, Left-30, Top-30, Form2.Width, Form2.Height, True);
if (NumForms = 1) and (Form3 <> nil) then
  MoveWindow(Form3.Handle, Left+Width-Form3.Width+30, Top+Height-Form3.Height+30, Form3.Width, Form3.Height, True);

if (NumForms = 2) then
  begin
  {the DeferWindowPos can move several windows at once}
  Hdwp1 := BeginDeferWindowPos(2);
  DeferWindowPos(Hdwp1,      // handle to internal structure
    Form2.Handle,      // handle to window to position
    Handle,      // placement-order handle
    Left-30,      // horizontal position
    Top-30,      // vertical position
    Form2.Width,      // width
    Form2.Height,      // height
    SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE  // window-positioning flags
   );

  {you need to call DeferWindowPos once for each window allocated
  in the BeginDeferWindowPos(2) function}
  DeferWindowPos(Hdwp1, Form3.Handle, HWND_BOTTOM,Left+Width-Form3.Width+30,
            Top+Height-Form3.Height+30, Form3.Width, Form3.Height,
            SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
  EndDeferWindowPos(Hdwp1);
  end;
end;
0
 
nem2k4Author Commented:
That code looks very promising :) Only thing I need to do is to keep the form positions relative to one another. I need to work out how many pixels Form1 was moved by and then move the others by the same amount.
0
 
nem2k4Author Commented:
Ok I have this:




unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
  private
 { Private declarations }
 oldx,oldy:integer;
    procedure WMMove(var Message: TWMMOVE); message WM_MOVE;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Form2: TForm;
  Form3: TForm;

implementation

{$R *.dfm}

procedure TForm1.WMMove(var Message: TWMMOVE);
var
Hdwp1: THandle;
NumForms: Integer;
xshift,yshift:integer;
begin
NumForms := 0;

if (Form2 <> nil) and Active then
  Inc(NumForms);

if (Form3 <> nil) and Active then
  Inc(NumForms);

xshift := message.XPos-oldx;
yshift := message.YPos-oldY;
Label1.Caption := 'NumForms is '+IntToStr(NumForms);//+' '+IntToStr(F2Top);
label2.Caption := 'XShift is '+inttostr(xshift);


if NumForms = 0 then Exit;
if (NumForms = 1) and (Form2 <> nil) then
  MoveWindow(Form2.Handle, Left-30, Top-30, Form2.Width, Form2.Height, True);
if (NumForms = 1) and (Form3 <> nil) then
  MoveWindow(Form3.Handle, Left+Width-Form3.Width+30, Top+Height-Form3.Height+30, Form3.Width, Form3.Height, True);

if (NumForms = 2) then
  begin
  label3.Caption := 'form2.x is'+inttostr(form2.Left);
  label4.Caption := 'form1.x is'+inttostr(form1.Left);
  {the DeferWindowPos can move several windows at once}
  Hdwp1 := BeginDeferWindowPos(2);
  DeferWindowPos(Hdwp1,     // handle to internal structure
    Form2.Handle,     // handle to window to position
    Handle,     // placement-order handle
    form2.Left+xshift, //Left-30,     // horizontal position
    form2.Top+yshift, //Top-30,     // vertical position
    Form2.Width,     // width
    Form2.Height,     // height
    SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE  // window-positioning flags
   );

  {you need to call DeferWindowPos once for each window allocated
  in the BeginDeferWindowPos(2) function}
  DeferWindowPos(Hdwp1, Form3.Handle, HWND_BOTTOM,
  form3.Left+xshift,
            form3.Top+yshift,
             Form3.Width,
              Form3.Height,
            SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
  EndDeferWindowPos(Hdwp1);
  end;
  oldx:= message.XPos;
  oldy:= message.YPos;
end;

end.



It works ok I guess, bit of a hack using those oldx and oldy variables though... is there any better way to get how many pixels across and down form1 has moved? I tried (Message.X-Form1.Left) but that didn't work.

Also the windows "ghost" a bit when they move, any way to prevent that?
0
 
Slick812Commented:
oh , because of the way I had to move the forms around, You can NOT use their  "Left" and "TOP" window positions for anything, they may not be correct,
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.