 VB.Net - Converting Calendar Dates

Calculating Dates of Variable Feasts
This section provides a set of functions for calculating festival dates (Easter, Solstice etc.) for any year. The formulae are designed for readers in the UK and may need adjusting in other countries.

Some of these functions are fairly complex. If you are only intereted in a few specific years, it may ve easier to use a look-up table based on an open-source festival date listing.

Easter (Western Christian used in the UK)
``` Public Shared Function Easter_Date(ByVal yyyy As Integer) As Date ' This calculation is sometimes called the Computus Dim a, b, c, d, e, f, g, h, i, k, l, m, mm, dd As Integer a = yyyy Mod 19 b = yyyy \ 100 c = yyyy Mod 100 d = b \ 4 e = b Mod 4 f = (b + 8) \ 25 g = (b - f + 1) \ 3 h = (19 * a + b - d - g + 15) Mod 30 i = c \ 4 k = c Mod 4 l = (32 + 2 * e + 2 * i - h - k) Mod 7 m = (a + 11 * h + 22 * l) \ 451 mm = (h + l - 7 * m + 114) \ 31 dd = ((h + l - 7 * m + 114) Mod 31) + 1 Return New Date(yyyy, mm, dd, 12, 0, 0) ' returned value is Western Easter date valid for all years after 1600 End Function ```

Easter (Western Orthodox)
``` Public Shared Function Orthodox_Easter_Date(ByVal yyyy As Integer) As Date Dim r1, r2, r3, r4, r5, ra, rb, rc As Integer Dim Jul2Greg As Integer r1 = yyyy Mod 19 r2 = yyyy Mod 4 r3 = yyyy Mod 7 ra = 19 * r1 + 16 r4 = ra Mod 30 rb = 2 * r2 + 4 * r3 + 6 * r4 r5 = rb Mod 7 rc = r4 + r5 Dim eDate As New Date(yyyy, 3, 21) eDate = DateAdd(DateInterval.Day, rc, eDate) Jul2Greg = CInt((Int(yyyy \ 100) * 3) / 4) - 2 eDate = DateAdd(DateInterval.Day, Jul2Greg, eDate) Return eDate End Function ```

Rosh Hashhanah
``` Public Shared Function RoshHashhanah(ByVal yyyy As Integer) As Date Dim golden As Integer = (yyyy Mod 19) + 1 Dim golden12 As Integer = golden * 12 Dim mm, dd As Integer Dim rosh As Date Dim wd As System.DayOfWeek Dim a As Double, frac As Double a = (Math.Floor(yyyy / 100) - Math.Floor(yyyy / 400) - 2) + (765433 / 492480 * (golden12 Mod 19)) + ((yyyy Mod 4) / 4) - (((313 * yyyy) + 89081) / 98496) mm = 9 dd = CInt(Math.Floor(a)) If dd > 30 Then dd -= 30 mm += 1 End If rosh = New Date(yyyy, mm, dd) wd = rosh.DayOfWeek ' Postponement rule 1 - add 1 day if Sunday, Wednesday or Friday If ((wd = DayOfWeek.Sunday) Or (wd = DayOfWeek.Wednesday) Or (wd = DayOfWeek.Friday)) Then rosh = rosh.AddDays(1) End If ' Postponement rule 2 - add 1 day if Monday and fraction>?/? and 12G%19>11 If (wd = DayOfWeek.Monday) Then frac = a - Math.Floor(a) If (frac > (23269 / 25920)) Then If (golden12 Mod 19) > 11 Then rosh = rosh.AddDays(1) End If End If End If ' Postponement rule 3 - add 2 days if Tuesday and frac>?/? and 12G%19>6 If wd = DayOfWeek.Tuesday Then frac = a - Math.Floor(a) If (frac > (1367 / 2160)) Then If ((golden12 Mod 19) > 6) Then rosh = rosh.AddDays(2) End If End If End If Return rosh End Function ```

