Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
What do you guys like to use for mouse mapping?
#1
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 Sub

Sometimes 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 If

So how about everyone else?

Pete
Reply
#2
So verbose Smile

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
b = b + ...
Reply




Users browsing this thread: 4 Guest(s)