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

0 Members and 1 Guest are viewing this topic.

Offline moises1953

  • Newbie
  • Posts: 55
Re: Alternative INKEY$ for Germany/Austria
« Reply #15 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.  
* Language in QB64-v0201.pdf (Filesize: 546.78 KB, Downloads: 166)
* Language in QB64-v0201.odt (Filesize: 460.96 KB, Downloads: 155)
« Last Edit: June 19, 2020, 01:29:49 pm by odin »

Offline RhoSigma

  • QB64 Developer
  • Forum Resident
  • Posts: 565
Re: Alternative INKEY$ for Germany/Austria
« Reply #16 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.  
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
Re: Alternative INKEY$ for Germany/Austria
« Reply #17 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.

* Language in QB64-v0202.pdf (Filesize: 537.91 KB, Downloads: 115)
* Language in QB64-v0202.odt (Filesize: 459.78 KB, Downloads: 96)
* InKeyHit-V0202.bas (Filesize: 10.7 KB, Downloads: 153)
* CP437 Reverse table-V0101.bas (Filesize: 2.72 KB, Downloads: 103)
* Keyhit-test-v0100.bas (Filesize: 3.14 KB, Downloads: 100)
« Last Edit: June 21, 2020, 06:34:48 am by moises1953 »

Offline RhoSigma

  • QB64 Developer
  • Forum Resident
  • Posts: 565
Re: Alternative INKEY$ for Western-European languages (CP1252 based)
« Reply #18 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.
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

Marked as best answer by RhoSigma on July 01, 2020, 10:49:52 pm

Offline moises1953

  • Newbie
  • Posts: 55
Re: Alternative INKEY$ for Western-European languages (CP1252 based)
« Reply #19 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
* Language in QB64-v0203.zip (Filesize: 2.74 MB, Downloads: 103)
* InKeyHit-V0204.zip (Filesize: 3.52 KB, Downloads: 93)
« Last Edit: July 19, 2020, 12:40:12 pm by moises1953 »

Offline RhoSigma

  • QB64 Developer
  • Forum Resident
  • Posts: 565
Re: Alternative INKEY$ for Western-European languages (CP1252 based)
« Reply #20 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.
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 RhoSigma

  • QB64 Developer
  • Forum Resident
  • Posts: 565
Re: Alternative INKEY$ for Western-European languages (CP1252 based)
« Reply #21 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
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
Re: Alternative INKEY$ for Western-European languages (CP1252 based)
« Reply #22 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.