FUNCTION keystat(VAR ch:char):boolean;
BEGIN  ch:=chr(BDOS(6,255)); keystat:=ch<>chr(0); END;


PROCEDURE getstring(x,y:integer; 
                  VAR s:midstr; 
                 maxlen:integer;
  shift,numeric,getreal:boolean; 
             VAR rvalue:real;
                  ndigs:integer; 
             VAR ivalue:integer; 
             VAR  error:integer;
             VAR escape:boolean);

CONST   fldchar=127;

VAR       ch                 :char; 
          field,worker,holder:midstr; 
                           cr:boolean;
printables,lowercase,numerics:set of char;

BEGIN holder:=''; printables:=[' '..'}']; lowercase:=['a'..'z']; 
if getreal then numerics:=['+','-','.','0'..'9','E','e']
else numerics:=['-','0'..'9']; 
cr:=FALSE;  escape:=FALSE; fillchar(field,sizeof(field),chr(fldchar)); 
field[0]:=chr(maxlen);
if numeric then if getreal then str(rvalue:1:ndigs,s)
   else str(ivalue:1,s);
if (s<'1') or (s<'1.0') then s:='';
if length(s) > maxlen then s[0]:=chr(maxlen);
gotoxy(x,y); write(field); gotoxy(x,y); write(s); gotoxy(x,y);
holder:=s; worker:='';
repeat
while not keystat(ch) do begin (* null *) end;
if ch in printables then
   if length(worker)>=maxlen then crt(BEEP) else
   if numeric and (not(ch in numerics)) then crt(BEEP)
   else begin if ch in lowercase then
     if shift then ch:=chr(ord(ch)-32);
     worker:=concat(worker,ch); gotoxy(x,y); write(worker); end
   else case ord(ch) of
8  : if length(worker)<=0 then crt(BEEP) else begin
     delete(worker,length(worker),1); gotoxy(x,y); write(worker);
     if length(worker)<=(maxlen-1) then
     write(chr(fldchar)); crt(LEFT); end;
13 : begin  cr:=TRUE; gotoxy(x,y); if (worker='') then s:=holder else
     s:=worker; write(field); end;
24 : begin gotoxy(x,y); write(field); worker:=''; gotoxy(x,y); end;
27 : escape:=TRUE
     ELSE crt(BEEP)  end;
until cr or escape;
if cr then begin if numeric then
case getreal of
TRUE	: val(worker,rvalue,error);
FALSE	: val(worker,ivalue,error); end  end  else begin
rvalue:=0.0; ivalue:=0  
end;  
end;