umain.pas

下面又是翻译： 韩国人 Silhwan Hyun 改写。 TMagnetic Class 是一个 Delphi 版本的"cMagneticWnd" 类

unit uMain;

interface

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

type
  TfrmParent = class(TForm)
    btnShowChild: TButton;
    btnClose: TButton;
    btnCreateChild: TButton;
    btnShowChild2: TButton;
    btnShowChild3: TButton;
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnShowChildClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnCreateChildClick(Sender: TObject);
    procedure btnShowChild2Click(Sender: TObject);
    procedure btnShowChild3Click(Sender: TObject);
  private
    { Private declarations }
    
  public
    { Public declarations }
    procedure WMEnterSizeMove(var Msg: TMessage); message WM_ENTERSIZEMOVE;
    procedure WMSizing(var Msg: TMessage); message WM_SIZING;
    procedure WMMoving(var Msg: TMessage); message WM_MOVING;
    procedure WMExitSizeMove(var Msg: TMessage); message WM_EXITSIZEMOVE;
    procedure WMSysCommand(var Msg: TMessage); message WM_SYSCOMMAND;
    procedure WMCommand(var Msg: TMessage); message WM_COMMAND;
  end;

var
  frmParent: TfrmParent;
 // MagneticWnd: TMagnetic;   // defined in Magnetic unit

implementation

{$R *.dfm}

uses uSub1, uSub2, uSub3;

const
   NumForms = 5;

var
   MagneticWndProc : TSubClass_Proc;
   dummyHandled : boolean;
   ChildForms : array[1..NumForms] of TfrmChild1;


//---------------------- Custom Message Handling procedures ----------------------

procedure TfrmParent.WMEnterSizeMove(var Msg: TMessage);
begin
   inherited;

   if Assigned(MagneticWndProc) then
      MagneticWndProc(Self.Handle, WM_ENTERSIZEMOVE, Msg, dummyHandled);
end;

procedure TfrmParent.WMSizing(var Msg: TMessage);
var
   bHandled: Boolean;
begin
   if not Assigned(MagneticWndProc) then
      inherited
   else
      if MagneticWndProc(Self.Handle, WM_SIZING, Msg, bHandled) then
         if not bHandled then
            inherited;
end;

procedure TfrmParent.WMMoving(var Msg: TMessage);
var
   bHandled: Boolean;
begin
   if not Assigned(MagneticWndProc) then
      inherited
   else
      if MagneticWndProc(Self.Handle, WM_MOVING, Msg, bHandled) then
         if not bHandled then
            inherited;
end;

procedure TfrmParent.WMExitSizeMove(var Msg: TMessage);
begin
   inherited;

   if Assigned(MagneticWndProc) then
      MagneticWndProc(Self.Handle, WM_EXITSIZEMOVE, Msg, dummyHandled);
end;

procedure TfrmParent.WMSysCommand(var Msg: TMessage);
begin
   inherited;

   if Assigned(MagneticWndProc) then
      MagneticWndProc(Self.Handle, WM_SYSCOMMAND, Msg, dummyHandled);
end;

procedure TfrmParent.WMCommand(var Msg: TMessage);
begin
   inherited;

   if Assigned(MagneticWndProc) then
      MagneticWndProc(Self.Handle, WM_COMMAND, Msg, dummyHandled);
end;

//------------------ end of Custom Message Handling procedures -------------------


// procedure to subclass ChildForms window procedure for magnetic effect.
function SubFormWindowProc(Wnd: HWND; Msg, wParam, lParam: Integer): Integer; stdcall;
var
  Handled: boolean;
  Message_: TMessage;
  OrgWndProc: Integer;
