?
Solved

Magnetic Forms

Posted on 2005-03-04
23
Medium Priority
?
1,496 Views
Last Modified: 2012-05-05
Has anyone got a piece of code, which i can add to my program to make all its forms 'attracted' to each other, aswell as the screen edges.
The forms do not need to be attracted to other program windows, just the forms within my program. An example of this is like Winamp.

I do know this is possible, and had the code working before (which i got from EE in the first place)... having reformatted i no longer have the coding, and nor can i find it on the net for the life of me.

I have searched the net, but only find components which either show annoying 'this isnt registered' popups, or the components charge for usage.

Could someone please either give me a nice bit of coding to achieve the magnatised effect i am looking for, or perhaps give me a link to a completely FREE component.

Kind Regards
0
Comment
Question by:Greenandroid
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 7
  • 6
  • +2
23 Comments
 
LVL 22

Expert Comment

by:Mohammed Nasman
ID: 13459613
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 13459646
Couple here:
http://www.torry.net/pages.php?id=97

and here:
http://www.torry.net/pages.php?id=100

also, I think the JVCL has the JvFormMagnet control.
http://www.delphi-jedi.org
0
 
LVL 2

Author Comment

by:Greenandroid
ID: 13460281
Thanks for replying to this question so soon, however i have several problems with the links both of you have given me... so i will explain why to each...

first of all mnasman
you gave me a link to http://www.undu.com/Articles/020329b.html
Before posting my question on EE, i had already tried this code, but as i am sure you are aware, this code is for making my form stick to the winamp windows. I had problems altering this code to stick to my own forms.

The second link you gave me was for http://www.appcontrols.com/components.html
Again, before posting on EE, i had come across these components. If you checked them carefully, and read the installation file, it does display a pop up when you run your project, saying the component is unregistered... I cannot deploy my program with this. I need a free component.

Eddie, your links lead me no further to my solution im afraid...
on the page http://www.torry.net/pages.php?id=97
there was only the component TMagForm.... this component ONLY sticks to the screen edges, and doesnt make the forms stick to each other. This was the same situation for the component ScreenSnap, which was on your other link, http://www.torry.net/pages.php?id=100.

 However on this page, there was RRAINET TMagnet, an ideal sounding component, BUT has problems installing it. Whilst actually trying to install the component, it couldnt find the component within the files it gives you... Perhaps you could try and install this component, and if you get it working, please explain what i have done wrong...

The JVCL components are also causing me problems, as they require the JCL (jedi components library), which refuses to instlal on my computor... The install.bat distributed with JCL returns an error, and i am uncertain how to install this components library without it.

I shall have another go at trying the RRainet TMagnet component, but in the mean time, any other help is deeply appreciated!
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 26

Expert Comment

by:EddieShipman
ID: 13461116
Did you see:
ScreenDocker v.1.0 By Tan Tze Yong.
ScreenDocker is an invisible component that enable
the owner form to have screen docking abilities like
the popular Winamp has.
 
Fully functional
Source: Included
 
Download: http://www.torry.net/vcl/forms/other/screendocker.zip?SID=75c81e9b243f6a15a5d00bfbaaa3d52b

RRAINET TMagnet is for D5 only because it only has the dcu. What version of Delphi do you have?
Source is avail on request from the author. infos@rrainet.com
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 13461163
oop, sorry, ScreenDocker also only does to edges of the screen, didn't see that until after I downloaded it.
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 13462284
0
 
LVL 2

Author Comment

by:Greenandroid
ID: 13462860
I just went to submit my reply to your last post, but my browser crashed... how frustrating...*rewrites*

Even more annoyingly, im afraid your new posts didn't help me any more eddie. the problem is, that page does contain some useful code, but it's totally impractical. The code itself is more than ALL the code within my program, and thats only for docking form1 to just one side of form2. Im sure you will agree, that code is HUGE - but along the lines of the solution i need. The site also contains a link to another posting about form docking, but again, this is only to the screen borders (and is a site i have already visited)...
Im wondering whether anyone could do a search for the answer on EE if they havent already, as i am certain it is on here.. Part-way through lastyear, i remember seeing a topic the same as this, in the section awaiting answers. I had tried using one of the sections of code someone had mentioned within the replies to that post, and it worked fine.
Please keep searching!!!!!!!!

Kind Regards
James
0
 
LVL 34

Expert Comment

by:Slick812
ID: 13463942
hello  Greenandroid, you can use the API  BeginDeferWindowPos( ) function to keep several forms "Docked" together during form moves and relocations. You can see some code and example for this at -

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_21085996.html

ask questions if this is along the lines of what you may need
0
 
LVL 2

