一个磁性窗体VCL组件的具体实现

一个磁性窗体VCL组件的具体实现
副标题：
作者：佚名 文章来源：大富翁 点击数：52 更新时间：2005-2-25
 
 
文：陈达军
日期：2003-10-29

记得《程序员》杂志中曾有一篇文章介绍过如何实现磁性窗体，该篇文章总结了网上相关的讨论帖子，分析了实现磁性窗体的基本原理，并最终给出了一个可行的解决方案。但文中介绍的具有磁性吸附能力的主窗体只能是应用程序的主窗体，不具有灵活性，且文中给出的示例代码是以C++ Bulider来实现的。现在我们就在Delphi中尝试一下如何以VCL组件的形式来实现该功能，并力求在功能上做些延伸。文中疏漏之处，还请高手指教。

分析
 讨论之前我们先来定义两个名词。这里所指的主窗体是指具有磁性吸附作用的窗体，而子窗体是指被主窗体吸附并能与主窗体粘在一起的窗体，子窗体之间不具备吸附性。打个比方，磁铁能吸附一个或多个铁块，而两个铁块之间是不具有磁性作用的（如果铁块被磁化那就另当别论了）。下面我们就来分析一下实现磁性窗体的大致过程。

 一、子窗体粘贴到主窗体的过程

用户在移动一个窗体的过程中，窗体会接收到什么消息呢？我们来看看MSDN上的一段说明：
 
The WM_MOVING message is sent to a window that the user is moving. By processing this message, an application can monitor the position of the drag rectangle and, if needed, change its position.

原来在窗体移动的过程中，会不断产生WM_MOVING标准的系统消息！！！该消息的LPARAM参数是一个指向TRect结构的指针，而TRect结构中存放着窗口当前位置矩形区域信息。由此不难推断出我们需要截获窗口的WM_MOVING消息，在Delphi中截获窗口消息的方法有很多种，这里我们采用替换原窗口函数的方式，用自定义消息处理函数来截获此消息。

再来看看MSDN上关于WM_MOVE消息的解释：

The WM_MOVE message is sent after a window has been moved.

看来WM_MOVE消息也应当是我们的囊中之物，用来调整相关窗口的最终位置。

在自定义消息处理函数中，我们不断地检测子窗体与主窗口的距离，若小于了某个设定的值，则将该子窗体粘贴到主窗体。但如何获知主窗体呢？因为只有获得了主窗体，我们才能将两者做位置区域比较，决定子窗体是否能被吸附到主窗体上。前面所说一文中采用了Application->MainForm的方式，这样就限制了主窗体只能是应用程序的主窗体。我们采取的做法是：定义一个全局变量来保存主窗体所关联的TMagnetServer对象，在创建第一个TMagnetServer对象时用该对象给此全局变量赋值，当然每个应用程序中也只能有一个TMagnetServer对象。

二、子窗体从主窗体移开的过程

子窗体从主窗体移开的过程与上述粘贴过程非常相似，具体实现时两者可放在一起处理。在自定义消息处理函数中，不断地检测子窗体与主窗口的距离，若大于了某个设定的值，则将该子窗体与主窗体断开。

 三、主窗口关联子窗体移动的过程

 主窗口关联子窗体移动即指在主窗体移动的过程中所有粘贴到该主窗体的子窗体都跟着主窗体的移动而移动，并保持相对位置不变。同理，主窗体在移动的过程也会接收到WM_MOVING消息，我们可以截获此消息，并逐一改变其所关联的所有子窗体的位置。
    
设计
 Delphi作为RAD（Rapid Application Development）工具而深受广大程序员的喜爱，丰富的VCL库可谓功不可没。由上述分析可知，我们定义了三个类来具体实现之，以适应"一拖即用"的组件化快速应用开发需要。

 TMagnetForm 类作为TMagnetServer和TMagnetClient类的基类，主要实现替换原窗口函数，截获特定窗口消息的功能。因为磁性窗体组件在运行时具有不可见性，所以该类直接从TComponent类继承。注意：TMagnetForm类的DoMoving和DoMove函数我们都定义为了virtual、abstract类型，充分利用虚函数的优点，实现根据继承类的不同而在运行时动态调用不同的函数。TMagnetForm类的相关说明如表1所示。

