Category : Pascal Source Code
Archive   : KYBRD.ZIP
Filename : KYBRD.PAS

 
Output of file : KYBRD.PAS contained in archive : KYBRD.ZIP
{$R-,S-,T-}
{ Turbo Pascal 4.0 unit of keyboard routines to process/validate ASCII/extended
keystrokes, and set/reset/status of shift keys. Enhanced keyboard (F11, F12)
support. }

{ John Haluska, CIS 74000,1106 }

unit kybrd;

interface

uses Crt,Dos;

type
Validkeys = set of char;
var
ErrorToneEnb : boolean; {Enables (true) or disables (false) ErrorTone }

function Enhkybrd : boolean;
procedure ErrorTone;
function KeyASCII(V : ValidKeys) : char;
function KeyExtd(V : ValidKeys) : byte;
procedure KeyFlush;
function KeyGet : integer;
function KeyView :integer;
procedure KeyWait;
function KeyYes: boolean;
procedure LockCaps(Sw : boolean);
procedure LockNum(Sw : boolean);
procedure LockScroll(Sw : boolean);
procedure LockStatus(var Caps, Num, Scroll : boolean);

implementation

var
Srv0, Srv1 : byte; { BIOS keyboard service numbers }

{-----------------------------------------------------------------------------}
{ Enhkybrd returns true if this computer supports an enhanced keyboard with
F11, F12 keys using BIOS service calls 10-12h. Note that some CPUs support
the enhanced keyboard through the original BIOS service calls 0-2.
Ref: Enhanced Keyboard, R. L. Hummel, PC Magazine, 9/15/87, p378 }

function Enhkybrd : boolean;

var
Regs : registers;
Ehk : boolean;
begin
Regs.AH := $12; { Call BIOS Service 12h - }
Intr($16,Regs); { Get Shift Status, Enhanced Kybrd }
Ehk := (Regs.AL = Mem[0:$417]); { Does register = memory location? }
Mem[0:$417] := Mem[0:$417] xor $80; { Toggle Insert mode }
Regs.AH := $12; { Repeat Call BIOS Service 12h - }
Intr($16,Regs); { Repeat Get Shift Status, Enhanced Kybrd }
Ehk := (Regs.AL = Mem[0:$417]); { Does register = memory location? }
Mem[0:$417] := Mem[0:$417] xor $80; { Toggle Insert mode }
Enhkybrd := Ehk;
end; {Enhkybrd}
{-----------------------------------------------------------------------------}
{ ErrorTone generates a 120 Hz tone for .1 second if unit variable
ErrorToneEnb is true (default). The caller can set ErrorToneEnb := False
to disable ErrorTone. }

procedure ErrorTone;
{Reequires unit global variable ErrorToneEnb}
begin
if ErrorToneEnb then
begin
Sound(120);
Delay(100);
NoSound;
end;
end; {ErrorTone}
{-----------------------------------------------------------------------------}
{ KeyASCII reads and validates a keystroke against a defined set of ASCII
characters until a valid character is entered. A chararcter not in the
defined set is ignored and the tone is sounded. Example: The expression
VK := KeyASCII(['a'..'f']) will return a,b,c,d,e, or f if the
corresponding key is pressed. }

