Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: RhoSigma on May 28, 2019, 07:06:33 am

Title: Alternative INKEY$ for Western-European languages (CP1252 based)
Post by: RhoSigma on May 28, 2019, 07:06:33 am
Following you find alternative INKEY$ function(s) made to overcome the need to use unicode fonts and respective _MAPUNICODE mappings in your programs. It mostly restores the regular INKEY$ behavior of the old SDL based QB64 versions, which natively had no problems with system codepage to Cp437 mappings.

NOTE:
Just goto the Best Answer post to download forum member Moises its version, which is based on the function below, but was enhanced to support a lot more western european languages, which regulary use windows codepage 1252.

The following code is my routine made explicitly for use in Germany, Austria and other areas with regular german keyboard layouts (probably Liechtenstein and german speaking parts of Switzerland). This function is the base of all further work done by forum member Moises.
Code: QB64: [Select]
  1. '-----------------------
  2. '--- New INKEY$ test ---
  3. '-----------------------
  5.     i$ = ""
  6.     WHILE i$ = ""
  7.         _LIMIT 50
  8.         i$ = KB1031toCP437Inkey$
  9.     WEND
  10.     IF LEN(i$) = 2 THEN
  11.         PRINT "CHR$(0) +", ASC(i$, 2), RIGHT$(i$, 1)
  12.     ELSE
  13.         PRINT "-------->", ASC(i$, 1), i$
  14.     END IF
  15.     IF i$ = CHR$(27) THEN CLS
  16. LOOP UNTIL i$ = CHR$(13)
  18.  
  19. '--------------------------
  20. '--- KB1031toCP437Inkey ---
  21. '--------------------------
  22. ' This alternative INKEY$ function is made for use in Germany/Austria
  23. ' and any QB64-GL versions (>= 1.000). It will directly map the inputs
  24. ' from a german keyboard to the chars available in Cp437, hence you
  25. ' don't need to setup a custom unicode font and _MAPUNICODE table, you
  26. ' can stay with QB64's built-in fonts and standard codepage 437.
  27. ' By this means it solves the INKEY$ issues introduced with the transition
  28. ' from using SDL to using OpenGL regarding special/international chars.
  29. ' However, it does not fix the regular INPUT, LINE INPUT and INPUT$ when
  30. ' used for keyboard input, here you should create your own functions,
  31. ' which use this function to get its inputs.
  32. '----------
  33. ' SYNTAX:
  34. '   keypress$ = KB1031toCP437Inkey$
  35. '----------
  36. ' RESULT:
  37. '   --- keypress$ ---
  38. '    Equivalent to the INKEY$ result (see Wiki-Page at www.qb64.org).
  39. '----------
  40. ' ACCENTS:
  41. '   Note that the accents keys on german keyboards are so called
  42. '   preselection keys, different from modifier keys (Shift/Ctrl/Alt)
  43. '   you don't need to hold them while typing accented chars. You just
  44. '   press it once followed by pressing the letter key once to get the
  45. '   respective accented char (eg. ` + e = Š). To get the accent char
  46. '   itself you either press the space bar after the accent preselection
  47. '   or you press the accent preselection key twice.
  48. '----------
  49. ' LIMITS:
  50. '   Note that the following keys and key combos are not supported
  51. '   for various reasons:
  52. '
  53. '    Two Byte Characters        Key                 CHR$(0) + "?"
  54. '   -------------------------------------------------------------
  55. '   CHR$(0) + CHR$(16-50)      [Alt] + letter
  56. '    rarely used, not in alphabetical order, KB layout dependent,
  57. '    => returns the regular char instead (Alt modifier ignored)
  58. '   CHR$(0) + CHR$(76)         [5 NumberPad]        "L" (NumLock off in QB64)
  59. '    rarely used, almost useless for most applications,
  60. '    => returns nothing
  61. '   CHR$(0) + CHR$(120-129)    [Alt] + number
  62. '    ignored in favor for alternative Alt + ASCII code input method,
  63. '    => returns nothing, but collects numbers to built an ASCII code,
  64. '       the respective char is returned when releasing the Alt-Key
  65. '   CHR$(0) + CHR$(130 or 131) [Alt] + _/- or +/=   "‚" or "ƒ"
  66. '    rarely used, KB layout dependent,
  67. '    => returns the regular char instead (Alt modifier ignored)
  68. '---------------------------------------------------------------------
  69. FUNCTION KB1031toCP437Inkey$
  70. STATIC number$, preKey&
  71. '--- clear result, get next key press/release ---
  72. KB1031toCP437Inkey$ = ""
  74. hit& = _KEYHIT
  75. '--- ignore releases (except number/preselection keys) ---
  76. IF hit& < 0 THEN
  77.     IF (hit& > -48 OR hit& < -57) AND hit& <> -220 AND hit& <> -221 GOTO noInput
  79. '--- get modifiers ---
  80. shift% = _KEYDOWN(100303) OR _KEYDOWN(100304)
  81. ctrl% = _KEYDOWN(100305) OR _KEYDOWN(100306)
  82. altgr% = _KEYDOWN(100307) AND _KEYDOWN(100306)
  83. alt% = (_KEYDOWN(100307) OR _KEYDOWN(100308)) AND NOT altgr%
  84. '--- check preselection keys (accents) ---
  85. IF hit& = -220 OR hit& = -221 THEN
  86.     IF preKey& <> 0 THEN 'double preselection key press
  87.         IF preKey& = -220 AND hit& = -220 AND NOT shift% THEN hit& = 94
  88.         IF preKey& = -221 AND hit& = -221 AND NOT shift% THEN hit& = 39 'not really Acute, but similar replacement
  89.         IF preKey& = 221 AND hit& = -221 AND shift% THEN hit& = 96
  90.         IF hit& < 0 THEN 'update after false values (eg. š release = -220)
  91.             preKey& = hit&
  92.             IF shift% THEN preKey& = -preKey&
  93.             GOTO noInput
  94.         END IF
  95.         preKey& = 0
  96.         GOTO setInkey
  97.     ELSE 'first preselection key press
  98.         preKey& = hit&
  99.         IF shift% THEN preKey& = -preKey&
  100.         GOTO noInput
  101.     END IF
  102. ELSEIF preKey& <> 0 AND hit& > 0 AND hit& <= 255 THEN 'any key after preselection key press
  103.     SELECT CASE preKey&
  104.         CASE -220: RESTORE KB1031toCP437_Circonflex
  105.         CASE -221: RESTORE KB1031toCP437_Acute
  106.         CASE 221: RESTORE KB1031toCP437_Grave
  107.         CASE ELSE: RESTORE KB1031toCP437_None
  108.     END SELECT
  109.     READ cnt% 'start accent lookup
  110.     FOR i% = 1 TO cnt%
  111.         READ keyCode&, charCode&
  112.         IF hit& = keyCode& THEN
  113.             hit& = charCode&
  114.             EXIT FOR
  115.         END IF
  116.     NEXT i%
  117.     preKey& = 0
  118.     IF hit& = charCode& GOTO setInkey 'accent found, go directly to evaluation
  120. '--- use Alt + number keys to enter Cp437 char codes ---
  121. IF NOT shift% AND NOT ctrl% AND alt% AND (hit& >= 48 AND hit& <= 57) THEN
  122.     '[Alt] + Number (CHR$(0) + CHR$({120-129}) ignored in favor
  123.     'for the alternative Alt + ASCII code input method
  124.     GOTO noInput
  125. ELSEIF NOT shift% AND NOT ctrl% AND alt% AND (hit& >= -57 AND hit& <= -48) THEN
  126.     number$ = number$ + CHR$(-hit&)
  127. ELSEIF number$ <> "" AND NOT alt% THEN
  128.     charCode& = VAL(RIGHT$(number$, 3))
  129.     IF charCode& >= 32 AND charCode& <= 255 THEN hit& = charCode&
  130.     number$ = "": preKey& = 0
  131.     GOTO setInkey
  133. '--- control sequences and special behavior ---
  134. IF hit& <= 255 THEN
  135.     IF shift% AND hit& = 9 THEN hit& = 15 * 256 'reverse TAB
  136.     IF ctrl% AND (hit& >= 65 AND hit& <= 90) THEN hit& = hit& - 64
  137.     IF ctrl% AND (hit& >= 97 AND hit& <= 122) THEN hit& = hit& - 96
  138.     IF hit& = 128 THEN hit& = 238: GOTO setInkey 'ü (replacement for superscript 3)
  139.     IF hit& = 167 THEN hit& = 21: GOTO setInkey ' (hence also available via Ctrl-u)
  140.     IF hit& = 179 THEN hit& = 252: GOTO setInkey 'î (replacement for Euro sign)
  141. ELSEIF hit& >= 256 AND hit& <= 65535 AND ((hit& AND 255) = 0) THEN
  142.     charCode& = hit& \ 256
  143.     'following modifier priority is (Alt -> Ctrl -> Shift)
  144.     IF charCode& >= 59 AND charCode& <= 68 THEN 'F1-F10
  145.         IF alt% THEN hit& = (charCode& + 45) * 256: GOTO setInkey
  146.         IF ctrl% THEN hit& = (charCode& + 35) * 256: GOTO setInkey
  147.         IF shift% THEN hit& = (charCode& + 25) * 256: GOTO setInkey
  148.     ELSEIF charCode& = 133 OR charCode& = 134 THEN 'F11-F12
  149.         IF alt% THEN hit& = (charCode& + 6) * 256: GOTO setInkey
  150.         IF ctrl% THEN hit& = (charCode& + 4) * 256: GOTO setInkey
  151.         IF shift% THEN hit& = (charCode& + 2) * 256: GOTO setInkey
  152.     ELSEIF charCode& = 71 THEN 'Home
  153.         IF alt% THEN hit& = 151 * 256: GOTO setInkey
  154.         IF ctrl% THEN hit& = 119 * 256: GOTO setInkey
  155.     ELSEIF charCode& = 72 THEN 'ArrowUp
  156.         IF alt% THEN hit& = 152 * 256: GOTO setInkey
  157.         IF ctrl% THEN hit& = 141 * 256: GOTO setInkey
  158.     ELSEIF charCode& = 73 THEN 'PageUp
  159.         IF alt% THEN hit& = 153 * 256: GOTO setInkey
  160.         IF ctrl% THEN hit& = 132 * 256: GOTO setInkey
  161.     ELSEIF charCode& = 75 THEN 'ArrowLeft
  162.         IF alt% THEN hit& = 155 * 256: GOTO setInkey
  163.         IF ctrl% THEN hit& = 115 * 256: GOTO setInkey
  164.     ELSEIF charCode& = 77 THEN 'ArrowRight
  165.         IF alt% THEN hit& = 157 * 256: GOTO setInkey
  166.         IF ctrl% THEN hit& = 116 * 256: GOTO setInkey
  167.     ELSEIF charCode& = 79 THEN 'End
  168.         IF alt% THEN hit& = 159 * 256: GOTO setInkey
  169.         IF ctrl% THEN hit& = 117 * 256: GOTO setInkey
  170.     ELSEIF charCode& = 80 THEN 'ArrowDown
  171.         IF alt% THEN hit& = 160 * 256: GOTO setInkey
  172.         IF ctrl% THEN hit& = 145 * 256: GOTO setInkey
  173.     ELSEIF charCode& = 81 THEN 'PageDown
  174.         IF alt% THEN hit& = 161 * 256: GOTO setInkey
  175.         IF ctrl% THEN hit& = 118 * 256: GOTO setInkey
  176.     ELSEIF charCode& = 82 THEN 'Insert
  177.         IF alt% THEN hit& = 162 * 256: GOTO setInkey
  178.         IF ctrl% THEN hit& = 146 * 256: GOTO setInkey
  179.     ELSEIF charCode& = 83 THEN 'Delete
  180.         IF alt% THEN hit& = 163 * 256: GOTO setInkey
  181.         IF ctrl% THEN hit& = 147 * 256: GOTO setInkey
  182.     END IF
  184. '--- bring the system codepage mapped inputs back to Cp437, if available ---
  185. IF hit& >= 128 AND hit& <= 255 THEN
  186.     RESTORE KB1031toCP437_Cp437
  187.     FOR i% = 128 TO 255
  188.         READ charCode&
  189.         IF hit& = charCode& THEN
  190.             hit& = i%
  191.             EXIT FOR
  192.         END IF
  193.     NEXT i%
  194.     IF hit& <> i% THEN hit& = 0 'no Cp437 entry found
  196. '--- finally encode the usual INKEY$ result ---
  197. setInkey:
  198. IF hit& > 0 THEN
  199.     IF hit& <= 255 THEN KB1031toCP437Inkey$ = CHR$(hit&)
  200.     IF hit& >= 256 AND hit& <= 65535 AND ((hit& AND 255) = 0) THEN KB1031toCP437Inkey$ = CHR$(0) + CHR$(hit& \ 256)
  202. noInput:
  204. '-----------------------------
  205. KB1031toCP437_Circonflex:
  206. DATA 7,32,94,65,143,97,131,101,136,105,140,111,147,117,150
  207. KB1031toCP437_Acute:
  208. DATA 7,32,39,69,144,97,160,101,130,105,161,111,162,117,163
  209. KB1031toCP437_Grave:
  210. DATA 6,32,96,97,133,101,138,105,141,111,149,117,151
  211. KB1031toCP437_None:
  213. KB1031toCP437_Cp437:
  214. DATA 199,252,233,226,228,224,229,231,234,235,232,239,238,236,196,197
  215. DATA 201,230,198,244,246,242,251,249,255,214,220,162,163,165,8359,402
  216. DATA 225,237,243,250,241,209,170,186,191,8976,172,189,188,161,171,187
  217. DATA 9617,9618,9619,9474,9508,9569,9570,9558,9557,9571,9553,9559,9565,9564,9563,9488
  218. DATA 9492,9524,9516,9500,9472,9532,9566,9567,9562,9556,9577,9574,9568,9552,9580,9575
  219. DATA 9576,9572,9573,9561,9560,9554,9555,9579,9578,9496,9484,9608,9604,9612,9616,9600
  220. DATA 945,223,915,960,931,963,181,964,934,920,937,948,8734,966,949,8745
  221. DATA 8801,177,8805,8804,8992,8993,247,8776,176,8729,183,8730,8319,178,9632,32
  223.  
  224.  
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: moises1953 on June 07, 2020, 07:58:48 am
Tank's a lot RhoSigma, i learn a lot analizing your keymaping proposal to capture keyboard inputs to CP437.
Think that's the more simple solution for consistency betwen display and keyboard.
May be the keymaping in the lines 156-167 works for most of keyboards?.
It's posible test in many keboards and refine the map table.

