+- 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: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: Updating my mouse and keyboard routine. (/showthread.php?tid=3402)
Updating my mouse and keyboard routine. - Pete - 01-21-2025
I thought I'd put this in a demo for @bplus to have a look at the mouse function. I want to add my other mapping routine as an option. This one uses arrays. Basically my goal is to pack as many methods and actions as I use in many of my apps into this one subroutine, if possible.
Demo: Press keys, hold keys like ctrl, click mouse, use wheel, hover/click buttons, drag, etc.
Code: (Select All)
ReDim Shared y_btl(2), y_bbr(2), x_btl(2), x_bbr(2), button$(2)
nob = 2
Color 15, 1
If mapping = 0 Then
Locate 10, 50: y_btl(1) = CsrLin: x_btl(1) = Pos(0): Print Chr$(218) + String$(10, 196) + Chr$(191)
Locate 11, 50: Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179);
Locate 12, 50: Print Chr$(192) + String$(10, 196) + Chr$(217);: y_bbr(1) = CsrLin: x_bbr(1) = Pos(0) - 1
button$(1) = " Button 1 "
Locate 11, 51: Print " Button 1 ";
Locate 10, 65: y_btl(2) = CsrLin: x_btl(2) = Pos(0): Print Chr$(218) + String$(10, 196) + Chr$(191)
Locate 11, 65: Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179);
Locate 12, 65: Print Chr$(192) + String$(10, 196) + Chr$(217);: y_bbr(2) = CsrLin: x_bbr(2) = Pos(0) - 1
button$(2) = " Button 2 "
Locate 11, 66: Print " Button 2 ";
Else
Locate 10, 50: Print Chr$(218) + String$(10, 196) + Chr$(191)
Locate 11, 50: Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179);
button$(1) = " Button 1 "
Locate 12, 50: Print Chr$(192) + String$(10, 196) + Chr$(217)
Locate 11, 51: Print " Button 1 ";
Locate 10, 65: Print Chr$(218) + String$(10, 196) + Chr$(191)
Locate 11, 65: Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179);
Locate 12, 65: Print Chr$(192) + String$(10, 196) + Chr$(217)
button$(2) = " Button 2 "
Locate 11, 66: Print " Button 2 ";
End If
PCopy 0, 1
Color 7, 0
Locate 1, 1
Do
MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, alt, AltToggle, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$, nob, button$()
If drag Then
If olddrag <> drag Then
If drag > 0 Then Print "Drag Right. Status ="; Else Print "Drag Left. Status = ";
Print drag
olddrag = drag
End If
Else
olddrag = 0
End If
If oldlb <> lb Then
Select Case lb
Case 0: Print "Left Button Up - Button Status ="; lb
Case -1: Print "Left Button Down - Button Status = "; lb
Case 1: Print "Left Button Pressed - Button Status ="; lb
Case 2: Print "Left Button Released - Button Status ="; lb
End Select
If lb = 0 Then Print "Number of clicks ="; clkcnt
End If
If oldmb <> mb Then
Select Case mb
Case 0: Print "Middle Button Up - Button Status ="; mb
Case -1: Print "Middle Button Down - Button Status = "; mb
Case 1: Print "Middle Button Pressed - Button Status ="; mb
Case 2: Print "Middle Button Released - Button Status ="; mb
End Select
End If
If oldrb <> rb Then
Select Case rb
Case 0: Print "Right Button Up - Button Status ="; rb
Case -1: Print "Right Button Down - Button Status = "; rb
Case 1: Print "Right Button Pressed - Button Status ="; rb
Case 2: Print "Right Button Released - Button Status ="; rb
End Select
End If
If oldmw <> mw Then
If mw < 0 Then Print "Mouse Wheel Up - Wheel Status ="; mw
If mw > 0 Then Print "Mouse Wheel Down - Wheel Status ="; mw
End If
If oldalt% <> alt% Then
If alt% < 0 Then Print "Alt Button Down" Else Print "Alt Button Released"
End If
If oldctrl% <> ctrl% Then
If ctrl% < 0 Then Print "Ctrl Button Down" Else Print "Ctrl Button Released"
End If
If oldshift% <> shift% Then
If shift% < 0 Then Print "Shift Button Down" Else Print "Shift Button Released"
End If
If oldalt <> alt And alt < 0 Then
Print "Alt Key Pressed";
If AltToggle Then Print " / Alt Toggle Status: On" Else Print " / Alt Toggle Status: Off"
End If
If k& < 0 Then oldb$ = ""
Select Case Len(b$)
Case 1
If oldb$ <> b$ Then Print "You Pressed: ";: x = CVI(MKI$(Asc(b$))): Print Chr$(x); " Chr$(" + LTrim$(Str$(x)) + ")"
oldb$ = b$
Case 2
If oldb$ <> b$ Then Print "You Pressed: "; "nul + " + LTrim$(Str$(Asc(Mid$(b$, 2, 1)))) + " Chr$(0) + " + Chr$(34) + Mid$(b$, 2, 1) + Chr$(34)
oldb$ = b$
End Select
oldlb = lb: oldrb = rb: oldmb = mb: oldmw = mw: oldalt% = alt%: oldctrl% = ctrl%: oldshift% = shift%: oldalt = alt
If CsrLin > _Height - 2 Then Cls: PCopy 1, 0
Loop
Sub MyMouse_and_Keyboard (lb, mb, rb, my, mx, mw, shift%, alt, AltToggle, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$, nob, button$())
Dim As Integer b_hover, i, oldmw
Static As Integer oldmy, oldmx, hover, mwy, oldmwy, b_active
Static z1 As Single
_Limit 60
If alt Then alt = 0
If Len(autokey$) Then
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
Exit Sub
Else
k& = _KeyHit
If k& = 100307 Or k& = 100308 Then
alt = -1
AltToggle = 1 - AltToggle
Exit Sub
End If
If k& > 0 Then
b$ = MKI$(k&)
If Mid$(b$, 2, 1) = Chr$(135) Then b$ = "" ' Keys like like Shift, Ctrl, and alt.
If Right$(b$, 1) = Chr$(0) Then b$ = Left$(b$, 1)
Else
b$ = ""
End If
End If
If z1 Then If Abs(Timer - z1) > .25 Then z1 = 0: clkcnt = 0
If lb > 0 Then
If lb = 1 Then
lb = -1
Else
lb = 0
End If
End If
If rb > 0 Then If rb = 1 Then rb = -1 Else rb = 0
If mb > 0 Then If mb = 1 Then mb = -1 Else mb = 0
While _MouseInput
mwy = mwy + _MouseWheel
Wend
my = _MouseY
mx = _MouseX
b_hover = 0
For i = 1 To nob ' number of buttons.
If my >= y_btl(i) And my <= y_bbr(i) And mx >= x_btl(i) And mx <= x_bbr(i) Then
b_hover = i
Exit For
End If
Next
If lb = -1 Then
If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then
If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.
End If
End If
If drag = 0 Then
If mwy <> oldmw Then
mw = Sgn(mwy - oldmwy): mwy = 0
Else
mw = 0
End If
oldmwy = mwy
If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1 Else If shift% Then shift% = 0
If _KeyDown(100305) Or _KeyDown(100306) Then ctrl% = -1 Else If ctrl% Then ctrl% = 0
If _KeyDown(100307) Or _KeyDown(100308) Then alt% = -1 Else If alt% Then alt% = 0
End If
If lb = -1 And _MouseButton(1) = 0 Then
lb = 2: drag = 0: hover = 0
ElseIf rb = -1 And _MouseButton(2) = 0 Then
rb = 2
ElseIf mb = -1 And _MouseButton(3) = 0 Then
mb = 2
End If
If _MouseButton(1) Then
If lb = 0 Then
lb = 1: z1 = Timer
clkcnt = clkcnt + 1
End If
ElseIf _MouseButton(2) And rb = 0 Then
rb = 1
ElseIf _MouseButton(3) And mb = 0 Then
mb = 1
End If
If b_active Then
If b_hover Then
If lb = 2 Then ' Button clicked. Flash effect.
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
For i = 1 To 2
If i = 1 Then Color 15, 1 Else Color 1, 3
Locate y_btl(b_active), x_btl(b_active): Print Chr$(218) + String$(10, 196) + Chr$(191)
Locate , x_btl(b_active): Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179)
Locate , x_btl(b_active): Print Chr$(192) + String$(10, 196) + Chr$(217);
Locate y_btl(b_active) + 1, x_btl(b_active) + 1: Print button$(b_active);
Color c1, c2
Locate s1, s2
_Delay .1
Next
End If
Else
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
Color 15, 1
Locate y_btl(b_active), x_btl(b_active): Print Chr$(218) + String$(10, 196) + Chr$(191)
Locate , x_btl(b_active): Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179)
Locate , x_btl(b_active): Print Chr$(192) + String$(10, 196) + Chr$(217);
Locate y_btl(b_active) + 1, x_btl(b_active) + 1: Print button$(b_active);
Color c1, c2
Locate s1, s2
b_active = 0
End If
Else
If b_hover And oldmy <> 0 Then
If b_active = 0 Then
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
Color 1, 3
Locate y_btl(b_hover), x_btl(b_hover): Print Chr$(218) + String$(10, 196) + Chr$(191)
Locate , x_btl(b_hover): Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179)
Locate , x_btl(b_hover): Print Chr$(192) + String$(10, 196) + Chr$(217);
Locate y_btl(b_hover) + 1, x_btl(b_hover) + 1: Print button$(b_hover);
Color c1, c2
Locate s1, s2
b_active = b_hover
End If
End If
End If
oldmy = my: oldmx = mx
End SubI'll probably switch to type variables before going any further.
Oh, since INKEY$ is very familiar to me, but I get a bit PISSED OFF now and then by its inability to detect press and release without adding a slightly imperfect coding workaround, I decided to migrate to _KEYHIT by using a _KEYHIT to INKEY$ conversion method. Lucky for me I migrated just before Inauguration day, or I might have HIT A WALL on that one!
Pete
RE: Updating my mouse and keyboard routine. - bplus - 01-21-2025
@Pete we must be on the same mind frequency (GHM), I just completed 2 Mouse routines last night that I am very happy with myself. I went to Steve's camp and learned about OldMouse. Turns out I had a copy of that, that has been sitting around for years, never got to study it as I did last night.
Yes, to incorp key catching also, or Not? That is a question not quite settled for me, yet. I see you are including.
It's good to be all inclusive, like Canada, Mexico, S America... then they are all US and no reason to build firewalls. How could we possibly make America greater???
If you can have only one tool, let it be a Swiss Army knife.
RE: Updating my mouse and keyboard routine. - Pete - 01-21-2025
I had a French Army knife once, but I had to give it up.
Pete
RE: Updating my mouse and keyboard routine. - Jack002 - 01-22-2025
![[Image: french-army-knife.jpg]](https://i.ibb.co/tLyN9Bh/french-army-knife.jpg)
RE: Updating my mouse and keyboard routine. - bplus - 01-22-2025
maybe I should post this in my own section
or maybe I should try to get this thread back on topic
here is my single blade knife for just getting a mouse click without backfire from not getting clear of mouse button release at next mouse poll or mouse catching missed because a single keydown was not responeded to fast enough and another detection (the same mouse down causes a reverse because my app is toggle a cell on or off. This is same situation that arose in dbox Play demo of Play.
Code: (Select All)
_Title "ClickTF test on grid" ' b+ 2025-01-20 test Steve mouse catch click with OldMouse check
Dim Shared As Long SW, SH
SW = 800: SH = 600
Screen _NewImage(SW, SH, 32): _ScreenMove 210, 60
sq = 100 ' cellsize in pixels 100x100 and xoffset and yoffset
cellsAcross = 6: CellsDown = 4
drawGrid sq, sq, sq, sq, cellsAcross, CellsDown ' OK
' now test clicking the cells
Do
If ClickTF%(mx, my) Then ' covert mx, my to a grid cell or say not in grid
gridx = mx \ sq: gridY = my \ sq
Locate 1, 1: Print Space$(500); ' clear line
Locate 1, 1: Print gridx; ","; gridY;
Print _IIf(gridx > 0 And gridx <= cellsAcross And gridY > 0 And gridY <= CellsDown, "inside", "outside");_
" the grid."
End If
Loop
Function ClickTF% (mx, my) ' where the mouse button goes down at NOT after any drag!
Static OldMouse: Dim mb
While _MouseInput: Wend ' there we've polled the mouse we don't need to remain inside the loop unless we need mouse wheel
mb = _MouseButton(1)
If mb And Not OldMouse Then
mx = _MouseX: my = _MouseY: ClickTF% = -1
End If
OldMouse = mb
End Function
Sub drawGrid (x, y, xs, ys, xn, yn) ' top left x, y, x side, y side, number of x, nmber of y
Dim As Long i, dx, dy
dx = xs * xn: dy = ys * yn
For i = 0 To xn
Line (x + xs * i, y)-(x + xs * i, y + dy)
Next
For i = 0 To yn
Line (x, y + ys * i)-(x + dx, y + ys * i)
Next
End SubA useful low LOC routine that is portable to many apps eg boards for editing graphics pixel by pixel or tile by tile, or games.
No more hacky! _Delay .25 yea!
RE: Updating my mouse and keyboard routine. - bplus - 01-22-2025
BTW @Pete double clicks from your demo seems like needs work.