In the final stage of a mouse function the following has been written:
Includes quad-click for all 3 buttons:
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 Function