I converted to a most compact form in a function, tested with spanish keyboard and works fine:
Code: QB64: [Select]
  1. [font=courier]
  2. FUNCTION MapKey437 (k)
  3.   CONST KeyInp = "€ ¡¢£¥ª«¬°±²µ·º»¼½¿ÄÅÆÇÉÑÖÜßàáâäåæçèéêëìíîïñ•¢ôö÷ùúûü"
  4.   CONST KeyMap = "îÿ­›œ¦®ªøñýæú§¯¬«¨Ž’€¥™šá… ƒ„†‘‡Š‚ˆ‰¡Œ‹¤•¢“”ö—£–"
  5.   i = INSTR(KeyInp, CHR$(k))
  6.   IF i THEN
  7.     MapKey437 = ASC(KeyMap, i)
  8.   ELSE
  9.     MapKey437 = k
  10.   END IF
  12. [/font]
  13.  

And this is my complete test program:
Code: QB64: [Select]
  2. DEFLNG H-P
  3. CONST Phor = 1366, Pver = 768 ' WXGA
  4. 'CONST Phor = 1600, Pver = 900 ' HD+
  5. TITLE "Inkeyhit" 'Version 1.1
  6. hscr = NEWIMAGE(Phor, Pver, 256)
  7. SCREEN hscr
  8. 'Allows test keyboard maping
  9. SCREENMOVE 0, 0
  10. '<Alt><Intro> for fullscreen
  11.  
  12. fontpath$ = "Lucon.ttf": fontsize% = 20 'Windows lucida console 20x12
  13. style$ = "MONOSPACE"
  14. hfont = LOADFONT(fontpath$, fontsize%, style$)
  15. IF hfont THEN FONT hfont
  16.  
  17. PRINT "Inkeyhit & display (128-175): €‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ ¡¢£¤¥¦§¨©ª«¬­®¯"
  18. PRINT "                   (176-223): °±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß"
  19. PRINT "CP437 extended     (224-254): àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþ"
  20. PRINT "Please, test Keyboard maping"
  21. PRINT CHR$(254);
  22. LOCATE , 1
  24.   in$ = Inkeyhit$ 'emulates quickbasic INKEY$
  25.   IF LEN(in$) THEN
  26.     PRINT in$;
  27.     pcol = POS(0)
  28.     PRINT CHR$(254);
  29.     LOCATE , pcol
  30.   END IF
  31. LOOP UNTIL in$ = CHR$(27)
  32. FONT 16
  33. IF hfont THEN FREEFONT hfont
  35.  
  36. FUNCTION Inkeyhit$ STATIC 'Emulates INKEY$
  37.   DIM k, iaccent AS INTEGER, car AS UNSIGNED BYTE, doblecar AS STRING * 2
  38.   k = KEYHIT
  39.   IF k THEN
  40.     car = 0
  41.     keyshift = KEYDOWN(100303) OR KEYDOWN(100304)
  42.     keyctrl = KEYDOWN(100305) OR KEYDOWN(100306)
  43.     keyAltGr = KEYDOWN(100307) AND KEYDOWN(100306)
  44.     keyalt = (KEYDOWN(100307) OR KEYDOWN(100308)) AND NOT keyAltGr
  45.  
  46.     IF iaccent THEN
  47.       SELECT CASE iaccent
  48.         CASE 1
  49.           SELECT CASE k
  50.             CASE 97: car = 160 '
  51.             CASE 101: car = 130 '‚
  52.             CASE 105: car = 161 '¡
  53.             CASE 111: car = 162 '¢
  54.             CASE 117: car = 163 '£
  55.             CASE 69: car = 144 '
  56.           END SELECT
  57.         CASE 2
  58.           SELECT CASE k
  59.             CASE 32: car = 96 '`
  60.             CASE 97: car = 133 '…
  61.             CASE 101: car = 138 'Š
  62.             CASE 105: car = 141 '
  63.             CASE 111: car = 149 '•
  64.             CASE 117: car = 151 '—
  65.           END SELECT
  66.         CASE 3
  67.           SELECT CASE k
  68.             CASE 97: car = 132 '„
  69.             CASE 101: car = 137 '‰
  70.             CASE 105: car = 139 '‹
  71.             CASE 111: car = 148 '”
  72.             CASE 117: car = 129 '
  73.             CASE 65: car = 142 'Ž
  74.             CASE 79: car = 153 '™
  75.             CASE 85: car = 154 'š
  76.           END SELECT
  77.         CASE 4
  78.           SELECT CASE k
  79.             CASE 32: car = 94 '^
  80.             CASE 97: car = 131 'ƒ
  81.             CASE 101: car = 136 'ˆ
  82.             CASE 105: car = 140 'Œ
  83.             CASE 111: car = 147 '“
  84.             CASE 117: car = 150 '–
  85.           END SELECT
  86.       END SELECT
  87.     END IF
  88.  
  89.     IF car = 0 THEN
  90.       SELECT CASE k
  91.         CASE 48 TO 57 'numeric heys 0-9
  92.           IF keyalt = 0 THEN car = k
  93.         CASE 97 TO 122 'CTRL a-z: 1-26
  94.           car = k
  95.           IF keyctrl THEN car = car - 96
  96.         CASE 0 TO 127
  97.           car = k
  98.         CASE 128 TO 255
  99.           car = MapKey437(k)
  100.         CASE 256 TO 65535 'double byte chr$(0)+
  101.           doblecar = MKI$(k)
  102.           IF ASC(doblecar) = 0 THEN
  103.             car = ASC(doblecar, 2)
  104.             IF keyalt THEN
  105.               SELECT CASE car
  106.                 CASE 59 TO 68 'F1-F10: ;-D
  107.                   MID$(doblecar, 2) = CHR$(car + 45)
  108.                 CASE 133, 134 'F11,F12; …,†
  109.                   MID$(doblecar, 2) = CHR$(car + 6)
  110.                 CASE ELSE
  111.                   MID$(doblecar, 2) = CHR$(0)
  112.               END SELECT
  113.             ELSEIF keyctrl THEN
  114.               SELECT CASE car
  115.                 CASE 59 TO 68 'F1-F10: ^-g
  116.                   MID$(doblecar, 2) = CHR$(car + 35)
  117.                 CASE 71 'Home
  118.                   MID$(doblecar, 2) = CHR$(119)
  119.                 CASE 73 'RePag
  120.                   MID$(doblecar, 2) = CHR$(132)
  121.                 CASE 75 'Left
  122.                   MID$(doblecar, 2) = CHR$(115)
  123.                 CASE 77 'Right
  124.                   MID$(doblecar, 2) = CHR$(116)
  125.                 CASE 79 'End
  126.                   MID$(doblecar, 2) = CHR$(117)
  127.                 CASE 81 'AvPag
  128.                   MID$(doblecar, 2) = CHR$(118)
  129.                 CASE 133, 134 'F11,F12
  130.                   MID$(doblecar, 2) = CHR$(car + 4)
  131.                 CASE ELSE
  132.                   MID$(doblecar, 2) = CHR$(0)
  133.               END SELECT
  134.             ELSEIF keyshift THEN
  135.               SELECT CASE car
  136.                 CASE 59 TO 68 'F1-F10
  137.                   MID$(doblecar, 2) = CHR$(car + 25)
  138.                 CASE 71 TO 81
  139.                 CASE 133, 134 'F11,F12
  140.                   MID$(doblecar, 2) = CHR$(car + 2)
  141.                 CASE ELSE
  142.                   MID$(doblecar, 2) = CHR$(0)
  143.               END SELECT
  144.             END IF
  145.           END IF
  146.           IF CVI(doblecar) THEN
  147.             Inkeyhit$ = doblecar
  148.             iaccent = 0
  149.           END IF
  150.           car = 0
  151.         CASE -100308 'Alt up
  152.           IF LEN(buf$) THEN
  153.             car = VAL(buf$)
  154.             buf$ = ""
  155.           END IF
  156.         CASE -222 'acute accent and umlaut (di‚resis)
  157.           IF keyshift THEN
  158.             iaccent = 3
  159.           ELSE
  160.             iaccent = 1
  161.           END IF
  162.         CASE -186 'grave accent and circumflex
  163.           IF keyshift THEN
  164.             iaccent = 4
  165.           ELSE
  166.             iaccent = 2
  167.           END IF
  168.         CASE -57 TO -48 'numeric keys, also numeric keypad with numlock
  169.           IF keyalt THEN
  170.             IF LEN(buf$) > 2 THEN buf$ = RIGHT$(buf$, 2)
  171.             buf$ = buf$ + CHR$(ABS(k))
  172.           END IF
  173.       END SELECT
  174.     END IF
  175.     IF car THEN
  176.       Inkeyhit$ = CHR$(car)
  177.       iaccent = 0
  178.     END IF
  179.   END IF
  181.  
  182. FUNCTION MapKey437 (k)
  183.   CONST KeyInp = "€ ¡¢£¥ª«¬°±²µ·º»¼½¿ÄÅÆÇÉÑÖÜßàáâäåæçèéêëìíîïñ•¢ôö÷ùúûü"
  184.   CONST KeyMap = "îÿ­›œ¦®ªøñýæú§¯¬«¨Ž’€¥™šá… ƒ„†‘‡Š‚ˆ‰¡Œ‹¤•¢“”ö—£–"
  185.   i = INSTR(KeyInp, CHR$(k))
  186.   IF i THEN
  187.     MapKey437 = ASC(KeyMap, i)
  188.   ELSE
  189.     MapKey437 = k
  190.   END IF
  192.  
  193. ' RESTORE CP437_Mapkey
  194. ' READ n
  195. ' FOR i = 1 TO n
  196. ' READ ky, map
  197. '   IF ky = k THEN EXIT FOR
  198. ' NEXT i
  199. ' IF i > n THEN map = k
  200. ' MapKey = map
  201. ' EXIT FUNCTION
  202.  
  203. 'CP437_Mapkey: ' Inverse CP437 + Euro(î)
  204. 'DATA 53,128,238,160,255,161,173,162,155,163,156,165,157,170,166,171,174
  205. 'DATA 172,170,176,248,177,241,178,253,181,230,183,250,186,167,187,175
  206. 'DATA 188,172,189,171,191,168,196,142,197,143,198,146,199,128,201,144
  207. 'DATA 209,165,214,153,220,154,223,225,224,133,225,160,226,131,228,132
  208. 'DATA 229,134,230,145,231,135,232,138,233,130,234,136,235,137,236,141
  209. 'DATA 237,161,238,140,239,139,241,164,242,149,243,162,244,147,246,148
  210. 'DATA 247,246,249,151,250,163,251,150,252,129
  211. '€ ¡¢£¥ª« -> îÿ­›œ¦®
  212. '¬°±²µ·º» -> ªøñýæú§¯
  213. '¼½¿ÄÅÆÇÉ -> ¬«¨Ž’€
  214. 'ÑÖÜßàáâä -> ¥™šá… ƒ„
  215. 'åæçèéêëì -> †‘‡Š‚ˆ‰
  216. 'íîïñ•¢ôö -> ¡Œ‹¤•¢“”
  217. '÷ùúûü    -> ö—£–
  218. [/font]
  219.  
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: moises1953 on June 07, 2020, 12:36:50 pm
No need for Umlaut?

Code: QB64: [Select]
  1.   KB1031toCP437_Umlaut:
  2.   DATA 8,65,142,79,153,85,154,97,132,101,137,105,139,111,148,117,129
  3.  
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: DDBE on June 07, 2020, 01:12:49 pm
Quote from: moises1953 on June 07, 2020, 12:36:50 pm
No need for Umlaut?

Code: QB64: [Select]
  1.   KB1031toCP437_Umlaut:
  2.   DATA 8,65,142,79,153,85,154,97,132,101,137,105,139,111,148,117,129
  3.  

I was gonna say, circonflex, aigu, and grave as mentioned in RhoSigma's code are not German, they're French. And Š, as mentioned in his OP, is a Slavic letter.
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: RhoSigma on June 07, 2020, 05:19:59 pm
Umlauts are single keys on german keyboards, hence one keypress for one char, so they're automatically covered by the reverse CP437 lookup. Circonflex, Aigu, Grave otherwise require two keys to be pressed one after another to generate one char, so they need the extra lookup.
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: moises1953 on June 09, 2020, 05:39:53 am
I understand RhoSigma, but we need in the spanish keyboard.

Quote from: RhoSigma on June 07, 2020, 05:19:59 pm
Umlauts are single keys on german keyboards, hence one keypress for one char, so they're automatically covered by the reverse CP437 lookup. Circonflex, Aigu, Grave otherwise require two keys to be pressed one after another to generate one char, so they need the extra lookup.

Adopted most of your ideas in keyboard maping to INKEY$ coompatibility with my InkeyHit function, and think that may be valid for all western Europe keyboards. I tested in english, french and spanish, and works fine. Can you test in yours, and tell me the results?.

This is the actual code:
Code: QB64: [Select]
  1. [font=courier]
  3. DEFLNG H-P
  4. 'CONST Phor = 1366, Pver = 768 ' WXGA
  5. CONST Phor = 1600, Pver = 900 ' HD+
  6.  
  7. TITLE "Inkeyhit" 'Version 1.1
  8. hscr = NEWIMAGE(Phor, Pver, 256)
  9. SCREEN hscr
  10. CONTROLCHR OFF
  11. 'Allows test keyboard maping
  12. SCREENMOVE 0, 0
  13. '<Alt><Intro> for fullscreen
  14.  
  15. fontpath$ = "Lucon.ttf": fontsize% = 24 'Windows lucida console 24x14
  16. style$ = "MONOSPACE"
  17. hfont = LOADFONT(fontpath$, fontsize%, style$)
  18. IF hfont THEN FONT hfont
  19.  
  20. PRINT "Inkeyhit & display (128-175): €‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ ¡¢£¤¥¦§¨©ª«¬­®¯"
  21. PRINT "                   (176-223): °±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß"
  22. PRINT "CP437 extended     (224-255): àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"
  23. PRINT "Please, test Keyboard maping"
  24. PRINT CHR$(254);
  25.  
  27.   in$ = Inkeyhit$ 'emulates quickbasic INKEY$
  28.   IF LEN(in$) THEN
  29.     PRINT in$;
  30.     IF in$ = CHR$(13) THEN PRINT
  31.     pcol = POS(0)
  32.     PRINT CHR$(254);
  33.     LOCATE , pcol
  34.   END IF
  35. LOOP UNTIL in$ = CHR$(27)
  36. FONT 16
  37. IF hfont THEN FREEFONT hfont
  39.  
  40. FUNCTION Inkeyhit$ STATIC 'Emulates INKEY$
  41.   CONST KeyLook = "€ ¡¢£¥ª«¬°±²µ·º»¼½¿ÄÅÆÇÉÑÖÜßàáâäåæçèéêëìíîïñ•¢ôö÷ùúûü" 'Accesible mapings in CP437
  42.   CONST KeyMapi = "îÿ­›œ¦®ªøñýæú§¯¬«¨Ž’€¥™šá… ƒ„†‘‡Š‚ˆ‰¡Œ‹¤•¢“”ö—£–" 'Maping code
  43.  
  44.   CONST AcuteLook = "aeiouE", GraveLook = " aeiou", UmlauLook = "aeiouAOUy", CircuLook = " aeiou"
  45.   CONST AcuteMapi = " ‚¡¢£", GraveMapi = "`…Š•—", UmlauMapi = "„‰‹”Ž™š˜", CircuMapi = "^ƒˆŒ“–"
  46.  
  47.   DIM hit AS LONG, prekey AS LONG, car AS UNSIGNED BYTE, dblcar AS STRING * 2
  48.  
  49.   hit = KEYHIT
  50.   IF hit THEN
  51.     car = 0
  52.     keyshift = KEYDOWN(100303) OR KEYDOWN(100304)
  53.     keyctrl = KEYDOWN(100305) OR KEYDOWN(100306)
  54.     keyAltGr = KEYDOWN(100307) AND KEYDOWN(100306)
  55.     keyalt = (KEYDOWN(100307) OR KEYDOWN(100308)) AND NOT keyAltGr
  56.  
  57.     IF prekey THEN
  58.       IF hit >= 32 AND hit <= 127 THEN
  59.         SELECT CASE prekey
  60.           CASE 1 '
  61.             p = INSTR(AcuteLook, CHR$(hit))
  62.             IF p THEN car = ASC(AcuteMapi, p)
  63.           CASE 2 '`
  64.             p = INSTR(GraveLook, CHR$(hit))
  65.             IF p THEN car = ASC(GraveMapi, p)
  66.           CASE 3
  67.             p = INSTR(UmlauLook, CHR$(hit))
  68.             IF p THEN car = ASC(UmlauMapi, p)
  69.           CASE 4
  70.             p = INSTR(CircuLook, CHR$(hit))
  71.             IF p THEN car = ASC(CircuMapi, p)
  72.         END SELECT
  73.       END IF
  74.     END IF
  75.  
  76.     IF car = 0 THEN '--- control sequences and special behavior ---
  77.       SELECT CASE hit
  78.         CASE 9 'tab
  79.           IF keyshift THEN dblcar = CHR$(0) + CHR$(15) ELSE car = hit
  80.         CASE 48 TO 57 'numeric heys 0-9
  81.           IF keyalt = 0 THEN car = hit
  82.         CASE 65 TO 90 'CTRL A-Z: 1-26
  83.           IF keyctrl THEN car = hit - 64 ELSE car = hit
  84.         CASE 97 TO 122 'CTRL a-z: 1-26
  85.           IF keyctrl THEN car = hit - 96 ELSE car = hit
  86.         CASE 0 TO 127
  87.           car = hit
  88.         CASE 128 TO 255
  89.           '--- bring the system codepage mapped inputs back to Cp437, if available ---
  90.           p = INSTR(KeyLook, CHR$(hit))
  91.           IF p THEN car = ASC(KeyMapi, p) ELSE car = hit
  92.         CASE 256 TO 65535 'double byte chr$(0)+
  93.           dblcar = MKI$(hit)
  94.           IF ASC(dblcar) = 0 THEN
  95.             car = ASC(dblcar, 2)
  96.             SELECT CASE car 'priority ordering (Alt -> Ctrl -> Shift)
  97.               CASE 59 TO 68 'F1-F10
  98.                 IF keyalt THEN
  99.                   MID$(dblcar, 2) = CHR$(car + 45)
  100.                 ELSEIF keyctrl THEN
  101.                   MID$(dblcar, 2) = CHR$(car + 35)
  102.                 ELSEIF keyshift THEN
  103.                   MID$(dblcar, 2) = CHR$(car + 25)
  104.                 END IF
  105.               CASE 133, 134 'F11-F12
  106.                 IF keyalt THEN
  107.                   MID$(dblcar, 2) = CHR$(car + 6)
  108.                 ELSEIF keyctrl THEN
  109.                   MID$(dblcar, 2) = CHR$(car + 4)
  110.                 ELSEIF keyshift THEN
  111.                   MID$(dblcar, 2) = CHR$(car + 2)
  112.                 END IF
  113.               CASE 71 'Home
  114.                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(119) 'w
  115.               CASE 73 'RePag
  116.                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(132) '„
  117.               CASE 75 'Left
  118.                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(115) 's
  119.               CASE 77 'Right
  120.                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(116) 't
  121.               CASE 79 'End
  122.                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(117) 'u
  123.               CASE 81 'AvPag
  124.                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(118) 'v
  125.             END SELECT
  126.           END IF
  127.           IF CVI(dblcar) THEN
  128.             Inkeyhit$ = dblcar
  129.             prekey = 0
  130.           END IF
  131.           car = 0
  132.         CASE IS >= &H40000000 'unicode (someday)
  133.           hitu = hit - &H40000000 '4 bytes
  134.         CASE -100308 'Alt up
  135.           IF LEN(buf$) THEN
  136.             car = VAL(buf$)
  137.             buf$ = ""
  138.           END IF
  139.         CASE -222 'acute accent and umlaut (SP:di‚resis)
  140.           IF keyshift THEN
  141.             prekey = 3
  142.           ELSE
  143.             prekey = 1
  144.           END IF
  145.         CASE -186 'grave accent and circumflex
  146.           IF keyshift THEN
  147.             prekey = 4
  148.           ELSE
  149.             prekey = 2
  150.           END IF
  151.         CASE -57 TO -48 'numeric keys, also numeric keypad with numlock
  152.           IF keyalt THEN
  153.             IF LEN(buf$) > 2 THEN buf$ = RIGHT$(buf$, 2)
  154.             buf$ = buf$ + CHR$(ABS(hit))
  155.           END IF
  156.       END SELECT
  157.     END IF
  158.     IF car THEN
  159.       Inkeyhit$ = CHR$(car)
  160.       prekey = 0
  161.     END IF
  162.   END IF
  164. [/font]
  165.  
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: RhoSigma on June 09, 2020, 09:18:05 am
Sorry, doesn't work 100%,

direct key to char mappings (hence all chars, for which is a key for on the keyboard) work except for:
§ = shift + 3 (the regular 3, not numpad)
³ = altgr + 3 (the regular 3, not numpad)

umlauts (äöüß) work, as they have its own key (I mentioned earlier)

´ and ^ accents work only sporadicly but only once, mostly when pressing the accent key until it begins to repeat and then pressing the respective char, after that I've to type a couple other chars until it works once again
` does not work, as it needs shift pressed on DE keyboards to select this accent, which results in eg. È if you want è

F-Keys, keypad, arrows work without modifiers or shift pressed,
F11-F12 get wrong CHR$(0) double chars when used with ctrl, many alt combos get wrong or no results

All this might be, as you seem to process all _KEYHIT values, the release values maybe mess up your internal function logic, for a good reason I only use the release values for preselection (accent) keys and numbers for the Alt+ASCII input, so I can internally distinguish between multi key generated chars and single key press chars, where i use the key down values for. In general you can assume that a pressed key gets also released, so you don't need to process key down and up values for a single char.

You should also flush the INKEY$ buffer before getting the _KEYHIT, to make sure that a pressed Enter is not pending in the buffer and accidently confirms a (LINE)INPUT which comes somewhere after the Inkeyhit$ call in the program.
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: loudar on June 09, 2020, 11:55:50 am
Is there a way to get this working for output into file?
When I use PRINT CHR$(132) I can see "ä" on screen, but using PRINT #5, CHR$(132) only yields ",". I only need this for Umlaute in german and I'm wondering why it does this.

EDIT: Got it working. Apparently I have to use CHR$(132) to print on screen and CHR$(228) to print into a file. Thanks for the code! <3
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: moises1953 on June 12, 2020, 07:08:49 am
Quote from: RhoSigma on June 09, 2020, 09:18:05 am
direct key to char mappings (hence all chars, for which is a key for on the keyboard) work except for:
§ = shift + 3 (the regular 3, not numpad)
³ = altgr + 3 (the regular 3, not numpad)

This symbols not exist in the CP437, no way to show, but may be you can susbtitute § for º = chr$(167), no suggestion for ³.

Please test this advanced function, wich takes many ideas from yours, and may be usefull.
Code: QB64: [Select]
  1. [font=courier]
  3. DEFLNG H-P
  4. CONST Phor = 1366, Pver = 768 ' WXGA
  5. 'CONST Phor = 1600, Pver = 900 ' HD+
  6.  
  7. TITLE "Inkeyhit" 'Version 1.2
  8. hscr = NEWIMAGE(Phor, Pver, 256)
  9. SCREEN hscr
  10. CONTROLCHR OFF
  11. 'Allows test keyboard maping
  12. SCREENMOVE 0, 0
  13.  
  14. fontpath$ = "Lucon.ttf": fontsize% = 20 'Windows lucida console 20x12; 24x14
  15. style$ = "MONOSPACE"
  16. hfont = LOADFONT(fontpath$, fontsize%, style$)
  17. IF hfont THEN FONT hfont
  18.  
  19. PRINT "Inkeyhit & display (128-175): €‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ ¡¢£¤¥¦§¨©ª«¬­®¯"
  20. PRINT "                   (176-223): °±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß"
  21. PRINT "CP437 extended     (224-255): àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"
  22. PRINT "Please, test Keyboard maping"
  23. PRINT CHR$(254);
  24. LOCATE , 1
  26.   in$ = Inkeyhit$ 'emulates quickbasic INKEY$
  27.   IF LEN(in$) THEN
  28.     PRINT in$;
  29.     IF in$ = CHR$(13) THEN PRINT
  30.     pcol = POS(0)
  31.     PRINT CHR$(254);
  32.     LOCATE , pcol
  33.   END IF
  34. LOOP UNTIL in$ = CHR$(27)
  35. FONT 16
  36. IF hfont THEN FREEFONT hfont
  38.  
  39. FUNCTION Inkeyhit$ STATIC 'Emulates INKEY$
  40.   CONST KeyLook = "€ ¡¢£¥ª«¬°±²µ·º»¼½¿ÄÅÆÇÉÑÖÜßàáâäåæçèéêëìíîïñ•¢ôö÷ùúûü" 'Accesible mapings in CP437
  41.   CONST KeyMapi = "îÿ­›œ¦®ªøñýæú§¯¬«¨Ž’€¥™šá… ƒ„†‘‡Š‚ˆ‰¡Œ‹¤•¢“”ö—£–" 'Maping code
  42.  
  43.   CONST AcuteLook = "aeiouE", GraveLook = " aeiou", UmlauLook = "aeiouAOUy", CircuLook = " aeiou"
  44.   CONST AcuteMapi = " ‚¡¢£", GraveMapi = "`…Š•—", UmlauMapi = "„‰‹”Ž™š˜", CircuMapi = "^ƒˆŒ“–"
  45.  
  46.   DIM hit AS LONG, prekey AS LONG, car AS UNSIGNED BYTE, dblcar AS STRING * 2
  47.  
  48.   hit = KEYHIT
  49.   IF hit THEN
  50.     car = 0
  51.     keyshift = KEYDOWN(100303) OR KEYDOWN(100304)
  52.     keyctrl = KEYDOWN(100305) OR KEYDOWN(100306)
  53.     keyAltGr = KEYDOWN(100307) AND KEYDOWN(100306)
  54.     keyalt = (KEYDOWN(100307) OR KEYDOWN(100308)) AND NOT keyAltGr
  55.  
  56.     IF prekey THEN
  57.       IF hit >= 32 AND hit <= 127 THEN
  58.         SELECT CASE prekey
  59.           CASE 1 '
  60.             p = INSTR(AcuteLook, CHR$(hit))
  61.             IF p THEN car = ASC(AcuteMapi, p)
  62.           CASE 2 '`
  63.             p = INSTR(GraveLook, CHR$(hit))
  64.             IF p THEN car = ASC(GraveMapi, p)
  65.           CASE 3
  66.             p = INSTR(UmlauLook, CHR$(hit))
  67.             IF p THEN car = ASC(UmlauMapi, p)
  68.           CASE 4
  69.             p = INSTR(CircuLook, CHR$(hit))
  70.             IF p THEN car = ASC(CircuMapi, p)
  71.         END SELECT
  72.       END IF
  73.     END IF
  74.  
  75.     IF car = 0 THEN '--- control sequences and special behavior ---
  76.       SELECT CASE hit
  77.         CASE 9 'tab
  78.           IF keyshift THEN dblcar = CHR$(0) + CHR$(15) ELSE car = hit
  79.         CASE 48 TO 57 'numeric heys 0-9
  80.           IF keyalt = 0 THEN car = hit
  81.         CASE 65 TO 90 'CTRL A-Z: 1-26
  82.           IF keyctrl THEN car = hit - 64 ELSE car = hit
  83.         CASE 97 TO 122 'CTRL a-z: 1-26
  84.           IF keyctrl THEN car = hit - 96 ELSE car = hit
  85.         CASE 0 TO 127 'ASCII
  86.           car = hit
  87.         CASE 128 TO 255
  88.           '--- bring the system codepage mapped inputs back to Cp437, if available ---
  89.           p = INSTR(KeyLook, CHR$(hit))
  90.           IF p THEN car = ASC(KeyMapi, p) ELSE car = hit
  91.         CASE 256 TO 65535 'double byte chr$(0)+
  92.           dblcar = MKI$(hit)
  93.           IF ASC(dblcar) = 0 THEN
  94.             car = ASC(dblcar, 2)
  95.             SELECT CASE car 'priority ordering (Alt -> Ctrl -> Shift)
  96.               CASE 59 TO 68 'F1-F10
  97.                 IF keyalt THEN
  98.                   MID$(dblcar, 2) = CHR$(car + 45)
  99.                 ELSEIF keyctrl THEN
  100.                   MID$(dblcar, 2) = CHR$(car + 35)
  101.                 ELSEIF keyshift THEN
  102.                   MID$(dblcar, 2) = CHR$(car + 25)
  103.                 END IF
  104.               CASE 133, 134 'F11-F12
  105.                 IF keyalt THEN
  106.                   MID$(dblcar, 2) = CHR$(car + 6)
  107.                 ELSEIF keyctrl THEN
  108.                   MID$(dblcar, 2) = CHR$(car + 4)
  109.                 ELSEIF keyshift THEN
  110.                   MID$(dblcar, 2) = CHR$(car + 2)
  111.                 END IF
  112.               CASE 71 'Home
  113.                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(119) 'w
  114.               CASE 73 'RePag
  115.                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(132) '„
  116.               CASE 75 'Left
  117.                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(115) 's
  118.               CASE 77 'Right
  119.                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(116) 't
  120.               CASE 79 'End
  121.                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(117) 'u
  122.               CASE 81 'AvPag
  123.                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(118) 'v
  124.             END SELECT
  125.           END IF
  126.           IF CVI(dblcar) THEN
  127.             Inkeyhit$ = dblcar
  128.             prekey = 0
  129.           END IF
  130.           car = 0
  131.         CASE IS >= &H40000000 'unicode (someday)
  132.           hitu = hit - &H40000000 '4 bytes
  133.         CASE -100308 'Alt up
  134.           IF LEN(buf$) THEN
  135.             car = VAL(buf$)
  136.             buf$ = ""
  137.           END IF
  138.         CASE -186 'grave accent and circumflex: Spanish
  139.           IF keyshift THEN
  140.             prekey = 4
  141.           ELSE
  142.             prekey = 2
  143.           END IF
  144.         CASE -220 'circumflex: German
  145.           prekey = 4
  146.         CASE -221 'German & French
  147.           IF isFrench THEN 'circumflex and umlaut
  148.             IF keyshift THEN
  149.               prekey = 3
  150.             ELSE
  151.               prekey = 4
  152.             END IF
  153.           ELSE 'German
  154.             IF keyshift THEN 'acute accent and grave
  155.               prekey = 2
  156.             ELSE
  157.               prekey = 1
  158.             END IF
  159.           END IF
  160.         CASE -222 'acute accent and umlaut: Spanish (di‚resis)
  161.           IF keyshift THEN
  162.             prekey = 3
  163.           ELSE
  164.             prekey = 1
  165.           END IF
  166.         CASE -57 TO -48 'numeric keys, also numeric keypad with numlock
  167.           IF keyalt THEN
  168.             IF LEN(buf$) > 2 THEN buf$ = RIGHT$(buf$, 2)
  169.             buf$ = buf$ + CHR$(ABS(hit))
  170.           END IF
  171.       END SELECT
  172.     END IF
  173.     IF car THEN
  174.       Inkeyhit$ = CHR$(car)
  175.       prekey = 0
  176.     END IF
  177.   END IF
  179.  
  180. [/font]
  181.  

Title: Re: Alternative INKEY$ for Germany/Austria
Post by: RhoSigma on June 12, 2020, 11:50:27 am
Indeed, it works in german, just 2 things:

Quote from: moises1953 on June 12, 2020, 07:08:49 am
This symbols not exist in the CP437, no way to show, but may be you can susbtitute § for º = chr$(167), no suggestion for ³.

1.) You're correct on ³, sorry I've overlooked that, but the § is available on CP437 on ASCII code 21
2.) Releasing the the capital Ü (shift ü) does generate -220 for KEYHIT, hence it's the same code than circumflex prekey. After writing Ü it falsely triggers a circumflex char (if available) for the next pressed key.

If you look closely on my routine above you'll see I've done explicit workarounds  for these two exceptions in lines 93 and 141. And please really consider to flush the regular INKEY$ buffer before KEYHIT as you see it in line 76 of my routine, it's for a good reason which I mentioned in my previous reply.
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: moises1953 on June 13, 2020, 02:33:01 am
Quote from: RhoSigma on June 12, 2020, 11:50:27 am
1.) You're correct on ³, sorry I've overlooked that, but the § is available on CP437 on ASCII code 21
Tank's a lot for your help RhoSigma.
Simply add a new key maping 167 'º' to 21 '§' and ready

Code: QB64: [Select]
  1.   CONST KeyLook = "€ ¡¢£¥§ª«¬°±²µ·º»¼½¿ÄÅÆÇÉÑÖÜßàáâäåæçèéêëìíîïñ•¢ôö÷ùúûü" 'Accesible mapings in CP437
  2.   CONST KeyMapi = "îÿ­›œ¦®ªøñýæú§¯¬«¨Ž’€¥™šá… ƒ„†‘‡Š‚ˆ‰¡Œ‹¤•¢“”ö—£–" 'Maping code
  3.   '____________________________^
  4.  
[/font]

I'm analizing you second question.
Also need to identify the keyboard language to solve the French-German colision. Do you know how to?
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: RhoSigma on June 13, 2020, 04:26:12 am
To get Keyboard type I use (in Windows)

Code: QB64: [Select]
  2.     FUNCTION GetKeyboardLayout&& (BYVAL thread&)
  4.  
  5. IF (GetKeyboardLayout&&(0) \ 65536) = &H0407 THEN deKeyboard% = -1
  6.  

see https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getkeyboardlayout

as I only need the keyboard device identifier, I check the high word of the result only

download the "Published Version" PDF here https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-lcid/70feba9f-294e-491e-b6eb-56532684c37f

starting on page 14 of this document you'll find the required hex values to check for, hence a french keyboard should return &H040C in the high word
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: moises1953 on June 16, 2020, 07:52:04 am
Tank's a lot RhoSigma, in my exploration of the windows API for language issues I have missed, but. However, it seems that Microsoft recommends using text codes, such as de-de, es-es, en-us, en-en, etc ...

Well, i completed and adapted at the keyboard layout, the inkeyhit$ function and works fine, as soon as posible, with 8 keyboards:
 es-ES,en-US,en-GB,fr-FR,fr-BE,de-DE,it-IT,pt-PT, plus 4 for some accents pending.

Can you test?, please:
Code: QB64: [Select]
  2. DEFLNG H-P
  3. DECLARE LIBRARY 'Used by QB64 'Kernel32' & 'User32'
  4.   FUNCTION GetACP~% 'CodePage
  5.   '  FUNCTION GetKeyboardLayoutName ALIAS GetKeyboardLayoutNameA (wszKLID$) 'boolean
  6.   FUNCTION GetKeyboardLayout&& (BYVAL thread&)
  7.   FUNCTION GetLastError& ()
  9.  
  10. CONST Phor = 1024, Pver = 768 ' XGA
  11. 'CONST Phor = 1200, Pver = 900 ' HD+4:3
  12.  
  13. TITLE "Inkeyhit" 'Version 1.4
  14. hscr = NEWIMAGE(Phor, Pver, 256)
  15. SCREEN hscr
  16. CONTROLCHR OFF
  17. 'Allows test keyboard maping
  18. SCREENMOVE 0, 0
  19. '<Alt><Intro> for fullscreen
  20.  
  21. fontpath$ = "Lucon.ttf": fontsize% = 20 'Windows lucida console 20x12; 24x14
  22. style$ = "MONOSPACE"
  23. hfont = LOADFONT(fontpath$, fontsize%, style$)
  24. IF hfont THEN FONT hfont
  25.  
  26. PRINT "Inkeyhit & display (000-047):  ";
  27. FOR i = 1 TO 47: PRINT CHR$(i);: NEXT
  29. PRINT "CP437 extended     (128-175): €‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ ¡¢£¤¥¦§¨©ª«¬­®¯"
  30. PRINT "                   (176-223): °±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß"
  31. PRINT "                   (224-255): àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"
  32. PRINT " Please, test Keyboard maping. Code page:"; GetACP; " Keyboard"; KbdLayOut
  33. PRINT CHR$(254);
  34. LOCATE , 1
  36.   in$ = Inkeyhit$ 'emulates quickbasic INKEY$
  37.   IF LEN(in$) THEN
  38.     PRINT in$;
  39.     IF in$ = CHR$(13) THEN PRINT
  40.     pcol = POS(0)
  41.     PRINT CHR$(254);
  42.     LOCATE , pcol
  43.   END IF
  44. LOOP UNTIL in$ = CHR$(27)
  45. FONT 16
  46. IF hfont THEN FREEFONT hfont
  48.  
  49. FUNCTION KbdLayOut
  50.   K = GetKeyboardLayout(0)
  51.   KbdLayOut = SHR(K, 16)
  53.  
  54. FUNCTION Inkeyhit$ 'Emulates INKEY$
  55.   CONST kbDaDk = 1030, kbDeDe = 1031, kbEnUs = 1033, kbEsEs = 1034, kbFrFr = 1036
  56.   CONST kbItIt = 1040, kBNlNl = 1043, KbSvSe = 1053
  57.   CONST kbEnEn = 2057, kbFrBe = 2060, kbPtPt = 2070, KbFrCh = 4108
  58.  
  59.   CONST KeyLook = "€¡¢£¤¥¦§ª«¬°±²µ¶·º»¼½¿ÄÅÆÇÉÑÖÜßàáâäåæçèéêëìíîïñòóôö÷øùúûüÿ" 'Accesible mapings in CP437
  60.   CONST KeyMapi = "î­›œ|¦®ªøñýæú§¯¬«¨Ž’€¥™šá… ƒ„†‘‡Š‚ˆ‰¡Œ‹¤•¢“”öè—£–˜" 'Maping code
  61.  
  62.   'CONST KeyLooa = "€ ¡¢£¥¦§ª«¬°±²µ·º»¼½¿ÄÅÆÇÉÑÖÜßàáâäåæçèéêëìíîïñòóôö÷ùúûü"
  63.   'CONST KeyMapa = "îÿ­›œ|#¦®ªøñýæú§¯¬«¨Ž’€¥™šá… ƒ„†‘‡Š‚ˆ‰¡Œ‹¤•¢“”ö—£–"
  64.  
  65.   CONST AcuteLook = "aeiouE", GraveLook = " aeiou", UmlauLook = "aeiouAOUy", CircuLook = " aeiouA"
  66.   CONST AcuteMapi = " ‚¡¢£", GraveMapi = "`…Š•—", UmlauMapi = "„‰‹”Ž™š˜", CircuMapi = "^ƒˆŒ“–"
  67.  
  68.   STATIC lastKey AS LONG, prekey AS LONG, number$
  69.   DIM car AS UNSIGNED BYTE, dblcar AS STRING * 2
  70.  
  71.   hit = KEYHIT
  72.   IF hit THEN
  73.     car = 0
  74.     keyshift = KEYDOWN(100303) OR KEYDOWN(100304)
  75.     keyctrl = KEYDOWN(100305) OR KEYDOWN(100306)
  76.     keyAltGr = KEYDOWN(100307) AND KEYDOWN(100306)
  77.     keyalt = (KEYDOWN(100307) OR KEYDOWN(100308)) AND NOT keyAltGr
  78.     kbl = KbdLayOut
  79.  
  80.     IF hit > 0 THEN
  81.       IF hit < 256 THEN lastKey = hit
  82.       IF hit > 64 AND hit < 123 THEN
  83.         SELECT CASE prekey
  84.           CASE 1 '
  85.             p = INSTR(AcuteLook, CHR$(hit))
  86.             IF p THEN car = ASC(AcuteMapi, p)
  87.           CASE 2 '`
  88.             p = INSTR(GraveLook, CHR$(hit))
  89.             IF p THEN car = ASC(GraveMapi, p)
  90.           CASE 3
  91.             p = INSTR(UmlauLook, CHR$(hit))
  92.             IF p THEN car = ASC(UmlauMapi, p)
  93.           CASE 4
  94.             p = INSTR(CircuLook, CHR$(hit))
  95.             IF p THEN car = ASC(CircuMapi, p)
  96.         END SELECT
  97.       END IF
  98.  
  99.       IF car THEN
  100.         prekey = 0
  101.       ELSE
  102.         '--- control sequences and special behavior ---
  103.         SELECT CASE hit
  104.           CASE 9 'tab
  105.             IF keyshift THEN dblcar = CHR$(0) + CHR$(15) ELSE car = hit
  106.           CASE 48 TO 57 'numeric heys 0-9
  107.             IF keyalt = 0 THEN car = hit
  108.           CASE 65 TO 90 'CTRL CAPS A-Z: 1-26
  109.             IF keyctrl THEN car = hit - 64 ELSE car = hit
  110.           CASE 97 TO 122 'CTRL a-z: 1-26
  111.             IF keyctrl THEN car = hit - 96 ELSE car = hit
  112.           CASE 0 TO 127 'ASCII
  113.             car = hit
  114.           CASE 128 TO 255
  115.             '--- bring the system codepage mapped inputs back to Cp437, if available ---
  116.             p = INSTR(KeyLook, CHR$(hit))
  117.             IF p THEN car = ASC(KeyMapi, p) ELSE car = hit
  118.           CASE 256 TO 65535 'double byte chr$(0)+
  119.             dblcar = MKI$(hit)
  120.             IF ASC(dblcar) = 0 THEN
  121.               car = ASC(dblcar, 2)
  122.               SELECT CASE car 'priority ordering (Alt -> Ctrl -> Shift)
  123.                 CASE 59 TO 68 'F1-F10
  124.                   IF keyalt THEN
  125.                     MID$(dblcar, 2) = CHR$(car + 45)
  126.                   ELSEIF keyctrl THEN
  127.                     MID$(dblcar, 2) = CHR$(car + 35)
  128.                   ELSEIF keyshift THEN
  129.                     MID$(dblcar, 2) = CHR$(car + 25)
  130.                   END IF
  131.                 CASE 133, 134 'F11-F12
  132.                   IF keyalt THEN
  133.                     MID$(dblcar, 2) = CHR$(car + 6)
  134.                   ELSEIF keyctrl THEN
  135.                     MID$(dblcar, 2) = CHR$(car + 4)
  136.                   ELSEIF keyshift THEN
  137.                     MID$(dblcar, 2) = CHR$(car + 2)
  138.                   END IF
  139.                 CASE 71 'Home
  140.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(119) 'w
  141.                 CASE 73 'RePag
  142.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(132) '„
  143.                 CASE 75 'Left
  144.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(115) 's
  145.                 CASE 77 'Right
  146.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(116) 't
  147.                 CASE 79 'End
  148.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(117) 'u
  149.                 CASE 81 'AvPag
  150.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(118) 'v
  151.               END SELECT
  152.             END IF
  153.             IF CVI(dblcar) THEN
  154.               Inkeyhit$ = dblcar
  155.               prekey = 0
  156.               lastKey = 0
  157.             END IF
  158.             car = 0
  159.           CASE IS >= &H40000000 'unicode (someday)
  160.             hitu = hit - &H40000000 '4 bytes
  161.         END SELECT
  162.       END IF 'car
  163.     ELSE 'hit<0
  164.       SELECT CASE hit
  165.         CASE -57 TO -48 'character code: numeric keys, also numeric keypad with numlock
  166.           IF keyalt THEN
  167.             IF LEN(number$) > 2 THEN number$ = RIGHT$(number$, 2)
  168.             number$ = number$ + CHR$(ABS(hit))
  169.           ELSEIF hit = -50 AND keyAltGr THEN 'FRA ~
  170.             car = 126
  171.           END IF
  172.         CASE -100308 'Alt up: capture character code
  173.           IF LEN(number$) THEN
  174.             car = VAL(number$)
  175.             number$ = ""
  176.           END IF
  177.         CASE -lastKey 'cancel lastkey
  178.           lastKey = 0
  179.           'special keys that only release
  180.           'including accents. prekey: 1-acute, 2-grave, 3-umlaut, 4-circumflex
  181.         CASE -186 'ESP POR & DAN
  182.           SELECT CASE kbl
  183.             CASE kbPtPt 'POR: grave & acute accent
  184.               IF keyshift THEN
  185.                 prekey = 2
  186.               ELSE
  187.                 prekey = 1
  188.               END IF
  189.             CASE kbDaDk 'DAN:  circumflex & umlaut
  190.               IF keyshift THEN
  191.                 prekey = 4
  192.               ELSE
  193.                 prekey = 3
  194.               END IF
  195.             CASE ELSE 'ESP: circumflex & grave accent
  196.               IF keyshift THEN
  197.                 prekey = 4
  198.               ELSE
  199.                 prekey = 2
  200.               END IF
  201.           END SELECT
  202.         CASE -187
  203.           IF kbl = kbFrBe THEN ' FRA BEFR: ~ accent
  204.             'prekey = 5
  205.           ELSE 'POR: umlaut
  206.             prekey = 3
  207.           END IF
  208.         CASE -191 'POR: circumflex
  209.           prekey = 4
  210.         CASE -192 'FRA BFR: acute
  211.           prekey = 1
  212.         CASE -219 'DAN: grave & acute accent
  213.           IF keyshift THEN
  214.             prekey = 2
  215.           ELSE
  216.             prekey = 1
  217.           END IF
  218.         CASE -220
  219.           IF kbl = kbFrBe THEN 'FRA BEFR: grave
  220.             prekey = 2
  221.           ELSE 'DEU: circumflex
  222.             prekey = 4
  223.           END IF
  224.         CASE -221 'DEU & FRA
  225.           SELECT CASE kbl 'keyboard layout
  226.             CASE kbFrFr, kbFrBe 'FRA,BEFR : umlaut & circumflex
  227.               IF keyshift THEN
  228.                 prekey = 3
  229.               ELSE
  230.                 prekey = 4
  231.               END IF
  232.             CASE ELSE 'DEU: grave & acute accent
  233.               IF keyshift THEN
  234.                 prekey = 2
  235.               ELSE
  236.                 prekey = 1
  237.               END IF
  238.           END SELECT
  239.         CASE -222 'ESP: umlaut & acute accent;  Spanish (di‚resis)
  240.           IF keyshift THEN
  241.             prekey = 3
  242.           ELSE
  243.             prekey = 1
  244.           END IF
  245.         CASE -226 'POR: \
  246.           car = 92
  247.       END SELECT 'hit
  248.     END IF 'hit>0
  249.     IF car THEN
  250.       Inkeyhit$ = CHR$(car)
  251.       prekey = 0
  252.     END IF
  253.   END IF 'hit
  255.  

