Code:

// Колическтво дней в любом месяце любого

// года можно получить с помощью EndOfAMonth

var

YYYY, MM, DD: Word;

D: TDateTime;

begin

DecodeDate(Date, YYYY, MM, DD);

D := EndOfAMonth(YYYY, {Номер месяца});

DecodeDate(D, YYYY, MM, DD); // DD - номер последнего дня в месяце

end;

Code:

function DaysOfMonth(mm, yy: Integer): Integer;

begin

if mm = 2then

begin

Result := 28;

if IsLeapYear(yy) then Result := 29;

end

else

begin

if mm < 8then

begin

if (mm mod2) = 0then

Result := 30

else

Result := 31;

end

else

begin

if (mm mod2) = 0then

Result := 31

else

Result := 30;

end;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

days: Integer;

begin

days := DaysOfMonth(7, 2001);

ShowMessage('July 2001 has ' + IntToStr(days) + ' days');

end;

Code:

function LastDayOfCurrentMonth: TDate;

var

y, m, d: Word;

begin

DecodeDate(now, y, m, d);

m := m + 1;

if m 12then

begin

y := y + 1;

m := 1;

end;

Result := EncodeDate(y, m, 1) - 1;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ShowMessage(DateToStr(LastDayOfCurrentMonth));

end;

Code:

function GetDays(ADate: TDate): Extended;

var

FirstOfYear: TDateTime;

begin

FirstOfYear := EncodeDate(StrToInt(FormatDateTime('yyyy', now)) - 1, 12, 31);

Result := ADate - FirstOfYear;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

label1.Caption := 'Today is the ' + FloatToStr(GetDays(Date)) + '. day of the year';

end;

Code:

function julian(year, month, day: Integer): real;

var

yr, mth: Integer;

noleap, leap, days, yrs: Real;

begin

if year < 0then yr := year + 1else yr := year;

mth := month;

if (month < 3) then

begin

mth := mth + 12;

yr := yr - 1;

end;

yrs := 365.25 * yr;

if ((yrs < 0) and (frac(yrs) <> 0)) then yrs := int(yrs) - 1else yrs := int(yrs);

days := int(yrs) + int(30.6001 * (mth + 1)) + day - 723244.0;

if days < -145068.0then julian := days

else

begin

yrs := yr / 100.0;

if ((yrs < 0) and (frac(yrs) <> 0)) then yrs := int(yrs) - 1;

noleap := int(yrs);

yrs := noleap / 4.0;

if ((yrs < 0) and (frac(yrs) <> 0)) then yrs := int(yrs) - 1;

leap := 2 - noleap + int(yrs);

julian := days + leap;

end;

end;

Code:

function Persia_to_Ger_date(aa: ShortString; ResultKind: Byte = 0): ShortString;

function TrueTo1(co: Boolean): Integer;

begin

if co then TrueTo1 := 1

else

TrueTo1 := 0;

end;

const

Conm_mons: array[0..11] of Byte = (31,28,31,30,31,30,31,31,30,31,30,31);

LeapYearSh: array[0..4] of Integer = (1375,1379,1383,1387,1391);

LeapYearMi: array[0..4] of Integer = (1996,2000,2004,2008,2012);

monthes: array[0..11] of ShortString = ('Jan', 'Feb', 'Mar', 'Apr',

'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');

type

date = record

da_day, da_mon, da_year: Integer;

end;

var

m_mons: array[0..11] of BYTE;

LastDayCountSh, LastDayCountMi: integer;

a, b: date;

sYY, sMM, sDD: ShortString;

I: Integer;

begin

for I := Low(Conm_mons) to High(Conm_mons) do

m_mons[I] := Conm_mons[I];

a.da_day := StrToNum(Copy(aa, DayPosInDate, DayLen));

a.da_mon := StrToNum(Copy(aa, MonthPosInDate, MonthLen));

a.da_year := StrToNum(Copy(aa, YearPosInDate, YearLen));

b.da_year := a.da_year + 621;

