Verbesserte Version von Years-, MonthsBetween + DurationStr

[Sir Rufo]

Moin,

habe ich mich doch gerade aufgeregt, dass die Funktionen YearsBetween und MonthsBetween falsche, da gerundete Ergebnisse liefern.

Code:

YearsBetween( '01.01.2009', '01.01.2010' ) => 0 Jahre
MonthsBetween( '01.01.2009', '01.01.2010' ) => 11 Monate

Wer kann denn mit dem Mist arbeiten - ich nicht, also habe ich einfach mal 2 Funktionen geschrieben, die diesen Fehler nicht haben.
Vielleicht kann es ja noch jemand gebrauchen

edit:

Ich habe das jetzt mal alles in einer Unit uDurationStr zusammengefasst und angehängt.
Zum Ausprobieren auch eine kleine Demo als Exe, wo alle Parameter der Funktion über das Formular geändert werden können.
Screenshot des Demo-Programms, na klar ihr sollt ja nicht die Katze im Sack kaufen

cu

Oliver

[s.h.a.r.k]

sowas gehört in die CodeLib

[Wolfgang Mix]

Schließe mich meinem Vorredner an und würde Daniel bitten, die beiden Funktionen
mit in meine Unit DateUtils2 zu übernehmen.
Um Verwechlungengen zu vermeiden, sollten sie dann aber andere Namen haben,
z.B. YearsBetween2 und MonthsBetween2.

Gruß

Wolfgang

[RWarnecke]

und/oder in mein Code-Orakel Online

[Sir Rufo]

Zitat von Wolfgang Mix:

Schließe mich meinem Vorredner an und würde Daniel bitten, die beiden Funktionen
mit in meine Unit DateUtils2 zu übernehmen.
Um Verwechlungengen zu vermeiden, sollten sie dann aber andere Namen haben,
z.B. YearsBetween2 und MonthsBetween2.

Gruß

Wolfgang

Jo, in die DateUtils2 passen die gut rein.

Als Namen könnte man auch YearsBetweenAsHumansCount bezeichnen

Ich habe da gerade eine weitere Zeitfunktion (die, wofür ich die genaue Jahres/Monatsangabe brauchte), die auch gut in die DateUtils2 reinpasst.

Schieb ich gleich mal in den ersten Thread rein.

cu

Oliver

[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(ANow, AThen: TDateTime): Integer;
  Var Yn, Yt, Mn, Mt, Dn, Dt: Word;

  Begin
    CheckedSwap(ANow, AThen);
    DecodeDate(ANow,  Yn, Mn, Dn);
    DecodeDate(AThen, Yt, Mt, Dt);
    Result := Yt - Yn;
    If (Mt < Mn) or ((Mt = Mn) and ((Dt < Dn))) Then Dec(Result);
  End;

Function MonthsBetween(ANow, AThen: TDateTime): Integer;
  Var Yn, Yt, Mn, Mt, Dn, Dt: Word;

  Begin
    CheckedSwap(ANow, AThen);
    DecodeDate(ANow,  Yn, Mn, Dn);
    DecodeDate(AThen, Yt, Mt, Dt);
    Result := (Yt - Yn) * 12 + (Mt - Mn);
    If Dt < Dn Then Dec(Result);
  End;

Es wird abgerundet und sozusagen immer der Tagesbeginn gewertet.
Also Anfang=01.01. und Ende=31.12. ist noch kein ganzes Jahr

[Wolfgang Mix]

@Sir Rufo

Die Namensgebung ist Dein Ding

Gruß

Wolfgang

[Sir Rufo]

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

[Wolfgang Mix]

@Sir Rufo

Mir fällt gerade ein, daß ich YearsBeween schon 1992 problemloser ohne Delphi
unter DBase entwickelt habe.
Die Grundidee ist diese

Du findest den Code unter CodeLib/SysUtils2/function Age();

Teste 'mal bitte

Grüß

Wolfgang