Author Comment

by:Greenandroid
ID: 13464107
Eddie,

Your links provided me with alot of code to get started on, but i have some issues with the coding in general. I think the last 2 links obtained a docking effect which were useless to me. The second url provided me with code which worked, but i use the word 'worked' carefully, as it only allowed docking for one side of my form1, to one side of my form2.
The first and third urls you posted provided me with errors, which i couldn't seem to fix. Could you try and compile a project using the coding in the first url, as this seems perfect for what i need...if only those blasted errors could go!

Slick182,

i find the same errors with your code, as i do with the 2 urls that eddie supplied. the example posted in the url is perfect for the job, but upon compiling, its riddled with errors. Can you try to get it to work, and perhaps explain where i am going wrong.

Thanks you both for helping with this

Regards
James
0
 
LVL 34

Expert Comment

by:Slick812
ID: 13466834
In the code for the EE url that I posted, the delphi code code there worked for me and it would appear that it worked for the questioner  nem2k4 . .
Not sure about what you are asking for, since the code works for at least 2 different people?
I would ask you -
What is the first error message or the first indication to you that the code you use is not going to work?
0
 
LVL 2

Author Comment

by:Greenandroid
ID: 13467137
Ok i used the code that you posted in your last post on that thread, and it compiled without error, however it didnt absolutely nothing.
What is it meant to dock to?

I compiled the project, and ran it 2 times, the forms didnt stick... which is fine and well......
BUT i added a button which has form2.show;
Your code didnt dock or magnetise my form1 to my form2 when they became close to each other.
0
 
LVL 10

Expert Comment

by:Jacco
ID: 13467221
Hi GreenAndroid,

Here is a magnetic form :) It snap to the top-right side of the Form assigned to AttachTo. I used 50 pixels for snapping to and of the Form. Only two messages need to be handled WM_NCLBUTTONDOWN to catch the initial ofset of the mouse from the left to of the dragged form. (This is used to snap of if the cursor moves to far of) WM_WINDOWPOSCHANGING top changed the default behavior of just following the mouse.

To test the code:

procedure TForm1.Button4Click(Sender: TObject);
begin
  with TfrmDragee.Create(Self) do
  begin
    AttachTo := Self;
    Show;
  end;
end;

Make sure to use Unit2 :)

Have fun with the code.

Regards Jacco

(More code needs to be added to support other sides)

unit Unit2;

interface

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

type
  TfrmDragee = class(TForm)
  private
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
    procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
  public
    AttachTo: TForm;
    DragPoint: TPoint;
  end;

implementation

{$R *.dfm}

{ TForm2 }

procedure TfrmDragee.WMNCLButtonDown(var Message: TWMNCLButtonDown);
begin
  DragPoint := Point(Message.XCursor - Left, Message.YCursor - Top);
  inherited;
end;

procedure TfrmDragee.WMWindowPosChanging(var Message: TWMWindowPosChanging);
var
  lCurrent, lTarget: TPoint;
  lMouse: TPoint;
begin
  if Assigned(AttachTo) then
  begin
    lCurrent  := BoundsRect.TopLeft;
    lTarget   := AttachTo.BoundsRect.TopLeft;
    lTarget.X := lTarget.X + AttachTo.Width;
    if Sqrt(Sqr(lTarget.X - lCurrent.X) + Sqr(lTarget.Y - lCurrent.Y)) < 50 then
    begin
      Message.WindowPos.x := lTarget.X;
      Message.WindowPos.y := lTarget.Y;
    end;
    GetCursorPos(lMouse);
    if Sqrt(Sqr(lMouse.X - Left - DragPoint.X) + Sqr(lMouse.Y - Top - DragPoint.Y)) > 50 then
    begin
      Message.WindowPos.x := lMouse.X - DragPoint.X;
      Message.WindowPos.y := lMouse.Y - DragPoint.Y;
    end;
  end;
end;

end.
0
 
LVL 34

Expert Comment

by:Slick812
ID: 13471410
Ok, the code at that EE question will NOT do a Snap-To type of Docking, it only moves several forms around at the same time, I was thinking you could see that form the code. . .
In order to have the Snap-To movement position Docking, that you describe, , , takes quite a bit More work and code, seems like more than 100 points worth. . . . I will assume that you also want a way to UnDock the satallite forms after they have been docked. So I put a button on each secondary form to allow docking and to Un dock it.
Here is some code for a "MainForm" that can be Docked to by secondary forms (Form2, Form3, Form4), the Main form has a button on it for each secondary Form, all that button does is Show the secondary Form, and has nothing to do with the SnapTo Docking, and can be omitted. There are no other controls on the Main Form. This is set up to allow Snap-To docking to the four edges of the MainForm, top, left, right, and bottom, not just anywhere on the form, I define 4 drag-over rectangles that have widths and heights defined in the constants BoxL and BoxH, which will be in the center of the MainForm's edge, so you will need to drag your secondary forms to the center of your mainforms edge. . . .

