Datumsdiffernz

Für allgemeine Fragen zur Programmierung mit PureBasic.
Benutzeravatar
Pelagio
Beiträge: 423
Registriert: 11.11.2004 17:52
Computerausstattung: Intel Core i3-4170 CPU 3,70 GHz
8,00 GB Arbeitsspeicher
WIN 10 Pro 64 Bit Betriebssystem
Wohnort: Bremen

Datumsdiffernz

Beitrag 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:
Ohne Zeit kein Fleiß
Auf neustem Stand zu sein ist eine Kunst die nicht jeder perfektioniert [Win10Pro(64); PB6.03 LTS]. :allright:
Benutzeravatar
Bisonte
Beiträge: 2427
Registriert: 01.04.2007 20:18

Re: Datumsdiffernz

Beitrag 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)
PureBasic 6.04 LTS (Windows x86/x64) | Windows10 Pro x64 | Asus TUF X570 Gaming Plus | R9 5900X | 64GB RAM | GeForce RTX 3080 TI iChill X4 | HAF XF Evo | build by vannicom​​
Benutzeravatar
NicTheQuick
Ein Admin
Beiträge: 8675
Registriert: 29.08.2004 20:20
Computerausstattung: Ryzen 7 5800X, 32 GB DDR4-3200
Ubuntu 22.04.3 LTS
GeForce RTX 3080 Ti
Wohnort: Saarbrücken
Kontaktdaten:

Re: Datumsdiffernz

Beitrag 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))
Bild
sibru
Beiträge: 265
Registriert: 15.09.2004 18:11
Wohnort: hamburg

Re: Datumsdiffernz

Beitrag 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!
Bild Bild
Benutzeravatar
Sicro
Beiträge: 955
Registriert: 11.08.2005 19:08
Kontaktdaten:

Re: Datumsdiffernz

Beitrag 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$))
Bild
Warum OpenSource eine Lizenz haben sollte :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (Syntax-Farbschema) :: RegEx-Engine (kompiliert RegExes zu NFA/DFA)
Manjaro Xfce x64 (Hauptsystem) :: Windows 10 Home (VirtualBox) :: Neueste PureBasic-Version
Antworten