Einzelnen Beitrag anzeigen

Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#9

Re: Verbesserte Version von YearsBetween, MonthsBetween

  Alt 27. Okt 2009, 16:27
Zitat von himitsu:
direkt ausgerechnet, ohne Annäherung über 'ne Schleife

Delphi-Quellcode:
Procedure CheckedSwap(Var ANow, AThen: TDateTime); Inline;
  Var Temp: TDateTime;

  Begin
    If ANow <= AThen Then Exit;
    Temp := ANow;
    ANow := AThen;
    AThen := Temp;
  End;

Function YearsBetween(const ANow, AThen: TDateTime): Integer;
  Var Yn, Yt, Mn, Mt, Dn, Dt: Word;
  d1, d2 : TDateTime;
  Begin
    d1 := ANow; d2 := AThen;
    CheckedSwap(d1, d2);
    DecodeDate(d1, Yn, Mn, Dn);
    DecodeDate(d2, Yt, Mt, Dt);
    Result := Yt - Yn;
    If (Mt < Mn) or ((Mt = Mn) and ((Dt+Frac(d2) < Dn+Frac(d1)))) Then Dec(Result);
  End;

Function MonthsBetween(const ANow, AThen: TDateTime): Integer;
  Var Yn, Yt, Mn, Mt, Dn, Dt: Word;
  d1, d2 : TDateTime;
  Begin
    d1 := ANow; d2 := AThen;
    CheckedSwap(d1, d2);
    DecodeDate(d1, Yn, Mn, Dn);
    DecodeDate(d2, Yt, Mt, Dt);
    Result := (Yt - Yn) * 12 + (Mt - Mn);
    If Dt+Frac(d2) < Dn+Frac(d1) Then Dec(Result);
  End;
Die Version ist - es wird nun nicht mehr gerundet - so auch gekauft

edit: const in die Funktionen angefügt, damit der Stack schön klein bleibt
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat