Adding MouseLeave and MouseHover Events to VB6 Controls

This article is about creating ActiveX controls in Visual Basic 6 that have two extra mouse events:

  1. MouseLeave: Raised when the cursor get out of the control.
  2. MouseHover: Raised when the user pauses the cursor over the control for a defined time (default is 400 milliseconds).

A famous approach to achieve this is to use a Timer control with a small interval. In the timer event, the programmer checks the cursor location. (I do hate this. It's painful and needs a lot of work and overhead to track the cursor.)

Another way is to start using VB.NET, which has these events built-in. (But you should have stronger reasons to switch to .NET!!)

The alternative way used in this article is to let Windows send you a MouseLeave,MouseHover message (event).

How to Do This

We need three things to achieve this:

  1. To tell Windows that you want it to send you the required events.

    This is achieved by calling the TrackMouseEvent API function, specifying the events you need and the hover time you want. This is done in the main module (mdlProc.bas) in the RequestTracking function.

  2. Dim trk As tagTRACKMOUSEEVENT
    trk.cbSize      = 16
    trk.dwFlags     = TME_LEAVE Or TME_HOVER
    trk.dwHoverTime = trak.HoverTime
    trk.hwndTrack   = trak.hwnd
    
    TrackMouseEvent trk
    
  3. To receive the message when Windows sends it.

    Visual Basic does not have a built-in mechanism to receive custom messages. You can only choose from a list of events in the form or control code window.

    So, we need to Subclass the control's window to intercept all messages sent to the window. Then, we can handle the messages we need and forward the rest to the original window procedure. This is done by calling the SetWindowLong API to set the new window procedure:

    SetWindowLong(ctl.hwnd, GWL_WNDPROC, AddressOf WindowProc)

    The WindowProc function is defined in mdlProc.bas like this:

    Private Function WindowProc(ByVal hwnd As Long, _
                                ByVal uMsg As Long, _
                                ByVal wParam As Long, _
                                ByVal lParam As Long) As Long
    

    We need to handle three specific messages: WM_MOUSELEAVE, WM_MOUSEHOVER, and WM_MOUSEMOVE, and forward other messages (as well as the WM_MOUSEMOVE message) directly to the original window procedure:

    WindowProc = CallWindowProc(trak.PrevProc, hwnd, uMsg, _
                                wParam, lParam)
    
  4. We need to dispatch the message to the window:

    Note that all messages are sent to the WindowProc function, but we may have multiple controls on the form. So, we want to know which control this message was originally sent to.

    To make this happen, we use a trackCol collection to hold references to clsTrackInfo objects. The keys of the collection are the window handles (hwnd). I use window handles as keys because the WindowProc function receives the window handle as a parameter, so we can use it to look up the clsTrackInfo object in the collection.

    To add the control to the collection:

    trackCol.Add trak, CStr(trak.hwnd)

    To search for the required control:

    Set trak = trackCol.Item(CStr(hwnd))

    Then, we use this code to check the value of the message and take the required action.

    If uMsg = WM_MOUSELEAVE Then
        trak.RaiseMouseLeave
    ElseIf uMsg = WM_MOUSEHOVER Then
        trak.RaiseMouseHover
    ElseIf uMsg = WM_MOUSEMOVE Then
        RequestTracking trak
        WindowProc = CallWindowProc(trak.prevProc, hwnd, uMsg, _
                                    wParam, lParam)
    Else
        WindowProc = CallWindowProc(trak.prevProc, hwnd, uMsg, _
                                    wParam, lParam)
        'Debug.Print uMsg
    End If
    

Selecting the Control

In the mdlProc.bas, I use the clsTrackInfo to be stored in the trackCol collection. These objects in the collection are used to connect the module code to the UserControl.

It makes more sense to store references to the UserControl directly, but this causes the Terminate event not to be raised in some cases due to circular references.

(More about this in the Knowledge base.)

Control's selection code

Note that I declared MyTrak with events:

Dim WithEvents MyTrak As clsTrackInfo
Option Explicit

Public Event MouseLeave()
Public Event MouseHover()

Dim WithEvents MyTrak As clsTrackInfo

Private Sub MyTrak_MouseHover()
RaiseEvent MouseHover
End Sub

Private Sub MyTrak_MouseLeave()
RaiseEvent MouseLeave
End Sub

Public Property Get HoverTime() As Long
HoverTime = MyTrak.HoverTime
End Property

Public Property Let HoverTime(newHoverTime As Long)
MyTrak.HoverTime = newHoverTime
PropertyChanged "HoverTime"
End Property

Private Sub UserControl_InitProperties()
Set MyTrak = New clsTrackInfo
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Set MyTrak  = New clsTrackInfo
MyTrak.hwnd = UserControl.hwnd

MyTrak.HoverTime = PropBag.ReadProperty("HoverTime", 400)

If Ambient.UserMode Then
StartTrack MyTrak
End If
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "HoverTime", MyTrak.HoverTime, 400
End Sub

Private Sub UserControl_Terminate()
EndTrack MyTrak
Set MyTrak = Nothing
End Sub

I handle the MyTrak_MouseHover and MyTrak_MouseLeave events of the MyTrak object to raise the required events.

Notes

  1. StartTrack is called in the UserControl_ReadProperties to start tracking the events and add the control to the trackCol collection. EndTrack is called in the UserControl_Terminate event to end tracking and remove the control from the trackCol Collection.

    I used UserControl_ReadProperties, not UserControl_Initialize, to check the Ambient.UserMode property that is not available in the UserControl_Initialize event.

  2. WM_MOUSEHOVER is sent when the user pauses the mouse over the control for a specific time. The default hover time is 400 milliseconds (the same as the Windows default), but you can change it.
  3. After the first time Windows send the WM_MOUSEHOVER or WM_MOUSELEAVE events, it does not resend them till you re-request this. So, I call RequestTracking when the WM_MOUSEMOVE message is sent.
  4. Set the Instancing property of clsTrackInfo to private.
  5. Take care when changing this article's code or generally when using window subclassing in Visual Basic. My IDE crashed many times before I could make it work fine!!
  6. Handle all errors in the MouseLeave, MouseHover, and MouseMove Event handlers. Any unhandled errors can make the IDE or the application crash or give more errors. So, using On Error ... goto or On Error Resume Next is advisable.

    Also, when error trapping (Tools->Options->General tab), select break on unhandled errors or break in class module, not break on all errors.

  7. It's always better not to end your application by using End or by clicking End in the IDE. This causes Terminate events not to be called.

If You Don't Understand All of the Above

You still can use the code.

  1. Create a new ActiveX Control project.
  2. Add mdlProc.bas and clsTrackInfo.cls to the project.
  3. Copy and paste the selection code above to your control.

Please feel free to contact the author for any questions or comments using this forum.



Downloads

Comments

  • HcqVAx CA WD XSd NUOQ iN

    Posted by pMhpodsWQa on 06/24/2013 11:26pm

    browse what does viagra for women do - what viagra dosage is best

    Reply
  • Working !!!!! Very Good Article

    Posted by akhilonly007 on 06/10/2007 11:14pm

    its very good for us (VB programmer) as there is no mouse hover and mouse leave event available.
    its working very much fine i have implemented it in my ActiveX control.
    when U use "End" statement then only application will crash otherwise works fine.

    • Glad that you liked it

      Posted by hspc on 06/11/2007 03:01pm

      I'm glad that you found it useful. about the "End" crash.. using End is not the recommended way to exit a VB6 application anyway. thanks for the comment.

      Reply
    Reply
  • Command buttons don't work either!

    Posted by kmh72756 on 10/17/2004 05:19pm

    Now that I've tested some more, Command buttons don't work either, so it's not 3rd-party controls that are a problem. Does anyone know why this doesn't work consistently? Where are the messages getting incorrectly consumed? They sure aren't getting to the WndProc.

    Reply
  • What about 3rd-party controls?

    Posted by kmh72756 on 10/15/2004 12:32pm

    Has anyone had any luck or problems making this work with 2rd-party controls? I thimk I understand how this works and I have working examples using Labels but no luck when I have a grid set up the same way. I am using TrueDB Grid Pro 8.0 from ComponentOne.

    Reply
Leave a Comment
  • Your email address will not be published. All fields are required.

Top White Papers and Webcasts

  • On-demand Event Event Date: September 10, 2014 Modern mobile applications connect systems-of-engagement (mobile apps) with systems-of-record (traditional IT) to deliver new and innovative business value. But the lifecycle for development of mobile apps is also new and different. Emerging trends in mobile development call for faster delivery of incremental features, coupled with feedback from the users of the app "in the wild." This loop of continuous delivery and continuous feedback is how the best mobile …

  • Live Event Date: September 17, 2014 @ 12:00 p.m. ET / 9:00 a.m. PT Another day, another end-of-support deadline. You've heard enough about the hazards of not migrating to Windows Server 2008 or 2012. What you may not know is that there's plenty in it for you and your business, like increased automation and performance, time-saving technical features, and a lower total cost of ownership. Check out this upcoming eSeminar and join Rich Holmes, Pomeroy's practice director of virtualization, as he discusses the …

Most Popular Programming Stories

More for Developers

Latest Developer Headlines

RSS Feeds