I have recently wrote this mouse function which supports
Single-Click/Double-Click/Triple-Click/Quad-Click for
Left mouse/Middle mouse/Right mouse..
Single-Click/Double-Click/Triple-Click/Quad-Click for
Left mouse/Middle mouse/Right mouse..
Code: (Select All)
Rem Mouse.bas is the sample mouse trap function for QB64 PD 2024.
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, MaxMouseButtons 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 i = 2 Then ' mouse
MaxMouseButtons = _LastButton(2)
End If
Next
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 Function