home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1986-03-11 | 1.5 KB | 52 lines |
- IMPLEMENTATION MODULE DateUtilities;
-
- FROM TimeDate IMPORT Time;
-
- VAR
- mnthtbl: ARRAY [1 .. 12] OF CARDINAL;
-
- PROCEDURE DayOfWeek(date: Time): CARDINAL;
- (* returns 0 = Sunday, ... 6 = Saturday*)
- BEGIN
- RETURN DayNum(date) MOD 7;
- END DayOfWeek;
-
- PROCEDURE DateDifference(First, Last: Time): CARDINAL;
- (* returns the numbers of days from first to last *)
- BEGIN
- RETURN DayNum(Last) - DayNum(First);
- END DateDifference;
-
- PROCEDURE SetDate(Year, Month, Day: CARDINAL; VAR Date: Time);
- (* set the date word of the timestamp *)
- (* 1900 < Year < 2100, 1 <= Month <= 12, 1 <= Day <= 31 *)
- BEGIN
- Date.day := (Year - 1900) * 512 + Month * 32 + Day;
- END SetDate;
-
- PROCEDURE DayNum(date: Time): CARDINAL;
- VAR
- Day, Month, Year: CARDINAL;
- BEGIN
- Day := date.day MOD 32;
- Month := date.day DIV 32 MOD 16;
- Year := date.day DIV 512;
- IF (Month > 2) & (Year MOD 4 = 0) THEN INC(Day) END;
- RETURN Day + mnthtbl[Month] + (Year * 365) + Year DIV 4;
- END DayNum;
-
- BEGIN
- mnthtbl[1] := 0; (* jan 31 *)
- mnthtbl[2] := 31; (* feb 28 or 29 *)
- mnthtbl[3] := 59; (* mar 31 *)
- mnthtbl[4] := 90; (* apr 30 *)
- mnthtbl[5] := 120; (* may 31 *)
- mnthtbl[6] := 151; (* jun 30 *)
- mnthtbl[7] := 181; (* jul 31 *)
- mnthtbl[8] := 212; (* aug 31 *)
- mnthtbl[9] := 243; (* sep 30 *)
- mnthtbl[10] := 273;(* oct 31 *)
- mnthtbl[11] := 304;(* nov 30 *)
- mnthtbl[12] := 334;(* dec 31 *)
- END DateUtilities.
-