Category : Pascal Source Code
Archive   : FIELD.ZIP
Filename : FIELD.PAS

 
Output of file : FIELD.PAS contained in archive : FIELD.ZIP

Unit field;

{ FIELD.PAS was developed by Frank Wood from KEYIN.INC by Michael
H. Hughes. This material is hereby placed in the Public Domain. }

Interface

Uses Crt,Dos;

{ Values returned by ReadyKey for IBM PC keys }
Const backspacekey = 8; { Cursor left and erase }
tabkey = 9; { Move to field on right }
shiftabkey = 15; { Move to field on left }
enterkey = 13; { Accept field }
esckey = 27; { Exit screen or program }
spacekey = 32; { Space bar }

extendedkey = 0; { Nul returned to indicate an extended key }
insertkey = 82; { Toggle insert mode }
deletekey = 83; { Delete a character }
homekey = 71; { Cursor to first position in field }
endkey = 79; { Cursor to end of entry or accept screen }
uparrowkey = 72; { Move to field above }
dnarrowkey = 80; { Move to field below }
larrowkey = 75; { Cursor left }
rarrowkey = 77; { Cursor right }

{ Special IBM PC characters used in menu screen. }
pickpointer = $1A;
pickmarker = $FE;

{ Constants to be used with the Boolean variable required. }
optional = False;
manditory = True;

Type message = string[70];
fldtypes = (alsymb,ascii,caplet,digits,usnint,sgnint,usndec,sgndec);
cursortypes = (hidden,underline,block);

Var firstpass: Boolean; { Kills tabkey, shiftabkey, uparrowkey, dnarrowkey. }
reversevideo: Boolean;{ Selects reverse video or markers for field. }
zerovoid: Boolean; { A required numerical data entry may not be zero. }
hitxtcolor: Byte; { Highlight text color }
lotxtcolor: Byte; { Normal text color }
txtbkgnd: Byte; { Screen background color }

{ "cursor" hides the cursor or switches between block and underline types. }
Procedure cursor(cursortype: cursortypes);

{ "note" displays an operator message on line 25 of the screen. }
Procedure note(msg: message);

{ "errmsg" displays an error message on line 25 of the screen. }
Procedure errmsg(msg: message);

{ "getkey" waits for a keystroke input and returns its numeric value. }
Function getkey(var specialkey:Boolean): Byte;

{ "getspecialkey" waits for a special keystroke and returns its numeric value.
An error message is generated if the operator presses an ordinary key. }
Function getspecialkey: Byte;

{ "editfield" is the master field input routine. This function will display a
string, or an integer or real number at a specified position on the screen,
will allow the operator to enter or edit the data, and place the edited
result back in the string, integer or real variable. Each character is
checked as it is entered and an error message is displayed for any
inappropriate keys.

The parameters required are as follows:

col,row - The column and row position of the field.

fldsize - The maximum field length in character positions.

decpla - The number of digits allowed right of the decimal point.

fldtype - The type of data to be entered, specified as follows:

alsymb - All printable symbols.
lascii - Lower (standard) ASCII characters only.
caplet - Upper case letters and other ASCII characters.
Shifting is not required; lower case letters are
converted to upper-case.
digits - Digits only processed as an ASCII string.
unsint - Digits only (unsigned integer).
sgnint - Digits and minus sign.
unsdec - Digits and decimal point.
sgndec - Digits, sign, and decimal point.

required - True if data must be entered in this field. A zero is not
accepted for a required field if zerovoid = True.

buffer - The string, integer or real variable that holds the initial value
and will receive the final value of the field. If blank on entry
the routine will display markers to indicate the length of the
field, otherwise the current contents are displayed.

editfield- This function returns the value of the keystroke that terminates
the operation. }

Function editfield(col,row,fldsize,decpla: Byte; fldtype: fldtypes;
required: Boolean; Var buffer): Byte;

{ "getpick" allows a field to be expressed as a picklist. Given an array of
strings, it will display them as a picklist beginning at the specified column
and row position on the screen. The operator may then move a pointer up
and down the list by pressing "spacekey" or "backspacekey". Pressing a
letter key will cause the routine to search for a string beginning with
that letter, and position the pointer on that item.

The parameters required are as follows:

col,row - The column and row position of the upper left corner of the menu
block. This will be 2 places to the left of the leftmost
character of the first menu text line.

maxpick - The number of items or lines in the menu

choice - The number of the item where the pointer is to be positioned
when the routine is first called. If a value of 1 is used, the
pointer will initially be on the first line of the pick list.
When the function is terminated with the enterkey, this variable
will contain the number of the item chosen.

picklist - An array of strings, each having a maximum length of 30
characters. The number of strings in the array must at least
as great as the value of "number". This is an untyped parameter,
and it is up to the programmer to ensure that the array is of the
correct dimensions.

getpick - This function returns the value of the key stroke that terminates
the operation in the same manner as "editfield".}

