home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / KYBRD.ZIP / KYBRDEM.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-03-06  |  11.1 KB  |  344 lines
  1. program Kybrdem;                    {Demo for Turbo Pascal 4.0 Kybrd unit}
  2.  
  3. {John Haluska, CIS 74000,1106}
  4.  
  5. uses Crt,Kybrd;
  6.  
  7. var
  8.   Select  : char;
  9.  
  10. procedure KeyCodes(N : integer; var Kc : string);
  11.           {return keyname Kc for extended key code input N}
  12. const
  13.   Ks : array[1..25] of string[5] =
  14.        ('a-','c-','s-','F1','F2','F3','F4','F5','F6','F7','F8','F9','F10',
  15.         'F11','F12','Home','Up','PgUp','Left','Right','End','Down',
  16.         'PgDn','Ins','Del');
  17. begin
  18.   case N of
  19.     3   : Kc:=Ks[2]+'2'; {c-2}         15  : Kc:=Ks[3]+'Tab';  {s-Tab}
  20.     16  : Kc:=Ks[1]+'Q'; {a-Q}         17  : Kc:=Ks[1]+'W';    {a-W}
  21.     18  : Kc:=Ks[1]+'E'; {a-E}         19  : Kc:=KS[1]+'R';    {a-R}
  22.     20  : Kc:=Ks[1]+'T'; {a-T}         21  : Kc:=Ks[1]+'Y';    {a-Y}
  23.     22  : Kc:=Ks[1]+'U'; {a-U}         23  : Kc:=Ks[1]+'I';    {a-I}
  24.     24  : Kc:=Ks[1]+'O'; {a-O}         25  : Kc:=Ks[1]+'P';    {a-P}
  25.     30  : Kc:=Ks[1]+'A'; {a-A}         31  : Kc:=Ks[1]+'S';    {a-S}
  26.     32  : Kc:=Ks[1]+'D'; {a-D}         33  : Kc:=Ks[1]+'F';    {a-F}
  27.     34  : Kc:=Ks[1]+'G'; {a-G}         35  : Kc:=Ks[1]+'H';    {a-H}
  28.     36  : Kc:=Ks[1]+'J'; {a-J}         37  : Kc:=Ks[1]+'K';    {a-K}
  29.     38  : Kc:=Ks[1]+'L'; {a-L}         44  : Kc:=Ks[1]+'Z';    {a-Z}
  30.     45  : Kc:=Ks[1]+'X'; {a-X}         46  : Kc:=Ks[1]+'C';    {a-C}
  31.     47  : Kc:=Ks[1]+'V'; {a-U}         48  : Kc:=Ks[1]+'B';    {a-B}
  32.     49  : Kc:=Ks[1]+'N'; {a-N}         50  : Kc:=Ks[1]+'M';    {a-M}
  33.     59..68   : Kc:=Ks[N-55];        {F1 to F10}
  34.     71..73   : Kc:=Ks[N-55];        {Home,Up,PgUp}
  35.     75  : Kc:= Ks[19];   {Left}        77  : Kc:=Ks[20];  {Right}
  36.     79..83   : Kc:=Ks[N-58];        {End,Down,PgDn,Ins,Del}
  37.     84..93   : Kc:=Ks[3]+Ks[N-80];     {s-F1 to s-F10}
  38.     94..103  : Kc:=Ks[2]+Ks[N-90];     {c-F1 to c-F10}
  39.     104..113 : Kc:=Ks[1]+Ks[N-100];    {a-F1 to a-F10}
  40.     114  : Kc:=Ks[2]+'PrtSc';{c-PrtSc} 115  : Kc:=Ks[2]+Ks[19]; {c-Left}
  41.     116  : Kc:=Ks[2]+Ks[20]; {c-Right} 117  : Kc:=Ks[2]+Ks[21]; {c-End}
  42.     118  : Kc:=Ks[2]+Ks[23]; {c-PgDn}  119  : Kc:=Ks[2]+Ks[16]; {c-Home}
  43.     120  : Kc:=Ks[1]+'1';    {a-1}     121  : Kc:=Ks[1]+'2';    {a-2}
  44.     122  : Kc:=Ks[1]+'3';    {a-3}     123  : Kc:=Ks[1]+'4';    {a-4}
  45.     124  : Kc:=Ks[1]+'5';    {a-5}     125  : Kc:=Ks[1]+'6';    {a-6}
  46.     126  : Kc:=Ks[1]+'7';    {a-7}     127  : Kc:=Ks[1]+'8';    {a-8}
  47.     128  : Kc:=Ks[1]+'9';    {a-9}     129  : Kc:=Ks[1]+'0';    {a-0}
  48.     130  : Kc:=Ks[1]+' -';   {a- -}    131  : Kc:=Ks[1]+' =';   {a-=}
  49.     132  : Kc:=Ks[2]+Ks[18]; {c-PgUp}
  50.  
  51.       { enhanced keyboard extended keycodes }
  52.  
  53.       1  : Kc:=Ks[1]+'Esc'; {a-Esc}     14  : Kc:=Ks[1]+'Bksp';   {a-Bksp}
  54.      26  : Kc:=Ks[1]+'[';   {a-[}       27  : Kc:=Ks[1]+']';      {a-]}
  55.      28  : Kc:=Ks[1]+'Entr';{a-Entr}    39  : Kc:=Ks[1]+';';      {a-;}
  56.      40  : Kc:=Ks[1]+'"';   {a-"}       41  : Kc:=Ks[1]+'`';      {a-`}
  57.      43  : Kc:=Ks[1]+'\';   {a-\}       51  : Kc:=Ks[1]+',';      {a-,}
  58.      52  : Kc:=Ks[1]+'.';   {a-.}       53  : Kc:=Ks[1]+'/';      {a-/}
  59.      55  : Kc:=Ks[1]+'* Kypd';{a-* }    74  : Kc:=Ks[1]+' - Kypd';{a- - Kypd}
  60.      76  : Kc:='5 Kypd';    {5 Kypd}    78  : Kc:=Ks[1]+'+';      {a-+}
  61.     133..134  : Kc:=Ks[N-119];               {F11,F12}
  62.     135..136  : Kc:=Ks[3]+Ks[N-121];         {s-F11,s-F12}
  63.     137..138  : Kc:=Ks[2]+Ks[N-123];         {c-F11,c-F12}
  64.     139..140  : Kc:=Ks[1]+Ks[N-125];         {a-F11,a-F12}
  65.     141  : Kc:=Ks[2]+Ks[17];  {c-Up}    142 :  Kc:=Ks[2]+' - Kypd'; {c- - Kypd}
  66.     143  : Kc:=Ks[2]+'5 Kypd'; {c-5}    144 :  Kc:=Ks[2]+' +';    {c- +}
  67.     145  : Kc:=Ks[2]+Ks[22];  {c-Down}  146 :  Kc:=Ks[2]+Ks[24];  {c-Ins}
  68.     147  : Kc:=Ks[2]+Ks[25];  {c-Del}   148 :  Kc:=Ks[2]+'Tab';   {c-Tab}
  69.     149  : Kc:=Ks[2]+' / Kypd'; {c- /}  150 :  Kc:=Ks[2]+' * Kypd';{c- *}
  70.     151..153  : Kc:=Ks[1]+Ks[N-135]+' Curpd';   {a-Home,a-Up,a-PgUp Curpd}
  71.     155  : Kc:=Ks[1]+Ks[19]+' Curpd';  {a-Left Curpd}
  72.     157 :  Kc:=Ks[1]+Ks[20]+' Curpd';  {a-Right Curpd}
  73.     159..163  : Kc:=Ks[1]+Ks[N-138]+' Curpd'; {End,Down,PgDn,Ins,Del Curpd}
  74.     164  : Kc:=Ks[1]+'/ Kypd';{a-/ Kypd}165 :  Kc:=Ks[1]+'Tab';  {a- Tab}
  75.     166  : Kc:=Ks[1]+'Enter Kypd'; {a-Enter Kypd}
  76.   end;
  77. end; {KeyCodes}
  78.  
  79. procedure EnhkybrdTest;
  80. var
  81.   B : boolean;
  82. begin
  83.   Writeln('A: function Enhkybrd : boolean;');
  84.   Writeln;
  85.   B := Enhkybrd;
  86.   if B = True then
  87.     begin
  88.       Write('Enhkybrd = True.  This CPU has enhanced keyboard ');
  89.       Writeln('with F11, F12 keys ');
  90.       Writeln('supported by BIOS services 10-12h.');
  91.     end
  92.   else
  93.     begin
  94.       Write('Enhkybrd = False.  This CPU may or may not have the ');
  95.       Writeln('enhanced keyboard.');
  96.       Write('If the enhanced keyboard is present, it is supported by BIOS ');
  97.       Writeln('services 0-2.');
  98.     end;
  99. end;
  100.  
  101. procedure ErrorToneTest;
  102. var
  103.   Ch  : char;
  104.   X,Y  : byte;
  105. begin
  106.   Writeln;
  107.   Writeln('B:  procedure ErrorTone;');
  108.   Writeln('    Enter character:  1   : Generate ErrorTone (if enabled)');
  109.   Writeln('                      2   : Enable ErrorTone');
  110.   Writeln('                      3   : Disable ErrorTone');
  111.   Writeln('                      ESC : Exit this test');
  112.   Writeln;
  113.   X := WhereX; Y := WhereY;
  114.   repeat
  115.     Ch := ReadKey;
  116.     GotoXY(X,Y);
  117.     case Ch of
  118.       '1'  :  begin
  119.                 Write('1:  Generate ErrorTone (if enabled)    ');
  120.                 ErrorTone;
  121.               end;
  122.       '2'  :  begin
  123.                 Write('2:  Enable ErrorTone                   ');
  124.                 ErrorToneEnb := True;
  125.               end;
  126.       '3'  :  begin
  127.                 Write('3:  Disable ErrorTone                  ');
  128.                 ErrorToneEnb := False;
  129.               end;
  130.       #27  : ;                       {Esc}
  131.       #0   :  begin                  {Extended key}
  132.                 Write('Invalid key                            ');
  133.                 Ch := ReadKey;
  134.               end;
  135.       else  Write('Invalid key                            ');
  136.       end;
  137.   until Ch = #27;                     {Esc}
  138.   Writeln;
  139. end;
  140.  
  141. procedure KeyASCIITest;
  142. var
  143.   Key : char;
  144. begin
  145.   Writeln('C:  Key := KeyASCII([''0''..''9'',#13])');
  146.   Write('Enter any character, only 0 - 9, CR accepted,');
  147.   Writeln(' CR will end test: ');
  148.   repeat
  149.     Key := KeyASCII(['0'..'9',#13]);
  150.     Write (Key:4);
  151.   until Key = #13;
  152.   Writeln;
  153. end;
  154.  
  155. procedure KeyExtdTest;
  156. var
  157.   KE : byte;
  158. begin
  159.   Writeln('D:  KE := KeyExtd([#0,#73,#81]);');
  160.   Write('Enter any character, only PgUp, PgDn, CR accepted.  ');
  161.   Writeln(' CR will end test.');
  162.   repeat
  163.     KE := KeyExtd([#0,#73,#81]);
  164.     Write (KE:4);
  165.   until KE = 0;
  166.   Writeln;
  167. end;
  168.  
  169. procedure KeyFlushTest;
  170. var
  171.   B : byte;
  172. begin
  173.   Writeln('E: procedure KeyFlush;');
  174.   Writeln('Enter any character.  All characters discarded.');
  175.   Writeln('After 5 entries, this menu item will be exited.');
  176.   B := 0;
  177.   repeat
  178.     if KeyPressed then
  179.       begin
  180.         KeyFlush;
  181.         Inc(B)
  182.       end;
  183.     until B = 5;
  184.     Writeln;
  185.   end;
  186.  
  187. procedure KeyGetTest;
  188.           {Requires procedure KeyCodes}
  189. var
  190.   N : integer;
  191.   S : string;
  192. begin
  193.   Writeln('F: function KeyGet: integer;');
  194.   Writeln('   Return ASCII code or scan code + 256 if non-ASCII key.');
  195.   Writeln('   Enter any key. ESC terminates this menu item.',#13,#10);
  196.   repeat
  197.     N := KeyGet;
  198.     DelLine;
  199.     Write('  KeyGet Return: ',N:4);
  200.     case N of
  201.       0..9,11..12,14..255 :
  202.         Write('  ASCII Char: ',Chr(N),#13);
  203.       10 : Write('  ASCII Char: LF',#13);
  204.       13 : Write('  ASCII Char: CR',#13);
  205.       256..511 :
  206.         begin
  207.           Write('  Extended Key Code: ',(N-256):3);
  208.           {$V-}KeyCodes(N-256,S);{$V+}
  209.           Write('  ',S,#13);
  210.         end;
  211.       end;
  212.   until N = 27;
  213.   Writeln;
  214. end;
  215.  
  216. procedure KeyViewTest;
  217.           {Requires procedure KeyCodes}
  218. var
  219.   N : integer;
  220.   S : string;
  221. begin
  222.   Writeln('G: function KeyView : integer;');
  223.   Write('   Examine in buffer ASCII code or scan code + 256 if ');
  224.   Writeln('non-ASCII key.');
  225.   Writeln('   Enter any key. ESC terminates this menu item.',#13,#10);
  226.   repeat
  227.     N := KeyView;
  228.     DelLine;
  229.     Write('  KeyView Return: ',N:4);
  230.     case N of
  231.       0..9,11..12,14..255 :
  232.         Write('  ASCII Char: ',Chr(N),'  Flush Kybrd Buffer',#13);
  233.       10 : Write('  ASCII Char: LF  Flush Kybrd Buffer',#13);
  234.       13 : Write('  ASCII Char: CR  Flush Kybrd Buffer',#13);
  235.       256..511 :
  236.         begin
  237.           Write('  Extended Key Code: ',(N-256):3);
  238.           {$V-}KeyCodes(N-256,S);{$V+}
  239.           Write('  ',S,'  Flush Kybrd Buffer',#13);
  240.         end;
  241.       end;
  242.     KeyFlush;          {Remove keypress from buffer}
  243.   until N = 27;
  244.   Writeln;
  245. end;
  246.  
  247. procedure KeyWaitTest;
  248. var
  249.   B : byte;
  250. begin
  251.   Writeln('H: procedure KeyWait;');
  252.   Writeln('Enter any character.  All characters discarded.');
  253.   Writeln('After 5 entries, this menu item will be exited.');
  254.   B := 0;
  255.   repeat
  256.     KeyWait;
  257.     B := B + 1;
  258.   until B = 5;
  259.  Writeln;
  260. end;
  261.  
  262. procedure KeyYesTest;
  263. var
  264.   Cb  : boolean;
  265. begin
  266.   Writeln('I: function KeyYes : boolean;');
  267.   Writeln('Enter any character. Only "y","Y", "n", or "N" accepted.');
  268.   Cb := KeyYes;
  269.   if Cb = True then Writeln('KeyYes = True.')
  270.     else Writeln('KeyYes = False');
  271.   Writeln;
  272. end;
  273.  
  274. procedure LockKeyTest;
  275. var
  276.   Key : char;
  277.   Cb,Nb,Sb  : boolean;
  278. begin
  279.   Writeln('J: LockCaps, LockNum, LockScroll, LockStatus');
  280.   Writeln('   Enter number: 1 - LockCaps Off    2 - LockCaps On');
  281.   Writeln('                 3 - LockNum  Off    4 - LockNum On');
  282.   Write('                 5 - LockScroll Off  6 - LockScroll On : ');
  283.   Key := ReadKey;
  284.   Case Key of
  285.     '1' : LockCaps(False);
  286.     '2' : LockCaps(True);
  287.     '3' : LockNum(False);
  288.     '4' : LockNum(True);
  289.     '5' : LockScroll(False);
  290.     '6' : LockScroll(True);
  291.   end;
  292.   Writeln;
  293.   LockStatus(Cb,Nb,Sb);
  294.   Write(#10,#13,'   LockStatus: ');
  295.   if Cb then Write('Caps On, ') else Write('Caps Off, ');
  296.   if Nb then Write('Num On, ') else Write('Num Off, ');
  297.   if Sb then Writeln('Scroll On ') else Writeln('Scroll Off');
  298.   Writeln;
  299. end;
  300.  
  301. begin
  302.   ClrScr;
  303.   repeat
  304.     Writeln;
  305.     Write ('Enter: (M) Menu, (Q) Quit, or Test Selection Letter: ');
  306.     Select := ReadKey;
  307.     if Select <> #0 then
  308.       begin
  309.         Select := UpCase(Select);
  310.         Writeln (Select);
  311.       end
  312.     else Select := Readkey;
  313.     Writeln;
  314.     case Select of
  315.     'M' : begin
  316.           ClrScr;
  317.           Writeln('                       Turbo Pascal 4.0 Kybrd Unit Demo');
  318.           Writeln;
  319.           Writeln('  A   Enhkybrd');
  320.           Writeln('  B   ErrorTone');
  321.           Writeln('  C   KeyASCII');
  322.           Writeln('  D   KeyExtd');
  323.           Writeln('  E   KeyFlush');
  324.           Writeln('  F   KeyGet');
  325.           Writeln('  G   KeyView');
  326.           Writeln('  H   KeyWait');
  327.           Writeln('  I   KeyYes');
  328.           Writeln('  J   LockCaps, LockNum, LockScroll, LockStatus');
  329.           end;
  330.     'A' : EnhkybrdTest;
  331.     'B' : ErrorToneTest;
  332.     'C' : KeyASCIITest;
  333.     'D' : KeyExtdTest;
  334.     'E' : KeyFlushTest;
  335.     'F' : KeyGetTest;
  336.     'G' : KeyViewTest;
  337.     'H' : KeyWaitTest;
  338.     'I' : KeyYesTest;
  339.     'J' : LockKeyTest;
  340.     'Q' : ;
  341.     end;
  342.   until Select = 'Q';
  343. end.
  344.