code for the MainForm -




unit BorderDock;

interface

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

type
  TDPos = (dpLeft,dpTop,dpRight,dpBottom);
  // I am only doing a 4 position docking to main form, left, top, right and bottom

  PDockRec = ^TDockRec;
  TDockRec = record // record to store the handle and position of docked forms
    Handle: Cardinal;
    DockPos: TPoint;
    dPos: TDPos;
    end;

  TMainForm = class(TForm)

  // all of this is NOT needed for SnapTo Docking -
    but_ShowForm2: TButton;
    But_ShowForm3: TButton;
    procedure but_ShowForm2Click(Sender: TObject);
    procedure But_ShowForm3Click(Sender: TObject);
  //  end of  NOT needed -

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMMoving(var Msg: TMessage); message WM_MOVING;
  end;

const
// these constants set the size of the drag over Dock seek rectangle
BoxL = 15;
BoxH = 18;

var
  MainForm: TMainForm;
  DockList: TList;
  aryPRect: Array[TDPos] of TRect;// rectangles for drag over Dock seek
  PosSet: Set of TDPos;// used to avoid docking in same location

implementation

{$R *.DFM}

uses
  BDock2, BDock3; //secondary forms units, Form2, Form3

procedure TMainForm.WMMoving(var Msg: TMessage);
var
hDwp1, i, wd, ht, halfW, halfH: Integer;

begin
wd := PRect(Msg.LParam).Right-PRect(Msg.LParam).Left;
ht := PRect(Msg.LParam).Bottom-PRect(Msg.LParam).Top;
halfH := ht div 2;
halfW := wd div 2;
aryPRect[dpLeft] := Rect(PRect(Msg.LParam).Left-BoxL,PRect(Msg.LParam).Top+halfH-BoxH,
                         PRect(Msg.LParam).Left+BoxL,PRect(Msg.LParam).Top+halfH+BoxH);
aryPRect[dpTop] := Rect(PRect(Msg.LParam).Left+halfW-BoxH,PRect(Msg.LParam).Top-BoxL,
                        PRect(Msg.LParam).Left+halfW+BoxH,PRect(Msg.LParam).Top+BoxL);
aryPRect[dpRight] := Rect(PRect(Msg.LParam).Left+wd-BoxL,aryPRect[dpLeft].Top,
                          PRect(Msg.LParam).Left+wd+BoxL,aryPRect[dpLeft].Bottom);
aryPRect[dpBottom] := Rect(aryPRect[dpTop].Left,PRect(Msg.LParam).Top+ht-BoxL,
                           aryPRect[dpTop].Right,PRect(Msg.LParam).Top+ht+BoxL);

if DockList.Count > 0 then
  begin
  hDwp1 := BeginDeferWindowPos(DockList.Count+1);
  for i := 0 to DockList.Count - 1 do
    begin
    DeferWindowPos(hDwp1, PDockRec(DockList[i]).Handle, HWND_BOTTOM,
        PRect(Msg.LParam)^.Left+PDockRec(DockList[i]).DockPos.x,
        PRect(Msg.LParam)^.Top+PDockRec(DockList[i]).DockPos.y, 1, 1,
        SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
    end;
  EndDeferWindowPos(hDwp1);
  Exit;
  end;

inherited;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
halfW, halfH: Integer;
begin
DockList := TList.Create;
halfW := Width div 2;
halfH := Height div 2;
aryPRect[dpLeft] := Rect(Left-BoxL,Top+halfH-BoxH,Left+BoxL,Top+halfH+BoxH);
aryPRect[dpTop] := Rect(Left+halfW-BoxH,Top-BoxL,Left+halfW+BoxH,Top+BoxL);
aryPRect[dpRight] := Rect(Left+Width-BoxL,aryPRect[dpLeft].Top,
                          Left+Width+BoxL,aryPRect[dpLeft].Bottom);
aryPRect[dpBottom] := Rect(aryPRect[dpTop].Left,Top+Height-BoxL,
                           aryPRect[dpTop].Right,Top+Height+BoxL);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
FreeAndNil(DockList);
end;

procedure TMainForm.but_ShowForm2Click(Sender: TObject);
begin
Form2.Show;
end;

procedure TMainForm.But_ShowForm3Click(Sender: TObject);
begin
if Assigned(Form3) then
  Form3.Show
  else
  Application.CreateForm(TForm3, Form3);
end;

end.



= = = = = =  = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =

below will be the code for a secondary form unit, ALL secondary form units have this same exact code for SnapTo Docking
All secondary forms have One TButton named   but_DoDock
this button will have a caption of  'Allow Docking', when the form is shown it will NOT be in Docking mode (DoDock := False), You must click the 'Allow Docking' button to set DoDock to True, which will allow this form to do Snap-To Docking, the button caption becomes 'Docking' and you can drag this form to the MainForm and it should Dock onto the main form if you get it close to an edge of the mainform.
After it has docked, the button caption will become 'Un Dock' and if you click the button, the form will separate (Un Dock) from the main form.




unit BDock2;

interface

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

const
WM_SETDOCK = WM_USER+359;

type
  TForm2 = class(TForm)
    but_DoDock: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure but_DoDockClick(Sender: TObject);
  private
    { Private declarations }
    Docked, DoDock: Boolean;
    procedure WMMoving(var Msg: TMessage); message WM_MOVING;
    procedure WMSetDock(var Msg: TMessage); message WM_SETDOCK;
  public
    { Public declarations }

  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}

