转载链接:http://www.ltesting.net/ceshi/ruanjianceshikaifajishu/rjcskfyy/vb/2007/0525/3426.html

Windows提供的鼠标移出消息有时候很有用,但是VB6中没有把这个事件封装给我们。
但是我们仍然可以使用子类化技术实现他,下面的代码就是一个简单的例子来处理Windows的
WM_MOUSELEAVE消息的,我演示的是鼠标移出一个Button时的情形。

1.加入一个模块,专门用来处理子类函数:

Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Copyright 2002 40Star, All Rights Reserved.
'
'E-Mail :[email protected]
'Distribution:你可以完全自由随便的使用这段代码,不管你用于任何目的
' 程序在于交流和学习
' 如有任何BUG请和我联系
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As String) As Long Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long 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 Const GWL_WNDPROC = (-&) Dim PrevWndProc& Private Const WM_DESTROY = &H2 Public Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long Public Const TME_CANCEL = &H80000000
Public Const TME_HOVER = &H1&
Public Const TME_LEAVE = &H2&
Public Const TME_NONCLIENT = &H10&
Public Const TME_QUERY = &H40000000 Private Const WM_MOUSELEAVE = &H2A3& Public Type TRACKMOUSEEVENTTYPE
cbSize As Long
dwFlags As Long
hwndTrack As Long
dwHoverTime As Long
End Type Public bTracking As Boolean
Dim evtTrack As TRACKMOUSEEVENTTYPE
''''''''''''''''''''''''''''''''''''''''' Private Function SubWndProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) _
As Long If Msg = WM_DESTROY Then Terminate (hwnd) '处理鼠标移出消息
If Msg = WM_MOUSELEAVE Then
bTracking = False
Form1.Print "The mouse left the form!"
End If
SubWndProc = CallWindowProc(PrevWndProc, hwnd, Msg, wParam, lParam)
End Function Public Sub Init(hwnd As Long)
PrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SubWndProc)
End Sub Public Sub Terminate(hwnd As Long)
Call SetWindowLong(hwnd, GWL_WNDPROC, PrevWndProc)
End Sub
' -- 模块结束 -- '

2. 窗体中处理需要加入的代码:

Option Explicit

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If bTracking = False Then
bTracking = True
Dim ET As TRACKMOUSEEVENTTYPE
'initialize structure
ET.cbSize = Len(ET)
ET.hwndTrack = Command1.hwnd
ET.dwFlags = TME_LEAVE
'start the tracking
TrackMouseEvent ET
End If
End Sub Private Sub Form_Load()
Call Init(Command1.hwnd)
End Sub Private Sub Form_Unload(Cancel As Integer)
Call Terminate(Command1.hwnd)
End Sub

此例程在Win2000 + VB6中调试通过

原文转自:http://www.ltesting.net
04-30 12:55