Daynumber

From: johan@lindgren.pp.se

Someone asked for a function to return the daynumber.

This is my routines for such.

unit datefunc;

interface

function checkdate (date : string) :boolean;

function Date2julian (date : string) : longint;

function Julian2date (julian : longint) : string;

function DayOfTheWeek (date : string) :string;

function idag : string;

implementation

uses

sysutils;

function idag () : string;

{Retrieves the current date and returns it in the form YYYYMMDD to be used

in the other functions in this unit.}

var

Year, Month, Day: Word;

begin

DecodeDate(Now, Year, Month, Day);

result := IntToStr(year)+ IntToStr(Month) +IntToStr(day);

end;

function Date2julian (date : string) : longint;

{Assumes the date in format YYYYMMDD.

If you have another format. Make a routine to

convert it first.}

var

month,day,year:integer;

ta,tb,tc : longint;

begin

month := strtoint(copy(date,5,2));

day := strtoint(copy(date,7,2));

year := strtoint(copy(date,1,4));

if month > 2 then

month := month - 3

else

begin

month := month + 9;

year := year - 1;

end;

ta := 146097 * (year div 100) div 4;

tb := 1461 * (year MOD 100) div 4;

tc := (153 * month + 2) div 5 + day + 1721119;

result := ta + tb + tc

end;

function mdy2date (month, day, year : integer) : string;

var

y,m,d : string;

begin

y := '000'+inttostr(year);

y := copy(y,length(y)-3,4);

m := '0'+inttostr(month);

m := copy(m,length(m)-1,2);

d := '0'+inttostr(day);

d := copy(d,length(d)-1,2);

result := y+m+d;

end;

function Julian2date (julian : longint) : string;

{Takes a value and returns a date in the form YYYYMMDD}

var

x,y,d,m : longint;

month,day,year : integer;

begin

x := 4 * julian - 6884477;

y := (x div 146097) * 100;

d := (x MOD 146097) div 4;

x := 4 * d + 3;

y := (x div 1461) + y;

d := (x MOD 1461) div 4 + 1;

x := 5 * d - 3;

m := x div 153 + 1;

d := (x MOD 153) div 5 + 1;

if m < 11 then

month := m + 2

else

month := m - 10;

day := d;

year := y + m div 11;

result := mdy2date(month, day, year);

end;

function checkdate (date : string) :boolean;

{Date must be in the form YYYYMMDD.}

var

julian : longint;

test : string;

begin

{First convert the datestring to julian single format.

This will always produce a value.}

julian := Date2julian(date);

{Then convert the value to a date.

This will always be a valid date. But if it is not the same

as date that was not a valid date.}

test := Julian2date(julian);

if date = test then

result := true

else

result := false;

end;

function DayOfTheWeek (date : string) :string;

{Takes a date in the form YYYYMMDD

Returns the weekday.}

var

julian : longint;

begin

julian := (Date2julian(date)) MOD 7;

case julian of

0 : result := 'Monday';

1 : result := 'Tuesday';

2 : result := 'Wednesday';

3 : result := 'Thursday';

4 : result := 'Friday';

5 : result := 'Saturday';

6 : result := 'Sunday';

end;

end;

end.