Difference between revisions of "Mouse Hover and Out Events"

From HashVB
Jump to: navigation, search
m (Reverted edit of 62.1.229.107, changed back to last version by Dee)
(→‎How do you use this mystical API?)
 
(6 intermediate revisions by 4 users not shown)
Line 8: Line 8:
 
====How do you use this mystical API?====
 
====How do you use this mystical API?====
 
First things first: the declarations required to use it (these do not include the declarations for subclassing) -  
 
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_CANCEL As Long = &H80000000
Line 28: Line 30:
 
   Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENTTYPE) As Long
 
   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):
 
The next thing to do is to create a function that will call TrackMouseEvent for a particular window (it's just easier that way):
  
Line 80: Line 95:
 
==MouseHover with windowless controls==
 
==MouseHover with windowless controls==
  
−
If you want to detect the mouse hovering over a label, you cant 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.
+
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

Latest revision as of 14:53, 25 April 2007

float
 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

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
Retrieved from "http://hashvb.earlsoft.co.uk/index.php?title=Mouse_Hover_and_Out_Events&oldid=2566"