Mouse Hover and Out Events

A common question is 'how do I catch when the user moves the mouse over and out of my control?'. Well here's the answer.

The key is to use the TrackMouseEvent API and subclass the window. (Note: this will not work with windowless controls as they have no windows to subclass - duh!)

So what is this TrackMouseEvent API then? Well, in the words of the all-knowing MSDN: "The TrackMouseEvent function posts messages when the mouse pointer leaves a window or hovers over a window for a specified amount of time."

How do you use this mystical API?

First things first: the declarations required to use it (these do not include the declarations for subclassing) -

 Private Const TME_CANCEL As Long = &H80000000
 Private Const TME_HOVER As Long = &H1&
 Private Const TME_LEAVE As Long = &H2&
 Private Const TME_NONCLIENT As Long = &H10&
 Private Const TME_QUERY As Long = &H40000000
 
 Private Const WM_MOUSELEAVE As Long = &H2A3&
 Private Const WM_MOUSEMOVE As Long = &H200
 Private Const WM_MOUSEHOVER As Long = &H2A1
 
 Private Type TRACKMOUSEEVENTTYPE
     cbSize As Long
     dwFlags As Long
     hwndTrack As Long
     dwHoverTime As Long
 End Type
 
 Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long

The next thing to do is to create a function that will call TrackMouseEvent for a particular window (it's just easier that way):

 Sub RequestTracking(hwnd As Long)
     Dim ET As TRACKMOUSEEVENTTYPE
     
     ET.cbSize = Len(ET)
     ET.hwndTrack = hwnd
     ET.dwFlags = TME_LEAVE Or TME_HOVER
     ET.dwHoverTime = 1
     TrackMouseEvent ET
 End Sub

As you can see, all we do here is set up a few variables in a struct and call the TrackMouseEvent API (for more information see [1])

The following code will subclass the window and handle hover and leave events:

 Public Sub SubclassWindow(ByVal hwnd As Long)
     Dim pOldWndProc As Long
     
     pOldWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf fnWndProc)
     SetProp hwnd, "pOldWndProc", pOldWndProc
 End Sub
 
 Public Sub UnSubclassWindow(ByVal hwnd As Long)
     SetWindowLong hwnd, GWL_WNDPROC, GetProp(hwnd, "pOldWndProc")
     RemoveProp hwnd, "pOldWndProc"
 End Sub
 
 Private Function fnWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
     Select Case uMsg
         Case WM_MOUSELEAVE
             SetProp hwnd, "bOver", False
             '-- Mouse Left
             '-- Do Something
             
         Case WM_MOUSEHOVER
             If GetProp(hwnd, "bOver") <> 1 Then
                 '-- Mouse Hovering
                 '-- Do something
             End If
             SetProp hwnd, "bOver", 1
         
         Case WM_MOUSEMOVE
             RequestTracking hwnd
     End Select
     fnWndProc = CallWindowProc(GetProp(hwnd, "pOldWndProc"), hwnd, uMsg, wParam, lParam)
 End Function

Then all you have to do is what you want where it says 'do something'. Simple.