Inc(b.da_year, TrueTo1(((a.da_mon > 10) or ((a.da_mon = 10) and (a.da_day >= 12)))

or ((LeapYearSh[(a.da_year - 1374) div4] <> a.da_year) and

((a.da_mon = 10) and (a.da_day = 11)))));

Inc(m_mons[1], TrueTo1(LeapYearMi[(b.da_year - 1996) div4] = b.da_year));

if (a.da_mon <= 7) then LastDayCountSh := ((a.da_mon - 1) * 31 + a.da_day)

else

LastDayCountSh := (186 + (a.da_mon - 7) * 30 + a.da_day);

if (b.da_year = (a.da_year + 622)) then LastDayCountMi :=

LastDayCountSh - 286 - TrueTo1(LeapYearSh[(a.da_year - 1375) div4] = a.da_year)

else

LastDayCountMi := (LastDayCountSh + 79);

b.da_day := LastDayCountMi;

b.da_mon := 0;

while (LastDayCountMi > m_mons[b.da_mon]) do

begin

Dec(LastDayCountMi, m_mons[b.da_mon]);

Inc(b.da_mon);

b.da_day := LastDayCountMi;

end;

Inc(b.da_mon);

if b.da_year < 1000then sYY := sYY + '0';

if b.da_year < 100then sYY := sYY + '0';

if b.da_year < 10then sYY := sYY + '0';

sYY := sYY + IntToStr(b.da_year);

if b.da_mon < 10then sMM := sMM + '0';

sMM := sMM + IntToStr(b.da_mon);

if b.da_day < 10then sDD := sDD + '0';

sDD := sDD + IntToStr(b.da_day);

case ResultKind of

0: Persia_to_Ger_date := sYY + '/' + sMM + '/' + sDD;

1: Persia_to_Ger_date := sYY + ' ' + monthes[b.da_mon - 1] + ' ' + sDD;

end;

end;

Code:

const

UnixDateDelta = 25569; { 1970-01-01T00:00:00,0 }

SecPerMin = 60;

SecPerHour = SecPerMin * 60;

SecPerDay = SecPerHour * 24;

MinDayFraction = 1 / (24 * 60);

{Convert Unix time to TDatetime}

function UnixTimeToDateTime(AUnixTime: DWord; ABias: Integer): TDateTime;

begin

Result := UnixDateDelta + (AUnixTime div SecPerDay) { Days }

+ ((AUnixTime mod SecPerDay) / SecPerDay) { Seconds }

- ABias * MinDayFraction { Bias to UTC in minutes };

end;

{Convert Unix time to String with locale settings}

function UnixTimeToStr(AUnixTime: DWord; ABias: Integer): string;

begin

Result := FormatDateTime('ddddd hh:nn:ss', UnixTimeToDateTime(AUnixTime, ABias));

end;

{Convert TDateTime to Unix time}

function DateTimeToUnixTime(ADateTime: TDateTime; ABias: Integer): DWord;

begin

Result := Trunc((ADateTime - UnixDateDelta) * SecPerDay) + ABias * SecPerMin;

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

Label1.Caption := UnixTimeToStr(977347109, -60);

end;

Code:

function DateExists(Date: string; Separator: char): Boolean;

var

OldDateSeparator: Char;

begin

Result := True;

OldDateSeparator := DateSeparator;

DateSeparator := Separator;

try

try

StrToDate(Date);

except

Result := False;

end;

finally

DateSeparator := OldDateSeparator;

end;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

if DateExists('35.3.2001', '.') then

begin

{your code}

end;

end;

Code:

function ValidDate(const S: String): Boolean;

BEGIN

Result := True;

try

StrToDate(S);

except

ON EConvertError DO

Result := False;

end;

END

Code:

program sunproject;

uses

Forms,

main in'main.pas'{Sun};

{$R *.RES}

begin

Application.Initialize;

Application.Title := 'Sun';

Application.CreateForm(TSun, Sun);

Application.Run;

end.

Code:

object Sun: TSun

Left = 210

Top = 106

BorderIcons = [biSystemMenu, biMinimize]

BorderStyle = bsSingle

Caption = 'Sun'

ClientHeight = 257

