'*************************************************************************
'**模 块 名：Form1
'**说 明：丹心软件在线设计 版权所有2007 - 2008(C)
'**创 建 人：丹心
'**日 期：2007-09-16 22:26:36
'**修 改 人：
'**日 期：
'**描 述：子类化检测鼠标移进移出
'**版 本：V1.0.0
'**博客地址：http://hi.baidu.com/starwork/
'**QQ   号码：121877114
'**E - mail:cnstarwork@126.com
'*************************************************************************
Option Explicit

Private Sub Form_Load()
If SubClass(Me.hWnd) Then
     
Else
       MsgBox "子类化未能成功初始化:-)"
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnSubClass(hWnd)
End Sub

Option Explicit
'*************************************************************************
'**模 块 名：mMouseEvent
'**说 明：丹心软件在线设计 版权所有2007 - 2008(C)
'**创 建 人：丹心
'**日 期：2007-09-16 22:26:36
'**修 改 人：
'**日 期：
'**描 述：子类化检测鼠标移进移出
'**版 本：V1.0.0
'**博客地址：http://hi.baidu.com/starwork/
'**QQ   号码：121877114
'**E - mail:cnstarwork@126.com
'*************************************************************************
Private Const WM_MOUSEMOVE = &H200
Private Const WM_MOUSELEAVE = &H2A3
Private Const GWL_WNDPROC = (-4)
Private Const WM_NCDESTROY = &H82 ' 如果组件被销毁，恢复源窗口过程处理函数
Private Const OLDWNDPROC = "OldWndProc"

Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) 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 uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENT_STRUCT) As Long
Private Declare Function TrackMouseEventComCtl Lib "Comctl32" Alias "_TrackMouseEvent" (lpEventTrack As TRACKMOUSEEVENT_STRUCT) As Long

Private m_bTrack                                As Boolean
Private m_bTrackUser32                          As Boolean
Private m_bInControl                         As Boolean

Private Type TRACKMOUSEEVENT_STRUCT
cbSize                             As Long
dwFlags                         As Long
hwndTrack                          As Long
dwHoverTime                      As Long
End Type

Private Enum TRACKMOUSEEVENT_FLAGS
TME_HOVER = &H1&
TME_LEAVE = &H2&
TME_QUERY = &H40000000
TME_CANCEL = &H80000000
End Enum

Public Function SubClass(hWnd As Long) As Boolean
Dim lpfnOld     As Long
Dim fSuccess     As Boolean

Call MouseEvent(m_bTrack, m_bTrackUser32)

If (GetProp(hWnd, OLDWNDPROC) = 0) Then
       lpfnOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
       If lpfnOld Then
         fSuccess = SetProp(hWnd, OLDWNDPROC, lpfnOld)
       End If
End If

If fSuccess Then
       SubClass = True
Else
       If lpfnOld Then Call UnSubClass(hWnd)
End If

End Function

Public Function UnSubClass(hWnd As Long) As Boolean
Dim lpfnOld     As Long
lpfnOld = GetProp(hWnd, OLDWNDPROC)
If lpfnOld Then
       If RemoveProp(hWnd, OLDWNDPROC) Then
         UnSubClass = SetWindowLong(hWnd, GWL_WNDPROC, lpfnOld)
       End If
End If
End Function

Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_NCDESTROY ' 如果组件被销毁，恢复源窗口过程处理函数
       Call UnSubClass(hWnd)
       MsgBox "卸载子类化   &H" & Hex$(hWnd), vbCritical, "警告"
Case WM_MOUSEMOVE
       If Not m_bInControl Then
         m_bInControl = True
         If TrackMouseLeave(hWnd, m_bTrack, m_bTrackUser32) = True Then
            Debug.Print "鼠标进入"
            Form1.Caption = "鼠标进入"
         End If
       End If
Case WM_MOUSELEAVE
       m_bInControl = False
       Debug.Print "鼠标离开"
       Form1.Caption = "鼠标离开"
End Select

WndProc = CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam)
End Function

Public Sub MouseEvent(ByRef bTrack As Boolean, ByRef bTrackUser32 As Boolean)
bTrack = True
bTrackUser32 = IsFunctionExported("TrackMouseEvent", "User32")
If Not bTrackUser32 Then
       If Not IsFunctionExported("_TrackMouseEvent", "Comctl32") Then
         bTrack = False
       End If
End If
End Sub

Private Function IsFunctionExported(ByVal sFunction As String, ByVal sModule As String) As Boolean
On Error GoTo IsFunctionExported_Error
Dim hmod        As Long
Dim bLibLoaded   As Boolean
hmod = GetModuleHandleA(sModule)
If hmod = 0 Then
       hmod = LoadLibraryA(sModule)
       If hmod Then bLibLoaded = True
End If
If hmod Then
       If GetProcAddress(hmod, sFunction) Then IsFunctionExported = True
End If
If bLibLoaded Then Call FreeLibrary(hmod)
Exit Function
IsFunctionExported_Error:
End Function

Public Function TrackMouseLeave(ByVal lng_hWnd As Long, ByVal bTrack As Boolean, ByVal bTrackUser32 As Boolean) As Boolean
On Error GoTo TrackMouseLeave_Error
Dim tme As TRACKMOUSEEVENT_STRUCT
If bTrack Then
       With tme
         .cbSize = Len(tme)
         .dwFlags = TME_LEAVE
         .hwndTrack = lng_hWnd
       End With
       If bTrackUser32 Then
         Call TrackMouseEvent(tme)
       Else
         Call TrackMouseEventComCtl(tme)
       End If
       TrackMouseLeave = True
End If
Exit Function
TrackMouseLeave_Error:
End Function

下载：

http://www.cnblogs.com/Files/starwork/子类化检测鼠标移进移出.rar