Posts: 2,480
Threads: 250
Joined: Apr 2022
Reputation:
127
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 | | | | 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$ = "" | | 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 | | 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) | | 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 | | 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); | | | | 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); | | | | 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 | | 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 | | 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) | | 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 | | Color c1, c2 | | Locate y, x | | End Sub |
Pete
Posts: 2,480
Threads: 250
Joined: Apr 2022
Reputation:
127
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$ = "" | | 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 | | 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) | | 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 | | 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); | | | | 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 | | 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); | | | | 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 | | 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 | | 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) | | 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 | | 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,901
Threads: 342
Joined: Apr 2022
Reputation:
255
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,480
Threads: 250
Joined: Apr 2022
Reputation:
127
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 | | Palette 6, 56 | | Color 0, 5 | | 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 | | | | 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); | | | | Return |
Pete
Shoot first and shoot people who ask questions, later.
Posts: 2,901
Threads: 342
Joined: Apr 2022
Reputation:
255
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,480
Threads: 250
Joined: Apr 2022
Reputation:
127
Ha, ha. The last time I feel for that old trick was 45 years ago. My wife is still in Maui.
Pete
Posts: 2,901
Threads: 342
Joined: Apr 2022
Reputation:
255
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,480
Threads: 250
Joined: Apr 2022
Reputation:
127
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 | | Palette 6, 56 | | Color 0, 5 | | 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,901
Threads: 342
Joined: Apr 2022
Reputation:
255
(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,480
Threads: 250
Joined: Apr 2022
Reputation:
127
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!"
|