Autumn Equinox
``` Private Shared Function AutumnEquinox(yyyy As Integer) As Date ' function error margin about 40 minutes Dim basedate As Date Dim offset As Double offset = 365.24218967 yyyy -= 2010 'offset = 365.2425 * yyyy offset *= yyyy basedate = New Date(2010, 9, 23, 3, 9, 0) basedate = basedate.AddDays(offset) Return basedate ```

Spring Equinox
``` Private Shared Function SpringEquinox(yyyy As Integer) As Date ' function error margin about 40 minutes Dim basedate As Date Dim offset As Double = 365.24218967 yyyy -= 2010 'offset = 365.2425 * yyyy offset *= yyyy basedate = New Date(2010, 3, 20, 17, 32, 0) basedate = basedate.AddDays(offset) Return basedate End Function ```

Summer Solstice
``` Private Shared Function SummerSolstice(yyyy As Integer) As Date ' function error margin about 40 minutes Dim basedate As Date Dim offset As Double offset = 365.24218967 yyyy -= 2010 'offset = 365.2425 * yyyy offset *= yyyy basedate = New Date(2010, 6, 21, 11, 28, 0) basedate = basedate.AddDays(offset) Return (basedate) End Function ```

Winter Solstice
``` Private Shared Function WinterSolstice(yyyy As Integer) As Date ' function error margin about 40 minutes Dim basedate As Date Dim offset As Double offset = 365.24218967 yyyy -= 2010 'offset = 365.2425 * yyyy offset *= yyyy basedate = New Date(2010, 12, 21, 23, 38, 0) basedate = basedate.AddDays(offset) Return basedate End Function ```

Bank Holidays - England and Wales
Some Scotland and Northern Ireland Bank Holidays are different ``` ' Thus fubction requires the Easter_Date function (first function in this set of functions) ' and the First_Monday function (provided immediately after this function.) ' The Structures DateName and WeekOfMonth are provided after the First_Monday function. ' This uses official formulaqe but Government sometimes changes dates for May-Day or Spring ' bank holidays, consider using a lookup table for government date changes. Private Shared Function Get_Bank_Holidays_England(yyyy As Integer) As List(Of DateName) Dim ret As New List(Of DateName) : ret.Clear() Dim dn As DateName Dim tDat As Date dn.Dat = New Date(yyyy, 1, 1, 12, 0, 0) If dn.Dat.DayOfWeek = DayOfWeek.Saturday Then dn.Dat = New Date(yyyy, 1, 3, 12, 0, 0) If dn.Dat.DayOfWeek = DayOfWeek.Sunday Then dn.Dat = New Date(yyyy, 1, 2, 12, 0, 0) dn.name = "New Years Day" ret.Add(dn) tDat = First_Monday(WeekOfMonth.First, DayOfWeek.Monday, yyyy, 3) dn.Dat = New Date(tDat.Year, tDat.Month, tDat.Day, 12, 0, 0) : dn.name = "May Day" ret.Add(dn) tDat = First_Monday(WeekOfMonth.Last, DayOfWeek.Monday, yyyy, 3) dn.Dat = New Date(tDat.Year, tDat.Month, tDat.Day, 12, 0, 0) : dn.name = "Spring" ret.Add(dn) tDat = Easter_Date(yyyy) dn.Dat = tDat.AddDays(-2) : dn.name = "Good Friday" ret.Add(dn) tDat = Easter_Date(yyyy) dn.Dat = tDat.AddDays(1) : dn.name = "Easter Monday" ret.Add(dn) tDat = First_Monday(WeekOfMonth.Last, DayOfWeek.Monday, yyyy, 8) dn.Dat = New Date(tDat.Year, tDat.Month, tDat.Day, 12, 0, 0) : dn.name = "Summer" ret.Add(dn) dn.Dat = New Date(yyyy, 12, 25, 12, 0, 0) If dn.Dat.DayOfWeek = DayOfWeek.Saturday Then dn.Dat = New Date(yyyy, 12, 27, 12, 0, 0) If dn.Dat.DayOfWeek = DayOfWeek.Sunday Then dn.Dat = New Date(yyyy, 12, 26, 12, 0, 0) dn.name = "Christmas Day" ret.Add(dn) dn.Dat = New Date(yyyy, 12, 26, 12, 0, 0) If dn.Dat.DayOfWeek = DayOfWeek.Saturday Then dn.Dat = New Date(yyyy, 12, 27, 12, 0, 0) If dn.Dat.DayOfWeek = DayOfWeek.Sunday Then dn.Dat = New Date(yyyy, 12, 28, 12, 0, 0) dn.name = "Christmas Day" ret.Add(dn) Return ret End Function Private Shared Function First_Monday(w1 As WeekOfMonth, d1 As DayOfWeek, year As Integer, month As Integer) As Date Dim dd, mm, yyyy As Integer Dim dat As Date If w1 = WeekOfMonth.Last Then dat = New Date(yyyy, mm, Date.DaysInMonth(yyyy, mm), 12, 0, 0) While dat.DayOfWeek <> d1 dat = dat.AddDays(-1) End While Return dat End If dd = 1 Select Case w1 Case WeekOfMonth.First : dd = 1 Case WeekOfMonth.Second : dd = 8 Case WeekOfMonth.Third : dd = 15 Case WeekOfMonth.Fourth : dd = 22 End Select dat = New Date(yyyy, mm, dd, 12, 0, 0) While dat.DayOfWeek <> d1 dat.AddDays(1) End While Return dat End Function Public Structure DateName Dim Dat As Date Dim name As String End Structure Public Structure WeekOfMonth First Second Third Fourth Last End Structure ```

