Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/INPFLD11.ZIP/FIELDTST.PAS

Pascal/Delphi Source File | 1987-07-02 | 5.2 KB | 159 lines

{ ==================================================== }
{ FieldTest - Test out the InpFld routine. Demonstrate }
{     how it works.                                    }
{                                                      }
{ Information about how to use InpFld is provided in   }
{ the procedure header for InpFld in the file          }
{ INPFLD.INC                                           }
{ ==================================================== }
Program FieldTest;

{$IINPFLD.INC }

Const
   UPPER = 1;
   AUTOEXIT = 5;
   RJUST = 6;
   DISPOLD = 7;

   editkeys : array [1..16] of strg80 = (
     '               Field Editing Keys           ',
     '                                            ',
     'Left Arrow  (Ctl-S) - Move left one column  ',
     'Right Arrow (Ctl-D) - Move right one column ',
     'Home        (Ctl-A) - Go to start of field  ',
     'End         (Ctl-F) - go to end of field    ',
     'BackSpace           - Delete char to left   ',
     'Del         (Ctl-G) - Delete current char   ',
     'Ctl-BackSpace       - Delete entire field   ',
     'Ins                 - Toggle insert mode    ',
     'Ctl-End             - Delete to end of field',
     'Ctl-Left Arrow      - Move one word to left ',
     'Ctl-Right Arrow     - Move one word to right',
     '                                            ',
     'To exit the field, use Enter, Tab, BackTab, ',
     'Esc, Up Arrow or Down Arrow.                ');
Var
   keyval : integer;         { Returned value of last keystroke }
   attr   : integer;         { The field attributes             }
   row,col: integer;         { Row/col position of the field    }
   size   : integer;         { Length of the field              }
   legal  : strg255;         { List of legal characters         }
   ibuf   : strg255;         { The actual input string          }
   options: option_type;     { Input options                    }
   s      : strg80;          { a display string for DispLine    }
   i      : integer;

Procedure DisplayExitCode;
Var atr : integer;
begin
   s := 'Exit key value: ';
   atr := ((black shl 4) + green);
   DispLine(60,18,atr,s);
   Gotoxy(77,19);
   Write(keyval);
end;

begin
   ClrScr;
   s := 'InpFld - Field Input Demonstration';
   attr := ((red shl 4) + yellow);
   DispLine(22,0,attr,s);   { Display a banner }
   attr := ((blue shl 4) + white);
   for i := 1 to 16 do DispLine(35,i+1,attr,editkeys[i]); { show edit info }

{ No options chosen. No uppercase translation, no auto exit from }
{ field, no initial string display. Allow all characters.        }

   s := 'No options, all chars legal';
   attr := ((black shl 4) + white);
   DispLine(4,2,attr,s);  { note that displine coordinates are 0-24, 0-79 }
   row := 4;     { InpFld coordinates are 1-25, 1-80 }
   col := 5;
   attr := ((lightgray shl 4) + black);
   size := 27;
   legal := '';
   ibuf := 'This will not be displayed.';
   options := [];
   InpFld(keyval,legal,ibuf,attr,col,row,size,options);
   DisplayExitCode;

{ Uppercase translation. All characters legal.                   }

   s := 'Translate all to uppercase';
   attr := ((black shl 4) + white);
   DispLine(4,5,attr,s);
   row := 7;
   col := 5;
   attr := ((red shl 4) + lightgreen);
   size := 26;
   legal := '';
   ibuf := 'This will not be displayed.';
   options := [UPPER];
   InpFld(keyval,legal,ibuf,attr,col,row,size,options);
   DisplayExitCode;

{ Display old string. All characters legal.                      }

   row := 9;
   col := 5;
   attr := ((green shl 4) + black);
   size := 24;
   legal := '';
   ibuf := 'Display old field.';
   options := [DISPOLD];
   InpFld(keyval,legal,ibuf,attr,col,row,size,options);
   DisplayExitCode;

{ Autoexit on filled field. numbers only.                        }

   s := 'Auto exit when full - numbers';
   attr := ((black shl 4) + white);
   DispLine(0,10,attr,s);
   row := 12;
   col := 1;
   attr := ((blue shl 4) + yellow);
   size := 29;
   legal := '0123456789';
   ibuf := '4321';
   options := [AUTOEXIT,DISPOLD];
   InpFld(keyval,legal,ibuf,attr,col,row,size,options);
   DisplayExitCode;

{                                                                }

   s := 'Answer yes/no (Y/N):';
   attr := ((magenta shl 4) + black);
   DispLine(2,15,attr,s);
   row := 16;
   col := 24;
   attr := ((lightgray shl 4) + black);
   size := 1;
   legal := 'NY';
   ibuf := 'Y';
   options := [UPPER,DISPOLD];
   InpFld(keyval,legal,ibuf,attr,col,row,size,options);
   DisplayExitCode;


{ Upper case, display old, right justify at end.                 }

   s := 'Enter a filename - try illegal characters (right justified on exit)';
   attr := ((black shl 4) + white);
   DispLine(0,19,attr,s);
   row := 21;
   col := 1;
   attr := ((brown shl 4) + white);
   size := 50;
   legal := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789:.$&#@!%''`~()-{}_/\';
   ibuf := 'C:\SUBDIR\SUB\FILENAME.EXT';
   options := [UPPER,RJUST,DISPOLD];
   InpFld(keyval,legal,ibuf,attr,col,row,size,options);
   DisplayExitCode;

   Gotoxy(1,23);
   Writeln('See INPFLD.INC for more information. InpFld is a ShareWare procedure.');
   Write  ('         Copyright (C) 1987 by Michael Burton Software.');

end.