logo VB.Net - Converting Calendar Dates
Guide Contents
DigitalDan Home Page

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 = 301