VB6实现的自动停靠窗体

1、新建EXE工程。

2、添加模块，键入以下代码：

'------------------- Module ---------------------------------------

' 2003-9-10

' 作者:任兀(DSclub)

'

'如果有问题

'请E-Mail:dsclub@hotmail.com

'

'--------------------------------------------------------

'--------------------------------------------------------

'－－－－－－－－－－－ 说明 －－－－－－－－－－－－－－－－－

'修改Private Const Margin As Long 的值可以改变吸附距离

'将本模块考入你的程序，然后在你的代码中写入Hook和Unhook即可

'

'----------------------------------------------------------------

Public Declare Function SystemParametersInfo Lib "user32.dll" Alias "SystemParametersInfoA" ( _

ByVal uAction As Long, _

ByVal uParam As Long, _

lpvParam As Any, _

ByVal fuWinIni As Long) As Long '去掉lpvParam的Byval修饰符才可以正常工作

Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _

ByVal hwnd As Long, _

ByVal nIndex As Long, _

ByVal dwNewLong As Long) As Long

Public Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _

ByVal hwnd As Long, _

ByVal nIndex As Long) As Long

Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _

ByVal lpPrevWndFunc As Long, _

ByVal hwnd As Long, _

ByVal msg As Long, _

ByVal wParam As Long, _

ByVal lParam As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _

Destination As Any, _

Source As Any, _

ByVal Length As Long)

Public Type WINDOWPOS

hwnd As Long

hWndInsertAfter As Long

x As Long

y As Long

cx As Long

cy As Long

flags As Long

End Type

Public Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Public Const SPI_GETWORKAREA As Long = 48

Public Const GWL_WNDPROC As Long = -4

Public Const WM_WINDOWPOSCHANGING As Long = &H46

Global lpPrevWndProc As Long

Global gHW As Long

Private Const Margin As Long = 20

Public Sub Hook()

lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)

End Sub

Public Sub Unhook()

Dim temp As Long

temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)

End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim lpwndpos As WINDOWPOS

Dim WorkArea As RECT

If uMsg = WM_WINDOWPOSCHANGING Then

SystemParametersInfo SPI_GETWORKAREA, 0, WorkArea, 0

CopyMemory lpwndpos, ByVal lParam, Len(lpwndpos)

If lpwndpos.x - WorkArea.Left < Margin And WorkArea.Left - lpwndpos.x < Margin Then lpwndpos.x = 0

If lpwndpos.y - WorkArea.Top < Margin And WorkArea.Top - lpwndpos.y < Margin Then lpwndpos.y = 0

If WorkArea.Right - lpwndpos.x - lpwndpos.cx < Margin And lpwndpos.x + lpwndpos.cx - WorkArea.Right < Margin Then lpwndpos.x = WorkArea.Right - lpwndpos.cx

If WorkArea.Bottom - lpwndpos.y - lpwndpos.cy < Margin And lpwndpos.y + lpwndpos.cy - WorkArea.Bottom < Margin Then lpwndpos.y = WorkArea.Bottom - lpwndpos.cy

CopyMemory ByVal lParam, lpwndpos, Len(lpwndpos)

End If

WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)

End Function

3、在Form1的代码中键入：

Private Sub Form_Load()

gHW = Me.hwnd

Hook

End Sub

Private Sub Form_Unload(Cancel As Integer)

Unhook

End Sub

4、运行。

挺简单的。