ClientWidth = 299

Color = clBtnFace

Font.Charset = DEFAULT_CHARSET

Font.Color = clWindowText

Font.Height = -11

Font.Name = 'MS Sans Serif'

Font.Style = []

OldCreateOrder = False

Position = poDesktopCenter

OnCreate = CreateForm

PixelsPerInch = 96

TextHeight = 13

object GroupBoxInput: TGroupBox

Left = 4

Top = 4

Width = 173

Height = 93

Caption = ' Ввод '

TabOrder = 0

object LabelLongitude: TLabel

Left = 35

Top = 44

Width = 78

Height = 13

Alignment = taRightJustify

Caption = 'Долгота (град):'

end

object LabelTimeZone: TLabel

Left = 13

Top = 68

Width = 100

Height = 13

Alignment = taRightJustify

Caption = 'Часовая зона (час):'

end

object LabelAtitude: TLabel

Left = 40

Top = 20

Width = 73

Height = 13

Alignment = taRightJustify

Caption = 'Широта (град):'

end

object EditB5: TEdit

Tag = 1

Left = 120

Top = 16

Width = 37

Height = 21

TabOrder = 0

Text = '0'

end

object EditL5: TEdit

Tag = 2

Left = 120

Top = 40

Width = 37

Height = 21

TabOrder = 1

Text = '0'

end

object EditH: TEdit

Tag = 3

Left = 120

Top = 64

Width = 37

Height = 21

TabOrder = 2

Text = '0'

end

end

object GroupBoxCalendar: TGroupBox

Left = 184

Top = 4

Width = 109

Height = 93

Caption = ' Календарь '

TabOrder = 1

object LabelD: TLabel

Left = 19

Top = 20

Width = 30

Height = 13

Alignment = taRightJustify

Caption = 'День:'

end

object LabelM: TLabel

Left = 13

Top = 44

Width = 36

Height = 13

Alignment = taRightJustify

Caption = 'Месяц:'

end

object LabelY: TLabel

Left = 28

Top = 68

Width = 21

Height = 13

Alignment = taRightJustify

Caption = 'Год:'

end

object EditD: TEdit

Tag = 1

Left = 56

Top = 16

Width = 37

Height = 21

TabOrder = 0

Text = '0'

end

object EditM: TEdit

Tag = 2

Left = 56

Top = 40

Width = 37

Height = 21

TabOrder = 1

Text = '0'

end

object EditY: TEdit

Tag = 3

Left = 56

Top = 64

Width = 37

Height = 21

TabOrder = 2

Text = '0'

end

end

object ButtonCalc: TButton

Left = 12

Top = 227

Width = 169

Height = 25

Caption = '&Вычислить'

TabOrder = 2

OnClick = ButtonCalcClick

end

object ListBox: TListBox

Left = 4

Top = 104

Width = 289

Height = 117

ItemHeight = 13

TabOrder = 3

end

object ButtonClear: TButton

Left = 192

Top = 227

Width = 91

Height = 25

Caption = '&Очистить'

TabOrder = 4

OnClick = ButtonClearClick

end

end

Code:

{

Программа вычисляет время восхода и захода

солнца по дате (с точностью до минуты) в пределах

нескольких текущих столетий. Производит корректировку, если

географическая

точка находится в арктическом или антарктическом регионе, где заход

или восход солнца

на текущую дату может не состояться. Вводимые данные: положительная

северная широта и

отрицательная западная долгота. Часовой пояс указывается относительно

Гринвича

(например, 5 для EST и 4 для EDT). Алгоритм обсуждался в

"Sky & Telescope" за август 1994, страница 84.

}

unit main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs,

StdCtrls;

type

TSun = class(TForm)

GroupBoxInput: TGroupBox;

LabelLongitude: TLabel;

EditB5: TEdit;

EditL5: TEdit;

LabelTimeZone: TLabel;

EditH: TEdit;

GroupBoxCalendar: TGroupBox;

LabelD: TLabel;

LabelM: TLabel;

LabelY: TLabel;

EditD: TEdit;

EditM: TEdit;