Also used some tools.
Extract reverse codes of CP437:
Code: QB64: [Select]
  2. CONST Apl = "Reverse table CP437 for key input test" ' version 1.0
  3. CONST KeyLook = "€¡¢£¥¦§ª«¬°±²µ¶·º»¼½¿ÄÅÆÇÉÑÖÜßàáâäåæçèéêëìíîïñòóôö÷ùúûüÿ" 'Accesible mapings in CP437
  4. CONST KeyMapi = "î­›œ|¦®ªøñýæú§¯¬«¨Ž’€¥™šá… ƒ„†‘‡Š‚ˆ‰¡Œ‹¤•¢“”ö—£–˜" 'Maping code
  5.  
  6. DEFLNG H-P
  7. DIM kar(255, 1)
  8. CONTROLCHR OFF
  9. TITLE Apl
  10. SCREEN _NEWIMAGE(512, 768, 8)
  11. SCREENMOVE 0, 0
  12. FONT 16
  13.  
  14. mapeables = -1
  15. '0,255 are mapped to 32 so excluded
  16. PRINT "CP437: Mapeable table:"
  17. FOR i = 1 TO 254
  18.   map = MAPUNICODE(i)
  19.   IF i - map AND map < 256 THEN
  20.     mapeables = mapeables + 1
  21.     kar(mapeables, 1) = i
  22.     kar(mapeables, 0) = map
  23.     PRINT i; map,
  24.   END IF
  27.  
  28. 'simple sort
  29. PRINT "Reverse for key capture"
  30. PRINT " Key  Map"
  31. FOR i = 0 TO mapeables
  32.   k = i
  33.   FOR j = i + 1 TO mapeables
  34.     IF kar(j, 0) < kar(k, 0) THEN k = j
  35.   NEXT j
  36.   IF k - i THEN
  37.     SWAP kar(i, 1), kar(k, 1)
  38.     SWAP kar(i, 0), kar(k, 0)
  39.   END IF
  40.   PRINT kar(i, 0); kar(i, 1);
  41.   n = INSTR(KeyLook, CHR$(kar(i, 0)))
  42.   IF n THEN PRINT MID$(KeyMapi, n, 1), ELSE PRINT " ",
  44. 'STOP
  46.  
  47. RESTORE Mapkey
  49. FOR i = 0 TO n - 1
  50.   READ k, map
  51.   IF k - kar(i, 0) OR map - kar(i, 1) THEN
  52.     PRINT k; map; " <> "; kar(i, 0); kar(i, 1)
  53.   END IF
  56. PRINT "Maping strings:"
  57. FOR i = 0 TO mapeables
  58.   PRINT CHR$(kar(i, 0));
  61. FOR i = 0 TO mapeables
  62.   PRINT CHR$(kar(i, 1));
  66.  
  67.  
  68. Mapkey:
  69. DATA 54,161,173,162,155,163,156,165,157,167,21,170,166,171,174,172,170
  70. DATA 176,248,177,241,178,253,181,230,182,20,183,250,186,167,187,175,188,172
  71. DATA 189,171,191,168,196,142,197,143,198,146,199,128,201,144,209,165
  72. DATA 214,153,220,154,223,225,224,133,225,160,226,131,228,132,229,134
  73. DATA 230,145,231,135,232,138,233,130,234,136,235,137,236,141,237,161
  74. DATA 238,140,239,139,241,164,242,149,243,162,244,147,246,148,247,246
  75. DATA 249,151,250,163,251,150,252,129,255,152
  76.  
  77. 'MapkeyFull:
  78. 'added    î                                             |
  79. 'DATA 58,128,238,161,173,162,155,163,156,164,15,165,157,166,124,167,21,170,166,171,174
  80. 'DATA 172,170,176,248,177,241,178,253,181,230,182,020,183,250,186,167,187,175,188,172
  81. 'DATA 189,171,191,168,196,142,197,143,198,146,199,128,201,144,209,165,214,153,220,154
  82. 'DATA 223,225,224,133,225,160,226,131,228,132,229,134,230,145,231,135,232,138,233,130
  83. 'DATA 234,136,235,137,236,141,237,161,238,140,239,139,241,164,242,149,243,162,244,147
  84. 'DATA 246,148,247,246,248,126,249,151,250,163,251,150,252,129,255,152
  85. '                      í
  86.  


And adapted Keyhit-Test to show the maping:
Code: QB64: [Select]
  1. DEFLNG A-Z
  2. CONST Apl = "KEYHIT Test"
  3. _TITLE Apl
  4. SCREEN _NEWIMAGE(768, 768, 256)
  7.  
  8. fontpath$ = "lucon.ttf" 'prueba
  9. fontsize% = 18
  10. style$ = "MONOSPACE"
  11. font = _LOADFONT(fontpath$, fontsize%, style$)
  12. IF font THEN _FONT font
  13.  
  14. FOR i = 1 TO 6
  15.   LOCATE , 5 + i * 10
  16.   PRINT CHR$(48 + i);
  20. FOR i = 1 TO 6
  21.   PRINT "0123456789";
  23. PRINT "0123"
  24. FOR i = 0 TO 255 STEP 64
  25.   PRINT USING "###:"; i;
  26.   FOR j = i TO i + 63
  27.     PRINT CHR$(j);
  28.   NEXT j
  32.  
  34.   x = _KEYHIT
  35.   IF x THEN
  36.     IF x < 0 THEN 'negative value means key released
  37.       COLOR 2
  38.       PRINT "Released ";
  39.       x = -x
  40.       IF x = 27 THEN EXIT DO
  41.     ELSE
  42.       COLOR 10
  43.       PRINT "Pressed "; 'positive value means key pressed
  44.     END IF
  45.     IF x < 256 THEN 'ASCII code values
  46.       PRINT "ASCII "; x;
  47.       IF x > 0 AND x <= 255 THEN
  48.         PRINT "[" + CHR$(x) + "]",
  49.         IF x > 127 THEN
  50.           y = MapKey(x)
  51.           IF x - y THEN PRINT " MAP TO "; y; "[" + CHR$(y) + "]";
  52.         END IF
  53.       END IF
  54.       PRINT
  55.     END IF
  56.     IF x >= 256 AND x < 65536 THEN '2 byte key codes
  57.       PRINT "2-BYTE-COMBO "; x AND 255; x \ 256;
  58.       x2 = x \ 256
  59.       IF x2 >= 32 AND x2 <= 255 THEN PRINT "[" + CHR$(x2) + "]" ELSE PRINT
  60.     END IF
  61.     IF x >= 100000 AND x < 200000 THEN 'QB84 Virtual Key codes
  62.       PRINT "SDL VK"; x - 100000
  63.     END IF
  64.     IF x >= 200000 AND x < &H40000000 THEN
  65.       PRINT "QB64 VK"; x - 200000
  66.     END IF
  67.     IF x >= &H40000000 THEN 'Unicode values (IME Input mode)
  68.       PRINT "UNICODE "; x - &H40000000; "0x" + HEX$(x - &H40000000) + " ...";
  69.       'cx = POS(1): cy = CSRLIN
  70.       '_FONT unifont
  71.       'LOCATE cy, cx
  72.       'COLOR 15
  73.       'z$ = MKL$(x - &H40000000) + MKL$(0)
  74.       'PRINT z$ + z$ + z$;
  75.       '_FONT font
  76.       'LOCATE cy, 1: PRINT
  77.     END IF
  78.   END IF
  81.  
  82. FUNCTION MapKey (k)
  83.   RESTORE CP437_Mapkey
  84.   READ n
  85.   FOR i = 1 TO n
  86.     READ ky, map
  87.     IF ky = k THEN EXIT FOR
  88.   NEXT i
  89.   IF i > n THEN map = k
  90.   MapKey = map
  92.  
  93.   CP437_Mapkey: '+Euro+....
  94.   DATA 58,128,238,161,173,162,155,163,156,164,15,165,157,166,124,167,21,170,166,171,174
  95.   DATA 172,170,176,248,177,241,178,253,181,230,182,020,183,250,186,167,187,175,188,172
  96.   DATA 189,171,191,168,196,142,197,143,198,146,199,128,201,144,209,165,214,153,220,154
  97.   DATA 223,225,224,133,225,160,226,131,228,132,229,134,230,145,231,135,232,138,233,130
  98.   DATA 234,136,235,137,236,141,237,161,238,140,239,139,241,164,242,149,243,162,244,147
  99.   DATA 246,148,247,246,248,126,249,151,250,163,251,150,252,129,255,152
  100.  
  101.   ' DATA 55,128,238,161,173,162,155,163,156,165,157,167,21,170,166,171,174
  102.   ' DATA 172,170,176,248,177,241,178,253,181,230,183,250,186,167,187,175
  103.   ' DATA 188,172,189,171,191,168,196,142,197,143,198,146,199,128,201,144
  104.   ' DATA 209,165,214,153,220,154,223,225,224,133,225,160,226,131,228,132
  105.   ' DATA 229,134,230,145,231,135,232,138,233,130,234,136,235,137,236,141
  106.   ' DATA 237,161,238,140,239,139,241,164,242,149,243,162,244,147,246,148
  107.   ' DATA 247,246,249,151,250,163,251,150,252,129
  109.  

Attach then memo
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: RhoSigma on June 17, 2020, 04:04:27 pm
Good work done,
as far as I see it right now everything works nice here with my de-de keyboard, at least with all the printable chars. However, will do a more comprehensive test comming weekend to check if especially all the double char (CHR$(0)+X) codes work as expected too. I'll let you know.

One question, would you mind me to implement your routine in the comming versions of my GuiTools Framework?
Of course it will be explicitlity mentioned, that you're the creator of this universal input routine.
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: moises1953 on June 19, 2020, 02:30:13 am
Thank's again RhoSigma. Of course you can freely use this code, which is essentially yours, but better this latest version today, with support for the following language-keyboard, as soon as then CP437 allows: da-DK, de-DE, de-CH, en-US, en-GB, es-ES, fr-FR, fr-BE, fr-CH, it-IT, nl-NL, sv-SE, pt-PT.

