Posts: 2,417
Threads: 245
Joined: Apr 2022
Reputation:
125
01-24-2025, 10:59 PM
(This post was last modified: 01-24-2025, 11:44 PM by Pete.)
Employed two different mapping approaches I've used over the years. Also added a button maker, so it will be easier to add buttons to any program I make, in the future.
Code: (Select All)
Dim Shared mapping
ReDim Shared y_btl(0), y_bbr(0), x_btl(0), x_bbr(0), button$(0), mRow$(0), nob
Rem Input "Choose a button mapping method 1 or 2: ", mapping
If mapping <> 2 Then mapping = 0
_KeyClear
Palette 5, 63
Color 0, 5: Cls
a$ = " Button 1 ": button_maker a$, 10, 51
a$ = " Button 2 ": button_maker a$, 10, 66
a$ = " Button 3 ": button_maker a$, 15, 51
a$ = " Button 4 ": button_maker a$, 15, 66
PCopy 0, 1
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 "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
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 b_hover Then
If lb = 1 Or lb = 0 Then ' Button clicked. Flash effect.
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
If lb = 1 Then Color 1, 5 Else Color 9, 5
j = Len(button$(b_active))
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);
Color c1, c2
Locate s1, s2
End If
Else
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
Color 8, 5
j = Len(button$(b_active))
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);
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
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_bbr(mapnbr - 96) = y_btl(mapnbr - 96)
x_bbr(mapnbr - 96) = Pos(0)
Color 15, 1
Case 4
Color 1, 5
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 8, 5
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)
Locate y - 1, x: a$ = String$(j, Chr$(220)): cal_mapit a$, 4
Locate y, x: a$ = button$(btnnbr): cal_mapit a$, 3
Locate y + 1, x: a$ = String$(j, Chr$(223)): cal_mapit a$, 4
End If
nob = btnnbr ' Number of buttons becomes a global variable here.
Color c1, c2
Locate y, x
End Sub
Pete
Posts: 2,417
Threads: 245
Joined: Apr 2022
Reputation:
125
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.
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 Sub
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
Posts: 2,821
Threads: 334
Joined: Apr 2022
Reputation:
242
Well, I always was quick to the finish when it came to playing with my joystick...
My routine is done. Now I just need to wait for all the crickets where feedback should be, and see how many people are never going to use it for anything at all.
Posts: 2,417
Threads: 245
Joined: Apr 2022
Reputation:
125
Well if I had a USB joystick handy, I'd love to try it.
Meanwhile, I got sidetracked with the desire to add a hardware display option. Something along theses 'lines'.
Code: (Select All)
Palette 5, 63 ' Bright white.
Palette 6, 56 ' Dark grey.
Color 0, 5 ' Bright white background.
Cls
Dim b(15) As String * 1
b(0) = " "
b(1) = "Ú"
b(2) = "Ä"
b(3) = "¿"
b(4) = "³"
b(5) = "À"
b(6) = "Ù"
b(7) = "Ã"
b(8) = "´"
b(9) = "Ä"
b(10) = "Â"
b(11) = "Á"
b(12) = "Þ"
b(13) = "Ý"
b(15) = "ß"
b(14) = "Ü"
Overlay = _NewImage(_Width * _FontWidth, _Height * _FontHeight, 32)
b_text_y% = 1
b_text_x% = 2
GoSub b_text_display
_Dest Overlay
Line (9, 7)-(102, 38), _RGB32(0, 0, 0), B
Rem Line (16, 15)-(96, 31), _RGB32(0, 0, 126), B
Overlay_Hardware = _CopyImage(Overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_Dest 0
_FreeImage Overlay_Hardware
_Display
Sleep
System
b_text_display:
Locate b_text_y%, b_text_x%: Color 6, 5: Print String$(12, b(14))
Locate , b_text_x%: Color 5, 6: Print String$(12, b(0))
Locate , b_text_x%: Color 6, 5: Print String$(12, b(15));
Locate b_text_y% + 1, b_text_x% + 1: Color 6, 7: Print b(0);: Print "Activate";: Print b(0);
Rem Locate b_text_y% + 1, b_text_x% + 1: Color 15, 1: Print b(0);: Print "Activate";: Print b(0);
Return
Pete
Shoot first and shoot people who ask questions, later.
Posts: 2,821
Threads: 334
Joined: Apr 2022
Reputation:
242
Okay. That's it. Give me your address and credit card number. I'm going to Amazon you one overnight for testing! Cost is NOT a concern!!
Posts: 2,417
Threads: 245
Joined: Apr 2022
Reputation:
125
Ha, ha. The last time I feel for that old trick was 45 years ago. My wife is still in Maui.
Pete
Posts: 2,821
Threads: 334
Joined: Apr 2022
Reputation:
242
While @Pete has been playing around with his mouse and keyboard stuff, I wanted to take a moment to highlight a little of my little keyboard routines here:
Code: (Select All)
$If WIN Then
Declare Library 'function is already used by QB64 so "User32" is not required
Function GetKeyState% (ByVal vkey As Long)
Function GetAsyncKeyState% (ByVal vkey As Long)
End Declare
$End If
Type KeyboardInfo_Type
Index As Long
ASCII As Long
Ctrl As Long
Shift As Long
Alt As Long
AltGr As Long
Repeat As _Float
LastHit As _Float
Down As Long
AltShift As Long
AltCtrl As Long
AltAltGr As Long
CtrlShift As Long
CtrlAlt As Long
CtrlAltGr As Long
ShiftAltGr As Long
CtrlAltShift As Long
End Type
Dim Shared Keys(254) As KeyboardInfo_Type
Dim Shared AltGr(1) As _Unsigned _Byte
_ControlChr Off
$If VKBI = UNDEFINED Then
Type Keyboard_Internal_Type
In_Use As Long
Is_Hidden As Long
Handle As Long
Hardware_Handle As Long
Xoffset As Long
Yoffset As Long
Xsize As Long
Ysize As Long
Style1 As Integer
style2 As Integer
End Type
Type Keyboard_Value_Type
Value As Long
State As Long
Caption As String
End Type
Dim Shared Virtual_KB(0 To 10) As Keyboard_Internal_Type
Dim Shared Keyboard_Values(0 To 10, 0 To 10, 0 To 255) As Keyboard_Value_Type '11 keyboards of up to 11 rows of 256 keys
Type Button_Report
Time As _Float
Value As Long
Caption As String
Held As Long
End Type
Type Buttons_Internal_Type
In_Use As Integer
Red As Integer
Green As Integer
Blue As Integer
RedMax As Integer
GreenMax As Integer
BlueMax As Integer
Font As Integer
Shade As Integer
Font_Color As _Unsigned Long
Font_Background As _Unsigned Long
End Type
ReDim Shared Button_Style(10) As Buttons_Internal_Type
Dim Shared Buttons(10) As Button_Report
Dim Shared Repeat_Speed As _Float
Repeat_Speed = 0.1 'by default
$Let VKBI = TRUE
$End If
Repeat_Speed = 0.2 'Global variable in the Virtual Keyboard library which a user can change for repeat speed
Screen _NewImage(800, 600, 32)
_ControlChr Off
'CREATE YOUR CUSTOM KEYBOARD LAYOUT HERE
Dim My_Keyboard(5) As String
My_Keyboard(0) = CHR$(0) + "27,ESC" + STRING$(2,0) + "15104,F1" + STRING$(2,0) + "15360,F2" + _
STRING$(2,0) + "15616,F3" + STRING$(2,0) + "15872,F4" + STRING$(2,0) + "16128,F5" + _
STRING$(2,0) + "16384,F6" + STRING$(2,0) + "16640,F7" + STRING$(2,0) + "16896,F8" + _
STRING$(2,0) + "17152,F9" + STRING$(2,0) + "17408,F10" + STRING$(2,0) + "34048,F11" + _
STRING$(2,0) + "34304,F12" + CHR$(0)
My_Keyboard(1) = "`1234567890-=" + Chr$(0) + "19200,BKSP" + Chr$(0)
My_Keyboard(2) = Chr$(0) + "9,TAB" + Chr$(0) + "QWERTYUIOP[]\"
My_Keyboard(3) = Chr$(0) + "100301,KB2" + Chr$(0) + "ASDFGHJKL;'" + Chr$(0) + "13,ENTER" + Chr$(0)
My_Keyboard(4) = Chr$(0) + "100304,SHIFT" + Chr$(0) + "ZXCVBNM,./" + Chr$(0) + "100303,SHIFT" + Chr$(0)
My_Keyboard(5) = CHR$(0) + "100306,CTRL" + STRING$(2,0) + "100311,WIN" + STRING$(2,0) + "100308,ALT" + _
STRING$(2,0) + "32,SPACE" + STRING$(2,0) + "100307,ALT" + STRING$(2,0) + "100312,WIN" + STRING$(2,0) + "100319,MENU" + _
STRING$(2,0) + "100305,CTRL" + CHR$(0)
font = _LoadFont("Courbd.ttf", 14, "monospace") 'IF USED ON A KEYBOARD, DON'T FREE THIS FONT
' IT GETS REUSED WHEN DRAWING KEYS UP/DOWN STATE
' Honestly, I like the look with the standard font 16 here better, but I wanted to load a custom font
' just so folks could see how to make use of it.
'DEFINING MY BUTTON STYLES FOR SHADING AND Effect
Button_Style_Up = Register_Button(50, 50, 50, 150, 150, 150, 8, 16, &HFFFFFF00, 0)
Button_Style_Down = Register_Button(150, 150, 150, 110, 110, 110, 8, 16, &HFFFFFF00, 0)
FullsizeKB1 = Create_KB(My_Keyboard(), 55, 35, Button_Style_Up, Button_Style_Down)
Button_Style_Up = Register_Button(50, 50, 150, 150, 150, 250, 8, 16, &HFFFFFF00, 0)
Button_Style_Down = Register_Button(150, 150, 250, 110, 110, 210, 8, 16, &HFFFFFF00, 0)
My_Keyboard(3) = Chr$(0) + "100301,KB3" + Chr$(0) + "ASDFGHJKL;'" + Chr$(0) + "13,ENTER" + Chr$(0)
FullsizeKB2 = Create_KB(My_Keyboard(), 55, 35, Button_Style_Up, Button_Style_Down)
' And here's where I'm redefining my keys to toggle for my second keyboard
My_Keyboard(1) = "~!@#$%^&*()_+" + Chr$(0) + "19200,BKSP" + Chr$(0)
My_Keyboard(2) = Chr$(0) + "9,TAB" + Chr$(0) + "qwertyuiop{}|"
My_Keyboard(3) = Chr$(0) + "100301,KB4" + Chr$(0) + "asdfghjkl:" + Chr$(34) + Chr$(0) + "13,ENTER" + Chr$(0)
My_Keyboard(4) = Chr$(0) + "100304,SHIFT" + Chr$(0) + "zxcvbnm<>?" + Chr$(0) + "100303,SHIFT" + Chr$(0)
Button_Style_Up = Register_Button(50, 50, 50, 150, 150, 150, 8, 16, &HFFFFFF00, 0)
Button_Style_Down = Register_Button(150, 150, 150, 110, 110, 110, 8, 16, &HFFFFFF00, 0)
FullsizeKB3 = Create_KB(My_Keyboard(), 55, 35, Button_Style_Up, Button_Style_Down)
Button_Style_Up = Register_Button(50, 50, 150, 150, 150, 250, 8, 16, &HFFFFFF00, 0)
Button_Style_Down = Register_Button(150, 150, 250, 110, 110, 210, 8, 16, &HFFFFFF00, 0)
My_Keyboard(3) = Chr$(0) + "100301,KB1" + Chr$(0) + "asdfghjkl:" + Chr$(34) + Chr$(0) + "13,ENTER" + Chr$(0)
FullsizeKB4 = Create_KB(My_Keyboard(), 55, 35, Button_Style_Up, Button_Style_Down)
Keyboard_In_Use = FullsizeKB1 'Set the keyboard I'm currently using
View Print 1 To 20
Do
Display_KB Keyboard_In_Use, 10, 380, -1
While _MouseInput: Wend 'must update mouse buffer before reading virtual keyboard
k = KeyHit 'The library version which reads all the keys for us, not the qb64 _KEYHIT version
'(ONLY FOR WINDOWS. LINUX/MAC USERS STILL GET THE SAME OLE BUGGY _KEYHIT FOR NOW. SORRY.)
If k = 0 Or k > 900000 Then k = VK_Keyhit(Keyboard_In_Use) 'this checks the virtual keyboard
If VK_Keydown(32) Then Print "Space held"; 'and here we can check for virtual keys being held down.
Select Case k
Case 100301 'swap keyboards, rather than having a CAPS LOCK key
Keyboard_In_Use = (Keyboard_In_Use + 1) Mod 4
_Delay .2 'we need a delay here, as we haven't actually pressed any key on the new keyboard
'so the keys aren't going to have a down timer to stop repeats.. We'd probably change keyboards
'multiple times quickly without it, before we lifted our finger up off the mouse button.
Case 27
System
Case 1 To 900000 '900001 are mouse buttons, which I don't want to print to the screen and add to any
' confusion.
Print k;
If k > 0 And k < 255 Then Print Chr$(k);
Print ,
End Select
_Display
_Limit 30
Loop
$If VKBI = UNDEFINED Then
'$Include:'Virtual Keyboard.BI'
$End If
Function VK_Keydown (Which)
For i = 0 To 10
If Buttons(i).Value = Which And Buttons(i).Held = -1 Then VK_Keydown = -1
Next
End Function
Function VK_Keyhit& (Which)
Static As Integer x, y 'so as to not interfer with any global variables
x = _MouseX - Virtual_KB(Which).Xoffset
y = _MouseY - Virtual_KB(Which).Yoffset
xsize = Virtual_KB(Which).Xsize
ysize = Virtual_KB(Which).Ysize
yon = x \ Virtual_KB(Which).Xsize
xon = y \ Virtual_KB(Which).Ysize
'first let's check mouse position
If xon < 0 Or xon > 10 Then GoTo safe_exit: 'mouse is not in keyboard zone
If yon < 0 Or yon > 255 Then GoTo safe_exit: 'once again, mouse is not in keyboard zone
If Keyboard_Values(Which, xon, yon).Value = 0 Then GoTo safe_exit: 'it's a key with no return code.
'LOCATE 1, 1: PRINT Keyboard_Values(Which, xon, yon).State
out$ = Keyboard_Values(Which, xon, yon).Caption
If _MouseButton(1) Then
Select Case Keyboard_Values(Which, xon, yon).State
Case 0 'mouse is down and key is marked as up
first_zero = 0
For i = 0 To 10 'check to see if this button matches one we're already tracking
' or if we already have the maximum amount of buttons pressed.
If Buttons(i).Value = Keyboard_Values(Which, xon, yon).Value Then GoTo safe_exit:
If Buttons(i).Value = 0 And first_zero = 0 Then first_zero = i
Next
If first_zero = 0 Then GoTo safe_exit: 'all buttons are currently pressed.
Buttons(first_zero).Value = Keyboard_Values(Which, xon, yon).Value
Buttons(first_zero).Time = ExtendedTimer + Repeat_Speed
Buttons(first_zero).Caption = Keyboard_Values(Which, xon, yon).Caption
VK_Keyhit = Keyboard_Values(Which, xon, yon).Value 'button is now marked down.
Set_States out$, Which, -1 'Now we're down
Toggle_Button out$, Which
Case -1 'mouse is down, key is down.
' We just ignore it
Case -2 'We went from up to down to up to down before the repeat cycle began.
' Let's lock the key down
Set_States out$, Which, -3 'and we're now in a hold state
For i = 0 To 10
If Buttons(i).Value = Keyboard_Values(Which, xon, yon).Value Then Buttons(i).Held = -1
Next
Case -4 'We had a held button, and now it's been clicked on and released
For i = 0 To 10
If Buttons(i).Value = Keyboard_Values(Which, xon, yon).Value Then Buttons(i).Held = 0
Next
End Select
Else 'We started out down, but...
If Keyboard_Values(Which, xon, yon).State = -1 Then Set_States out$, Which, -2 'Now we're up
If Keyboard_Values(Which, xon, yon).State = -3 Then Set_States out$, Which, -4 'Now we're up
End If
safe_exit:
For i = 0 To 10
If Buttons(i).Caption = "" Then _Continue
If Buttons(i).Time = 0 Then _Continue
If Buttons(i).Held Then _Continue
Select Case Buttons(i).Value 'buttons value is the value of the key hit
Case Is <> 0 ' key has been hit and registered
If ExtendedTimer > Buttons(i).Time Then
out$ = Buttons(i).Caption
Set_States out$, Which, 0 'Now we're up
Toggle_Button out$, Which
Buttons(i).Value = 0: Buttons(i).Time = 0: Buttons(i).Caption = ""
End If
End Select
Next
End Function
Sub Set_States (out$, Which, State)
For j = 0 To 10
For z = 0 To 255
If Keyboard_Values(Which, j, z).Caption = out$ Then
Keyboard_Values(Which, j, z).State = State
End If
Next
skip:
Next
End Sub
Sub Reset_Buttons (Which)
For j = 0 To 10
For z = 0 To 255
Keyboard_Values(Which, j, z).State = 0
If Keyboard_Values(Which, j, z).Caption <> "" Then
Toggle_Button Keyboard_Values(Which, j, z).Caption, Which
End If
Next
Buttons(j).Time = 0
Buttons(j).Value = 0
Buttons(j).Held = 0
Buttons(j).Caption = ""
Next
End Sub
Sub Toggle_Button (out$, Which)
Style1 = Virtual_KB(Which).Style1
Style2 = Virtual_KB(Which).style2
xsize = Virtual_KB(Which).Xsize
ysize = Virtual_KB(Which).Ysize
For xon = 0 To 10
For z = 0 To 255
firston = -1
If Keyboard_Values(Which, xon, z).Caption = "" Then _Continue
If Keyboard_Values(Which, xon, z).Caption = out$ Then
If firston = -1 Then firston = z
Repeat = Asc(out$, Len(out$))
If Repeat < 1 Or Repeat > 9 Then Repeat = 1
If firston > -1 Then
d = _Dest: _Dest Virtual_KB(Which).Handle
Select Case Keyboard_Values(Which, xon, z).State
Case 0 'button is up
If Repeat > 1 Then
Draw_Button firston * xsize, xon * ysize, xsize * Repeat, ysize, Left$(Keyboard_Values(Which, xon, z).Caption, Len(Keyboard_Values(Which, xon, z).Caption) - 1), Style1
Else
Draw_Button firston * xsize, xon * ysize, xsize * Repeat, ysize, Keyboard_Values(Which, xon, z).Caption, Style1
End If
Case -1 'button is down
If Repeat > 1 Then
Draw_Button firston * xsize, xon * ysize, xsize * Repeat, ysize, Left$(Keyboard_Values(Which, xon, z).Caption, Len(Keyboard_Values(Which, xon, z).Caption) - 1), Style2
Else
Draw_Button firston * xsize, xon * ysize, xsize * Repeat, ysize, Keyboard_Values(Which, xon, z).Caption, Style2
End If
End Select
Virtual_KB(Which).Hardware_Handle = _CopyImage(Virtual_KB(Which).Handle, 33)
_Dest d
z = z + Repeat - 1
End If
End If
Next
Next
End Sub
Sub Display_KB (Which As Integer, Xwhere As Integer, Ywhere As Integer, style As Integer)
Static Old_KB As Integer
If Old_KB <> Which Then Reset_Buttons (Old_KB): Reset_Buttons (Which)
If Virtual_KB(Which).In_Use = 0 Then Exit Sub
If Virtual_KB(Which).Is_Hidden Then Exit Sub
Virtual_KB(Which).Xoffset = Xwhere
Virtual_KB(Which).Yoffset = Ywhere
If style Then 'we want a hardware image
_PutImage (Xwhere, Ywhere), Virtual_KB(Which).Hardware_Handle
Else
_PutImage (Xwhere, Ywhere), Virtual_KB(Which).Handle
End If
End Sub
Function Create_KB (KB() As String, Xsize As Long, Ysize As Long, Style1 As Integer, Style2 As Integer)
'style1 and style2 are the styles of the buttons associated with the keyboard
Static As Long D, S 'stored as static so as to not interfer with any globals of the same name.
D = _Dest: S = _Source
For i = 0 To 10
If Virtual_KB(i).In_Use = 0 Then
Virtual_KB(i).In_Use = -1
Virtual_KB(i).Xsize = Xsize
Virtual_KB(i).Ysize = Ysize
Virtual_KB(i).Style1 = Style1
Virtual_KB(i).style2 = Style2
Create_KB = i
Exit For
End If
Next
If i = 11 Then
Cls
Print "Too many keyboards registered in use at the same time! Can not create a new one."
End
End If
This_KB = i
keyboard_image = _NewImage(4096, 4096, 32)
_Dest keyboard_image: _Source keyboard_image
'now build the keyboard
For i = 0 To UBound(KB)
top = i * Ysize
count = 0
For j = 1 To Len(KB(i))
left = (count) * Xsize
count = count + 1
repeat = 1
c = Asc(KB(i), j): out$ = ""
If c = 0 Then
'look for the comma
comma_position = InStr(j, KB(i), ",")
If comma_position Then 'we have a value, label
value$ = Mid$(KB(i), j + 1, comma_position - j - 1)
c = Val(value$)
j = comma_position + 1
Else 'cry loud and hard so we can sort it out while programming our keyboard layout
scream_and_die:
Sleep
Cls
Print "You have an invalid keyboard layout!"
End
End If
end_position = InStr(j, KB(i), Chr$(0))
If end_position Then 'we're extracting the label
out$ = Mid$(KB(i), j, end_position - j)
repeat = Asc(out$, Len(out$))
If repeat > 0 And repeat < 9 Then
r$ = Chr$(repeat)
out$ = Left$(out$, Len(out$) - 1)
Else
repeat = 1
End If
Keyboard_Values(This_KB, i, count - 1).Caption = out$ + r$
j = end_position
Else
GoTo scream_and_die
End If
End If
If left + Xsize * repeat > max_width Then max_width = left + Xsize * repeat
If top + Ysize > max_height Then max_height = top + Ysize
If c < 256 And out$ = "" Then out$ = Chr$(c)
Keyboard_Values(This_KB, i, count - 1).Caption = out$ + "r"
Draw_Button left, top, Xsize * repeat, Ysize, out$, Style1
Do Until repeat = 1
Keyboard_Values(This_KB, i, count - 1).Value = c
Keyboard_Values(This_KB, i, count - 1).Caption = out$ + r$
count = count + 1
repeat = repeat - 1
Loop
Keyboard_Values(This_KB, i, count - 1).Value = c
Keyboard_Values(This_KB, i, count - 1).Caption = out$ + r$
r$ = ""
Next
Next
'resize to proper size to put upon the screen
Virtual_KB(This_KB).Handle = _NewImage(max_width + 1, max_height + 1, 32)
_PutImage (0, 0)-(max_width, max_height), keyboard_image, Virtual_KB(This_KB).Handle, (0, 0)-(max_width, max_height)
Virtual_KB(This_KB).Hardware_Handle = _CopyImage(Virtual_KB(This_KB).Handle, 33)
_FreeImage keyboard_image
clean_exit:
_Source S: _Dest D
End Function
Function Register_Button (Red AS INTEGER,Green AS INTEGER,Blue AS INTEGER,_
RedMax AS INTEGER,GreenMax AS INTEGER,BlueMax AS INTEGER,Shade AS INTEGER,_
Font AS INTEGER,Font_Color AS _UNSIGNED LONG,Font_Background AS _UNSIGNED LONG)
U = UBound(Button_Style)
For i = 0 To 10
If Button_Style(i).In_Use = 0 Then Exit For
Next
If i > U Then ReDim _Preserve Button_Style(U + 10) As Buttons_Internal_Type
Button_Style(i).In_Use = -1
Button_Style(i).Red = Red
Button_Style(i).Green = Green
Button_Style(i).Blue = Blue
Button_Style(i).RedMax = RedMax
Button_Style(i).GreenMax = GreenMax
Button_Style(i).BlueMax = BlueMax
Button_Style(i).Shade = Shade
Button_Style(i).Font = Font
Button_Style(i).Font_Color = Font_Color
Button_Style(i).Font_Background = Font_Background
Register_Button = i
End Function
Sub Draw_Button (x, y, wide, tall, caption$, style)
Dim As _Unsigned Long k, d, bg
F = _Font
d = _DefaultColor
bg = _BackgroundColor
_Font Button_Style(style).Font
If Button_Style(style).Shade > 0 Then 'if the shadowing is less than 1, then we have none.
rc = (Button_Style(style).RedMax - Button_Style(style).Red) / Button_Style(style).Shade
gc = (Button_Style(style).GreenMax - Button_Style(style).Green) / Button_Style(style).Shade
bc = (Button_Style(style).BlueMax - Button_Style(style).Blue) / Button_Style(style).Shade
End If
For i = 0 To Button_Style(style).Shade
k = _RGB32(Button_Style(style).Red + rc * i, Button_Style(style).Green + gc * i, Button_Style(style).Blue + bc * i)
Line (x + i * .75, y + i)-(x + wide - i * .75, y + tall - i), k, B
Next
Paint (x + i, y + i), k
Color _RGB32(r, g, b), 0
Color Button_Style(style).Font_Color, Font_Background
_PrintString (x + (wide - _PrintWidth(caption$)) / 2, y + (tall - _FontHeight) / 2 + 2), caption$
_Font F
Color d, bg
End Sub
$If EXTENDEDTIMER = UNDEFINED Then
$Let EXTENDEDTIMER = TRUE
Function ExtendedTimer##
'modified extendedtimer to store the old day's count, and not have to recalculate it every time the routine is called.
Static olds As _Float, old_day As _Float
Dim m As Integer, d As Integer, y As Integer
Dim s As _Float, day As String
If olds = 0 Then 'calculate the day the first time the extended timer runs
day = Date$
m = Val(Left$(day, 2))
d = Val(Mid$(day, 4, 2))
y = Val(Right$(day, 4)) - 1970
Select Case m 'Add the number of days for each previous month passed
Case 2: d = d + 31
Case 3: d = d + 59
Case 4: d = d + 90
Case 5: d = d + 120
Case 6: d = d + 151
Case 7: d = d + 181
Case 8: d = d + 212
Case 9: d = d + 243
Case 10: d = d + 273
Case 11: d = d + 304
Case 12: d = d + 334
End Select
If (y Mod 4) = 2 And m > 2 Then d = d + 1 'add a day if this is leap year and we're past february
d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
d = d + (y + 2) \ 4 'add in days for leap years passed
s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
old_day = s
End If
If Timer < oldt Then 'we went from 23:59:59 (a second before midnight) to 0:0:0 (midnight)
old_day = s + 83400 'add another worth of seconds to our counter
End If
oldt = Timer
olds = old_day + oldt
ExtendedTimer## = olds
End Function
$End If
''$INCLUDE:'Keyboard Library.BI'
Sub SetAltGr (Key1 As Integer, Key2 As Integer)
AltGr(0) = Key1 'any key from our index (0 says no key)
AltGr(1) = Key2 'PLUS any other key from our index (0 says no additional key)
'Using this, we can set AltGr to become several things.
'AltGr(0) = 165, AltGr(1) = 0 -- This would say we're using the RIGHT Alt key (alone) to simulate the AltGr key. (Windows Onscreen Keyboard does this.)
'AltGr(0) = 17, AltGr(1) = 18 -- This would use any CTRL-ALT combo to simulate a AltGr keypress.
'Some useful values are listed for quick reference below
'0 = NoKey
'17 = ANY Ctrl
'18 = ANY Alt
'162 = Left Control
'163 = Right Control
'164 = Left Alt
'165 = Right Alt
'Default is for AltGr(0) = 165, AltGr(1) = 0, which uses Right-Alt alone as the AltGr key.
'Feel free to customize the setting to your personal preference/need.
End Sub
Sub KeyClear
_Delay .05 'give time for a keyup event to log itself so we can clear it
Do: k = KeyHit: Loop Until k = 0
End Sub
Function KeyHit&
$If WIN Then
Static ReturnCount As Integer
Static ReturnValues(30) As Long
Shared AltGr, Alt, Shift, Ctrl
If Keys(1).Index = 0 Then Init_KeyCodes "US" 'if someone forgets to put the init routine in their code, be certain to initialize the codes before attempting to use them.
If ReturnCount > 0 Then 'If we generated a cue of values last pass, clear those up first, before getting new values.
'The only time we really see this is when we hit a shift, ctrl, alt key, usually.
KeyHit = ReturnValues(1)
For i = 1 To ReturnCount - 1
ReturnValues(i) = ReturnValues(i + 1)
Next
ReturnCount = ReturnCount - 1
Exit Function
End If
If Keys(16).Down Then Shift = -1 Else Shift = 0
If Keys(17).Down Then Ctrl = -1 Else Ctrl = 0
If Keys(18).Down Then Alt = -1 Else Alt = 0
If AltGr(0) <> 0 And AltGr(1) <> 0 Then
If Keys(AltGr(0)).Down And Keys(AltGr(1)).Down Then AltGr = -1 Else AltGr = 0
ElseIf AltGr(1) <> 0 Then
If Keys(AltGr(1)).Down Then AltGr = -1 Else AltGr = 0
ElseIf AltGr(0) <> 0 Then
If Keys(AltGr(0)).Down Then AltGr = -1 Else AltGr = 0
Else
AltGr = 0
End If
'until Ctrl or Alt status, if the key down was used to help generate AltGr as a modifier key
If AltGr Then
If (AltGr(0) = 18 Or AltGr(1) = 18) Then Alt = 0 'if we use both ALT keys to represent part of AltGr, when AltGr is active, Alt isn't.
If (AltGr(0) = 164 Or AltGr(1) = 164) And Keys(165).Down = 0 Then Alt = 0 'if we use Left ALT keys to represent part of AltGr, when AltGr is active, Left Alt isn't.
If (AltGr(0) = 165 Or AltGr(1) = 165) And Keys(164).Down = 0 Then Alt = 0 'if we use Right ALT keys to represent part of AltGr, when AltGr is active, Right Alt isn't.
If (AltGr(0) = 17 Or AltGr(1) = 17) Then Ctrl = 0 'if we use both CTRL keys to represent part of AltGr, when AltGr is active, Ctrl isn't.
If (AltGr(0) = 162 Or AltGr(1) = 162) And Keys(163).Down = 0 Then Ctrl = 0 'if we use Left CTRL keys to represent part of AltGr, when AltGr is active, Left Ctrl isn't.
If (AltGr(0) = 163 Or AltGr(1) = 163) And Keys(162).Down = 0 Then Ctrl = 0 'if we use Right CTRL keys to represent part of AltGr, when AltGr is active, Right Ctrl isn't.
End If
If Alt And Shift Then AltShift = -1 Else AltShift = 0
If Alt And Ctrl Then AltCtrl = -1 Else AltCtrl = 0
If Alt And AltAltGR Then AltAltGR = -1 Else AltAltGR = 0
If Ctrl And Shift Then CtrlShift = -1 Else CtrlShift = 0
If Shift And AltGr Then ShiftAltGr = -1 Else ShiftAltGr = 0
If Ctrl And Alt And Shift Then CtrlAltShift = -1 Else CtrlAltShift = 0
If _WindowHasFocus Then
For i = 1 To 254
r = GetKeyState(Keys(i).Index) And &H8000
If r Then 'the key is down
If Keys(i).LastHit Then
If ExtendedTimer > Keys(i).LastHit Then
ReturnCount = ReturnCount + 1 'add one to the return buffer
ReturnValues(ReturnCount) = Keys(i).Down 'and put the existing value back in the buffer, as a key repeat
End If
Else
If Keys(i).Down = 0 Then 'the key was up on the last pass.
If CtrlAltShift <> 0 And Keys(i).CtrlAltShift <> 0 Then 'return the CtrlAltShift value
Keys(i).Down = Keys(i).CtrlAltShift
ElseIf AltAltGR <> 0 And Keys(i).AltAltGr <> 0 Then 'return the AltAltGr value
Keys(i).Down = Keys(i).AltAltGr
ElseIf CtrlAltGr& <> 0 And Keys(i).CtrlAltGr& <> 0 Then 'return the CtrlAltGr& value
Keys(i).Down = Keys(i).CtrlAltGr&
ElseIf ShiftAltGr <> 0 And Keys(i).ShiftAltGr <> 0 Then 'return the ShiftAltGr value
Keys(i).Down = Keys(i).ShiftAltGr
ElseIf CtrlShift <> 0 And Keys(i).CtrlShift <> 0 Then 'return the CtrlShift value
Keys(i).Down = Keys(i).CtrlShift
ElseIf AltCtrl <> 0 And Keys(i).AltCtrl <> 0 Then 'return the AltCtrl value
Keys(i).Down = Keys(i).AltCtrl
ElseIf AltShift <> 0 And Keys(i).AltShift <> 0 Then 'return the AltShift value
Keys(i).Down = Keys(i).AltShift
ElseIf AltGr <> 0 And Keys(i).AltGr <> 0 Then 'return the altgr value
Keys(i).Down = Keys(i).AltGr
ElseIf Shift <> 0 And Keys(i).Shift <> 0 Then 'return the shift value
Keys(i).Down = Keys(i).Shift
If _CapsLock = 0 Then 'caps lock basically reverses the behavior of the shift key with the letters A-Z and a-z
Select Case i
Case 65 To 90: Keys(i).Down = Keys(i).ASCII
End Select
End If
ElseIf (Ctrl <> 0) And (Keys(i).Ctrl <> 0) Then 'return the ctrl value
Keys(i).Down = Keys(i).Ctrl
ElseIf Alt <> 0 And Keys(i).Alt <> 0 Then 'return the alt value
Keys(i).Down = Keys(i).Alt
Else 'all that's left is to return the ASCII value
Keys(i).Down = Keys(i).ASCII
If _CapsLock = 0 Then 'caps lock basically reverses the behavior of the shift key with the letters A-Z and a-z
Select Case i
Case 65 To 90: Keys(i).Down = Keys(i).Shift
End Select
End If
End If
ReturnCount = ReturnCount + 1 'add one to the return buffer
ReturnValues(ReturnCount) = Keys(i).Down 'and store the value in the buffer
If Keys(i).Repeat = -1 Then 'keys that are set to a -1 on repeat simply toggle state as on, or off.
Keys(i).LastHit = 1E+1000 'such as SHIFT, CTRL, ALT...
Else
Keys(i).LastHit = ExtendedTimer + Keys(i).Repeat 'and record when we hit it for repeat purposes
End If
End If
End If
Else
If Keys(i).Down Then 'the key was down on the last pass
ReturnCount = ReturnCount + 1
ReturnValues(ReturnCount) = -Keys(i).Down 'mark it as being up on this one
End If
Keys(i).Down = 0 'and set it back down for future passes
Keys(i).LastHit = 0 'once again, set it as being ready to be hit again
End If
Next
If ReturnCount > 0 Then 'If we generated a cue of values last pass, clear those up first, before getting new values.
'The only time we really see this is when we hit a shift, ctrl, alt key, usually.
KeyHit = ReturnValues(1)
For i = 1 To ReturnCount - 1
ReturnValues(i) = ReturnValues(i + 1)
Next
ReturnCount = ReturnCount - 1
Exit Function
End If
End If 'End of IF _WINDOWHASFOCUS
$Else
KeyHit = _KEYHIT
$End If
End Function
Sub Remap_KeyCode (Which As Long, ASCII As Long, Ctrl As Long, Shift As Long, Alt As Long, AltGr As Long, Repeat As _Float)
Dim i As Long
i = Which
Keys(i).Index = i
Keys(i).ASCII = ASCII
Keys(i).Ctrl = Ctrl
Keys(i).Shift = Shift
Keys(i).Alt = Alt
Keys(i).AltGr = AltGr
Keys(i).Repeat = Repeat
Keys(i).LastHit = 0
Keys(i).Down = 0
End Sub
SUB Remap_Extended_KeyCode (Which&, AltShift&, AltCtrl&, AltAltGr&, _
CtrlShift&, CtrlAltGr&, ShiftAltGr&, CtrlAltShift&)
Keys(Which&).AltShift = AltShift&
Keys(Which&).AltCtrl = AltCtrl&
Keys(Which&).AltAltGr = AltAltGr&
Keys(Which&).CtrlShift = CtrlShift&
Keys(Which&).CtrlAltGr = CtrlAltGr&
Keys(Which&).ShiftAltGr = ShiftAltGr&
Keys(Which&).CtrlAltShift = CtrlAltShift&
End Sub
Function KeyDown& (Code As Long)
If Code <= 0 Then Exit Function
For i = 1 To 254
If GetAsyncKeyState(i) Then 'first check for actual physical keys down
If Keys(i).ASCII = Code Then KeyDown = -1: Exit Function 'then check to see if the code matches anything we've mapped it to.
If Keys(i).Shift = Code Then KeyDown = -1: Exit Function
If Keys(i).Alt = Code Then KeyDown = -1: Exit Function
If Keys(i).AltGr = Code Then KeyDown = -1: Exit Function
If Keys(i).AltShift = Code Then KeyDown = -1: Exit Function
If Keys(i).AltCtrl = Code Then KeyDown = -1: Exit Function
If Keys(i).AltAltGr = Code Then KeyDown = -1: Exit Function
If Keys(i).CtrlShift = Code Then KeyDown = -1: Exit Function
If Keys(i).CtrlAltGr = Code Then KeyDown = -1: Exit Function
If Keys(i).ShiftAltGr = Code Then KeyDown = -1: Exit Function
If Keys(i).CtrlAltShift = Code Then KeyDown = -1: Exit Function
End If
Next
KeyDown& = 0
End Function
Sub Init_KeyCodes (Language As String)
Restore default_keyboard_data
For i = 1 To 254
Read Keys(i).Index, Keys(i).ASCII, Keys(i).Ctrl, Keys(i).Shift, Keys(i).Alt, Keys(i).AltGr, Keys(i).Repeat
Keys(i).LastHit = 0: Keys(i).Down = 0
Next
default_keyboard_data:
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 1,900001,0,0,0,0,0.2: 'Left Mouse Button
Data 2,900002,0,0,0,0,0.2: 'Right Mouse Button
Data 3,900003,0,0,0,0,0.2: 'VK_Cancel
Data 4,900004,0,0,0,0,0.2: 'Middle Mouse Button
Data 5,900005,0,0,0,0,0.2: 'Mouse Button 4
Data 6,900006,0,0,0,0,0.2: 'Mouse Button 5
Data 7,900007,0,0,0,0,0.2: 'Undefined
Data 8,8,0,0,0,0,0.2: 'Backspace
Data 9,9,0,0,0,0,0.2: 'Tab
Data 10,900010,0,0,0,0,0.2: 'Reserved
Data 11,900011,0,0,0,0,0.2: 'Reserved
Data 12,19456,0,0,0,0,0.2: 'Clear
Data 13,13,0,0,0,0,0.2: 'Enter
Data 14,900014,0,0,0,0,0.2: 'Undefined
Data 15,900015,0,0,0,0,0.2: 'Undefined
Data 16,100016,0,0,0,0,-1: 'Shift (Notice I set it to simple toddle and report UP/DOWN results for us)
Data 17,100017,0,0,0,0,-1: 'Ctrl (Same)
Data 18,100018,0,0,0,0,-1: 'Alt (Same)
Data 19,100019,0,0,0,0,0.2: 'Pause
Data 20,100301,0,0,0,0,-1: 'Caps Lock
Data 21,900021,0,0,0,0,0.2: 'VK_Hangul
Data 22,900022,0,0,0,0,0.2: 'Undefined
Data 23,900023,0,0,0,0,0.2: 'VK_Junja
Data 24,900024,0,0,0,0,0.2: 'VK_Final
Data 25,900025,0,0,0,0,0.2: 'VK_Hanga//VK_Kanji
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 26,900026,0,0,0,0,0.2: 'Undefined
Data 27,27,0,0,0,0,0.2: 'ESC
Data 28,900028,0,0,0,0,0.2: 'VK_Convert
Data 29,900029,0,0,0,0,0.2: 'VK_NonConvert
Data 30,900030,0,0,0,0,0.2: 'VK_Accept
Data 31,900031,0,0,0,0,0.2: 'VK_ModeChange
Data 32,32,0,0,0,0,0.2: 'VK_Space
Data 33,18688,0,0,0,0,0.2: 'Page Up
Data 34,20736,0,0,0,0,0.2: 'Page Down
Data 35,20224,0,0,0,0,0.2: 'End
Data 36,18176,0,0,0,0,0.2: 'Home
Data 37,19200,0,0,0,0,0.2: 'Left Arrow
Data 38,18432,0,0,0,0,0.2: 'Up Arrow
Data 39,19712,0,0,0,0,0.2: 'Right Arrow
Data 40,20480,0,0,0,0,0.2: 'Down Arrow
Data 41,900041,0,0,0,0,-1: 'VK_SELECT
Data 42,900042,0,0,0,0,-1: 'CK_PRINT
Data 43,900043,0,0,0,0,-1: 'VK_EXECUTE
Data 44,900044,0,0,0,0,-1: 'VK_SNAPSHOT
Data 45,20992,0,0,0,0,0.2: 'INS
Data 46,21248,0,0,0,0,0.2: 'DEL
Data 47,900047,0,0,0,0,0.2: 'VK_HELP
Data 48,48,0,41,0,0,0.2: '0
Data 49,49,0,33,0,0,0.2: '1
Data 50,50,0,64,0,0,0.2: '2
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 51,51,0,35,0,0,0.2: '3
Data 52,52,0,36,0,0,0.2: '4
Data 53,53,0,37,0,0,0.2: '5
Data 54,54,0,94,0,0,0.2: '6
Data 55,55,0,38,0,0,0.2: '7
Data 56,56,0,42,0,0,0.2: '8
Data 57,57,0,40,0,0,0.2: '9
Data 58,900058,0,0,0,0,0.2: 'Undefined
Data 59,900059,0,0,0,0,0.2: 'Undefined
Data 60,900060,0,0,0,0,0.2: 'Undefined
Data 61,900061,0,0,0,0,0.2: 'Undefined
Data 62,900062,0,0,0,0,0.2: 'Undefined
Data 63,900063,0,0,0,0,0.2: 'Undefined
Data 64,900064,0,0,0,0,0.2: 'Undefined
Data 65,65,0,97,0,0,0.2: 'a
Data 66,66,0,98,0,0,0.2: 'b
Data 67,67,0,99,0,0,0.2: 'c
Data 68,68,0,100,0,0,0.2: 'd
Data 69,69,0,101,0,0,0.2: 'e
Data 70,70,0,102,0,0,0.2: 'f
Data 71,71,0,103,0,0,0.2: 'g
Data 72,72,0,104,0,0,0.2: 'h
Data 73,73,0,105,0,0,0.2: 'i
Data 74,74,0,106,0,0,0.2: 'j
Data 75,75,0,107,0,0,0.2: 'k
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 76,76,0,108,0,0,0.2: 'l
Data 77,77,0,109,0,0,0.2: 'm
Data 78,78,0,110,0,0,0.2: 'n
Data 79,79,0,111,0,0,0.2: 'o
Data 80,80,0,112,0,0,0.2: 'p
Data 81,81,0,113,0,0,0.2: 'q
Data 82,82,0,114,0,0,0.2: 'r
Data 83,83,0,115,0,0,0.2: 's
Data 84,84,0,116,0,0,0.2: 't
Data 85,85,0,117,0,0,0.2: 'u
Data 86,86,0,118,0,0,0.2: 'v
Data 87,87,0,119,0,0,0.2: 'w
Data 88,88,0,120,0,0,0.2: 'x
Data 89,89,0,121,0,0,0.2: 'y
Data 90,90,0,122,0,0,0.2: 'z
Data 91,100311,0,0,0,0,-1: 'Left WIN
Data 92,100312,0,0,0,0,-1: 'Right WIN
Data 93,100319,0,0,0,0,-1: 'Applications (Menu)
Data 94,900094,0,0,0,0,0.2: 'Reserved
Data 95,900095,0,0,0,0,0.2: 'VK_SLEEP
Data 96,48,0,0,0,0,0.2: 'Numpad 0
Data 97,49,0,0,0,0,0.2: 'Numpad 1
Data 98,50,0,0,0,0,0.2: 'Numpad 2
Data 99,51,0,0,0,0,0.2: 'Numpad 3
Data 100,52,0,0,0,0,0.2: 'Numpad 4
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 101,53,0,0,0,0,0.2: 'Numpad 5
Data 102,54,0,0,0,0,0.2: 'Numpad 6
Data 103,55,0,0,0,0,0.2: 'Numpad 7
Data 104,56,0,0,0,0,0.2: 'Numpad 8
Data 105,57,0,0,0,0,0.2: 'Numpad 9
Data 106,42,0,0,0,0,0.2: 'Numpad *
Data 107,43,0,0,0,0,0.2: 'Numpad +
Data 108,900108,0,0,0,0,0.2: 'VK_SEPARATOR
Data 109,51,0,0,0,0,0.2: 'Numpad -
Data 110,52,0,0,0,0,0.2: 'Numpad .
Data 111,53,0,0,0,0,0.2: 'Numpad /
Data 112,15104,0,0,0,0,0.2: 'F1
Data 113,15360,0,0,0,0,0.2: 'F2
Data 114,15616,0,0,0,0,0.2: 'F3
Data 115,15872,0,0,0,0,0.2: 'F4
Data 116,16128,0,0,0,0,0.2: 'F5 /
Data 117,16384,0,0,0,0,0.2: 'F6
Data 118,16640,0,0,0,0,0.2: 'F7
Data 119,16896,0,0,0,0,0.2: 'F8
Data 120,17152,0,0,0,0,0.2: 'F9
Data 121,17408,0,0,0,0,0.2: 'F10
Data 122,34048,0,0,0,0,0.2: 'F11
Data 123,34304,0,0,0,0,0.2: 'F12
Data 124,900124,0,0,0,0,0.2: 'F13
Data 125,900125,0,0,0,0,0.2: 'F14
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 126,900126,0,0,0,0,0.2: 'F15
Data 127,900127,0,0,0,0,0.2: 'F16
Data 128,900128,0,0,0,0,0.2: 'F17
Data 129,900129,0,0,0,0,0.2: 'F18
Data 130,900130,0,0,0,0,0.2: 'F19
Data 131,900131,0,0,0,0,0.2: 'F20
Data 132,900132,0,0,0,0,0.2: 'F21
Data 133,900133,0,0,0,0,0.2: 'F22
Data 134,900134,0,0,0,0,0.2: 'F23
Data 135,900135,0,0,0,0,0.2: 'F24
Data 136,900136,0,0,0,0,0.2: 'Unassigned
Data 137,900137,0,0,0,0,0.2: 'Unassigned
Data 138,900138,0,0,0,0,0.2: 'Unassigned
Data 139,900139,0,0,0,0,0.2: 'Unassigned
Data 140,900140,0,0,0,0,0.2: 'Unassigned
Data 141,900141,0,0,0,0,0.2: 'Unassigned
Data 142,900142,0,0,0,0,0.2: 'Unassigned
Data 143,900143,0,0,0,0,0.2: 'Unassigned
Data 144,100300,0,0,0,0,-1: 'NUM LOCK
Data 145,100302,0,0,0,0,-1: 'SCROLL LOCK
Data 146,900146,0,0,0,0,0.2: 'OEM SPECIFIC
Data 147,900147,0,0,0,0,0.2: 'OEM SPECIFIC
Data 148,900148,0,0,0,0,0.2: 'OEM SPECIFIC
Data 149,900149,0,0,0,0,0.2: 'OEM SPECIFIC
Data 150,900150,0,0,0,0,0.2: 'OEM SPECIFIC
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 151,900151,0,0,0,0,0.2: 'Unassigned
Data 152,900152,0,0,0,0,0.2: 'Unassigned
Data 153,900153,0,0,0,0,0.2: 'Unassigned
Data 154,900154,0,0,0,0,0.2: 'Unassigned
Data 155,900155,0,0,0,0,0.2: 'Unassigned
Data 156,900156,0,0,0,0,0.2: 'Unassigned
Data 157,900157,0,0,0,0,0.2: 'Unassigned
Data 158,900158,0,0,0,0,0.2: 'Unassigned
Data 159,900159,0,0,0,0,0.2: 'Unassigned
Data 160,100304,0,0,0,0,-1: 'Left Shift
Data 161,100303,0,0,0,0,-1: 'Right Shift
Data 162,100306,0,0,0,0,-1: 'Left Control
Data 163,100305,0,0,0,0,-1: 'Right Control
Data 164,100308,0,0,0,0,-1: 'Left Alt
Data 165,100309,0,0,0,0,-1: 'Right Alt
Data 166,900166,0,0,0,0,0.2: 'Browser back
Data 167,900167,0,0,0,0,0.2: 'Browser forward
Data 168,900168,0,0,0,0,0.2: 'Browser refresh
Data 169,900169,0,0,0,0,0.2: 'Browser stop
Data 170,900170,0,0,0,0,0.2: 'Browser search
Data 171,900171,0,0,0,0,0.2: 'Browser favorites
Data 172,900172,0,0,0,0,0.2: 'Browser home
Data 173,900173,0,0,0,0,0.2: 'Mute
Data 174,900174,0,0,0,0,0.2: 'Vol Down
Data 175,900175,0,0,0,0,0.2: 'Vol Up
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 176,900176,0,0,0,0,0.2: 'Media Next
Data 177,900177,0,0,0,0,0.2: 'Media prev
Data 178,900178,0,0,0,0,0.2: 'Media stop
Data 179,900179,0,0,0,0,0.2: 'Media Play/Pause
Data 180,900180,0,0,0,0,0.2: 'Launch mail
Data 181,900181,0,0,0,0,0.2: 'Launch media select
Data 182,900182,0,0,0,0,0.2: 'Launch app1
Data 183,900183,0,0,0,0,0.2: 'Launch app2
Data 184,900184,0,0,0,0,0.2: 'Reserved
Data 185,900185,0,0,0,0,0.2: 'Reserved
Data 186,59,0,58,0,0,0.2: ';:
Data 187,61,0,43,0,0,0.2: '=+
Data 188,44,0,60,0,0,0.2: ',<
Data 189,45,0,95,0,0,0.2: '-_
Data 190,46,0,62,0,0,0.2: '.>
Data 191,47,0,63,0,0,0.2: '/?
Data 192,96,0,126,0,0,0.2: '`~
Data 193,900193,0,0,0,0,0.2: 'Reserved
Data 194,900194,0,0,0,0,0.2: 'Reserved
Data 195,900195,0,0,0,0,0.2: 'Reserved
Data 196,900196,0,0,0,0,0.2: 'Reserved
Data 197,900197,0,0,0,0,0.2: 'Reserved
Data 198,900198,0,0,0,0,0.2: 'Reserved
Data 199,900199,0,0,0,0,0.2: 'Reserved
Data 200,900200,0,0,0,0,0.2: 'Reserved
' Index Unmodified Ctrl Shift Alt AltGr Repeat
Data 201,900201,0,0,0,0,0.2: 'Reserved
Data 202,900202,0,0,0,0,0.2: 'Reserved
Data 203,900203,0,0,0,0,0.2: 'Reserved
Data 204,900204,0,0,0,0,0.2: 'Reserved
Data 205,900205,0,0,0,0,0.2: 'Reserved
Data 206,900206,0,0,0,0,0.2: 'Reserved
Data 207,900207,0,0,0,0,0.2: 'Reserved
Data 208,900208,0,0,0,0,0.2: 'Reserved
Data 209,900209,0,0,0,0,0.2: 'Reserved
Data 210,900210,0,0,0,0,0.2: 'Reserved
Data 211,900211,0,0,0,0,0.2: 'Reserved
Data 212,900212,0,0,0,0,0.2: 'Reserved
Data 213,900213,0,0,0,0,0.2: 'Reserved
Data 214,900214,0,0,0,0,0.2: 'Reserved
Data 215,900215,0,0,0,0,0.2: 'Reserved
Data 216,900216,0,0,0,0,0.2: 'Unassigned
Data 217,900217,0,0,0,0,0.2: 'Unassigned
Data 218,900218,0,0,0,0,0.2: 'Unassigned
Data 219,91,0,123,0,0,0.2: '[{
Data 220,92,0,124,0,0,0.2: '\|
Data 221,93,0,125,0,0,0.2: ']}
Data 222,39,0,34,0,0,0.2: ''"
Data 223,900223,0,0,0,0,0.2: 'OEM SPECIFIC
Data 224,900224,0,0,0,0,0.2: 'Reserved
Data 225,900225,0,0,0,0,0.2: 'OEM SPECIFIC d
Data 226,900226,0,0,0,0,0.2: 'Either the Angle Bracket key,or Backslash on RT 102-key keyboard
Data 227,900227,0,0,0,0,0.2: 'OEM SPECIFIC
Data 228,900228,0,0,0,0,0.2: 'OEM SPECIFIC
Data 229,900229,0,0,0,0,0.2: 'IME PROCESS key (whatever that is)
Data 230,900230,0,0,0,0,0.2: 'OEM SPECIFIC
Data 231,900231,0,0,0,0,0.2: 'Used to pass UNICODE characters (however that works)
Data 232,900232,0,0,0,0,0.2: 'Unassigned
Data 233,900233,0,0,0,0,0.2: 'OEM SPECIFIC
Data 234,900234,0,0,0,0,0.2: 'OEM SPECIFIC
Data 235,900235,0,0,0,0,0.2: 'OEM SPECIFIC
Data 236,900236,0,0,0,0,0.2: 'OEM SPECIFIC
Data 237,900237,0,0,0,0,0.2: 'OEM SPECIFIC
Data 238,900238,0,0,0,0,0.2: 'OEM SPECIFIC
Data 239,900239,0,0,0,0,0.2: 'OEM SPECIFIC
Data 240,900240,0,0,0,0,0.2: 'OEM SPECIFIC
Data 241,900241,0,0,0,0,0.2: 'OEM SPECIFIC
Data 242,900242,0,0,0,0,0.2: 'OEM SPECIFIC
Data 243,900243,0,0,0,0,0.2: 'OEM SPECIFIC
Data 244,900244,0,0,0,0,0.2: 'OEM SPECIFIC
Data 245,900245,0,0,0,0,0.2: 'OEM SPECIFIC
Data 246,900246,0,0,0,0,0.2: 'VK_ATTN
Data 247,900247,0,0,0,0,0.2: 'VK_ATTN
Data 248,900248,0,0,0,0,0.2: 'VK_ATTN
Data 249,900249,0,0,0,0,0.2: 'VK_ATTN
Data 250,900250,0,0,0,0,0.2: 'VK_ATTN
Data 251,900251,0,0,0,0,0.2: 'VK_ATTN
Data 252,900252,0,0,0,0,0.2: 'Reserved
Data 253,900253,0,0,0,0,0.2: 'VK_PA1
Data 254,900253,0,0,0,0,0.2: 'VK_OEM_CLEAR
Data 0,0,0,0,0,0,0.2: 'END OF DATA
AltGr(0) = 165
AltGr(1) = 0
Select Case Language
Case "DE"
Restore Microsoft_windows_cp1250
For i = 128 To 255
Read unicode
_MapUnicode unicode To ASCIIcode
Next
Microsoft_windows_cp1250:
Data 8364,0,8218,0,8222,8230,8224,8225,0,8240,352,8249,346,356,381,377
Data 0,8216,8217,8220,8221,8226,8211,8212,0,8482,353,8250,347,357,382,378
Data 160,711,728,321,164,260,166,167,168,169,350,171,172,173,174,379
Data 176,177,731,322,180,181,182,183,184,261,351,187,317,733,318,380
Data 340,193,194,258,196,313,262,199,268,201,280,203,282,205,206,270
Data 272,323,327,211,212,336,214,215,344,366,218,368,220,221,354,223
Data 341,225,226,259,228,314,263,231,269,233,281,235,283,237,238,271
Data 273,324,328,243,244,337,246,247,345,367,250,369,252,253,355,729
'Remap_KeyCode (Which, ASCII, Ctrl , Shift, Alt, AltGr, Repeat AS _FLOAT)
Remap_KeyCode 226, 60, 0, 62, 124, 92, 0.2 '<>|
Remap_KeyCode 219, 225, 0, 63, 0, 0, 0.2 '-
Remap_KeyCode 48, 48, 0, 61, 0, 125, 0.2 '0
Remap_KeyCode 192, 148, 0, 153, 0, 0, 0.2
Remap_KeyCode 222, 132, 0, 142, 0, 0, 0.2
Remap_KeyCode 50, 50, 0, 34, 0, 253, 0.2: '2 .. I don't see a superscript 3 for AltGr codes for the 3 key.
Remap_KeyCode 51, 51, 0, 35, 0, 0, 0.2: '3 ..I don't see the squiggle for this in the ASCII code. It needs to be changed, but I dunno with what.
Remap_KeyCode 54, 54, 0, 38, 0, 0, 0.2: '6
Remap_KeyCode 55, 55, 0, 47, 0, 123, 0.2: '7
Remap_KeyCode 56, 56, 0, 40, 0, 91, 0.2: '8
Remap_KeyCode 57, 57, 0, 41, 0, 93, 0.2: '9
Remap_KeyCode 186, 129, 0, 154, 0, 0, 0.2: ';:
Remap_KeyCode 187, 43, 0, 42, 0, 126, 0.2: '=+
Remap_KeyCode 191, 35, 0, 249, 0, 0, 0.2: '/?
Remap_KeyCode 81, 81, 0, 113, 0, 64, 0.2: 'q
Remap_KeyCode 69, 69, 0, 101, 0, 238, 0.2: 'e
Remap_KeyCode 77, 77, 0, 109, 0, 0, 0.2: 'm -- again, I failed to find the goofy u which AltGr produces in the 256 ASCII set
Case "WE"
Restore Microsoft_windows_cp1252
For i = 128 To 255
Read unicode
_MapUnicode unicode To ASCIIcode
Next
Microsoft_windows_cp1252:
Data 8364,0,8218,402,8222,8230,8224,8225,710,8240,352,8249,338,0,381,0
Data 0,8216,8217,8220,8221,8226,8211,8212,732,8482,353,8250,339,0,382,376
Data 160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175
Data 176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191
Data 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207
Data 208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223
Data 224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239
Data 240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255
'remap_KeyCode (Which, ASCII, Ctrl , Shift, Alt, AltGr, Repeat AS _FLOAT)
Remap_KeyCode 188, 44, 0, 59, 0, 0, 0.2: ',;
Remap_KeyCode 190, 46, 0, 58, 0, 0, 0.2: '.:
Remap_KeyCode 50, 50, 0, 34, 0, 0, 0.2: '2 "
Remap_KeyCode 51, 51, 0, 156, 0, 0, 0.2: '3 œ
Remap_KeyCode 191, 151, 0, 21, 0, 0, 0.2: '£
Remap_KeyCode 222, 133, 0, 248, 0, 35, 0.2: '… ø#
Remap_KeyCode 192, 149, 0, 128, 0, 64, 0.2: '• € @
Remap_KeyCode 186, 138, 0, 130, 0, 91, 0.2 'Š ‚ [
Remap_KeyCode 187, 43, 0, 42, 0, 93, 0.2 ' + * ]
Remap_KeyCode 54, 54, 0, 38, 0, 0, 0.2 '6 &
Remap_KeyCode 55, 55, 0, 47, 0, 0, 0.2 '7 /
Remap_KeyCode 56, 56, 0, 40, 0, 0, 0.2 '8(
Remap_KeyCode 57, 57, 0, 41, 0, 0, 0.2 '9 )
Remap_KeyCode 48, 48, 0, 61, 0, 0, 0.2 '0 =
Remap_KeyCode 219, 39, 0, 63, 0, 0, 0.2 ' ' ?
Remap_KeyCode 221, 141, 0, 94, 0, 0, 0.2 ' ^
Remap_KeyCode 226, 60, 0, 62, 0, 0, 0.2 '< >
Case "IT"
Restore ASCII_cp850
For i = 128 To 255
Read unicode
_MapUnicode unicode To ASCIIcode
Next
ASCII_cp850:
Data 199,252,233,226,228,224,229,231,234,235,232,239,238,236,196,197
Data 201,230,198,244,246,242,251,249,255,214,220,248,163,216,215,402
Data 225,237,243,250,241,209,170,186,191,174,172,189,188,161,171,187
Data 9617,9618,9619,9474,9508,193,194,192,169,9571,9553,9559,9565,162,165,9488
Data 9492,9524,9516,9500,9472,9532,227,195,9562,9556,9577,9574,9568,9552,9580,164
Data 240,208,202,203,200,305,205,206,207,9496,9484,9608,9604,166,204,9600
Data 211,223,212,210,245,213,181,254,222,218,219,217,253,221,175,180
Data 173,177,8215,190,182,167,247,184,176,168,183,185,179,178,9632,160
'remap_KeyCode (Which, ASCII, Ctrl , Shift, Alt, AltGr, Repeat AS _FLOAT)
Remap_KeyCode 188, 44, 0, 59, 0, 0, 0.2: ',;
Remap_KeyCode 190, 46, 0, 58, 0, 0, 0.2: '.:
Remap_KeyCode 50, 50, 0, 34, 0, 0, 0.2: '2 "
Remap_KeyCode 51, 51, 0, 156, 0, 0, 0.2: '3 œ
Remap_KeyCode 191, 151, 0, 21, 0, 0, 0.2: '£
Remap_KeyCode 222, 133, 0, 248, 0, 35, 0.2: '… ø#
Remap_KeyCode 192, 149, 0, 128, 0, 64, 0.2: '• € @
Remap_KeyCode 186, 138, 0, 130, 0, 91, 0.2 'Š ‚ [
Remap_KeyCode 187, 43, 0, 42, 0, 93, 0.2 ' + * ]
Remap_KeyCode 54, 54, 0, 38, 0, 0, 0.2 '6 &
Remap_KeyCode 55, 55, 0, 47, 0, 0, 0.2 '7 /
Remap_KeyCode 56, 56, 0, 40, 0, 0, 0.2 '8(
Remap_KeyCode 57, 57, 0, 41, 0, 0, 0.2 '9 )
Remap_KeyCode 48, 48, 0, 61, 0, 0, 0.2 '0 =
Remap_KeyCode 219, 39, 0, 63, 0, 0, 0.2 ' ' ?
Remap_KeyCode 221, 141, 0, 94, 0, 0, 0.2 ' ^
Remap_KeyCode 226, 60, 0, 62, 0, 0, 0.2 '< >
End Select
End Sub
$If EXTENDEDTIMER = UNDEFINED Then
$LET EXTENDEDTIMER = TRUE
FUNCTION ExtendedTimer##
'modified extendedtimer to store the old day's count, and not have to recalculate it every time the routine is called.
STATIC olds AS _FLOAT, old_day AS _FLOAT
DIM m AS INTEGER, d AS INTEGER, y AS INTEGER
DIM s AS _FLOAT, day AS STRING
IF olds = 0 THEN 'calculate the day the first time the extended timer runs
day = DATE$
m = VAL(LEFT$(day, 2))
d = VAL(MID$(day, 4, 2))
y = VAL(RIGHT$(day, 4)) - 1970
SELECT CASE m 'Add the number of days for each previous month passed
CASE 2: d = d + 31
CASE 3: d = d + 59
CASE 4: d = d + 90
CASE 5: d = d + 120
CASE 6: d = d + 151
CASE 7: d = d + 181
CASE 8: d = d + 212
CASE 9: d = d + 243
CASE 10: d = d + 273
CASE 11: d = d + 304
CASE 12: d = d + 334
END SELECT
IF (y MOD 4) = 2 AND m > 2 THEN d = d + 1 'add a day if this is leap year and we're past february
d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
d = d + (y + 2) \ 4 'add in days for leap years passed
s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
old_day = s
END IF
IF TIMER < oldt THEN 'we went from 23:59:59 (a second before midnight) to 0:0:0 (midnight)
old_day = s + 83400 'add another worth of seconds to our counter
END IF
oldt = TIMER
olds = old_day + oldt
ExtendedTimer## = olds
END FUNCTION
$End If
Sub ExtendedInput (prompt$, result$) 'Over Engineered Input
'limit VALUES:
'1 = Unsigned
'2 = Integer
'4 = Float
'8 = Who cares. It's handled via internal variables and we don't need to know a type for it.
'Uses {} at the start of the prompt to limit possible input
'P = Password
'U = Unsigned
'I = Integer
'F = Float
'L## = Length of max ##
'X##, Y## = LOCATE before printing
'D = Disable paste option
'V = Move CTRL-V to AFTER paste
'H = Hide Input after finished. (Won't leave prompt, or user input on the screen.)
PCopy 0, 1
A = _AutoDisplay: X = Pos(0): Y = CsrLin
OX = X: OY = Y 'original x and y positions
CP = 0: OldCP = 0 'Cursor Position
_KeyClear
length_limit = -1 'unlimited length input, by default
If Left$(prompt$, 1) = "{" Then 'possible limiter
i = InStr(prompt$, "}")
If i Then 'yep, we have something!
limiter$ = UCase$(Mid$(prompt$, 2, i - 2))
If InStr(limiter$, "U") Then limit = limit Or 1 'Unsigned
If InStr(limiter$, "I") Then 'can't limit to BOTH an integer AND a float
limit = limit Or 2 'Integer
ElseIf InStr(limiter$, "F") Then
limit = limit Or 4 'Float
float_before_limit = KB_GetValue(limiter$, "F")
float_after_limit = KB_GetValue(Mid$(limiter$, InStr(limiter$, "F") + 1), ".")
End If
End If
If InStr(limiter$, "P") Then password_protected = -1: limit = limit Or 8 'don't show passwords.
If InStr(limiter$, "L") Then 'Length Limitation
limit = limit Or 8
length_limit = KB_GetValue(limiter$, "L")
End If
If InStr(limiter$, "X") Then 'X position on screen
limit = limit Or 8
X = KB_GetValue(limiter$, "X")
End If
If InStr(limiter$, "Y") Then 'Y position on scren
limit = limit Or 8
Y = KB_GetValue(limiter$, "Y")
End If
If InStr(limiter$, "D") Then disable_paste = -1: limit = limit Or 8 'disable paste
If InStr(limiter$, "V") Then cursor_after_paste = -1: limit = limit Or 8 'disable paste
If InStr(limiter$, "H") Then clean_exit = -1: limit = limit Or 8 'hide after finished
End If
If limit <> 0 Then prompt$ = Mid$(prompt$, i + 1)
Do
PCopy 1, 0
If _KeyDown(100307) Or _KeyDown(100308) Then AltDown = -1 Else AltDown = 0
k = KeyHit
If AltDown Then
Select Case k 'ignore all keypresses except ALT-number presses
Case -57 To -48: AltWasDown = -1: alt$ = alt$ + Chr$(-k)
End Select
Else
Select Case k 'without alt, add any keypresses to our input
Case 8
oldin$ = in$
If CP > 0 Then OldCP = CP: CP = CP - 1
in$ = Left$(in$, CP) + Mid$(in$, CP + 2) 'backspace to erase input
Case 9
oldin$ = in$
in$ = Left$(in$, CP) + Space$(4) + Mid$(in$, CP + 1) 'four spaces for any TAB entered
OldCP = CP
CP = CP + 4
Case 32 To 128
If _KeyDown(100305) Or _KeyDown(100306) Then
If k = 118 Or k = 86 Then
If disable_paste = 0 Then
oldin$ = in$
temp$ = _Clipboard$
in$ = Left$(in$, CP) + temp$ + Mid$(in$, CP + 1) 'ctrl-v paste
'CTRL-V leaves cursor in position before the paste, without moving it after.
'Feel free to modify that behavior here, if you want it to move to after the paste.
If cursor_after_paste Then CP = CP + Len(temp$)
End If
End If
If k = 122 Or k = 90 Then Swap in$, oldin$: Swap OldCP, CP 'ctrl-z undo
Else
check_input:
oldin$ = in$
If limit And 1 Then 'unsigned
If k = 43 Or k = 45 Then _Continue 'remove signs +/-
End If
If limit And 2 Then 'integer
If k = 45 And CP = 0 Then GoTo good_input 'only allow a - sign for the first digit
If k < 48 Or k > 57 Then _Continue 'remove anything non-numeric
End If
If limit And 4 Then 'float
If k = 45 And CP = 0 Then GoTo good_input 'only allow a - sign for the first digit
If k = 46 And InStr(in$, ".") = 0 Then GoTo good_input 'only one decimal point
If k < 48 Or k > 57 Then _Continue 'remove anything non-numeric
If Left$(in$, 1) = "-" Then temp$ = Mid$(in$, 2) Else temp$ = in$
If InStr(in$, ".") = 0 Or CP < InStr(in$, ".") Then
If Len(temp$) < float_before_limit Or float_before_limit = -1 Then
in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
OldCP = CP
CP = CP + 1
End If
Else
temp$ = Mid$(in$, InStr(in$, ".") + 1)
If Len(temp$) < float_after_limit Or float_after_limit = -1 Then
in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
OldCP = CP
CP = CP + 1
End If
End If
_Continue
End If
good_input:
If CP < length_limit Or length_limit < 0 Then
in$ = Left$(in$, CP) + Chr$(k) + Mid$(in$, CP + 1) 'add input to our string
OldCP = CP
CP = CP + 1
End If
End If
Case 18176 'Home
CP = 0
Case 20224 'End
CP = Len(in$)
Case 21248 'Delete
oldin$ = in$
in$ = Left$(in$, CP) + Mid$(in$, CP + 2)
Case 19200 'Left
CP = CP - 1
If CP < 0 Then CP = 0
Case 19712 'Right
CP = CP + 1
If CP > Len(in$) Then CP = Len(in$)
End Select
End If
alt$ = Right$(alt$, 3)
If AltWasDown = -1 And AltDown = 0 Then
v = Val(alt$)
If v >= 0 And v <= 255 Then
k = v
alt$ = "": AltWasDown = 0
GoTo check_input
End If
End If
blink = (blink + 1) Mod 30
Locate Y, X
Print prompt$;
If password_protected Then
Print String$(Len(Left$(in$, CP)), "*");
If blink \ 15 Then Print " "; Else Print "_";
Print String$(Len(Mid$(in$, CP + 1)), "*")
Else
Print Left$(in$, CP);
If blink \ 15 Then Print " "; Else Print "_";
Print Mid$(in$, CP + 1)
End If
_Display
_Limit 30
Loop Until k = 13
PCopy 1, 0
Locate OY, OX
If clean_exit = 0 Then
Locate Y, X
If password_protected Then
Print prompt$; String$(Len(in$), "*")
Else
Print prompt$; in$
End If
End If
result$ = in$
If A Then _AutoDisplay
End Sub
Function KB_GetValue (limiter$, what$)
jstart = InStr(limiter$, what$): j = 0
If Mid$(limiter$, InStr(limiter$, what$) + 1, 1) = "-" Then
GetValue = -1 'unlimited
Exit Function
End If
Do
j = j + 1
m$ = Mid$(limiter$, jstart + j, 1)
Loop Until m$ < "0" Or m$ > "9"
KB_GetValue = Val(Mid$(limiter$, jstart + 1, j - 1))
End Function
Note that if you're a windows user, this does something AMAZING for you... It works with ALL the keys on your keyboard!! Even such things as CTRL-TAB reports its value correctly, as does CTRL-1, CTRL-2...
Glut is broken when it comes to a lot of the keyboard interactions, particularly in regards of CTRL and other combination keypresses. This doesn't have that issue. It reads from the Windows API and returns the values of our keypresses to us, bypassing Glut completely.
So not only can you use your mouse or keyboard, but you can use them FULLY and without issues.
All in only a bazillion more lines of code than what Pete is using for his simple little routines.
Posts: 2,417
Threads: 245
Joined: Apr 2022
Reputation:
125
01-27-2025, 10:18 PM
(This post was last modified: 01-27-2025, 10:20 PM by Pete.)
I had to refresh my brain on using hardware acceleration, so I built up the hybrid buttons a bit more...
Code: (Select All)
Overlay = _NewImage(_Width * _FontWidth, _Height * _FontHeight, 32)
ReDim Shared x(0), y(0), button$(0)
Dim Shared BHybFg, BHybBg1, BHybBg2, BHybBdr1, BHybBdr2, Bg
Bg = 5: BHybBg1 = 6: BHybFg = 6: BHybBg2 = 7: BHybBdr1 = 0: BHybBdr2 = 255
Palette 5, 63 ' Bright white.
Palette 6, 56 ' Dark grey.
Color 0, 5 ' Bright white background.
Cls
a$ = " Activate ": button_maker a$, 7, 51
a$ = " Search ": button_maker a$, 7, 66
a$ = " Pause ": button_maker a$, 12, 51
a$ = " Reset ": button_maker a$, 12, 66
nob = 4
Do
_Limit 30
For i = 1 To nob
j = Len(button$(i))
_Dest Overlay
Line (8 * (x(i) - 1), 16 * (y(i) - 1) + 7)-((j + 2) * 8 + 8 * (x(i) - 1), 16 * 2 + 16 * (y(i) - 1) + 7), _RGB32(BHybBdr1, BHybBdr1, BHybBdr1), B
Line (8 * (x(i) - 1) + 8, 16 * (y(i) - 1) + 15)-((j + 1) * 8 + 8 * (x(i) - 1), y(i) * 16 + 15), _RGB32(BHybBdr2, BHybBdr2, BHybBdr2), B
Overlay_Hardware = _CopyImage(Overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_Dest 0
_FreeImage Overlay_Hardware
Next
_Display
Loop Until Len(InKey$)
End
Sub button_maker (button$, y, x)
Static nob
nob = nob + 1
Dim b(15) As String * 1
b(0) = Chr$(0)
b(1) = "Ú"
b(2) = "Ä"
b(3) = "¿"
b(4) = "³"
b(5) = "À"
b(6) = "Ù"
b(7) = "Ã"
b(8) = "´"
b(9) = "Ä"
b(10) = "Â"
b(11) = "Á"
b(12) = "Þ"
b(13) = "Ý"
b(15) = "ß"
b(14) = "Ü"
j = Len(button$)
i = nob
ReDim _Preserve x(i), y(i), button$(i)
y(i) = y: x(i) = x
button$(i) = String$(j, 0)
Mid$(button$(i), 1 + (j - Len(_Trim$(button$))) / 2) = button$
Locate y(i), x(i): Color BHybBg1, Bg: Print String$(j + 2, b(14))
Locate , x(i): Color Bg, BHybBg1: Print String$(j + 2, b(0))
Locate , x(i): Color BHybBg1, Bg: Print String$(j + 2, b(15));
Locate y(i) + 1, x(i) + 1: Color BHybFg, BHybBg2: Print button$;
End Sub
In other news, @SMcNeill
That's neat! It is something I had thought about for a demo, but I realized it's too much to code for just that purpose, alone. Now I know just how much too much was!
I did manage to piss it off a bit. I clicked the KB2 key. The keyboard color changed but then all hell broke loose in memory, going from 96MB to over 1300MB before I hit End Task to shut it down. Memory leak?
Pete
Posts: 2,821
Threads: 334
Joined: Apr 2022
Reputation:
242
(01-27-2025, 10:18 PM)Pete Wrote: That's neat! It is something I had thought about for a demo, but I realized it's too much to code for just that purpose, alone. Now I know just how much too much was!
I did manage to piss it off a bit. I clicked the KB2 key. The keyboard color changed but then all hell broke loose in memory, going from 96MB to over 1300MB before I hit End Task to shut it down. Memory leak?
Pete
Maybe... The demo that I copied that from is about 4 or 5 years old, so there's been several changes in the language in that time. It could be that the code has always had memory issues by not freeing something it should... or it could be a change to the language... or it could just be that it doesn't like YOU.
And you have to remember, this isn't really just a single library at work. This is my KeyHit library which gives us the extra keycodes that GLUT doesn't, on top of my Virtual Keyboard library, which is what gives the keyboards and the buttons which we can interact with. The actual code here (excluding the two libraries which are merged into this one post) is a trifling set of lines of code.
When I get a chance, I'll dig into it sometime and see where/what it's doing with regard to memory. Honestly, it should never jump to 1.3GB of mem usage! Something has to be seriously wrong there, for that to happen!
Posts: 2,417
Threads: 245
Joined: Apr 2022
Reputation:
125
Why do I get the distinct impression you'll just come back later and exclaim, "Nope, everything checks out just fine, so apparently it just doesn't like you!... Hey, I made A.I. and I wasn't even aware of it at the time!"
|
