Here's the next version.
What's new:
1. Rules based date calculations
a. Gregorian rules
b. Christian and Orthodox rules
c. Support to flag weekdays as business/non business days
d. Rules can be flagged to be save automatically for business day calculations -
there is a hard limit of 1000 rules that can be saved
2. Julian Calendar
3. ISO Calendar
4. Business Date Calculations
a. Erase saved rules
b. Set a weekday as a business or non business day
c. Get all saved rule calculated non business dates
d. Check if a date is a business day
e. Get weekday business day status
f. Get limit on maximum number of non business dates supported
g. Get current number of non business dates saved
h. Get number of business days between two dates
i. Get number of non business days between two dates
j. Get first business day of a month and year
k. Get last business day of a month and year
l. Add/Subtract business days from a date
Next up is the Chinese calendar which requires all the astronomy related stuff, and, we'll add my favorite astronomy functions.
Here is test script. If you use FF, turn on your console option.
Dim oCalendar as cCalendar
Dim sToday as String
Dim arRules() as DATE_CALCULATION
Dim uGreg1 as GREGORIAN_DATE
Dim uGreg2 as GREGORIAN_DATE
Dim uGregToday as GREGORIAN_DATE
Dim uJulian as JULIAN_DATE
Dim uISO as ISO_DATE
Dim nSerial as LongInt
Dim nSerialStart as LongInt
Dim nSerialEnd as LongInt
Dim iIndex as Long
Dim nYear as Long
Dim bBusinessWeekday as BOOLEAN
Dim arNonBusinessDates() as LongInt
sToday = Date
uGregToday.Month = Val(Left(sToday,2))
uGregToday.Day = Val(Mid(sToday,4,2))
uGregToday.Year = Val(Right(sToday,4))
nSerial = oCalendar.SerialFromGregorian(uGregToday)
oCalendar.JulianFromSerial(nSerial,uJulian)
oCalendar.ISOFromSerial(nSerial,uISO)
Print "Today is..."
Print Str(uGregToday.Month) + "/" + Str(uGregToday.Day) + "/" + Str(uGregToday.Year) + " (Gregorian)"
Print Str(uJulian.Month) + "/" + Str(uJulian.Day) + "/" + Str(uJulian.Year) + " (Julian)"
Print Str(uISO.Day) + ".Day " + Str(uISO.Week) + ".Week " + Str(uISO.Year) + " (Year has " + _
Str(IIf(uISO.LongYear = False,52,53)) + " weeks)" + " (ISO)"
Print ""
' US Federal Holidays
ReDim arRules(0 To 10)
nYear = uGregToday.Year
' Holidays that fall on a Saturday are observed on Fri, Sunday on Monday
arRules(0).Name = "New Year's Day"
arRules(0).Month = cCalendarClass.JANUARY
arRules(0).Day = 1
arRules(0).Year = nYear
arRules(0).RuleClass = cCalendarClass.GREGORIAN_RULES
arRules(0).Rule = cCalendarClass.NO_RULES
arRules(0).Weekday = cCalendarClass.ALL_WEEKDAYS
arRules(0).SaturdayRule = cCalendarClass.SATURDAY_OBSERVED_ON_FRIDAY
arRules(0).SundayRule = cCalendarClass.SUNDAY_OBSERVED_ON_MONDAY
arRules(0).YearRule = cCalendarClass.ALL_YEARS
arRules(0).NonBusinessDate = True
arRules(1).Name = "Martin Luther King Day"
arRules(1).Month = cCalendarClass.JANUARY
arRules(1).Day = 0
arRules(1).Year = nYear
arRules(1).RuleClass = cCalendarClass.GREGORIAN_RULES
arRules(1).Rule = cCalendarClass.THIRD_WEEK
arRules(1).Weekday = cCalendarClass.MONDAY
arRules(1).SaturdayRule = cCalendarClass.NO_SATURDAY_RULE
arRules(1).SundayRule = cCalendarClass.NO_SUNDAY_RULE
arRules(1).YearRule = cCalendarClass.ALL_YEARS
arRules(1).NonBusinessDate = True
' This holiday Is designated as "Washington’s Birthday" in section 6103(a) of title 5 of the United States Code,
' which is the law that specifies holidays for Federal employees.
arRules(2).Name = "Washington's Birthday"
arRules(2).Month = cCalendarClass.FEBRUARY
arRules(2).Day = 0
arRules(2).Year = nYear
arRules(2).RuleClass = cCalendarClass.GREGORIAN_RULES
arRules(2).Rule = cCalendarClass.THIRD_WEEK
arRules(2).Weekday = cCalendarClass.MONDAY
arRules(2).SaturdayRule = cCalendarClass.NO_SATURDAY_RULE
arRules(2).SundayRule = cCalendarClass.NO_SUNDAY_RULE
arRules(2).YearRule = cCalendarClass.ALL_YEARS
arRules(2).NonBusinessDate = True
arRules(3).Name = "Memorial Day"
arRules(3).Month = cCalendarClass.MAY
arRules(3).Day = 0
arRules(3).Year = nYear
arRules(3).RuleClass = cCalendarClass.GREGORIAN_RULES
arRules(3).Rule = cCalendarClass.LAST_WEEK
arRules(3).Weekday = cCalendarClass.MONDAY
arRules(3).SaturdayRule = cCalendarClass.NO_SATURDAY_RULE
arRules(3).SundayRule = cCalendarClass.NO_SUNDAY_RULE
arRules(3).YearRule = cCalendarClass.ALL_YEARS
arRules(3).NonBusinessDate = True
arRules(4).Name = "Independence Day"
arRules(4).Month = cCalendarClass.JULY
arRules(4).Day = 4
arRules(4).Year = nYear
arRules(4).RuleClass = cCalendarClass.GREGORIAN_RULES
arRules(4).Rule = cCalendarClass.NO_RULES
arRules(4).Weekday = cCalendarClass.ALL_WEEKDAYS
arRules(4).SaturdayRule = cCalendarClass.SATURDAY_OBSERVED_ON_FRIDAY
arRules(4).SundayRule = cCalendarClass.SUNDAY_OBSERVED_ON_MONDAY
arRules(4).YearRule = cCalendarClass.ALL_YEARS
arRules(4).NonBusinessDate = True
arRules(5).Name = "Labor Day"
arRules(5).Month = cCalendarClass.SEPTEMBER
arRules(5).Day = 0
arRules(5).Year = nYear
arRules(5).RuleClass = cCalendarClass.GREGORIAN_RULES
arRules(5).Rule = cCalendarClass.FIRST_WEEK
arRules(5).Weekday = cCalendarClass.MONDAY
arRules(5).SaturdayRule = cCalendarClass.NO_SATURDAY_RULE
arRules(5).SundayRule = cCalendarClass.NO_SUNDAY_RULE
arRules(5).YearRule = cCalendarClass.ALL_YEARS
arRules(5).NonBusinessDate = True
arRules(6).Name = "Columbus Day"
arRules(6).Month = cCalendarClass.OCTOBER
arRules(6).Day = 0
arRules(6).Year = nYear
arRules(6).RuleClass = cCalendarClass.GREGORIAN_RULES
arRules(6).Rule = cCalendarClass.SECOND_WEEK
arRules(6).Weekday = cCalendarClass.MONDAY
arRules(6).SaturdayRule = cCalendarClass.NO_SATURDAY_RULE
arRules(6).SundayRule = cCalendarClass.NO_SUNDAY_RULE
arRules(6).YearRule = cCalendarClass.ALL_YEARS
arRules(6).NonBusinessDate = True
arRules(7).Name = "Veteran's Day"
arRules(7).Month = cCalendarClass.NOVEMBER
arRules(7).Day = 11
arRules(7).Year = nYear
arRules(7).RuleClass = cCalendarClass.GREGORIAN_RULES
arRules(7).Rule = cCalendarClass.NO_RULES
arRules(7).Weekday = cCalendarClass.ALL_WEEKDAYS
arRules(7).SaturdayRule = cCalendarClass.SATURDAY_OBSERVED_ON_FRIDAY
arRules(7).SundayRule = cCalendarClass.SUNDAY_OBSERVED_ON_MONDAY
arRules(7).YearRule = cCalendarClass.ALL_YEARS
arRules(7).NonBusinessDate = True
arRules(8).Name = "Thanksgiving Day"
arRules(8).Month = cCalendarClass.NOVEMBER
arRules(8).Day = 0
arRules(8).Year = nYear
arRules(8).RuleClass = cCalendarClass.GREGORIAN_RULES
arRules(8).Rule = cCalendarClass.FOURTH_WEEK
arRules(8).Weekday = cCalendarClass.THURSDAY
arRules(8).SaturdayRule = cCalendarClass.NO_SATURDAY_RULE
arRules(8).SundayRule = cCalendarClass.NO_SUNDAY_RULE
arRules(8).YearRule = cCalendarClass.ALL_YEARS
arRules(8).NonBusinessDate = True
arRules(9).Name = "Christmas Day"
arRules(9).Month = cCalendarClass.DECEMBER
arRules(9).Day = 25
arRules(9).Year = nYear
arRules(9).RuleClass = cCalendarClass.GREGORIAN_RULES
arRules(9).Rule = cCalendarClass.NO_RULES
arRules(9).Weekday = cCalendarClass.ALL_WEEKDAYS
arRules(9).SaturdayRule = cCalendarClass.SATURDAY_OBSERVED_ON_FRIDAY
arRules(9).SundayRule = cCalendarClass.SUNDAY_OBSERVED_ON_MONDAY
arRules(9).YearRule = cCalendarClass.ALL_YEARS
arRules(9).NonBusinessDate = True
arRules(10).Name = "Inauguration Day"
arRules(10).Month = cCalendarClass.JANUARY
arRules(10).Day = 20
arRules(10).Year = nYear + 1
arRules(10).RuleClass = cCalendarClass.GREGORIAN_RULES
arRules(10).Rule = cCalendarClass.NO_RULES
arRules(10).Weekday = cCalendarClass.ALL_WEEKDAYS
arRules(10).SaturdayRule = cCalendarClass.NO_SATURDAY_RULE
arRules(10).SundayRule = cCalendarClass.SUNDAY_OBSERVED_ON_MONDAY
arRules(10).YearRule = cCalendarClass.YEARS_AFTER_LEAP_ONLY
arRules(10).NonBusinessDate = False
oCalendar.DateCalculation(arRules())
Print "Gregorian Date calculations (USA Federal Holidays)"
For iIndex = 0 To UBound(arRules)
oCalendar.GregorianFromSerial(arRules(iIndex).ObservedDays1,uGreg1)
oCalendar.GregorianFromSerial(arRules(iIndex).ObservedDays2,uGreg2)
Print arRules(iIndex).Name + " - " + Str(uGreg1.Month) + "/" + Str(uGreg1.Day) + "/" + Str(uGreg1.Year) + _
IIf(arRules(iIndex).Observed = True, _
IIf(arRules(iIndex).ObservedDays1 = arRules(iIndex).ObservedDays2,""," (Observed on " + _
Str(uGreg2.Month) + "/" + Str(uGreg2.Day) + "/" + Str(uGreg2.Year) + ")"), " (Not Observed)")
Next
oCalendar.GetSavedNonBusinessDates(arNonBusinessDates())
Print "Maximum limit for saved business date calculations is " + Str(oCalendar.NonBusinessDatesLimit)
Print "Dates saved for business date calculations is " + Str(oCalendar.NonBusinessDatesSaved)
If UBound(arNonBusinessDates) >= 0 Then
For iIndex = 0 To UBound(arNonBusinessDates)
oCalendar.GregorianFromSerial(arNonBusinessDates(iIndex),uGreg1)
Print Str(uGreg1.Month) + "/" + Str(uGreg1.Day) + "/" + Str(uGreg1.Year)
Next
End If
nSerial = oCalendar.BusinessMonthBegin(uGregToday.Month,uGregToday.Year)
oCalendar.GregorianFromSerial(nSerial,uGreg1)
Print "Business Begin of Month is " + Str(uGreg1.Month) + "/" + Str(uGreg1.Day) + "/" + Str(uGreg1.Year)
nSerial = oCalendar.BusinessMonthEnd(uGregToday.Month,uGregToday.Year)
oCalendar.GregorianFromSerial(nSerial,uGreg1)
Print "Business End of Month is " + Str(uGreg1.Month) + "/" + Str(uGreg1.Day) + "/" + Str(uGreg1.Year)
nSerial = oCalendar.SerialFromGregorian(uGregToday)
oCalendar.GregorianFromSerial(oCalendar.AddBusinessDays(nSerial,14),uGreg1)
Print "Today + 14 business days is " + Str(uGreg1.Month) + "/" + Str(uGreg1.Day) + "/" + Str(uGreg1.Year)
oCalendar.GregorianFromSerial(oCalendar.AddBusinessDays(nSerial,-14),uGreg1)
Print "Today - 14 business days is " + Str(uGreg1.Month) + "/" + Str(uGreg1.Day) + "/" + Str(uGreg1.Year)
Print "Check for business day..."
uGreg1.Month = cCalendarClass.JANUARY
uGreg1.Day = 3
uGreg1.Year = nYear
nSerial = oCalendar.SerialFromGregorian(uGreg1)
Print Str(uGreg1.Month) + "/" + Str(uGreg1.Day) + "/" + Str(uGreg1.Year) + " business day is " + _
Str(oCalendar.IsBusinessDay(nSerial))
uGreg1.Month = cCalendarClass.DECEMBER
uGreg1.Day = 31
uGreg1.Year = nYear - 1
nSerialStart = oCalendar.SerialFromGregorian(uGreg1)
uGreg1.Month = cCalendarClass.FEBRUARY
uGreg1.Day = 1
uGreg1.Year = nYear
nSerialEnd = oCalendar.SerialFromGregorian(uGreg1)
Print "Business days in the month of Jan " + Str(nYear) + " is " + _
Str(oCalendar.BusinessDaysBetween(nSerialStart,nSerialEnd))
Print "Non Business days in the month of Jan " + Str(nYear) + " is " + _
Str(oCalendar.NonBusinessDaysBetween(nSerialStart,nSerialEnd))
Print "Saturday as a workday is " + Str(oCalendar.GetBusinessWeekday(cCalendarClass.SATURDAY))
oCalendar.SetBusinessWeekday(cCalendarClass.SATURDAY,True)
Print "Updated Saturday as a workday is " + Str(oCalendar.GetBusinessWeekday(cCalendarClass.SATURDAY))
Print ""
Print "Calculations for Catholic and Protestant churches"
ReDim arRules(0 To 15)
' Easter based holidays do not apply weekday or year observation rules
arRules(0).Name = "Sexagesima Sunday"
arRules(0).Year = nYear
arRules(0).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(0).Rule = cCalendarClass.CHRISTIAN_EASTER_SEXAGESIMASUNDAY
arRules(0).NonBusinessDate = False
arRules(1).Name = "Shrove Sunday"
arRules(1).Year = nYear
arRules(1).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(1).Rule = cCalendarClass.CHRISTIAN_EASTER_SHROVESUNDAY
arRules(1).NonBusinessDate = False
arRules(2).Name = "Shrove Monday"
arRules(2).Year = nYear
arRules(2).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(2).Rule = cCalendarClass.CHRISTIAN_EASTER_SHROVEMONDAY
arRules(2).NonBusinessDate = False
arRules(3).Name = "Mardi Gras"
arRules(3).Year = nYear
arRules(3).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(3).Rule = cCalendarClass.CHRISTIAN_EASTER_MARDIGRAS
arRules(3).NonBusinessDate = False
arRules(4).Name = "Ash Wednesday"
arRules(4).Year = nYear
arRules(4).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(4).Rule = cCalendarClass.CHRISTIAN_EASTER_ASHWEDNESDAY
arRules(4).NonBusinessDate = False
arRules(5).Name = "Mothering Sunday"
arRules(5).Year = nYear
arRules(5).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(5).Rule = cCalendarClass.CHRISTIAN_EASTER_MOTHERINGSUNDAY
arRules(5).NonBusinessDate = False
arRules(6).Name = "Palm Sunday"
arRules(6).Year = nYear
arRules(6).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(6).Rule = cCalendarClass.CHRISTIAN_EASTER_PALMSUNDAY
arRules(6).NonBusinessDate = False
arRules(7).Name = "Maundy Thursday"
arRules(7).Year = nYear
arRules(7).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(7).Rule = cCalendarClass.CHRISTIAN_EASTER_MAUNDYTHURSDAY
arRules(7).NonBusinessDate = False
arRules(8).Name = "Good Friday"
arRules(8).Year = nYear
arRules(8).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(8).Rule = cCalendarClass.CHRISTIAN_EASTER_GOODFRIDAY
arRules(8).NonBusinessDate = False
arRules(9).Name = "Easter"
arRules(9).Year = nYear
arRules(9).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(9).Rule = cCalendarClass.CHRISTIAN_EASTER_EASTER
arRules(9).NonBusinessDate = False
arRules(10).Name = "Easter Monday"
arRules(10).Year = nYear
arRules(10).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(10).Rule = cCalendarClass.CHRISTIAN_EASTER_EASTERMONDAY
arRules(10).NonBusinessDate = False
arRules(11).Name = "Rogation Sunday"
arRules(11).Year = nYear
arRules(11).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(11).Rule = cCalendarClass.CHRISTIAN_EASTER_ROGATIONSUNDAY
arRules(11).NonBusinessDate = False
arRules(12).Name = "Ascension"
arRules(12).Year = nYear
arRules(12).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(12).Rule = cCalendarClass.CHRISTIAN_EASTER_ASCENSION
arRules(12).NonBusinessDate = False
arRules(13).Name = "Pentecost"
arRules(13).Year = nYear
arRules(13).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(13).Rule = cCalendarClass.CHRISTIAN_EASTER_PENTECOST
arRules(13).NonBusinessDate = False
arRules(14).Name = "Trinity Sunday"
arRules(14).Year = nYear
arRules(14).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(14).Rule = cCalendarClass.CHRISTIAN_EASTER_TRINITYSUNDAY
arRules(14).NonBusinessDate = False
arRules(15).Name = "Corpus Christi"
arRules(15).Year = nYear
arRules(15).RuleClass = cCalendarClass.CHRISTIANEASTER_RULES
arRules(15).Rule = cCalendarClass.CHRISTIAN_EASTER_CORPUSCHRISTI
arRules(15).NonBusinessDate = False
oCalendar.DateCalculation(arRules())
For iIndex = 0 To UBound(arRules)
oCalendar.GregorianFromSerial(arRules(iIndex).ObservedDays1,uGreg1)
Print arRules(iIndex).Name + " - " + Str(uGreg1.Month) + "/" + Str(uGreg1.Day) + "/" + Str(uGreg1.Year)
Next
Print ""
Print "Calculations for Orthodox churches"
ReDim arRules(0 To 9)
arRules(0).Name = "New Year"
arRules(0).Year = nYear
arRules(0).RuleClass = cCalendarClass.ORTHODOXEASTER_RULES
arRules(0).Rule = cCalendarClass.ORTHODOX_EASTER_NEWYEAR
arRules(0).NonBusinessDate = False
arRules(1).Name = "Great Lent"
arRules(1).Year = nYear
arRules(1).RuleClass = cCalendarClass.ORTHODOXEASTER_RULES
arRules(1).Rule = cCalendarClass.ORTHODOX_EASTER_GREATLENT
arRules(1).NonBusinessDate = False
arRules(2).Name = "Forgiveness Sunday"
arRules(2).Year = nYear
arRules(2).RuleClass = cCalendarClass.ORTHODOXEASTER_RULES
arRules(2).Rule = cCalendarClass.ORTHODOX_EASTER_FORGIVENESSSUNDAY
arRules(2).NonBusinessDate = False
arRules(3).Name = "Palm Sunday"
arRules(3).Year = nYear
arRules(3).RuleClass = cCalendarClass.ORTHODOXEASTER_RULES
arRules(3).Rule = cCalendarClass.ORTHODOX_EASTER_PALMSUNDAY
arRules(3).NonBusinessDate = False
arRules(4).Name = "Good Friday"
arRules(4).Year = nYear
arRules(4).RuleClass = cCalendarClass.ORTHODOXEASTER_RULES
arRules(4).Rule = cCalendarClass.ORTHODOX_EASTER_GOODFRIDAY
arRules(4).NonBusinessDate = False
arRules(5).Name = "Easter"
arRules(5).Year = nYear
arRules(5).RuleClass = cCalendarClass.ORTHODOXEASTER_RULES
arRules(5).Rule = cCalendarClass.ORTHODOX_EASTER_EASTER
arRules(5).NonBusinessDate = False
arRules(6).Name = "Feast of Ascension"
arRules(6).Year = nYear
arRules(6).RuleClass = cCalendarClass.ORTHODOXEASTER_RULES
arRules(6).Rule = cCalendarClass.ORTHODOX_EASTER_FEASTOFASCENSION
arRules(6).NonBusinessDate = False
arRules(7).Name = "Pentecost"
arRules(7).Year = nYear
arRules(7).RuleClass = cCalendarClass.ORTHODOXEASTER_RULES
arRules(7).Rule = cCalendarClass.ORTHODOX_EASTER_PENTECOST
arRules(7).NonBusinessDate = False
arRules(8).Name = "Apostles Fast"
arRules(8).Year = nYear
arRules(8).RuleClass = cCalendarClass.ORTHODOXEASTER_RULES
arRules(8).Rule = cCalendarClass.ORTHODOX_EASTER_APOSTLESFAST
arRules(8).NonBusinessDate = False
arRules(9).Name = "All Saints Sunday"
arRules(9).Year = nYear
arRules(9).RuleClass = cCalendarClass.ORTHODOXEASTER_RULES
arRules(9).Rule = cCalendarClass.ORTHODOX_EASTER_ALLSAINTSSUNDAY
arRules(9).NonBusinessDate = False
oCalendar.DateCalculation(arRules())
For iIndex = 0 To UBound(arRules)
oCalendar.GregorianFromSerial(arRules(iIndex).ObservedDays1,uGreg1)
Print arRules(iIndex).Name + " - " + Str(uGreg1.Month) + "/" + Str(uGreg1.Day) + "/" + Str(uGreg1.Year)
Next
Hi Richard,
Just in case you don't know, if you add private to the functions or procedures, e.g. Private Function cCalendar.cmFloor(ByVal x as Double) as Long, the ones not called won't be added to the executable. It is a sort of dead code removal when using source code, not libraries.
Keep the good work.
Thanks for the tip. A mass replace of Function or Sub with Private Function or Private Sub could do that easily.
Jose - Is there any downside to just marking all functions and subs are private for maximum dead code removal? There is so much interweaving of the functions that I get dizzy just trying to figure out what would be good candidates to mark as private.
If you're going to use them as an include file, not a DLL or library, you can mark all of them. The compiler flags those that aren't called anywhere in the program. If it is called, it is included; otherwise, don't. In my include files, I have marked all the functions, subs, and even constructors and destructors of the classes without problems.
Don't mark as private a function that you want to export (DLL) or that you're going to include in a library, a callback if it can be called by an external program, or an event's class. It is similar to the dead code removal of PowerBASIC, except that in PB it is the default and you have to mark as COMMON or as COM those that should not be removed even if they aren't called in the program.