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."
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
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
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