Mouse Routine

[Pete]

For word Processing we need a mouse that can handle double and triple clicks, along with drag, right click, the mouse wheel, and we'll throw in middle clicks because I'm fresh out of kitchen sinks...

Code: (Select All)

Type mousevar
    mx As Integer ' Row.
    my As Integer ' Column.
    wh As Integer ' Wheel.
    lb_status As Integer ' Left Button Status.
    rb_status As Integer ' Right Button Status.
    mb_status As Integer ' Middle Button Status.
    click As Integer ' Number of timed left button clicks.
    CursorStyle As Integer ' 0 Default, 1 Link style. (Hand).
    mousekey As String ' Auto Keyboard Input.
End Type
Dim m As mousevar
 
i = 3: j = 1: a$ = "None" ' Seed.
Do
    _Limit 60
    ' Demo portion...
    If j > 80 Then i = i + 1: j = 1: If i > 24 Then End
    Select Case m.click
        Case 1: a$ = "Single": If m.lb_status = 2 Then a$ = "Drag"
        Case 2: a$ = "Double"
        Case 3: a$ = "Triple"
    End Select
    Select Case m.wh
        Case 0: b$ = "--"
        Case 1: b$ = "Dn"
        Case -1: b$ = "Up"
    End Select
    Locate 1, 3: Print "Row:"; m.my;: Locate 1, 11: Print "Col:"; m.mx;
    Locate 1, 23: Print "Lt:"; m.lb_status; "  Rt:"; m.rb_status; "  Md:"; m.mb_status; "  Whl: "; b$; "  Last Left Click: "; a$; "  ";
 
    mouse m
Loop
 
Sub mouse (m As mousevar)
    ' Local vars: i%, j%, k%, button_active, button_status
    Static As Integer oldmx, oldmy, button_active, last_active, button_status
    Static As Long mtimer
    If m.wh Then m.wh = 0
    While _MouseInput
        m.wh = m.wh + _MouseWheel
    Wend
    m.mx = _MouseX
    m.my = _MouseY
    i% = _MouseButton(1)
    j% = _MouseButton(2)
    k% = _MouseButton(3)
    If i% And button_active = 0 Then
        button_active = 1 ' Left button pressed.
    ElseIf j% And button_active = 0 Then
        button_active = 2 ' Right button pressed.
    ElseIf k% And button_active = 0 Then
        button_active = 3 ' Middle button pressed.
    ElseIf button_active And i% + j% + k% = 0 Then
        button_active = 0
    End If
    Select Case button_active
        Case 0
            Select Case button_status
                Case -2
                    button_status = 0 ' The clicked event and the release triggered any event structured to occur on release.
                Case -1
                    button_status = -2 ' The clicked event triggered any event structured to occur when the button is released.
                Case 0
                    ' Button has not been pressed yet.
                Case 1
                    button_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.
                Case 2
                    button_status = -2 ' The drag event is over because the button was released.
            End Select
        Case Else
            Select Case button_status ' Note drag is determined in the text highlighting routine.
                Case -1
                    ' An event occurred and the button is still down.
                    If button_active = 1 Then ' Only left button for drag events.
                        If oldmx <> m.mx Or oldmy <> m.my Then
                            button_status = 2 ' Drag.
                        End If
                    End If
                Case 0
                    button_status = 1 ' Button just pressed.
                    If m.click = 0 And button_active = 1 Then
                        mtimer = Timer + .75
                        If mtimer > 86400 Then mtimer = mtimer - 86400 ' Midnight correction.
                    End If
                    m.click = Abs(m.click) + 1
                Case 1
                    button_status = -1 ' The button is down and triggered any event structured to occur on initial press.  The status will remain -1 as long as the button is depressed.
            End Select
    End Select
    m.lb_status = 0: m.rb_status = 0: m.mb_status = 0
    Select Case button_active
        Case 0
            Select Case last_active
                Case 1: m.lb_status = button_status
                Case 2: m.rb_status = button_status
                Case 3: m.mb_status = button_status
            End Select
        Case 1 ' Left
            m.lb_status = button_status
            If Abs(m.click) And button_status < 1 Then m.click = -Abs(m.click) Else m.click = Abs(m.click)
        Case 2 ' Right
            m.rb_status = button_status
        Case 3 ' Middle
            m.mb_status = button_status
    End Select
    If Timer > mtimer Then m.click = 0
    oldmx = m.mx: oldmy = m.my: last_active = button_active
End Sub

[TerryRitchie]

Oh, so close!

should be

TYPE mousevarmint

missed opportunity

[bplus]

+1 jeez! i am awed by complexity triple clicks

just one thing what if, when dragging mouse I want mouse down coordinates PLUS mouse up coordinates, i need that often say in a chess game.

[Pete]

Oh, so close!

should be

TYPE mousevarmint

missed opportunity

And you guys waz all ah thinkin the things whizzin past Terry's aveetar wer stars. Them's my bullets, varmints!

 - Sam

[Pete]

@bplus

Thanks! The routine does take into account vertical as well as horizontal drag movement, but maybe I'm not understanding your question correctly. Let's apply the mouse routine to a cheap-ASCII chess example. I made CHR$(219) a queen and lets drag her all around SCREEN 0!

Code: (Select All)

Type mousevar
    mx As Integer ' Row.
    my As Integer ' Column.
    wh As Integer ' Wheel.
    lb_status As Integer ' Left Button Status.
    rb_status As Integer ' Right Button Status.
    mb_status As Integer ' Middle Button Status.
    click As Integer ' Number of timed left button clicks.
    CursorStyle As Integer ' 0 Default, 1 Link style. (Hand).
    mousekey As String ' Auto Keyboard Input.
