PDS (Professional Development System, aka. QuickBASIC 7.x, aka. QBX) has a neat library (see DATIM.BI header and one of the DTFMT##.LIB files) that provides multiple ways to manipulate dates: Now&(), Month&(serial#), Day&(serial#), Year&(serial#), Weekday&(serial#), Hour&(serial#), Minute&(serial#), Second&(serial#), DateSerial#(year%, month%, day%), etc. However, if you're running QBasic 1.1 and QuickBASIC 4.5, you may have to come up with your own solution.
Get and set System Date
The BASIC dialect has an easy-to-use keyword that can return the system date as a "MM-DD-YYYY" (Month-Day-Year) string. The same keyword can also be used as a statement to set the date. It's trivial, really:
DECLARE SUB dateGetToday (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER)
DECLARE SUB dateSetToday (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER)
DIM iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER
' Get current date.
dateGetToday iYear, iMonth, iDay
PRINT " Year:"; iYear
PRINT "Month:"; iMonth
PRINT " Day:"; iDay
' Set date to May 1st, 1995.
dateSetToday 1995, 5, 1
PRINT DATE$
' Restore date to its initial values.
dateSetToday iYear, iMonth, iDay
'' Get system date with DATE$
SUB dateGetToday (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER)
DIM sDate AS STRING
' Using DATE$ as a function: get the system date.
sDate = DATE$
' Split date, show result.
iMonth = VAL(LEFT$(sDate, 2)) ' 2 first characters
iDay = VAL(MID$(sDate, 4, 2)) ' 2 characters at offset 4
iYear = VAL(RIGHT$(sDate, 4)) ' 4 last characters
END SUB
'' Set system date with DATE$
SUB dateSetToday (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER)
DIM sDate AS STRING * 10
' Write the 10-character string.
sDate = STRING$(10, "-")
MID$(sDate, 1, 2) = RIGHT$("0" + LTRIM$(STR$(iMonth)), 2)
MID$(sDate, 4, 2) = RIGHT$("0" + LTRIM$(STR$(iDay)), 2)
MID$(sDate, 7, 4) = RIGHT$("000" + LTRIM$(STR$(iYear)), 4)
' Invoke DATE$ to change the system date.
DATE$ = sDate
END SUB
If for some reason you'd rather not use DATE$ (or you're not coding in BASIC,) it is possible to do the exact same thing with DOS Interrupt 0x21, function 0x2A and 0x2B:
'$INCLUDE: 'QB.BI' DECLARE SUB dateGetToday (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER) DECLARE SUB dateSetToday (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER) DIM iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER ' Get current date. dateGetToday iYear, iMonth, iDay PRINT " Year:"; iYear PRINT "Month:"; iMonth PRINT " Day:"; iDay ' Set date to May 1st, 1995. dateSetToday 1995, 5, 1 PRINT DATE$ ' Restore date to its initial values. dateSetToday iYear, iMonth, iDay '' Get system date with DOS Interrupt 0x21, 0x2A SUB dateGetToday (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER) DIM regsIn AS RegTypeX, regsOut AS RegTypeX ' Function 0x2A - GET SYSTEM DATE (DOS 1+) regsIn.ax = &H2A00 ' Do interrupt. CALL INTERRUPTX(&H21, regsIn, regsOut) ' Return values. iYear = regsOut.cx iMonth = regsOut.dx \ &H100 iDay = regsOut.dx AND &HFF END SUB '' Set system date with DOS Interrupt 0x21, 0x2B SUB dateSetToday (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER) DIM regsIn AS RegTypeX, regsOut AS RegTypeX regsIn.ax = &H2B00 regsIn.cx = iYear ' set date (MUST be a value between 1980 and 2099) regsIn.dx = iMonth * &H100 + iDay CALL INTERRUPTX(&H21, regsIn, regsOut) ' If (regsOut.ax AND &hFF) is not NULL, the date is invalid and ' the system date is left unchanged. END SUB
Please note that DOS' epoch is 1980, meaning that the date must at least be January 1st, 1980. Month value is of course 1 to 12, and day value is in range 1 to 31 (sometimes 28, 29, or 30, depending on the month and leap year.)
Fun fact of the day: On FAT16 file systems, the year is stored on 7 bits, meaning that it may be a value between 0 and 127. Since DOS' epoch is 1980, the latest date the system can represent should be December 31st, 2107. However, DOS only allows years up to 2099 (this is the dreaded year 2100 bug that will hopefully return our civilization back to the Dark Ages for real for real this time.)
Formatted date string
I'm always amazed when I see the visitors count for what is essentially a QuickBASIC-centric page in the year of our Lord 2025. It's absolutely insane. I don't know where you guys come from, but I know one thing: things get messy as soon as they get "international." Take dates representations for instance...
In the US, dates are usually written MM/DD/YYYY (like that DATE$ keyword we just saw) while in Europe, it's usually DD.MM.YYYY. Then, there's the ISO way of doing things with YYYY-MM-DD. To make things even messier, some write months and days with only one digit, and some even remove the first two digits of the year, just because. What is 11/10/12? November 10th 1912, October 11th 2012? Or maybe is it December 10th 1811? Who knows? Well, the guy who wrote that probably knows. But come on, I mean... come on.
Format string parser
Ideally, dates should be stored as integers so we can let the user decide how he wants it displayed. It's not very complex, all we have to do is provide a formatting string, shove our year, month and day into a function, and we get a readable string in return. The formatting string will use codes "Y" for year, "M" for month and "D" for day. It should also support 2-digit padded months and days for "MM" and "DD", return a 3-character string for "MMM" and "DDD" or a full-length string with "MMMM" and "DDDD". Year is slightly different as it will only support "YY" (last two digits, padded) and "YYYY" (whole year, unpadded.)
First, we're just going to parse the format string one character at a time. If we encounter "Y" "M" or "D" we count the number of times it appears in a row:
CONST cDateChrYear = &H59 ' ASCII code for "Y"
CONST cDateChrMonth = &H4D ' ASCII code for "M"
CONST cDateChrDay = &H44 ' ASCII code for "D"
DIM iRead AS INTEGER, iLen AS INTEGER
DIM iThis AS INTEGER, iCnt AS INTEGER
DIM sFormat AS STRING, sOut AS STRING
sFormat = "MM-DD-YYYY"
' Initialize reading offset (beginning) and format string length (end.)
iRead = 1
iLen = LEN(sFormat)
' Parse the whole format string.
DO UNTIL (iRead > iLen)
' Get format string character code.
iThis = ASC(MID$(sFormat, iRead, 1))
SELECT CASE (iThis)
' Y, M, D
CASE cDateChrDay, cDateChrMonth, cDateChrYear
' Count the number of times the character appears.
iChr = iThis
iCnt = 0
DO WHILE (iThis = iChr)
iCnt = iCnt + 1
IF (iRead + iCnt > iLen) THEN EXIT DO
iChr = ASC(MID$(sFormat, iRead + iCnt, 1))
LOOP
' ... TODO, DEBUG ... '
PRINT CHR$(iThis); STR$(iCnt); "x"
' Skip ahead.
iRead = iRead + iCnt
CASE ELSE
' Append as is and skip ahead.
sOut = sOut + CHR$(iThis)
iRead = iRead + 1
END SELECT
LOOP
Now, depending on the format code and its length, we have to return a slightly different string. Functionally, the following would do the trick:
' Day code (1, 2, 3, or 4 characters)
IF ((iThis = cDateChrDay) AND (iCnt = 1)) THEN
sOut = sOut + LTRIM$(STR$(iDay))
ELSEIF ((iThis = cDateChrDay) AND (iCnt = 2)) THEN
sOut = sOut + RIGHT$("0" + LTRIM$(STR$(iDay)), 2)
ELSEIF ((iThis = cDateChrDay) AND (iCnt = 3)) THEN
sOut = sOut + "DAY" ' TODO
ELSEIF ((iThis = cDateChrDay) AND (iCnt = 4)) THEN
sOut = sOut + "LONGDAY" ' TODO
' Month code (1, 2, 3, or 4 characters)
ELSEIF ((iThis = cDateChrMonth) AND (iCnt = 1)) THEN
sOut = sOut + LTRIM$(STR$(iMonth))
ELSEIF ((iThis = cDateChrMonth) AND (iCnt = 2)) THEN
sOut = sOut + RIGHT$("0" + LTRIM$(STR$(iMonth)), 2)
ELSEIF ((iThis = cDateChrMonth) AND (iCnt = 3)) THEN
sOut = sOut + "MONTH" ' TODO
ELSEIF ((iThis = cDateChrMonth) AND (iCnt = 4)) THEN
sOut = sOut + "LONGMONTH" ' TODO
' Year code (2 or 4 characters)
ELSEIF ((iThis = cDateChrYear) AND (iCnt = 2)) THEN
sOut = sOut + RIGHT$("0" + LTRIM$(STR$(iYear)), 2)
ELSEIF ((iThis = cDateChrYear) AND (iCnt = 4)) THEN
sOut = sOut + LTRIM$(STR$(iYear))
' Unsupported code length
ELSE
sOut = sOut + STRING$(iCnt, iThis)
END IF
But it's pretty redundant. So let's substitute iDay, iMonth and iYear with a generic iValue instead:
' Get the proper value according to the format code.
IF (iThis = cDateChrDay) THEN
iValue = iDay
ELSEIF (iThis = cDateChrMonth) THEN
iValue = iMonth
ELSEIF (iThis = cDateChrYear) THEN
iValue = iYear
END IF
' 1-character code is available for month and day. Rather than test against
' D and M, we'll check the code against Y.
IF ((iCnt = 1) AND (iThis <> cDateChrYear)) THEN
sOut = sOut + LTRIM$(STR$(iValue))
' 2-character code is available for year, month and day. In every case, we do
' the exact same thing: pad to 2 digits and take the two rightmost characters.
ELSEIF (iCnt = 2) THEN
sOut = sOut + RIGHT$("0" + LTRIM$(STR$(iValue)), 2)
' 3-character code is available for month and day, and returns a short string.
' We don't have the code we need yet, so we'll leave it alone for now.
ELSEIF ((iCnt = 3) AND (iThis <> cDateChrYear)) THEN
sOut = sOut + "VALUE" ' TODO
' 4-character code is available for month and day, and returns a long string.
' We don't have the code for that either.
ELSEIF ((iCnt = 4) AND (iThis <> cDateChrYear)) THEN
sOut = sOut + "LONGVALUE" ' TODO
' 4-character code is also available for year. Looking at it, we could just
' include it in the first evaluation of the block we wrote earlier.
ELSEIF ((iCnt = 4) AND (iThis = cDateChrYear)) THEN
sOut = sOut + LTRIM$(STR$(iValue))
' Unsupported code length
ELSE
sOut = sOut + STRING$(iCnt, iThis)
END IF
We're getting there... now, let's try to include long and short strings. We're also going to start with a big condition block, something like this:
ELSEIF ((iCnt = 3) AND (iThis <> cDateChrYear)) THEN
IF (iThis = cDateChrMonth) THEN
' iValue is the month, a value between 1 and 12. First we decrement the
' value by 1 to obtain a value between 0 and 11, then we multiply by three
' because each string is 3 characters long, then we add an offset of 1
' because in QuickBASIC, the first character of a string is located at 1,
' not 0. And presto, we can extract the string we want from the list
' without using array or write a huge condition block.
iOfs = 1 + (iValue - 1) * 3
sOut = sOut + MID$("JanFebMarAprMayJunJulAugSepOctNovDec", iOfs, 3)
ELSE
' Same logic for the weekday. Here, iValue is going to be the weekday, a
' value between 0 (Sunday) and 6 (Saturday.) We don't have to code to
' obtain this value yet, but it should look like this:
iOfs = 1 + iValue * 3
sOut = sOut + MID$("SunMonTueWedThuFriSat", iOfs, 3)
END IF
END IF
And again, merge as much stuff as possible together:
' Get the proper value according to the format code, also get the offset for
' the string representation:
IF (iThis = cDateChrDay) THEN
iValue = iDay
' Note: we don't have the dateWeekDay%() function yet. Soon, I swear.
iOfs = 1 + (dateWeekDay%(iYear, iMonth, iDay) * 3)
ELSEIF (iThis = cDateChrMonth) THEN
iValue = iMonth
' Offset iMonth by 7 days (the string starts with the day of the week, then
' proceeds with month names.)
iOfs = 1 + ((7 + iMonth - 1) * 3)
ELSEIF (iThis = cDateChrYear) THEN
iValue = iYear
END IF
' ... MORE CODE ...
ELSEIF ((iCnt = 3) AND (iThis <> cDateChrYear)) THEN
sOut = sOut + MID$("SunMonTueWedThuFriSatJanFebMarAprMayJunJulAugSepOctNovDec", iOfs, 3)
END IF
Yeah, that's better. For long strings, we're going to do the exact same thing: place all our names in one string (padded with spaces to 9 characters.) And get their offset. In fact, we're going to scrap the "short" version of the string and use the full-name string instead because we can easily extract the first three characters if we want to:
' Get the proper value according to the format code, also get the offset for
' the string representation:
IF (iThis = cDateChrDay) THEN
iValue = iDay
' The stride is now 9 characters (for "Wednesday", "September", etc.)
iOfs = 1 + (dateWeekDay%(iYear, iMonth, iDay) * 9)
' Only preserve up to 9 or 3 characters. We could also compute the value
' as 3 ^ (iCnt - 2) if we're hell-bent on removing the conditional block.
IF (iCnt = 4) THEN
iSze = 9
ELSE
iSze = 3
END IF
ELSEIF (iThis = cDateChrMonth) THEN
iValue = iMonth
iOfs = 1 + ((7 + iMonth - 1) * 9)
IF (iCnt = 4) THEN
iSze = 9
ELSE
iSze = 3
END IF
ELSEIF (iThis = cDateChrYear) THEN
iValue = iYear
END IF
' ... MORE CODE ...
' Get string form.
sOut = sOut + LEFT$(RTRIM$(MID$("Sunday Monday Tuesday Wednesday" + _
"Thursday Friday Saturday January " + _
"February March April May " + _
"June July August September" + _
"October November December ", iOfs, 9)), iSze)
After adding a few checks here and there, we get the following function. Note that it requires two new functions we still have to write: dateMonthDays%() (which returns the length of the given month, in days) and dateWeekDay%() (which returns the weekday as an integer between 0 and 6 included.)
DECLARE FUNCTION dateFormat$ (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER, sFormat AS STRING)
CONST cDateChrYear = &H59 ' ASCII code for "Y"
CONST cDateChrMonth = &H4D ' ASCII code for "M"
CONST cDateChrDay = &H44 ' ASCII code for "D"
''
'' Returns a formatted date string. For instance: "YYYY-MM-DD", "MM/DD/YYYY",
'' "DD.MM.YYYY", "MMMM, D YYYY", "DDDD, D MMM. 'YY", etc. Empty strings are
'' returned for invalid dates. You may have to get creative if your string
'' contains M, D or Y that shouldn't be converted. For instance,
'' dateFormat$(y,m,d,"Day: DDDD") should be "Day: "+dateFormat$(y,m,d,"DDDD")
''
FUNCTION dateFormat$ (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER, sFormat AS STRING)
DIM sOut AS STRING, sNew AS STRING, iThis AS INTEGER, iRead AS INTEGER
DIM iCnt AS INTEGER, iChr AS INTEGER, iLen AS INTEGER, iOfs AS INTEGER
' Quick check: arguments make no sense.
IF ((iYear < 1) OR (iMonth < 1) OR (iMonth > 12) OR (iDay < 1)) THEN
EXIT FUNCTION
END IF
IF (iDay > dateMonthDays%(iYear, iMonth)) THEN
EXIT FUNCTION
END IF
' Initialize reading offset (beginning) and format string length (end.)
iRead = 1
iLen = LEN(sFormat)
' Parse the whole format string.
DO UNTIL (iRead > iLen)
' Get format character code.
iThis = ASC(MID$(sFormat, iRead, 1))
SELECT CASE (iThis)
CASE cDateChrDay, cDateChrMonth, cDateChrYear ' D, M, or Y
' Count the number of times the character appears.
iChr = iThis
iCnt = 0
DO WHILE (iThis = iChr)
iCnt = iCnt + 1
IF (iRead + iCnt > iLen) THEN EXIT DO
iChr = ASC(MID$(sFormat, iRead + iCnt, 1))
LOOP
' Get replacement string for D, M, or Y.
IF (iThis = cDateChrDay) THEN
sNew = LTRIM$(STR$(iDay))
iOfs = 1 + (dateWeekDay%(iYear, iMonth, iDay) * 9)
ELSEIF (iThis = cDateChrMonth) THEN
sNew = LTRIM$(STR$(iMonth))
iOfs = 1 + ((7 + iMonth - 1) * 9)
ELSE
sNew = LTRIM$(STR$(iYear))
END IF
' Replace format code.
IF (((iCnt = 1) AND (iThis <> cDateChrYear)) OR ((iCnt = 4) AND (iThis = cDateChrYear))) THEN
sOut = sOut + sNew
ELSEIF (iCnt = 2) THEN
sOut = sOut + RIGHT$("0" + sNew, 2)
ELSEIF (((iCnt = 3) OR (iCnt = 4)) AND (iThis <> cDateChrYear)) THEN
sOut = sOut + LEFT$(RTRIM$(MID$("Sunday Monday Tuesday Wednesday" + _
"Thursday Friday Saturday January " + _
"February March April May " + _
"June July August September" + _
"October November December ", iOfs, 9)), 3 ^ (iCnt - 2))
ELSE
sOut = sOut + MID$(sFormat, iRead, iCnt)
END IF
' Skip ahead.
iRead = iRead + iCnt
CASE ELSE
' Append as is and skip ahead.
sOut = sOut + CHR$(iThis)
iRead = iRead + 1
END SELECT
LOOP
dateFormat$ = sOut
END FUNCTION
Missing bits: days per month
One of the functions we need to get our code working returns the number of days in a month. That's pretty straightfoward for the most part: April, June, September and November are 31 days. February is 28 (non-leap year) or 29 (leap year) days, and the remaining seven months are 30 days. We're going to use a simple SELECT CASE for that. For good measure, we're also going to return 0 if the provided month is invalid.
''
'' Return the length in days (28 to 31,) of a given month (1 to 12.) If the
'' month value is out of bounds, this function returns 0.
''
FUNCTION dateMonthDays% (iYear AS INTEGER, iMonth AS INTEGER)
SELECT CASE (iMonth)
' Month out of bounds, return 0.
CASE IS < 1, IS > 12
dateMonthDays% = 0
' February is 28 - 0 or 28 - -1 days.
CASE 2
dateMonthDays% = 28 - dateLeapYear%(iYear)
' April, June, September and November are 30 days.
CASE 4, 6, 9, 11
dateMonthDays% = 30
' Everything else is 31 days.
CASE ELSE
dateMonthDays% = 31
END SELECT
END FUNCTION
Even more missing bits: leap year
Okay, now we need to determine which year is a leap year. Our next function, dateLeapYear%(), will return True (-1) if the provided year is a leap year or False (0) if it isn't. But first, what's a leap year? Usually a year is 365 days, except on a leap year when it is 366 days. The extra day is added to the month of February, which is usually 28 days (or 29 on leap years.)
Most people will tell you that a leap year happens every four years. Which is always true in the Julian Calendar (named after Julius Caesar, a famous Italian disco dancer from the 70s,) but the system we use nowadays is the Greogrian Calendar so the rules are a little different.
Fun fact of the day: a day is not exactly 24 hours: the most recent calculations determined it is 23 hours, 56 minutes and 4.1 seconds.
According to the Julian Calendar, a year is 365.25 days long. Since it wasn't possible to cut a day in quarters, it was decided that years that could be evenly divided by 4 would be leap years (366 days rather than the usual 365.) This model sort of worked until someone realized that every 128 years the calendar was drifting by a day. By 1582 AD, it had drifted over 10 days and it would only make calculating seasons harder as the gap increased in time. That's when the new Gregorian calendar was introduced, estimating that a year was 365.2422 and 365.2424 days in tropical and equinox years.
When the shift between Julian and Gregorian Calendar was made, 10 days were omitted from the Julian Calendar to account for the inaccuracy: the day following October 4 (Julian Calendar) is known as October 15, 1582 (Gregorian Calendar.) In the US and UK, the shift was made on September 14th 1752... For your edification, here's how to determine if a date should belong to the Julian or Gregorian calendar:
'' Return True (-1) if the date falls in the Gregorian Calendar.
FUNCTION dateGregorian%(iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER)
dateGregorian% = (iYear > 1582) OR ((iYear = 1582) AND _
((iMonth > 10) OR ((iMonth = 10) AND iDay >= 15)))
END FUNCTION
If you think this is confusing, imagine what people born on the 29th of February must feel. Anyway, the gist of it is: a leap year must be evenly divisible by 4, but it cannot be evenly divided by 100 unless it is also divisible by 400. So:
DECLARE FUNCTION dateLeapYear%(iYear AS INTEGER)
CONST True = -1
CONST False = 0
DIM iYear AS INTEGER
iYear = 1995
PRINT LTRIM$(STR$(iYear));" is";
IF (dateLeapYear%(iYear) = False) THEN
PRINT "n't";
END IF
PRINT " a leap year"
'' Return True (-1) if iYear is 366 days long, False (0) otherwise.
FUNCTION dateLeapYear%(iYear AS INTEGER)
' Cannot be evenly divided by 4.
IF (iYear MOD 4) THEN
dateLeapYear% = False
' Is evenly divided by 4, it MAY be a leap year...
ELSE
' If it is also evenly divided by 100 it is NOT a leap year, unless..
IF ((iYear MOD 100) = 0) THEN
' It can also be evenly divided by 400.
IF ((iYear MOD 400) = 0) THEN
dateLeapYear% = True
ELSE
dateLeapYear% = False
END IF
ELSE
dateLeapYear% = False
END IF
END IF
END FUNCTION
It's a little bit clumsy but it works. Let's tidy it up a bit:
'' Return True (-1) if the specified year is a leap year, False (0) otherwise. FUNCTION dateLeapYear% (iYear AS INTEGER) dateLeapYear% = ((((iYear MOD 4) = 0) AND ((iYear MOD 100) <> 0)) OR ((iYear MOD 400) = 0)) END FUNCTION
Great, now we can determine if we have a leap year and the number of days in a month. The last piece of the puzzle is a lot more complex and is going to tell us the day of the week.
Last missing bit: weekday
I'm a bit ashamed (only a tiny little bit) to admit it, but I can't explain the values used for that one. If I had to guess, the intricacies of those values would require an entire book to explain. As you all know, I can't read. And I'm not dedicated enough to learn how to. But what I can tell you is that the following function will return an index that matches the day of the week: 0 is Sunday, 1 is Monday, 5 is Friday, 6 is Saturday, and anything in-between.
''
'' Return the day of the week (0 to 6) for the given date; 0 is Sunday, 6 is
'' Saturday.
''
FUNCTION dateWeekDay% (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER)
DIM iCode AS INTEGER, iTemp AS INTEGER
' Set decade code
iTemp = iYear MOD 100
iCode = ((iTemp \ 4) + iTemp) MOD 7
' Add century code
iTemp = iYear \ 100
iCode = iCode + ((3 - (ABS((iTemp - 16) MOD 4))) * 2)
' Add leap code
iCode = iCode + ((iMonth < 3) AND dateLeapYear%(iYear))
' Add month code
iCode = iCode + (ASC(MID$("033614625035", iMonth, 1)) - 48)
' Return week day: 0 (Sunday) to 6 (Saturday)
dateWeekDay% = ((iCode + iDay) MOD 7)
END FUNCTION
Date serials
So far, we learned how to obtain and set the system date, compute when a leap year occures, get the number of days in a month, how to format arbitrary dates to human-readable strings, and we learned absolutely nothing about the day of the week. The final frontier(tm) might be date serials. Date serials represent the number of days elapsed since a specific date (for Excel, it is January 1st, 1900) and are useful to compute the number of days elapsed between two dates.
Fun fact of the day: to maintain compatibility with Lotus 1-2-3, Microsoft Excel (wrongly) assumes 1900 to be a leap year (it's not) when calculating date serials. Thus, Excel claims that February 29th, 1900 is a valid date, which offsets date serials by 1 as soon as March 1900. It is entirely possible that other softwares also implemented this quirk to be comptabile with Microsoft Excel.
DECLARE FUNCTION dateSerial& (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER)
DIM iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER
DIM iToday AS LONG, iXmas AS LONG
' Get today's date, convert to serial.
dateGetToday iYear, iMonth, iDay
iToday = dateSerial&(iYear, iMonth, iDay)
' Get serial for this year's Christmas.
iXmas = dateSerial&(iYear, 12, 25)
' How many days before Christmas?
IF (iXmas = iToday) THEN
PRINT "Merry Christmas!"
ELSEIF (iXmas < iToday) THEN
PRINT "Christmas was"; iToday - iXmas; "day(s) ago."
ELSE
PRINT "TriOptimum reminds you that there are only"; iXmas - iToday;
PRINT "shopping day(s) until Christmas!"
END IF
'' This function returns a 32-bit integer equivalent to the number of days
'' elapsed since January 1st, 1900.
FUNCTION dateSerial& (iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER)
DIM iRefYear AS INTEGER, iRefLeap AS INTEGER ' Reference year (1900)
DIM iPrvYear AS INTEGER, iPrvLeap AS INTEGER ' Previous year (iYear - 1)
DIM iSerial AS LONG
' Add 365 days for every year elapsed since 1900.
iSerial = (365& * (iYear - 1900))
' Add one day for each leap year in that same period.
iRefYear = 1900: iPrvYear = iYear - 1
iRefLeap = (iRefYear \ 4) - (iRefYear \ 100) + (iRefYear \ 400)
iPrvLeap = (iPrvYear \ 4) - (iPrvYear \ 100) + (iPrvYear \ 400)
iSerial = iSerial + iPrvLeap - iRefLeap
' Add days for every elapsed month.
FOR i% = 1 TO iMonth - 1
iSerial = iSerial + dateMonthDays%(iYear, iMonth)
NEXT i%
' Add remaining days.
dateSerial& = iSerial + (iDay - 1)
END FUNCTION
If we want to determine what will be the date twenty three days from now, we simply convert the current date to a serial, add 23, and convert the result back into a date... so let's write a serial to date converter.
'' This routine finds the date that is iSerial days away from January 1st 1900.
SUB dateFromSerial (iSerial AS LONG, iYear AS INTEGER, iMonth AS INTEGER, iDay AS INTEGER)
DIM iPrvYear AS INTEGER, iPrvLeap AS INTEGER, iRefLeap AS INTEGER
DIM iRefYear AS INTEGER, iRefMonth AS INTEGER, iRefDays AS INTEGER
DIM iRefSerial AS LONG
' Copy the source serial, we don't want to modify it.
iRefSerial = iSerial
' Serial = 0
iYear = 1900
iMonth = 1
iDay = 1
' Estimate the number of years elapsed (assume none are leap)
iYear = iYear + (iRefSerial \ 365&)
iRefSerial = iRefSerial MOD 365
' Count the number of leap years among our estimation.
iRefYear = 1900: iPrvYear = iYear - 1
iRefLeap = (iRefYear \ 4) - (iRefYear \ 100) + (iRefYear \ 400)
iPrvLeap = (iPrvYear \ 4) - (iPrvYear \ 100) + (iPrvYear \ 400)
iRefSerial = iRefSerial - (iPrvLeap - iRefLeap)
' iRefSerial represents days. If we have a negative count, we counted far
' more years than we should have. Exchange some for days until iRefSerial is
' positive again.
WHILE (iRefSerial < 0)
iYear = iYear - 1
iRefSerial = iRefSerial + 365 - dateLeapYear(iYear)
WEND
' Months
DO
iRefDays = dateMonthDays%(iYear, iMonth)
IF (iRefSerial < iRefDays) THEN EXIT DO
iRefSerial = iRefSerial - iRefDays
iMonth = iMonth + 1
LOOP
' Whatever remains
iDay = iDay + iRefSerial
END SUB
It may not seem like much, but now we should have everything we need to do some in-depth stuff including: computing the date of Easter, find the first day of a week, retrieve the Nth Wednesday of the month, etc. The sky's the limit! And also INTEGERs. INTEGERs are a pretty hard limit indeed. Have fun!