Deine Funktion ist etwa 60% schneller als die im Beitrag dadrüber.
Naja, wenn es um Schnelligkeit geht dann so:
Delphi-Quellcode:
// WeekDay 0=Mo, 6=So
FUNCTION LastWeekDayOfMonth(Year,Month,WeekDay:Integer):TDateTime;
const DIM:
Array[1..12]
of byte=(31,28,31,30,31,30,31,31,30,31,30,31);
var Day,DN,DoW,Y:Integer;
begin
Y:=Year;
Day:=DIM[Month]+Ord((Month=2)
and ((Year
mod 4=0)
and (Year
mod 100<>0)
or (Year
mod 400=0)));
DN:=Year*365+Day+31*(Month-1);
If Month>2
then Dec(DN,(23+4*Month)
div 10)
else if Year<>0
then Dec(Year)
else Dec(DN);
Inc(DN,Year
div 4 - Year
div 100 + Year
div 400);
DoW:=(5+DN)
mod 7;
if WeekDay>DOW
then Dec(Day,7-WeekDay+DoW)
else Dec(Day,Dow-WeekDay);
Result:=EncodeDate(Y,Month,Day);
end;
Kurz zur Funktion, falls es jemanden interessiert:
In der Funktion wird u.A. DN berechnet. DN ist die Anzahl der Tage, die seit dem fiktiven Datum 01.01.0000 vergangen sind, wobei angenommen wird, dass der Gregorianische Kalender schon immer gegolten hätte.
Der 01.01.0000 hätte also die Nummer 0.
Auf meinem Rechner (i7 2600K 3.4 GHz) arbeitet diese Funktion deutlich schneller.
Bei unten stehendem Test brauchte diese Funktion 187 ms, die aus #7 2262 ms.
Das mag auf anderen Rechnern anders sein.
Hinzu kommt, dass die Funktion aus #7 in bestimmten Fällen falsche Resultate liefert.
Für Dezember 1899 und Montag liefert #7 den 26.12.1899, richtig wäre der 25.12.1899 (Geburtstag von Humphrey Bogart).
Auch für Dienstag bis Freitag im Dezember 1899 tritt diese Verschiebung um einen Tag auf.
Ansonsten arbeitet sie im Zeitraum 1583 bis 2500 korrekt.
Was mir ebenfalls nicht an #7 gefällt, ist, dass sie nicht ein Datum sondern einen Zeitpunkt liefert (nämlich 23:59:59 am jeweiligen Tag) was vermutlich auch die Quelle des Fehlers ist.
Hier die Prozedur mit der ich getestet habe.
Delphi-Quellcode:
PROCEDURE TMain.Test;
var Err,I,Year,Month,DoW1,DoW2:Integer; DT1,DT2:TDateTime; DS1,DS2:String;
T0,T1,T2:Cardinal;
begin
// Prüfung ob beide Funktionen identische Ergebnisse bringen
Err:=0;
for Year:=1583 to 2500 do
for Month:=1 to 12 do
for DoW1:=0 to 6 do begin
DT1:=LastWeekDayOfMonth(Year,Month,DoW1);
DS1:=FormatDateTime('dd.mm.yyyy',DT1);
if DoW1<6 then DoW2:=DoW1+2 else DoW2:=1;
DT2:=GetLastWeekDayOfMonth(Year,Month,DoW2);
DS2:=FormatDateTime('dd.mm.yyyy',DT2);
if DS1<>DS2 then begin
Inc(Err);
ShowMessage(IntToStr(Year)+' '+IntToStr(Month)+#13+
IntToStr(DoW1)+' '+DS1+#13+
IntToStr(DoW2)+' '+DS2);
end;
end;
ShowMessage(IntToStr(Err));
// Performance Vergleich
T0:=GetTickCount;
for I:=1 to 50 do
for Year:=1583 to 2500 do
for Month:=1 to 12 do
for DoW1:=0 to 6 do
DT1:=LastWeekDayOfMonth(Year,Month,DoW1);
T1:=GetTickCount;
for I:=1 to 50 do
for Year:=1583 to 2500 do
for Month:=1 to 12 do
for DoW2:=1 to 7 do
DT2:=GetLastWeekDayOfMonth(Year,Month,DoW2);
T2:=GetTickCount;
ShowMessage(IntToStr(T1-T0)+#13+IntToStr(T2-T1));
end;