Code:

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 > 2then

month := month - 3

else

begin

month := month + 9;

year := year - 1;

end;

ta := 146097 * (year div100) div4;

tb := 1461 * (year mod100) div4;

tc := (153 * month + 2) div5 + 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;

{Получает значение и возвращает дату в формате YYYYMMDD}

var

 

x, y, d, m: longint;

month, day, year: integer;

begin

 

x := 4 * julian - 6884477;

y := (x div146097) * 100;

d := (x mod146097) div4;

x := 4 * d + 3;

y := (x div1461) + y;

d := (x mod1461) div4 + 1;

x := 5 * d - 3;

m := x div153 + 1;

d := (x mod153) div5 + 1;

if m < 11then

month := m + 2

else

month := m - 10;

day := d;

year := y + m div11;

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 := true

else

 

result := false;

end;

 

function DayOfTheWeek(date: string): string;

{Получаем дату в формате YYYYMMDD

и возвращаем день недели.}

var

 

julian: longint;

begin

julian := (Date2julian(date)) mod7;

 

case julian of

0: result := 'Понедельник';

1: result := 'Вторник';

2: result := 'Среда';

3: result := 'Четверг';

4: result := 'Пятница';

5: result := 'Суббота';

6: result := 'Воскресенье';

end;

end;

 

end.

 

Тем не менее, начиная со второй версии, Delphi содержат в своем арсенале замечательную функцию DayOfWeek, возвращающую целочисленный результат в диапазоне от 1 до 7. Вот пример кода, присланный Андреем Ивановым:

 

Code:

uses SysUtils;

...

 

function TForm1.DayOfWeekRus(S: TDateTime): string;

begin

case DayOfWeek(S) of

1: Result := 'Воскресенье';

2: Result := 'Понедельник';

3: Result := 'Вторник';

4: Result := 'Среда';

5: Result := 'Четверг';

6: Result := 'Пятница';

7: Result := 'Суббота';

end;

end;

 

 

 

https://delphiworld.narod

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

d: TDateTime;

begin

d := StrToDate(Edit1.Text);

ShowMessage(FormatDateTime('dddd',d));

end;

 

 

 

https://delphiworld.narod

DelphiWorld 6.0

 


 

Функции DayOfTheWeek и DayOfWeek (см. справку по Дельфи)

Вариант 1:

 

Code:

function WeekOfYear(ADate : TDateTime) : word;

var

day : word;

month : word;

year : word;

FirstOfYear : TDateTime;

begin

DecodeDate(ADate, year, month, day);

FirstOfYear := EncodeDate(year, 1, 1);

Result := Trunc(ADate - FirstOfYear) div7 + 1;

end;

 

 

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(IntToStr(WeekOfYear(Date)));

end;

 

 


Вариант 2:

 

Code:

function WeekNum(const ADate: TDateTime): word;

var

Year: word;

Month: word;

Day: word;

begin

DecodeDate(ADate + 4 - DayOfWeek(ADate + 6), Year, Month, Day);

result := 1 + trunc((ADate - EncodeDate(Year, 1, 5) +

DayOfWeek(EncodeDate(Year, 1, 3))) / 7);

end;

 

 


Вариант 3:

 

Code:

function WeekOfYear(Dat: TDateTime): Word;

// Интерпретация номеров дней:

// ISO: 1 = Понедельник, 7 = Воскресенье

// Delphi SysUtils: 1 = Воскресенье, 7 = Суббота

var

Day,

Month,

Year: Word;

FirstDate: TDateTime;

DateDiff : Integer;

begin

day := SysUtils.DayOfWeek(Dat)-1;

Dat := Dat + 3 - ((6 + day) mod7);

DecodeDate(Dat, Year, Month, Day);

FirstDate := EncodeDate(Year, 1, 1);

DateDiff := Trunc(Dat - FirstDate);

Result := 1 + (DateDiff div7);

end;

 

 

 

 

Взято из https://forum.sources

 

Получитьномернеделиподате

Code:

var

FirstWeekDay: Integer = 2;

{ Wochentag, mit dem die Woche beginnt

(siehe Delphi-Wochentage)

2 : Montag (nach DIN 1355) }

FirstWeekDate: Integer = 4;

{ 1 : Beginnt am ersten Januar

4 : Erste-4 Tage-Woche (nach DIN 1355)

7 : Erste volle Woche }

 

{ liefert das Datum des ersten Tages der Woche }

{ get date of first day of week}

function WeekToDate(AWeek, AYear: Integer): TDateTime;

begin

Result := EncodeDate(AYear, 1, FirstWeekDate);

Result := Result + (AWeek - 1) * 7 - ((DayOfWeek(Result) + (7 - FirstWeekDay)) mod7);

end;

 

{ liefert die Wochennummer und das Jahr, zu dem die Woche gehort }

{ get weeknumber and year of the given week number}

procedure DateToWeek(ADate: TDateTime; var AWeek, AYear: Word);

var

Month, Day: Word;

begin

ADate := ADate - ((DayOfWeek(ADate) - FirstWeekDay + 7) mod7) + 7 - FirstWeekDate;

DecodeDate(ADate, AYear, Month, Day);

AWeek := (Trunc(ADate - EncodeDate(AYear, 1, 1)) div7) + 1;

end;

 

 

{Week to date example}

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(FormatDateTime('dd.mm.yyyy', WeekToDate(51, 2000)));

end;

 

{Date to week example}

procedure TForm1.Button2Click(Sender: TObject);

var

week, year: Word;

begin

DateToWeek(now, week, year);

ShowMessage(IntToStr(week));

ShowMessage(IntToStr(year));

end;

 

Взято с сайта: https://www.swissdelphicenter