{ Generate A Menu Display and return the number of the choice. }
Function getpick(col,row,maxpick: Byte; Var choice: Byte; Var picklist):Byte;

Implementation


Procedure beep;

Begin
write(chr(7))
End;


Procedure cursor(cursortype: cursortypes);

Var reg: Registers;
startline: Byte;
monocrt: Boolean;

Begin
{ Check to see if the CRT is monochrome. }
reg.AH:=$0F;
Intr($10,reg); { Use interupt 10 to get display type }
If reg.AL = $07
Then monocrt:=True
Else monocrt:=False;

{ Set the startline value for the cursor type chosen. }
If cursortype = block
Then startline:=$00
Else If monocrt
Then startline:=$0C { For monochrome cursor endline = $0D }
Else startline:=$06; { For CGA cursor endline = $07 }
If cursortype = hidden
Then reg.CH:=$20 { This blows cursor into oblivion }
Else reg.CH:=startline;
reg.CL:=07;
reg.AH:=1;
Intr($10,reg) { Use interupt 10 to set startline }
End;


Procedure blank(col,row,places: Byte);

Var start: Byte;

Begin
GotoXY(col,row);
For start:=1 To places Do Write(' ');
GotoXY(col,row)
End;

Procedure note(msg: message); { Display a note at line 25 }
Begin
cursor(hidden);
blank(1,25,78);
TextColor(hitxtcolor);
Write('Note'); { displayed with highlight }
TextColor(hitxtcolor+Blink);
Write(': '); { displayed with blink and highlight }
TextColor(hitxtcolor);
Write(msg); { displayed with highlight }
TextColor(lotxtcolor)
End;

Procedure errmsg(msg: message); { Display an error message at line 25 }
Begin
TextColor(hitxtcolor+Blink);
TextBackground(txtbkgnd);
blank(1,25,78);
Write(chr(7),'ERROR: '); { sound bell, display with blink and highlight }
TextColor(hitxtcolor);
Write(msg); { displayed with highlight }
TextColor(lotxtcolor);
End;

{ Waits for a key and returns its value }
Function getkey(var specialkey:Boolean): Byte;

Var ch: Char;

Begin
ch:=ReadKey;
If ord(ch) = extendedkey Then
Begin
specialkey:=True;
ch:=ReadKey
End
Else If (ord(ch) = backspacekey) Or
(ord(ch) = tabkey) Or
(ord(ch) = enterkey) Or
(ord(ch) = esckey)
Then specialkey:=True
Else specialkey:=False;
getkey:=ord(ch)
End;

{ Waits for a special key and returns its value }
Function getspecialkey: Byte;

Var
ch: Byte;
specialkey: Boolean;

Begin
Repeat
GotoXY(78,25);
TextColor(hitxtcolor);
Write(chr($FE));
GotoXY(78,25);
TextColor(lotxtcolor);
cursor(underline);
ch:=getkey(specialkey);
If Not specialkey
Then errmsg('Entry Must be a Special Key!');
Until specialkey;
getspecialkey:=ch;
End;

{ Allows editing of old or entry of new data and returns last keystroke }
Function editfield(col,row,fldsize,decpla: Byte; fldtype: fldtypes;
required: Boolean; Var buffer): Byte;

Type inputkeys = set of Char;
intdata = Integer; { Identifier to typecast untyped variable }
realdata = Real; { Identifier to typecast untyped variable }

Var field: string[80]; { Holding string for key input }

posn: Byte; { Current cursor position in field }
count: Byte; { Number of characters in field }
ptr,ctr: Byte; { Temporary pointer,counter }
code: Integer; { Error code returned by Val procedure }
intvalue: Integer; { Integer value returned by Val procedure }
realvalue: Real; { Real value returned by Val procedure }

