home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / getxp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-06-22  |  3.3 KB  |  97 lines
  1.  
  2. {General purpose procedure to get an expression with regard to limit of}
  3. {length of string. Called with C=Column, R=Row, L=Length limit of      }
  4. {expression. Carriage return--Chr(13)--enters the expression into      }
  5. {desired location in calling routine. This is for strings.             }
  6. procedure GetExpression;
  7.      begin
  8.          Expression := '';
  9.          GotoXY(C,R);
  10.          Write('':L,'<<');
  11.          GotoXY(C,R);
  12.          Repeat
  13.          Read(KBD,Ch);
  14.          Expression := Expression + Ch; {Add each keystroke to string}
  15.          J := Length(Expression);
  16.          If Ch = Chr(8) then {Special routing for backspaces}
  17.          begin
  18.             If J = 1 then  {Special routine for backspace as first Ch}
  19.             begin
  20.               Write(^G);
  21.               Delete(Expression,J,1);
  22.             end;
  23.             If J <> 1 then
  24.             begin
  25.               Delete(Expression,J-1,2);
  26.               M := (C + (J - 2));
  27.               GotoXY(M,R);
  28.               Write(' ');
  29.               J := J - 1;
  30.             end;
  31.          end;
  32.          GotoXY(C,R);
  33.          Write(Expression);
  34.          If Ch = Chr(13) then L := L + 1;
  35.          If J > L then
  36.          begin
  37.               Write(^G); {Wipes it out with a beep if too long}
  38.               Expression := '';
  39.               GotoXY(C,R);
  40.               Write('':L,'<<      ');
  41.          end;
  42.          Until Ch = Chr(13);
  43.      end;
  44.  
  45. {Similar to GetExpression, but uses X as number length. Case of routine}
  46. {averts variable type error by locking out anything but numbers, back- }
  47. {spaces and Carriage returns}
  48. procedure GetNumber;
  49.      begin
  50.          Expression := '';
  51.          GotoXY(C,R);
  52.          Write('':X,'<<');
  53.          GotoXY(C,R);
  54.          Repeat
  55.                Repeat
  56.                    Beep := True; {Locks out letters, etc. Beeps if wrong}
  57.                    Read(KBD,Ch); {kind of key pressed}
  58.                    If Ch in ['0','1','2','3','4','5','6','7','8','9',Chr(8),Chr(13)] then
  59.                    begin
  60.                        Beep := False;
  61.                    end;
  62.                    If Beep = True then Write(^G);
  63.                Until Ch in ['0','1','2','3','4','5','6','7','8','9',Chr(8),Chr(13)];
  64.                Expression := Expression + Ch;
  65.                J := Length(Expression);
  66.                If Ch = Chr(8) then
  67.                begin
  68.                   If J = 1 then
  69.                   begin
  70.                     Write(^G);
  71.                     Delete(Expression,J,1);
  72.                   end;
  73.                   If J <> 1 then
  74.                   begin
  75.                     Delete(Expression,J-1,2);
  76.                     M := (C + (J - 2));
  77.                     GotoXY(M,R);
  78.                     Write(' ');
  79.                     J := J - 1;
  80.                  end;
  81.               end;
  82.               GotoXY(C,R);
  83.               Write(Expression);
  84.               If Ch = Chr(13) then X := X + 1;
  85.               If J > X then
  86.               begin
  87.                    Write(^G);
  88.                    Expression := '';
  89.                    GotoXY(C,R);
  90.                    Write('':X,'<<      ');
  91.               end;
  92.               Until Ch = Chr(13);
  93.               Val(Expression,K,O);
  94.               Number := K;
  95.      end;
  96.  
  97.