Contributor: SWAG SUPPORT GROUP
(********************************************************)
(******************** PICK.PAS **************************)
(******* the pick unit; to select menu choice *******)
Unit Pick;
interface
{1} Function ScreenChar : Char; {return the char at the cursor}
{2} Procedure BlockCursor; {give us a block cursor; TP6 & 7 only}
{3} Procedure NormalCursor; {restore cursor to normal; TP6 & 7 only}
{4} Function PickByte(Left, Top, Bottom : Byte) : Byte;
{return the number of the item chosen as a byte, or
return ZERO if ESCape is pressed}
{5} Function PickChar(Left, Top, Bottom : Byte) : Char;
{return the character at the cursor when ENTER is pressed}
{
Notes: for "Pick" functions
One returns a Byte and the other returns a Char - use one
or the other;
Parameters:
Left = the left side of the menu list (left side of window+1)
Top = the top of the menu list (top of window+1)
Bottom = the bottom of the menu list; (bottom of window-1)
}
implementation
uses
dos,
crt,
keyb;
{-----------------------------------------------------}
Function PickByte(Left,Top,Bottom : byte) : Byte;
{return the number of the item chosen as a byte, or
return ZERO if ESCape is pressed}
Var
x,y,x1,y1 : byte;
ch : char;
int,total : byte;
begin
PickByte := 0; {default to ZERO}
total := (Bottom - Top)+1; {total number of items in list}
x1 := WhereX; y1 := WhereY; {save the original location}
x := Left; y := Top;
BlockCursor; {give us a block cursor}
GotoXy(x, y);
int := 1;
Repeat
Ch := GetKey;
Case Ch of
LeftArrow, UpArrow : {move up}
begin
If y = Top then
begin
y := Bottom;
int := total;
end
else
begin
Dec(y);
dec(int);
end;
GotoXy(x,y);
end; {leftarrow}
RightArrow, DownArrow : {move down}
begin
If y = Bottom then
begin
y := Top;
int := 1;
end
else
begin
Inc(y);
inc(int);
end;
GotoXy(x,y);
end; {rightarrow}
PgUp, Home : {go to top of list}
begin
y := Top;
int := 1;
GotoXy(x,y);
end;
PgDn, EndKey : {go to bottom of list}
begin
y := Bottom;
int := total;
GotoXy(x,y);
end;
#13 : PickByte := int; {return position of choice in the array}
End; {Case Ch}
Until (ch = #27) or (ch = #13); {loop until ESCape or ENTER}
GotoXY(x1,y1); {return to original location}
NormalCursor; {Restore the cursor}
end;
{---------------------------------------------}
Function PickChar(Left, Top,Bottom : byte) : Char;
{return the character at the cursor when ENTER is pressed}
Var
x,y,x1,y1 : byte;
ch : char;
begin
PickChar := #27;
x1 := WhereX; y1 := WhereY;
x := Left; y := Top;
BlockCursor; {give us a block cursor}
GotoXy(x,y);
Repeat
Ch := GetKey;
Case Ch of
LeftArrow, UpArrow :
begin
If y = Top then y := Bottom else Dec(y);
GotoXy(x,y);
end; {leftarrow}
RightArrow, DownArrow :
begin
If y = Bottom then y := Top else Inc(y);
GotoXy(x,y);
end; {leftarrow}
PgUp, Home :
begin
y := Top;
GotoXy(x,y);
end;
PgDn, EndKey :
begin
y := Bottom;
GotoXy(x,y);
end;
#13 : PickChar := ScreenChar; {return the char under the cursor}
End; {Case Ch}
Until (ch = #27) or (ch = #13);
GotoXY(x1,y1);
NormalCursor; {give us a block cursor}
end;
{-----------------------------------------------}
{----------------------------------------}
Function ScreenChar : Char; {return the character at the cursor}
Var
R : Registers;
begin
Fillchar(R, SizeOf(R), 0);
R.AH := 8;
R.BH := 0;
Intr(10,ドル R);
ScreenChar := Chr(R.AL);
end;
{--------------------------------------------------}
{---------------------------------}
Procedure NormalCursor; {restore cursor to normal; TP6 & 7 only}
BEGIN
asm
mov ah,1
mov ch,5 { / You will want to fool around with these two}
mov cl,6 { \ numbers to get the cursor you want}
int 10ドル
END;
END;
{--------------------------------}
Procedure BlockCursor; {give us a block cursor; TP6 & 7 only}
BEGIN
asm
mov ah,1
mov ch,5 { / You will want to fool around with these two}
mov cl,8 { \ numbers to get the cursor you want; (1=big)}
int 10ドル
END;
END;
{-------------------------------------}
End.
{----------------- end of PICK.PAS --------------------}
(********************************************************)
(******************** KEYB.PAS **************************)
(******* the keyboard unit; for GetKey() function *******)
Unit Keyb;
Interface
Uses Crt;
Const
F1 = #187;
F2 = #188;
F3 = #189;
F4 = #190;
F5 = #191;
F6 = #192;
F7 = #193;
F8 = #194;
F9 = #195;
F10 = #196;
ALTF1 = #232;
ALTF2 = #233;
ALTF3 = #234;
ALTF4 = #235;
ALTF5 = #236;
ALTF6 = #237;
ALTF7 = #238;
ALTF8 = #239;
ALTF9 = #240;
ALTF10 = #241;
CTRLF1 = #222;
CTRLF2 = #223;
CTRLF3 = #224;
CTRLF4 = #225;
CTRLF5 = #226;
CTRLF6 = #227;
CTRLF7 = #228;
CTRLF8 = #229;
CTRLF9 = #230;
CTRLF10 = #231;
SHFTF1 = #212;
SHFTF2 = #213;
SHFTF3 = #214;
SHFTF4 = #215;
SHFTF5 = #216;
SHFTF6 = #217;
SHFTF7 = #218;
SHFTF8 = #219;
SHFTF9 = #220;
SHFTF10 = #221;
UPARROW = #200;
RIGHTARROW = #205;
LEFTARROW = #203;
DOWNARROW = #208;
HOME = #199;
PGUP = #201;
ENDKEY = #207;
PGDN = #209;
INS = #210;
DEL = #211;
TAB = #9;
ESC = #27;
ENTER = #13;
SYSREQ = #183;
CTRLMINUS = #31;
SPACE = #32;
CTRL2 = #129;
CTRL6 = #30;
BACKSPACE = #8;
BS = #8; {2 NAMES FOR BACKSPACE}
CTRLBACKSLASH = #28;
CTRLLEFTBRACKET = #27;
CTRLRIGHTBRACKET = #29;
CTRLBACKSPACE = #127;
CTRLBS = #127;
ALTA = #158;
ALTB = #176;
ALTC = #174;
ALTD = #160;
ALTE = #146;
ALTF = #161;
ALTG = #162;
ALTH = #163;
ALTI = #151;
ALTJ = #164;
ALTK = #165;
ALTL = #166;
ALTM = #178;
ALTN = #177;
ALTO = #152;
ALTP = #153;
ALTQ = #144;
ALTR = #147;
ALTS = #159;
ALTT = #148;
ALTU = #150;
ALTV = #175;
ALTW = #145;
ALTX = #173;
ALTY = #149;
ALTZ = #172;
CTRLA = #1;
CTRLB = #2;
CTRLC = #3;
CTRLD = #4;
CTRLE = #5;
CTRLF = #6;
CTRLG = #7;
CTRLH = #8;
CTRLI = #9;
CTRLJ = #10;
CTRLK = #11;
CTRLL = #12;
CTRLM = #13;
CTRLN = #14;
CTRLO = #15;
CTRLP = #16;
CTRLQ = #17;
CTRLR = #18;
CTRLS = #19;
CTRLT = #20;
CTRLU = #21;
CTRLV = #22;
CTRLW = #23;
CTRLX = #24;
CTRLY = #25;
CTRLZ = #26;
ALT1 = #248;
ALT2 = #249;
ALT3 = #250;
ALT4 = #251;
ALT5 = #252;
ALT6 = #253;
ALT7 = #254;
ALT8 = #255;
ALT9 = #167;
ALT0 = #168;
ALTMINUS = #169;
ALTEQ = #170;
SHIFTTAB = #143;
Function GetKey : Char;
procedure unGetKey(C : char);
procedure FlushKbd;
procedure flushBuffer;
const
hasPushedChar : boolean = false;
implementation
var
pushedChar : char;
(******************************************************************************
* FlushKbd *
******************************************************************************)
procedure FlushKbd;
var
C : char;
begin
hasPushedChar := False;
while (KeyPressed) do
C := GetKey;
end; {flushKbd}
(******************************************************************************
* flushBuffer *
* Same as above, but if key was pushed by eventMgr, know about it !! *
******************************************************************************)
procedure flushBuffer;
var
b : boolean;
begin
b := hasPushedChar;
flushKbd;
hasPushedChar := b;
end; {flushBuffer}
(******************************************************************************
* unGetKey *
* UnGetKey will put one character back in the input buffer. Push-back buffer *
* can contain only one character. *
* To avoid problems DO NOT CALL UNGETKEY WITHOUT FIRST CALLING GETKEY. If two *
* characters are pushed, the first is discarded. *
******************************************************************************)
procedure unGetKey;
begin
hasPushedChar := True;
pushedChar := c;
end; {unGetKey}
(******************************************************************************
* GetKey *
******************************************************************************)
function GetKey : Char;
var
c : Char;
Begin
if (hasPushedChar) then begin
GetKey := pushedChar;
hasPushedChar := False;
exit;
end;
c := ReadKey;
if (Ord(c) = 0) then Begin
c := ReadKey;
if c in [#128,#129,#130,#131]
then c := chr(ord(c) + 39)
else c := chr(ord(c) + 128); {map to suit keyboard constants}
End;
GetKey := c; {return keyboard (my..) code }
End; {getKey}
End.
{--------------- End of KEYB.PAS ---------------}
(********************************************************)
(************************** TEST.PAS ********************)
(*************** to test the PICK unit ******************)
(*************** quit by pressing ESCape ****************)
Program Test;
uses crt,pick;
{--------------- test program -----------------}
const
max = 6;
s : array[1..max] of string[18] =
(
'1. Number One ',
'2. Number Two ',
'3. Number Three ',
'4. Number Four ',
'5. Number Five ',
'6. Number Six ');
var
i : byte;
x : byte;
ch : char;
j : byte;
begin
clrscr;
x := 10; {left side of the list}
{------------------------- test using PickByte() ----------------}
for i := 1 to max do
begin {display the list of menu items}
j := i+5; {start from row 6}
gotoxy(x,j);
writeln(s[i]);
end;
i := j;
repeat
{ch := choice(x,1,i);}
j := pickbyte(x,6,i);
gotoxy(15,22);
writeln('You chose ',j);
until j = 0; {until Escape}
{------------------------- test using PickChar() ----------------}
ClrScr;
ch := 'A';
for i := 1 to max do
begin
s[i][1] := Ch; {change numbers to letters in menu list}
Inc(Ch);
end;
for i := 1 to max do
begin {display the list of menu items}
gotoxy(x,i); {start from row 1}
writeln(s[i]);
end;
repeat
ch := PickChar(x,1,i);
gotoxy(15,22);
writeln('You chose ',ch);
until ch = #27; {until Escape}
end.
{------------------------ end of TEST.PAS ---------------------------}