home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / pascal / PASLIBR.ZIP / KBDDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-15  |  4.4 KB  |  188 lines
  1. {--------------------------------------------------------------------}
  2. {- Before compiling this demo program make sure the Unit Directories-}
  3. {- in the Options, Directories menu specify where to find the       -}
  4. {- FlashPac Units.                                                  -}
  5. {-                                                                  -}
  6. {- Compiler       Directory                                         -}
  7. {- --------       -----------------                                 -}
  8. {-  TP4           A:\TP4                                            -}
  9. {-  TP5           A:\TP5                                            -}
  10. {-  TP55          A:\TP55                                           -}
  11. {-                                                                  -}
  12. {--------------------------------------------------------------------}
  13.  
  14. program testit;
  15. uses Crt,FPKbd,FPVideo;
  16.  
  17. Var
  18.    Done : Boolean;
  19.  
  20. Procedure TestBiosKbdClr;
  21. Var
  22.    Ch : Char;
  23.    i  : Integer;
  24. Begin
  25.    Writeln( 'Press "Q" to quit' );
  26.    Repeat
  27.       Delay(500);
  28.       BiosKbdClr;
  29.       Ch := ReadKey;
  30.       Write(Ch);
  31.    Until Ch = 'Q';
  32. End;
  33.  
  34. Procedure TestBiosKbdGetElmt;
  35. Var
  36.    Ch : Integer;
  37. Begin
  38.    Writeln( 'Press "ESC" to quit' );
  39.    Repeat
  40.       Ch := BiosKbdGetElmt;
  41.       Writeln('Ch = ',Ch:1);
  42.    Until Ch = 1;
  43. End;
  44.  
  45. Procedure TestBiosKbdHit;
  46. Begin
  47.    BiosKbdClr;
  48.    Repeat
  49.       Writeln('Press any key to end test');
  50.    Until BiosKbdHit;
  51.    BiosKbdClr;
  52. End;
  53.  
  54. Procedure TestBiosKbdRead;
  55. Var
  56.    St : Str2;
  57. Begin
  58.    Writeln( 'Press "Q" to quit' );
  59.    Repeat
  60.       BiosKbdRead(St);
  61.       Write('St = ',St,'  St[1] = ',Ord(St[1]):1);
  62.       Writeln('   St[2] = ',Ord(St[2]):1,'  Len = ',Length(St):1);
  63.    Until St = 'Q';
  64. End;
  65.  
  66. Procedure TestBiosKbdStat;
  67. Var
  68.    Ch,Stat,i,
  69.    Remainder : Integer;
  70.    St        : String[8];
  71. Begin
  72.    ClrScr;
  73.    St[0] := Chr(8);
  74.    Writeln( 'Press "ESC" to quit' );
  75.    Repeat
  76.       Gotoxy( 1, 4 );
  77.       Stat := BiosKbdStat;
  78.       For i := 1 To 8 Do
  79.          St[i] := '0';
  80.       i := 8;
  81.       While Stat > 0 Do Begin
  82.          Remainder := Stat Mod 2;
  83.          St[i] := Chr(Remainder+48);
  84.          i := i - 1;
  85.          Stat := Stat Div 2;
  86.       End;
  87.       Writeln('BiosKbdStat = ',St);
  88.       If ( BiosKbdHit ) Then
  89.          Ch := BiosKbdGetElmt;
  90.    Until Ch = 1;
  91. End;
  92.  
  93. Procedure TestDosKbdClr;
  94. Var
  95.    Ch : Char;
  96.    i  : Integer;
  97. Begin
  98.    Writeln( 'Press "Q" to quit' );
  99.    Repeat
  100.       Delay(500);
  101.       DosKbdClr;
  102.       Ch := ReadKey;
  103.       Write(Ch);
  104.    Until Ch = 'Q';
  105.    DosKbdClr;
  106. End;
  107.  
  108. Procedure TestDosKbdGetElmt;
  109. Var
  110.    Ch : Integer;
  111. Begin
  112.    Writeln( 'Press "Q" to quit' );
  113.    Repeat
  114.       Ch := DosKbdGetElmt;
  115.       Writeln('Ch = ',Ch:1);
  116.    Until Ch = 213;
  117. End;
  118.  
  119. Procedure TestDosKbdHit;
  120. Begin
  121.    DosKbdClr;
  122.    Repeat
  123.       Writeln('Press any key to end test');
  124.    Until DosKbdHit;
  125. End;
  126.  
  127. Procedure TestDosKbdRead;
  128. Var
  129.    St : Str2;
  130. Begin
  131.    Writeln( 'Press "Q" to quit' );
  132.    Repeat
  133.       DosKbdRead(St);
  134.       Write('St = ',St,'  St[1] = ',Ord(St[1]):1);
  135.       Writeln('   St[2] = ',Ord(St[2]):1,'  Len = ',Length(St):1);
  136.    Until St = 'Q';
  137. End;
  138.  
  139. Function GetMenuSelection : Integer;
  140. Var
  141.    Item : integer;
  142. Begin
  143.    Item := 0;
  144.    TextAttr := 7;
  145.    Repeat
  146.       ClrWin(1,1,80,25,7);
  147.       Window(1,1,80,25);
  148.       GotoxyAbs(1,1);
  149.       WriteStLn(' ');
  150.       WriteStln(' 1. BiosKbdClr      ');
  151.       WriteStln(' 2. BiosKbdGetElmt  ');
  152.       WriteStln(' 3. BiosKbdHit      ');
  153.       WriteStln(' 4. BiosKbdRead     ');
  154.       WriteStln(' 5. BiosKbdStat     ');
  155.       WriteStln(' 6. DosKbdClr       ');
  156.       WriteStln(' 7. DosKbdGetElmt   ');
  157.       WriteStln(' 8. DosKbdHit       ');
  158.       WriteStln(' 9. DosKbdRead      ');
  159.       WriteStln(' ');
  160.       WriteStln('10. Quit');
  161.       WriteStln(' ');
  162.       WriteSt('Enter selection to test ==> ');
  163.       Readln( Item );
  164.    Until Item In [1..10];
  165.    GetMenuSelection := Item;
  166. End;
  167.  
  168. begin
  169.    DirectVideo := True;
  170.    ClrWin(1,1,80,25,7);
  171.    GotoxyAbs(1,1);
  172.    Done := False;
  173.    While Not Done Do Begin
  174.       Case GetMenuSelection Of
  175.           1 : TestBiosKbdClr;
  176.           2 : TestBiosKbdGetElmt;
  177.           3 : TestBiosKbdHit;
  178.           4 : TestBiosKbdRead;
  179.           5 : TestBiosKbdStat;
  180.           6 : TestDosKbdClr;
  181.           7 : TestDosKbdGetElmt;
  182.           8 : TestDosKbdHit;
  183.           9 : TestDosKbdRead;
  184.          10 : Done := True;
  185.       End;
  186.    End;
  187. End.
  188.