01-26-2025, 08:09 PM
So while Steve is handling his joystick, I'm digging into my universal mouse / keyboard library project. I'd say I'll see if I can finish before Steve, but after that opening statement, that just feels wrong to say.
So I added two style of button choices and two methods of button mapping. One uses arrays and the other creates a map of the screen.
A button making sub was also created to make it very easy to create, label, and place buttons.
For fun I improved the scrolling of the info on the left. No more need for CLS.
I also decided to add a variable 'demo' to enable the demo program to always run once the mouse / keyboard routine is made into a completed library.
What's next is to add the TAB feature, which allows the tab key to be used to highlight buttons. Also that will require adding an Enter key press to selected the highlighted button. It's always something...
Pete
So I added two style of button choices and two methods of button mapping. One uses arrays and the other creates a map of the screen.
A button making sub was also created to make it very easy to create, label, and place buttons.
For fun I improved the scrolling of the info on the left. No more need for CLS.
I also decided to add a variable 'demo' to enable the demo program to always run once the mouse / keyboard routine is made into a completed library.
Code: (Select All)
Dim Shared mapping, demo, BSelect, ButtonStyle
Dim Shared Bg, BBdr, BBdrHover, BBdrFlash, BFg, BBg, BBg1, BHvrFg, BHvrBk, BFgFlash, BBgFlash
ReDim Shared y_btl(0), y_bbr(0), x_btl(0), x_bbr(0), button$(0), mRow$(0), nob
Input "Choose a button mapping method 0 or 1: ", mapping
If mapping = 0 Then _Title "Mouse / Keyboard Demo with Array Mapping" Else _Title "Mouse / Keyboard Demo with Screen Mapping"
demo = 1
_KeyClear
Palette 5, 63
BBdr = 8: BBdrHover = 9: BBdrFlash = 1: Bg = 5: BFg = 15: BBg = 3: BBg1 = 1: BHvrFg = 3: BHvrBk = 1: BFgFlash = 1: BBgFlash = 7
Color 0, 5: Cls
Dim Shared a$(_Height)
a$ = " Button 1 ": button_maker a$, 7, 51
a$ = " Button 2 ": button_maker a$, 7, 66
a$ = " Button 3 ": button_maker a$, 12, 51
a$ = " Button 4 ": button_maker a$, 12, 66
a$ = " Button 5 ": button_maker a$, -17, 51
a$ = " Button 6 ": button_maker a$, -17, 66
a$ = " Button 7 ": button_maker a$, -22, 51
a$ = " Button 8 ": button_maker a$, -22, 66
Locate 1, 1
_ControlChr Off
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_array "Drag Right. Status = " + LTrim$(Str$(drag)) Else print_array "Drag Left. Status = " + LTrim$(Str$(drag))
olddrag = drag
End If
Else
olddrag = 0
End If
If oldlb <> lb Then
Select Case lb
Case 0
print_array "Left Button Up - Button Status = " + LTrim$(Str$(lb))
print_array "Number of clicks = " + LTrim$(Str$(clkcnt))
If temp Then print_array "Button Selected = " + LTrim$(Str$(temp))
Case -1
print_array "Left Button Down - Button Status = " + LTrim$(Str$(lb))
Case 1
print_array "Left Button Pressed - Button Status = " + LTrim$(Str$(lb))
Case 2
print_array "Left Button Released - Button Status = " + LTrim$(Str$(lb))
If BSelect Then temp = BSelect Else temp = 0
End Select
End If
If oldmb <> mb Then
Select Case mb
Case 0: print_array "Middle Button Up - Button Status = " + LTrim$(Str$(mb))
Case -1: print_array "Middle Button Down - Button Status = " + LTrim$(Str$(mb))
Case 1: print_array "Middle Button Pressed - Button Status = " + LTrim$(Str$(mb))
Case 2: print_array "Middle Button Released - Button Status = " + LTrim$(Str$(mb))
End Select
End If
If oldrb <> rb Then
Select Case rb
Case 0: print_array "Right Button Up - Button Status = " + LTrim$(Str$(rb))
Case -1: print_array "Right Button Down - Button Status = " + LTrim$(Str$(rb))
Case 1: print_array "Right Button Pressed - Button Status = " + LTrim$(Str$(rb))
Case 2: print_array "Right Button Released - Button Status = " + LTrim$(Str$(rb))
End Select
End If
If oldmw <> mw Then
If mw < 0 Then print_array "Mouse Wheel Up - Wheel Status = " + LTrim$(Str$(mw))
If mw > 0 Then print_array "Mouse Wheel Down - Wheel Status = " + LTrim$(Str$(mw))
End If
If oldalt% <> alt% Then
If alt% < 0 Then print_array "Alt Button Down" Else print_array "Alt Button Released"
End If
If oldctrl% <> ctrl% Then
If ctrl% < 0 Then print_array "Ctrl Button Down" Else print_array "Ctrl Button Released"
End If
If oldshift% <> shift% Then
If shift% < 0 Then print_array "Shift Button Down" Else print_array "Shift Button Released"
End If
If oldalt <> alt And alt < 0 Then
If AltToggle Then print_array "Alt Key Pressed / Alt Toggle Status: On" Else print_array "Alt Key Pressed / Alt Toggle Status: Off"
End If
If k& < 0 Then oldb$ = ""
Select Case Len(b$)
Case 1
If oldb$ <> b$ Then x = CVI(MKI$(Asc(b$))): print_array "You Pressed: " + Chr$(x) + " Chr$(" + LTrim$(Str$(x)) + ")"
oldb$ = b$
Case 2
If oldb$ <> b$ Then print_array "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
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
If BSelect Then BSelect = 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
If mapping Then
If Len(mRow$(my)) Then
If Mid$(mRow$(my), mx, 1) <> Chr$(32) Then
b_hover = Asc(Mid$(mRow$(my), mx, 1)) - 96
End If
End If
Else
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
End If
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
Do
If b_active Then
If demo Then If b_active > 4 Then ButtonStyle = 1 Else ButtonStyle = 0
If b_hover Then
Select Case lb
Case 0, 1 ' Button clicked. Flash effect.
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
j = Len(button$(b_active))
Select Case ButtonStyle
Case 0
If lb = 1 Then Color BBdrFlash, Bg Else Color BBdrHover, Bg
Locate y_btl(b_active), x_btl(b_active): Print Chr$(218) + String$(j, 196) + Chr$(191)
Locate , x_btl(b_active): Print Chr$(179);: Locate , Pos(0) + j: Print Chr$(179)
Locate , x_btl(b_active): Print Chr$(192) + String$(j, 196) + Chr$(217);
Rem Locate y_btl(b_active) + 1, x_btl(b_active) + 1: Print button$(b_active);
Case 1
If lb = 1 Then Color BBgFlash, Bg Else Color BHvrFg, Bg
Locate y_btl(b_active) - 1, x_btl(b_active): Print String$(j, 220);
Locate y_btl(b_active) + 1, x_btl(b_active): Print String$(j, 223);
If lb = 1 Then Color BFgFlash, BBgFlash Else Color BFg, BBg
Locate y_btl(b_active), x_btl(b_active): Print button$(b_active);
End Select
Color c1, c2
Locate s1, s2
Case 2 ' Button selection completed.
BSelect = b_hover
End Select
Else
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
j = Len(button$(b_active))
Select Case ButtonStyle
Case 0
Color BBdr, Bg
Locate y_btl(b_active), x_btl(b_active): Print Chr$(218) + String$(j, 196) + Chr$(191)
Locate , x_btl(b_active): Print Chr$(179);: Locate , Pos(0) + j: Print Chr$(179)
Locate , x_btl(b_active): Print Chr$(192) + String$(j, 196) + Chr$(217);
Rem Locate y_btl(b_active) + 1, x_btl(b_active) + 1: Print button$(b_active);
Case 1
Color BBg1, Bg
Locate y_btl(b_active) - 1, x_btl(b_active): Print String$(j, 220);
Locate y_btl(b_active) + 1, x_btl(b_active): Print String$(j, 223);
Color BFg, BBg1
Locate y_btl(b_active), x_btl(b_active): Print button$(b_active);
End Select
Color c1, c2
Locate s1, s2
b_active = 0
End If
Exit Do
Else
If b_hover And oldmy <> 0 And b_active = 0 Then
b_active = b_hover
Else
Exit Do
End If
End If
Loop
If demo Then
q1 = CsrLin: q2 = Pos(0)
Locate 3, 48: Print "Hover ="; b_hover; " Active ="; b_active; " Style ="; ButtonStyle;
Locate q1, q2
End If
oldmy = my: oldmx = mx
End Sub
Sub cal_mapit (a$, mapid)
Static initiate As Integer, mapnbr As Integer
If initiate = 0 Then
initiate = 1
ReDim mRow$(_Height)
mapnbr = 96
End If
If mRow$(CsrLin) = "" Then mRow$(CsrLin) = Space$(_Width)
Select Case mapid
Case 1
mapnbr = mapnbr + 1 ' Advance.
y_btl(mapnbr - 96) = CsrLin: x_btl(mapnbr - 96) = Pos(0)
Case 2
y_bbr(mapnbr - 96) = CsrLin: x_bbr(mapnbr - 96) = Pos(0) + Len(a$)
Case 3
mapnbr = mapnbr + 1 ' Advance.
y_btl(mapnbr - 96) = CsrLin
x_btl(mapnbr - 96) = Pos(0)
y_bbr(mapnbr - 96) = CsrLin
x_bbr(mapnbr - 96) = Pos(0) + Len(a$)
End Select
Mid$(mRow$(CsrLin), Pos(0)) = String$(Len(a$), Chr$(mapnbr))
Print a$;
End Sub
Sub button_maker (a$, y, x)
Static btnnbr
c1 = _DefaultColor: c2 = _BackgroundColor
j = Len(a$)
btnnbr = btnnbr + 1
ReDim _Preserve y_btl(btnnbr), x_btl(btnnbr), y_bbr(btnnbr), x_bbr(btnnbr), button$(btnnbr)
button$(btnnbr) = String$(j, 0) ' Fill any spaces with the null character.
Mid$(button$(btnnbr), 1 + (j - Len(_Trim$(a$))) \ 2) = _Trim$(a$)
If y > 0 Then
Color BBdr, Bg
Locate y - 1, x - 1
a$ = Chr$(218) + String$(j, 196) + Chr$(191): cal_mapit a$, 1
Locate y, x - 1: a$ = Chr$(179): cal_mapit a$, 0: Locate , Pos(0) + j: a$ = Chr$(179): cal_mapit a$, 0
Locate y + 1, x - 1: a$ = Chr$(192) + String$(j, 196) + Chr$(217): cal_mapit a$, 2
Locate y, x: a$ = button$(btnnbr): cal_mapit a$, 0
Else
y = Abs(y)
Color BFg, BBg1: Locate y, x: a$ = button$(btnnbr): cal_mapit a$, 3
Color BBg1, Bg: Locate y - 1, x: a$ = String$(j, Chr$(220)): cal_mapit a$, 0
Locate y + 1, x: a$ = String$(j, Chr$(223)): cal_mapit a$, 0
End If
nob = btnnbr ' Number of buttons becomes a global variable here.
Color c1, c2
Locate y, x
End Sub
Sub print_array (a$)
Static cnt
If cnt = _Height - 1 Then
Locate 1, 1
j = cnt: cnt = 0
For cnt = 1 To j - 1
a$(cnt) = a$(cnt + 1)
Print a$(cnt);
Next
a$(cnt) = Space$(45)
Mid$(a$(cnt), 1) = a$
Print a$(cnt);
Else
cnt = cnt + 1
a$(cnt) = Space$(45)
Mid$(a$(cnt), 1) = a$
Print a$(cnt);
End If
End SubWhat's next is to add the TAB feature, which allows the tab key to be used to highlight buttons. Also that will require adding an Enter key press to selected the highlighted button. It's always something...
Pete