VB6实现的自动停靠窗体
<DIV class=postTitle><A class=postTitle2 id=viewpost1_TitleUrl href="http://www.cnblogs.com/dsclub/archive/2004/06/24/18330.html" target="_blank" >VB6实现的自动停靠窗体</A> </DIV>1、新建EXE工程。<BR>2、添加模块，键入以下代码：<BR>'------------------- Module ---------------------------------------<BR>' 2003-9-10<BR>' 作者:任兀(DSclub)<BR>'<BR>'如果有问题<BR>'请E-Mail:dsclub@hotmail.com<BR>'<BR>'--------------------------------------------------------<BR>'--------------------------------------------------------<BR>'－－－－－－－－－－－ 说明 －－－－－－－－－－－－－－－－－<BR>'修改Private Const Margin As Long 的值可以改变吸附距离<BR>'将本模块考入你的程序，然后在你的代码中写入Hook和Unhook即可<BR>'<BR>'----------------------------------------------------------------
Public Declare Function SystemParametersInfo Lib "user32.dll" Alias "SystemParametersInfoA" ( _<BR> ByVal uAction As Long, _<BR> ByVal uParam As Long, _<BR> lpvParam As Any, _<BR> ByVal fuWinIni As Long) As Long '去掉lpvParam的Byval修饰符才可以正常工作<BR> <BR>Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _<BR> ByVal hwnd As Long, _<BR> ByVal nIndex As Long, _<BR> ByVal dwNewLong As Long) As Long<BR>Public Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _<BR> ByVal hwnd As Long, _<BR> ByVal nIndex As Long) As Long<BR>Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _<BR> ByVal lpPrevWndFunc As Long, _<BR> ByVal hwnd As Long, _<BR> ByVal msg As Long, _<BR> ByVal wParam As Long, _<BR> ByVal lParam As Long) As Long<BR>Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _<BR> Destination As Any, _<BR> Source As Any, _<BR> ByVal Length As Long)<BR> <BR> <BR>Public Type WINDOWPOS<BR> hwnd As Long<BR> hWndInsertAfter As Long<BR> x As Long<BR> y As Long<BR> cx As Long<BR> cy As Long<BR> flags As Long<BR>End Type
Public Type RECT<BR> Left As Long<BR> Top As Long<BR> Right As Long<BR> Bottom As Long<BR>End Type
Public Const SPI_GETWORKAREA As Long = 48<BR>Public Const GWL_WNDPROC As Long = -4<BR>Public Const WM_WINDOWPOSCHANGING As Long = &H46
Global lpPrevWndProc As Long<BR>Global gHW As Long<BR>Private Const Margin As Long = 20
Public Sub Hook()<BR> lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)<BR>End Sub
Public Sub Unhook()<BR> Dim temp As Long<BR> temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)<BR>End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long<BR>Dim lpwndpos As WINDOWPOS<BR>Dim WorkArea As RECT
If uMsg = WM_WINDOWPOSCHANGING Then<BR> SystemParametersInfo SPI_GETWORKAREA, 0, WorkArea, 0<BR> CopyMemory lpwndpos, ByVal lParam, Len(lpwndpos)<BR> <BR> If lpwndpos.x - WorkArea.Left < Margin And WorkArea.Left - lpwndpos.x < Margin Then lpwndpos.x = 0<BR> If lpwndpos.y - WorkArea.Top < Margin And WorkArea.Top - lpwndpos.y < Margin Then lpwndpos.y = 0<BR> If WorkArea.Right - lpwndpos.x - lpwndpos.cx < Margin And lpwndpos.x + lpwndpos.cx - WorkArea.Right < Margin Then lpwndpos.x = WorkArea.Right - lpwndpos.cx<BR> If WorkArea.Bottom - lpwndpos.y - lpwndpos.cy < Margin And lpwndpos.y + lpwndpos.cy - WorkArea.Bottom < Margin Then lpwndpos.y = WorkArea.Bottom - lpwndpos.cy<BR> <BR> CopyMemory ByVal lParam, lpwndpos, Len(lpwndpos)<BR> End If<BR> <BR> WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)<BR>End Function
<BR>3、在Form1的代码中键入：<BR>Private Sub Form_Load()<BR> gHW = Me.hwnd<BR> Hook<BR>End Sub
Private Sub Form_Unload(Cancel As Integer)<BR> Unhook<BR>End Sub<BR><BR>4、运行。<BR>
页:
[1]