EditY: TEdit;

ButtonCalc: TButton;

ListBox: TListBox;

ButtonClear: TButton;

LabelAtitude: TLabel;

procedure Calendar; // Календарь

procedure GetTimeZone; // Получение часового пояса

procedure PosOfSun; // Получаем положение солнца

procedure OutInform; // Процедура вывода информации

procedure PossibleEvents(Hour: integer); // Возможные события на

полученный час

procedure GetDate; //Получить значения даты

procedure GetInput; //Получить значения широты,...

procedure ButtonCalcClick(Sender: TObject);

procedure CreateForm(Sender: TObject);

procedure ButtonClearClick(Sender: TObject);

private

function Sgn(Value: Double): integer; // Сигнум

public

{ Public declarations }

end;

var

Sun: TSun;

st: string;

aA, aD: array[1..2] of double;

B5: integer;

L5: double;

H: integer;

Z, Z0, Z1: double;

D: double;

M, Y: integer;

A5, D5, R5: double;

J3: integer;

T, T0, TT, T3: double;

L0, L2: double;

H0, H1, H2, H7, N7, D7: double;

H3, M3: integer;

M8, W8: double;

A, B, A0, D0, A2, D1, D2, DA, DD: double;

E, F, J, S, C, P, L, G, V, U, W: double;

V0, V1, V2: double;

C0: integer;

AZ: double;

const

P2 = Pi * 2; // 2 * Pi

DR = Pi / 180; // Радиан на градус

K1 = 15 * DR * 1.0027379;

implementation

{$R *.DFM}

function TSun.Sgn(Value: Double): integer;

begin

{if Value = 0 then} Result := 0;

if Value > 0then

Result := 1;

if Value < 0then

Result := -1;

end;

procedure TSun.Calendar;

begin

G := 1;

if Y < 1583then

G := 0;

D1 := Trunc(D);

F := D - D1 - 0.5;

J := -Trunc(7 * (Trunc((M + 9) / 12) + Y) / 4);

if G = 1then

begin

S := Sgn(M - 9);

A := Abs(M - 9);

J3 := Trunc(Y + S * Trunc(A / 7));

J3 := -Trunc((Trunc(J3 / 100) + 1) * 3 / 4);

end;

J := J + Trunc(275 * M / 9) + D1 + G * J3;

J := J + 1721027 + 2 * G + 367 * Y;

if F >= 0then

Exit;

F := F + 1;

J := J - 1;

end;

procedure TSun.GetTimeZone;

begin

T0 := T / 36525;

S := 24110.5 + 8640184.813 * T0;

S := S + 86636.6 * Z0 + 86400 * L5;

S := S / 86400;

S := S - Trunc(S);

T0 := S * 360 * DR;

end;

procedure TSun.PosOfSun;

begin

// Фундаментальные константы

// (Van Flandern & Pulkkinen, 1979)

L := 0.779072 + 0.00273790931 * T;

G := 0.993126 + 0.0027377785 * T;

L := L - Trunc(L);

G := G - Trunc(G);

L := L * P2;

G := G * P2;

V := 0.39785 * Sin(L);

V := V - 0.01000 * Sin(L - G);

V := V + 0.00333 * Sin(L + G);

V := V - 0.00021 * TT * Sin(L);

U := 1 - 0.03349 * Cos(G);

U := U - 0.00014 * Cos(2 * L);

U := U + 0.00008 * Cos(L);

W := -0.00010 - 0.04129 * Sin(2 * L);

W := W + 0.03211 * Sin(G);

W := W + 0.00104 * Sin(2 * L - G);

W := W - 0.00035 * Sin(2 * L + G);

W := W - 0.00008 * TT * Sin(G);

// Вычисление солнечных координат

S := W / Sqrt(U - V * V);

A5 := L + ArcTan(S / Sqrt(1 - S * S));

S := V / Sqrt(U);

D5 := ArcTan(S / Sqrt(1 - S * S));

R5 := 1.00021 * Sqrt(U);

end;

procedure TSun.PossibleEvents(Hour: integer);

var

num: string;

begin

st := '';

