QB64 Phoenix Edition › QB64 Rising › Code and Stuff › Programs v
Yet another mouse function

Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Threaded Mode
Yet another mouse function
eoredson Offline
Cthulhu Lord
****
Posts: 369
Threads: 71
Joined: Jul 2022
Reputation: 14
#1
10-09-2023, 03:34 AM (This post was last modified: 10-09-2023, 07:10 AM by eoredson.)
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 Function


Attached Files
.bas   mouse.bas (Size: 7.18 KB / Downloads: 30)
DNDDOOR | DUNGEON | SICK | HexEditor | Utilities | QB64shell | DNDBBS
sych | mega | share | My Email
Website Find
Reply
eoredson Offline
Cthulhu Lord
****
Posts: 369
Threads: 71
Joined: Jul 2022
Reputation: 14
#2
10-09-2023, 04:32 AM (This post was last modified: 10-09-2023, 07:11 AM by eoredson.)
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 Function

And, yes, you could probably add a Quad-Click or double-right click. But an nth click would result in an endless timer loop.


Attached Files
.bas   mouse.bas (Size: 7.18 KB / Downloads: 43)
Website Find
Reply
eoredson Offline
Cthulhu Lord
****
Posts: 369
Threads: 71
Joined: Jul 2022
Reputation: 14
#3
10-09-2023, 06:50 AM (This post was last modified: 10-09-2023, 06:52 AM by eoredson.)
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 Function


Attached Files
.bas   mouse.bas (Size: 7.18 KB / Downloads: 39)
DNDDOOR | DUNGEON | SICK | HexEditor | Utilities | QB64shell | DNDBBS
sych | mega | share | My Email
Website Find
Reply
grymmjack Offline
a friendly old nerd
*******
Posts: 476
Threads: 25
Joined: Nov 2022
Reputation: 45
#4
10-09-2023, 06:54 PM
Thank you for sharing! I think it's a handy thing you've made.

Question - does it handle middle click?
grymmjack (gj!)
GitHub | YouTube | Soundcloud | 16colo.rs
Website Find
Reply
eoredson Offline
Cthulhu Lord
****
Posts: 369
Threads: 71
Joined: Jul 2022
Reputation: 14
#5
10-09-2023, 11:40 PM
(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.
Website Find
Reply
grymmjack Offline
a friendly old nerd
*******
Posts: 476
Threads: 25
Joined: Nov 2022
Reputation: 45
#6
10-10-2023, 12:15 AM
(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
grymmjack (gj!)
GitHub | YouTube | Soundcloud | 16colo.rs
Website Find
Reply
SMcNeill Offline
Super Moderator
******
Posts: 2,671
Threads: 324
Joined: Apr 2022
Reputation: 214
#7
10-10-2023, 01:07 AM
Might also want to take a look at this mouse routine.  It may give you some ideas for your own.  Wink

https://qb64phoenix.com/forum/showthread.php?tid=138
Website Find
Reply
eoredson Offline
Cthulhu Lord
****
Posts: 369
Threads: 71
Joined: Jul 2022
Reputation: 14
#8
10-10-2023, 01:49 AM
(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.  Wink

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.
Website Find
Reply
eoredson Offline
Cthulhu Lord
****
Posts: 369
Threads: 71
Joined: Jul 2022
Reputation: 14
#9
10-10-2023, 03:27 AM (This post was last modified: 10-13-2023, 05:03 AM by eoredson.)
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: 49)
Website Find
Reply




Users browsing this thread: 4 Guest(s)