home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / kaypro / newritkp.lbr / KBDSTUFF.IZC / KBDSTUFF.INC
Text File  |  1986-12-27  |  2KB  |  60 lines
  1. FUNCTION keystat(VAR ch:char):boolean;
  2. BEGIN  ch:=chr(BDOS(6,255)); keystat:=ch<>chr(0); END;
  3.  
  4.  
  5. PROCEDURE getstring(x,y:integer; 
  6.                   VAR s:midstr; 
  7.                  maxlen:integer;
  8.   shift,numeric,getreal:boolean; 
  9.              VAR rvalue:real;
  10.                   ndigs:integer; 
  11.              VAR ivalue:integer; 
  12.              VAR  error:integer;
  13.              VAR escape:boolean);
  14.  
  15. CONST   fldchar=127;
  16.  
  17. VAR       ch                 :char; 
  18.           field,worker,holder:midstr; 
  19.                            cr:boolean;
  20. printables,lowercase,numerics:set of char;
  21.  
  22. BEGIN holder:=''; printables:=[' '..'}']; lowercase:=['a'..'z']; 
  23. if getreal then numerics:=['+','-','.','0'..'9','E','e']
  24. else numerics:=['-','0'..'9']; 
  25. cr:=FALSE;  escape:=FALSE; fillchar(field,sizeof(field),chr(fldchar)); 
  26. field[0]:=chr(maxlen);
  27. if numeric then if getreal then str(rvalue:1:ndigs,s)
  28.    else str(ivalue:1,s);
  29. if (s<'1') or (s<'1.0') then s:='';
  30. if length(s) > maxlen then s[0]:=chr(maxlen);
  31. gotoxy(x,y); write(field); gotoxy(x,y); write(s); gotoxy(x,y);
  32. holder:=s; worker:='';
  33. repeat
  34. while not keystat(ch) do begin (* null *) end;
  35. if ch in printables then
  36.    if length(worker)>=maxlen then crt(BEEP) else
  37.    if numeric and (not(ch in numerics)) then crt(BEEP)
  38.    else begin if ch in lowercase then
  39.      if shift then ch:=chr(ord(ch)-32);
  40.      worker:=concat(worker,ch); gotoxy(x,y); write(worker); end
  41.    else case ord(ch) of
  42. 8  : if length(worker)<=0 then crt(BEEP) else begin
  43.      delete(worker,length(worker),1); gotoxy(x,y); write(worker);
  44.      if length(worker)<=(maxlen-1) then
  45.      write(chr(fldchar)); crt(LEFT); end;
  46. 13 : begin  cr:=TRUE; gotoxy(x,y); if (worker='') then s:=holder else
  47.      s:=worker; write(field); end;
  48. 24 : begin gotoxy(x,y); write(field); worker:=''; gotoxy(x,y); end;
  49. 27 : escape:=TRUE
  50.      ELSE crt(BEEP)  end;
  51. until cr or escape;
  52. if cr then begin if numeric then
  53. case getreal of
  54. TRUE    : val(worker,rvalue,error);
  55. FALSE    : val(worker,ivalue,error); end  end  else begin
  56. rvalue:=0.0; ivalue:=0  
  57. end;  
  58. end;
  59. E    : val(worker,rvalue,error);
  60. FALSE    : val(worker,ivalue,error); end  end  else beg