[Back to DATETIME SWAG index] [Back to Main SWAG index] [Original]
unit dates;
{$O+}
{ EXDATE.PAS -- Turbo Pascal Extended Date Subroutines
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
const
days : array [0..6] of String[9] =
('Sunday','Monday','Tuesday',
'Wednesday','Thursday','Friday',
'Saturday');
months: array [0..11] of string[15] =
('January','February','March','April','May','June','July',
'August','September','October','November','December');
function today_day_of_week: integer;
function today_day: integer;
function today_month: integer;
function today_year: integer;
function day_of_week (day, month, year: integer) : integer;
function ordinal_day (day, month, year: integer) : integer;
function today_serial_day: longint;
procedure from_ordinal_day(ordinal_day, year: integer;var day, month: integer);
function valid_date(day, month, year: integer) : boolean;
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
uses dos;
function today_serial_day: longint;
begin
today_serial_day:=serial_day(today_day,today_month,today_year);
end;
function today_day_of_week: integer;
var m,d,y,dw: word;
begin
getdate(y,m,d,dw);
today_day_of_week := dw;
end;
function today_month: integer;
var m,d,y,dw: word;
begin
getdate(y,m,d,dw);
today_month := m;
end;
function today_day: integer;
var m,d,y,dw: word;
begin
getdate(y,m,d,dw);
today_day := d;
end;
function Today_year: integer;
var m,d,y,dw: word;
begin
getdate(y,m,d,dw);
today_year := y;
end;
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.
[Back to DATETIME SWAG index] [Back to Main SWAG index] [Original]