Author: Tomas Rutkauskas
How to calculate the current week
Answer:
Solve 1:
There are 2 other functions included which are required for our function. One
checks for a leap year, the other returns the number of days in a month (checking
the leap year) and the third is the one you want, the week of the year.
1 function kcIsLeapYear(nYear: Integer): Boolean;
2 begin
3 Result := (nYear mod 4 = 0) and ((nYear mod 100 <> 0) or (nYear mod 400 = 0));
4 end;
5
6 function kcMonthDays(nMonth, nYear: Integer): Integer;
7 const
8 DaysPerMonth: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31,
9 30, 31);
10 begin
11 Result := DaysPerMonth[nMonth];
12 if (nMonth = 2) and kcIsLeapYear(nYear) then
13 Inc(Result);
14 end;
15
16 function kcWeekOfYear(dDate: TDateTime): Integer;
17 var
18 X, nDayCount: Integer;
19 nMonth, nDay, nYear: Word;
20 begin
21 nDayCount := 0;
22 DecodeDate(dDate, nYear, nMonth, nDay);
23 for X := 1 to (nMonth - 1) do
24 nDayCount := nDayCount + kcMonthDays(X, nYear);
25 nDayCount := nDayCount + nDay;
26 Result := ((nDayCount div 7) + 1);
27 end;
Solve 2:
28
29 function CalendarWeek(ADate: TDateTime): integer;
30
31 {Author: Ralph Friedman (ralphfriedman@email.com)
32
33 Calculates calendar week assuming:
34 Monday is the 1st day of the week
35 The 1st calendar week is the 1st week of the year that contains a Thursday
36
37 -1 result indicates error.
38 Any other negative result indicates week 52 or 53 of the previous year.}
39
40 var
41 day: word;
42 dayOne: word;
43 firstOfYear: TDateTime;
44 month: word;
45 monthOne: word;
46 prevDayOne: word;
47 year: word;
48 begin
49 Result := -1;
50 try
51 DecodeDate(ADate, year, month, day);
52 except
53 Exit;
54 end;
55 case DayOfWeek(EncodeDate(year, 1, 1)) of
56 1: dayOne := 2; {Sunday}
57 2: dayOne := 1; {Monday}
58 3: dayOne := 31; {Tuesday}
59 4: dayOne := 30; {Wednesday}
60 5: dayOne := 29; {Thursday}
61 6: dayOne := 4; {Friday}
62 7: dayOne := 3; {Saturday}
63 else
64 dayOne := 0;
65 end;
66 case DayOfWeek(EncodeDate(year - 1, 1, 1)) of
67 1: prevDayOne := 2; {Sunday}
68 2: prevDayOne := 1; {Monday}
69 3: prevDayOne := 31; {Tuesday}
70 4: prevDayOne := 30; {Wednesday}
71 5: prevDayOne := 29; {Thursday}
72 6: prevDayOne := 4; {Friday}
73 7: prevDayOne := 3; {Saturday}
74 else
75 prevDayOne := 0;
76 end;
77 if (prevDayOne = 0) or (dayOne = 0) then
78 Exit;
79 if dayOne > 4 then
80 begin
81 Dec(year);
82 monthOne := 12
83 end
84 else
85 monthOne := 1;
86 firstOfYear := EncodeDate(year, monthOne, dayOne);
87 if (ADate < firstOfYear) then
88 if (PrevDayOne > 4) then
89 Result := -53
90 else
91 Result := -52
92 else
93 Result := (Trunc(ADate - firstOfYear) div 7) + 1;
94 end;
|
