+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: Chatting and Socializing (https://qb64phoenix.com/forum/forumdisplay.php?fid=11)
+--- Forum: General Discussion (https://qb64phoenix.com/forum/forumdisplay.php?fid=2)
+--- Thread: What do you guys like to use for mouse mapping? (/showthread.php?tid=3310)
What do you guys like to use for mouse mapping? - Pete - 12-21-2024
Arrays is one way to go, but I got used to using a non-array method many moons ago. (_|_)
Code: (Select All)
Locate 2
text$ = "Demo of mapping technique"
Print center$(text$)
text$ = "for mouse menu selection."
Print center$(text$)
_Delay 4
Print
text$ = "Watch as the program maps."
Print center$(text$)
text$ = "the menu at the bottom..."
Print center$(text$)
y = CsrLin: x = Pos(0)
a$ = "[F1] Help [F5] Save [Enter] Laugh at Steve [Esc] Quit"
Locate _Height, _Width \ 2 - Len(a$) \ 2 + 1: Print a$;
Locate _Height - 2, 1
For i = 1 To _Width ' Convert to width.
f$ = f$ + Chr$(Screen(_Height, i))
Next
_Delay 2: Color 8, 0
temp$ = " "
For i = 1 To Len(f$) ' Map mouse hot zones.
x$ = Mid$(f$, i, 1)
If hot Then
If Left$(LTrim$(Mid$(f$, i) + "["), 1) = "[" Then
hot = 1 - hot
temp$ = " "
End If
End If
If x$ <> Chr$(32) And hot = 0 Then
hot = 1 - hot
j = j + 1
temp$ = Chr$(96 + j)
End If
map$ = map$ + temp$
Print LTrim$(Str$(hot));: _Delay .1
Next
Locate _Height - 1, 1: Print map$;
Locate y, x
Color 7, 0
Print
text$ = "Now try the Mouse by clicking a"
Print center$(text$)
text$ = "selection from the bottom menu."
Print center$(text$)
Print
y = CsrLin
Do
_Limit 30
MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$
If lb = 2 And my = _Height Then
Select Case Asc(Mid$(map$, mx, 1)) - 96
Case 1: b$ = "F1"
Case 2: b$ = "F5"
Case 3: b$ = "Enter"
Case 4: b$ = "Esc"
End Select
End If
If Len(b$) Then
Select Case b$
Case Chr$(0) + Chr$(59), "F1"
text$ = "You selected: Help"
Locate y: Print Space$(_Width - 1);
Print center$(text$)
Case Chr$(0) + Chr$(63), "F5"
text$ = "You selected: Save"
Locate y: Print Space$(_Width - 1);
Print center$(text$)
Case Chr$(13), "Enter"
text$ = "You selected: Laugh at Steve. Great choice!"
Locate y: Print Space$(_Width - 1);
Print center$(text$)
Case Chr$(27), "Esc"
text$ = "You selected: Quit. See you later!"
Locate y: Print Space$(_Width - 1);
Print center$(text$)
_Delay 4
System
End Select
End If
Loop
Function center$ (text$)
Locate , _Width \ 2 - Len(text$) \ 2 + 1
center$ = text$
End Function
Sub MyMouse_and_Keyboard (lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$)
Static oldmy, oldmx, z1, hover, mwy, oldmwy
If Len(autokey$) Then
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
Else
b$ = InKey$
End If
If z1 Then If Abs(Timer - z1) > .3 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
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
If z1 = 0 Then
z1 = Timer ' Let first click go through.
Else
clkcnt = clkcnt + 1
End If
End If
ElseIf _MouseButton(2) And rb = 0 Then
rb = 1
ElseIf _MouseButton(3) And mb = 0 Then
mb = 1
End If
oldmy = my: oldmx = mx
End SubSometimes I just use an Instr() method...
Code: (Select All)
j = _InStrRev(Mid$(f$, 1, mx), "[") + 1
If j Then
temp$ = RTrim$(Mid$(f$, j, InStr(Mid$(f$, j) + "[", "[") - 1))
If mx < j + Len(temp$) Then
If lb = 2 Then
b$ = Mid$(temp$, 1, InStr(temp$, "]") - 1)
End If
End If
End IfSo how about everyone else?
Pete
RE: What do you guys like to use for mouse mapping? - bplus - 12-21-2024
So verbose
Here a little less LOC:
Code: (Select All)
_Title "Quick Menu" ' b+ 2024-12-20
Screen _NewImage(800, 600, 32): _ScreenMove 250, 60
Dim menu$(1 To 4)
menu$(1) = "Help": menu$(2) = "Save": menu$(3) = "Laugh at Pete's joke": menu$(4) = "Quit"
Cls , &HFF000088: _PrintMode _KeepBackground
Do
sel = getButtonNumberChoice%(menu$())
Print "You picked: "; menu$(sel)
Loop Until sel = 4
Sub drwBtn (x, y, s$) '200 x 50
Dim fc~&, bc~&
Line (x, y)-Step(200, 50), _RGB32(0, 0, 0), BF
Line (x, y)-Step(197, 47), _RGB32(255, 255, 255), BF
Line (x + 1, y + 1)-Step(197, 47), &HFFBABABA, BF
fc~& = _DefaultColor: bc~& = _BackgroundColor ' save color before we chnge
Color _RGB32(0, 0, 0), &HFFBABABA
_PrintString (x + 100 - 4 * Len(s$), y + 17), s$
Color fc~&, bc~& ' restore color
End Sub
'this works pretty good for a menu of buttons to get menu number
Function getButtonNumberChoice% (choice$()) 'this sub uses drwBtn
ub = UBound(choice$): lb = LBound(choice$)
For b = lb To ub ' drawing a column of buttons at _width - 210 starting at y = 10
drwBtn _Width - 210, b * 60 + 10, choice$(b)
Next
Do
While _MouseInput: Wend
mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
If mb Then
_Delay .25 ' delay before exit to give user time to release mouse button
If mx > _Width - 210 And mx <= _Width - 10 Then
For b = lb To ub
If my >= b * 60 + 10 And my <= b * 60 + 60 Then
getButtonNumberChoice% = b: Exit Function
End If
Next
Beep
Else
Beep
End If
End If
_Limit 60
Loop
End Function