begin
   Result := 0;

   if not Assigned(MagneticWndProc) then
   begin
      Result := CallWindowProc(Pointer(OrgWndProc), Wnd, Msg, wParam, lParam);
      exit;
   end;

   OrgWndProc := GetWindowLong(Wnd, GWL_USERDATA);
   if (OrgWndProc = 0) then
      exit;

   Message_.WParam := wParam;
   Message_.LParam := lParam;
   Message_.Result := 0;

   if (Msg = WM_SYSCOMMAND) or (Msg = WM_ENTERSIZEMOVE) or (Msg = WM_EXITSIZEMOVE) or
       (Msg = WM_WINDOWPOSCHANGED) or (Msg = WM_COMMAND)then
   begin
      Result := CallWindowProc(Pointer(OrgWndProc), Wnd, Msg, wParam, lParam);
      MagneticWndProc(Wnd, Msg, Message_, dummyHandled);
   end else if (Msg = WM_MOVING) or (Msg = WM_SIZING) then
   begin
      MagneticWndProc(Wnd, Msg, Message_, Handled);
      if Handled then
      begin
         Result := Message_.Result;
         exit;
      end else
         Result := CallWindowProc(Pointer(OrgWndProc), Wnd, Msg, wParam, lParam);
   end else if (Msg = WM_DESTROY) then
   begin
      if Assigned(MagneticWnd) then
         MagneticWnd.RemoveWindow(Wnd);
      Result := CallWindowProc(Pointer(OrgWndProc), Wnd, Msg, wParam, lParam);
   end else
      Result := CallWindowProc(Pointer(OrgWndProc), Wnd, Msg, wParam, lParam);
end;


procedure TfrmParent.btnCreateChildClick(Sender: TObject);
var
  i : integer;
  OrgWndProc: Integer;
begin
  if Assigned(ChildForms[1]) then  // already created child forms ?
     exit;

  for i := 1 to NumForms do
  begin
    ChildForms[i] := TfrmChild1.Create(Self);
    ChildForms[i].Caption := 'Magnetic Child1-' + intToStr(i);
    ChildForms[i].Left := 100 + i * 35;
    ChildForms[i].top := 100 + i * 35;
    ChildForms[i].Show;

    if not MagneticWnd.AddWindow(ChildForms[i].Handle, self.Handle, MagneticWndProc) then
       exit;

  // Subclassing sub form, the original Window Proc is saved in its own 32-bit value space.
    OrgWndProc := GetWindowLong(ChildForms[i].Handle, GWL_WNDPROC);
    SetWindowLong(ChildForms[i].Handle, GWL_USERDATA, OrgWndProc);  // Save Original Window Proc
    SetWindowLong(ChildForms[i].Handle, GWL_WNDPROC, Integer(@SubFormWindowProc));
  end;
end;

procedure TfrmParent.btnShowChild2Click(Sender: TObject);
begin
   frmChild2.Show;
end;

procedure TfrmParent.btnShowChild3Click(Sender: TObject);
begin
   frmChild3.Show;
end;

procedure TfrmParent.btnShowChildClick(Sender: TObject);
var
  i : integer;
begin
  for i := 1 to NumForms do
  begin
    if ChildForms[i] <> nil then
       if (not ChildForms[i].Visible) then
           ChildForms[i].Show;
  end;

  if (not frmChild2.Visible) then
      frmChild2.Show;

  if (not frmChild3.Visible) then
      frmChild3.Show;
end;

procedure TfrmParent.FormCreate(Sender: TObject);
begin
  // Create a TMagnetic Class
  MagneticWnd := TMagnetic.Create;

end;

procedure TfrmParent.FormDestroy(Sender: TObject);
begin
 // Release TMagnetic Class
  MagneticWnd.Free;

end;

procedure TfrmParent.FormShow(Sender: TObject);
begin
  if Assigned(MagneticWnd) then
  begin
    // Set Snap width
     MagneticWnd.SnapWidth := 15;
    // Register main window as a serviced window of TMagnetic Class
     MagneticWnd.AddWindow(Self.Handle, 0, MagneticWndProc);
  end;
end;

procedure TfrmParent.btnCloseClick(Sender: TObject);
begin
   Close;
end;

end.