05-09-2025, 08:44 PM
Added some missing stuffs:
Code: (Select All)
Screen _NewImage(1024, 720, 32)
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
Print
Print
Print "Feb 3rd is the "; Date.DayOfYear("02/03/2025"); " day of the year." 'command to get the day of the year
Print "(January has 31 + 3 in Feb = 34, which should be that result above.)"
Print "Today is the "; Date.DayOfYear(Date$); " day of the year."
Print
Print
Print "There are "; Date.DaysBetween(Date$, "09-25-2025"); " Days until Steve's BirthDay!" 'and days between dates
Print "There are "; Date.DaysBetween("09-25-2025", "12-25-2025"); "days between Steve's Birthday and Christmas!"
Print "There are "; Date.DaysBetween(Date$, "12-25-2025"); " Days until Christmas left this year!"
Do
Locate 30, 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.DayOfYear& (Date1 As String)
Dim As String Date0
Date0 = "01-01-" + Date.Year(Date1, "MM/DD/YYYY")
Date.DayOfYear = Date.DaysBetween(Date1$, Date0) + 1 'add one as Jan 1st is the first day of year
End Function
Function Date.DaysBetween&& (Date1$, Date2$)
Dim As _Float t1, t2
t1## = Date.TimeStamp(Date1$, 0)
t2## = Date.TimeStamp(Date2$, 0)
If t2## < t1## Then Swap t1##, t2##
Date.DaysBetween = (t2## - t1##) / (60 * 60 * 24)
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