Кто-нибудь пробовал написать функцию, возвращающую для определенной даты день недели? Моя функция как раз этим и занимается.
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; {Получает текущую дату и возвращает ее в формате YYYYMMDD для использования другими функциями данного молуля.} var
Year, Month, Day: Word; begin DecodeDate(Now, Year, Month, Day); result := IntToStr(year)+ IntToStr(Month) +IntToStr(day);end;
function Date2julian (date : string) : longint; {Получает дату в формате YYYYMMDD. Если у вас другой формат, в первую очередь преобразуйте его.} 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 + tcend;
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; {Получает значение и возвращает дату в формате 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; {Дата должна быть в формате YYYYMMDD.} var
julian : longint; test : string;begin {Сначала преобразовываем строку в юлианский формат даты. Это позволит получить необходимое значение.} julian := Date2julian(date); {Затем преобразовываем полученную величину в дату. Это всегда будет правильной датой. Для проверки делаем обратное преобразование. Результат проверки передаем как выходной параметр функции.} test := Julian2date(julian);
if date = test then
result := trueelse
result := false;end;
function DayOfTheWeek (date : string) :string; {Получаем дату в формате YYYYMMDD и возвращаем день недели.} var
julian : longint;begin julian := (Date2julian(date)) MOD 7;
case julian of 0 : result := 'Понедельник'; 1 : result := 'Вторник'; 2 : result := 'Среда'; 3 : result := 'Четверг'; 4 : result := 'Пятница'; 5 : result := 'Суббота'; 6 : result := 'Воскресенье'; end;end;
