11 hours ago
Rounding up all my date and time routines and gathering them into one little library for quick use, and making certain they're Option _Explicit ready and all work 100% with our current version of QB64PE.
Here's what I have so far out of this work in progress, but expect more things to be added as I sort through my junk and find missing parts/features that aren't in here at the moment. (I know I have a DaysBetween somewhere which counts the days between two dates, and a DayofYear which tells you today is the 123rd day of the year, and there's probably a dozen other little things missing out of this that need to all be consolidated in one place for ease of reference. Expect this work to expand in time.
)
Note that not all routines may be shown in the small example code above. Browse through the comments and text and see what all is available here and what you can do with this junk. There just might be something useful in it for someone else.
Here's what I have so far out of this work in progress, but expect more things to be added as I sort through my junk and find missing parts/features that aren't in here at the moment. (I know I have a DaysBetween somewhere which counts the days between two dates, and a DayofYear which tells you today is the 123rd day of the year, and there's probably a dozen other little things missing out of this that need to all be consolidated in one place for ease of reference. Expect this work to expand in time.
)Code: (Select All)
Option _Explicit
Print Date.Day("12/24/1997", "MM/DD/YYYY") 'Gives the day from a formatted string
Print Date.Day("24/12/1997", "DD/MM/YYYY")
Print Date.Day("97/12/24", "YY/MM/DD")
Print Date.Month("12/24/1997", "MM/DD/YYYY") 'Gives the month from a formatted string
Print Date.Month("24/12/1997", "DD/MM/YYYY")
Print Date.Month("97/12/24", "YY/MM/DD")
Print Date.Year("12/24/1997", "MM/DD/YYYY") 'Gives the year from a formatted string
Print Date.Year("24/12/1997", "DD/MM/YYYY")
Print Date.Year("97/12/24", "YY/MM/DD")
Print
Print
Print "01/01/2025 was a "; Date.WeekDay.Name("01/01/2025", "MM/DD/YYYY")
Print "Today is a "; Date.WeekDay.Name(Date$, "MM/DD/YYYY")
Print
Print
Print Date.ToString(12, 25, 2025, "YYYY/MM/DD") 'command to format MM/DD/YYYY values into the format you like
Print Date.ToUniDate(Date$, "WWW MMM DDD, YYYY") 'unidate is much more powerful and can do fancier formatting
Print Date.ToUniDate(Date$, "www, MMM dd, YYYY") 'but requires a standard date format to work with.
'so you may want to use Date.ToString to format your date to QB64 standard "MM/DD/YYYY" then ToUniDate it
'for fancy formatting
Do
Locate 20, 1
Print "The current timestamp is: "; Date.TimeStamp(Date$, Timer)
_Limit 60
Loop Until _KeyHit
System
Function Date.Day$ (Day As String, Format As String)
Date.Day = String.Get.Part(Day, Format, "DD")
End Function
Function Date.Month$ (Day As String, Format As String)
Date.Month = String.Get.Part(Day, Format, "MM")
End Function
Function Date.TimeStamp## (d$, 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
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
Date.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
Date.TimeStamp## = (s## + t##)
End Function
Function Date.ToString$ (MM As _Unsigned Long, DD As _Unsigned Long, YYYY As _Unsigned Long, Format As String)
Dim As String T, temp
Dim As Long p
temp = UCase$(Format$)
p = InStr(temp, "YYYY")
If p Then 'looking for a 4-string year
T = Right$("0000" + _ToStr$(YYYY), 4)
Mid$(temp$, p) = T
Else 'only a 2-digit year
p = InStr(temp, "YY")
T = Right$("00" + _ToStr$(YYYY), 2)
Mid$(temp$, p) = T
End If
p = InStr(temp, "MM")
If p Then 'looking for a 4-string year
T = Right$("00" + _ToStr$(MM), 2)
Mid$(temp$, p) = T
End If
p = InStr(temp, "DD")
If p Then 'looking for a 4-string year
T = Right$("00" + _ToStr$(DD), 2)
Mid$(temp$, p) = T
End If
Date.ToString = temp$
End Function
Function Date.ToUniDate$ (UserDate As String, Format As String)
'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$ = ""
Date.ToUniDate$ = 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 Date.WeekDay& (Day$, Format$) 'specify MM/DD/YYYY format
'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
Dim As Long century, zerocentury, result
Dim As Long MM, DD, YYYY
MM = Val(Date.Month(Day$, Format$))
DD = Val(Date.Day(Day$, Format$))
YYYY = Val(Date.Year(Day$, Format$))
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
Date.WeekDay& = result 'results are 1 to 7, from Sunday to Saturday
End Function
Function Date.WeekDay.Name$ (Day$, Format$) 'specifty MM/DD/YYYY format
$Let INCLUDE_GETWEEKDAY = TRUE
Dim result As Long
result = Date.WeekDay(Day$, Format$)
Select Case result
Case 1: Date.WeekDay.Name = "Sunday"
Case 2: Date.WeekDay.Name = "Monday"
Case 3: Date.WeekDay.Name = "Tuesday"
Case 4: Date.WeekDay.Name = "Wednesday"
Case 5: Date.WeekDay.Name = "Thursday"
Case 6: Date.WeekDay.Name = "Friday"
Case 7: Date.WeekDay.Name = "Saturday"
End Select
End Function
Function Date.Year$ (Day As String, Format As String)
If InStr(Format, "YYYY") Then 'looking for a 4-string year
Date.Year = String.Get.Part(Day, Format, "YYYY")
Else 'only a 1-string year
Date.Year = String.Get.Part(Day, Format, "YY")
End If
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
Function String.Get.Part$ (Source As String, Format As String, Part As String)
'this routine allows us to get partial information from a properly formatted string
'format should be something similar to:
'YYYY/MM/DD
'YY-MM-DD
'or similar. What we're looking for is the PART we specify in that format.
Dim As Long p
p = InStr(UCase$(Format), Part)
If Len(Source) <> Len(Format) _OrElse p = 0 Then
_MessageBox "Bad Format", "Error: Passing String with invalid format to Function String.Get.Part.", "error"
Else
String.Get.Part = Mid$(Source, p, Len(Part))
End If
End Function
Note that not all routines may be shown in the small example code above. Browse through the comments and text and see what all is available here and what you can do with this junk. There just might be something useful in it for someone else.