home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / utils / arc-lbr / lbrutil.lbr / DRTODATE.IZC / DRTODATE.INC
Text File  |  1986-12-27  |  1KB  |  32 lines
  1.   PROCEDURE drtodate(thedate : integer; VAR yr, mo, day : integer);
  2.   (* 1 Jan 1978 corresponds to Digital Research date = 1  *)
  3.   (* BUG - cannot handle negative values for dates > 2067 *)
  4.  
  5.     VAR
  6.       i, y1        : integer;
  7.       dayspermonth : ARRAY[1..12] OF 1..31;
  8.  
  9.     BEGIN (* drtodate *)
  10.     FOR i := 1 TO 12 DO dayspermonth[i] := 31;
  11.     dayspermonth[4] := 30; dayspermonth[6] := 30;
  12.     dayspermonth[9] := 30; dayspermonth[11] := 30;
  13.     IF thedate >= 731 THEN BEGIN (* avoid overflows *)
  14.       yr := 1980; thedate := thedate - 731; END
  15.     ELSE BEGIN
  16.       thedate := thedate + 730; yr := 1976; END;
  17.     (* 0..365=y0; 366..730=y1; 731..1095=y2; 1096..1460=y3 *)
  18.     i := thedate DIV 1461; thedate := thedate MOD 1461;
  19.     y1 := (thedate-1) DIV 365; yr := yr + y1 + 4*i;
  20.     IF y1 = 0 THEN (* leap year *) dayspermonth[2] := 29
  21.     ELSE BEGIN
  22.       thedate := thedate - 1; (* 366 -> 365 -> 1 Jan *)
  23.       dayspermonth[2] := 28; END;
  24.     day := thedate - 365*y1 + 1; mo := 1;
  25.     WHILE day > dayspermonth[mo] DO BEGIN
  26.       day := day - dayspermonth[mo];
  27.       mo := succ(mo); END;
  28.     END; (* drtodate *)
  29.  
  30.   (* 1-----------------1 *)
  31.  
  32. »s