Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Easter Date using tables

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Easter Date using tables

    Get either Orthodox Easter date and/or Western Easter date, using original tables. Thanks to Claus Tondering's Calendar Faq

    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
    Last edited by Egbert Zijlema; 11 Sep 2008, 05:04 PM. Reason: deleted wrong remark in code section

    Egbert Zijlema, journalist and programmer (zijlema at basicguru dot eu)
    http://zijlema.basicguru.eu
    *** Opinions expressed here are not necessarily untrue ***
Working...
X