| View previous topic :: View next topic |
| Author |
Message |
Avis
Junior Poster
Joined: 07 Oct 2003
Posts: 510
Location: India
|
 Posted: Oct 8th, 2003 04:02 AM Post subject: Simulate MouseEnter and MouseLeave Events |
 |
|
| Code: | 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 |
|
|
| Back to top |
|
P.T.A.M.
Administrator
Joined: 08 Oct 2003
Posts: 752
Location: Greece
|
| Posted: Oct 10th, 2003 07:37 AM Post subject: |
|
|
Here are some other ways :
| Code: | 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 |
_________________
No one is completely useless. They can at least be an example of what to avoid. |
|
| Back to top |
|
P.T.A.M.
Administrator
Joined: 08 Oct 2003
Posts: 752
Location: Greece
|
| Posted: Oct 10th, 2003 07:38 AM Post subject: |
|
|
| Code: | 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 |
_________________
No one is completely useless. They can at least be an example of what to avoid. |
|
| Back to top |
|
P.T.A.M.
Administrator
Joined: 08 Oct 2003
Posts: 752
Location: Greece
|
| Posted: Oct 10th, 2003 07:39 AM Post subject: |
|
|
| Code: | 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 |
_________________
No one is completely useless. They can at least be an example of what to avoid. |
|
| Back to top |
|
|
