Einzelnen Beitrag anzeigen

Amateurprofi

Registriert seit: 17. Nov 2005
Ort: Hamburg
956 Beiträge
 
Delphi XE2 Professional
 
#9

AW: Den letzten Donnerstag eines Monats

  Alt 26. Dez 2017, 01:30
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;
Gruß, Klaus
Die Titanic wurde von Profis gebaut,
die Arche Noah von einem Amateur.
... Und dieser Beitrag vom Amateurprofi....
  Mit Zitat antworten Zitat