1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:

{
    TMagnetic VCL Write by ZHONG WAN at 2001.3 Ver 1.01

      -'`"_         -'`" \
     /     \       /      "
    /     /\\__   /  ___   \       Î÷°²¿Æ¼¼Ñ§Ôº143ÐÅÏä 710054
   |      | \  -"`.-(   \   |
   |      |  |     | \"  |  |                Íò  ÖØ
   |     /  /  "-"  \  \    |
    \___/  /  (o o)  \  (__/       µçÓÊ(email):
         __| _     _ |__           mantousoft@sina.com
        (      ( )      )
         \_\.-.___.-./_/           ÍøÖ·(homepage):
           __  | |  __             http://mantousoft.51.net
          |  \.| |./  |
          | '#.   .#' |            OICQ: 6036742
          |__/ '"" \__|
        -/             \-          2001.3.1

    °æȨËùÓУ¬ÈκÎÈ˲»µÃδ¾ÔÊÐíÓÃÓÚÉÌÒµ»òÓ¯Àû

    Èç¹ûÄã¾õµÃÓÐʲôºÃµÄ½¨Ò飬ϣÍûÄܸæËßÎÒ

    Í¬Ê±»¶ÓÄã¸Ä½ø±¾¿Ø¼þµÄÌØÐÔ

    ¸ÄÍêÁËÒ»¶¨Òª¼ÄÒ»·Ý¸øÎÒàÞ
}

unit Magnetic;

interface

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

type
  TMagOption = class (TPersistent)
  private
      fMagTray:boolean;
      fMagExplorer:boolean;
      fMagCustom:boolean;
  public
      constructor Create;
      destructor Destroy;override;
  published
      property MagTray:boolean     read fMagTray      write fMagTray;
      property MagExplorer:boolean read fMagExplorer  write fMagExplorer;
      property MagCustom:boolean   read fMagCustom    write fMagCustom;
  end;

type
  TMagnetic = class(TComponent)
  private
    fActive:Boolean;
    fCanResize:Boolean;
    fOldPoint:TPoint;     {old mouse point}
    fNewPoint:TPoint;     {moved point}
    fMagEffect:Integer;   {magnetic effect default 10pix}
    fMagOption:TMagOption;
    fForm:TForm;
    fOldTWndMethod:TWndMethod;
    HWnd_Tray,HWnd_Explorer:HWND;
    RWnd_Tray,RWnd_Explorer,RWnd_Custrom:TRect;
    procedure Magnetic(var MagPoint:TPoint);
    procedure WndProc(var Message: TMessage);
    procedure WMMouseMove(var Msg:TMessage);
    procedure WMLButtonDown(var Msg:TMessage);
    procedure WMNCHitTest(var Msg: TMessage);
    { private declarations }
  protected    
    procedure SetMagOption(Value:TMagOption);
    { protected declarations }
  public
    CustomMagWnd:HWND;
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    { public declarations }
  published
    property Active:boolean       read fActive          write fActive;
    property CanResize:boolean    read fCanResize       write fCanResize;    
    property MagOption:TMagOption read fMagOption       write SetMagOption;
    property MagEffect:Integer    read fMagEffect       write fMagEffect;
    { published declarations }
  end;


procedure Register;

implementation

constructor TMagOption.Create;
begin
  inherited Create;
  fMagTray:=True;
  fMagExplorer:=False;
  fMagCustom:=False;
end;

destructor TMagOption.Destroy;
begin
  inherited Destroy;
end;

constructor TMagnetic.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  fActive:=True;
  fMagEffect:=10;
  fMagOption:=TMagOption.Create;
  fForm:=TForm(AOwner);
  fOldTWndMethod:=fForm.WindowProc;
  fForm.WindowProc:=WndProc;
  if fForm.BorderStyle=bsNone then fCanResize:=true;
end;

destructor TMagnetic.Destroy;
begin
  fMagOption.Free;
  fForm.WindowProc:=fOldTWndMethod;
  inherited Destroy;
end;

procedure TMagnetic.WndProc(var Message: TMessage);
begin
  { disable during Delphi IDE }
  if (CsDesigning in ComponentState) then fOldTwndMethod(Message)
  else
    case Message.Msg of
      WM_LBUTTONDOWN : WMLButtonDown(Message);
      WM_MOUSEMOVE   : WMMouseMove(Message);
      WM_NCHITTEST   : WMNCHitTest(Message);
    else fOldTwndMethod(Message);
  end;
end;

procedure TMagnetic.WMMouseMove(var Msg:TMessage);
var
  pt:TPoint;
begin
  fOldTWndMethod(Msg);
  if not fActive then exit;
  {whether can move}
  if (fForm.WindowState<>wsNormal)and not fActive then exit;
  {whether mouse left button}
  if HiWord(GetAsyncKeyState(VK_LBUTTON))>0 then
  begin
    pt:=Point(TWMMouseMove(Msg).XPos,TWMMouseMove(Msg).YPos);
    {calculate new point}
    fNewPoint:=Point(fForm.left+pt.x-fOldPoint.x,fForm.top+pt.y-fOldPoint.y);
    Magnetic(fNewPoint);  {do magnetic}
    fForm.SetBounds(fNewpoint.X,fNewpoint.Y,fForm.Width,fForm.Height);
  end;
end;

procedure TMagnetic.WMLButtonDown(var Msg: TMessage);
begin
  fOldTWndMethod(Msg);
  if not fActive then exit;
  fOldPoint:=Point(TWMLButtonDown(Msg).XPos,TWMLButtonDown(Msg).YPos);
  if MagOption.fMagCustom and (CustomMagWnd>0) then
    GetWindowRect(CustomMagWnd, RWnd_Custrom);     { get custom rect }
  if MagOption.fMagExplorer then
    HWnd_Explorer:=FindWindow('CabinetWClass',nil);{ get explorer handle }
    if HWnd_Explorer>0 then
      GetWindowRect(HWnd_Explorer, RWnd_Explorer); { get explorer rect }
  if MagOption.fMagTray then
    HWnd_Tray:=FindWindow('Shell_TrayWnd',nil);    { get traybar handle }
  if HWnd_Tray>0 then
    GetWindowRect(HWnd_Tray, RWnd_Tray);           { get taskbar rect }
end;

procedure TMagnetic.WMNCHitTest(var Msg:TMessage);
var
  pt:TPoint;
begin
  fOldTWndMethod(Msg);
  {if windowstate not normal and not can resize then exit}
  if (fForm.WindowState<>wsNormal) or not fCanResize then exit;
  {get form's edges and change it's size}
  pt:=Point(TWMNCHitTest(Msg).XPos,TWMNCHitTest(Msg).YPos);
  pt:=fForm.ScreenToClient(pt);
  if (pt.x<5) and (pt.y<5) then Msg.Result:=htTopLeft
  else if (pt.x>fForm.Width-5) and (pt.y<5) then Msg.Result:=htTopRight
  else if (pt.x>fForm.Width-5) and (pt.y>fForm.Height-5) then Msg.Result:=htBottomRight
  else if (pt.x<5) and (pt.y>fForm.Height-5) then Msg.Result:=htBottomLeft
  else if (pt.x<5) then Msg.Result:=htLeft
  else if (pt.y<5) then Msg.Result:=htTop
  else if (pt.x>fForm.Width-5) then Msg.Result:=htRight
  else if (pt.y>fForm.Height-5) then Msg.Result:=htBottom;
end;

procedure TMagnetic.Magnetic(var MagPoint:TPoint);
begin
  if not fActive then exit;

  if MagOption.fMagCustom and (CustomMagWnd>0) then
  begin
    { mangetize custrom}
    if Abs(RWnd_Custrom.Bottom-MagPoint.Y)<fMagEffect then MagPoint.Y:=RWnd_Custrom.Bottom
    else if Abs(MagPoint.Y+fForm.Height-RWnd_Custrom.Top)<fMagEffect then MagPoint.Y:=RWnd_Custrom.Top-fForm.Height;
    if Abs(RWnd_Custrom.Right-MagPoint.X)<fMagEffect then MagPoint.X:=RWnd_Custrom.Right
    else if Abs(MagPoint.X+fForm.Width-RWnd_Custrom.Left)<fMagEffect then MagPoint.X:=RWnd_Custrom.Left-fForm.Width;
  end;

  if MagOption.fMagExplorer and (HWnd_Explorer>0) then
  begin
    { mangetize explorer}
    if Abs(RWnd_Explorer.Bottom-MagPoint.Y)<fMagEffect then MagPoint.Y:=RWnd_Explorer.Bottom
    else if Abs(MagPoint.Y+fForm.Height-RWnd_Explorer.Top)<fMagEffect then MagPoint.Y:=RWnd_Explorer.Top-fForm.Height;
    if Abs(RWnd_Explorer.Right-MagPoint.X)<fMagEffect then MagPoint.X:=RWnd_Explorer.Right
    else if Abs(MagPoint.X+fForm.Width-RWnd_Explorer.Left)<fMagEffect then MagPoint.X:=RWnd_Explorer.Left-fForm.Width;
  end;

  if MagOption.fMagTray and (HWnd_Tray>0) then
  begin
    { mangetize tray}
    if Abs(RWnd_Tray.Bottom-MagPoint.Y)<fMagEffect then MagPoint.Y:=RWnd_Tray.Bottom
    else if Abs(MagPoint.Y+fForm.Height-RWnd_Tray.Top)<fMagEffect then MagPoint.Y:=RWnd_Tray.Top-fForm.Height;
    if Abs(RWnd_Tray.Right-MagPoint.X)<fMagEffect then MagPoint.X:=RWnd_Tray.Right
    else if Abs(MagPoint.X+fForm.Width-RWnd_Tray.Left)<fMagEffect then MagPoint.X:=RWnd_Tray.Left-fForm.Width;
  end;

  { magnetize screen }
  if MagPoint.X<fMagEffect then MagPoint.X:=0;
  if MagPoint.X>Screen.Width-fForm.Width-fMagEffect then MagPoint.X:=Screen.Width-fForm.Width;
  if MagPoint.Y<fMagEffect then MagPoint.Y:=0;
  if MagPoint.Y>Screen.Height-fForm.Height-fMagEffect then MagPoint.Y:=Screen.Height-fForm.Height;
  { end screen }

end;

procedure TMagnetic.SetMagOption(Value:TMagOption);
begin
  FMagOption.Assign(Value);
end;

procedure Register;
begin
  RegisterComponents('Samples', [TMagnetic]);
end;

end.					

1:
2:

If Form1.Left<10 Then Form1.Left:=0;
...					

1:

Form1.Left := min(0, Form1.Left);