Today version of InKeykit$. At the moment I will leave it here, unless someone detects bugs and puts them on this forum.
Code: QB64: [Select]
  2. DEFLNG H-P
  3. DECLARE LIBRARY 'Used by QB64 'Kernel32' & 'User32'
  4.   FUNCTION GetACP~% 'CodePage
  5.   '  FUNCTION GetKeyboardLayoutName ALIAS GetKeyboardLayoutNameA (wszKLID$) 'boolean
  6.   FUNCTION GetKeyboardLayout&& (BYVAL thread&)
  7.   FUNCTION GetLastError& ()
  9.  
  10. CONST Phor = 1024, Pver = 768 ' XGA
  11. 'CONST Phor = 1200, Pver = 900 ' HD+4:3
  12.  
  13. TITLE "Inkeyhit" 'Version 2.0
  14. hscr = NEWIMAGE(Phor, Pver, 256)
  15. SCREEN hscr
  16. CONTROLCHR OFF
  17. 'Allows test keyboard maping
  18. SCREENMOVE 0, 0
  19. '<Alt><Intro> for fullscreen
  20.  
  21. fontpath$ = "Lucon.ttf": fontsize% = 20 'Windows lucida console 20x12; 24x14
  22. style$ = "MONOSPACE"
  23. hfont = LOADFONT(fontpath$, fontsize%, style$)
  24. IF hfont THEN FONT hfont
  25.  
  26. PRINT "Inkeyhit & display (000-047):  ";
  27. FOR i = 1 TO 47: PRINT CHR$(i);: NEXT
  29. PRINT "CP437 extended     (128-175): €‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ ¡¢£¤¥¦§¨©ª«¬­®¯"
  30. PRINT "                   (176-223): °±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß"
  31. PRINT "                   (224-255): àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"
  32. PRINT " Please, test Keyboard maping. Code page:"; GetACP; " Keyboard"; KbdLayOut
  33. PRINT CHR$(254);
  34. LOCATE , 1
  36.   in$ = Inkeyhit$ 'emulates quickbasic INKEY$
  37.   IF LEN(in$) THEN
  38.     PRINT in$;
  39.     IF in$ = CHR$(13) THEN PRINT
  40.     pcol = POS(0)
  41.     PRINT CHR$(254);
  42.     LOCATE , pcol
  43.   END IF
  44. LOOP UNTIL in$ = CHR$(27)
  45. FONT 16
  46. IF hfont THEN FREEFONT hfont
  48.  
  49. FUNCTION KbdLayOut
  50.   K = GetKeyboardLayout(0)
  51.   KbdLayOut = SHR(K, 16)
  53.  
  54. FUNCTION Inkeyhit$ 'Emulates INKEY$
  55.   CONST kbDaDk = 1030, kbDeDe = 1031, kbEnUs = 1033, kbEsEs = 1034, kbFrFr = 1036
  56.   CONST kbItIt = 1040, kbNlNl = 1043, KbSvSe = 1053
  57.   CONST kbDeCh = 2055, kbEnEn = 2057, kbFrBe = 2060, kbPtPt = 2070, KbFrCh = 4108
  58.  
  59.   CONST PkAcute = 1, PkGrave = 2, PkUmlau = 3, PkCircu = 4
  60.  
  61.   CONST KeyLook = "€¡¢£¤¥¦§ª«¬°±²µ¶·º»¼½¿ÄÅÆÇÉÑÖÜßàáâäåæçèéêëìíîïñòóôö÷øùúûüÿ" 'Accesible mapings in CP437
  62.   CONST KeyMapi = "î­›œ|¦®ªøñýæú§¯¬«¨Ž’€¥™šá… ƒ„†‘‡Š‚ˆ‰¡Œ‹¤•¢“”öè—£–˜" 'Maping code
  63.  
  64.   CONST AcuteLook = "aeiouE", GraveLook = " aeiou", UmlauLook = "aeiouAOUy", CircuLook = " aeiouA"
  65.   CONST AcuteMapi = " ‚¡¢£", GraveMapi = "`…Š•—", UmlauMapi = "„‰‹”Ž™š˜", CircuMapi = "^ƒˆŒ“–"
  66.  
  67.   STATIC lastKey AS LONG, prekey AS LONG, number$
  68.   DIM car AS UNSIGNED BYTE, dblcar AS STRING * 2
  69.  
  70.   hit = KEYHIT
  71.   IF hit THEN
  72.     car = 0
  73.     keyshift = KEYDOWN(100303) OR KEYDOWN(100304)
  74.     keyctrl = KEYDOWN(100305) OR KEYDOWN(100306)
  75.     keyAltGr = KEYDOWN(100307) AND KEYDOWN(100306)
  76.     keyalt = (KEYDOWN(100307) OR KEYDOWN(100308)) AND NOT keyAltGr
  77.  
  78.     IF hit > 0 THEN
  79.       IF hit < 256 THEN lastKey = hit
  80.       IF hit > 64 AND hit < 123 THEN
  81.         SELECT CASE prekey
  82.           CASE PkAcute '
  83.             p = INSTR(AcuteLook, CHR$(hit))
  84.             IF p THEN car = ASC(AcuteMapi, p)
  85.           CASE PkGrave '`
  86.             p = INSTR(GraveLook, CHR$(hit))
  87.             IF p THEN car = ASC(GraveMapi, p)
  88.           CASE PkUmlau
  89.             p = INSTR(UmlauLook, CHR$(hit))
  90.             IF p THEN car = ASC(UmlauMapi, p)
  91.           CASE PkCircu
  92.             p = INSTR(CircuLook, CHR$(hit))
  93.             IF p THEN car = ASC(CircuMapi, p)
  94.         END SELECT
  95.       END IF
  96.  
  97.       IF car THEN
  98.         prekey = 0
  99.       ELSE
  100.         '--- control sequences and special behavior ---
  101.         SELECT CASE hit
  102.           CASE 9 'tab
  103.             IF keyshift THEN dblcar = CHR$(0) + CHR$(15) ELSE car = hit
  104.           CASE 48 TO 57 'numeric heys 0-9
  105.             IF keyalt = 0 THEN car = hit
  106.           CASE 65 TO 90 'CTRL CAPS A-Z: 1-26
  107.             IF keyctrl THEN car = hit - 64 ELSE car = hit
  108.           CASE 97 TO 122 'CTRL a-z: 1-26
  109.             IF keyctrl THEN car = hit - 96 ELSE car = hit
  110.           CASE 0 TO 127 'ASCII
  111.             car = hit
  112.           CASE 128 TO 255
  113.             '--- bring the system codepage mapped inputs back to Cp437, if available ---
  114.             p = INSTR(KeyLook, CHR$(hit))
  115.             IF p THEN car = ASC(KeyMapi, p) ELSE car = hit
  116.           CASE 256 TO 65535 'double byte chr$(0)+
  117.             dblcar = MKI$(hit)
  118.             IF ASC(dblcar) = 0 THEN
  119.               car = ASC(dblcar, 2)
  120.               SELECT CASE car 'priority ordering (Alt -> Ctrl -> Shift)
  121.                 CASE 59 TO 68 'F1-F10
  122.                   IF keyalt THEN
  123.                     MID$(dblcar, 2) = CHR$(car + 45)
  124.                   ELSEIF keyctrl THEN
  125.                     MID$(dblcar, 2) = CHR$(car + 35)
  126.                   ELSEIF keyshift THEN
  127.                     MID$(dblcar, 2) = CHR$(car + 25)
  128.                   END IF
  129.                 CASE 133, 134 'F11-F12
  130.                   IF keyalt THEN
  131.                     MID$(dblcar, 2) = CHR$(car + 6)
  132.                   ELSEIF keyctrl THEN
  133.                     MID$(dblcar, 2) = CHR$(car + 4)
  134.                   ELSEIF keyshift THEN
  135.                     MID$(dblcar, 2) = CHR$(car + 2)
  136.                   END IF
  137.                 CASE 71 'Home
  138.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(119) 'w
  139.                 CASE 73 'RePag
  140.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(132) '„
  141.                 CASE 75 'Left
  142.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(115) 's
  143.                 CASE 77 'Right
  144.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(116) 't
  145.                 CASE 79 'End
  146.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(117) 'u
  147.                 CASE 81 'AvPag
  148.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(118) 'v
  149.               END SELECT
  150.             END IF
  151.             IF CVI(dblcar) THEN
  152.               Inkeyhit$ = dblcar
  153.               prekey = 0
  154.               lastKey = 0
  155.             END IF
  156.             car = 0
  157.           CASE IS >= &H40000000 'unicode (someday)
  158.             hitu = hit - &H40000000 '4 bytes
  159.         END SELECT
  160.       END IF 'car
  161.     ELSE 'hit<0
  162.       kbl = KbdLayOut
  163.       SELECT CASE hit
  164.         CASE -57 TO -48 'character code: numeric keys, also numeric keypad with numlock
  165.           IF keyalt THEN
  166.             IF LEN(number$) > 2 THEN number$ = RIGHT$(number$, 2)
  167.             number$ = number$ + CHR$(ABS(hit))
  168.           ELSEIF hit = -50 AND keyAltGr THEN 'fr-FR ~
  169.             car = 126
  170.           END IF
  171.         CASE -100308 'Alt up: capture character code
  172.           IF LEN(number$) THEN
  173.             car = VAL(number$)
  174.             number$ = ""
  175.           END IF
  176.         CASE -lastKey 'cancel lastkey
  177.           lastKey = 0
  178.           'special keys that only release
  179.           'including accents. prekey: 1-acute, 2-grave, 3-umlaut, 4-circumflex
  180.         CASE -186 'es-ES pt-PT da-DK & sv-SE
  181.           SELECT CASE kbl
  182.             CASE kbPtPt 'pt-PT: grave & acute accent
  183.               IF keyshift THEN
  184.                 prekey = PkGrave
  185.               ELSE
  186.                 prekey = PkAcute
  187.               END IF
  188.             CASE kbEsEs 'es-ES: circumflex & grave accent
  189.               IF keyshift THEN
  190.                 prekey = PkCircu
  191.               ELSE
  192.                 prekey = PkGrave
  193.               END IF
  194.             CASE ELSE 'da-DK & sv-SE:  circumflex & umlaut
  195.               IF keyshift THEN
  196.                 prekey = PkCircu
  197.               ELSE
  198.                 prekey = PkUmlau
  199.               END IF
  200.           END SELECT
  201.         CASE -187 'pt-PT: umlaut
  202.           prekey = PkUmlau
  203.         CASE -191 'pt-PT: circumflex
  204.           prekey = PkCircu
  205.         CASE -192 'nl-NL de-CH & fr-FR fr-BE
  206.           SELECT CASE kbl
  207.             CASE kbNlNl 'nl-NL: grave & acute accent
  208.               IF keyshift THEN
  209.                 prekey = PkGrave
  210.               ELSE
  211.                 prekey = PkAcute
  212.               END IF
  213.             CASE kbDeCh 'de-CH: umlaut
  214.               prekey = PkUmlau
  215.             CASE ELSE 'fr-FR fr-BE: acute
  216.               prekey = PkAcute
  217.           END SELECT
  218.         CASE -219 'de-CH da-DK & sv-SE
  219.           IF kbl = kbDeCh THEN 'de-CH: acute
  220.             prekey = PkAcute
  221.           ELSE 'da-DK & sv-SE: grave & acute accent
  222.             IF keyshift THEN
  223.               prekey = PkGrave
  224.             ELSE
  225.               prekey = PkAcute
  226.             END IF
  227.           END IF
  228.         CASE -220 'fr-BE & de-DU
  229.           IF kbl = kbFrBe THEN 'fr-BE: grave
  230.             prekey = PkGrave
  231.           ELSE 'de-DE: circumflex
  232.             prekey = PkCircu
  233.           END IF
  234.         CASE -221 'fr-FR fr-BE nl-NL & de-DE
  235.           SELECT CASE kbl 'keyboard layout
  236.             CASE kbFrFr, kbFrBe 'fr-FR: umlaut & circumflex
  237.               IF keyshift THEN
  238.                 prekey = PkUmlau
  239.               ELSE
  240.                 prekey = PkCircu
  241.               END IF
  242.             CASE kbNlNl 'nl-NL:  circumflex & umlaut
  243.               IF keyshift THEN
  244.                 prekey = PkCircu
  245.               ELSE
  246.                 prekey = PkUmlau
  247.               END IF
  248.             CASE kbDeCh 'de-CH grave & circumflex
  249.               IF keyshift THEN
  250.                 prekey = PkGrave
  251.               ELSE
  252.                 prekey = PkCircu
  253.               END IF
  254.             CASE ELSE 'de-DE : grave & acute accent
  255.               IF keyshift THEN
  256.                 prekey = PkGrave
  257.               ELSE
  258.                 prekey = PkAcute
  259.               END IF
  260.           END SELECT
  261.         CASE -222 'es-ES: umlaut & acute accent;  Spanish (di‚resis)
  262.           IF keyshift THEN
  263.             prekey = PkUmlau
  264.           ELSE
  265.             prekey = PkAcute
  266.           END IF
  267.         CASE -226 'pt-PT: \  ?
  268.           car = 92
  269.       END SELECT 'hit
  270.     END IF 'hit>0
  271.     IF car THEN
  272.       Inkeyhit$ = CHR$(car)
  273.       prekey = 0
  274.     END IF
  275.   END IF 'hit
  277.  

I am updating the document
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: moises1953 on June 19, 2020, 07:44:15 am
Injected defect.

