home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / KYBRD.ZIP / KYBRD.PAS next >
Encoding:
Pascal/Delphi Source File  |  1988-03-06  |  9.7 KB  |  264 lines
  1. {$R-,S-,T-}
  2. { Turbo Pascal 4.0 unit of keyboard routines to process/validate ASCII/extended
  3.   keystrokes, and set/reset/status of shift keys.  Enhanced keyboard (F11, F12)
  4.   support.  }
  5.  
  6. { John Haluska, CIS 74000,1106 }
  7.  
  8. unit kybrd;
  9.  
  10. interface
  11.  
  12. uses Crt,Dos;
  13.  
  14. type
  15.   Validkeys  = set of char;
  16. var
  17.   ErrorToneEnb  :  boolean;   {Enables (true) or disables (false) ErrorTone }
  18.  
  19. function  Enhkybrd : boolean;
  20. procedure ErrorTone;
  21. function  KeyASCII(V : ValidKeys) : char;
  22. function  KeyExtd(V : ValidKeys) : byte;
  23. procedure KeyFlush;
  24. function  KeyGet : integer;
  25. function  KeyView :integer;
  26. procedure KeyWait;
  27. function  KeyYes: boolean;
  28. procedure LockCaps(Sw : boolean);
  29. procedure LockNum(Sw : boolean);
  30. procedure LockScroll(Sw : boolean);
  31. procedure LockStatus(var Caps, Num, Scroll : boolean);
  32.  
  33. implementation
  34.  
  35. var
  36.   Srv0, Srv1  : byte;                         { BIOS keyboard service numbers }
  37.  
  38. {-----------------------------------------------------------------------------}
  39. { Enhkybrd returns true if this computer supports an enhanced keyboard with
  40.   F11, F12 keys using BIOS service calls 10-12h.  Note that some CPUs support
  41.   the enhanced keyboard through the original BIOS service calls 0-2.
  42.   Ref: Enhanced Keyboard, R. L. Hummel, PC Magazine, 9/15/87, p378   }
  43.  
  44. function Enhkybrd : boolean;
  45.  
  46.   var
  47.     Regs : registers;
  48.     Ehk  : boolean;
  49.   begin
  50.     Regs.AH := $12;                     { Call BIOS Service 12h -            }
  51.     Intr($16,Regs);                     {   Get Shift Status, Enhanced Kybrd }
  52.     Ehk := (Regs.AL = Mem[0:$417]);       { Does register = memory location? }
  53.     Mem[0:$417] := Mem[0:$417] xor $80;                 { Toggle Insert mode }
  54.     Regs.AH := $12;                     { Repeat Call BIOS Service 12h -     }
  55.     Intr($16,Regs);                { Repeat Get Shift Status, Enhanced Kybrd }
  56.     Ehk := (Regs.AL = Mem[0:$417]);       { Does register = memory location? }
  57.     Mem[0:$417] := Mem[0:$417] xor $80;                 { Toggle Insert mode }
  58.     Enhkybrd := Ehk;
  59.   end; {Enhkybrd}
  60. {-----------------------------------------------------------------------------}
  61. { ErrorTone generates a 120 Hz tone for .1 second if unit variable
  62.   ErrorToneEnb is true (default).  The caller can set ErrorToneEnb := False
  63.   to disable ErrorTone. }
  64.  
  65. procedure ErrorTone;
  66.           {Reequires unit global variable ErrorToneEnb}
  67.   begin
  68.     if ErrorToneEnb then
  69.       begin
  70.         Sound(120);
  71.         Delay(100);
  72.         NoSound;
  73.       end;
  74.   end; {ErrorTone}
  75. {-----------------------------------------------------------------------------}
  76. { KeyASCII reads and validates a keystroke against a defined set of ASCII
  77.   characters until a valid character is entered.  A chararcter not in the
  78.   defined set is ignored and the tone is sounded.  Example: The expression
  79.   VK := KeyASCII(['a'..'f'])  will return  a,b,c,d,e, or f  if the
  80.   corresponding key is pressed. }
  81.  
  82. function KeyASCII(V : ValidKeys) : char;
  83.           {Unit type ValidKeys  = set of char.  Requires procedure ErrorTone}
  84.   var
  85.     C,Cs  : char;
  86.     OK : boolean;
  87.   begin
  88.     repeat
  89.       OK := False;
  90.       C := ReadKey;
  91.       case C of
  92.         #1..#255 : if C in V then OK := True else ErrorTone;
  93.         #0       : begin
  94.                      ErrorTone;
  95.                      Cs := ReadKey;
  96.                      OK := False
  97.                    end;
  98.       end;
  99.     until OK;
  100.     KeyASCII := C;
  101.   end; {KeyASCII}
  102. {-----------------------------------------------------------------------------}
  103. { KeyExtd returns the extended key code (function keys, cursor keys, alt-keys,
  104.   etc) as a single byte that is in a defined set of characters V. All other
  105.   keystrokes are rejected except Enter which is returned as 0.
  106.   Example: The expression EK := KeyExtd([#73,#81,#0]) will give the associated
  107.   byte value (73,81,0) for PgUp, PgDn, or Enter if the corresponding key is
  108.   pressed. }
  109.  
  110.  function KeyExtd(V : ValidKeys) : byte;
  111.           {Unit type ValidKeys  = set of char.  Requires unit variable Srv0 }
  112.   var
  113.     G    : integer;
  114.     OK   : boolean;
  115.     regs : registers;
  116.   begin
  117.     repeat
  118.       OK := False;
  119.       Regs.AH := Srv0;                      { Call BIOS Service 0 or 10h -  }
  120.       Intr ($16, Regs);                     {   Read Next KyBrd Character   }
  121.       case Regs.AL of
  122.              0 : begin
  123.                    G := Regs.AH;                    { Extended key code }
  124.                    if Chr(G) in V then OK := True else ErrorTone;
  125.                  end;
  126.             13 : begin
  127.                    G := 0;
  128.                    if Chr(G) in V then OK := True else ErrorTone;
  129.                  end;
  130.         else ErrorTone;
  131.       end;
  132.     until OK;
  133.     KeyExtd := G;
  134.   end; {KeyExtd}
  135. {-----------------------------------------------------------------------------}
  136. { KeyFlush reads and discards all pending keystrokes. }
  137.  
  138. procedure KeyFlush;
  139.  
  140.   var
  141.     Ch : char;
  142.   begin
  143.     while KeyPressed do Ch := ReadKey;
  144.   end; {KeyFlush}
  145. {-----------------------------------------------------------------------------}
  146. { KeyGet returns a keyboard entry as an integer corresponding to the ASCII code
  147.   or the extended code + 256 if a non ASCII key.  Example:  If 't' is pressed,
  148.   KeyGet will return 116.  If 'Home' is pressed, KeyGet will return 327. }
  149.  
  150. function KeyGet : integer;
  151.          {Requires unit variable Srv0}
  152.   var
  153.     Regs : registers;
  154.   begin
  155.     Regs.AH := Srv0;                        { Call BIOS Service 0 or 10h -   }
  156.     Intr ($16, Regs);                          {   Read Next KyBrd Character }
  157.     case Regs.AL of
  158.       1..223, 225..255 :  KeyGet := Regs.AL;    {ASCII character code}
  159.       0  : KeyGet := Regs.AH or 256;            {Extended key code + 256}
  160.       224 : if Regs.AH <> 0 then KeyGet := Regs.AH or 256  {cursor keys + 256}
  161.               else KeyGet := Regs.AL;
  162.     end;
  163.   end; {KeyGet}
  164. {-----------------------------------------------------------------------------}
  165. { KeyView waits for keypress and examine an integer in the keyboard buffer
  166.   corresponding to the ASCII code or the extended key code + 256 if a
  167.   non-ASCII key. The keypress is removed from the buffer with the Read, Readln,
  168.   ReadKey, or KeyGet routines. }
  169.  
  170. function KeyView :integer;
  171.          {Requires unit variable Srv1}
  172.   var
  173.     Regs : registers;
  174.   begin
  175.     repeat
  176.       Regs.AH := Srv1;                      { Call BIOS Service 1 or 11h -   }
  177.       Intr($16,Regs);                          {   Report If Keybrd Char Rdy }
  178.     until Regs.Flags and $40 = 0;
  179.     case Regs.AL of
  180.       1..223, 225..255 :  KeyView := Regs.AL;    {ASCII character code}
  181.       0  : KeyView := Regs.AH or 256;            {Extended key code + 256}
  182.       224 : if Regs.AH <> 0 then KeyView := Regs.AH or 256 {cursor keys + 256}
  183.               else KeyView := Regs.AL;
  184.     end;
  185.   end;
  186. {-----------------------------------------------------------------------------}
  187. { KeyWait waits until any key is pressed, then returns.  The key value is
  188.   discarded. }
  189.  
  190. procedure KeyWait;
  191.  
  192.   var
  193.     Ch : char;
  194.   begin
  195.     repeat until KeyPressed;
  196.     while KeyPressed do Ch := Readkey;
  197.   end; {KeyWait}
  198. {-----------------------------------------------------------------------------}
  199. { KeyYes reads a Y, y, N or n keystroke and returns a boolean true for Y or y
  200.   or false for N or n. All other keystrokes are rejected. Example: YK := KeyYes
  201.   returns result "true" if Y is pressed. }
  202.  
  203. function KeyYes: boolean;
  204.          {Requires function KeyASCII }
  205.   const
  206.     YesNo : ValidKeys = ['N','n','Y','y'];
  207.   begin
  208.     KeyYes := UpCase(KeyASCII(YesNo)) = 'Y';
  209.   end {KeyYes};
  210. {-----------------------------------------------------------------------------}
  211. { LockCaps sets or resets the Caps Lock switch.  Example: LockCaps(True) turns
  212.   on the CapsLock switch causing all future alphabetic keys to be entered in
  213.   uppercase. }
  214.  
  215. procedure LockCaps (Sw : boolean);
  216.  
  217.   begin
  218.     if Sw then Mem[0:$417] := Mem[0:$417] or $40        {set Caps Lock}
  219.       else Mem[0:$417] := Mem[0:$417] and $BF;          {clear Caps Lock}
  220.   end; {LockCaps}
  221. {-----------------------------------------------------------------------------}
  222. { LockNum sets or resets the Num Lock switch.  Example: LockNum(True) turns
  223.   on the NumLock switch causing future entries from keypad to be numbers. }
  224.  
  225. procedure LockNum (Sw : boolean);
  226.  
  227.   begin
  228.     if Sw then Mem[0:$417] := Mem[0:$417] or $20        {set Num Lock}
  229.       else Mem[0:$417] := Mem[0:$417] and $DF;          {clear Num Lock}
  230.   end; {LockNum}
  231. {-----------------------------------------------------------------------------}
  232. { LockScroll sets or resets the Scroll Lock switch.  Example: LockScroll(True)
  233.   turns on the ScrollLock switch.  }
  234.  
  235. procedure LockScroll (Sw : boolean);
  236.  
  237.   begin
  238.     if Sw then Mem[0:$417] := Mem[0:$417] or $10        {set Scroll Lock}
  239.       else Mem[0:$417] := Mem[0:$417] and $EF;          {clear Scroll Lock}
  240.   end; {LockScroll}
  241. {-----------------------------------------------------------------------------}
  242. { LockStatus returns the status (true if set, false if clear) of the Caps Lock,
  243.   Num Lock, and Scroll Lock keys.}
  244.  
  245. procedure LockStatus (var Caps, Num, Scroll : boolean);
  246.  
  247.   begin
  248.     Caps := (Mem[0:$417] and $40) = $40;
  249.     Num := (Mem[0:$417] and $20) = $20;
  250.     Scroll := (Mem[0:$417] and $10) = $10;
  251.   end; {LockStatus}
  252. {-----------------------------------------------------------------------------}
  253.  
  254. begin
  255.   Srv0 := 0;
  256.   Srv1 := 1;
  257.   if Enhkybrd then                { True if BIOS calls 10-12h required }
  258.     begin
  259.       Srv0 := $10;      { Change BIOS calls for enhanced keyboard      }
  260.       Srv1 := $11;      {  Read Next Key and KeyBoard Character Ready  }
  261.     end;
  262.   ErrorToneEnb := True;                             { Enable ErrorTone }
  263. end.
  264.