Verbesserte Version von Years-, MonthsBetween + DurationStr

[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".

An die Kinder: Bitte nicht nachmachen

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

[add] kleines Testprogrammchen angehängt