名 称  类 型  说 明
OldWindowProc  TWndMethod  默认消息处理函数
DoMoving      Procedure virtual abstract  WM_MOVING消息处理函数
DoMove  Procedure virtual abstract  WM_MOVE消息处理函数
表1

 TMagnetServer 类实现了磁性主窗体具备的功能。Delphi中的TList类为我们存放子窗体列表提供了一个很好的容器类。当有子窗体粘贴到主窗体时，就将该子窗体的TMagnetClient对象添加到链表中，反之，则从链表中移除该对象。在主窗体移动的过程，调用AdjustFormPos 函数，逐一调整子窗体的位置。并且可以通过MagnetStyles 集合类型属性来控制主窗体的粘贴样式。TMagnetServer类的相关说明如表2所示。

名 称  类 型  说 明
FActive  Boolean  决定主窗体是否允许粘贴
FDistance      Integer  产生磁性引力的距离
FForm  TScrollingWinControl  关联的窗口
FMagnetStyles  TMangerStyles  主窗体粘贴样式
FMagnetClientList  TList  关联的子窗体链表
AdjustFormPos  procedure  调整关联子窗体位置
UnionOtherForm  procedure  具体调整过程
DoMove  procedure override  重载基类同名函数
DoMoving  procedure override  重载基类同名函数
表2

 TMagnetClient 类用来封装磁性子窗体的功能。FMagnetServer 成员变量用来存储子窗体关联的主窗体的TMagnetServer对象。TMagnetClient类的相关说明如表3所示。

名 称  类 型  说 明
FEnabled  Boolean  用来防止重复操作
FForm  TScrollingWinControl  关联的窗口
FMagnetServer  TMagnetServer  粘贴到的主窗体
FXPos  Integer  子窗体粘贴时最终Left位置
FYPos  Integer  子窗体粘贴时最终Top位置
AttachToForm  procedure  粘贴到主窗体或移开过程
DoMove  procedure override  重载基类同名函数
DoMoving  procedure override  重载基类同名函数
表3

编码
 经过了上面详细的分析设计，磁性窗体组件的具体实现过程并不困难。下面我们就摘取部分关键代码来做一下说明，具体的实现过程请参考附例代码。

var
  MainServer: TMagnetServer;  // 定义一个全局变量

// 定义新的窗体消息处理函数
procedure TMagnetForm.NewWndProc(var Message: TMessage);
begin
  if Message.Msg = WM_MOVING then
  begin
    DoMoving(Message);
    Message.Result := 1;
  end;
  if Message.Msg = WM_MOVE then
  begin
    DoMove(Message);
    Message.Result := 1;
  end; 
  OldWindowProc(Message);
end;

// TmagnetForm构造函数，确保每个窗体只能拥有一个TMagnetServer或TMagnetClient组件
constructor TMagnetForm.Create(AOwner: TComponent);
var
  nIndex: Integer;
begin
  for nIndex := 0 to TScrollingWinControl(AOwner).ComponentCount - 1 do
begin
    if (UpperCase(TScrollingWinControl(AOwner).Components[nIndex].ClassName) = 'TMAGNETCLIENT') or
       (UpperCase(TScrollingWinControl(AOwner).Components[nIndex].ClassName) = 'TMAGNETSERVER') then
    begin
      Alert('该窗体已经拥有一个 TMagnetServer 或 TMagnetClient 组件!');
      Exit;
    end;
  end;
 
  inherited Create(AOwner);
end;

Alert()函数是一个用来显示警告信息的自定义函数。定义如下：

// 显示警告信息
procedure Alert(const Msg: string);
begin
 Application.MessageBox(PChar(Msg), PChar(Application.Title), MB_ICONWARNING or Mb_OK);
end;

// TMagnetServer类的构造函数
constructor TMagnetServer.Create(AOwner: TComponent);
begin
  // 确保每个应用程序的TMagnetServer组件唯一
  if Assigned(MainServer) then
  begin
    Alert('每个应用程序只能拥有一个 TMagnetServer 组件!');
    Exit;
  end; 
  inherited Create(AOwner);

  // 初始化成员变量
  FMagnetClientList := TList.Create;
  FForm := AOwner as TScrollingWinControl;
  FDistance := DEFAULT_DISTANCE;
  FActive := True;
  FMagnetStyles := [msTop, msBottom, msLeft, msRight];
  MainServer := Self;  // 将自己赋值给上面定义的 MainServer 全局变量

// 替换窗口消息处理函数   
  if not(csDesigning in ComponentState) then
  begin
    OldWindowProc := FForm.WindowProc;
    FForm.WindowProc := NewWndProc;
  end;   
end;

// 移动被粘贴在一起的其他窗体
procedure TMagnetServer.AdjustFormPos(Rect: PRect);
var
  Dx, Dy: Integer;
  nIndex: Integer;
  MagnetClient: TMagnetClient;
