Magnetic Forms

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

ASKER

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!

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

oop, sorry, ScreenDocker also only does to edges of the screen, didn't see that until after I downloaded it.

Here's a post that may help you:

http://www.delphipages.com/threads/thread.cfm?ID=39584&G=39582&SAR=TRUE

ASKER

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

Found these:
https://www.experts-exchange.com/questions/20723414/Anyone-know-of-a-good-docking-component.html
https://www.experts-exchange.com/questions/20408337/Connecting-two-TForms-together.html
https://www.experts-exchange.com/questions/20427326/snapping-a-form-to-another-form's-border.html
https://www.experts-exchange.com/questions/20339794/Hook-two-forms-to-eachother-like-Winamp-player-do.html
https://www.experts-exchange.com/questions/20753872/Form-positioning.html

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 -

https://www.experts-exchange.com/questions/21085996/Keep-forms-snapped-together.html

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

ASKER

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

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?

ASKER

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.

Jacco

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.

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

ASKER

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

ASKER

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?

????
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

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.

ASKER

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?

SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

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