[Back to KEYBOARD SWAG index] [Back to Main SWAG index] [Original]
{========================================================================}
{ }
{ If you find these procedures/functions useful, please help support the }
{ SHAREWARE system by sending a small donation ( up to $5 ) to help with }
{ my college education. Reguardless of a donation, use these routines in }
{ good health (and with a clear concious), I hope you find them useful. }
{ }
{ }
{ Send Any Replies To: EUROPA Software }
{ 314 Pleasant Meadows Dr. }
{ Gaffney, SC 29340 }
{ }
{ Program: KB_v02 Last Revised: 11/21/89 }
{ }
{ Author: J.E. Clary }
{ }
{ Using ALL of these routines increases the .EXE by only 336 bytes. }
{ }
{ Implementation: Turbo Pascal v.4.0 & v.5.0 }
{ }
{ Purpose: }
{ }
{ This UNIT is to provide direct access to the Keyboard status byte. }
{ It is intended to use while running under MS-DOS. The unit will not }
{ function properly, if at all, when running under OS/2. This is because }
{ low-memory access is denied under OS/2 to protect the Operating System.}
{ If you need these functions under OS/2 they are easily accesible by }
{ calling OS Interrupt 9, which returns status bytes 40:17h and 40:18h }
{ 'leagally'. The UNIT is written to carry as little excess baggage as }
{ possible ( only 16 bytes in constants and work variables ) and execute }
{ as fast as possible. This is achieved by directly addressing the key- }
{ board status byte instead of calling the Operating System. }
{ }
{========================= DISCALIMER ===============================}
{ }
{ }
{ These routines are provided AS IS. EUROPA Software, nor any of its }
{ employees shall be held liable for any incidental or consequential }
{ damage attributed to the use, or inability to use this product. }
{ }
{ }
{========================================================================}
unit KB_v02;
INTERFACE
const Right_Shift = 0; { Key_To_Check Constants }
Left_Shift = 1;
Control_Key = 2;
Alt_key = 3;
Scroll_Lock_Key = 4; { Key_To_Set Constants }
Number_Lock_Key = 5;
Caps_Lock_Key = 6;
State_Off = 0; { Action Constants }
State_On = 1;
State_Toggle = 2;
function Is_Key_Pressed( Key_To_Check : byte ) : boolean;
procedure Set_Keyboard_State( Key_To_Set, Action : byte );
procedure Save_Keyboard_Status;
procedure Restore_Keyboard_Status;
procedure Clear_Type_Ahead_Buffer;
IMPLEMENTATION
var Hold_Keyboard_Status, Or_Mask, And_Mask : byte;
kb_stat : byte absolute $0:$417; { Keyboard Status Byte }
tail_buf : byte absolute $0:$41C; { Tail of Circular KB Buffer }
head_buf : byte absolute $0:$41A; { Head of Circular KB Buffer }
procedure Clear_Type_Ahead_Buffer;
begin
tail_buf := head_buf;
end;
procedure Save_Keyboard_Status;
begin
Hold_Keyboard_Status := kb_stat;
end;
procedure Restore_Keyboard_Status;
begin
kb_stat := Hold_Keyboard_Status;
end;
function Is_Key_Pressed( Key_To_Check : byte ) : boolean;
begin
Or_Mask := (1 SHL Key_To_Check);
Is_Key_Pressed := ((kb_stat AND Or_Mask) = Or_Mask);
end;
procedure Set_Keyboard_State( Key_to_Set, Action : byte );
begin
Or_Mask := 1 SHL Key_To_Set;
And_Mask := (NOT Or_Mask);
case Action of
0: kb_stat := kb_stat AND And_Mask; { Off }
1: kb_stat := kb_stat OR Or_Mask; { On }
2: if ( kb_stat AND Or_Mask) = Or_Mask then { Toggle }
kb_stat := (kb_stat AND And_Mask)
else kb_stat := (kb_stat OR Or_Mask);
end;
end;
begin { UNIT Initialization Code }
Hold_Keyboard_Status := 0;
end.
{ -------------------------- DEMO ----------------------------}
program test_KB;
{ Demonstates the use of the KB_v02 Unit. }
uses crt, KB_v02;
const on = 'Key is Pressed ';
off = 'Key isn''t Pressed';
EveryMsg = 'Any Key to Force ';
MidMsg = ' Lock Key to ';
lock_keys : array[1..3] of byte =
( Number_Lock_Key, Caps_Lock_Key, Scroll_Lock_Key );
key_states : array[1..3] of byte =
( State_On, State_Off, State_Toggle );
key_names : array[1..3] of string = ('Number','Caps','Scroll');
state_names : array[1..3] of string = ('On','Off','Toggle');
var i,j : byte;
procedure BurnKey;
var ch : char;
begin
ch := readkey;
if ch = #0 then ch := readkey;
end;
procedure writeAT( x,y : byte; st : string );
begin
gotoxy( x,y );
write( st );
end;
begin
clrscr;
writeln( 'DEMO of Is_Keypressed Function' );
writeln;
writeln( ' Any Normal Key to continue ' );
writeAT( 10, 10, 'Alt Key Status' );
writeAT( 10, 12, 'CTRL Key Status' );
writeAT( 10, 14, 'Left Shift Status' );
writeAT( 10, 16, 'Right Shift Status' );
repeat
if Is_Key_Pressed( Alt_Key ) then writeAT( 30,10, on )
else writeAT( 30,10, off );
if Is_Key_Pressed( Control_Key ) then writeAT( 30,12, on )
else writeAT( 30,12, off );
if Is_Key_Pressed( Left_Shift ) then writeAT( 30,14, on )
else writeAT( 30,14, off );
if Is_Key_Pressed( Right_Shift ) then writeAT( 30,16, on )
else writeAT( 30,16, off );
delay(100);
until keypressed;
clrscr;
burnkey;
writeln('Keyboard Status Saved' );
writeln;
Save_Keyboard_Status;
for i := 1 to 3 do begin
for j := 1 to 3 do begin
writeln( EveryMsg, key_names[i], MidMsg, state_names[j] );
burnkey;
Set_Keyboard_State( Lock_Keys[i], key_States[j] );
end;
writeln;
end;
writeln;
writeln( 'End of Demo.' );
writeln( 'Any Key to Restore Original Lock Status and Exit.' );
BurnKey;
Restore_Keyboard_Status;
end.
[Back to KEYBOARD SWAG index] [Back to Main SWAG index] [Original]