samsonite1023
asked on
MouseUp (or mouseDown) even anywhere on screen.
How can I tell the status of the mouse even when it is off any of my controls? All I have found is how to get it's position, but what about the buttons?
Basically, I need to know how to tell when the left button has been depressed.
Thanks
-Sam
Basically, I need to know how to tell when the left button has been depressed.
Thanks
-Sam
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Hi
Thanks for points, glad I could help you.
My sample include ALL source code, just copy/paste what you need.
OK, code here:
Add bas module to your app:
'======bas module code=====
Option Explicit
Public Type POINTAPI
x As Long
y As Long
End Type
Type TMSG
hWnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public hJournalHook As Long, hAppHook As Long
Public SHptr As Long
Public Const WM_CANCELJOURNAL = &H4B
Public Function JournalRecordProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode < 0 Then
JournalRecordProc = CallNextHookEx(hJournalHoo k, nCode, wParam, lParam)
Exit Function
End If
ResolvePointer(SHptr).Fire Event lParam
Call CallNextHookEx(hJournalHoo k, nCode, wParam, lParam)
End Function
Public Function AppHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode < 0 Then
AppHookProc = CallNextHookEx(hAppHook, nCode, wParam, lParam)
Exit Function
End If
Dim msg As TMSG
CopyMemory msg, ByVal lParam, Len(msg)
Select Case msg.message
Case WM_CANCELJOURNAL
If wParam = 1 Then ResolvePointer(SHptr).Fire Event WM_CANCELJOURNAL
End Select
Call CallNextHookEx(hAppHook, nCode, wParam, ByVal lParam)
End Function
Private Function ResolvePointer(ByVal lpObj&) As cSystemHook
Dim oSH As cSystemHook
CopyMemory oSH, lpObj, 4&
Set ResolvePointer = oSH
CopyMemory oSH, 0&, 4&
End Function
'========End Bas module=======
Add class module named cSystemHook
'=====Class module code=======
Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event SystemKeyDown(KeyCode As Integer)
Public Event SystemKeyUp(KeyCode As Integer)
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_SYSTEMKEYDOWN = &H104
Private Const WM_SYSTEMKEYUP = &H105
Private Const WH_JOURNALRECORD = 0
Private Const WH_GETMESSAGE = 3
Private Type EVENTMSG
wMsg As Long
lParamLow As Long
lParamHigh As Long
msgTime As Long
hWndMsg As Long
End Type
Dim EMSG As EVENTMSG
Public Function SetHook() As Boolean
If hJournalHook = 0 Then hJournalHook = SetWindowsHookEx(WH_JOURNA LRECORD, AddressOf JournalRecordProc, App.hInstance, 0)
If hAppHook = 0 Then hAppHook = SetWindowsHookEx(WH_GETMES SAGE, AddressOf AppHookProc, App.hInstance, App.ThreadID)
SetHook = True
End Function
Public Sub RemoveHook()
UnhookWindowsHookEx hAppHook
UnhookWindowsHookEx hJournalHook
End Sub
Private Sub Class_Initialize()
SHptr = ObjPtr(Me)
End Sub
Private Sub Class_Terminate()
If hJournalHook Or hAppHook Then RemoveHook
End Sub
Public Function FireEvent(ByVal lParam As Long)
Dim i%, j%, k%
Dim s As String
If lParam = WM_CANCELJOURNAL Then
hJournalHook = 0
SetHook
Exit Function
End If
CopyMemory EMSG, ByVal lParam, Len(EMSG)
Select Case EMSG.wMsg
Case WM_KEYDOWN
j = 0
If GetAsyncKeyState(vbKeyShif t) Then j = (j Or 1)
If GetAsyncKeyState(vbKeyCont rol) Then j = (j Or 2)
If GetAsyncKeyState(vbKeyMenu ) Then j = (j Or 4)
s = Hex(EMSG.lParamLow)
k = (EMSG.lParamLow And &HFF)
RaiseEvent KeyDown(k, j)
s = Left$(s, 2) & Right$("00" & Hex(k), 2)
EMSG.lParamLow = CLng("&h" & s)
CopyMemory ByVal lParam, EMSG, Len(EMSG)
Case WM_KEYUP
j = 0
If GetAsyncKeyState(vbKeyShif t) Then j = (j Or 1)
If GetAsyncKeyState(vbKeyCont rol) Then j = (j Or 2)
If GetAsyncKeyState(vbKeyMenu ) Then j = (j Or 4)
s = Hex(EMSG.lParamLow)
k = (EMSG.lParamLow And &HFF)
RaiseEvent KeyUp(k, j)
s = Left$(s, 2) & Right$("00" & Hex(k), 2)
EMSG.lParamLow = CLng("&h" & s)
CopyMemory ByVal lParam, EMSG, Len(EMSG)
Case WM_MOUSEMOVE
i = 0
If GetAsyncKeyState(vbKeyLBut ton) Then i = (i Or 1)
If GetAsyncKeyState(vbKeyRBut ton) Then i = (i Or 2)
If GetAsyncKeyState(vbKeyMBut ton) Then i = (i Or 4)
j = 0
If GetAsyncKeyState(vbKeyShif t) Then j = (j Or 1)
If GetAsyncKeyState(vbKeyCont rol) Then j = (j Or 2)
If GetAsyncKeyState(vbKeyMenu ) Then j = (j Or 4)
RaiseEvent MouseMove(i, j, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))
Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN
i = 0
If GetAsyncKeyState(vbKeyShif t) Then i = (i Or 1)
If GetAsyncKeyState(vbKeyCont rol) Then i = (i Or 2)
If GetAsyncKeyState(vbKeyMenu ) Then i = (i Or 4)
RaiseEvent MouseDown(2 ^ ((EMSG.wMsg - 513) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))
Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP
i = 0
If GetAsyncKeyState(vbKeyShif t) Then i = (i Or 1)
If GetAsyncKeyState(vbKeyCont rol) Then i = (i Or 2)
If GetAsyncKeyState(vbKeyMenu ) Then i = (i Or 4)
RaiseEvent MouseUp(2 ^ ((EMSG.wMsg - 514) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))
Case WM_SYSTEMKEYDOWN
s = Hex(EMSG.lParamLow)
k = (EMSG.lParamLow And &HFF)
If k <> vbKeyMenu Then RaiseEvent SystemKeyDown(k)
s = Left$(s, 2) & Right$("00" & Hex(k), 2)
EMSG.lParamLow = CLng("&h" & s)
CopyMemory ByVal lParam, EMSG, Len(EMSG)
Case WM_SYSTEMKEYUP
s = Hex(EMSG.lParamLow)
k = (EMSG.lParamLow And &HFF)
If k <> vbKeyMenu Then RaiseEvent SystemKeyUp(k)
s = Left$(s, 2) & Right$("00" & Hex(k), 2)
EMSG.lParamLow = CLng("&h" & s)
CopyMemory ByVal lParam, EMSG, Len(EMSG)
Case Else
End Select
End Function
'=======End Class module code=====
How to use:
'=======Form code=======
Dim WithEvents sh As cSystemHook
Private Sub sh_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim sText As String
Select Case Button
Case vbLeftButton: sText = "Left"
Case vbMiddleButton: sText = "Middle"
Case vbRightButton: sText = "Right"
Case Else
End Select
Debug.Print sText & " mouse button down at position " & x & ", " & y
End Sub
Private Sub sh_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim sText As String
Select Case Button
Case vbLeftButton: sText = "Left"
Case vbMiddleButton: sText = "Middle"
Case vbRightButton: sText = "Right"
Case Else
End Select
Debug.Print sText & " mouse button up at position " & x & ", " & y
End Sub
'Note: you can remove all Keyboard staff from class module, if you don't need it.
Cheers
Thanks for points, glad I could help you.
My sample include ALL source code, just copy/paste what you need.
OK, code here:
Add bas module to your app:
'======bas module code=====
Option Explicit
Public Type POINTAPI
x As Long
y As Long
End Type
Type TMSG
hWnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public hJournalHook As Long, hAppHook As Long
Public SHptr As Long
Public Const WM_CANCELJOURNAL = &H4B
Public Function JournalRecordProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode < 0 Then
JournalRecordProc = CallNextHookEx(hJournalHoo
Exit Function
End If
ResolvePointer(SHptr).Fire
Call CallNextHookEx(hJournalHoo
End Function
Public Function AppHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If nCode < 0 Then
AppHookProc = CallNextHookEx(hAppHook, nCode, wParam, lParam)
Exit Function
End If
Dim msg As TMSG
CopyMemory msg, ByVal lParam, Len(msg)
Select Case msg.message
Case WM_CANCELJOURNAL
If wParam = 1 Then ResolvePointer(SHptr).Fire
End Select
Call CallNextHookEx(hAppHook, nCode, wParam, ByVal lParam)
End Function
Private Function ResolvePointer(ByVal lpObj&) As cSystemHook
Dim oSH As cSystemHook
CopyMemory oSH, lpObj, 4&
Set ResolvePointer = oSH
CopyMemory oSH, 0&, 4&
End Function
'========End Bas module=======
Add class module named cSystemHook
'=====Class module code=======
Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event SystemKeyDown(KeyCode As Integer)
Public Event SystemKeyUp(KeyCode As Integer)
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_SYSTEMKEYDOWN = &H104
Private Const WM_SYSTEMKEYUP = &H105
Private Const WH_JOURNALRECORD = 0
Private Const WH_GETMESSAGE = 3
Private Type EVENTMSG
wMsg As Long
lParamLow As Long
lParamHigh As Long
msgTime As Long
hWndMsg As Long
End Type
Dim EMSG As EVENTMSG
Public Function SetHook() As Boolean
If hJournalHook = 0 Then hJournalHook = SetWindowsHookEx(WH_JOURNA
If hAppHook = 0 Then hAppHook = SetWindowsHookEx(WH_GETMES
SetHook = True
End Function
Public Sub RemoveHook()
UnhookWindowsHookEx hAppHook
UnhookWindowsHookEx hJournalHook
End Sub
Private Sub Class_Initialize()
SHptr = ObjPtr(Me)
End Sub
Private Sub Class_Terminate()
If hJournalHook Or hAppHook Then RemoveHook
End Sub
Public Function FireEvent(ByVal lParam As Long)
Dim i%, j%, k%
Dim s As String
If lParam = WM_CANCELJOURNAL Then
hJournalHook = 0
SetHook
Exit Function
End If
CopyMemory EMSG, ByVal lParam, Len(EMSG)
Select Case EMSG.wMsg
Case WM_KEYDOWN
j = 0
If GetAsyncKeyState(vbKeyShif
If GetAsyncKeyState(vbKeyCont
If GetAsyncKeyState(vbKeyMenu
s = Hex(EMSG.lParamLow)
k = (EMSG.lParamLow And &HFF)
RaiseEvent KeyDown(k, j)
s = Left$(s, 2) & Right$("00" & Hex(k), 2)
EMSG.lParamLow = CLng("&h" & s)
CopyMemory ByVal lParam, EMSG, Len(EMSG)
Case WM_KEYUP
j = 0
If GetAsyncKeyState(vbKeyShif
If GetAsyncKeyState(vbKeyCont
If GetAsyncKeyState(vbKeyMenu
s = Hex(EMSG.lParamLow)
k = (EMSG.lParamLow And &HFF)
RaiseEvent KeyUp(k, j)
s = Left$(s, 2) & Right$("00" & Hex(k), 2)
EMSG.lParamLow = CLng("&h" & s)
CopyMemory ByVal lParam, EMSG, Len(EMSG)
Case WM_MOUSEMOVE
i = 0
If GetAsyncKeyState(vbKeyLBut
If GetAsyncKeyState(vbKeyRBut
If GetAsyncKeyState(vbKeyMBut
j = 0
If GetAsyncKeyState(vbKeyShif
If GetAsyncKeyState(vbKeyCont
If GetAsyncKeyState(vbKeyMenu
RaiseEvent MouseMove(i, j, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))
Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN
i = 0
If GetAsyncKeyState(vbKeyShif
If GetAsyncKeyState(vbKeyCont
If GetAsyncKeyState(vbKeyMenu
RaiseEvent MouseDown(2 ^ ((EMSG.wMsg - 513) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))
Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP
i = 0
If GetAsyncKeyState(vbKeyShif
If GetAsyncKeyState(vbKeyCont
If GetAsyncKeyState(vbKeyMenu
RaiseEvent MouseUp(2 ^ ((EMSG.wMsg - 514) / 3), i, CSng(EMSG.lParamLow), CSng(EMSG.lParamHigh))
Case WM_SYSTEMKEYDOWN
s = Hex(EMSG.lParamLow)
k = (EMSG.lParamLow And &HFF)
If k <> vbKeyMenu Then RaiseEvent SystemKeyDown(k)
s = Left$(s, 2) & Right$("00" & Hex(k), 2)
EMSG.lParamLow = CLng("&h" & s)
CopyMemory ByVal lParam, EMSG, Len(EMSG)
Case WM_SYSTEMKEYUP
s = Hex(EMSG.lParamLow)
k = (EMSG.lParamLow And &HFF)
If k <> vbKeyMenu Then RaiseEvent SystemKeyUp(k)
s = Left$(s, 2) & Right$("00" & Hex(k), 2)
EMSG.lParamLow = CLng("&h" & s)
CopyMemory ByVal lParam, EMSG, Len(EMSG)
Case Else
End Select
End Function
'=======End Class module code=====
How to use:
'=======Form code=======
Dim WithEvents sh As cSystemHook
Private Sub sh_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim sText As String
Select Case Button
Case vbLeftButton: sText = "Left"
Case vbMiddleButton: sText = "Middle"
Case vbRightButton: sText = "Right"
Case Else
End Select
Debug.Print sText & " mouse button down at position " & x & ", " & y
End Sub
Private Sub sh_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim sText As String
Select Case Button
Case vbLeftButton: sText = "Left"
Case vbMiddleButton: sText = "Middle"
Case vbRightButton: sText = "Right"
Case Else
End Select
Debug.Print sText & " mouse button up at position " & x & ", " & y
End Sub
'Note: you can remove all Keyboard staff from class module, if you don't need it.
Cheers
ASKER
Thanks a lot! I just found your source the other day, and got it working.
However, thanks for helping me out even after you got your points.
-Sam
However, thanks for helping me out even after you got your points.
-Sam
ASKER
I just need to know when the mouse button is unpressed.. Or I could do a timer to check to see if the button is pressed at all.
-Sam