specialkey: Boolean; { Key has an extended code }
numdata: Boolean; { Data is not a string }
decdata: Boolean; { Data is a decimal number }
empty: Boolean; { Field is currently blank }
first: Boolean; { First character is still being processed }
edit: Boolean; { Field is in edit mode, editing key was pressed }
insert: Boolean; { Field is in insert mode, insert key was pressed }
error: Boolean; { Keying error has occured }
beyond: Boolean; { Cursor is beyond last character position in field }
terminate: Boolean; { Field entry has been terminated }
abort: Boolean; { Field entry has been canceled }

regkeys: Inputkeys; { All printable keys }
asckeys: Inputkeys; { Ordinary ASCII keys }
digkeys: Inputkeys; { Digit keys only }

ch: Char; { Current key pressed }
chval: Byte; { Ord() of current key pressed }
datablock: Byte; { Symbol showing unused position in field }

{ Changes colors and datablock character as required }
Procedure inscrn(input: Boolean);

Begin
If reversevideo Then { Reverse video display }
Begin
If input Then { Reverse }
Begin
TextColor(txtbkgnd);
TextBackground(lotxtcolor)
End
Else { Normal }
Begin
TextColor(lotxtcolor);
TextBackground(txtbkgnd)
End;
datablock:=$20 { A blank space for reverse video }
End
Else { Regular display }
Begin
If input Then { Highlight }
TextColor(hitxtcolor)
Else
TextColor(lotxtcolor); { Normal }
TextBackground(txtbkgnd);
datablock:=$FE { The regular block synbol }
End
End;

Begin { editfield function }

{ Set display }
inscrn(False);

{ Determine data type }
If fldtype > digits Then numdata:=True Else numdata:=False;
If fldtype > sgnint Then decdata:=True Else decdata:=False;

{ Load data from buffer to "field" and initialize field length }
If numdata Then
If decdata Then
Begin
If (fldtype = usndec) Then
Begin
If (decpla <> 0) And (fldsize < 3) Then fldsize:=3;
If (decpla <> 0) And (decpla > fldsize-2) Then decpla:=fldsize-2
End
Else
Begin
If (decpla = 0) And (fldsize < 2) Then fldsize:=2;
If (decpla <> 0) And (fldsize < 4) Then fldsize:=4;
If (decpla <> 0) And (decpla > fldsize-3) Then decpla:=fldsize-3
End;
str(realdata(buffer):fldsize:decpla,field)
End
Else
Begin
If (fldtype = sgnint) And (fldsize < 2) Then fldsize:=2;
str(intdata(buffer):fldsize,field)
End
Else
Begin
move(buffer,ch,1);
move(buffer,field,ord(ch)+1)
End;
If length(field) > fldsize Then field[0]:=chr(fldsize);
If length(field) < fldsize Then
For posn:=length(field)+1 To fldsize Do field[posn]:=chr(datablock);
count:=length(field);
If count = 0 Then empty:=True Else empty:=False;
field[0]:=chr(fldsize);

{ Delete leading blanks }
While numdata And (field[1] = ' ') Do
If count = 1 Then
Begin
field[1]:=chr(datablock);
count:=0
End
Else
Begin
move(field[2],field[1],fldsize-1);
field[fldsize]:=chr(datablock);
count:=pred(count)
End;

{ Clear message line and display existing value }
blank(1,25,78);
cursor(hidden);
inscrn(True);
GotoXY(col,row);
Write(field);
GotoXY(col,row);