uses BorderDock;

var
DockRec: TDockRec;

procedure TForm2.WMSetDock(var Msg: TMessage);
var
wRect: TRect;
dPos1: TDPos;
begin
if Msg.WParam <> 54321 then Exit;
case Msg.LParam of
  100: DockRec.DockPos := Point(-Width, abs(MainForm.Height - Height) div 2);
  101: DockRec.DockPos := Point(abs(MainForm.Width - Width) div 2, -Height);
  102: DockRec.DockPos := Point(MainForm.Width, abs(MainForm.Height - Height) div 2);
  103: DockRec.DockPos := Point(abs(MainForm.Width - Width) div 2, MainForm.Height);
  else Exit;
  end;
dPos1 := TDPos(Msg.LParam-100);
PosSet := PosSet+[dPos1];
DockRec.dPos := dPos1;
DockList.Add(@DockRec);
Docked := True;
DoDock := False;
but_DoDock.Caption := 'Un Dock';
GetWindowRect(MainForm.Handle, wRect);
Msg.LParam := Integer(@wRect);
MainForm.WMMoving(Msg);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
DockRec.Handle := Handle;
DockRec.DockPos := Point(-Width, 0);
DockRec.dPos := dpLeft;
Docked := False;
DoDock := False;
but_DoDock.Caption := 'Allow Docking';
end;


procedure TForm2.WMMoving(var Msg: TMessage);
var
Hdwp1, i: Integer;
cPnt: TPoint;
dPos1: TDPos;

  function dooPoint(dPos: TDPos): TPoint;
  begin
  case dPos of
    dpLeft: begin Result := PRect(Msg.LParam).BottomRight;
            Dec(Result.y, Height div 2);
            end;
    dpTop: begin Result := PRect(Msg.LParam).BottomRight;
            Dec(Result.x, Width div 2);
            end;
    dpRight: begin Result := PRect(Msg.LParam).TopLeft;
            Inc(Result.y, Height div 2);
            end;
    dpBottom: begin Result := PRect(Msg.LParam).TopLeft;
            Inc(Result.x, Width div 2);
            end;
    end;
  end;


