home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOOL-INC.ZIP / DAYSAFTR.INC < prev    next >
Encoding:
Text File  |  1989-12-31  |  1.2 KB  |  63 lines
  1.  
  2. (* --------------------------------------------------------- *)
  3. procedure determine_last_date(days: integer);
  4.    (* determine first_date as n days before today *)
  5. var
  6.    year:    word;
  7.    month:   word;
  8.    day:     word;
  9.    dow:     word;
  10.  
  11.    procedure itoa2(i: integer; var sp);
  12.    var
  13.       s: array[1..2] of char absolute sp;
  14.    begin
  15.       s[1] := chr( (i div 10) + ord('0'));
  16.       s[2] := chr( (i mod 10) + ord('0'));
  17.    end;
  18.  
  19.  
  20. const
  21.    monthdays:  array[1..12] of integer =
  22.       (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
  23.  
  24. begin
  25.    { get today's date from DOS }
  26.    GetDate(year,month,day,dow);
  27.    year := year - 1900;
  28.  
  29.    { advance N days }
  30.    while (days > 0) do
  31.    begin
  32.       dec(days);
  33.  
  34.       if (day < monthdays[month]) then
  35.          inc(day)
  36.       else
  37.  
  38.       if (month < 12) then
  39.       begin
  40.          inc(month);
  41.          day := 1;
  42.       end
  43.       else
  44.  
  45.       begin
  46.          inc(year);
  47.          month := 1;
  48.          day := 1;
  49.       end;
  50.    end;
  51.  
  52.    { format the date for comparison }
  53.  { itoa2(year,firstdate[1]);
  54.    itoa2(month,firstdate[3]);
  55.    itoa2(day,firstdate[5]); }
  56.  
  57.    writeln('Final date is ',month,'-',day,'-',year);
  58. end;
  59.  
  60.  
  61.  
  62.  
  63.