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

 
Output of file : KYBRDEM.PAS contained in archive : KYBRD.ZIP
program Kybrdem; {Demo for Turbo Pascal 4.0 Kybrd unit}

{John Haluska, CIS 74000,1106}

uses Crt,Kybrd;

var
Select : char;

procedure KeyCodes(N : integer; var Kc : string);
{return keyname Kc for extended key code input N}
const
Ks : array[1..25] of string[5] =
('a-','c-','s-','F1','F2','F3','F4','F5','F6','F7','F8','F9','F10',
'F11','F12','Home','Up','PgUp','Left','Right','End','Down',
'PgDn','Ins','Del');
begin
case N of
3 : Kc:=Ks[2]+'2'; {c-2} 15 : Kc:=Ks[3]+'Tab'; {s-Tab}
16 : Kc:=Ks[1]+'Q'; {a-Q} 17 : Kc:=Ks[1]+'W'; {a-W}
18 : Kc:=Ks[1]+'E'; {a-E} 19 : Kc:=KS[1]+'R'; {a-R}
20 : Kc:=Ks[1]+'T'; {a-T} 21 : Kc:=Ks[1]+'Y'; {a-Y}
22 : Kc:=Ks[1]+'U'; {a-U} 23 : Kc:=Ks[1]+'I'; {a-I}
24 : Kc:=Ks[1]+'O'; {a-O} 25 : Kc:=Ks[1]+'P'; {a-P}
30 : Kc:=Ks[1]+'A'; {a-A} 31 : Kc:=Ks[1]+'S'; {a-S}
32 : Kc:=Ks[1]+'D'; {a-D} 33 : Kc:=Ks[1]+'F'; {a-F}
34 : Kc:=Ks[1]+'G'; {a-G} 35 : Kc:=Ks[1]+'H'; {a-H}
36 : Kc:=Ks[1]+'J'; {a-J} 37 : Kc:=Ks[1]+'K'; {a-K}
38 : Kc:=Ks[1]+'L'; {a-L} 44 : Kc:=Ks[1]+'Z'; {a-Z}
45 : Kc:=Ks[1]+'X'; {a-X} 46 : Kc:=Ks[1]+'C'; {a-C}
47 : Kc:=Ks[1]+'V'; {a-U} 48 : Kc:=Ks[1]+'B'; {a-B}
49 : Kc:=Ks[1]+'N'; {a-N} 50 : Kc:=Ks[1]+'M'; {a-M}
59..68 : Kc:=Ks[N-55]; {F1 to F10}
71..73 : Kc:=Ks[N-55]; {Home,Up,PgUp}
75 : Kc:= Ks[19]; {Left} 77 : Kc:=Ks[20]; {Right}
79..83 : Kc:=Ks[N-58]; {End,Down,PgDn,Ins,Del}
84..93 : Kc:=Ks[3]+Ks[N-80]; {s-F1 to s-F10}
94..103 : Kc:=Ks[2]+Ks[N-90]; {c-F1 to c-F10}
104..113 : Kc:=Ks[1]+Ks[N-100]; {a-F1 to a-F10}
114 : Kc:=Ks[2]+'PrtSc';{c-PrtSc} 115 : Kc:=Ks[2]+Ks[19]; {c-Left}
116 : Kc:=Ks[2]+Ks[20]; {c-Right} 117 : Kc:=Ks[2]+Ks[21]; {c-End}
118 : Kc:=Ks[2]+Ks[23]; {c-PgDn} 119 : Kc:=Ks[2]+Ks[16]; {c-Home}
120 : Kc:=Ks[1]+'1'; {a-1} 121 : Kc:=Ks[1]+'2'; {a-2}
122 : Kc:=Ks[1]+'3'; {a-3} 123 : Kc:=Ks[1]+'4'; {a-4}
124 : Kc:=Ks[1]+'5'; {a-5} 125 : Kc:=Ks[1]+'6'; {a-6}
126 : Kc:=Ks[1]+'7'; {a-7} 127 : Kc:=Ks[1]+'8'; {a-8}
128 : Kc:=Ks[1]+'9'; {a-9} 129 : Kc:=Ks[1]+'0'; {a-0}
130 : Kc:=Ks[1]+' -'; {a- -} 131 : Kc:=Ks[1]+' ='; {a-=}
132 : Kc:=Ks[2]+Ks[18]; {c-PgUp}

{ enhanced keyboard extended keycodes }

