home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FORUM25C.ZIP / RANGES.SUB < prev    next >
Encoding:
Text File  |  1988-12-27  |  1.2 KB  |  54 lines
  1. Function minstr (blocks:integer):sstr;
  2. VAR min,sec:integer;
  3.     rsec:real;
  4.     ss:sstr;
  5. begin
  6.   rsec:=1.38 * blocks * (1200/baudrate);
  7.   min:=trunc (rsec/60.0);
  8.   sec:=trunc (rsec-(min*60.0));
  9.   ss:=strr(sec);
  10.   if length(ss)<2 then ss:='0'+ss;
  11.   minstr:=strr(min)+':'+ss
  12. end;
  13.  
  14. Procedure parserange (numents:integer; VAR f,l:integer);
  15. VAR rf,rl:mstr;
  16.     p,v1,v2:integer;
  17. begin
  18.   f:=0;
  19.   l:=0;
  20.   if numents<1 then exit;
  21.   repeat
  22.     writestr ('Range [1-'+strr(numents)+', CR=all, ?=help]:');
  23.     if input='?' then printfile (textfiledir+'Rangehlp');
  24.     if (length(input)>0) and (upcase(input[1])='Q') then exit
  25.   until (input<>'?') or hungupon;
  26.   if hungupon then exit;
  27.   if length(input)=0 then begin
  28.     f:=1;
  29.     l:=numents
  30.   end else begin
  31.     p:=pos('-',input);
  32.     v1:=valu(copy(input,1,p-1));
  33.     v2:=valu(copy(input,p+1,255));
  34.     if p=0 then begin
  35.       f:=v2;
  36.       l:=v2
  37.     end else if p=1 then begin
  38.       f:=1;
  39.       l:=v2
  40.     end else if p=length(input) then begin
  41.       f:=v1;
  42.       l:=numents
  43.     end else begin
  44.       f:=v1;
  45.       l:=v2
  46.     end
  47.   end;
  48.   if (f<1) or (l>numents) or (f>l) then begin
  49.     f:=0;
  50.     l:=0;
  51.     writestr ('Invalid range!')
  52.   end;
  53.   writeln (^B)
  54. end;