vindevogel
asked on
How do I know what control my mouse is over ?
Hi,
I'm writing a control that checks when the mouse enters a control and when it leaves the control. (Does some more things too) This code I already have. (That's the code below)
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private mReturn As Long
Private mPoint As POINTAPI
Public LinkedControl As Control
Public Captured As Boolean
Public Event ControlCaptured()
Public Event ControlReleased()
Private Sub UserControl_Initialize()
UserControl_Resize
End Sub
Private Sub UserControl_Resize()
UserControl.Width = 540
UserControl.Height = 540
End Sub
Public Property Get CursorPosX() As Long
mReturn = GetCursorPos(mPoint)
CursorPosX = mPoint.x
End Property
Public Property Get CursorPosY() As Long
mReturn = GetCursorPos(mPoint)
CursorPosY = mPoint.y
End Property
Public Sub MouseMove(x As Single, y As Single)
If Me.Captured Then
Release x, y
Else
Capture
End If
End Sub
Private Sub Capture()
SetCapture LinkedControl.hwnd
Captured = True
RaiseEvent ControlCaptured
End Sub
Private Function Release(x As Single, y As Single) As Boolean
If (x < 0) Or (x > LinkedControl.Width) Or (y < 0) Or (y > LinkedControl.Height) Then
ReleaseCapture
Captured = False
RaiseEvent ControlReleased
Release = True
Else
Release = False
End If
End Function
In the form where I use my control (called MouseEx) I can trap events with following code
Option Explicit
Private Sub Form_Load()
Set MouseEx1.LinkedControl = Text1
End Sub
Private Sub MouseEx1_ControlCaptured()
Debug.Print "Captured "
End Sub
Private Sub MouseEx1_ControlReleased()
Debug.Print "Released"
End Sub
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseEx1.MouseMove X, Y
End Sub
Now, It's the line in the mousemove that bothers me.
I want to be able check these things without coding the mousemove myself.
I've seen programs where they show on which control the mouse is. They probably check off something with the APIs, but I don't know what anymore.
Can anyone give me a piece of code that does:
You have a form, you put on it text1, text2, picture1 ... and a label. When you move the mouse over one of these controls, the label should say on which one you are. This, without coding anything on the controls. Only a generic function.
Thanks
I'm writing a control that checks when the mouse enters a control and when it leaves the control. (Does some more things too) This code I already have. (That's the code below)
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private mReturn As Long
Private mPoint As POINTAPI
Public LinkedControl As Control
Public Captured As Boolean
Public Event ControlCaptured()
Public Event ControlReleased()
Private Sub UserControl_Initialize()
UserControl_Resize
End Sub
Private Sub UserControl_Resize()
UserControl.Width = 540
UserControl.Height = 540
End Sub
Public Property Get CursorPosX() As Long
mReturn = GetCursorPos(mPoint)
CursorPosX = mPoint.x
End Property
Public Property Get CursorPosY() As Long
mReturn = GetCursorPos(mPoint)
CursorPosY = mPoint.y
End Property
Public Sub MouseMove(x As Single, y As Single)
If Me.Captured Then
Release x, y
Else
Capture
End If
End Sub
Private Sub Capture()
SetCapture LinkedControl.hwnd
Captured = True
RaiseEvent ControlCaptured
End Sub
Private Function Release(x As Single, y As Single) As Boolean
If (x < 0) Or (x > LinkedControl.Width) Or (y < 0) Or (y > LinkedControl.Height) Then
ReleaseCapture
Captured = False
RaiseEvent ControlReleased
Release = True
Else
Release = False
End If
End Function
In the form where I use my control (called MouseEx) I can trap events with following code
Option Explicit
Private Sub Form_Load()
Set MouseEx1.LinkedControl = Text1
End Sub
Private Sub MouseEx1_ControlCaptured()
Debug.Print "Captured "
End Sub
Private Sub MouseEx1_ControlReleased()
Debug.Print "Released"
End Sub
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseEx1.MouseMove X, Y
End Sub
Now, It's the line in the mousemove that bothers me.
I want to be able check these things without coding the mousemove myself.
I've seen programs where they show on which control the mouse is. They probably check off something with the APIs, but I don't know what anymore.
Can anyone give me a piece of code that does:
You have a form, you put on it text1, text2, picture1 ... and a label. When you move the mouse over one of these controls, the label should say on which one you are. This, without coding anything on the controls. Only a generic function.
Thanks
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Wireman: Thanks for your answer. However, I'm going to reject it:
1) I still have to code on the LinkedControl (one line).
2) In the answer of Ask_ED (well, tru the links he supplied), I found a better API. The WindowFromPoint API. I'm using that one now.
With his answer, I simplified my code. One slight disadvantage: I'm using a timer. I don't know how to capture the enter and leave without having to loop either with a timer, either with a mousemove.
I'm posting the resulting code below.
I'm rejecting yours and awarding Ask_ED. Thanks for the On error resume next. Hadn't noticed. Hope you're not angry with me for rejecting.
Yves Vindevogel
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 WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private mReturn As Long
Private mPoint As POINTAPI
Public LinkedControl As Control
Public Event ControlOver()
Public Event ControlLeave()
Private Sub tmrMouse_Timer()
Dim vHandle As Long
Static vOver As Boolean
If LinkedControl Is Nothing Then Exit Sub
vHandle = WindowFromPoint(CursorPosX , CursorPosY)
If vHandle = LinkedControl.hwnd Then
If Not vOver Then
vOver = True
RaiseEvent ControlOver
End If
Else
If vOver Then
vOver = False
RaiseEvent ControlLeave
End If
End If
End Sub
Private Sub UserControl_Initialize()
UserControl_Resize
End Sub
Private Sub UserControl_Resize()
On Error Resume Next
UserControl.Width = 540
UserControl.Height = 540
End Sub
Public Property Get CursorPosX() As Long
mReturn = GetCursorPos(mPoint)
CursorPosX = mPoint.x
End Property
Public Property Get CursorPosY() As Long
mReturn = GetCursorPos(mPoint)
CursorPosY = mPoint.y
End Property
Public Property Get Interval() As Long
Interval = tmrMouse.Interval
End Property
Public Property Let Interval(ByVal aInterval As Long)
tmrMouse.Interval = aInterval
PropertyChanged "Interval"
End Property
Private Sub UserControl_ReadProperties (PropBag As PropertyBag)
tmrMouse.Interval = PropBag.ReadProperty("Inte rval", 100)
End Sub
Private Sub UserControl_WritePropertie s(PropBag As PropertyBag)
Call PropBag.WriteProperty("Int erval", tmrMouse.Interval, 100)
End Sub
1) I still have to code on the LinkedControl (one line).
2) In the answer of Ask_ED (well, tru the links he supplied), I found a better API. The WindowFromPoint API. I'm using that one now.
With his answer, I simplified my code. One slight disadvantage: I'm using a timer. I don't know how to capture the enter and leave without having to loop either with a timer, either with a mousemove.
I'm posting the resulting code below.
I'm rejecting yours and awarding Ask_ED. Thanks for the On error resume next. Hadn't noticed. Hope you're not angry with me for rejecting.
Yves Vindevogel
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 WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private mReturn As Long
Private mPoint As POINTAPI
Public LinkedControl As Control
Public Event ControlOver()
Public Event ControlLeave()
Private Sub tmrMouse_Timer()
Dim vHandle As Long
Static vOver As Boolean
If LinkedControl Is Nothing Then Exit Sub
vHandle = WindowFromPoint(CursorPosX
If vHandle = LinkedControl.hwnd Then
If Not vOver Then
vOver = True
RaiseEvent ControlOver
End If
Else
If vOver Then
vOver = False
RaiseEvent ControlLeave
End If
End If
End Sub
Private Sub UserControl_Initialize()
UserControl_Resize
End Sub
Private Sub UserControl_Resize()
On Error Resume Next
UserControl.Width = 540
UserControl.Height = 540
End Sub
Public Property Get CursorPosX() As Long
mReturn = GetCursorPos(mPoint)
CursorPosX = mPoint.x
End Property
Public Property Get CursorPosY() As Long
mReturn = GetCursorPos(mPoint)
CursorPosY = mPoint.y
End Property
Public Property Get Interval() As Long
Interval = tmrMouse.Interval
End Property
Public Property Let Interval(ByVal aInterval As Long)
tmrMouse.Interval = aInterval
PropertyChanged "Interval"
End Property
Private Sub UserControl_ReadProperties
tmrMouse.Interval = PropBag.ReadProperty("Inte
End Sub
Private Sub UserControl_WritePropertie
Call PropBag.WriteProperty("Int
End Sub
ASKER
Thanks Ask_ED.
I found the API I needed in the code there.
I found the API I needed in the code there.
WindowFromPoint
WindowFromPointEx
ChildWindowFromPoint
are all required to determine which control is below the mouse, ChildWindowFromPoint is necessary when a control is within a frame or other container.
WindowFromPointEx
ChildWindowFromPoint
are all required to determine which control is below the mouse, ChildWindowFromPoint is necessary when a control is within a frame or other container.
On Error Resume Next 'to prevent GDI Crashes
'error occurs at design time when bottom right corner is resized left and above the top left corner
UserControl.Width = 540
UserControl.Height = 540
End Sub
...................
and below is the code I do for watching mouse movement (with some enhancements removed)
(New Project and add one button)
...................
<clip>
Option Explicit
'sample form by Arty Clark
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom 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 Function DoWatch()
Static AlReadyWatching As Boolean
Dim P As POINTAPI
Dim R As RECT
'ensure only one instance of function running
If AlReadyWatching Then Exit Function
AlReadyWatching = True
'find out where the control is
'keep watching until mouse is not within rect of control
Do
GetCursorPos P
GetWindowRect Me.Command1.hWnd, R
If P.X <= R.Right And P.X >= R.Left And P.Y <= R.Bottom And P.Y >= R.Top Then
Me.Command1.Caption = "Mouse Over"
Else
Me.Command1.Caption = "Mouse Out"
AlReadyWatching = False
Exit Function
End If
Loop While DoEvents
End Function
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call DoWatch
End Sub