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

Offline moises1953

  • Newbie
  • Posts: 39
Re: Alternative INKEY$ for Germany/Austria
« Reply #15 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

Offline BSpinoza

  • Newbie
  • Posts: 44
Re: Alternative INKEY$ for Germany/Austria
« Reply #16 on: June 19, 2020, 02:49:13 AM »
I'm missing the "^"-sign.
"Ich sage euch: man muss noch Chaos in sich haben, um einen tanzenden Stern gebären zu können. Ich sage euch: ihr habt noch Chaos in euch." (from Friedrich Nietzsche: "Also sprach Zarathustra")

Offline moises1953

  • Newbie
  • Posts: 39
Re: Alternative INKEY$ for Germany/Austria
« Reply #17 on: June 19, 2020, 07:44:15 AM »
Injected defect.

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

Offline RhoSigma

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

Offline moises1953

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

« Last Edit: June 21, 2020, 06:34:48 AM by moises1953 »

Offline RhoSigma

  • Seasoned Forum Regular
  • Posts: 369
  • Use multiple Desktop windows with GuiTools.
Re: Alternative INKEY$ for Western-European languages (CP1252 based)
« Reply #20 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.
Interested in my QB64 Stuff?
GuiTools Framework, Blankers, QB64/Notepad++ setup ...
Libraries (MD5/SHA2 hashing, DES56 encryption, LZW packer, File/Data buffers, Image processing, C++ stdlib wrappers and more)
see here: https://www.qb64.org/forum/index.php?topic=809.msg100182#msg100182

Marked as best answer by RhoSigma on July 02, 2020, 05:49:52 AM

Offline moises1953

  • Newbie
  • Posts: 39
Re: Alternative INKEY$ for Western-European languages (CP1252 based)
« Reply #21 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
« Last Edit: July 19, 2020, 12:40:12 PM by moises1953 »

Offline RhoSigma

  • Seasoned Forum Regular
  • Posts: 369
  • Use multiple Desktop windows with GuiTools.
Re: Alternative INKEY$ for Western-European languages (CP1252 based)
« Reply #22 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.
Interested in my QB64 Stuff?
GuiTools Framework, Blankers, QB64/Notepad++ setup ...
Libraries (MD5/SHA2 hashing, DES56 encryption, LZW packer, File/Data buffers, Image processing, C++ stdlib wrappers and more)
see here: https://www.qb64.org/forum/index.php?topic=809.msg100182#msg100182

Offline RhoSigma

  • Seasoned Forum Regular
  • Posts: 369
  • Use multiple Desktop windows with GuiTools.
Re: Alternative INKEY$ for Western-European languages (CP1252 based)
« Reply #23 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
Interested in my QB64 Stuff?
GuiTools Framework, Blankers, QB64/Notepad++ setup ...
Libraries (MD5/SHA2 hashing, DES56 encryption, LZW packer, File/Data buffers, Image processing, C++ stdlib wrappers and more)
see here: https://www.qb64.org/forum/index.php?topic=809.msg100182#msg100182

Offline moises1953

  • Newbie
  • Posts: 39
Re: Alternative INKEY$ for Western-European languages (CP1252 based)
« Reply #24 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& ()
  6.   FUNCTION LCIDToLocaleName% (BYVAL LCID&, lcidName$, BYVAL length%, BYVAL dwFlags~&)
  7. '....
  8. klid = KbdLayOut
  9. PRINT "Code page:"; GetACP; " Keyboard"; klid; LcidToName$(klid)
  10. '...
  11.  
  12. FUNCTION KbdLayOut&
  13.   STATIC k&
  14.   k& = GetKeyboardLayout(0)
  15.   KbdLayOut& = _SHR(k&, 16)
  16.  
  17. FUNCTION LcidToName$ (lcid&)
  18.   DIM le%, lcidname$
  19.   lcidname$ = STRING$(40, 0)
  20.   le% = LCIDToLocaleName%(lcid&, lcidname$, LEN(lcidname$), 0)
  21.   IF le% > 0 THEN
  22.     LcidToName$ = WideToAscii$(LEFT$(lcidname$, le% * 2), le%)
  23.   ELSE
  24.     LcidToName$ = ""
  25.   END IF
  26.  
  27. FUNCTION WideToAscii$ (unicodez$, le%)
  28.   DIM i&, ascii$
  29.   ascii$ = ""
  30.   FOR i& = 1 TO 2 * (le% - 1) STEP 2
  31.     ascii$ = ascii$ + MID$(unicodez$, i&, 1)
  32.   NEXT i&
  33.   WideToAscii$ = ascii$
  34.