This works OK
Code: QB64 $NOPREFIX: [Select]
  2. DEFLNG H-P
  3. DECLARE LIBRARY 'Used by QB64 'Kernel32' & 'User32'
  4.   FUNCTION GetACP~% 'CodePage
  5.   '  FUNCTION GetKeyboardLayoutName ALIAS GetKeyboardLayoutNameA (wszKLID$) 'boolean
  6.   FUNCTION GetKeyboardLayout&& (BYVAL thread&)
  7.   FUNCTION GetLastError& ()
  9.  
  10. CONST Phor = 1024, Pver = 768 ' XGA
  11. 'CONST Phor = 1200, Pver = 900 ' HD+4:3
  12.  
  13. TITLE "Inkeyhit" 'Version 2.01
  14. hscr = NEWIMAGE(Phor, Pver, 256)
  15. SCREEN hscr
  17. 'Allows test keyboard maping
  19. '<Alt><Intro> for fullscreen
  20.  
  21. fontpath$ = "Lucon.ttf": fontsize% = 20 'Windows lucida console 20x12; 24x14
  22. style$ = "MONOSPACE"
  23. hfont = LOADFONT(fontpath$, fontsize%, style$)
  24. IF hfont THEN FONT hfont
  25.  
  26. PRINT "Inkeyhit & display (000-047):  ";
  27. FOR i = 1 TO 47: PRINT CHR$(i);: NEXT
  29. PRINT "CP437 extended     (128-175): €‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ ¡¢£¤¥¦§¨©ª«¬­®¯"
  30. PRINT "                   (176-223): °±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß"
  31. PRINT "                   (224-255): àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"
  32. PRINT " Please, test Keyboard maping. Code page:"; GetACP; " Keyboard"; KbdLayOut
  33. PRINT CHR$(254);
  34. LOCATE , 1
  36.   in$ = Inkeyhit$ 'emulates quickbasic INKEY$
  37.   IF LEN(in$) THEN
  38.     PRINT in$;
  39.     IF in$ = CHR$(13) THEN PRINT
  40.     pcol = POS(0)
  41.     PRINT CHR$(254);
  42.     LOCATE , pcol
  43.   END IF
  44. LOOP UNTIL in$ = CHR$(27)
  45. FONT 16
  46. IF hfont THEN FREEFONT hfont
  48.  
  49. FUNCTION KbdLayOut
  50.   K = GetKeyboardLayout(0)
  51.   KbdLayOut = SHR(K, 16)
  53.  
  54. FUNCTION Inkeyhit$ 'Emulates INKEY$
  55.   CONST kbDaDk = 1030, kbDeDe = 1031, kbEnUs = 1033, kbEsEs = 1034, kbFrFr = 1036
  56.   CONST kbItIt = 1040, kbNlNl = 1043, KbSvSe = 1053
  57.   CONST kbDeCh = 2055, kbEnEn = 2057, kbFrBe = 2060, kbPtPt = 2070, KbFrCh = 4108
  58.  
  59.   CONST PkAcute = 1, PkGrave = 2, PkUmlau = 3, PkCircu = 4
  60.  
  61.   CONST KeyLook = "€¡¢£¤¥¦§ª«¬°±²µ¶·º»¼½¿ÄÅÆÇÉÑÖÜßàáâäåæçèéêëìíîïñòóôö÷øùúûüÿ" 'Accesible mapings in CP437
  62.   CONST KeyMapi = "î­›œ|¦®ªøñýæú§¯¬«¨Ž’€¥™šá… ƒ„†‘‡Š‚ˆ‰¡Œ‹¤•¢“”öè—£–˜" 'Maping code
  63.  
  64.   CONST AcuteLook = "aeiouE", GraveLook = " aeiou", UmlauLook = "aeiouAOUy", CircuLook = " aeiouA"
  65.   CONST AcuteMapi = " ‚¡¢£", GraveMapi = "`…Š•—", UmlauMapi = "„‰‹”Ž™š˜", CircuMapi = "^ƒˆŒ“–"
  66.  
  67.   STATIC lastKey AS LONG, prekey AS LONG, number$
  68.   DIM car AS UNSIGNED BYTE, dblcar AS STRING * 2
  69.  
  70.   hit = KEYHIT
  71.   IF hit THEN
  72.     car = 0
  73.     keyshift = KEYDOWN(100303) OR KEYDOWN(100304)
  74.     keyctrl = KEYDOWN(100305) OR KEYDOWN(100306)
  75.     keyAltGr = KEYDOWN(100307) AND KEYDOWN(100306)
  76.     keyalt = (KEYDOWN(100307) OR KEYDOWN(100308)) AND NOT keyAltGr
  77.  
  78.     IF hit > 0 THEN
  79.       IF hit < 256 THEN lastKey = hit
  80.       IF hit >= 32 AND hit < 123 THEN
  81.         SELECT CASE prekey
  82.           CASE PkAcute '
  83.             p = INSTR(AcuteLook, CHR$(hit))
  84.             IF p THEN car = ASC(AcuteMapi, p)
  85.           CASE PkGrave '`
  86.             p = INSTR(GraveLook, CHR$(hit))
  87.             IF p THEN car = ASC(GraveMapi, p)
  88.           CASE PkUmlau
  89.             p = INSTR(UmlauLook, CHR$(hit))
  90.             IF p THEN car = ASC(UmlauMapi, p)
  91.           CASE PkCircu
  92.             p = INSTR(CircuLook, CHR$(hit))
  93.             IF p THEN car = ASC(CircuMapi, p)
  94.         END SELECT
  95.       END IF
  96.  
  97.       IF car THEN
  98.         prekey = 0
  99.       ELSE
  100.         '--- control sequences and special behavior ---
  101.         SELECT CASE hit
  102.           CASE 9 'tab
  103.             IF keyshift THEN dblcar = CHR$(0) + CHR$(15) ELSE car = hit
  104.           CASE 48 TO 57 'numeric heys 0-9
  105.             IF keyalt = 0 THEN car = hit
  106.           CASE 65 TO 90 'CTRL CAPS A-Z: 1-26
  107.             IF keyctrl THEN car = hit - 64 ELSE car = hit
  108.           CASE 97 TO 122 'CTRL a-z: 1-26
  109.             IF keyctrl THEN car = hit - 96 ELSE car = hit
  110.           CASE 0 TO 127 'ASCII
  111.             car = hit
  112.           CASE 128 TO 255
  113.             '--- bring the system codepage mapped inputs back to Cp437, if available ---
  114.             p = INSTR(KeyLook, CHR$(hit))
  115.             IF p THEN car = ASC(KeyMapi, p) ELSE car = hit
  116.           CASE 256 TO 65535 'double byte chr$(0)+
  117.             dblcar = MKI$(hit)
  118.             IF ASC(dblcar) = 0 THEN
  119.               car = ASC(dblcar, 2)
  120.               SELECT CASE car 'priority ordering (Alt -> Ctrl -> Shift)
  121.                 CASE 59 TO 68 'F1-F10
  122.                   IF keyalt THEN
  123.                     MID$(dblcar, 2) = CHR$(car + 45)
  124.                   ELSEIF keyctrl THEN
  125.                     MID$(dblcar, 2) = CHR$(car + 35)
  126.                   ELSEIF keyshift THEN
  127.                     MID$(dblcar, 2) = CHR$(car + 25)
  128.                   END IF
  129.                 CASE 133, 134 'F11-F12
  130.                   IF keyalt THEN
  131.                     MID$(dblcar, 2) = CHR$(car + 6)
  132.                   ELSEIF keyctrl THEN
  133.                     MID$(dblcar, 2) = CHR$(car + 4)
  134.                   ELSEIF keyshift THEN
  135.                     MID$(dblcar, 2) = CHR$(car + 2)
  136.                   END IF
  137.                 CASE 71 'Home
  138.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(119) 'w
  139.                 CASE 73 'RePag
  140.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(132) '„
  141.                 CASE 75 'Left
  142.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(115) 's
  143.                 CASE 77 'Right
  144.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(116) 't
  145.                 CASE 79 'End
  146.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(117) 'u
  147.                 CASE 81 'AvPag
  148.                   IF keyctrl THEN MID$(dblcar, 2) = CHR$(118) 'v
  149.               END SELECT
  150.             END IF
  151.             IF CVI(dblcar) THEN
  152.               Inkeyhit$ = dblcar
  153.               prekey = 0
  154.               lastKey = 0
  155.             END IF
  156.             car = 0
  157.           CASE IS >= &H40000000 'unicode (someday)
  158.             hitu = hit - &H40000000 '4 bytes
  159.         END SELECT
  160.       END IF 'car
  161.     ELSE 'hit<0
  162.       kbl = KbdLayOut
  163.       SELECT CASE hit
  164.         CASE -57 TO -48 'character code: numeric keys, also numeric keypad with numlock
  165.           IF keyalt THEN
  166.             IF LEN(number$) > 2 THEN number$ = RIGHT$(number$, 2)
  167.             number$ = number$ + CHR$(ABS(hit))
  168.           ELSEIF hit = -50 AND keyAltGr THEN 'fr-FR ~
  169.             car = 126
  170.           END IF
  171.         CASE -100308 'Alt up: capture character code
  172.           IF LEN(number$) THEN
  173.             car = VAL(number$)
  174.             number$ = ""
  175.           END IF
  176.         CASE -lastKey 'cancel lastkey
  177.           lastKey = 0
  178.           'special keys that only release
  179.           'including accents. prekey: 1-acute, 2-grave, 3-umlaut, 4-circumflex
  180.         CASE -186 'es-ES pt-PT da-DK & sv-SE
  181.           SELECT CASE kbl
  182.             CASE kbPtPt 'pt-PT: grave & acute accent
  183.               IF keyshift THEN
  184.                 prekey = PkGrave
  185.               ELSE
  186.                 prekey = PkAcute
  187.               END IF
  188.             CASE kbEsEs 'es-ES: circumflex & grave accent
  189.               IF keyshift THEN
  190.                 prekey = PkCircu
  191.               ELSE
  192.                 prekey = PkGrave
  193.               END IF
  194.             CASE ELSE 'da-DK & sv-SE:  circumflex & umlaut
  195.               IF keyshift THEN
  196.                 prekey = PkCircu
  197.               ELSE
  198.                 prekey = PkUmlau
  199.               END IF
  200.           END SELECT
  201.         CASE -187 'pt-PT: umlaut
  202.           prekey = PkUmlau
  203.         CASE -191 'pt-PT: circumflex
  204.           prekey = PkCircu
  205.         CASE -192 'nl-NL de-CH & fr-FR fr-BE
  206.           SELECT CASE kbl
  207.             CASE kbNlNl 'nl-NL: grave & acute accent
  208.               IF keyshift THEN
  209.                 prekey = PkGrave
  210.               ELSE
  211.                 prekey = PkAcute
  212.               END IF
  213.             CASE kbDeCh 'de-CH: umlaut
  214.               prekey = PkUmlau
  215.             CASE ELSE 'fr-FR fr-BE: acute
  216.               prekey = PkAcute
  217.           END SELECT
  218.         CASE -219 'de-CH da-DK & sv-SE
  219.           IF kbl = kbDeCh THEN 'de-CH: acute
  220.             prekey = PkAcute
  221.           ELSE 'da-DK & sv-SE: grave & acute accent
  222.             IF keyshift THEN
  223.               prekey = PkGrave
  224.             ELSE
  225.               prekey = PkAcute
  226.             END IF
  227.           END IF
  228.         CASE -220 'fr-BE & de-DU
  229.           IF kbl = kbFrBe THEN 'fr-BE: grave
  230.             prekey = PkGrave
  231.           ELSE 'de-DE: circumflex
  232.             prekey = PkCircu
  233.           END IF
  234.         CASE -221 'fr-FR fr-BE nl-NL & de-DE
  235.           SELECT CASE kbl 'keyboard layout
  236.             CASE kbFrFr, kbFrBe 'fr-FR: umlaut & circumflex
  237.               IF keyshift THEN
  238.                 prekey = PkUmlau
  239.               ELSE
  240.                 prekey = PkCircu
  241.               END IF
  242.             CASE kbNlNl 'nl-NL:  circumflex & umlaut
  243.               IF keyshift THEN
  244.                 prekey = PkCircu
  245.               ELSE
  246.                 prekey = PkUmlau
  247.               END IF
  248.             CASE kbDeCh 'de-CH grave & circumflex
  249.               IF keyshift THEN
  250.                 prekey = PkGrave
  251.               ELSE
  252.                 prekey = PkCircu
  253.               END IF
  254.             CASE ELSE 'de-DE : grave & acute accent
  255.               IF keyshift THEN
  256.                 prekey = PkGrave
  257.               ELSE
  258.                 prekey = PkAcute
  259.               END IF
  260.           END SELECT
  261.         CASE -222 'es-ES: umlaut & acute accent;  Spanish (di‚resis)
  262.           IF keyshift THEN
  263.             prekey = PkUmlau
  264.           ELSE
  265.             prekey = PkAcute
  266.           END IF
  267.         CASE -226 'pt-PT: \  ?
  268.           car = 92
  269.       END SELECT 'hit
  270.     END IF 'hit>0
  271.     IF car THEN
  272.       Inkeyhit$ = CHR$(car)
  273.       prekey = 0
  274.     END IF
  275.   END IF 'hit
  277.  
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: RhoSigma on June 20, 2020, 06:05:53 pm
Have completed my tests, did some minor changes, so it now works perfect:

1.) added superscript "n" as replacement for the missing superscript "3" in cp437 (lines 61-62)
2.) replaced space with "á" (ASCII 160 in cp437) in AcuteMapi (line 65), maybe you've overlooked it
3.) added dblcar code for Ins/Del keys (line 149-152), codes according to available documentation
4.) moved the IF CVI(dblcar) THEN block (original lines 151-156) out of the CASE 256 TO 65535 section and placed it after END SELECT (new lines 158-163) of the respective SELECT CASE block, otherwise the reverse tab dblcar code from the beginning of that SELECT CASE block would never be recognized
5.) added a check for Alt+number ASCII input (lines 177-178), if the generated code is inside the printable ASCII range, although you already make sure the code is not longer than 3 digits, even 3 digits can still be > 255

