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 :mrgreen: ihr sollt ja nicht die Katze im Sack kaufen

cu

Oliver

[s.h.a.r.k]

sowas gehört in die CodeLib :zwinker:

[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 :zwinker:

[Sir Rufo]

Zitat:

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 :mrgreen:

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

[DP-Maintenance]

Dieses Thema wurde von "Daniel G" von "Open-Source" nach "Neuen Beitrag zur Code-Library hinzufügen" verschoben.
Passt hier in der Tat (vorerst) besser rein...

[Sir Rufo]

Zitat:

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 :mrgreen:

edit: const in die Funktionen angefügt, damit der Stack schön klein bleibt :mrgreen:

[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

[Sir Rufo]

Zitat:

Zitat von 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

Jo, danke,

aber das kann ich nicht benutzen, da ich bei folgenden Vergleichszeiten
'27.10.2009 17:56:16' und
'27.10.2011 17:56:15'
folgendes Ergebnis möchte:
'1 Jahr 11 Monate 4 Wochen 2 Tage 23 Stunden 59 Minuten 59 Sekunden'
Und deine Funktion gibt mir da 2 Jahre aus

Die Himi-Funktion habe ich abgeändert und die liefert genau was ich brauche (ohne Schleife)

cu

Oliver

[himitsu]

Zitat:

Zitat von Sir Rufo

Die Version ist - es wird nun nicht mehr gerundet - so auch gekauft :mrgreen:

:angel:

Wenn du die Extravariablen (d1 und d2) nimmst, dann kannst du das CONST wieder bei den Parametern einfügen :)
(hatte mir diese zusätzlichen Variablen nur erspart, da Delphi hier, selbst mit CONST nicht call-by-referenz nutzt, sondern auch da beide Parameter auf den Stack schiebt, so als würde kein CONST dastehn ... drum hat man ohne Extravariablen und ohne CONST 16 Byte auf'm Stack eingespart, aber so sehr fällt das nun auch nicht auf :angel2: )


Wenn du die Tageszeit mit beachten willst, dann dürfte eine weitere Zeile nach CheckedSwap dieses wohl ermöglichen

Delphi-Quellcode:

If Trunc(d1) < Trunc(d2) then d2 := d2 + 1;

eventuell auch mit 'nem kleinen Rundunssschutz von ~1 Sekunde

Delphi-Quellcode:

If d2 - d1 >= 0.00001157 {1s} then d2 := d2 + 1;

oder andersrum? :gruebel:

Delphi-Quellcode:

If Trunc(d1) > Trunc(d2) then d2 := d2 - 1;
// bzw.
If d1 - d2 >= 0.00001157 {1s} then d2 := d2 - 1;

mein schädel brummt grad etwas und hab jetzt nicht so den Nerv mir 'nen kleines Testprogrämmchen zu schreiben

[Wolfgang Mix]

@Sir Rufo
Na dann freue ich mich mit Dir auf Deinen optimierten Code :-D

[Edit] Gerade erst gelesen:
Thus, for example, YearsBetween reports the difference between Jan 1 and Dec 31 as 0 on non-leap years and 1 on leap years.
Allein schon wegen dieser Aussage in der OH ist die Funktion YearsBetween IMHO mangelhaft [/Edit]

Gruß

Wolfgang

[Sir Rufo]

Ist ja jetzt egal, jetzt haben wir ja eine genaue Funktion dafür.

Ich habe jetzt aus dem ganzen Geraffel eine Unit gebaut, die als Hauptzweck den Unterschied zwischen zwei Zeitangaben in einer Textform ausgibt.

Auch hier waren noch einige Rundungsfehler aus der DateUtils zu umschiffen.

cu

Oliver

[Wolfgang Mix]

Nettes Tool, Deine Demo, Kompliment!

Werde ich gerne für Demonstrationszwecke verwenden :-D

Gruß

Wolfgang

[himitsu]

Mal so aus Interesse ... rechnet dieses wenigstens richtig?
Hach, es war schön das Format-Befehlchen mal wieder etwas mißbrauchen zu "dürfen".

:warn: An die Kinder: Bitte nicht nachmachen :lol:

Delphi-Quellcode:

Uses Math, DateUtils;

Function DurationStr(ANow, AThen: TDateTime): String;
  Var D: TDateTime;
    Yn, Yt, Mn, Mt, Wt, Dn, Dt: Word;
    Hn, Ht, Nn, Nt, Sn, St, Tn, Tt: Word;

  Begin
    If ANow > AThen Then Begin
      D     := ANow;
      ANow  := AThen;
      AThen := D;
    End;
    DecodeDate(ANow,  Yn, Mn, Dn);
    DecodeDate(AThen, Yt, Mt, Dt);
    DecodeTime(ANow,  Hn, Nn, Sn, Tn);
    DecodeTime(AThen, Ht, Nt, St, Tt);
    Tt := Tt - Tn;  If SmallInt(Tt) < 0 Then Begin  Inc(Tt, 1000);  Dec(St);  End;
    St := St - Sn;  If SmallInt(St) < 0 Then Begin  Inc(St, 60);    Dec(Nt);  End;
    Nt := Nt - Nn;  If SmallInt(Nt) < 0 Then Begin  Inc(Nt, 60);    Dec(Ht);  End;
    Ht := Ht - Hn;  If SmallInt(Ht) < 0 Then Begin  Inc(Ht, 24);    Dec(Dt);  End;
    Dt := Dt - Dn;  If SmallInt(Dt) < 0 Then Begin  Inc(Dt,
         DaysInAMonth(Yt + Min(Mt - 2, 0), (Mt + 10) mod 12 + 1));  Dec(Mt);  End;
    Wt := Dt div 7; Dt := Dt mod 7;
    Mt := Mt - Mn;  If SmallInt(Mt) < 0 Then Begin  Inc(Mt, 12);    Dec(Yt);  End;
    Yt := Yt - Yn;
    Result := '';
    If Yt > 0 Then Result := Result + Format('%.0n Jahr%*:s ',  [Yt / 1, Min(Yt+1,3), '', 'e']);
    If Mt > 0 Then Result := Result + Format('%d Monat%*:s ',   [Mt, Min(Mt+1,3), '', 'e']);
    If Wt > 0 Then Result := Result + Format('%d Woche%*:s ',   [Wt, Min(Wt+1,3), '', 'n']);
    If Dt > 0 Then Result := Result + Format('%d Tag%*:s ',     [Dt, Min(Dt+1,3), '', 'e']);
    If Ht > 0 Then Result := Result + Format('%d Stunde%*:s ',  [Ht, Min(Ht+1,3), '', 'n']);
    If Nt > 0 Then Result := Result + Format('%d Minute%*:s ',  [Nt, Min(Nt+1,3), '', 'n']);
    If St > 0 Then Result := Result + Format('%d Sekunde%*:s ', [St, Min(St+1,3), '', 'n']);
    If Tt > 0 Then Result := Result + Format('%d msec', [Tt]);
    If Result = '' Then Result := 'gleich' Else Result := Trim(Result);
  End;

[edit] kleinen Fehler behoben ... hatte die Millisekunden vergessen zu berechnen
und ein Tag hat 60 Stunden :oops:

[add] kleines Testprogrammchen angehängt