(09-17-2024, 01:58 PM)Dav Wrote: Neat date routines. Do you have a Get day of the Year function? I have one that works (I think it works), but the code is kind of ugly. Maybe there's a better way of doing this.
- Dav
I'll have to dig for it. There should be a version on the forums here somewhere, where I shared a few routines to calculate the numbers of days between two dates. One should be able to use them to get a Day of Year result. (From Jan 1 to Current day, same year for both, should give the day of year. Might need to adjust by 1 (Jan 1 to Jan 1 would be 0 days apart, so add 1 to make it the first day of the year.) Or else count from Dec 31, the year before to current date.)
@Dav Try this example and you'll see what I'm talking about:
Code: (Select All)
Screen _NewImage(1280, 720, 32)
Print "Is the date in proper format? The skies say "; CheckDayFormat(Date$)
Print "The Date = "; Date$
Print "Weekday = "; GetWeekDayName(Date$); ", which is day number"; GetWeekDay(Date$); "of the week."
Print "Day ="; GetDay(Date$)
Print "Month ="; GetMonth(Date$)
Print "Year ="; GetYear(Date$)
Print
Print "And to reverse the process we take those values and make them a date with :"; MakeDate(GetMonth(Date$), GetDay(Date$), GetYear(Date$))
Print
Print
Print
Print "And we can always fancify our date to universal formats: "
Print UniDate$("mm/dd/yyyy", Date$)
Print UniDate$("w, MM dd, YYYY", Date$)
Print UniDate$("W, MM DD, YYYY", Date$)
Print UniDate$("dd/mm/yyyy", Date$)
Print UniDate$("W, E D, YYYY", Date$)
Print UniDate$("mm-dd-yy", Date$)
Do
Print
Print "If you want to know the day that belongs to any date, give me a date in MM/DD/YYYY format =>";
Input dat$
If CheckDayFormat(dat$) Then
Exit Do
Else
Print "Bad format for your date. Sorry."
End If
Loop
Print
Print dat$; "was a "; GetWeekDayName$(dat$)
Print
Print
Print "Do you want to know how many days were between two dates?"
Print "Give me the first date in MM/DD/YYYY format =>";
Input dat$
Print "Give me the first date in MM/DD/YYYY format =>";
Input dat2$
Print "There were "; DaysBetween(dat$, dat2$); " days between "; dat$; " and "; dat2$; "."
Function DaysBetween&& (t1$, t2$)
t1## = TimeStamp(t1$, 0)
t2## = TimeStamp(t2$, 0)
If t2## < t1## Then Swap t1##, t2##
DaysBetween = (t2## - t1##) / (60 * 60 * 24)
End Function
Function CheckDayFormat (Day As String) 'use MM/DD/YYYY format
Dim As String DD, MM, YYYY, TD, TM, TY
If Len(Day$) <> 10 Then Glitch = -1
DD = Left$(Day, 2)
MM = Mid$(Day, 4, 2)
YYYY = Right$(Day, 4)
TD = Right$("00" + _Trim$(Str$(Val(DD))), 2)
TM = Right$("00" + _Trim$(Str$(Val(MM))), 2)
TY = Right$("0000" + _Trim$(Str$(Val(YYYY))), 4)
If TD <> DD Then Glitch = -1
If TM <> MM Then Glitch = -1
If TY <> YYYY Then Glitch = -1
If Glitch = 0 Then CheckDayFormat = -1
End Function
Function GetDay& (Day As String) 'use MM/DD/YYYY format
If CheckDayFormat(Day$) = 0 Then GetDay = 0: Exit Function
GetDay = Val(Mid$(Day, 4, 2))
End Function
Function GetMonth& (Day As String) 'use MM/DD/YYYY format
If CheckDayFormat(Day$) = 0 Then GetMonth = 0: Exit Function
GetMonth = Val(Left$(Day, 2))
End Function
Function GetYear& (Day As String) 'use MM/DD/YYYY format
If CheckDayFormat(Day$) = 0 Then GetYear = 0: Exit Function
GetYear = Val(Right$(Day, 4))
End Function
Function GetWeekDay& (Day$) 'use MM/DD/YYYY format
'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
If CheckDayFormat(Day$) = 0 Then GetWeekDay = 0: Exit Function
Dim As Long century, zerocentury, result
Dim As Long MM, DD, YYYY
MM = GetMonth(Day$): DD = GetDay(Day$): YYYY = GetYear(Day$)
If MM < 3 Then MM = MM + 12: YYYY = YYYY - 1
century = YYYY Mod 100
zerocentury = YYYY \ 100
result = (DD + Int(13 * (MM + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7
If result = 0 Then result = 7
GetWeekDay& = result 'results are 1 to 7, from Sunday to Saturday
End Function
Function GetWeekDayName$ (Day$) 'use MM/DD/YYYY format
Dim result As Long
result = GetWeekDay(Day$)
Select Case result
Case 1: GetWeekDayName = "Sunday"
Case 2: GetWeekDayName = "Monday"
Case 3: GetWeekDayName = "Tuesday"
Case 4: GetWeekDayName = "Wednesday"
Case 5: GetWeekDayName = "Thursday"
Case 6: GetWeekDayName = "Friday"
Case 7: GetWeekDayName = "Saturday"
End Select
End Function
Function MakeDate$ (MM As _Unsigned Long, DD As _Unsigned Long, YYYY As _Unsigned Long)
Dim As String TD, TM, TY
TM = Right$("00" + _Trim$(Str$(MM)), 2)
TD = Right$("00" + _Trim$(Str$(DD)), 2)
TY = Right$("0000" + _Trim$(Str$(YYYY)), 4)
MakeDate = TM + "-" + TD + "-" + TY
End Function
Function UniDate$ (format$, userdate$)
'some basic documentation for formatting:
'dates sent via userdate$ should be in the standardized QB64 DATE$ format -- MM/DD/YYYY
'To customize your return date format, use the following syntax
'w = short weekday names. (Mon, Tue, Wed, Thu, Fri, Sat, Sun)
'W = long weekday names. (Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday)
'E = Extended month names. (January, February, March....)
'M = long month names. (Jan, Feb, Mar...)
'm = short month names. (01, 02, 03...)
'D = long day names. (01st, 02nd, 03rd...)
'd = short day names. (01, 02, 03...)
'Y or y (case insensitive) = year. Number of Yy present determines the number of digits we return.
' YY = 2-digit year
' YYYY = 4 digit year
' Y with any additional number of y's = 4 digit year by default, so a typo of YYYYY is the same as YYYY.
'Any other character is simply considered part of the desired output and faithfully carried over into the proper spot.
' For example, "mm/dd/yyyy" gives us "02/10/2023" for Feb 10th, 2023.
' Second example, "dd.mm.yyyy" gives us "10.02.2023" for the same date.
' Third example, "dd EE YYYY" gives us "02 February 2023" for that same date.
'Note: Extra digits of most of these codes are simply ignored for error proofing purposes, with only the initial code being accepted.
' For example "mM YYYY" is actually processed as a simple "m YYYY". The process won't mix short, long, or extended results.
' Also for example, "m YY" is the *exact* same as "mm YY".
' Feel free to use extra digits as you desire to help you keep track of positional spacing in your format string.
' Even though "M D, yyyy" may process the same as "MMM DDDD, YYYY", the second may work better for you if you're trying to track
' position of formatted objects. (The output would be "Feb 10th, 2023", and those extra characters help hold that
' positioning for us easily.)
'And, I think that's it. Enjoy, guys!
Dim As String temp, m, d, y, firstchar, Day
Dim out$
Dim As Long MonthSet, DaySet, WeekdaySet, result, YearSet, mm, dd, yyyy, century, zerocentury
temp$ = userdate$
If temp$ = "" Then temp$ = Date$
m$ = Left$(temp$, 2)
d$ = Mid$(temp$, 4, 2)
y$ = Right$(temp$, 4)
temp$ = format$
Do
firstchar$ = Left$(temp$, 1)
Select Case firstchar$
Case "E" 'extended month
temp$ = Mid$(temp$, 2)
If Not MonthSet Then
MonthSet = -1
Select Case Val(m$)
Case 1: out$ = out$ + "January"
Case 2: out$ = out$ + "February"
Case 3: out$ = out$ + "March"
Case 4: out$ = out$ + "April"
Case 5: out$ = out$ + "May"
Case 6: out$ = out$ + "June"
Case 7: out$ = out$ + "July"
Case 8: out$ = out$ + "August"
Case 9: out$ = out$ + "September"
Case 10: out$ = out$ + "October"
Case 11: out$ = out$ + "November"
Case 12: out$ = out$ + "December"
End Select
End If
Case "M" 'long month
temp$ = Mid$(temp$, 2)
If Not MonthSet Then
MonthSet = -1
Select Case Val(m$)
Case 1: out$ = out$ + "Jan"
Case 2: out$ = out$ + "Feb"
Case 3: out$ = out$ + "Mar"
Case 4: out$ = out$ + "Apr"
Case 5: out$ = out$ + "May"
Case 6: out$ = out$ + "Jun"
Case 7: out$ = out$ + "Jul"
Case 8: out$ = out$ + "Aug"
Case 9: out$ = out$ + "Sep"
Case 10: out$ = out$ + "Oct"
Case 11: out$ = out$ + "Nov"
Case 12: out$ = out$ + "Dec"
End Select
End If
Case "m" 'short month
temp$ = Mid$(temp$, 2)
If Not MonthSet Then
MonthSet = -1
Select Case Val(m$)
Case 1: out$ = out$ + "01"
Case 2: out$ = out$ + "02"
Case 3: out$ = out$ + "03"
Case 4: out$ = out$ + "04"
Case 5: out$ = out$ + "05"
Case 6: out$ = out$ + "06"
Case 7: out$ = out$ + "07"
Case 8: out$ = out$ + "08"
Case 9: out$ = out$ + "09"
Case 10: out$ = out$ + "10"
Case 11: out$ = out$ + "11"
Case 12: out$ = out$ + "12"
End Select
End If
Case "D" 'long day
temp$ = Mid$(temp$, 2)
If Not DaySet Then
DaySet = -1
out$ = out$ + Right$("00" + _Trim$(d$), 2)
Select Case Val(d$)
Case 1, 11, 21, 31: out$ = out$ + "st"
Case 2, 22: out$ = out$ + "nd"
Case 3, 23: out$ = out$ + "rd"
Case Else: out$ = out$ + "th"
End Select
End If
Case "d" 'short day
temp$ = Mid$(temp$, 2)
If Not DaySet Then
DaySet = -1
out$ = out$ + Right$("00" + _Trim$(d$), 2)
End If
Case "W" 'long weekday
temp$ = Mid$(temp$, 2)
If Not WeekdaySet Then
GoSub getday
Select Case result
Case 0: Day$ = "Saturday"
Case 1: Day$ = "Sunday"
Case 2: Day$ = "Monday"
Case 3: Day$ = "Tuesday"
Case 4: Day$ = "Wednesday"
Case 5: Day$ = "Thursday"
Case 6: Day$ = "Friday"
End Select
out$ = out$ + Day$
End If
Case "w" 'short weekday
temp$ = Mid$(temp$, 2)
If Not WeekdaySet Then
GoSub getday
Select Case result
Case 0: Day$ = "Sat"
Case 1: Day$ = "Sun"
Case 2: Day$ = "Mon"
Case 3: Day$ = "Tue"
Case 4: Day$ = "Wed"
Case 5: Day$ = "Thr"
Case 6: Day$ = "Fri"
End Select
out$ = out$ + Day$
End If
Case "Y", "y" 'year
If Not YearSet Then
YearSet = -1
If Left$(UCase$(temp$), 4) = "YYYY" Then
temp$ = Mid$(temp$, 5)
out$ = out$ + y$
ElseIf Left$(UCase$(temp$), 2) = "YY" Then
temp$ = Mid$(temp$, 3)
out$ = out$ + Right$(y$, 2)
Else
temp$ = Mid$(temp$, 2)
out$ = out$ + y$
End If
Else
temp$ = Mid$(temp$, 2)
End If
Case Else 'seperator
temp$ = Mid$(temp$, 2)
out$ = out$ + firstchar$
End Select
Loop Until temp$ = ""
UniDate$ = out$
Exit Function
getday:
WeekdaySet = -1
'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
mm = Val(m$): dd = Val(d$): yyyy = Val(y$)
If mm < 3 Then mm = mm + 12: yyyy = yyyy - 1
century = yyyy Mod 100
zerocentury = yyyy \ 100
result = (dd + Int(13 * (mm + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7
Return
End Function
Function TimeStamp## (d1$, t##) 'date and timer
'Based on Unix Epoch time, which starts at year 1970.
Dim l As _Integer64, l1 As _Integer64, m As _Integer64
Dim d As _Integer64, y As _Integer64, i As _Integer64
Dim s As _Float, d$
If CheckDayFormat(d1$) = 0 Then
Print "Bad format for date. Can not get a timestamp. Default value of ERROR ERROR issued instead!"
Error 5
Exit Function
End If
d$ = d1$
For i = 1 To Len(d$) 'replace hypens with /
If Mid$(d$, i, 1) = "\" Then Mid$(d$, i) = "-"
If Mid$(d$, i, 1) = "/" Then Mid$(d$, i) = "-"
Next
l = InStr(d$, "-")
l1 = InStr(l + 1, d$, "-")
m = Val(Left$(d$, l))
d = Val(Mid$(d$, l + 1))
y = Val(Mid$(d$, l1 + 1))
If y < 1970 Then 'calculate shit backwards
Select Case m 'turn the day backwards for the month
Case 1, 3, 5, 7, 8, 10, 12: d = 31 - d '31 days
Case 2: d = 28 - d 'special 28 or 29.
Case 4, 6, 9, 11: d = 30 - d '30 days
End Select
If y Mod 4 = 0 And m < 3 Then 'check for normal leap year, and we're before it...
d = d + 1 'assume we had a leap year, subtract another day
If y Mod 100 = 0 And y Mod 400 <> 0 Then d = d - 1 'not a leap year if year is divisible by 100 and not 400
End If
'then count the months that passed after the current month
For i = m + 1 To 12
Select Case i
Case 2: d = d + 28
Case 3, 5, 7, 8, 10, 12: d = d + 31
Case 4, 6, 9, 11: d = d + 30
End Select
Next
'we should now have the entered year calculated. Now lets add in for each year from this point to 1970
d = d + 365 * (1969 - y) '365 days per each standard year
For i = 1968 To y + 1 Step -4 'from 1968 onwards,backwards, skipping the current year (which we handled previously in the FOR loop)
d = d + 1 'subtract an extra day every leap year
If (i Mod 100) = 0 And (i Mod 400) <> 0 Then d = d - 1 'but skipping every year divisible by 100, but not 400
Next
s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
TimeStamp## = -(s## + 24 * 60 * 60 - t##)
Exit Function
Else
y = y - 1970
End If
For i = 1 To m 'for this year,
Select Case i 'Add the number of days for each previous month passed
Case 1: d = d 'January doestn't have any carry over days.
Case 2, 4, 6, 8, 9, 11: d = d + 31
Case 3 'Feb might be a leap year
If (y Mod 4) = 2 Then 'if this year is divisible by 4 (starting in 1972)
d = d + 29 'its a leap year
If (y Mod 100) = 30 And (y Mod 400) <> 30 Then 'unless..
d = d - 1 'the year is divisible by 100, and not divisible by 400
End If
Else 'year not divisible by 4, no worries
d = d + 28
End If
Case 5, 7, 10, 12: d = d + 30
End Select
Next
d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
For i = 2 To y - 1 Step 4 'from 1972 onwards, skipping the current year (which we handled previously in the FOR loopp)
d = d + 1 'add an extra day every leap year
If (i Mod 100) = 30 And (i Mod 400) <> 30 Then d = d - 1 'but skiping every year divisible by 100, but not 400
Next
s## = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
TimeStamp## = (s## + t##)
End Function
Function ExtendedTimer##
'Simplified version of the TimeStamp routine, streamlined to only give positive values based on the current timer.
'Note: Only good until the year 2100, as we don't do all the fancy calculations for leap years.
'A timer should work quickly and efficiently in the background; and the less we do, the less lag we might insert
'into a program.
Dim m As Integer, d As Integer, y As Integer
Dim s As _Float, day As String
day = Date$
m = Val(Left$(day, 2))
d = Val(Mid$(day, 4, 2))
y = Val(Right$(day, 4)) - 1970
Select Case m 'Add the number of days for each previous month passed
Case 2: d = d + 31
Case 3: d = d + 59
Case 4: d = d + 90
Case 5: d = d + 120
Case 6: d = d + 151
Case 7: d = d + 181
Case 8: d = d + 212
Case 9: d = d + 243
Case 10: d = d + 273
Case 11: d = d + 304
Case 12: d = d + 334
End Select
If (y Mod 4) = 2 And m > 2 Then d = d + 1 'add a day if this is leap year and we're past february
d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
d = d + (y + 2) \ 4 'add in days for leap years passed
s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
ExtendedTimer## = (s + Timer)
End Function