Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/EXDATE.ZIP/EXDATE.PAS

Pascal/Delphi Source File | 1988-01-04 | 6.9 KB | 214 lines

unit exdate;

{      EXDATE.PAS  -- Turbo Pascal Extended Date Subroutines

       Author: Ted Lassagne
               Cor Communications
               P. O. Box 1587
               Cupertino, CA  95015
               (Compuserve 70325,206)

 This is a collection of useful calendar date subroutines which are
 valid from October 15, 1582 until such time as the Gregorian calendar
 is replaced.  Note that Great Britain did not change to the Gregorian
 calendar until 1752, Russia until 1918, and Turkey until 1928.  (These
 routines will work until the year 32767; after that, you will need
 to replace ints with longints.)

 The day of the week algorithm derivation is described very well in
 Rosen's "Elementary Number Theory and Its Applications" (Addison-Wesley,
 1984, pp 134-137).  The ordinal day algorithms are derived using
 reasoning similar to that of Rosen's derivation.  The serial day
 algorithms are based upon Julian day algorithms in Algorithm 199
 by Robert G. Tantzen in Communications of the ACM  6, 8 (Aug 1963),
 page 444.}

{==================================================================}

                         INTERFACE

function day_of_week (day, month, year: integer) : integer;
{Returns integer day of week for date.  0 = Sunday, 6 = Saturday}


function ordinal_day (day, month, year: integer) : integer;
{Returns ordinal day of year (1-366) for date}

procedure from_ordinal_day (ordinal_day, year: integer;
    var day, month: integer);
{Returns day and month for ordinal_day of a year}


function valid_date(day, month, year: integer) : boolean;
{Returns true if day, month, year represent a valid date}


function day_diff(day_1, month_1, year_1, day_2, month_2, year_2: integer)
   : longint;
{Returns the number of days between two dates, the first date being denoted
 by day_1, month_1, year_1, and the second by day_2, month_2, year_2.
 A negative value means that the second date is earlier than the first date.}

procedure days_from(day, month, year, days: integer;
    var new_day, new_month, new_year: integer);
{Returns a date (new_day, new_month, new_year) which is a specified number
 of days (days) from a given date (day, month, year).   The number of days
 may be positive or negative.}


  {The following auxiliary procedures are in the interface just in case
   they may be useful for other purposes.}

function leap_year(year: integer) : integer;
   { Returns 1 for a leap year and 0 for others }

function serial_day(day, month, year: integer) : longint;
{Converts a date to a "serial day" for performing calendar arithmetic.
 The serial day is the classic Julian date less 1721119.}

procedure from_serial_day (serial_day: longint;
    var day, month, year:integer);
{Returns the day, month, year corresponding to a "serial day".}

{==================================================================}

                        IMPLEMENTATION

function day_of_week (day, month, year: integer) : integer;
{Returns integer day of week for date.  0 = Sunday, 6 = Saturday
 Uses Zeller's congruence.}
   var century, yr, dw: integer;
   begin
      if month < 3 then begin
         month := month + 10;
         year := year -1
         end
      else
         month := month - 2;
      century := year div 100;
      yr := year mod 100;
      dw := (((26*month - 2) div 10)+day+yr+(yr div 4)+
         (century div 4) - (2*century)) mod 7;
      if dw < 0 then day_of_week := dw + 7 else day_of_week := dw;
   end;



function leap_year(year: integer) : integer;
   { Returns 1 for a leap year and 0 for others }
   begin
   if year and 3 <> 0 then leap_year := 0
   else if year mod 100 <> 0 then leap_year := 1
   else if year mod 400 <> 0 then leap_year := 0
   else leap_year := 1;
   end;

function ordinal_day (day, month, year: integer) : integer;
{Returns ordinal day of year (1-366) for date}
   var od: integer;
   begin
   if month < 3 then
      month := month + 10
   else
      month := month - 2;
   od := (306 * month - 2) div 10 - 30;
   if od < 306 then
      ordinal_day := od + 59 + leap_year(year) + day
   else
      ordinal_day := od - 306 + day;
   end;

procedure from_ordinal_day (ordinal_day, year: integer;
    var day, month: integer);
{Returns day and month for ordinal day of a year}
   var lyf, adj_mo: integer;
   begin
   lyf := leap_year(year) + 60;
   if ordinal_day < lyf then
      ordinal_day := ordinal_day + 305
   else
      ordinal_day := ordinal_day - lyf;
   adj_mo := (ordinal_day * 10 + 4) div 306 + 1;
   day := ordinal_day - ((adj_mo * 306 - 2) div 10 - 30) + 1;
   if adj_mo < 11 then
      month := adj_mo + 2
   else
      month := adj_mo - 10;
   end;

function valid_date(day, month, year: integer) : boolean;
{Determines whether a date is valid by transforming to an ordinal and
 trying to transform it back again.}
   var od, m, d: integer;
   begin
   od := ordinal_day(day, month, year);
   if (od > 366) or (od < 1) then
      valid_date := false
   else begin
      from_ordinal_day(od, year, d, m);
      if (d = day) and (m = month) then valid_date := true
      else valid_date := false
   end;
   end;

function serial_day(day, month, year: integer) : longint;
{Converts a date to a "serial day" for performing calendar arithmetic.
 The serial day is the classic Julian date less 1721119.}
var  m, y : longint;
   begin
      if month > 2 then begin
         m := month - 3;
         y := year;
      end
      else begin
         m := month + 9;
         y := year - 1;
      end;

      serial_day :=
         ((y div 100) * 146097) div 4 +
         ((y mod 100) * 1461) div 4 +
         (153 * m + 2) div 5 + day;
   end;

function day_diff(day_1, month_1, year_1, day_2, month_2, year_2: integer)
   : longint;
{Returns the number of days between two dates. A negative value means that the
 second date is earlier than the first date.}
   begin
   day_diff := serial_day(day_2, month_2, year_2) -
      serial_day(day_1, month_1, year_1);
   end;

procedure from_serial_day (serial_day: longint;
    var day, month, year:integer);
{Returns the date corresponding to a "serial day".}
   var j, d : longint;
   begin
      j := serial_day * 4 - 1;
      d := ((j mod 146097) div 4) * 4 + 3;
      year := (j div 146097) * 100 + (d div 1461);
      d := (((d mod 1461) + 4) div 4) * 5 - 3;
      month := d div 153;
      day := ((d mod 153) + 5) div 5;

      if month < 10 then
         month := month + 3
      else begin
         month := month - 9;
         year := year + 1;
      end;
   end;

procedure days_from(day, month, year, days: integer; var new_day,
      new_month, new_year: integer);
{Returns a date which is a specified number of days from a given date.
 The number of days may be positive or negative.}
   begin
   from_serial_day(serial_day(day, month, year) + days,
      new_day, new_month, new_year);
   end;

begin
end.