L0 := T0 + Hour * K1;

L2 := L0 + K1;

H0 := L0 - A0;

H2 := L2 - A2;

H1 := (H2 + H0) / 2; // Часовой угол,

D1 := (D2 + D0) / 2; // наклон в получасе

if Hour <= 0then

V0 := S * Sin(D0) + C * Cos(D0) * Cos(H0) - Z;

V2 := S * Sin(D2) + C * Cos(D2) * Cos(H2) - Z;

if Sgn(V0) = Sgn(V2) then

Exit;

V1 := S * Sin(D1) + C * Cos(D1) * Cos(H1) - Z;

A := 2 * V2 - 4 * V1 + 2 * V0;

B := 4 * V1 - 3 * V0 - V2;

D := B * B - 4 * A * V0;

if D < 0then

Exit;

D := Sqrt(D);

if (V0 < 0) and (V2 > 0) then

st := st + 'Восход солнца в ';

if (V0 < 0) and (V2 > 0) then

M8 := 1;

if (V0 > 0) and (V2 < 0) then

st := st + 'Заход солнца в ';

if (V0 > 0) and (V2 < 0) then

W8 := 1;

E := (-B + D) / (2 * A);

if (E > 1) or (E < 0) then

E := (-B - D) / (2 * A);

T3 := Hour + E + 1 / 120; // Округление

H3 := Trunc(T3);

M3 := Trunc((T3 - H3) * 60);

Str(H3: 2, num);

st := st + num + ':';

Str(M3: 2, num);

st := st + num;

H7 := H0 + E * (H2 - H0);

N7 := -Cos(D1) * Sin(H7);

D7 := C * Sin(D1) - S * Cos(D1) * COS(H7);

AZ := ArcTan(N7 / D7) / DR;

if (D7 < 0) then

AZ := AZ + 180;

if (AZ < 0) then

AZ := AZ + 360;

if (AZ > 360) then

AZ := AZ - 360;

Str(AZ: 4: 1, num);

st := st + ', азимут ' + num;

end;

procedure TSun.OutInform;

begin

if (M8 = 0) and (W8 = 0) then

begin

if V2 < 0then

ListBox.Items.Add('Солнце заходит весь день ');

if V2 > 0then

ListBox.Items.Add('Солнце восходит весь день ');

end

else

begin

if M8 = 0then

ListBox.Items.Add('В этот день солнце не восходит ');

if W8 = 0then

ListBox.Items.Add('В этот день солнце не заходит ');

end;

end;

procedure TSun.GetDate;

begin

D := StrToInt(EditD.text);

M := StrToInt(EditM.text);

Y := StrToInt(EditY.text);

end;

procedure TSun.GetInput;

begin

B5 := StrToInt(EditB5.Text);

L5 := StrToInt(EditL5.Text);

H := StrToInt(EditH.Text);

end;

procedure TSun.ButtonCalcClick(Sender: TObject);

var

C0: integer;

begin

GetDate;

GetInput;

ListBox.Items.Add('Широта: ' + EditB5.Text +

' Долгота: ' + EditL5.Text +

' Зона: ' + EditH.Text +

' Дата: ' + EditD.Text +

'/' + EditM.Text +

'/' + EditY.Text);

L5 := L5 / 360;

Z0 := H / 24;

Calendar;

T := (J - 2451545) + F;

TT := T / 36525 + 1; // TT - столетия, начиная с 1900.0

GetTimeZone; // Получение часового пояса

T := T + Z0;

PosOfSun; // Получаем положение солнца

aA[1] := A5;

aD[1] := D5;

T := T + 1;

PosOfSun;

aA[2] := A5;

aD[2] := D5;

if aA[2] < aA[1] then

aA[2] := aA[2] + P2;

Z1 := DR * 90.833; // Вычисление зенита

S := Sin(B5 * DR);

C := Cos(B5 * DR);

Z := Cos(Z1);

M8 := 0;

W8 := 0;

A0 := aA[1];

D0 := aD[1];

DA := aA[2] - aA[1];

DD := aD[2] - aD[1];