{ Initialize conditions }
regkeys:=[#1..#6,#11..#12,#14..#26,#28..#31,#32..#255];
asckeys:=[#32..#127];
digkeys:=[#48..#57];
posn:=1; insert:=False; edit:=False; first:=True;
error:=False; terminate:=False; abort:=False;
editfield:=0;

{ Get input from keyboard }
Repeat { Until valid data or aborted }

Repeat { Until field entry terminated }

{ Reset cursor position and turn cursor on }
If error Then
Begin
GotoXY(col+posn-1,row);
inscrn(False)
End;
If insert Then cursor(block) Else cursor(underline);

{ Get character and turn cursor off }
chval:=getkey(specialkey);
cursor(hidden);
ch:=chr(chval);

{ Erase message line and reset cursor and attributes }
If error Then
Begin
blank(1,25,78);
GotoXY(col+posn-1,row);
inscrn(True);
error:=False
End;

{ Check if cursor is beyond end of field }
If posn <= fldsize Then beyond:=False Else beyond:=True;

{ Select proper response to the key pressed }
If specialkey Then Case chval Of

esckey,
uparrowkey,
dnarrowkey,
tabkey,
shiftabkey:
If firstpass and Not (chval = esckey) Then
beep
Else
Begin
{ Set function return value }
Case chval Of
esckey: editfield:=esckey;
uparrowkey: editfield:=uparrowkey;
dnarrowkey: editfield:=dnarrowkey;
tabkey: editfield:=tabkey;
shiftabkey: editfield:=shiftabkey
End;
insert:=False;
abort:=True;
terminate:=True

End;

enterkey:
Begin
{ Accept data and terminate }
If empty And required Then
Begin { required field empty }
errmsg('You Must Enter Data for This Item!');
error:=True
End;
If Not error Then
Begin
{ accept existing data }
If first And Not edit And Not numdata Then
Begin
move(buffer,field,fldsize+1);
If length(field) > fldsize Then field[0]:=chr(fldsize)
End;
editfield:=enterkey;
terminate:=True
End;
insert:=false
End;

rarrowkey:
Begin
{ cursor right }
edit:=True;
If (posn <= count) and (posn < fldsize) Then
Begin
Inc(posn);
GotoXY(col+posn-1,row)
End
Else beep
End;

larrowkey:
Begin
{ cursor left }
edit:=True;
If posn > 1 Then
Begin
Dec(posn);
GotoXY(col+posn-1,row)
End
Else beep
End;

homekey:
Begin
{ cursor to first position in field }
edit:=True;
If posn > 1 Then
Begin
posn:=1;
GotoXY(col,row)
End
Else beep
End;

endkey:
Begin
{ cursor right }
edit:=True;
If posn <= count Then
Begin
posn:=succ(count);
GotoXY(col+posn-1,row)
End
Else beep
End;

insertkey:
Begin
edit:=True;
insert:=not insert
End;

backspacekey:
Begin
{ Destructive backspace }
If posn > 1 Then
Begin
posn:=pred(posn);
If posn < count+1 Then
Begin
move(field[posn+1],field[posn],fldsize-posn);
count:=pred(count);
If count = 0 Then empty:=True Else empty:=False;
field[fldsize]:=chr(datablock);
GotoXY(col,row);
Write(field);
GotoXY(col+posn-1,row)
End
End
Else beep
End;

deletekey:
Begin
{ Delete the character at the cursor position }
edit:=True;
If posn < count+1 Then
Begin
move(field[posn+1],field[posn],fldsize-posn);
count:=pred(count);
If count = 0 Then empty:=True Else empty:=False;
field[fldsize]:=chr(datablock);
GotoXY(col,row);
Write(field);
GotoXY(col+posn-1,row)
End
End

Else beep { Ignore other specialkeys }
End { specialkey case statement }

Else If beyond Then beep

Else If ch in regkeys Then
Begin
{ Character (Printable) key }
If first And Not empty And Not edit Then
Begin
{ Clear the current field if first key press is data }
fillchar(field[1],fldsize,chr(datablock));
GotoXY(col,row);
Write(field);
GotoXY(col,row);
count:=0; posn:=1; empty:=True;
End;

{ Validate key }
Case fldtype Of
alsymb:;
ascii,
caplet:
If Not (ch in asckeys) Then
Begin
errmsg('Entry Must be an Ordinary ASCII Character!');
error:=True
End
Else If fldtype = caplet Then
ch:=UpCase(ch);
digits,
usnint:
If Not (ch in digkeys) Then
Begin
errmsg('Entry Must be a Digit!');
error:=True
End;
sgnint:
If Not (ch in digkeys)
And Not ((ch = '-') And (posn = 1)) Then
Begin
errmsg('Entry Must be Digit or Initial Minus Sign!');
error:=True
End;
usndec:
If Not (ch in digkeys)
And Not ((ch = '.') And (pos('.',field) = 0))
And Not ((ch = '.') And (pos('.',field) = posn)) Then
Begin
errmsg('Entry Must be Digit or Decimal Point!');
error:=true
End;
sgndec:
If Not (ch in digkeys)
And Not ((ch = '-') And (posn = 1))
And Not ((ch = '.') And (pos('.',field) = 0))
And Not ((ch = '.') And (pos('.',field) = posn)) Then
Begin
errmsg
('Must be Digit, Initial Minus Sign, or Declimal Point!');
error:=True
End
Else
Else
End; { fldtype Case statement }

{ Display the character and update the pointers }
If not error And insert And (count = fldsize) Then
Begin
errmsg('Field is Full!');
error:=True
End
Else
If not error And insert and (field[posn] = '-') Then
Begin
errmsg('Insertion Ahead of Minus Sign Not Allowed!');
error:=True
End
Else
If not error Then
Begin
{ Insert a space at the cursor position }
If insert and (posn <= count) Then
Begin
move(field[posn],field[posn+1],fldsize-posn);
Inc(count);
field[posn]:=' ';
GotoXY(col,row);
Write(field);
GotoXY(col+posn-1,row)
End;
Write(ch);
field[posn]:=ch;
If posn > count Then count:=posn;
If posn <= fldsize Then Inc(posn);
first:=False; empty:=False
End
End { printable character case }

Else beep;

Until terminate; { End of input }

{ Input Complete; Validate and Format or Abort }
field[0]:=chr(count);
If Not abort Then
Begin
If numdata Then
Begin
{ Delete extra leading zeros }
While (count > 1) And (field[1] = '0')
And (field[2] <> '.') Do
Begin
move(field[2],field[1],fldsize-1);
field[fldsize]:=chr(datablock);
Dec(count);
field[0]:=chr(count)
End;
While (count > 2) And (field[1] = '-')
And (field[2] = '0') And (field[3] <> '.') Do
Begin
move(field[3],field[2],fldsize-2);
field[fldsize]:=chr(datablock);
Dec(count);
field[0]:=chr(count)
End;
{ Place a zero in an empty field or add a zero where needed }
If count = 0 Then
Begin
Inc(count);
field[0]:=chr(count);
field[1]:='0'
End
Else If field[1] = '.' Then
Begin
Inc(count);
field[0]:=chr(count);
move(field[1],field[2],count-1);
field[1]:='0'
End
Else If (field[1] = '-') And ((field[2] = '.') Or (count = 1)) Then
Begin
Inc(count);
field[0]:=chr(count);
move(field[2],field[3],count-2);
field[2]:='0'
End;
If field[count] = '.' Then
If (decpla <> 0) Then
Begin
Inc(count);
field[0]:=chr(count);
field[count]:='0'
End
Else
Begin
field[count]:=chr(datablock);
Dec(count);
field[0]:=chr(count)
End;
val(field,realvalue,code);
{ check for zero value when entry is required }
If required And (realvalue = 0) And zerovoid Then
Begin
errmsg('Zero is Not a Valid Entry!');
If count > fldsize Then count:=fldsize;
error:=True; posn:=1; edit:=True;
terminate:=False
End
Else If decdata Then
Begin
field[0]:=chr(fldsize);
ptr:=pos('.',field);
{ Check for too many digits }
If (decpla > 0) And (((ptr > 0) And (ptr+decpla > fldsize))
Or ((ptr = 0) And (count+decpla > fldsize-1))) Then
Begin
errmsg('Too Many Digits before Decimal Point!');
If count > fldsize Then count:=fldsize;
error:=True; edit:=True; terminate:=False;
posn:=1
End
Else If ((count-ptr) > decpla) And Not (ptr = 0) Then
Begin
errmsg('Too Many Digits after Decimal Point!');
If count > fldsize Then count:=fldsize;
error:=True; edit:=True; terminate:=False;
posn:=count+1
End
Else
Begin
field[0]:=chr(count);
realdata(buffer):=realvalue
End
End
Else { Integer data }
Begin
val(field,intvalue,code);
If (code = 0) And (field[1] <> '-')
And Not ((intvalue >= 0) And (intvalue <= 32767)) Then
Begin
errmsg('Invalid Entry, Maximum Integer is 32767!');
error:=True; edit:=True; terminate:=False;
posn:=1
End
Else If (code = 0) And (field[1] = '-')
And Not ((intvalue >= -32768) And (intvalue <= 0)) Then
Begin
errmsg('Invalid Entry, Minimum Integer is -32768!');
error:=True; edit:=True; terminate:=False;
posn:=1
End
Else intdata(buffer):=intvalue
End
End
Else { String data }
Begin
{ Set count for blank field to zero }
ptr:=1;
While (field[ptr] = ' ') And (ptr < count) Do Inc(ptr);
If (field[ptr] = ' ') And (ptr = count) Then
Begin
If required Then
Begin
errmsg('You Must Enter Data Not Blanks!');
error:=True; posn:=1; edit:=True;
terminate:=False
End
Else
Begin
field[0]:=chr(0);
count:=0
End
End
End;
{ Display the field and load it to the buffer }
If Not error Then
Begin
inscrn(False);
blank(col,row,fldsize);
If numdata Then
If decdata Then
Write(realdata(buffer):fldsize:decpla)
Else { Integer data }
Write(intdata(buffer):fldsize)
Else { String data }
Begin
Write(field);
move(field,buffer,length(field)+1)
End;
sound(80); { Make a clicking sound }
delay(3); { to confirm successful }
nosound { entry of data! }
End
Else { Error }
If numdata Then
Begin
field[0]:=chr(fldsize);
inscrn(True);
blank(col,row,fldsize);
Write(field)
End
End
Else { Abort }
{ Restore original data and exit without change }
Begin
inscrn(False);
blank(col,row,fldsize); { Erase field }
If numdata Then
If decdata Then
Write(realdata(buffer):fldsize:decpla)
Else { Integer data }
Write(intdata(buffer):fldsize)
Else { String data }
Begin
move(buffer,ch,1);
move(buffer,field,ord(ch)+1);
If length(field) > fldsize Then
field[0]:=chr(fldsize);
Write(field)
End
End;

Until terminate
End; { editfield }

Function getpick(col,row,maxpick: Byte; Var choice: Byte; Var picklist):Byte;

Const maxnumber=20; { maximum size of list array }

Type listtype=Array[1..maxnumber] Of String[30];

Var list: listtype Absolute picklist;
picknum, count, chval, initial: Byte;
pointer, marker: String[3];
firstletter: String[1];
ch: Char;
specialkey: Boolean;

Begin
pointer:=' ';
pointer[2]:=chr(pickpointer);
marker:=' ';
marker[2]:=chr(pickmarker);
cursor(hidden);
TextColor(lotxtcolor);

{ Display list }
For picknum:=1 To maxpick Do
Begin
GotoXY(col,picknum+row-1);
Write(marker,list[picknum])
End;
note('SPACE, BACKSPACE or First Letter to Move; ENTER to Select!');

{ Pick menu }
picknum:=choice;
initial:=choice;
getpick:=0;
Repeat
{ Display current pick }
GotoXY(col,row+picknum-1);
TextColor(hitxtcolor+Blink);
Write(pointer);
TextColor(hitxtcolor);
Write(list[picknum]);
{ Get Keyboard and clear current pick }
chval:=getkey(specialkey);
GotoXY(col,row+picknum-1);
TextColor(hitxtcolor);
Write(pointer); { Kill blink on pointer }
GotoXY(col,row+picknum-1);
TextColor(lotxtcolor);
If (chval <> enterkey) Then
Write(marker,list[picknum]);
{ If abort, reset initial pick }
If (chval = uparrowkey) Or
(chval = dnarrowkey) Or
(chval = tabkey) Or
(chval = shiftabkey) Or
(chval = esckey) Then
Begin
GotoXY(col,row+initial-1);
TextColor(hitxtcolor);
Write(pointer,list[initial])
End;

{ Determine new Pick }
Case chval Of
enterkey:
Begin
getpick:=enterkey;
choice:=picknum
End;
endkey:
picknum:=maxpick;
homekey:
picknum:=1;
esckey:
getpick:=esckey;
uparrowkey:
If firstpass Then beep
Else getpick:=uparrowkey;
dnarrowkey:
If firstpass Then beep
Else getpick:=dnarrowkey;
tabkey:
If firstpass Then beep
Else getpick:=tabkey;
shiftabkey:
If firstpass Then beep
Else getpick:=shiftabkey;
backspacekey:
If picknum > 1 Then Dec(picknum)
Else picknum:=maxpick;
spacekey:
If picknum < (maxpick) Then Inc(picknum)
Else picknum:=1
Else { default case }
Begin
{ Check for first character of line }
count:=picknum;
ch:=UpCase(chr(chval));
Repeat
Inc(count);
If count > maxpick Then count:=1;
firstletter:=copy(list[count],1,1);
Until (count = picknum)
Or (ch = UpCase(firstletter[1]));
picknum:=count
End
End; { chval Case statement }

Until (chval = enterkey) Or
(chval = esckey) Or
(chval = uparrowkey) Or
(chval = dnarrowkey) Or
(chval = tabkey) Or
(chval = shiftabkey)
End;

End.