home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
d
/
drcpas10.zip
/
KEYBOARD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-11-17
|
6KB
|
255 lines
{$A+,B-,D-,F-,I+,L-,N-,O-,R-,S+,V-}
unit keyboard;
(* by David R. Conrad, for Turbo Pascal 5.5
This code is not copyrighted, you may use it freely.
There are no guarantees, either expressed or implied,
as to either merchantability or fitness for a particular
purpose. The author's liability is limited to the amount
you paid for it.
David R. Conrad, 17 Nov 92
David_Conrad@mts.cc.wayne.edu
dave@michigan.com
*)
interface
const
(* for testing shift key status *)
RIGHTSHIFT = $01;
LEFTSHIFT = $02;
CTRLKEY = $04;
ALTKEY = $08;
SCROLLLOCK = $10;
NUMLOCK = $20;
CAPSLOCK = $40;
INSTOGGLE = $80;
(* these constants are only for enhanced keyboards *)
LEFTCTRL = $0100;
LEFTALT = $0200;
RIGHTCTRL = $0400;
RIGHTALT = $0800;
SCROLLDOWN = $1000;
NUMDOWN = $2000;
CAPSDOWN = $4000;
SYSRQDOWN = $8000;
(* for setting the delay rate *)
delay250 = 0;
delay500 = 1;
delay750 = 2;
delay1000 = 3;
(* for setting the repeat rate *)
fastkey = $00;
defaultkey = $0C;
slowkey = $1F;
var
scancode, asciival : char;
{$IFDEF SCREENSAVE}
lastkeypress, timeout : longint;
screensaver : procedure;
{$ENDIF}
(* all routines are documented in the implementation section *)
function readkey : char;
function keypressed : boolean;
function shiftkeys : word;
function enhanced : boolean;
procedure typematic (kbddelay, repeatrate : byte);
function pushkey (ch : char) : boolean;
procedure clearkeys;
procedure waitkey;
implementation
uses dos, dostools
{$IFDEF SCREENSAVE}
, timer
{$ENDIF}
;
const
kbdint = $16;
var
second : char;
readfunc, pressfunc, shiftfunc : byte;
function readkey : char;
(* get key press, wait for one if necessary *)
(* returns #0 then scan code for extended keys, just like CRT.readkey *)
(* note: also puts ascii value and scan code in asciival and scancode *)
(* note: if SCREENSAVE is defined, calls keypressed repeatedly to allow
screen saver to get control; see keypressed *)
var
r : registers;
begin
if second <> #0 then
begin
readkey := second;
second := #0;
end
else
begin
{$IFDEF SCREENSAVE}
repeat until keypressed;
{$ENDIF}
initregisters (r);
r.ah := readfunc;
intr (kbdint, r);
if (r.al = $E0) and (r.ah <> 0) then r.al := 0;
readkey := char(r.al);
asciival := char(r.al);
scancode := char(r.ah);
if r.al = 0 then second := char(r.ah);
end;
{$IFDEF SCREENSAVE}
lastkeypress := ClockTix;
{$ENDIF}
end;
function keypressed : boolean;
(* tell whether any keystrokes are waiting; has a key been pressed? *)
(* note: if a key has been pressed, puts ascii value and scan code of
key in asciival and scancode, allowing:
if keypressed and (asciival = #27) then ....
This does not remove the keystroke from the typeahead buffer. *)
(* note: if SCREENSAVE is defined and more that timeout timer ticks
have occured since the lastkeypress, the screen saver is invoked. *)
var
r : registers;
p : procedure;
begin
if second <> #0 then
keypressed := true
else
begin
{$IFDEF SCREENSAVE}
if (@screensaver <> nil) and
(difftix(lastkeypress, ClockTix) > timeout) then
begin
p := screensaver;
@screensaver := nil;
p;
screensaver := p;
lastkeypress := ClockTix;
end;
{$ENDIF}
initregisters (r);
r.ah := pressfunc;
intr (kbdint, r);
if (r.al = $E0) and (r.ah <> 0) then r.al := 0;
if (r.flags AND FZero) = FZero then
keypressed := false
else
begin
keypressed := true;
asciival := char(r.al);
scancode := char(r.ah);
end;
end;
end;
function shiftkeys : word;
(* get shift key state: upper byte only valid with enhanced keyboard *)
var
r : registers;
begin
initregisters (r);
r.ah := shiftfunc;
intr (kbdint, r);
shiftkeys := r.ax;
end;
function enhanced : boolean;
(* tell whether an enhanced keyboard BIOS is present *)
var
r : registers;
a : byte;
begin
initregisters (r);
r.ah := $02;
intr (kbdint, r);
a := NOT r.al;
r.ah := $12;
r.al := a;
intr (kbdint, r);
enhanced := a <> r.al;
end;
procedure typematic (kbddelay, repeatrate : byte);
(* set the typematic delay and repeat rate on an enhanced keyboard *)
var
r : registers;
begin
initregisters (r);
r.ah := $03;
r.al := $05;
if kbddelay > delay1000 then kbddelay := delay250;
if repeatrate > slowkey then repeatrate := fastkey;
r.bh := kbddelay;
r.bl := repeatrate;
intr (kbdint, r);
end;
function pushkey (ch : char) : boolean;
(* push a keystroke back into the typeahead buffer *)
(* note: the contents of the scancode variable are used for the scan code
of the key; if the scan code matters, place it in that variable prior
to calling this routine *)
(* note: will return false if the typeahead buffer is full or if no
enhanced BIOS present *)
var
r : registers;
begin
initregisters (r);
r.ah := $05;
r.al := $01;
r.cl := byte(ch);
r.ch := byte(scancode);
intr (kbdint, r);
pushkey := r.al = 0;
end;
procedure clearkeys;
(* clear the typeahead buffer *)
begin
while keypressed do if readkey = #0 then if readkey = #0 then;
end;
procedure waitkey;
(* wait for a keypress *)
begin
if readkey = #0 then if readkey = #0 then;
end;
(* note: because of the auto-detection of the enhanced ROM BIOS and use
of appropriate function numbers, these routine will work on original
PC's and XT's and also allow full access to all features of enhanced
keyboards, e.g. F11 & F12.
*)
begin
second := #0;
if enhanced then
begin
readfunc := $10;
pressfunc := $11;
shiftfunc := $12;
end
else
begin
readfunc := $00;
pressfunc := $01;
shiftfunc := $02;
end;
{$IFDEF SCREENSAVE}
@screensaver := nil;
timeout := 5460;
lastkeypress := ClockTix;
{$ENDIF}
end.