home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol293 / turbpc1.lbr / ENTSAM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-17  |  4.5 KB  |  153 lines
  1. Program EntrySample;
  2.  
  3. var
  4.   Field                 : String[10];
  5.   LowEnd,HighEnd        : Real;
  6.   Result,Value,
  7.   Place,FieldSize,Times : Integer;
  8.   Cursor,Ch             : Char;
  9.   RangeOK               : Boolean;
  10.  
  11. procedure InputField;
  12.  
  13. label Bypass;
  14.  
  15. begin
  16.     Field := '';
  17.     Place := 0;
  18.     Repeat
  19.       Read(Kbd,Ch);
  20.       If Length(Field)<=FieldSize then begin
  21.         Case Ch of
  22.           #8       : begin             {BackSpace key}
  23.                        If Place=0 then begin  {avoid backspacing beyond}
  24.                          Write(Trm,Chr(8));   {beginning of field      }
  25.                          Write(' ');
  26.                        end
  27.                        else begin
  28.                          Delete(Field,Place,1); {destructive backspace}
  29.                          Place := Place-1;
  30.                          Write(Trm,Chr(8));
  31.                          Write(Cursor);
  32.                          Write(Trm,Chr(8));
  33.                        end;
  34.                      end;
  35.            #127    : begin;             {Delete Key}
  36.                        If Place=0 then begin  {avoid backspacing beyond}
  37.                          Write(Trm,Chr(8));   {beginning of field again}
  38.                          Write(' ');
  39.                        end
  40.                        else begin
  41.                          Delete(Field,Place,1); {destructive backspace}
  42.                          Place := Place-1;
  43.                          Write(Trm,Chr(8));
  44.                          Write(Cursor);
  45.                          Write(Trm,Chr(8));
  46.                        end;
  47.                      end;
  48.            #13     : begin              {Carraige Return--End of input}
  49.                        GoTo Bypass;     {for this field               }
  50.                      end;
  51.         else
  52.           If Length(Field)<FieldSize then begin
  53.             Place := Place+1;
  54.             Write(Ch);
  55.             Field := Field + Ch;
  56.           end
  57.           else begin
  58.             If Ch <> Chr(13) then
  59.               Write(Chr(7));            {Ring bell at terminal if at end of}
  60.           end;                          {field and no RETURN key pressed   }
  61. ByPass:
  62.         end;
  63.       end;
  64.     Until Ch=Chr(13);
  65. end;
  66.  
  67. procedure StripBlanks;            {don't use on Alpha-numeric fields...}
  68.                                   {blanks there may be valid           }
  69. begin
  70.   Repeat
  71.     Place := Pos(' ',Field);
  72.     Delete(Field,Place,1);
  73.     Place := Pos(' ',Field);
  74.   Until Place=0;
  75. end;
  76.  
  77.  
  78. procedure RangeCheck;
  79.  
  80. begin
  81.   Result := 0;                     {initialize error code}
  82.   StripBlanks;                     {from FLDINPUT.PAS - pull out blanks}
  83.   Val(Field,Value,Result);         {convert Field to a Number}
  84.   If Result <> 0 then begin        {look for non-numeric characters} 
  85.     Result := 0;                   {reset result code}
  86.     RangeOK := False;
  87.     Write(Chr(7));
  88.     GoToXY(1,23); ClrEol;
  89.     WriteLn('Input must be numeric.              ');
  90.     Write('Press any key to continue...        ');
  91.     Read(Kbd,Ch);
  92.     GoToXY(1,23); ClrEol;
  93.     GoToXY(1,24); ClrEol;
  94.   end
  95.   else begin
  96.     If (Value < LowEnd) or (Value > HighEnd) then begin
  97.       Write(Chr(7));
  98.       RangeOK := False;
  99.       GoToXY(1,23); ClrEol;
  100.       WriteLn('Value not in allowable range.       ');
  101.       Write('Press any key to continue...        ');
  102.       Read(Kbd,Ch);
  103.       GoToXY(1,23); ClrEol;
  104.       GoToXY(1,24); ClrEol;
  105.     end
  106.     else begin
  107.       RangeOK := True;
  108.     end;             {checking range}
  109.   end;               {checking result code}
  110. end;                 {of RangeCheck}
  111.  
  112.  
  113. begin                               {little sample program}
  114.   ClrScr;
  115.   Write('What do you use to delineate fields? (e.g., "_") :');
  116.   Read(Cursor);
  117.   ClrScr;
  118.   GoToXY(30,4);
  119.   Write('Entry Test');
  120.   GoToXY(1,6);
  121.   Write('Alpha Data: ');
  122.   FieldSize := 8;
  123.   GoToXY(20,6);
  124.   For Place := 1 to FieldSize do begin
  125.     Write(Cursor);
  126.   end;
  127.   GoToXY(20,6);
  128.   InputField;
  129.   GoToXY(20,6); ClrEol;
  130.   WriteLn(Field);
  131.   Field := '';
  132.   Repeat
  133.     GoToXY(1,8);
  134.     Write('Enter a number between 1 and 1000 : ');
  135.     FieldSize := 4;
  136.     LowEnd := 1;
  137.     HighEnd := 1000;
  138.     GoToXY(40,8);
  139.     For Place := 1 to FieldSize do begin
  140.       Write(Cursor);
  141.     end;
  142.     GoToXY(40,8);
  143.     InputField;
  144.     StripBlanks;
  145.     RangeCheck;
  146.    Until RangeOK;
  147.    Field := '';
  148.    GoToXy(20,1);
  149.    Write('Press any key to continue...');
  150.    Read(Kbd,Ch);
  151.    ClrScr;
  152. end.
  153.