Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Yet another mouse function
#9
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


Attached Files
.bas   mouse3.bas (Size: 5.24 KB / Downloads: 50)
Reply


Messages In This Thread
Yet another mouse function - by eoredson - 10-09-2023, 03:34 AM
RE: Yet another mouse function - by eoredson - 10-09-2023, 04:32 AM
RE: Yet another mouse function - by eoredson - 10-09-2023, 06:50 AM
RE: Yet another mouse function - by grymmjack - 10-09-2023, 06:54 PM
RE: Yet another mouse function - by eoredson - 10-09-2023, 11:40 PM
RE: Yet another mouse function - by grymmjack - 10-10-2023, 12:15 AM
RE: Yet another mouse function - by SMcNeill - 10-10-2023, 01:07 AM
RE: Yet another mouse function - by eoredson - 10-10-2023, 01:49 AM
RE: Yet another mouse function - by eoredson - 10-10-2023, 03:27 AM



Users browsing this thread: 9 Guest(s)