fsbrn@BRL.ARPA (VLD/LTTB) (11/10/87)
Haah,
I haven't seen the original question about reading function and cursor
keys in Turbo Pascal, but I have seen a couple of answers. The
answers given were the ones you will find in many books, both on DOS
and TP, and work fine. However, when I first needed to read cursor
keys I wrote my own function which uses the "correct" (non-TP-specific)
approach. I'm enclosing both my include (KEYSCAN.INC) file and an
extract from a program that uses it.
Basically, there are several global numeric constants (F1Key, HomeKey,
etc) and an enumerated type (KeyClassType) with 2 values (ascii_key
and function_key). When the procedure KeyScan() is called it returns
the character that was read and the class it belongs to. Your program
must then check the class and the character itself as the example
does. Notice that when the KeyClass is function_key you must compare
ord(Ch) with the various key codes; Ch is a char but the codes are
numeric.
Be aware that the example won't run because I ripped out a lot of code
to highlight the keyscan portion, but the file KEYSCAN.INC is complete.
dsw, fferd
Fred S. Brundick
USABRL, APG, MD.
<fsbrn@brl.arpa>
----------------------------------------------------------------------
KEYSCAN.INC
{
This file contains declarations for keyboard scanning.
The following subprogram is defined:
1. procedure GetScanCode (var Ch : char;
var KeyClass : KeyClassType);
This function gets a char and determines its class.
Written by : Ferd Brundick
Date written: 1 Jan 87
}
const
{ these keys are all of class function_key }
{ "real" function keys }
F1Key = $3B;
F2Key = $3C;
F3Key = $3D;
F4Key = $3E;
F5Key = $3F;
F6Key = $40;
F7Key = $41;
F8Key = $42;
F9Key = $43;
F10Key = $44;
{ numeric keypad "function" keys }
HomeKey = $47;
UpKey = $48;
PgUpKey = $49;
LeftKey = $4B;
FiveKey = $4C;
RightKey = $4D;
EndKey = $4F;
DownKey = $50;
PgDnKey = $51;
InsKey = $52;
DelKey = $53;
type
Register = record
case integer of
1 : (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : integer);
2 : (AL, AH, BL, BH, CL, CH, DL, DH : byte)
end; { record }
KeyClassType = (ascii_key, function_key);
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
procedure GetScanCode (var Ch : char;
var KeyClass : KeyClassType);
{
This function gets a char and determines its class.
}
var
Reg : register;
begin { procedure GetScanCode }
Reg.AH := 0;
Intr($16, Reg); { wait until key is pressed }
Ch := Char(Reg.AL); { AL holds low byte of scan code }
if Byte(Ch) = 0 then begin { was a function key pressed? }
KeyClass := function_key;
Ch := Char(Reg.AH) { AH holds high byte of scan code }
end
else { assume ASCII }
KeyClass := ascii_key
end; { procedure GetScanCode }
{ - - - - - - - - - - - - - End of File - - - - - - - - - - - - }
----------------------------------------------------------------------
FRAGMENT.PAS
{$I \TURBO\SOURCE\INCLUDE\KEYSCAN.INC }
function _DoMenu (Menu : MenuRec;
IsSubMenu : boolean) : char;
{
Display and process a menu, then return the
Result code of the item the user chose.
A null string is returned if user the aborts
by hitting the ESCape key.
}
var
Ch : char;
Selection : char;
KeyClass : KeyClassType;
begin { procedure _DoMenu }
repeat { until user makes a selection or exits }
SetCursorMode(CursorOff);
TextBackground(Color.Select.Background);
TextColor(Color.Select.Foreground);
GotoXY(XPos, YPos);
write(ItemStr[Index]);
GetScanCode(Ch, KeyClass);
if KeyClass = ascii_key then begin
if Ch = CR then begin
Selection := Result[Index];
Done := TRUE
end
else if Ch = ESC then begin
Selection := MenuAbortChar;
Done := TRUE
end
else write(^G)
end
else if KeyClass = function_key then
if ord(Ch) = UpKey then
Index := Index - 1
else if ord(Ch) = DownKey then
Index := Index + 1
else if ord(Ch) = RightKey then
if SubMenu[Index] = nil then
write(^G)
else begin
ChildMenu := SubMenu[Index]^;
ChildMenu.XCoord := XCoord + Width + 3;
ChildMenu.YCoord := YPos - 1;
Selection := _DoMenu(ChildMenu, TRUE);
Done := Selection <> MenuAbortChar
end { right }
else
write(^G)
until Done
end; { function _DoMenu }
----------------------------------------------------------------------