Mouse Hover and Out Events
| This article is based on Visual Basic 6. Find other Visual Basic 6 articles. |
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 method will not work with windowless controls as they have no windows to subclass. For these you can use an alternative method)
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."
Contents
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 GWL_WNDPROC = (-4)
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
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 Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) 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
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 MSDN)
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.
MouseHover with windowless controls
If you want to detect the mouse hovering over a label, you can't use the method above as they are "virtual" controls and don't have a window handle. You can still use the MouseMove event of the label to detect MouseHover and the MouseMove event of its container to detect MouseOut.
Here is an example of how you can do much the same thing without using the Windows API and it works for both windowless and normal controls. It consists of a form which is just a test bed and a class. For each control that you want to have MouseEnter and MouseExit events you create an instance of the class and assign it to a variable declared WithEvents. For example;
Private WithEvents moLabel1 as cMouse
You can now add handlers for the events like this:
Private sub moLabel1_MouseEnter() 'Do something! End Sub
cMouse.cls
This class is used to subclass the controls that you want respond to MouseEnter and MouseExit events. Note that it only works for labels at the moment but it is trivial to extend it to work with other control types as well. Hint: look at the way that the different types of container are handled.
Option Explicit Private WithEvents moControl As Label Private WithEvents moForm As Form Private WithEvents moFrame As Frame Private mbMouseOver As Boolean Public Event MouseEnter() Public Event MouseExit()
Set this property to connect the control on the form to the event handlers in the class. Notice that there are two container variables declared: moForm and moFrame; you should extend this to handle the other containers as well (PictureBox for instance).
Public Property Set oControl(RHS As Label)
Set moControl = RHS
If TypeOf RHS.Container Is Frame Then
Set moFrame = moControl.Container
Else
Set moForm = moControl.Container
End If
End Property
Here we respond to the MouseMove on a frame. If the mouse was inside the control then we raise the MouseExit event and clear the flag that said we were inside.
Private Sub xMouseMove()
If mbMouseOver Then
mbMouseOver = False
RaiseEvent MouseExit
End If
End Sub
Private Sub moFrame_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
xMouseMove
End Sub
This is the same as the MouseMove handler for the frame. Duplicate this to handle other containers as well
Private Sub moForm_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) xMouseMove End Sub
Here we check to see if we were inside, if not we generate the MouseEnter event and set the flag.
Private Sub moControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not mbMouseOver Then
mbMouseOver = True
RaiseEvent MouseEnter
End If
End Sub
frmMouse.frm
This is an example form that uses the cMouse class.
VERSION 5.00
Begin VB.Form frmMouse
Caption = "Form1"
ClientHeight = 3180
ClientLeft = 60
ClientTop = 360
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3180
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.Frame Frame1
Caption = "Frame1"
Height = 1095
Left = 480
TabIndex = 1
Top = 1440
Width = 3495
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Label2"
Height = 195
Left = 240
TabIndex = 2
Top = 360
Width = 480
End
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Label1"
Height = 195
Left = 240
TabIndex = 0
Top = 600
Width = 480
End
End
Attribute VB_Name = "frmMouse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private WithEvents moLabel1 As cMouse
Attribute moLabel1.VB_VarHelpID = -1
Private WithEvents moLabel2 As cMouse
Attribute moLabel2.VB_VarHelpID = -1
Private Sub Form_Load()
Set moLabel1 = New cMouse
Set moLabel1.oControl = Label1
Set moLabel2 = New cMouse
Set moLabel2.oControl = Label2
End Sub
Private Sub moLabel1_MouseEnter()
Label1.Caption = "Mouse entered"
End Sub
Private Sub moLabel1_MouseExit()
Label1.Caption = "Mouse left"
End Sub
Private Sub moLabel2_MouseEnter()
Label2.Caption = "Mouse entered"
End Sub
Private Sub moLabel2_MouseExit()
Label2.Caption = "Mouse left"
End Sub
