100分求磁性窗体（连动窗体）源码！

Question

不要发WINAMP的那个了，我试过，试不出来，用不好
最好是您试过的，生成源程序看过的，谢谢了！贴一段好用的也可以，WINAMP的那个就不用贴了，网上到处都是

Answer 1

我是楼主，下面这个可以，但是看不太懂，谁能帮我试一试，因为这个程序当FORM1移动时，FORM２的现有状态全部都改变了，不太好，怎么保留FORM2的状态，只是跟着一起移动啊？？unit   Unit1;interfaceuses
    Windows, Messages, SysUtils, Variants, Classes, Graphics,   Controls,   Forms,
    Dialogs;type
    TForm1 = class(TForm)
    private
        { Private declarations }
        procedure  WMWindowPosChanged(var   Msg:   TWMWindowPosChanged);message   WM_WINDOWPOSCHANGED;    public
        { Public declarations }
    end;var
    Form1:   TForm1;const     uFlag   =   SWP_NOACTIVATE   or   SWP_NOZORDER   or   SWP_NOMOVE   or   SWP_NOSIZE;implementationuses   Unit2;{$R   *.dfm}{   TForm1   }procedure   TForm1.WMWindowPosChanged(var   Msg:   TWMWindowPosChanged);
var
    Rect:   TRect;
      X,   Y,   Cx,   Cy:   Integer;
      uFlag2:   UINT;
begin
    inherited;
    if   Form2   <>   nil   then       //如果子窗体存在
    begin
        GetWindowRect(Form2.Handle,   Rect);         //获得子窗体的位置
        with   Msg   do
        begin
            X   :=   WindowPos^.x   +   WindowPos^.cx;         //新X坐标
            Y   :=   WindowPos^.y;                                       //新Y坐标
            Cx   :=   WindowPos^.cx;                                   //新宽度
            Cy   :=   WindowPos^.cy;                                 //新高度
        end;
        uFlag2   :=   uFlag;                                 //移动必要时
        if   (Rect.Top   <>   Y)   or   (Rect.Left   <>   X)   then
            uFlag2   :=   uFlag2   and   (not   SWP_NOMOVE);
        if   (Rect.Bottom   -   Rect.Top   <>   Cy)   or         //尺寸变更必要时
              (Rect.Right   -   Rect.Left   <>   Cx)   then
            uFlag2   :=   uFlag2   and   (not   SWP_NOSIZE);
        if   uFlag   <>   uFlag2   then                                   //都必要时
            SetWindowPos(Form2.Handle,   0,   X,   Y,   Cx,   Cy,   uFlag2);
        end;
end;

Answer 2

>>怎么保留FORM2的状态，只是跟着一起移动啊？？
是不是form2里面自己有修改的代码

Answer 3

不啊，FORM2的大小不变，height座标不变，可以吗？而且条件是当FORM2的边框和FORM1隔20象素时一起移动，太远就不移动

Answer 4

要是移动时form2.screen.height也不变，width和height都不变，并且按相隔20象素时，找到当时位置可以吸附在form1的上下左右四面都可以吸附就是最完美的了。
不过太复杂了，我试改了一部分，大部分还在想，五颗星，能在帮帮吗？我急用。

Answer 5

不是form2.screen.height，错了，是FORM2没吸附前的原始screen.height和form1的原始screen.height的高度差不变

Answer 6

//        if   (Rect.Bottom   -   Rect.Top   <>   Cy)   or         //尺寸变更必要时
//              (Rect.Right   -   Rect.Left   <>   Cx)   then
//            uFlag2   :=   uFlag2   and   (not   SWP_NOSIZE就不会改变 form2 的 height ...

Answer 7

var F1Top, F1Left: integer;
procedure TForm1.FormShow(Sender: TObject);
begin
  if not form2.Visible then
  begin
      form2.Show;
      form2.Top := 400;
  end;  F1Top := self.Top;
  F1Left := self.Left;
end;const     uFlag   =   SWP_NOACTIVATE   or   SWP_NOZORDER   or   SWP_NOMOVE   or   SWP_NOSIZE;procedure TForm1.WMWindowPosChanged(var Msg: TWMWindowPosChanged);
var
    Rect:   TRect;
      X,   Y,   Cx,   Cy:   Integer;
      uFlag2:   UINT;
begin
    inherited;
    if   Form2   <>   nil   then       //如果子窗体存在
    begin
        GetWindowRect(Form2.Handle,   Rect);         //获得子窗体的位置
        with   Msg   do
        begin
            X   :=   Form2.Left +  (WindowPos^.x - F1Left);         //新X坐标
            Y   :=   Form2.Top + (WindowPos^.y - F1Top);                                       //新Y坐标
            Cx   :=   WindowPos^.cx;                                   //新宽度
            Cy   :=   WindowPos^.cy;                                 //新高度
        end;
        uFlag2   :=   uFlag;                                 //移动必要时
        if   (Rect.Top   <>   Y)   or   (Rect.Left   <>   X)   then
            uFlag2   :=   uFlag2   and   (not   SWP_NOMOVE);
//        if   (Rect.Bottom   -   Rect.Top   <>   Cy)   or         //尺寸变更必要时
//              (Rect.Right   -   Rect.Left   <>   Cx)   then
//            uFlag2   :=   uFlag2   and   (not   SWP_NOSIZE);
        if   uFlag   <>   uFlag2   then                                   //都必要时
            SetWindowPos(Form2.Handle,   0,   X,   Y,   Cx,   Cy,   uFlag2);
        end;  F1Top := self.Top;
  F1Left := self.Left;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 FreeAndNil(Form2);
end;

Answer 8

>>这个是的，但是怎么也能吸附在左边呢？而且只是隔20像素时，
加个判断：
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeAndNil(Form2);
end;var F1Top, F1Left: integer;procedure TForm1.FormShow(Sender: TObject);
begin
  if not form2.Visible then
  begin
    form2.Show;
    form2.Top := 400;
    F1Top := self.Top;
    F1Left := self.Left;
  end;
end;const uFlag = SWP_NOACTIVATE or SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE;procedure TForm1.WMWindowPosChanged(var Msg: TWMWindowPosChanged);
var
  Rect: TRect;
  X, Y, Cx, Cy: Integer;
  uFlag2: UINT;
begin
  inherited;
  if Form2 <> nil then //如果子窗体存在
  begin
    if (Form2.Left - (F1Left + Form1.Width)) < 20 then
    begin      GetWindowRect(Form2.Handle, Rect); //获得子窗体的位置
      with Msg do
      begin
        X := Form2.Left + (WindowPos^.x - F1Left); //新X坐标
        Y := Form2.Top + (WindowPos^.y - F1Top); //新Y坐标
        Cx := WindowPos^.cx; //新宽度
        Cy := WindowPos^.cy; //新高度
      end;
      uFlag2 := uFlag; //移动必要时
      if (Rect.Top <> Y) or (Rect.Left <> X) then
        uFlag2 := uFlag2 and (not SWP_NOMOVE);      if uFlag <> uFlag2 then //都必要时
        SetWindowPos(Form2.Handle, 0, X, Y, Cx, Cy, uFlag2);
    end;
  end;
  F1Top := self.Top;
  F1Left := self.Left;
end;

Answer 9

修改成这样好点：
  if Form2 <> nil then //如果子窗体存在
  begin
    if (abs((Form2.Left - (F1Left + Form1.Width))) < 20)  or
      (abs(Form2.top - (F1Top + Form1.Height)) < 20)  or
       (abs(F1Left - (Form2.Left + Form2.Width)) < 20)  or
       (abs(F1Top - (Form2.Top + Form2.Height)) < 20) then