home *** CD-ROM | disk | FTP | other *** search
/ The C Users' Group Library 1994 August / wc-cdrom-cusersgrouplibrary-1994-08.iso / listings / v_01_04 / 1n04042a < prev    next >
Text File  |  1990-08-08  |  828b  |  62 lines
  1.  
  2.  
  3.  
  4. const
  5.     HT = chr(9);
  6.     CR = chr(13);
  7.     SPACES = [' ', HT, CR];
  8.  
  9. procedure val
  10.     (s : string; var v : integer; var code : integer);
  11.     var
  12.         c : char;
  13.         digit, i, n : integer;
  14.         neg : boolean;
  15.  
  16.     function next : char;
  17.         begin
  18.         if i < length(s) then
  19.             begin
  20.             inc(i);
  21.             next := s[i];
  22.             end
  23.         else
  24.             next := chr(0);
  25.         end;
  26.  
  27.     begin
  28.     i := 0;
  29.     c := next;
  30.     while c in SPACES do
  31.         c := next;
  32.     neg := FALSE;
  33.     if c = '+' then
  34.         c := next
  35.     else if c = '-' then
  36.         begin
  37.         neg := TRUE;
  38.         c := next;
  39.         end;
  40.     if not (c in ['0' .. '9']) then
  41.         begin
  42.         code := i;
  43.         exit;
  44.         end;
  45.     n := 0;
  46.     while c in ['0' .. '9'] do
  47.         begin
  48.         n := n * 10 + ord(c) - ord('0');
  49.         c := next;
  50.         end;
  51.     if neg then
  52.         n := -n;
  53.     v := n;
  54.     if c = chr(0) then
  55.         code := 0
  56.     else
  57.         code := i;
  58.     end;
  59.  
  60. ----------
  61.  
  62.