10-16-2023, 04:41 AM
I thought a few of you guys might have use for some of these inside your own works. (Note that these are all going into my toolbox project as well. I just thought I'd share them independent here for a preview of sorts for folks to enjoy.)
Code: (Select All)
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$)
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