End Type
Dim m As mousevar
 
i = 3: j = 1: a$ = "None" ' Seed.
piece_y = _Height \ 2: piece_x = _Width \ 2
Locate piece_y, piece_x: Print Chr$(219);
Do
    _Limit 60
    If j > 80 Then i = i + 1: j = 1: If i > 24 Then End
    Select Case m.click
        Case 1: a$ = "Single": If m.lb_status = 2 Then a$ = "Drag"
        Case 2: a$ = "Double"
        Case 3: a$ = "Triple"
    End Select
    Select Case m.wh
        Case 0: b$ = "--"
        Case 1: b$ = "Dn"
        Case -1: b$ = "Up"
    End Select
    Locate 1, 3: Print "Row:"; m.my;: Locate 1, 11: Print "Col:"; m.mx;
    Locate 1, 23: Print "Lt:"; m.lb_status; "  Rt:"; m.rb_status; "  Md:"; m.mb_status; "  Whl: "; b$; "  Last Left Click: "; a$; "  ";
 
    mouse m
 
    If m.my = piece_y And m.mx = piece_x Then
        _MouseShow "LINK"
    Else
        If mb.lb_status <> 2 Then _MouseShow "DEFAULT"
    End If
    Select Case m.lb_status
        Case 1
            If m.my = piece_y And m.mx = piece_x Then move = 1
        Case 2
            If move Then ' Drag.
                Locate piece_y, piece_x: Print " ";
                Locate m.my, m.mx: Print Chr$(219);
                piece_y = m.my: piece_x = m.mx
            End If
        Case -2
            move = 0 ' Button released. Drag event over.
    End Select
Loop
Sub mouse (m As mousevar)
    ' Local vars: i%, j%, k%, button_active, button_status
    Static As Integer oldmx, oldmy, button_active, last_active, button_status
    Static As Long mtimer
    If m.wh Then m.wh = 0
    While _MouseInput
        m.wh = m.wh + _MouseWheel
    Wend
    m.mx = _MouseX
    m.my = _MouseY
    i% = _MouseButton(1)
    j% = _MouseButton(2)
    k% = _MouseButton(3)
    If i% And button_active = 0 Then
        button_active = 1 ' Left button pressed.
    ElseIf j% And button_active = 0 Then
        button_active = 2 ' Right button pressed.
    ElseIf k% And button_active = 0 Then
        button_active = 3 ' Middle button pressed.
    ElseIf button_active And i% + j% + k% = 0 Then
        button_active = 0
    End If
    Select Case button_active
        Case 0
            Select Case button_status
                Case -2
                    button_status = 0 ' The clicked event and the release triggered any event structured to occur on release.
                Case -1
                    button_status = -2 ' The clicked event triggered any event structured to occur when the button is released.
                Case 0
                    ' Button has not been pressed yet.
                Case 1
                    button_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.
                Case 2
                    button_status = -2 ' The drag event is over because the button was released.
            End Select
        Case Else
            Select Case button_status ' Note drag is determined in the text highlighting routine.
                Case -1
                    ' An event occurred and the button is still down.
                    If button_active = 1 Then ' Only left button for drag events.
                        If oldmx <> m.mx Or oldmy <> m.my Then
                            button_status = 2 ' Drag.
                        End If
                    End If
                Case 0
                    button_status = 1 ' Button just pressed.
                    If m.click = 0 And button_active = 1 Then
                        mtimer = Timer + .75
                        If mtimer > 86400 Then mtimer = mtimer - 86400 ' Midnight correction.
                    End If
                    m.click = Abs(m.click) + 1
                Case 1
                    button_status = -1 ' The button is down and triggered any event structured to occur on initial press.  The status will remain -1 as long as the button is depressed.
            End Select
    End Select
    m.lb_status = 0: m.rb_status = 0: m.mb_status = 0 ' Left button was released so drag is over.
    Select Case button_active
        Case 0
            Select Case last_active
                Case 1: m.lb_status = button_status
                Case 2: m.rb_status = button_status
                Case 3: m.mb_status = button_status
            End Select
        Case 1 ' Left
            m.lb_status = button_status
            If Abs(m.click) And button_status < 1 Then m.click = -Abs(m.click) Else m.click = Abs(m.click)
        Case 2 ' Right
            m.rb_status = button_status
        Case 3 ' Middle
            m.mb_status = button_status
    End Select
    If Timer > mtimer Then m.click = 0
    oldmx = m.mx: oldmy = m.my: last_active = button_active
End Sub

I know, I miss the days when CHR$(219) was a king, but now it's a drag queen, oh well.

Pete

[bplus]

+1 thanks for demo, a different aproach than i was thinking but could work. would have get practiced in using this method.

luv it when mouse image goes to hand when moving/dragging!

[James D Jarvis]

Cool. What would code for scrolling a selected queen look like ? (Asking for a lazy friend).

[Pete]

Cool. What would code for scrolling a selected queen look like ? (Asking for a lazy friend).

For an ASCII chess board, with simple letters representing the pieces, the "Q" for queen would be moved with the same code used to move the CHR$(19) block in the previous example. Now for graphics, it's more complicated. A range is needed to detect the chess piece and there is masking involved to go along with the movement. You might want to look up the graphic Chess Board by TheBOB in the Prolific Programmers section. I believe he has a mouse routine to move the pieces.

Pete

[eoredson]

I have recently wrote this mouse function which supports
 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