Author Topic: Alternative INKEY$ for Western-European languages (CP1252 based)  (Read 12836 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline RhoSigma

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

Offline moises1953

  • Newbie
  • Posts: 55
    • View Profile
Re: Alternative INKEY$ for Germany/Austria
« Reply #1 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
  11. [/font]
  12.  

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

Offline moises1953

  • Newbie
  • Posts: 55
    • View Profile
Re: Alternative INKEY$ for Germany/Austria
« Reply #2 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.  

Offline DDBE

  • Newbie
  • Posts: 26
    • View Profile
Re: Alternative INKEY$ for Germany/Austria
« Reply #3 on: June 07, 2020, 01:12:49 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.

Offline RhoSigma

  • QB64 Developer
  • Forum Resident
  • Posts: 565
    • View Profile
Re: Alternative INKEY$ for Germany/Austria
« Reply #4 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.
My Projects:   https://qb64forum.alephc.xyz/index.php?topic=809
GuiTools - A graphic UI framework (can do multiple UI forms/windows in one program)
Libraries - ImageProcess, StringBuffers (virt. files), MD5/SHA2-Hash, LZW etc.
Bonus - Blankers, QB64/Notepad++ setup pack

Offline moises1953

  • Newbie
  • Posts: 55
    • View Profile
Re: Alternative INKEY$ for Germany/Austria
« Reply #5 on: June 09, 2020, 05:39:53 am »
I understand RhoSigma, but we need in the spanish keyboard.

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

Offline RhoSigma

  • QB64 Developer
  • Forum Resident
  • Posts: 565
    • View Profile
Re: Alternative INKEY$ for Germany/Austria
« Reply #6 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.
My Projects:   https://qb64forum.alephc.xyz/index.php?topic=809
GuiTools - A graphic UI framework (can do multiple UI forms/windows in one program)
Libraries - ImageProcess, StringBuffers (virt. files), MD5/SHA2-Hash, LZW etc.
Bonus - Blankers, QB64/Notepad++ setup pack

Offline loudar

  • Newbie
  • Posts: 73
  • improve it bit by bit.
    • View Profile
Re: Alternative INKEY$ for Germany/Austria
« Reply #7 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
« Last Edit: June 09, 2020, 12:09:09 pm by loudar »
Check out what I do besides coding: http://loudar.myportfolio.com/

Offline moises1953

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

* Language in QB64.pdf (Filesize: 388.33 KB, Downloads: 301)
* Language in QB64.odt (Filesize: 352.17 KB, Downloads: 280)
« Last Edit: June 12, 2020, 07:13:09 am by moises1953 »

Offline RhoSigma

  • QB64 Developer
  • Forum Resident
  • Posts: 565
    • View Profile
Re: Alternative INKEY$ for Germany/Austria
« Reply #9 on: June 12, 2020, 11:50:27 am »
Indeed, it works in german, just 2 things:

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.
My Projects:   https://qb64forum.alephc.xyz/index.php?topic=809
GuiTools - A graphic UI framework (can do multiple UI forms/windows in one program)
Libraries - ImageProcess, StringBuffers (virt. files), MD5/SHA2-Hash, LZW etc.
Bonus - Blankers, QB64/Notepad++ setup pack

Offline moises1953

  • Newbie
  • Posts: 55
    • View Profile
Re: Alternative INKEY$ for Germany/Austria
« Reply #10 on: June 13, 2020, 02:33:01 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?
« Last Edit: June 13, 2020, 03:08:02 am by moises1953 »

Offline RhoSigma

  • QB64 Developer
  • Forum Resident
  • Posts: 565
    • View Profile
Re: Alternative INKEY$ for Germany/Austria
« Reply #11 on: June 13, 2020, 04:26:12 am »
To get Keyboard type I use (in Windows)

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

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
My Projects:   https://qb64forum.alephc.xyz/index.php?topic=809
GuiTools - A graphic UI framework (can do multiple UI forms/windows in one program)
Libraries - ImageProcess, StringBuffers (virt. files), MD5/SHA2-Hash, LZW etc.
Bonus - Blankers, QB64/Notepad++ setup pack

Offline moises1953

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

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


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

Attach then memo
* Language in QB64-v0105.pdf (Filesize: 483.48 KB, Downloads: 388)
* Language in QB64-v0105.odt (Filesize: 464.84 KB, Downloads: 292)
« Last Edit: June 17, 2020, 11:35:28 am by moises1953 »

Offline RhoSigma

  • QB64 Developer
  • Forum Resident
  • Posts: 565
    • View Profile
Re: Alternative INKEY$ for Germany/Austria
« Reply #13 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.
My Projects:   https://qb64forum.alephc.xyz/index.php?topic=809
GuiTools - A graphic UI framework (can do multiple UI forms/windows in one program)
Libraries - ImageProcess, StringBuffers (virt. files), MD5/SHA2-Hash, LZW etc.
Bonus - Blankers, QB64/Notepad++ setup pack

Offline moises1953

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

I am updating the document