+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: Yet another mouse function (/showthread.php?tid=2073)
Yet another mouse function - eoredson - 10-09-2023
Hi,
I know mouse drivers and functions have been discussed 100 times but I am posting this mouse program because I wrote it myself and might be of some use.
It is not an issue or am I declaring any problem.
Erik
Code: (Select All)
Rem Mouse.bas is the sample mouse trap function for QB64 PD 2023.
DefLng A-Z
Dim Shared MouseX As Integer, MouseY As Integer
Dim Shared MouseButton1 As Integer, MouseButton2 As Integer, MouseButton3 As Integer
Dim Shared MouseWheel As Integer, WheelReverse As Integer
Const ClickCount = 10 ' double click loop counter
Const ClickDelay = .1 ' double click loop delay
Color 15
Print "Mouse detect. Press <esc> to exit."
If WheelReverse Then
Print " Mouse wheel reverse on."
End If
Do
x$ = InKey$
If x$ = Chr$(27) Then Exit Do
x = MouseDriver
If MouseButton1 = 2 Then
Print "Double-Button1": MouseButton1 = 0
Else
If MouseButton1 = 1 Then
Print "Button1": MouseButton1 = 0
End If
End If
If MouseButton2 Then MouseButton2 = 0: Print "Button2"
If MouseButton3 Then MouseButton3 = 0: Print "Button3"
If MouseX Or MouseY Then Print "Coor:"; MouseX; MouseY
If MouseWheel Then
If MouseWheel = -1 Then
Print "Mousewheel Up"
End If
If MouseWheel = 1 Then
Print "Mousewheel Down"
End If
End If
Loop
End
Function MouseDriver
Static X1 As Integer, Y1 As Integer ' store old values
MouseX = 0: MouseY = 0
If _MouseInput Then
X = CInt(_MouseX): Y = CInt(_MouseY) ' X,Y return single
If X <> X1 Or Y <> Y1 Then
X1 = X: Y1 = Y
MouseX = Y: MouseY = X ' X,Y are reversed
While _MouseInput: Wend ' empty buffer
MousePressed = -1
End If
MouseButton1 = _MouseButton(1)
If MouseButton1 Then
MouseButton1 = 1
'MouseX = Y1
'MouseY = X1
MousePressed = -1
MouseCount = 0
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(1) Then
MouseButton1 = 2
Exit Do
End If
End If
Loop
End If
MouseButton2 = _MouseButton(2)
If MouseButton2 Then
'MouseX = Y1
'MouseY = X1
MousePressed = -1
End If
MouseButton3 = _MouseButton(3)
If MouseButton3 Then
MousePressed = -1
End If
MouseWheel = _MouseWheel
If MouseWheel Then
' reverse mousewheel value
If WheelReverse Then
If MouseWheel = -1 Then
MouseWheel = 1
Else
If MouseWheel = 1 Then
MouseWheel = -1
End If
End If
End If
End If
End If
MouseDriver = -1
End FunctionRE: Yet another mouse function - eoredson - 10-09-2023
Same mouse program but with Triple-Click:
Code: (Select All)
Rem Mouse.bas is the sample mouse trap function for QB64 PD 2023.
DefLng A-Z
Dim Shared MouseX As Integer, MouseY As Integer
Dim Shared MouseButton1 As Integer, MouseButton2 As Integer, MouseButton3 As Integer
Dim Shared MouseWheel As Integer, WheelReverse As Integer
Const ClickCount = 10 ' double click loop counter
Const ClickDelay = .1 ' double click loop delay
Color 15
Print "Mouse detect. Press <esc> to exit."
If WheelReverse Then
Print " Mouse wheel reverse on."
End If
Do
x$ = InKey$
If x$ = Chr$(27) Then Exit Do
x = MouseDriver
If MouseButton1 = 3 Then
Print "Triple-Button1": MouseButton1 = 0
Else
If MouseButton1 = 2 Then
Print "Double-Button1": MouseButton1 = 0
Else
If MouseButton1 = 1 Then
Print "Button1": MouseButton1 = 0
End If
End If
End If
If MouseButton2 Then MouseButton2 = 0: Print "Button2"
If MouseButton3 Then MouseButton3 = 0: Print "Button3"
If MouseX Or MouseY Then Print "Coor:"; MouseX; MouseY
If MouseWheel Then
If MouseWheel = -1 Then
Print "Mousewheel Up"
End If
If MouseWheel = 1 Then
Print "Mousewheel Down"
End If
End If
Loop
End
Function MouseDriver
Static X1 As Integer, Y1 As Integer ' store old values
MouseX = 0: MouseY = 0
If _MouseInput Then
X = CInt(_MouseX): Y = CInt(_MouseY) ' X,Y return single
If X <> X1 Or Y <> Y1 Then
X1 = X: Y1 = Y
MouseX = Y: MouseY = X ' X,Y are reversed
While _MouseInput: Wend ' empty buffer
MousePressed = -1
End If
' single click
MouseButton1 = _MouseButton(1)
If MouseButton1 Then
MouseButton1 = 1
'MouseX = Y1
'MouseY = X1
MousePressed = -1
MouseCount = 0
' double click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(1) Then
MouseButton1 = 2
MouseCount = 0
' triple click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(1) Then
MouseButton1 = 3
Exit Function
End If
End If
Loop
End If
End If
Loop
End If
MouseButton2 = _MouseButton(2)
If MouseButton2 Then
'MouseX = Y1
'MouseY = X1
MousePressed = -1
End If
MouseButton3 = _MouseButton(3)
If MouseButton3 Then
MousePressed = -1
End If
MouseWheel = _MouseWheel
If MouseWheel Then
' reverse mousewheel value
If WheelReverse Then
If MouseWheel = -1 Then
MouseWheel = 1
Else
If MouseWheel = 1 Then
MouseWheel = -1
End If
End If
End If
End If
End If
MouseDriver = -1
End FunctionAnd, yes, you could probably add a Quad-Click or double-right click. But an nth click would result in an endless timer loop.
RE: Yet another mouse function - eoredson - 10-09-2023
In the final stage of a mouse function the following has been written:
Includes quad-click for all 3 buttons:
Code: (Select All)
Rem Mouse.bas is the sample mouse trap function for QB64 PD 2023.
DefLng A-Z
Dim Shared MouseX As Integer, MouseY As Integer
Dim Shared MouseButton1 As Integer, MouseButton2 As Integer, MouseButton3 As Integer
Dim Shared MouseWheel As Integer, WheelReverse As Integer
WheelReverse = 0
Const ClickCount = 10 ' double click loop counter
Const ClickDelay = .1 ' double click loop delay
Color 15
Print "Mouse detect. Press <esc> to exit."
If WheelReverse Then
Print " Mouse wheel reverse on."
End If
Do
x$ = InKey$
If x$ = Chr$(27) Then Exit Do
x = MouseDriver
Select Case MouseButton1
Case 4
Print "Quad-Button1": MouseButton1 = 0
Case 3
Print "Triple-Button1": MouseButton1 = 0
Case 2
Print "Double-Button1": MouseButton1 = 0
Case 1
Print "Button1": MouseButton1 = 0
End Select
Select Case MouseButton2
Case 4
Print "Quad-Button2": MouseButton2 = 0
Case 3
Print "Triple-Button2": MouseButton2 = 0
Case 2
Print "Double-Button2": MouseButton2 = 0
Case 1
Print "Button2": MouseButton2 = 0
End Select
Select Case MouseButton3
Case 4
Print "Quad-Button3": MouseButton3 = 0
Case 3
Print "Triple-Button3": MouseButton3 = 0
Case 2
Print "Double-Button3": MouseButton3 = 0
Case 1
Print "Button3": MouseButton3 = 0
End Select
If MouseX Or MouseY Then Print "Coor:"; MouseX; MouseY
If MouseWheel Then
If MouseWheel = -1 Then
Print "Mousewheel Up"
End If
If MouseWheel = 1 Then
Print "Mousewheel Down"
End If
End If
Loop
End
Function MouseDriver
Static X1 As Integer, Y1 As Integer ' store old values
MouseX = 0: MouseY = 0
If _MouseInput Then
X = CInt(_MouseX): Y = CInt(_MouseY) ' X,Y return single
If X <> X1 Or Y <> Y1 Then
X1 = X: Y1 = Y
MouseX = Y: MouseY = X ' X,Y are reversed
While _MouseInput: Wend ' empty buffer
MousePressed = -1
End If
' single click
MouseButton1 = _MouseButton(1)
If MouseButton1 Then
MouseButton1 = 1
MousePressed = -1
MouseCount = 0
' double click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(1) Then
MouseButton1 = 2
MouseCount = 0
' triple click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(1) Then
MouseButton1 = 3
MouseCount = 0
' quad click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(1) Then
MouseButton1 = 4
Exit Function
End If
End If
Loop
End If
End If
Loop
End If
End If
Loop
End If
' single click
MouseButton2 = _MouseButton(2)
If MouseButton2 Then
MouseButton2 = 1
MousePressed = -1
MouseCount = 0
' double click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(2) Then
MouseButton2 = 2
MouseCount = 0
' triple click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(2) Then
MouseButton2 = 3
MouseCount = 0
' quad click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(2) Then
MouseButton2 = 4
Exit Function
End If
End If
Loop
End If
End If
Loop
End If
End If
Loop
End If
' single click
MouseButton3 = _MouseButton(3)
If MouseButton3 Then
MouseButton3 = 1
MousePressed = -1
MouseCount = 0
' double click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(3) Then
MouseButton3 = 2
MouseCount = 0
' triple click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(3) Then
MouseButton3 = 3
MouseCount = 0
' quad click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(3) Then
MouseButton3 = 4
Exit Function
End If
End If
Loop
End If
End If
Loop
End If
End If
Loop
End If
MouseWheel = _MouseWheel
If MouseWheel Then
' reverse mousewheel value
If WheelReverse Then
If MouseWheel = -1 Then
MouseWheel = 1
Else
If MouseWheel = 1 Then
MouseWheel = -1
End If
End If
End If
End If
End If
MouseDriver = -1
End FunctionRE: Yet another mouse function - grymmjack - 10-09-2023
Thank you for sharing! I think it's a handy thing you've made.
Question - does it handle middle click?
RE: Yet another mouse function - eoredson - 10-09-2023
(10-09-2023, 06:54 PM)grymmjack Wrote: Thank you for sharing! I think it's a handy thing you've made.
Question - does it handle middle click?
Yes. As Button3 and with double/triple/quad click..
Erik.
RE: Yet another mouse function - grymmjack - 10-10-2023
(10-09-2023, 11:40 PM)eoredson Wrote:(10-09-2023, 06:54 PM)grymmjack Wrote: Thank you for sharing! I think it's a handy thing you've made.
Question - does it handle middle click?
Yes. As Button3 and with double/triple/quad click..
Erik.
Awesome
RE: Yet another mouse function - SMcNeill - 10-10-2023
Might also want to take a look at this mouse routine. It may give you some ideas for your own.
https://qb64phoenix.com/forum/showthread.php?tid=138
RE: Yet another mouse function - eoredson - 10-10-2023
(10-10-2023, 01:07 AM)SMcNeill Wrote: Might also want to take a look at this mouse routine. It may give you some ideas for your own.
https://qb64phoenix.com/forum/showthread.php?tid=138
Interesting. Your code seems to be of a similar technique as mine with a different style.
I would actually have some use to press/held though.
Erik.
RE: Yet another mouse function - eoredson - 10-10-2023
This code from the Wiki declares the 3 mouse buttons and 512 keyboard buttons:
Code: (Select All)
Rem Mouse.bas is the sample mouse trap function for QB64 PD 2023.
DefLng A-Z
Rem $Dynamic
Dim Shared MouseX As Integer, MouseY As Integer
Dim Shared MouseWheel As Integer, WheelReverse As Integer, MaxMouseButtons As Integer
Dim Shared MouseButtons(10) As Integer, MousePressed As Integer
WheelReverse = 0
Const ClickCount = 10 ' double click loop counter
Const ClickDelay = .1 ' double click loop delay
Color 15
Print "Mouse detect. Press <esc> to exit."
If WheelReverse Then
Print " Mouse wheel reverse on."
End If
devices = _Devices 'MUST be read in order for other 2 device functions to work!
Print "Number of input devices found ="; devices
For i = 1 To devices
Print "Device#"; i; " "; _Device$(i); "Buttons:"; _LastButton(i)
If Left$(_Device$(i), 7) = "[MOUSE]" Then ' mouse
MaxMouseButtons = _LastButton(i)
End If
Next
x = MouseClear
Do
x$ = InKey$
If x$ = Chr$(27) Then Exit Do
x = MouseDriver
For m = 1 To MaxMouseButtons
Select Case MouseButtons(m)
Case 1
Print "Button"; m
Case 2
Print "Double-Button"; m
Case 3
Print "Triple-Button"; m
Case 4
Print "Quad-Button"; m
Case 5
Print "Quint-Button"; m
End Select
Next
If MouseX Or MouseY Then Print "Coor:"; MouseX; MouseY
If MouseWheel Then
If MouseWheel = -1 Then
MouseWheelUp = MouseWheelUp + 1
Print "Mousewheel Up"; MouseWheelUp
End If
If MouseWheel = 1 Then
MouseWheelDown = MouseWheelDown + 1
Print "Mousewheel Down"; MouseWheelDown
End If
End If
Loop
End
Function MouseDriver
Static X1 As Integer, Y1 As Integer ' store old values
MouseX = 0: MouseY = 0
For M = 1 To MaxMouseButtons
MouseButtons(M) = 0
Next
If _MouseInput Then
X = CInt(_MouseX): Y = CInt(_MouseY) ' X,Y return single
If X <> X1 Or Y <> Y1 Then
X1 = X: Y1 = Y
MouseX = Y: MouseY = X ' X,Y are reversed
N = MouseClear ' empty buffer
MousePressed = -1
End If
' loop through all mouse buttons
For M = 1 To MaxMouseButtons
' single click
MouseButtonX = _MouseButton(M)
If MouseButtonX Then
MouseButtons(M) = 1
MousePressed = -1
MouseCount = 0
X = MouseClear
' double click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(M) Then
MouseButtons(M) = 2
MouseCount = 0
X = MouseClear
' triple click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(M) Then
MouseButtons(M) = 3
MouseCount = 0
X = MouseClear
' quad click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(M) Then
MouseButtons(M) = 4
MouseCount = 0
' quint click
Do
_Delay ClickDelay
MouseCount = MouseCount + 1
If MouseCount >= ClickCount Then Exit Do
If _MouseInput Then
If _MouseButton(M) Then
MouseButtons(M) = 5
Exit Function
End If
End If
Loop
End If
End If
Loop
End If
End If
Loop
End If
End If
Loop
End If
MouseWheel = _MouseWheel
If MouseWheel Then
' reverse mousewheel value
If WheelReverse Then
If MouseWheel = -1 Then
MouseWheel = 1
Else
If MouseWheel = 1 Then
MouseWheel = -1
End If
End If
End If
End If
Next
End If
MouseDriver = -1
End Function
Function MouseClear
While _MouseInput: Wend
MouseClear = -1
End Function