Summer Time EU and USA
Although some European countries change their clocks on the same day as the UK, the date/time or use of Summer Time could vary across Europe.
Although some North American countries/states change their clocks on the same day as the US, the date/time or use of Summer Time could vary across the Continent or even within the USA.
``` Private Shared Function Start_of_Summer_Time_UK(yyyy As Integer) As Date ' Last Sunday in March at 02:00 ' start at 12:00 (avoid near midnight or near 02:00) Dim dat As New Date(yyyy, 3, 31, 12, 0, 0) While dat.DayOfWeek <> DayOfWeek.Sunday dat = dat.AddDays(-1) End While ' now we can set the time to 02:00 Return New Date(dat.Year, dat.Month, dat.Day, 2, 0, 0, 0) End Function ' Private Shared Function End_of_Summer_Time_UK(yyyy As Integer) As Date ' Last Sunday in October at 02:00 ' start at 12:00 (avoid near midnight or near 02:00) ' Be aware that Date command may use local time-zones Dim dat As New Date(yyyy, 10, 31, 12, 0, 0) While dat.DayOfWeek <> DayOfWeek.Sunday dat = dat.AddDays(-1) End While ' now we can set the time to 02:00 Return New Date(dat.Year, dat.Month, dat.Day, 2, 0, 0, 0) End Function ' Private Shared Function Start_Of_Summer_Time_USA(yyyy As Integer) As Date ' Second Sunday in March at 02:00 ' start at 12:00 (avoid near midnight or near 02:00) ' Be aware that Date command may use local time-zones Dim dat As New Date(yyyy, 3, 8, 12, 0, 0) While dat.DayOfWeek <> DayOfWeek.Sunday dat = dat.AddDays(1) End While ' now we can set the time to 02:00 Return New Date(dat.Year, dat.Month, dat.Day, 2, 0, 0, 0) End Function ' Private Shared Function End_Of_Summer_Time_USA(yyyy As Integer) As Date ' First Sunday in November at 02:00 ' start at 12:00 (avoid near midnight or near 02:00) ' Be aware that Date command may use local time-zones Dim dat As New Date(yyyy, 11, 1, 12, 0, 0) While dat.DayOfWeek <> DayOfWeek.Sunday dat = dat.AddDays(1) End While ' now we can set the time to 02:00 Return New Date(dat.Year, dat.Month, dat.Day, 2, 0, 0, 0) End Function ```
DigitalDan.co.uk ... Hits = 40