一、關于起因
前幾天發了一篇博文，是關于擷取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 