一、關於起因
前幾天發了一篇博文，是關於獲取VB類模塊成員函數指針的內容(http://www.cnblogs.com/alexywt/p/5880993.html)；今天我就發一下我的應用實例。
VB中默認是沒有鼠標移出事件響應的，而這個事件其實在項目開發中，實用性很強，很多時候需要在鼠標移出窗體或控件時做些事情；沒有這個事件會感覺很費力；
今天我所說的實際案例就是，在窗體上，設計一個SplitterBar控件，窗體的最終用戶使用這個控件可以在運行程序時任意調整其內部控件大小。
二、修改CHooker類
我在第二篇參考博文作者開發的CHooker類上做了部分修改(對應以下代碼中的中文注釋部分代碼)，使該類能夠跟蹤鼠標移開事件，代碼如下：
1 Option Explicit 2 3 Private Type TRACKMOUSEEVENTTYPE 4 cbSize As Long 5 dwFlags As Long 6 hwndTrack As Long 7 dwHoverTime As Long 8 End Type 9 10 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) 11 Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 12 Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long 13 Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long 14 Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 15 Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long 16 17 Private Const GWL_WNDPROC = (-4) 18 Private Const WM_NCDESTROY = &H82 19 Private Const WM_MOUSEMOVE = &H200 20 Private Const TME_LEAVE = &H2& 21 Private Const WM_MOUSELEAVE = &H2A3& 22 23 Public Event WindowProc(ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, bCallNext As Boolean, lReturn As Long) 24 25 Private m_hwnd As Long, m_NewProc As Long, m_OldProc As Long 26 Private m_TrackMouseLeave As Boolean 'm_TrackMouseLeave設置在Hook時是否開啟跟蹤鼠標移開事件，是否正在跟蹤移動事件 27 Private m_Tracking As Boolean '跟蹤移開事件時，標識當前是否正在跟蹤移動事件 28 29 Private Sub Class_Initialize() 30 m_NewProc = GetClassProcAddr(Me, 5, 4, True) 31 End Sub 32 33 Private Sub Class_Terminate() 34 Call Unbind 35 End Sub 36 37 Public Function Bind(ByVal hWnd As Long, Optional TrackMouseLeave As Boolean = False) As Boolean 38 Call Unbind 39 If IsWindow(hWnd) Then m_hwnd = hWnd 40 m_OldProc = SetWindowLong(m_hwnd, GWL_WNDPROC, m_NewProc) 41 Bind = CBool(m_OldProc) 42 m_TrackMouseLeave = TrackMouseLeave '保存用戶傳遞的跟蹤鼠標移開事件設置 43 End Function 44 45 Public Function Unbind() As Boolean 46 If m_OldProc <> 0 Then Unbind = CBool(SetWindowLong(m_hwnd, GWL_WNDPROC, m_OldProc)) 47 m_OldProc = 0 48 End Function 49 50 Private Function WindowProcCallBack(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 51 Dim bCallNext As Boolean, lReturn As Long 52 Dim tTrackML As TRACKMOUSEEVENTTYPE '一個移開事件結構聲明 53 54 bCallNext = True 55 56 RaiseEvent WindowProc(Msg, wParam, lParam, bCallNext, lReturn) 57 '當用戶需要跟蹤鼠標移開事件時 58 If m_TrackMouseLeave Then 59 '鼠標在其上移動，當前未標識為跟蹤狀態(第一次或者移開鼠標后重新移動回來時) 60 If Msg = WM_MOUSEMOVE And m_Tracking = False Then 61 m_Tracking = True 62 'initialize structure 63 tTrackML.cbSize = Len(tTrackML) 64 tTrackML.hwndTrack = hWnd 65 tTrackML.dwFlags = TME_LEAVE 66 'start the tracking 67 TrackMouseEvent tTrackML 68 End If 69 '鼠標移開時，取消跟蹤狀態 70 If Msg = WM_MOUSELEAVE Then m_Tracking = False 71 End If 72 73 If bCallNext Then 74 WindowProcCallBack = CallWindowProc(m_OldProc, hWnd, Msg, wParam, lParam) 75 Else 76 WindowProcCallBack = lReturn 77 End If 78 If hWnd = m_hwnd And Msg = WM_NCDESTROY Then Call Unbind 79 End Function 80 81 Private Function GetClassProcAddr(obj As Object, ByVal Index As Long, _ 82 Optional ByVal ParamCount As Long = 4, Optional ByVal HasReturnValue As Boolean) As Long 83 Static lReturn As Long, pReturn As Long 84 Static AsmCode(50) As Byte 85 86 Dim i As Long, pThis As Long, pVtbl As Long, pFunc As Long 87 88 pThis = ObjPtr(obj) 89 CopyMemory pVtbl, ByVal pThis, 4 90 CopyMemory pFunc, ByVal pVtbl + (6 + Index) * 4, 4 91 pReturn = VarPtr(lReturn) 92 For i = 0 To UBound(AsmCode) '填充nop 93 AsmCode(i) = &H90 94 Next 95 AsmCode(0) = &H55 'push ebp 96 AsmCode(1) = &H8B: AsmCode(2) = &HEC 'mov ebp,esp 97 AsmCode(3) = &H53 'push ebx 98 AsmCode(4) = &H56 'push esi 99 AsmCode(5) = &H57 'push edi 100 If HasReturnValue Then 101 AsmCode(6) = &HB8 'mov offset lReturn 102 CopyMemory AsmCode(7), pReturn, 4 103 AsmCode(11) = &H50 'push eax 104 End If 105 For i = 0 To ParamCount - 1 'push dword ptr[ebp+xx] 106 AsmCode(12 + i * 3) = &HFF 107 AsmCode(13 + i * 3) = &H75 108 AsmCode(14 + i * 3) = (ParamCount - i) * 4 + 4 109 Next 110 i = i * 3 + 12 111 AsmCode(i) = &HB9 'mov ecx,this 112 CopyMemory AsmCode(i + 1), pThis, 4 113 AsmCode(i + 5) = &H51 'push ecx 114 AsmCode(i + 6) = &HE8 'call 相對地址 115 CopyMemory AsmCode(i + 7), pFunc - VarPtr(AsmCode(i + 6)) - 5, 4 116 If HasReturnValue Then 117 AsmCode(i + 11) = &HB8 'mov eax,offset lReturn 118 CopyMemory AsmCode(i + 12), pReturn, 4 119 AsmCode(i + 16) = &H8B 'mov eax,dword ptr[eax] 120 AsmCode(i + 17) = &H0 121 End If 122 AsmCode(i + 18) = &H5F 'pop edi 123 AsmCode(i + 19) = &H5E 'pop esi 124 AsmCode(i + 20) = &H5B 'pop ebx 125 AsmCode(i + 21) = &H8B: AsmCode(i + 22) = &HE5 'mov esp,ebp 126 AsmCode(i + 23) = &H5D 'pop ebp 127 AsmCode(i + 24) = &HC3 'ret 128 GetClassProcAddr = VarPtr(AsmCode(0)) 129 End Function
三、CHooker類的使用
那么如何使用這個新構建的類，來實現我們的需求了？首先創建一個窗體，放置三個PictureBox，其中一個做為SplitterBar(name屬性picture4)，其余2個圖片框的寬度將會由SplitterBar在運行時調整。
1 Private Type POINTAPI 2 x As Long 3 y As Long 4 End Type 5 6 Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long 7 8 Private mCanMove As Boolean 9 Private mPreCursorPos As POINTAPI 10 Private mCurCursorPos As POINTAPI 11 Private WithEvents mHooker As CHooker 12 13 Private Sub MDIForm_Load() 14 Set mHooker = New CHooker 15 call mHooker.Bind(Picture4.hWnd, True) 16 End Sub 17 18 Private Sub MDIForm_Unload(Cancel As Integer) 19 mHooker.Unbind 20 Set mHooker = Nothing 21 End Sub 22 23 Private Sub mHooker_WindowProc(ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, bCallNext As Boolean, lReturn As Long) 24 If Msg = WM_MOUSELEAVE Then Me.MousePointer = 0 25 End Sub 26 27 28 Private Sub picture4_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 29 Call GetCursorPos(mPreCursorPos) 30 End Sub 31 32 Private Sub picture4_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 33 Me.MousePointer = vbSizeWE 34 If (Button And vbLeftButton) > 0 Then 35 Call GetCursorPos(mCurCursorPos) 36 mCanMove = True 37 Picture4.Move Picture4.Left + (mCurCursorPos.x - mPreCursorPos.x) * mdlCommon.TwipsPerPixelX() 38 mPreCursorPos = mCurCursorPos 39 End If 40 End Sub 41 42 Private Sub picture4_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 43 If mCanMove Then 44 '此處添加調整界面元素位置與大小的代碼 45 End If 46 End Sub
四、其他說明
mdlCommon.TwipsPerPixelX()函數是在模塊mdlCommon的一個公共函數，相關代碼如下：
1 Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long 2 Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long 3 Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long 4 5 6 Private Const HWND_DESKTOP As Long = 0 7 Private Const LOGPIXELSX As Long = 88 8 Private Const LOGPIXELSY As Long = 90 9 10 'TwipsPerPixelX：屏幕水平方向上1像素轉換為對應的緹值 11 Public Function TwipsPerPixelX() As Single 12 Dim lngDC As Long 13 14 lngDC = GetDC(HWND_DESKTOP) 15 TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX) 16 ReleaseDC HWND_DESKTOP, lngDC 17 End Function 18 19 'TwipsPerPixelY：屏幕垂直方向上1像素轉換為對應的緹值 20 Public Function TwipsPerPixelY() As Single 21 Dim lngDC As Long 22 23 lngDC = GetDC(HWND_DESKTOP) 24 TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY) 25 ReleaseDC HWND_DESKTOP, lngDC 26 End Function