for C0 := 0to23do

begin

P := (C0 + 1) / 24;

A2 := aA[1] + P * DA;

D2 := aD[1] + P * DD;

PossibleEvents(C0);

if st <> ''then

ListBox.Items.Add(st);

A0 := A2;

D0 := D2;

V0 := V2;

end;

OutInform;

ListBox.Items.Add(''); // Разделяем данные

end;

procedure TSun.CreateForm(Sender: TObject);

begin

EditD.Text := FormatDateTime('d', Date);

EditM.Text := FormatDateTime('m', Date);

EditY.Text := FormatDateTime('yyyy', Date);

end;

procedure TSun.ButtonClearClick(Sender: TObject);

begin

ListBox.Clear;

end;

end.

Code:

const year = 2002; // Год календаря

var months: array [1..12] of byte;

procedure TForm1.FormCreate(Sender: TObject);

begin

Form1.Caption := 'Календарь на ' + IntToStr(year) + ' год';

Form1.Color := clWhite;

// Длины месяцев:

months[1] := 31;

months[2] := 28 + ord(IsLeapYear(year));

months[3] := 31;

months[4] := 30;

months[5] := 31;

months[6] := 30;

months[7] := 31;

months[8] := 31;

months[9] := 30;

months[10] := 31;

months[11] := 30;

months[12] := 31;

end;

procedure TForm1.FormPaint(Sender: TObject);

const// Настройки размеров календаря:

MonthDX = 150;

MonthDY = 135;

DayDX = 20;

DayDY = 15;

MonthH = 20;

var

month, i: integer;

day: integer;

s: string[2];

begin

with Form1.Canvas dofor month := 1to12dobegin

// Вывод названия месяца:

Font.Name := 'Times';

Font.Size := 13;

TextOut((month - 1) mod3 * MonthDX, (month - 1) div3 * MonthDY,

LongMonthNames[month]);

Font.Name := 'Courier';

Font.Size := 8;

// Вывод названий дней недели:

for day := 1to7do

TextOut((month - 1) mod3 * MonthDX,

day mod7 * DayDY + (month - 1) div3 * MonthDY + MonthH,

ShortDayNames[(day + 1) mod7 + 1]);

// Определение дня недели первого числа месяца:

day := DayOfWeek(EncodeDate(year, month, 1)) - 2;

if day < 0then inc(day, 7);

// Вывод чисел:

for i := 1to months[month] dobegin

str(i: 2, s);

TextOut(day div7 * DayDX + (month - 1) mod3 * MonthDX + DayDX,

day mod7 * DayDY + (month - 1) div3 * MonthDY + MonthH, s);

inc(day);

end;

end;

end;

Code:

{

Data sometimes have to be filtered regarding to working

days (Mo.-Fri.) of the current Week. Following procs set

your TDateTimePicker automatically.

}

function GetMonday(RefDay: TDate): TDate;

var

DoW: Integer;

DateOffset: Integer;

begin

DoW := DayOfWeek(RefDay);

// Montag der Woche

if DoW = 1then DateOffset := -6

else

DateOffset := Dow - 2;

Result := RefDay - DateOffset;

end;

function GetFriday(RefDay: TDate): TDate;

var

DoW: Integer;

DateOffset: Integer;

begin

DoW := DayOfWeek(RefDay);

{

Friday of current week

Freitag der Woche

}

if DoW = 1then DateOffset := -2

else

DateOffset := Dow - 6;

Result := RefDay - DateOffset;

end;

procedure SetWorkingDaysFilter(S, E: TDateTimePicker);

var

N: TDate;

begin

N := Now;

S.Date := GetMonday(N);

E.Date := GetFriday(N);

end;

{Just as short as simple}

{Einfach und kurz}

type

TForm1 = class(TForm)

DStart: TDateTimePicker;

DEnd: TDateTimePicker;

btSetFilter: TButton;

procedure btSetFilterClick(Sender: TObject);

end;

procedure TForm1.btSetFilterClick(Sender: TObject);

begin

SetWorkingDaysFilter(DStart, DEnd);

end;

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;

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;

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;