Code:
#COMPILE EXE
#DIM ALL
' IMPORTANT NOTE!
' This utility uses several functions from the Gregorian Date Library, including the [U]new[/U] function MONTHDAYFORMAT.
' So don't forget to download it from my site, http://zijlema.basicguru.eu/files/gregorian.zip
#INCLUDE "C:\PBWIN80\SOURCES\DATETIME\GREGORIAN\GREGORIAN.INC" ' modify path for your situation
%LOCALE_USA = 1033
' ******************************************************
' FUNCTION Orthodox_Easter *
' selects PFM-date from simple table of golden numbers *
' returns Orthodox Easter date in Gregorian calendar *
' ******************************************************
FUNCTION Orthodox_Easter(BYVAL wYear AS WORD) AS LONG
LOCAL bGoldenNbr AS BYTE, JulianPFM AS LONG, GregorianPFM AS LONG
LOCAL iGregAdjust AS LONG, iGregCorrect AS LONG
LOCAL wMonth AS WORD, wDay AS WORD
bGoldenNbr = wYear MOD 19 + 1
' first step: select Paschal Full Moon date in Julian Calendar
SELECT CASE AS LONG bGoldenNbr
CASE 1
wMonth = 4 : wDay = 5
CASE 2
wMonth = 3 : wDay = 25
CASE 3
wMonth = 4 : wDay = 13
CASE 4
wMonth = 4 : wDay = 2
CASE 5
wMonth = 3 : wDay = 22
CASE 6
wMonth = 4 : wDay = 10
CASE 7
wMonth = 3 : wDay = 30
CASE 8
wMonth = 4 : wDay = 18
CASE 9
wMonth = 4 : wDay = 7
CASE 10
wMonth = 3 : wDay = 27
CASE 11
wMonth = 4 : wDay = 15
CASE 12
wMonth = 4 : wDay = 4
CASE 13
wMonth = 3 : wDay = 24
CASE 14
wMonth = 4 : wDay = 12
CASE 15
wMonth = 4 : wDay = 1
CASE 16
wMonth = 3 : wDay = 21
CASE 17
wMonth = 4 : wDay = 9
CASE 18
wMonth = 3 : wDay = 29
CASE 19
wMonth = 4 : wDay = 17
END SELECT
JulianPFM = Gregorian(wYear, wMonth, wDay) ' as Gregorian Day Number
' second step: Convert Julian PFM to Gregorian Calendar:
GregorianPFM = JulianPFM + 10 ' add initial 10 days adjustment from 1582
IF wYear > 1699 THEN
iGregAdjust = (wYear \ 100) - 16 ' add 1 day for each centennial year from 1700
iGregCorrect = iGregAdjust \ 4 ' correct for centennial leap years: 2000, 2400 etc.
GregorianPFM = GregorianPFM + iGregAdjust - iGregCorrect
END IF
' third step: Find next Sunday:
DO
INCR GregorianPFM
LOOP UNTIL GregDayOfWeek(GregorianPFM) = 7 ' until next Sunday = Easter date
FUNCTION = GregorianPFM
END FUNCTION
' ******************************************************
' FUNCTION Western_Easter *
' selects PFM-date from table of epacts *
' returns Orthodox Easter date in Gregorian calendar *
' ******************************************************
FUNCTION Western_Easter(BYVAL wYear AS WORD) AS LONG
LOCAL wCentury AS WORD, wMonth AS WORD, wDay AS WORD
LOCAL bGoldenNbr AS BYTE, Epact AS LONG
LOCAL SolarEqu AS LONG, LunarEqu AS LONG, GregorianPFM AS LONG
wCentury = wYear \ 100 + 1 ' integer division by 100 returns first 2 digits
bGoldenNbr = (wYear MOD 19) + 1 ' Golden Number (Metonic Moon Cycle), base one!
Epact = (11 * (bGoldenNbr - 1)) MOD 30 ' Julian Epact
SolarEqu = (3 * wCentury) \ 4
LunarEqu = (8 * wCentury + 5) \ 25
Epact = Epact - SolarEqu + LunarEqu + 8 ' adjust to Gregorian Epact
' Epact must be a value from 1 through 30, so:
IF Epact >30 THEN
Epact = Epact MOD 30 ' for values greater than 30 use MOD operator
ELSEIF Epact <1 THEN
DO
Epact = Epact + 30 ' for values < 1 (zero or even negative) add 30...
LOOP UNTIL Epact >0 ' as often as needed to get a value greater than zero
END IF
SELECT CASE AS LONG Epact
CASE 1 TO 12
wMonth = 4
wDay = 13 - Epact ' = 12 through 1
CASE 24 TO 30
wMonth = 4
SELECT CASE AS LONG Epact
CASE 24 : wDay = 18
CASE 25
IF bGoldenNbr > 11 THEN wDay = 17 ELSE wDay = 18
CASE 26 TO 30 : wDay = 43 - Epact ' = 17 through 13
END SELECT
CASE 13 TO 23
wMonth = 3
wDay = 44 - Epact ' = 31 through 21
END SELECT
GregorianPFM = Gregorian(wYear, wMonth, wDay)
' second step: find following Sunday
DO
INCR GregorianPFM
LOOP UNTIL GregDayOfWeek(GregorianPFM) = 7 ' until first (= Easter) Sunday
FUNCTION = GregorianPFM
END FUNCTION
FUNCTION PBMAIN () AS LONG
LOCAL st AS SYSTEMTIME
GetLocalTime st
MSGBOX "EASTER IN " & FORMAT$(st.wYear) & ": " & $CRLF & _
"Western: " & MonthDayFormat(Western_Easter(st.wYear), %LOCALE_USA) & $CRLF & _
"Orthodox: " & MonthDayFormat(Orthodox_Easter(st.wYear), %LOCALE_USA), 64, " Testing Easter tables..."
END FUNCTION