Power-Programmierung/CD1.mdf/pascal/library/dos/tug__002/field.pas

Pascal/Delphi Source File | 1988-08-08 | 33.7 KB | 1,017 lines

{TUG PDS CERT 1.01 (Pascal)

==========================================================================

                  TUG PUBLIC DOMAIN SOFTWARE CERTIFICATION

The Turbo User Group (TUG) is recognized by Borland International as the
official support organization for Turbo languages.  This file has been
compiled and verified by the TUG library staff.  We are reasonably certain
that the information contained in this file is public domain material, but
it is also subject to any restrictions applied by its author.

This diskette contains PROGRAMS and/or DATA determined to be in the PUBLIC
DOMAIN, provided as a service of TUG for the use of its members.  The
Turbo User Group will not be liable for any damages, including any lost
profits, lost savings or other incidental or consequential damages arising
out of the use of or inability to use the contents, even if TUG has been
advised of the possibility of such damages, or for any claim by any
other party.

To the best of our knowledge, the routines in this file compile and function
properly in accordance with the information described below.

If you discover an error in this file, we would appreciate it if you would
report it to us.  To report bugs, or to request information on membership
in TUG, please contact us at:

             Turbo User Group
             PO Box 1510
             Poulsbo, Washington USA  98370

--------------------------------------------------------------------------
                       F i l e    I n f o r m a t i o n

* DESCRIPTION
Author Frank Wood. Turbo Pascal 4.0 unit for coding input screens. The
main function locates fields, allows complete editing, and returns
terminating keystroke. Eight fields types with crash proof data entry and
error messages. Menu pick function also included.

* ASSOCIATED FILES
FIELD.PAS
FLDDEMO.PAS
FLDTEST.PAS
OLDDEMO.PAS
FIELD.TXT

* CHECKED BY
DRM 08/08/88

* KEYWORDS
TURBO PASCAL V4.0

==========================================================================
}
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.