（转载）VB6之鼠标移出事件

转载链接：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      ：40Star@163.com
'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