function KeyASCII(V : ValidKeys) : char;
{Unit type ValidKeys = set of char. Requires procedure ErrorTone}
var
C,Cs : char;
OK : boolean;
begin
repeat
OK := False;
C := ReadKey;
case C of
#1..#255 : if C in V then OK := True else ErrorTone;
#0 : begin
ErrorTone;
Cs := ReadKey;
OK := False
end;
end;
until OK;
KeyASCII := C;
end; {KeyASCII}
{-----------------------------------------------------------------------------}
{ KeyExtd returns the extended key code (function keys, cursor keys, alt-keys,
etc) as a single byte that is in a defined set of characters V. All other
keystrokes are rejected except Enter which is returned as 0.
Example: The expression EK := KeyExtd([#73,#81,#0]) will give the associated
byte value (73,81,0) for PgUp, PgDn, or Enter if the corresponding key is
pressed. }

function KeyExtd(V : ValidKeys) : byte;
{Unit type ValidKeys = set of char. Requires unit variable Srv0 }
var
G : integer;
OK : boolean;
regs : registers;
begin
repeat
OK := False;
Regs.AH := Srv0; { Call BIOS Service 0 or 10h - }
Intr ($16, Regs); { Read Next KyBrd Character }
case Regs.AL of
0 : begin
G := Regs.AH; { Extended key code }
if Chr(G) in V then OK := True else ErrorTone;
end;
13 : begin
G := 0;
if Chr(G) in V then OK := True else ErrorTone;
end;
else ErrorTone;
end;
until OK;
KeyExtd := G;
end; {KeyExtd}
{-----------------------------------------------------------------------------}
{ KeyFlush reads and discards all pending keystrokes. }

procedure KeyFlush;

var
Ch : char;
begin
while KeyPressed do Ch := ReadKey;
end; {KeyFlush}
{-----------------------------------------------------------------------------}
{ KeyGet returns a keyboard entry as an integer corresponding to the ASCII code
or the extended code + 256 if a non ASCII key. Example: If 't' is pressed,
KeyGet will return 116. If 'Home' is pressed, KeyGet will return 327. }

function KeyGet : integer;
{Requires unit variable Srv0}
var
Regs : registers;
begin
Regs.AH := Srv0; { Call BIOS Service 0 or 10h - }
Intr ($16, Regs); { Read Next KyBrd Character }
case Regs.AL of
1..223, 225..255 : KeyGet := Regs.AL; {ASCII character code}
0 : KeyGet := Regs.AH or 256; {Extended key code + 256}
224 : if Regs.AH <> 0 then KeyGet := Regs.AH or 256 {cursor keys + 256}
else KeyGet := Regs.AL;
end;
end; {KeyGet}
{-----------------------------------------------------------------------------}
{ KeyView waits for keypress and examine an integer in the keyboard buffer
corresponding to the ASCII code or the extended key code + 256 if a
non-ASCII key. The keypress is removed from the buffer with the Read, Readln,
ReadKey, or KeyGet routines. }

function KeyView :integer;
{Requires unit variable Srv1}
var
Regs : registers;
begin
repeat
Regs.AH := Srv1; { Call BIOS Service 1 or 11h - }
Intr($16,Regs); { Report If Keybrd Char Rdy }
until Regs.Flags and $40 = 0;
case Regs.AL of
1..223, 225..255 : KeyView := Regs.AL; {ASCII character code}
0 : KeyView := Regs.AH or 256; {Extended key code + 256}
224 : if Regs.AH <> 0 then KeyView := Regs.AH or 256 {cursor keys + 256}
else KeyView := Regs.AL;
end;
end;
{-----------------------------------------------------------------------------}
{ KeyWait waits until any key is pressed, then returns. The key value is
discarded. }

procedure KeyWait;

var
Ch : char;
begin
repeat until KeyPressed;
while KeyPressed do Ch := Readkey;
end; {KeyWait}
{-----------------------------------------------------------------------------}
{ KeyYes reads a Y, y, N or n keystroke and returns a boolean true for Y or y
or false for N or n. All other keystrokes are rejected. Example: YK := KeyYes
returns result "true" if Y is pressed. }

function KeyYes: boolean;
{Requires function KeyASCII }
const
YesNo : ValidKeys = ['N','n','Y','y'];
begin
KeyYes := UpCase(KeyASCII(YesNo)) = 'Y';
end {KeyYes};
{-----------------------------------------------------------------------------}
{ LockCaps sets or resets the Caps Lock switch. Example: LockCaps(True) turns
on the CapsLock switch causing all future alphabetic keys to be entered in
uppercase. }

procedure LockCaps (Sw : boolean);

begin
if Sw then Mem[0:$417] := Mem[0:$417] or $40 {set Caps Lock}
else Mem[0:$417] := Mem[0:$417] and $BF; {clear Caps Lock}
end; {LockCaps}
{-----------------------------------------------------------------------------}
{ LockNum sets or resets the Num Lock switch. Example: LockNum(True) turns
on the NumLock switch causing future entries from keypad to be numbers. }

procedure LockNum (Sw : boolean);

begin
if Sw then Mem[0:$417] := Mem[0:$417] or $20 {set Num Lock}
else Mem[0:$417] := Mem[0:$417] and $DF; {clear Num Lock}
end; {LockNum}
{-----------------------------------------------------------------------------}
{ LockScroll sets or resets the Scroll Lock switch. Example: LockScroll(True)
turns on the ScrollLock switch. }

procedure LockScroll (Sw : boolean);

begin
if Sw then Mem[0:$417] := Mem[0:$417] or $10 {set Scroll Lock}
else Mem[0:$417] := Mem[0:$417] and $EF; {clear Scroll Lock}
end; {LockScroll}
{-----------------------------------------------------------------------------}
{ LockStatus returns the status (true if set, false if clear) of the Caps Lock,
Num Lock, and Scroll Lock keys.}

procedure LockStatus (var Caps, Num, Scroll : boolean);

begin
Caps := (Mem[0:$417] and $40) = $40;
Num := (Mem[0:$417] and $20) = $20;
Scroll := (Mem[0:$417] and $10) = $10;
end; {LockStatus}
{-----------------------------------------------------------------------------}

begin
Srv0 := 0;
Srv1 := 1;
if Enhkybrd then { True if BIOS calls 10-12h required }
begin
Srv0 := $10; { Change BIOS calls for enhanced keyboard }
Srv1 := $11; { Read Next Key and KeyBoard Character Ready }
end;
ErrorToneEnb := True; { Enable ErrorTone }
end.


  3 Responses to “Category : Pascal Source Code
Archive   : KYBRD.ZIP
Filename : KYBRD.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/