begin
  if not Assigned(FForm) then Exit;
  if not FActive then Exit;   

  Dx := Rect^.Left - FForm.Left;
  Dy := Rect^.Top - FForm.Top;
  FForm.Left := Rect^.Left;
  FForm.Top := Rect^.Top;

  // 逐一调整主窗体关联的所有子窗体位置
  for nIndex := 0 to FMagnetClientList.Count - 1 do
  begin
    MagnetClient := FMagnetClientList[nIndex];
    UnionOtherForm(MagnetClient, Dx, Dy);
  end;
end;

// 具体的调整子窗体位置过程
procedure TMagnetServer.UnionOtherForm(MagnetClient: TMagnetClient; Dx, Dy: Integer);
var
  Fx, Fy: Integer;
  FormTemp: TScrollingWinControl;
Begin
 if not Assigned(MagnetClient) then Exit;
    FormTemp := MagnetClient.FForm;    
    if (MagnetClient.FEnabled) then
    begin
      MagnetClient.FEnabled := False;
      Fx := FormTemp.Left;
      Fy := FormTemp.Top;    
    
      SetWindowPos(FormTemp.Handle, FForm.Handle,
                   Fx + Dx, Fy + Dy,
                   FormTemp.Width, FormTemp.Height,
                   SWP_NOSIZE or SWP_NOACTIVATE); 
      MagnetClient.FEnabled := True;
end;
end;

// 将窗体粘贴到主窗体上或重新从主窗体移开过程
procedure TMagnetClient.AttachToForm(MagnetServer: TMagnetServer; Rect: PRect; Distance: Integer);
var
  RectServer: TRect;
  IsPasted: Boolean;
begin
  if not Assigned(FForm) then Exit;
  if not Assigned(MainServer) then Exit;;
  if not Assigned(MainServer.FForm) then Exit;

  GetWindowRect(MainServer.FForm.Handle, RectServer);
  FXPos := Rect^.Left;
  FYPos := Rect^.Top;
  IsPasted := False;
 
  // 上下方向判断
  if (Mid(RectServer.Left, Rect^.Left, RectServer.Right) or Mid(Rect^.Left, RectServer.Left, Rect^.Right)) then
  begin
    if (DistanceIn(Rect^.Top, RectServer.Bottom, Distance) and (msBottom in MainServer.FMagnetStyles)) then
    begin
      // 下粘贴
      FYPos := RectServer.Bottom;
      IsPasted := True;
    end
    else if (DistanceIn(Rect^.Bottom, RectServer.Top, Distance) and (msTop in MainServer.FMagnetStyles)) then
    begin
      // 上粘贴
      FYPos := RectServer.Top - (Rect^.Bottom - Rect^.Top);
      IsPasted := True;
    end;
  end;

  // 左右方向判断
  if (Mid(RectServer.Top, Rect^.Top, RectServer.Bottom) or Mid(Rect^.Top, RectServer.Top, Rect^.Bottom)) then
  begin
    if (DistanceIn(Rect^.Left, RectServer.Right, Distance) and (msRight in MainServer.FMagnetStyles)) then
    begin
      // 右粘贴
      FXPos := RectServer.Right;
      IsPasted := True;
    end
    else if (DistanceIn(Rect^.Right, RectServer.Left, Distance) and (msLeft in MainServer.FMagnetStyles)) then
    begin
      // 左粘贴
      FXPos := RectServer.Left - (Rect^.Right - Rect^.Left);
      IsPasted := True;
    end;
  end;

  // 判断最终是粘贴到主窗体还是从主窗体移开
  if IsPasted and MainServer.Active then
  begin
    if not Assigned(FMagnetServer) then
    begin
      MainServer.FMagnetClientList.Add(Self);
      FMagnetServer := MainServer;
    end;
  end else begin
    if Assigned(FMagnetServer) then
    begin
      MainServer.FMagnetClientList.Remove(Self);
      FMagnetServer := nil;
    end;
  end;
end;

// 将我们定义的TMagnetServer和TMagnetClient组件注册到Delphi中
procedure Register;
begin
  RegisterComponents('Magnet', [TMagnetServer, TMagnetClient]);
end;

 通过了以上分析、设计和编码的过程，我们完成了一个磁性窗口组件的制作，使用时只要在窗体上放上一个相关磁性窗体组件即可，将磁性窗体组件化必将使应用开发时更加便捷。下面我们就来创建一个应用程序，看看效果如何。

测试
 
图1

 将我们刚才创建的磁性窗体组件安装到Delphi环境中，并新建一个应用程序，创建三个窗体，分别放上一个TMagnetServer和TMagnetClient组件，并设定窗口为合适的大小，编译程序生成可执行文件，运行效果如图1所示。以上所有代码在Delphi6下测试通过。