Seite 1 von 1

Datumsdiffernz

Verfasst: 02.07.2018 06:03
von Pelagio
Hallo PB'ler,

ich bin jetzt schon mehrere Tage dabei zu versuchen die Differenz zwischen zwei Datumszeiten in genauer Auflistung von Jahre, Monate und Tage zu, mit PB eigenen Mitteln zu realisieren. Jeder Ansatz den ich versuchte schlug irgendwann, beim Test mit unterschiedlichem Datum, fehl.
Zum Beispiel die Differenz zwischen Heute und dem 31.01.2021 kann ich zwar in Tagen ermitteln aber die korrekte Ermittlung von Jahre, Monate und Tage geht fehl. Vielleicht hat ja jemand eine Idee oder mit rein PB Mitteln geht es nicht.
Ich habe mich jetzt doch entschieden meine bestes, nicht korrektes, Ergebnis zu posten:

Code: Alles auswählen


#Tag = (24*60*60)
;vDate = Parsedate("%dd.%mm.%yyyy", "31.01.2021")
;vRestTage = ( vDate - Date()) / #Tag + 1


Procedure.s Restzeit(vDate.i, vRestTage.i)
	Protected pResult.s, pDate.i, pJahre.i, pMonate.i, pTage.i

	pJahre  = (vRestTage/365)
	pDate   = AddDate(Date(), #PB_Date_Year, pJahre)
	pTage   = (vDate - pDate) / #Tag
	pMonate = pTage/30
	pDate   = AddDate(pDate, #PB_Date_Month, pMonate)
	pTage   = (vDate - pDate) / #Tag
	pResult = "NUR NOCH  "
	pResult + Str(pJahre) 
	If (pJahre=1): pResult + " Jahr  ": Else: pResult + " Jahre  ": EndIf
	pResult + Str(pMonate)
	If (pMonate=1): pResult + " Monat  ": Else: pResult + " Monate  ": EndIf
	pResult + Str(pTage)
	If (pTage=1): pResult + " Tag": Else: pResult + " Tage": EndIf
	If (pJahre=0) And (pMonate=0): gFlag = #False: EndIf
	ProcedureReturn pResult
EndProcedure
:praise:

Re: Datumsdiffernz

Verfasst: 02.07.2018 09:12
von Bisonte
Also in Tagen und Wochen ist das kein Problem. Aber die Monate und Jahre wird knifflig.

Nicht jeder Monat hat die gleiche Anzahl Tage, und der Februar ist ja mit unserem Schaltjahrsystem besonders betroffen.

Für Tage und Wochenhabe ich mal eine Prozedur von Hroudtwolf etwas erweitert :

Code: Alles auswählen

Procedure.s FormatSeconds (StartDate.q, StopDate.q)
  
  Protected lWeeks, lHours , lMinutes, lSeconds, lDays, String.s, First.s
  
  lSeconds = StopDate - StartDate
  
  lMinutes = lSeconds / 60
  lSeconds = lSeconds % 60
  lHours   = lMinutes / 60
  lMinutes = lMinutes % 60
  
  lDays    = lHours / 24
  lHours   = lHours % 24
  
  lWeeks   = lDays / 7
  lDays    = lDays % 7
  
  If lWeeks > 0
    If lWeeks = 1
      String + "Eine Woche,"
    Else
      String + Str(lWeeks) + " Wochen,"
    EndIf
    
  EndIf
  If lDays > 0
    If lDays = 1
      String + " einen Tag,"
    Else
      String + " " + Str(lDays) + " Tage,"
    EndIf
  EndIf
  
  
  String + " " + Str(lHours) + " Stunden, " + Str(lMinutes) + " Minuten und " + Str(lSeconds) + " Sekunden"
  
  ProcedureReturn String
  
EndProcedure

vDate = ParseDate("%dd.%mm.%yyyy", "31.01.2021")

Debug FormatSeconds (Date(), vDate)

Re: Datumsdiffernz

Verfasst: 02.07.2018 10:48
von NicTheQuick
Ich hätte das hier im Angebot

Code: Alles auswählen

Procedure dateDiff(date1.q, date2.q)
	Protected diffYears.i = Year(date2) - Year(date1)
	If AddDate(date1, #PB_Date_Year, diffYears) > date2
		diffYears - 1
	EndIf
	date1 = AddDate(date1, #PB_Date_Year, diffYears)
	Protected diffMonths.i = (12 + Month(date2) - Month(date1)) % 12
	If AddDate(date1, #PB_Date_Month, diffMonths) > date2
		diffMonths - 1
	EndIf
	date1 = AddDate(date1, #PB_Date_Month, diffMonths)
	Protected diffSeconds = Second(date2 - date1)
	Protected diffDays = Day(date2 - date1) - 1
	Protected diffHours = Hour(date2 - date1)
	Protected diffMinutes = Minute(date2 - date1)

	Debug "Nur noch " + diffYears + " Jahre, " + diffMonths + " Monate, " + diffDays + " Tage, " + diffHours + " Stunden, " + diffMinutes + " Minuten und " + diffSeconds + " Sekunden."
EndProcedure

dateDiff(Date(2017, 7, 2, 0, 0, 0), Date(2018, 8, 3, 1, 1, 1))

Re: Datumsdiffernz

Verfasst: 02.07.2018 11:29
von sibru
Hier mal ´ne Lösung mit Schaltjahr-Berücksichtigung:

Code: Alles auswählen

;Modul      DateDiff Version 1.02 vom 14.02.2009 
#PB_Vers  = "4.20"
;
;Funktion:  liefert Datums-Differenz (Anz. Tage, Monate und Jahre im DatumsFormat)
;
;Aufruf:    DatDiff$ = DateDiff(Datum1$, Datum2$ {, DateMask$})
;           Datum1$:   Start-Datum im Format lt. DateMask$
;           Datum2$:   Ende-Datum im Format lt. DateMask$
;           DateMask$: DatumsMaske mit DatenKennungen (%DD, %MM, %YY / %YYYY)
;                      wenn nicht angegeben, so wird "%DD.%MM.%YYYY" benutzt
;
;           Diese Funktion liefert die Differenz der beiden angegebenen Datume
;           im Format lt. DateMask (%DD=Anz. Tage %MM=Anz. Monate %YY / %YYYY=
;           Anz. Jahre)
;

;#jaPBeExt exit

Procedure.s DateDiff(Datum1$, Datum2$, DateMask$ = "%DD.%MM.%YYYY")
  Protected diff, Jahr, Jahre
  Protected Datum1 = ParseDate(DateMask$, Datum1$)
  Protected Datum2 = ParseDate(DateMask$, Datum2$)
  If Datum1>Datum2 : Swap Datum1, Datum2 : EndIf ;Datum1 ist nun sicher das Kleinerere
  diff = Datum2 - Datum1
  Jahre = Year(Datum2) - Year(Datum1);Sonderbehandlung wg. MinJahr=1970
  While Datum1<Datum2 ;Schaltjahre prüfen
    Jahr = Year(Datum1)
    If((Jahr%4 = 0 And Jahr%100<>0)Or(Jahr%400 = 0));SchaltJahr ?
      diff = AddDate(diff, #PB_Date_Day, - 1);ein Tag weniger
    EndIf
    Datum1 = AddDate(Datum1, #PB_Date_Year, 1)
  Wend
  DateMask$ = ReplaceString(DateMask$, "%DD", RSet(Str(Day(diff)), 2, "0"))
  DateMask$ = ReplaceString(DateMask$, "%MM", RSet(Str(Month(diff) - 1), 2, "0"))
  DateMask$ = ReplaceString(DateMask$, "%YYYY", RSet(Str(Jahre), 4, "0"))
  DateMask$ = ReplaceString(DateMask$, "%YY", RSet(Str(Jahre), 2, "0"))
  ProcedureReturn DateMask$
EndProcedure

; ;/===== TestRoutine =====
; d1$ = "17.02.1980"
; d2$ = "16.03.2016"
; diff$ = DateDiff(d1$, d2$)
; Debug diff$
viel Erfolg!

Re: Datumsdiffernz

Verfasst: 02.07.2018 18:13
von Sicro

Code: Alles auswählen

; MIT License
;
; Copyright (c) 2018 Sicro
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.

Procedure DaysInMonth(Date)
  
  Date = Date(Year(Date), Month(Date) + 1, 1, 0, 0, 0)
  Date = AddDate(Date, #PB_Date_Day, -1)
  
  ProcedureReturn Day(Date)
  
EndProcedure

Procedure$ GetDateDiff(Date1, Date2, ResultMask$ = "%y years, %m months, %d days, %h hours, %i minutes, %s seconds")
  
  Protected DiffSeconds, DiffMinutes, DiffHours, DiffDays, DiffMonths, DiffYears, Carry
  Protected Result$ = ResultMask$
  
  If Date1 > Date2
    Swap Date1, Date2
  EndIf
  
  DiffSeconds = Second(Date2) - Second(Date1)
  If DiffSeconds < 0
    DiffSeconds + 60
    Carry = 1
  EndIf
  
  DiffMinutes = Minute(Date2) - Minute(Date1) - Carry
  If DiffMinutes < 0
    DiffMinutes + 60
    Carry = 1
  Else
    Carry = 0
  EndIf
  
  DiffHours = Hour(Date2) - Hour(Date1) - Carry
  If DiffHours < 0
    DiffHours + 24
    Carry = 1
  Else
    Carry = 0
  EndIf
  
  DiffDays = Day(Date2) - Day(Date1) - Carry
  If DiffDays < 0
    DiffDays + DaysInMonth(Date1)
    Carry = 1
  Else
    Carry = 0
  EndIf
  
  DiffMonths = Month(Date2) - Month(Date1) - Carry
  If DiffMonths < 0
    DiffMonths + 12
    Carry = 1
  Else
    Carry = 0
  EndIf
  
  DiffYears = Year(Date2) - Year(Date1) - Carry
  
  Result$ = ReplaceString(Result$, "%y", Str(DiffYears))
  Result$ = ReplaceString(Result$, "%m", Str(DiffMonths))
  Result$ = ReplaceString(Result$, "%d", Str(DiffDays))
  Result$ = ReplaceString(Result$, "%h", Str(DiffHours))
  Result$ = ReplaceString(Result$, "%i", Str(DiffMinutes))
  Result$ = ReplaceString(Result$, "%s", Str(DiffSeconds))
  
  Result$ = ReplaceString(Result$, "%M", Str((Date2 - Date1) / (60 * 60 * 24 * 30)))
  Result$ = ReplaceString(Result$, "%D", Str((Date2 - Date1) / (60 * 60 * 24)))
  Result$ = ReplaceString(Result$, "%H", Str((Date2 - Date1) / (60 * 60)))
  Result$ = ReplaceString(Result$, "%I", Str((Date2 - Date1) / 60))
  Result$ = ReplaceString(Result$, "%S", Str(Date2 - Date1))
  
  ProcedureReturn Result$
  
EndProcedure

Define ResultMask$ = "Years: %y" + #CRLF$ +
                    "Months: %m (Months in total: %M)" + #CRLF$ +
                    "Days: %d (Days in total: %D)" + #CRLF$ +
                    "Hours: %h (Hours in total: %H)" + #CRLF$ +
                    "Minutes: %i (Minutes in total: %I)" + #CRLF$ +
                    "Seconds: %s (Seconds in total: %S)"

MessageRequester("GetDateDiff", GetDateDiff(Date(2003, 3, 1, 0, 0, 0), Date(2004, 3, 1, 0, 0, 0), ResultMask$))