+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Utilities (https://qb64phoenix.com/forum/forumdisplay.php?fid=8)
+---- Thread: Mouse Routine (/showthread.php?tid=2631)
Mouse Routine - Pete - 04-28-2024
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 SubRE: Mouse Routine - TerryRitchie - 04-28-2024
Oh, so close!
should be
TYPE mousevarmint
missed opportunity
RE: Mouse Routine - bplus - 04-28-2024
+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.
RE: Mouse Routine - Pete - 04-28-2024
(04-28-2024, 12:54 PM)TerryRitchie Wrote: 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
RE: Mouse Routine - Pete - 04-28-2024
@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 SubI know, I miss the days when CHR$(219) was a king, but now it's a drag queen, oh well.
Pete
RE: Mouse Routine - bplus - 04-28-2024
+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!
RE: Mouse Routine - James D Jarvis - 04-28-2024
Cool. What would code for scrolling a selected queen look like ? (Asking for a lazy friend).
RE: Mouse Routine - Pete - 04-30-2024
(04-28-2024, 07:39 PM)James D Jarvis Wrote: 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
RE: Mouse Routine - eoredson - 05-13-2024
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