VB - Simulate MouseEnter and MouseLeave events...

[crptcblade]

Option Explicit
 
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCapture Lib "user32" () As Long
 
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    With Command1
        If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then 'MouseLeave
            Call ReleaseCapture
        ElseIf GetCapture() <> .hwnd Then 'MouseEnter
            Call SetCapture(.hwnd)
        Else
            'Normal MouseMove
        End If
    End With
 
End Sub

Replace Command1 with the name of the control. The control must have an hWnd property, and support the MouseMove event for this to work.

[MartinLiss]

Could you add an explanation of how/why this code would be used?

[crptcblade]

Sorry, no.

[crptcblade]

I use it mainly for painting certain effects on usercontrols when the mouse is over it. Like toolbar buttons. See attached.

[manavo11]

Another way to do this. It uses a timer, does not need the mousemove event and also needs the hwnd property :

Option Explicit
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Type POINTAPI
    X As Long
    Y As Long
End Type
 
 
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
 
Private Sub Form_Load()
    Timer1.Interval = 1
    Timer1.Enabled = True
End Sub
 
Private Sub Timer1_Timer()
    Dim Rec As RECT, Point As POINTAPI
    
    GetWindowRect Command1.hwnd, Rec
    
    GetCursorPos Point
 
    If Point.X >= Rec.Left And Point.X <= Rec.Right And Point.Y >= Rec.Top And Point.Y <= Rec.Bottom Then
        Me.Caption = "Over Button"
    Else
        Me.Caption = "Not Over Button"
    End If
End Sub

[manavo11]

Like the other version, it needs a timer and the hwnd :

Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
 
Private Type POINTAPI
    X As Long
    Y As Long
End Type
 
Private Sub CheckMouse(Control As Control)
Dim mhWnd As Long
Dim Pt As POINTAPI
 
GetCursorPos Pt
 
mhWnd = WindowFromPoint(Pt.X, Pt.Y)
If mhWnd = Control.hwnd Then
    Debug.Print "Mouse Is Over " & Control.Name
Else
    Debug.Print "Mouse Isn't Over " & Control.Name
End If
End Sub
 
Private Sub Timer1_Timer()
CheckMouse Command1
End Sub

[manavo11]

Another way, just a timer and no hwnd or mousemove event :

Option Explicit
 
Private Type POINTAPI
    X As Long
    Y As Long
End Type
 
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
 
Private Declare Function ScreenToClient Lib "user32" _
(ByVal hwnd As Long, lpPoint As POINTAPI) As Long
 
Dim Pt As POINTAPI
 
Private Sub CheckMouse(Control As Control)
 
Dim SM As Single
 
GetCursorPos Pt
ScreenToClient Me.hwnd, Pt
 
SM = Me.ScaleMode
Me.ScaleMode = vbPixels
 
If (Pt.X > Control.Left And Pt.X < Control.Left + Control.Width) And (Pt.Y > Control.Top And Pt.Y < Control.Top + Control.Height) Then
    Debug.Print "Over"
Else
    Debug.Print "Not Over"
End If
 
Me.ScaleMode = SM
 
End Sub
 
Private Sub Timer1_Timer()
CheckMouse Label1
End Sub