Code: QB64 $NOPREFIX: [Select]
  2. DEFLNG H-P
  3. DECLARE LIBRARY 'Used by QB64 'Kernel32' & 'User32'
  4.     FUNCTION GetACP~% 'CodePage
  5.     '  FUNCTION GetKeyboardLayoutName ALIAS GetKeyboardLayoutNameA (wszKLID$) 'boolean
  6.     FUNCTION GetKeyboardLayout&& (BYVAL thread&)
  7.     FUNCTION GetLastError& ()
  9.  
  10. CONST Phor = 1024, Pver = 768 ' XGA
  11. 'CONST Phor = 1200, Pver = 900 ' HD+4:3
  12.  
  13. TITLE "Inkeyhit" 'Version 2.01
  14. hscr = NEWIMAGE(Phor, Pver, 256)
  15. SCREEN hscr
  17. 'Allows test keyboard maping
  19. '<Alt><Intro> for fullscreen
  20.  
  21. fontpath$ = "Lucon.ttf": fontsize% = 20 'Windows lucida console 20x12; 24x14
  22. style$ = "MONOSPACE"
  23. hfont = LOADFONT(fontpath$, fontsize%, style$)
  24. IF hfont THEN FONT hfont
  25.  
  26. PRINT "Inkeyhit & display (000-047):  ";
  27. FOR i = 1 TO 47: PRINT CHR$(i);: NEXT
  29. PRINT "CP437 extended     (128-175): €‚ƒ„…†‡ˆ‰Š‹ŒŽ‘ä“”•–—˜™š›œÖö ¡¢£¤¥¦§Ü©ª«¬ü®¯"
  30. PRINT "                   (176-223): °±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞß"
  31. PRINT "                   (224-255): àáâãäåæçèéêëìíîïðñòóßÄö÷øùúûüýþÿ"
  32. PRINT " Please, test Keyboard maping. Code page:"; GetACP; " Keyboard"; KbdLayOut
  33. PRINT CHR$(254);
  34. LOCATE , 1
  36.     in$ = Inkeyhit$ 'emulates quickbasic INKEY$
  37.     IF LEN(in$) THEN
  38.         PRINT in$;
  39.         IF in$ = CHR$(13) THEN PRINT
  40.         pcol = POS(0)
  41.         PRINT CHR$(254);
  42.         LOCATE , pcol
  43.     END IF
  44. LOOP UNTIL in$ = CHR$(27)
  45. FONT 16
  46. IF hfont THEN FREEFONT hfont
  48.  
  49. FUNCTION KbdLayOut
  50. K = GetKeyboardLayout(0)
  51. KbdLayOut = SHR(K, 16)
  53.  
  54. FUNCTION Inkeyhit$ 'Emulates INKEY$
  55. CONST kbDaDk = 1030, kbDeDe = 1031, kbEnUs = 1033, kbEsEs = 1034, kbFrFr = 1036
  56. CONST kbItIt = 1040, kbNlNl = 1043, KbSvSe = 1053
  57. CONST kbDeCh = 2055, kbEnEn = 2057, kbFrBe = 2060, kbPtPt = 2070, KbFrCh = 4108
  58.  
  59. CONST PkAcute = 1, PkGrave = 2, PkUmlau = 3, PkCircu = 4
  60.  
  61. CONST KeyLook = "€¡¢£¤¥¦§ª«¬°±²³µ¶·º»¼½¿ÄÅÆÇÉÑÖÜßàáâäåæçèéêëìíîïñòóßö÷øùúûüÿ" 'Accesible mapings in CP437
  62. CONST KeyMapi = "îü›œ|¦®ªøñýüæú§¯¬«ÜŽä€¥™šá… ƒ„†‘‡Š‚ˆ‰¡Œ‹¤•¢“”öè—£–˜" 'Maping code
  63.  
  64. CONST AcuteLook = "aeiouE", GraveLook = " aeiou", UmlauLook = "aeiouAOUy", CircuLook = " aeiouA"
  65. CONST AcuteMapi = " ‚¡¢£", GraveMapi = "`…Š•—", UmlauMapi = "„‰‹”Ž™š˜", CircuMapi = "^ƒˆŒ“–"
  66.  
  67. STATIC lastKey AS LONG, prekey AS LONG, number$
  68. DIM car AS UNSIGNED BYTE, dblcar AS STRING * 2
  69.  
  70. hit = KEYHIT
  71. IF hit THEN
  72.     car = 0
  73.     keyshift = KEYDOWN(100303) OR KEYDOWN(100304)
  74.     keyctrl = KEYDOWN(100305) OR KEYDOWN(100306)
  75.     keyAltGr = KEYDOWN(100307) AND KEYDOWN(100306)
  76.     keyalt = (KEYDOWN(100307) OR KEYDOWN(100308)) AND NOT keyAltGr
  77.  
  78.     IF hit > 0 THEN
  79.         IF hit < 256 THEN lastKey = hit
  80.         IF hit >= 32 AND hit < 123 THEN
  81.             SELECT CASE prekey
  82.                 CASE PkAcute '
  83.                     p = INSTR(AcuteLook, CHR$(hit))
  84.                     IF p THEN car = ASC(AcuteMapi, p)
  85.                 CASE PkGrave '`
  86.                     p = INSTR(GraveLook, CHR$(hit))
  87.                     IF p THEN car = ASC(GraveMapi, p)
  88.                 CASE PkUmlau
  89.                     p = INSTR(UmlauLook, CHR$(hit))
  90.                     IF p THEN car = ASC(UmlauMapi, p)
  91.                 CASE PkCircu
  92.                     p = INSTR(CircuLook, CHR$(hit))
  93.                     IF p THEN car = ASC(CircuMapi, p)
  94.             END SELECT
  95.         END IF
  96.  
  97.         IF car THEN
  98.             prekey = 0
  99.         ELSE
  100.             '--- control sequences and special behavior ---
  101.             SELECT CASE hit
  102.                 CASE 9 'tab
  103.                     IF keyshift THEN dblcar = CHR$(0) + CHR$(15) ELSE car = hit
  104.                 CASE 48 TO 57 'numeric heys 0-9
  105.                     IF keyalt = 0 THEN car = hit
  106.                 CASE 65 TO 90 'CTRL CAPS A-Z: 1-26
  107.                     IF keyctrl THEN car = hit - 64 ELSE car = hit
  108.                 CASE 97 TO 122 'CTRL a-z: 1-26
  109.                     IF keyctrl THEN car = hit - 96 ELSE car = hit
  110.                 CASE 0 TO 127 'ASCII
  111.                     car = hit
  112.                 CASE 128 TO 255
  113.                     '--- bring the system codepage mapped inputs back to Cp437, if available ---
  114.                     p = INSTR(KeyLook, CHR$(hit))
  115.                     IF p THEN car = ASC(KeyMapi, p) ELSE car = hit
  116.                 CASE 256 TO 65535 'double byte chr$(0)+
  117.                     dblcar = MKI$(hit)
  118.                     IF ASC(dblcar) = 0 THEN
  119.                         car = ASC(dblcar, 2)
  120.                         SELECT CASE car 'priority ordering (Alt -> Ctrl -> Shift)
  121.                             CASE 59 TO 68 'F1-F10
  122.                                 IF keyalt THEN
  123.                                     MID$(dblcar, 2) = CHR$(car + 45)
  124.                                 ELSEIF keyctrl THEN
  125.                                     MID$(dblcar, 2) = CHR$(car + 35)
  126.                                 ELSEIF keyshift THEN
  127.                                     MID$(dblcar, 2) = CHR$(car + 25)
  128.                                 END IF
  129.                             CASE 133, 134 'F11-F12
  130.                                 IF keyalt THEN
  131.                                     MID$(dblcar, 2) = CHR$(car + 6)
  132.                                 ELSEIF keyctrl THEN
  133.                                     MID$(dblcar, 2) = CHR$(car + 4)
  134.                                 ELSEIF keyshift THEN
  135.                                     MID$(dblcar, 2) = CHR$(car + 2)
  136.                                 END IF
  137.                             CASE 71 'Home
  138.                                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(119) 'w
  139.                             CASE 73 'RePag
  140.                                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(132) '„
  141.                             CASE 75 'Left
  142.                                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(115) 's
  143.                             CASE 77 'Right
  144.                                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(116) 't
  145.                             CASE 79 'End
  146.                                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(117) 'u
  147.                             CASE 81 'AvPag
  148.                                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(118) 'v
  149.                             CASE 82 'Ins
  150.                                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(146) '’
  151.                             CASE 83 'Del
  152.                                 IF keyctrl THEN MID$(dblcar, 2) = CHR$(147) '“
  153.                         END SELECT
  154.                     END IF
  155.                 CASE IS >= &H40000000 'unicode (someday)
  156.                     hitu = hit - &H40000000 '4 bytes
  157.             END SELECT
  158.             IF CVI(dblcar) THEN
  159.                 Inkeyhit$ = dblcar
  160.                 prekey = 0
  161.                 lastKey = 0
  162.                 car = 0
  163.             END IF
  164.         END IF 'car
  165.     ELSE 'hit<0
  166.         kbl = KbdLayOut
  167.         SELECT CASE hit
  168.             CASE -57 TO -48 'character code: numeric keys, also numeric keypad with numlock
  169.                 IF keyalt THEN
  170.                     IF LEN(number$) > 2 THEN number$ = RIGHT$(number$, 2)
  171.                     number$ = number$ + CHR$(ABS(hit))
  172.                 ELSEIF hit = -50 AND keyAltGr THEN 'fr-FR ~
  173.                     car = 126
  174.                 END IF
  175.             CASE -100308 'Alt up: capture character code
  176.                 IF LEN(number$) THEN
  177.                     tmp% = VAL(number$)
  178.                     IF tmp% >= 32 AND tmp% <= 255 THEN car = tmp%
  179.                     number$ = ""
  180.                 END IF
  181.             CASE -lastKey 'cancel lastkey
  182.                 lastKey = 0
  183.                 'special keys that only release
  184.                 'including accents. prekey: 1-acute, 2-grave, 3-umlaut, 4-circumflex
  185.             CASE -186 'es-ES pt-PT da-DK & sv-SE
  186.                 SELECT CASE kbl
  187.                     CASE kbPtPt 'pt-PT: grave & acute accent
  188.                         IF keyshift THEN
  189.                             prekey = PkGrave
  190.                         ELSE
  191.                             prekey = PkAcute
  192.                         END IF
  193.                     CASE kbEsEs 'es-ES: circumflex & grave accent
  194.                         IF keyshift THEN
  195.                             prekey = PkCircu
  196.                         ELSE
  197.                             prekey = PkGrave
  198.                         END IF
  199.                     CASE ELSE 'da-DK & sv-SE:  circumflex & umlaut
  200.                         IF keyshift THEN
  201.                             prekey = PkCircu
  202.                         ELSE
  203.                             prekey = PkUmlau
  204.                         END IF
  205.                 END SELECT
  206.             CASE -187 'pt-PT: umlaut
  207.                 prekey = PkUmlau
  208.             CASE -191 'pt-PT: circumflex
  209.                 prekey = PkCircu
  210.             CASE -192 'nl-NL de-CH & fr-FR fr-BE
  211.                 SELECT CASE kbl
  212.                     CASE kbNlNl 'nl-NL: grave & acute accent
  213.                         IF keyshift THEN
  214.                             prekey = PkGrave
  215.                         ELSE
  216.                             prekey = PkAcute
  217.                         END IF
  218.                     CASE kbDeCh 'de-CH: umlaut
  219.                         prekey = PkUmlau
  220.                     CASE ELSE 'fr-FR fr-BE: acute
  221.                         prekey = PkAcute
  222.                 END SELECT
  223.             CASE -219 'de-CH da-DK & sv-SE
  224.                 IF kbl = kbDeCh THEN 'de-CH: acute
  225.                     prekey = PkAcute
  226.                 ELSE 'da-DK & sv-SE: grave & acute accent
  227.                     IF keyshift THEN
  228.                         prekey = PkGrave
  229.                     ELSE
  230.                         prekey = PkAcute
  231.                     END IF
  232.                 END IF
  233.             CASE -220 'fr-BE & de-DE
  234.                 IF kbl = kbFrBe THEN 'fr-BE: grave
  235.                     prekey = PkGrave
  236.                 ELSE 'de-DE: circumflex
  237.                     prekey = PkCircu
  238.                 END IF
  239.             CASE -221 'fr-FR fr-BE nl-NL & de-DE
  240.                 SELECT CASE kbl 'keyboard layout
  241.                     CASE kbFrFr, kbFrBe 'fr-FR: umlaut & circumflex
  242.                         IF keyshift THEN
  243.                             prekey = PkUmlau
  244.                         ELSE
  245.                             prekey = PkCircu
  246.                         END IF
  247.                     CASE kbNlNl 'nl-NL:  circumflex & umlaut
  248.                         IF keyshift THEN
  249.                             prekey = PkCircu
  250.                         ELSE
  251.                             prekey = PkUmlau
  252.                         END IF
  253.                     CASE kbDeCh 'de-CH grave & circumflex
  254.                         IF keyshift THEN
  255.                             prekey = PkGrave
  256.                         ELSE
  257.                             prekey = PkCircu
  258.                         END IF
  259.                     CASE ELSE 'de-DE : grave & acute accent
  260.                         IF keyshift THEN
  261.                             prekey = PkGrave
  262.                         ELSE
  263.                             prekey = PkAcute
  264.                         END IF
  265.                 END SELECT
  266.             CASE -222 'es-ES: umlaut & acute accent;  Spanish (di‚resis)
  267.                 IF keyshift THEN
  268.                     prekey = PkUmlau
  269.                 ELSE
  270.                     prekey = PkAcute
  271.                 END IF
  272.             CASE -226 'pt-PT: \  ?
  273.                 car = 92
  274.         END SELECT 'hit
  275.     END IF 'hit>0
  276.     IF car THEN
  277.         Inkeyhit$ = CHR$(car)
  278.         prekey = 0
  279.     END IF
  280. END IF 'hit
  282.  
  283.  
Title: Re: Alternative INKEY$ for Germany/Austria
Post by: moises1953 on June 21, 2020, 06:27:45 am
Thank's again RhoSigma:
1. OK
2. have been caused by copy and paste
OK for 3. 4 and .5.

The copy from forum doesn't work well in Spanish: ¡ has disappeared, as well as á.

The literal string mapping mechanism is compact and efficient, but does not copy well in the QB64 IDE, neither from the .odt document, nor from the forum, therefore, in the absence of constant arrays, it will be necessary to keep the code out of posts.

Updated QB64 code, with the valuable contribution of RhoSigma follows. Please confirm.

Title: Re: Alternative INKEY$ for Western-European languages (CP1252 based)
Post by: RhoSigma on June 21, 2020, 09:30:46 am
Hi moises,
I see the differences you've marked, but with downloading it's all correct now.

I've also modified the title of my initial post to indicate to other people, that's not longer a Germany/Austria fix only for INKEY$, but for most CP1252 based western european languages.

Now as this became a useful routine for many people, who might want to use it in their own programs, you should consider some more tweaks to make it a really independent easy paste & use function.

1.) Code it without $NOPREFIX, just for the case somebody is using an older QB64 version 1.0-1.3.
2.) Don't depend your variables on DEFLNG or similar, as other people have probably other defaults in effect, rather use type suffixes within the routine or DIM all variables locally in the function, the latter will also make sure it works with OPTION _EXPLICIT, you should test for this, as many people use it.
3.) Replace SHR in the KbdLayOut function with integer division, once again people may use a QB64 version, which does not yet have the SHR instruction
4.) Pack the file(s) into a .zip or .7z archive, even if it is only one file to avoid download errors. Eg. downloading via FTP does generally distinguish between binary and Ascii files and will add system specific line endings to Ascii files. I don't know about the line endings behavior in a regular HTTP download in the browser, but I'm using Firefox and it downloaded two of your files as pure text files and changed/added the.txt extension, while only one file was downloaded as .bas, all this cannot happen if it is an archive file.
Title: Re: Alternative INKEY$ for Western-European languages (CP1252 based)
Post by: moises1953 on July 02, 2020, 02:45:01 am
In this new version:
Some recommendations of RhoSigma for reusability.
Added some keyboards: en-IE,es-MX,nb-NO,
Keyboard Layout ID obtained at the beginning and passed to InkeyHit$ as parameter.
Added Function KlidToName.
Added a doc in spanish
All software and doc's compresed in the attached file

This is my final contribution for a time, due to work.

EDIT: In the attach v02.04 correct a defect in one portugusse accent, and added API funtions to obtain the name of locale about language & keyboard
Title: Re: Alternative INKEY$ for Western-European languages (CP1252 based)
Post by: RhoSigma on July 02, 2020, 03:02:45 am
I'm currently at work, no time, will check it later at home, nevertheless I've re-marked your post as "Best Anwer" to direct other interested people directly to the latest version. More feedback in a couple hours.
Title: Re: Alternative INKEY$ for Western-European languages (CP1252 based)
Post by: RhoSigma on July 02, 2020, 12:13:25 pm
Moises,
just had a look on the newest InkeyHit version. First and most important thing, it still works as expected here.
I see you've already eliminated all CASE ELSE blocks in the keyboard dependent preselection detection, which was something I've recognized too as a thing which needs change to avoid wrong operation on unrecognized keyboard layouts, so well done. Giving the keyboard layout as FUNCTION parameter, instead of calling the function everytime inside the InkeyHit routine is a good move too.

Everything else I could propose now would only be cosmetic surgery, but I waive to it, as this is something dependent on the personal taste and everybody does have different preferences.

Thank You for your efforts,
RhoSigma
Title: Re: Alternative INKEY$ for Western-European languages (CP1252 based)
Post by: moises1953 on July 19, 2020, 12:56:48 pm
May be is correct use the Windows API function LCIDToLocaleName to obtain the language-keyboard name from KeyboardLayoutId (klid) ?

Code: QB64: [Select]
  1. DECLARE LIBRARY 'Used by QB64 'Kernel32' & 'User32'
  2.   FUNCTION GetACP~% 'CodePage
  3.   FUNCTION GetKeyboardLayoutName%% ALIAS GetKeyboardLayoutNameA (wszKLID$) 'boolean (byte)
  4.   FUNCTION GetKeyboardLayout&& (BYVAL thread&)
  5.   FUNCTION GetLastError& ()
  8.   FUNCTION LCIDToLocaleName% (BYVAL LCID&, lcidName$, BYVAL length%, BYVAL dwFlags~&)
  10. '....
  11. klid = KbdLayOut
  12. PRINT "Code page:"; GetACP; " Keyboard"; klid; LcidToName$(klid)
  13. '...
  15.  
  16. FUNCTION KbdLayOut&
  17.   STATIC k&
  18.   k& = GetKeyboardLayout(0)
  19.   KbdLayOut& = _SHR(k&, 16)
  21.  
  22. FUNCTION LcidToName$ (lcid&)
  23.   DIM le%, lcidname$
  24.   lcidname$ = STRING$(40, 0)
  25.   le% = LCIDToLocaleName%(lcid&, lcidname$, LEN(lcidname$), 0)
  26.   IF le% > 0 THEN
  27.     LcidToName$ = WideToAscii$(LEFT$(lcidname$, le% * 2), le%)
  28.   ELSE
  29.     LcidToName$ = ""
  30.   END IF
  32.  
  33. FUNCTION WideToAscii$ (unicodez$, le%)
  34.   DIM i&, ascii$
  35.   ascii$ = ""
  36.   FOR i& = 1 TO 2 * (le% - 1) STEP 2
  37.     ascii$ = ascii$ + MID$(unicodez$, i&, 1)
  38.   NEXT i&
  39.   WideToAscii$ = ascii$
  41.  

Text Only | Text with Attachments