1 : Kc:=Ks[1]+'Esc'; {a-Esc} 14 : Kc:=Ks[1]+'Bksp'; {a-Bksp}
26 : Kc:=Ks[1]+'['; {a-[} 27 : Kc:=Ks[1]+']'; {a-]}
28 : Kc:=Ks[1]+'Entr';{a-Entr} 39 : Kc:=Ks[1]+';'; {a-;}
40 : Kc:=Ks[1]+'"'; {a-"} 41 : Kc:=Ks[1]+'`'; {a-`}
43 : Kc:=Ks[1]+'\'; {a-\} 51 : Kc:=Ks[1]+','; {a-,}
52 : Kc:=Ks[1]+'.'; {a-.} 53 : Kc:=Ks[1]+'/'; {a-/}
55 : Kc:=Ks[1]+'* Kypd';{a-* } 74 : Kc:=Ks[1]+' - Kypd';{a- - Kypd}
76 : Kc:='5 Kypd'; {5 Kypd} 78 : Kc:=Ks[1]+'+'; {a-+}
133..134 : Kc:=Ks[N-119]; {F11,F12}
135..136 : Kc:=Ks[3]+Ks[N-121]; {s-F11,s-F12}
137..138 : Kc:=Ks[2]+Ks[N-123]; {c-F11,c-F12}
139..140 : Kc:=Ks[1]+Ks[N-125]; {a-F11,a-F12}
141 : Kc:=Ks[2]+Ks[17]; {c-Up} 142 : Kc:=Ks[2]+' - Kypd'; {c- - Kypd}
143 : Kc:=Ks[2]+'5 Kypd'; {c-5} 144 : Kc:=Ks[2]+' +'; {c- +}
145 : Kc:=Ks[2]+Ks[22]; {c-Down} 146 : Kc:=Ks[2]+Ks[24]; {c-Ins}
147 : Kc:=Ks[2]+Ks[25]; {c-Del} 148 : Kc:=Ks[2]+'Tab'; {c-Tab}
149 : Kc:=Ks[2]+' / Kypd'; {c- /} 150 : Kc:=Ks[2]+' * Kypd';{c- *}
151..153 : Kc:=Ks[1]+Ks[N-135]+' Curpd'; {a-Home,a-Up,a-PgUp Curpd}
155 : Kc:=Ks[1]+Ks[19]+' Curpd'; {a-Left Curpd}
157 : Kc:=Ks[1]+Ks[20]+' Curpd'; {a-Right Curpd}
159..163 : Kc:=Ks[1]+Ks[N-138]+' Curpd'; {End,Down,PgDn,Ins,Del Curpd}
164 : Kc:=Ks[1]+'/ Kypd';{a-/ Kypd}165 : Kc:=Ks[1]+'Tab'; {a- Tab}
166 : Kc:=Ks[1]+'Enter Kypd'; {a-Enter Kypd}
end;
end; {KeyCodes}

procedure EnhkybrdTest;
var
B : boolean;
begin
Writeln('A: function Enhkybrd : boolean;');
Writeln;
B := Enhkybrd;
if B = True then
begin
Write('Enhkybrd = True. This CPU has enhanced keyboard ');
Writeln('with F11, F12 keys ');
Writeln('supported by BIOS services 10-12h.');
end
else
begin
Write('Enhkybrd = False. This CPU may or may not have the ');
Writeln('enhanced keyboard.');
Write('If the enhanced keyboard is present, it is supported by BIOS ');
Writeln('services 0-2.');
end;
end;

procedure ErrorToneTest;
var
Ch : char;
X,Y : byte;
begin
Writeln;
Writeln('B: procedure ErrorTone;');
Writeln(' Enter character: 1 : Generate ErrorTone (if enabled)');
Writeln(' 2 : Enable ErrorTone');
Writeln(' 3 : Disable ErrorTone');
Writeln(' ESC : Exit this test');
Writeln;
X := WhereX; Y := WhereY;
repeat
Ch := ReadKey;
GotoXY(X,Y);
case Ch of
'1' : begin
Write('1: Generate ErrorTone (if enabled) ');
ErrorTone;
end;
'2' : begin
Write('2: Enable ErrorTone ');
ErrorToneEnb := True;
end;
'3' : begin
Write('3: Disable ErrorTone ');
ErrorToneEnb := False;
end;
#27 : ; {Esc}
#0 : begin {Extended key}
Write('Invalid key ');
Ch := ReadKey;
end;
else Write('Invalid key ');
end;
until Ch = #27; {Esc}
Writeln;
end;

procedure KeyASCIITest;
var
Key : char;
begin
Writeln('C: Key := KeyASCII([''0''..''9'',#13])');
Write('Enter any character, only 0 - 9, CR accepted,');
Writeln(' CR will end test: ');
repeat
Key := KeyASCII(['0'..'9',#13]);
Write (Key:4);
until Key = #13;
Writeln;
end;

procedure KeyExtdTest;
var
KE : byte;
begin
Writeln('D: KE := KeyExtd([#0,#73,#81]);');
Write('Enter any character, only PgUp, PgDn, CR accepted. ');
Writeln(' CR will end test.');
repeat
KE := KeyExtd([#0,#73,#81]);
Write (KE:4);
until KE = 0;
Writeln;
end;

procedure KeyFlushTest;
var
B : byte;
begin
Writeln('E: procedure KeyFlush;');
Writeln('Enter any character. All characters discarded.');
Writeln('After 5 entries, this menu item will be exited.');
B := 0;
repeat
if KeyPressed then
begin
KeyFlush;
Inc(B)
end;
until B = 5;
Writeln;
end;

procedure KeyGetTest;
{Requires procedure KeyCodes}
var
N : integer;
S : string;
begin
Writeln('F: function KeyGet: integer;');
Writeln(' Return ASCII code or scan code + 256 if non-ASCII key.');
Writeln(' Enter any key. ESC terminates this menu item.',#13,#10);
repeat
N := KeyGet;
DelLine;
Write(' KeyGet Return: ',N:4);
case N of
0..9,11..12,14..255 :
Write(' ASCII Char: ',Chr(N),#13);
10 : Write(' ASCII Char: LF',#13);
13 : Write(' ASCII Char: CR',#13);
256..511 :
begin
Write(' Extended Key Code: ',(N-256):3);
{$V-}KeyCodes(N-256,S);{$V+}
Write(' ',S,#13);
end;
end;
until N = 27;
Writeln;
end;

procedure KeyViewTest;
{Requires procedure KeyCodes}
var
N : integer;
S : string;
begin
Writeln('G: function KeyView : integer;');
Write(' Examine in buffer ASCII code or scan code + 256 if ');
Writeln('non-ASCII key.');
Writeln(' Enter any key. ESC terminates this menu item.',#13,#10);
repeat
N := KeyView;

DelLine;
Write(' KeyView Return: ',N:4);
case N of
0..9,11..12,14..255 :
Write(' ASCII Char: ',Chr(N),' Flush Kybrd Buffer',#13);
10 : Write(' ASCII Char: LF Flush Kybrd Buffer',#13);
13 : Write(' ASCII Char: CR Flush Kybrd Buffer',#13);
256..511 :
begin
Write(' Extended Key Code: ',(N-256):3);
{$V-}KeyCodes(N-256,S);{$V+}
Write(' ',S,' Flush Kybrd Buffer',#13);
end;
end;
KeyFlush; {Remove keypress from buffer}
until N = 27;
Writeln;
end;

procedure KeyWaitTest;
var
B : byte;
begin
Writeln('H: procedure KeyWait;');
Writeln('Enter any character. All characters discarded.');
Writeln('After 5 entries, this menu item will be exited.');
B := 0;
repeat
KeyWait;
B := B + 1;
until B = 5;
Writeln;
end;

procedure KeyYesTest;
var
Cb : boolean;
begin
Writeln('I: function KeyYes : boolean;');
Writeln('Enter any character. Only "y","Y", "n", or "N" accepted.');
Cb := KeyYes;
if Cb = True then Writeln('KeyYes = True.')
else Writeln('KeyYes = False');
Writeln;
end;

procedure LockKeyTest;
var
Key : char;
Cb,Nb,Sb : boolean;
begin
Writeln('J: LockCaps, LockNum, LockScroll, LockStatus');
Writeln(' Enter number: 1 - LockCaps Off 2 - LockCaps On');
Writeln(' 3 - LockNum Off 4 - LockNum On');
Write(' 5 - LockScroll Off 6 - LockScroll On : ');
Key := ReadKey;
Case Key of
'1' : LockCaps(False);
'2' : LockCaps(True);
'3' : LockNum(False);
'4' : LockNum(True);
'5' : LockScroll(False);
'6' : LockScroll(True);
end;
Writeln;
LockStatus(Cb,Nb,Sb);
Write(#10,#13,' LockStatus: ');
if Cb then Write('Caps On, ') else Write('Caps Off, ');
if Nb then Write('Num On, ') else Write('Num Off, ');
if Sb then Writeln('Scroll On ') else Writeln('Scroll Off');
Writeln;
end;

begin
ClrScr;
repeat
Writeln;
Write ('Enter: (M) Menu, (Q) Quit, or Test Selection Letter: ');
Select := ReadKey;
if Select <> #0 then
begin
Select := UpCase(Select);
Writeln (Select);
end
else Select := Readkey;
Writeln;
case Select of
'M' : begin
ClrScr;
Writeln(' Turbo Pascal 4.0 Kybrd Unit Demo');
Writeln;
Writeln(' A Enhkybrd');
Writeln(' B ErrorTone');
Writeln(' C KeyASCII');
Writeln(' D KeyExtd');
Writeln(' E KeyFlush');
Writeln(' F KeyGet');
Writeln(' G KeyView');
Writeln(' H KeyWait');
Writeln(' I KeyYes');
Writeln(' J LockCaps, LockNum, LockScroll, LockStatus');
end;
'A' : EnhkybrdTest;
'B' : ErrorToneTest;
'C' : KeyASCIITest;
'D' : KeyExtdTest;
'E' : KeyFlushTest;
'F' : KeyGetTest;
'G' : KeyViewTest;
'H' : KeyWaitTest;
'I' : KeyYesTest;
'J' : LockKeyTest;
'Q' : ;
end;
until Select = 'Q';
end.


  3 Responses to “Category : Pascal Source Code
Archive   : KYBRD.ZIP
Filename : KYBRDEM.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/