以前曾写代码试过,下边是我的一个完整DEMO,共有2个窗体。
主窗体是form1,form1上有按钮,按下,弹出form2,托动form2,就会发现form1有磁性了。
你可以修改一下,使所有的form都具有磁性。(D6通过)
--------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
form2.show;
end;
end.
--------------
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm2 = class(TForm)
private
procedure WMWINDOWPOSCHANGING(Var Msg: TWMWINDOWPOSCHANGING);message WM_WINDOWPOSCHANGING;
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses Types,Unit1;
{$R *.dfm}
procedure TForm2.WMWINDOWPOSCHANGING(var Msg: TWMWINDOWPOSCHANGING);
var
rWorkArea: TRect;
StickAt : Word;
begin
StickAt :=38; //可随意设置,是磁性的范围大小。
rWorkArea.Left:=form1.left;
rWorkArea.Top:=form1.Top;
rWorkArea.Right:=form1.left+form1.Width;
rWorkArea.Bottom:=form1.Top+form1.Height;
// SystemParametersInfo(SPI_GETWORKAREA, 0, @rWorkArea, 0);
//-------------------------------------------
// 磁性窗体图示:
//
// ……………………………………
// | ___________________ |
// | | |___|__________主from边界
// | | …………………… | |
// | | | | | |__________外边界,当超过(向内)外边界时,重新设置为主from边界
// | | | | | |
// | | |……………… |__|___|__________内边界,当超过(向外)内边界时,重新设置为主from边界
// | |___________________| |
// | |
// |…………………………………|
//
//
//---------------------------------------------
with Msg.WindowPos^ do
begin
if (x+cx<rWorkArea.Left+StickAt) then //左方 (x<rWorkArea.Left) and
if (x+cx>rWorkArea.Left-StickAt) or((x+cx>rWorkArea.Left) and (x+cx<rWorkArea.Left+StickAt)) then
begin
x:=rWorkArea.Left-cx;
end;
if (x>rWorkArea.Right-StickAt) then //右方 and (x+cx>rWorkArea.Right)
if (x<rWorkArea.Right+StickAt) or ((x<rWorkArea.Right) and (x>rWorkArea.Right-StickAt)) then
begin
x:=rWorkArea.Right;
end;
if (y+cy<rWorkArea.Top+StickAt) then //上方 (y<rWorkArea.Top) and
if (y+cy>rWorkArea.Top-StickAt) or ((y+cy>rWorkArea.Top) and (y+cy<rWorkArea.Top+StickAt)) then
begin
y:= rWorkArea.Top-cy;
end;
if (y>rWorkArea.Bottom-StickAt) then //下方 and (y+cy>rWorkArea.Bottom)
if (y<rWorkArea.Bottom+StickAt) or ((y<rWorkArea.Bottom) and (y>rWorkArea.Bottom-StickAt)) then
begin
y:= rWorkArea.Bottom;
end;
end;
inherited;
end;
end.