begin
if Docked then
  begin
  Hdwp1 := BeginDeferWindowPos(DockList.Count+1);

  DeferWindowPos(Hdwp1, MainForm.Handle, HWND_BOTTOM,
          PRect(Msg.LParam)^.Left-DockRec.DockPos.x,
          PRect(Msg.LParam)^.Top-DockRec.DockPos.y, 1, 1,
          SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
  if DockList.Count > 1 then
  for i := 0 to DockList.Count - 1 do
      begin
      if PDockRec(DockList[i]).Handle = Handle then Continue;

      DeferWindowPos(Hdwp1, PDockRec(DockList[i]).Handle, HWND_BOTTOM,
          PRect(Msg.LParam)^.Left+PDockRec(DockList[i]).DockPos.x-DockRec.DockPos.x,
          PRect(Msg.LParam)^.Top+PDockRec(DockList[i]).DockPos.y-DockRec.DockPos.y, 1, 1,
          SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
      end;
  EndDeferWindowPos(Hdwp1);
  Exit;
  end else
  if DoDock then
  begin
  for dPos1 := dpLeft to dpBottom do
  if ptInRect(aryPRect[dPos1] , dooPoint(dPos1)) then
    begin
    if not (dPos1 in PosSet) then
      begin
      GetCursorPos(cPnt);
      mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, cPnt.x, cPnt.y,0,0);
      Application.ProcessMessages;
      PostMessage(Handle, WM_SETDOCK, 54321,100+Ord(dPos1));
      end;
    Break;
    end;
  end;
inherited;
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Docked then
  begin
  DockList.Extract(@DockRec);
  PosSet := PosSet-[DockRec.dPos];
  end;
Docked := False;
DoDock := False;
but_DoDock.Caption := 'Allow Docking';
end;


procedure TForm2.but_DoDockClick(Sender: TObject);
begin
if but_DoDock.Caption = 'Allow Docking' then
  begin
  DoDock := True;
  but_DoDock.Caption := 'Docking';
  end else
  if but_DoDock.Caption = 'Docking' then
  begin
  DoDock := False;
  but_DoDock.Caption := 'Allow Docking';
  end else
  if but_DoDock.Caption = 'Un Dock' then
  begin
  DockList.Extract(@DockRec);
  PosSet := PosSet-[DockRec.dPos];
  Docked := False;
  DoDock := False;
  but_DoDock.Caption := 'Allow Docking';
  end;
end;

end.


 = = = = = = = = = = = = = = = = = = = = = = = = == = = = =

this seems to work, as far as I can tell
0
 
LVL 2

Author Comment

by:Greenandroid
ID: 13477324
Hmmm

I can get it to compile fine, without errors, however im still having difficulties. If i press button 2, then form 2 shows fine... But upon even moving the mainform a fraction, it returns an access violation.


Bit miffed as to why it is doing it, but i shall keep trying
0
 
LVL 2

Author Comment

by:Greenandroid
ID: 13477501
Ok... instead of naming the forms MainForm and BDock2 etc, i have changed them back to unit1 and so forth. I have also removed all traces of form3, so your code show only dock my form1 and form 2 together... I have copied the code i have used EXACTLY. This compiles without error, until i move Form1.


code for the MainForm -




unit Unit1;

interface

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

type
  TDPos = (dpLeft,dpTop,dpRight,dpBottom);
  // I am only doing a 4 position docking to main form, left, top, right and bottom

  PDockRec = ^TDockRec;
  TDockRec = record // record to store the handle and position of docked forms
    Handle: Cardinal;
    DockPos: TPoint;
    dPos: TDPos;
    end;

  TForm1 = class(TForm)

  // all of this is NOT needed for SnapTo Docking -
    but_ShowForm2: TButton;
    procedure but_ShowForm2Click(Sender: TObject);
  //  end of  NOT needed -

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMMoving(var Msg: TMessage); message WM_MOVING;
  end;

const
// these constants set the size of the drag over Dock seek rectangle
BoxL = 15;
BoxH = 18;

var
  Form1: TForm1;
  DockList: TList;
  aryPRect: Array[TDPos] of TRect;// rectangles for drag over Dock seek
  PosSet: Set of TDPos;// used to avoid docking in same location

implementation

{$R *.DFM}

uses
  Unit2; //secondary forms units, Form2, Form3

procedure TForm1.WMMoving(var Msg: TMessage);
var
hDwp1, i, wd, ht, halfW, halfH: Integer;

begin
wd := PRect(Msg.LParam).Right-PRect(Msg.LParam).Left;
ht := PRect(Msg.LParam).Bottom-PRect(Msg.LParam).Top;
halfH := ht div 2;
halfW := wd div 2;
aryPRect[dpLeft] := Rect(PRect(Msg.LParam).Left-BoxL,PRect(Msg.LParam).Top+halfH-BoxH,
                         PRect(Msg.LParam).Left+BoxL,PRect(Msg.LParam).Top+halfH+BoxH);
aryPRect[dpTop] := Rect(PRect(Msg.LParam).Left+halfW-BoxH,PRect(Msg.LParam).Top-BoxL,
                        PRect(Msg.LParam).Left+halfW+BoxH,PRect(Msg.LParam).Top+BoxL);
aryPRect[dpRight] := Rect(PRect(Msg.LParam).Left+wd-BoxL,aryPRect[dpLeft].Top,
                          PRect(Msg.LParam).Left+wd+BoxL,aryPRect[dpLeft].Bottom);
aryPRect[dpBottom] := Rect(aryPRect[dpTop].Left,PRect(Msg.LParam).Top+ht-BoxL,
                           aryPRect[dpTop].Right,PRect(Msg.LParam).Top+ht+BoxL);

if DockList.Count > 0 then
  begin
  hDwp1 := BeginDeferWindowPos(DockList.Count+1);
  for i := 0 to DockList.Count - 1 do
    begin
    DeferWindowPos(hDwp1, PDockRec(DockList[i]).Handle, HWND_BOTTOM,
        PRect(Msg.LParam)^.Left+PDockRec(DockList[i]).DockPos.x,
        PRect(Msg.LParam)^.Top+PDockRec(DockList[i]).DockPos.y, 1, 1,
        SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
    end;
  EndDeferWindowPos(hDwp1);
  Exit;
  end;

inherited;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
halfW, halfH: Integer;
begin
DockList := TList.Create;
halfW := Width div 2;
halfH := Height div 2;
aryPRect[dpLeft] := Rect(Left-BoxL,Top+halfH-BoxH,Left+BoxL,Top+halfH+BoxH);
aryPRect[dpTop] := Rect(Left+halfW-BoxH,Top-BoxL,Left+halfW+BoxH,Top+BoxL);
aryPRect[dpRight] := Rect(Left+Width-BoxL,aryPRect[dpLeft].Top,
                          Left+Width+BoxL,aryPRect[dpLeft].Bottom);
aryPRect[dpBottom] := Rect(aryPRect[dpTop].Left,Top+Height-BoxL,
                           aryPRect[dpTop].Right,Top+Height+BoxL);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(DockList);
end;

procedure TForm1.but_ShowForm2Click(Sender: TObject);
begin
Form2.Show;
end;


end.



= = = = = =  = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =



unit Unit2;

interface

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

const
WM_SETDOCK = WM_USER+359;

type
  TForm2 = class(TForm)
    but_DoDock: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure but_DoDockClick(Sender: TObject);
  private
    { Private declarations }
    Docked, DoDock: Boolean;
    procedure WMMoving(var Msg: TMessage); message WM_MOVING;
    procedure WMSetDock(var Msg: TMessage); message WM_SETDOCK;
  public
    { Public declarations }

  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}

uses Unit1;

var
DockRec: TDockRec;

procedure TForm2.WMSetDock(var Msg: TMessage);
var
wRect: TRect;
dPos1: TDPos;
begin
if Msg.WParam <> 54321 then Exit;
case Msg.LParam of
  100: DockRec.DockPos := Point(-Width, abs(Form1.Height - Height) div 2);
  101: DockRec.DockPos := Point(abs(Form1.Width - Width) div 2, -Height);
  102: DockRec.DockPos := Point(Form1.Width, abs(Form1.Height - Height) div 2);
  103: DockRec.DockPos := Point(abs(Form1.Width - Width) div 2, Form1.Height);
  else Exit;
  end;
dPos1 := TDPos(Msg.LParam-100);
PosSet := PosSet+[dPos1];
DockRec.dPos := dPos1;
DockList.Add(@DockRec);
Docked := True;
DoDock := False;
but_DoDock.Caption := 'Un Dock';
GetWindowRect(Form1.Handle, wRect);
Msg.LParam := Integer(@wRect);
Form1.WMMoving(Msg);
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
DockRec.Handle := Handle;
DockRec.DockPos := Point(-Width, 0);
DockRec.dPos := dpLeft;
Docked := False;
DoDock := False;
but_DoDock.Caption := 'Allow Docking';
end;


procedure TForm2.WMMoving(var Msg: TMessage);
var
Hdwp1, i: Integer;
cPnt: TPoint;
dPos1: TDPos;

  function dooPoint(dPos: TDPos): TPoint;
  begin
  case dPos of
    dpLeft: begin Result := PRect(Msg.LParam).BottomRight;
            Dec(Result.y, Height div 2);
            end;
    dpTop: begin Result := PRect(Msg.LParam).BottomRight;
            Dec(Result.x, Width div 2);
            end;
    dpRight: begin Result := PRect(Msg.LParam).TopLeft;
            Inc(Result.y, Height div 2);
            end;
    dpBottom: begin Result := PRect(Msg.LParam).TopLeft;
            Inc(Result.x, Width div 2);
            end;
    end;
  end;


begin
if Docked then
  begin
  Hdwp1 := BeginDeferWindowPos(DockList.Count+1);

  DeferWindowPos(Hdwp1, Form1.Handle, HWND_BOTTOM,
          PRect(Msg.LParam)^.Left-DockRec.DockPos.x,
          PRect(Msg.LParam)^.Top-DockRec.DockPos.y, 1, 1,
          SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
  if DockList.Count > 1 then
  for i := 0 to DockList.Count - 1 do
      begin
      if PDockRec(DockList[i]).Handle = Handle then Continue;

      DeferWindowPos(Hdwp1, PDockRec(DockList[i]).Handle, HWND_BOTTOM,
          PRect(Msg.LParam)^.Left+PDockRec(DockList[i]).DockPos.x-DockRec.DockPos.x,
          PRect(Msg.LParam)^.Top+PDockRec(DockList[i]).DockPos.y-DockRec.DockPos.y, 1, 1,
          SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
      end;
  EndDeferWindowPos(Hdwp1);
  Exit;
  end else
  if DoDock then
  begin
  for dPos1 := dpLeft to dpBottom do
  if ptInRect(aryPRect[dPos1] , dooPoint(dPos1)) then
    begin
    if not (dPos1 in PosSet) then
      begin
      GetCursorPos(cPnt);
      mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, cPnt.x, cPnt.y,0,0);
      Application.ProcessMessages;
      PostMessage(Handle, WM_SETDOCK, 54321,100+Ord(dPos1));
      end;
    Break;
    end;
  end;
inherited;
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Docked then
  begin
  DockList.Extract(@DockRec);
  PosSet := PosSet-[DockRec.dPos];
  end;
Docked := False;
DoDock := False;
but_DoDock.Caption := 'Allow Docking';
end;


procedure TForm2.but_DoDockClick(Sender: TObject);
begin
if but_DoDock.Caption = 'Allow Docking' then
  begin
  DoDock := True;
  but_DoDock.Caption := 'Docking';
  end else
  if but_DoDock.Caption = 'Docking' then
  begin
  DoDock := False;
  but_DoDock.Caption := 'Allow Docking';
  end else
  if but_DoDock.Caption = 'Un Dock' then
  begin
  DockList.Extract(@DockRec);
  PosSet := PosSet-[DockRec.dPos];
  Docked := False;
  DoDock := False;
  but_DoDock.Caption := 'Allow Docking';
  end;
end;

end.

===================================================
Ok this compiles, but causes an error as mentioned in my post above.
It highlights the line "if DockList.Count > 0 then" with an exeption error..
Could you either explain why this is, or, (i dont know if you are allowed to), but email me a working version?
0
 
LVL 34

Expert Comment

by:Slick812
ID: 13478902
????
I can only guess at what may or may not be the problem?
The code I posted is working code. . .
From your error and the line for the error of  "if DockList.Count > 0 then"  I would say that your DockList has NOT been created. .
You have code in your FormCreate for  "DockList := TList.Create;" so it would be created if that procedure is called, so It must not being called, ,

although that code is in my code, I did NOT add that code by just writing it (or pasting it as in your case). .  I got it from the FormCreate event, I went to the object inspector for the Form (mainForm, Form1, whatever), and in the Events Tab, I doubled clicked the   OnCreate   event to have that event and code added to the unit, same for the   " procedure FormDestroy(Sender: TObject);"  event
0
 
LVL 34

Expert Comment

by:Slick812
ID: 13479782
I ran my code again to test and see if I could change it, and this is the code now, I took out all form events and added an initialization clause, I also added a WM_MOVE to improve the drag-over rectangle updating

unit BorderDock;

interface

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

type
  TDPos = (dpLeft,dpTop,dpRight,dpBottom);

  PDockRec = ^TDockRec;
  TDockRec = record
    Handle: Cardinal;
    DockPos: TPoint;
    dPos: TDPos;
    end;

  TMainForm = class(TForm)

  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMMoving(var Msg: TMessage); message WM_MOVING;
    procedure WMMove(var Msg: TMessage); message WM_MOVE;
  end;

const
BoxL = 22;
BoxH = 56;

var
  MainForm: TMainForm;
  DockList: TList;
  aryPRect: Array[TDPos] of TRect;
  PosSet: Set of TDPos;

implementation

{$R *.DFM}

uses
  BDock2, BDock3;

procedure TMainForm.WMMove(var Msg: TMessage);
var
halfH, halfW: Integer;
begin
halfH := Height div 2;
halfW := Width div 2;
aryPRect[dpLeft] := Rect(Left-BoxL,Top+halfH-BoxH,
                         Left+BoxL,Top+halfH+BoxH);
aryPRect[dpTop] := Rect(Left+halfW-BoxH,Top-BoxL,
                        Left+halfW+BoxH,Top+BoxL);
aryPRect[dpRight] := Rect(Left+Width-BoxL,aryPRect[dpLeft].Top,
                          Left+Width+BoxL,aryPRect[dpLeft].Bottom);
aryPRect[dpBottom] := Rect(aryPRect[dpTop].Left,Top+Height-BoxL,
                           aryPRect[dpTop].Right,Top+Height+BoxL);
end;

procedure TMainForm.WMMoving(var Msg: TMessage);
var
hDwp1, i: Integer;

begin
if DockList.Count > 0 then
  begin
  hDwp1 := BeginDeferWindowPos(DockList.Count+1);
  for i := 0 to DockList.Count - 1 do
    begin
    DeferWindowPos(hDwp1, PDockRec(DockList[i]).Handle, HWND_BOTTOM,
        PRect(Msg.LParam)^.Left+PDockRec(DockList[i]).DockPos.x,
        PRect(Msg.LParam)^.Top+PDockRec(DockList[i]).DockPos.y, 1, 1,
        SWP_NOSIZE or SWP_NOZORDER or SWP_NOACTIVATE);
    end;
  EndDeferWindowPos(hDwp1);
  Exit;
  end;

inherited;
end;


initialization
DockList := TList.Create;

finalization
FreeAndNil(DockList);

end.
0
 
LVL 2

Author Comment

by:Greenandroid
ID: 13480723
hmmmm....

ok i did what you said, and compiled.... hey presto.. no errors - BUT it didnt dock

I saved everything and reopened it about 20 mins later. When i opened it this time, its actually started docking.... but very badly...
The problem is it doestnt dock consistantly. I open form 2, press the 'allow docking' button. The button caption changes to 'docking' as it should. When i move form 2 to any of my form1's edges, it doesn't dock at all. If i quickly wave it over the form, it might spontaniously dock to one side. When i undock it, and click to allow docking again, it doesn't redock at all when i move it over form 1.

Any ideas why its doing this?
0
 
LVL 34

Assisted Solution

by:Slick812
Slick812 earned 400 total points
ID: 13482832
???
in Unit2 for Form2 then -

    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

are both Form Events, where you get them both from the object inspector. . .

I am not sure what to say, it works for me with good results. .  especially after I add the WM_MOVE to even out the rectangle updates. . .

you may want to widen the Drag-Over Rectangle, I used a narrow scope, but you might change the -

BoxL = 22;
BoxH = 56;

to  slightly more. . .

you could add a button click to your main form to see the drag-over rectangles -

procedure TMainForm.sbut_ShowRectsClick(Sender: TObject);
var
sDC: Integer;
i: TDPos;
begin
sDC := GetDC(0);
for i := dpLeft to High(aryPRect) do
Rectangle(sDC,aryPRect[i].Left,aryPRect[i].Top,aryPRect[i].Right,aryPRect[i].Bottom);
ReleaseDC(0,sDC);
end;

The secondary forms all have their 4 "Points" of drag detection at the center of their 4 egdes,
0
 
LVL 26

Accepted Solution

by:
EddieShipman earned 400 total points
ID: 13490827
I don't believe you took a look at this control, did you:

---------------- TSnapForm v1.5 ----------------
This component let a form to be magnetized with
another form (like WinAmp). The magnetic strength
is modifiable. It is also possible to stick the
form and moving the child form with his parent.
Some bugs was fixed : TSnapForm v1.5 - non visual
component - 02/09/2003 Correction of bugs.

Upgrades : - Event when a form is unMagnetized.
           - Event when a magnetization was
             modified
           - Help file created
             (in French only sorry)

TSnapForm v1.4d - non visual component - 01/09/2003
Correction of bugs : - When a sticked form is
                       resize, the parent form move
                       too.
                     - Suppress stick when form is
                       minimize/maximize/restore/close.
TSnapForm v1.4c - non visual component
Correction of bugs : - Fix a bug in DelFormSnap procedure.

http://www.delphipages.com/edit/count.cfm?ID=3976
0
 
LVL 2

Author Comment

by:Greenandroid
ID: 13491122
Well... What can i say...

First of all, i wish to thank both Eddie and Slick for their continual support throughout this thread. I have no doubt that your code worked properly slick, but for some reason it wouldn't work for me.

Eddie, the component you posted above works for me PERFECTLY. Perhaps this component was in one of those delphi links you gave me.. (im thinking i may have not noticed it).... or perhaps its just another component you found from somewhere... either way, its great.

I did not want to leave your support unrewarded slick, so i have given both you and Eddie 100 points.

Thank you both of you!

Regards
James
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 13491457
Glad to be of assistance. It's surprisint that I didn't search DP before, I am the leading expert there.
I only searched Torry's and that control is not listed there.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
In this video we outline the Physical Segments view of NetCrunch network monitor. By following this brief how-to video, you will be able to learn how NetCrunch visualizes your network, how granular is the information collected, as well as where to f…
In this video, Percona Solutions Engineer Barrett Chambers discusses some of the basic syntax differences between MySQL and MongoDB. To learn more check out our webinar on MongoDB administration for MySQL DBA: https://www.percona.com/resources/we…
Suggested Courses
Course of the Month11 days, 20 hours left to enroll

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question