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 Calculation

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

  • Easter Calculation

    Easter date or Easter Sunday is the Sunday, following the first full moon after the Vernal Equinox (= the 21st of March). This full moon is also referred to as: PASCHAL FULL MOON.

    This Easter-routine uses Julian Day Number calculations, which has 3 advantages:
    1. Easter-related holidays can easily be found too, e.g. Good Friday = Easter minus 2.
    2. Once we have found the Julian Day Number for Paschal Full Moon, it's easy to find the next Sunday. Don't use difficult 'algebraic' formulas here, but simply add 1 (day) until the result is a Sunday.
    3. Initially PFM is returned as the number of days elapsed since March 1. If this number is greater than 31, PFM is in April. However, using JDN you don't need to care about this. Simply pretend that March has more than 31 days. Example: 'March 32', written as Julian(year, 3, 32), equals April 1 or Julian(year, 4, 1)

    Code:
    ' ===============================================================================
    '      Source code: PowerBASIC for Windows
    '         Compiler: PBDLL60
    '           Author: [email protected]
    ' Copyright status: Public Domain
    '          Purpose: Calculate Easter for a given year
    ' ===============================================================================
     
    #COMPILE EXE
    #INCLUDE "WIN32API.INC"
     
    FUNCTION Julian(BYVAL year AS INTEGER, _
                    BYVAL month AS INTEGER, _
                    BYVAL day AS INTEGER) AS LONG
      LOCAL Elapsed AS LONG, InvalidLeaps AS INTEGER, ValidLeaps AS INTEGER, dMonths AS INTEGER
     
      IF month < 3 THEN                      ' January or February?
        month = month + 12                   ' 13th or 14th month ....
        DECR year                            ' .... of prev. year
      END IF
     
      Elapsed = INT((year + 4712) * 365.25)  ' days in years elapsed
      InvalidLeaps = year \ 100              ' substract century leapdays
      ValidLeaps = year \ 400                ' re-add valid ones
      dMonths = INT(30.6 * (month - 1) + .2) ' days of months elapsed + adjustment
      FUNCTION = Elapsed - InvalidLeaps + _
                 ValidLeaps + dMonths + day
    END FUNCTION
     
    FUNCTION JulToDate(BYVAL Jul AS LONG) AS STRING
      LOCAL st AS SYSTEMTIME, szText AS ASCIIZ * 255
     
      Jul = Jul + 68569
      help& = 4 * Jul \ 146097
      Jul = Jul - ((146097 * help& + 3) \ 4)
      TempYear& = 4000 * (Jul + 1) \ 1461001
      Jul = Jul - (1461 * TempYear& \ 4) + 31
      TempMonth& = 80 * Jul \ 2447
      st.wDay = Jul - (2447 * TempMonth& \ 80)
      st.wMonth = TempMonth& + 2 - (12 * (TempMonth& \ 11))
      st.wYear = 100 * (help& - 49) + TempYear& + (TempMonth& \ 11)
      GetDateFormat %LOCALE_USER_DEFAULT, %DATE_LONGDATE, st, BYVAL %NULL, szText, SIZEOF(szText)
      FUNCTION = szText
    END FUNCTION
     
    FUNCTION PaschalFullMoon(year AS INTEGER) AS LONG
      LOCAL Century AS INTEGER, temp AS INTEGER, PFM AS INTEGER
     
      Century = year \ 100
      temp    = (Century - 15) \ 2
      temp    = temp + 202
      temp    = temp - 11 * (year MOD 19)
      SELECT CASE Century
        CASE 21, 24, 25, 27 TO 32, 34, 35
          DECR temp
        CASE 33, 36, 37, >38
          temp = temp - 2
      END SELECT
      temp = temp MOD 30
      PFM = temp + 21
      IF (temp = 29) OR _
         (temp = 28 AND year MOD 19 > 10) THEN DECR PFM
      FUNCTION = Julian(year, 3, PFM)
    END FUNCTION                  
      
    FUNCTION EasterSunday(year AS INTEGER) AS LONG
      LOCAL start AS LONG, Sun AS BYTE
     
      Sun = 6
      start = PaschalFullMoon(year)
      DO
        INCR start
      LOOP UNTIL start MOD 7 = Sun
      FUNCTION = start
    END FUNCTION
     
    FUNCTION GoodFriday(year AS INTEGER) AS LONG
      FUNCTION = EasterSunday(year) - 2
    END FUNCTION
     
    FUNCTION EasterMonday(year AS INTEGER) AS LONG
      FUNCTION = EasterSunday(year) + 1
    END FUNCTION
     
    FUNCTION AscensionDay(year AS INTEGER) AS LONG
      FUNCTION = EasterSunday(year) + 39
    END FUNCTION
     
    FUNCTION WhitSunday(year AS INTEGER) AS LONG
      FUNCTION = EasterSunday(year) + 49
    END FUNCTION
     
    FUNCTION WhitMonday(year AS INTEGER) AS LONG
      FUNCTION = EasterSunday(year) + 50
    END FUNCTION
     
    FUNCTION PBMAIN() AS LONG
      LOCAL WhichYear AS INTEGER, caption AS STRING
      WhichYear = 2000
      caption = "Easter " + TRIM$(STR$(WhichYear)) + " by Egbert Zijlema"
      MSGBOX "Paschal Full Moon in " + TRIM$(STR$(WhichYear)) + " is " + _
             JulToDate(PaschalFullMoon(WhichYear)) + CHR$(46, 13) + _
             "The first Sunday after this date - " + _
             JulToDate(EasterSunday(WhichYear)) + " - is Easter" + CHR$(46, 13) + _
             "Other Easter-related holidays are:" + CHR$(13, 9) + _
             "Good Friday: " + JulToDate(GoodFriday(WhichYear)) + CHR$(46, 13, 9) + _
             "Easter Monday: " + JulToDate(EasterMonday(WhichYear)) + CHR$(46, 13, 9) + _
             "Ascension Day: " + JulToDate(AscensionDay(WhichYear)) + CHR$(46, 13, 9) + _
             "Whit Sunday: " + JulToDate(WhitSunday(WhichYear)) + CHR$(46, 13, 9) + _
             "Whit Monday: " + JulToDate(WhitMonday(WhichYear)) + ".", 64, caption
    END FUNCTION

    [This message has been edited by Egbert Zijlema (edited April 22, 2000).]

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

  • #2
    Code:
    '######################################################################################
    ' Difference between Date/Time combinations using Date$ and Time$ style data strings
    '
    ' Thanks to Egbert for the Julian Date routines.
    ' I changed the routine declarations slightly to use LONGs rather than INTEGERs
    '######################################################################################
    #COMPILE EXE
    #INCLUDE "WIN32API.INC"
    
    ' One TYPE declaration required
    TYPE ElapsedTimeStruc
      hours   AS LONG
      minutes AS LONG
      seconds AS LONG
    END TYPE
    '######################################################################################
    FUNCTION DateToJulian(inDate AS STRING) AS LONG
    ' Returns Julian Date (Long Integer) from "String" Date formatted as: MM/DD/YYYY.
      LOCAL year         AS LONG, _
            month        AS LONG, _
            day          AS LONG, _
            Elapsed      AS LONG, _
            InvalidLeaps AS LONG, _
            ValidLeaps   AS LONG, _
            dMonths      AS LONG
    
      month = VAL(LEFT$(inDate,2))
      day   = VAL(MID$(inDate,4,2))
      year  = VAL(MID$(inDate,7,4))
    
      IF month < 3 THEN                      ' January or February?
        month = month + 12                   ' 13th or 14th month ....
        DECR year                            ' .... of prev. year
      END IF
    
      Elapsed = INT((year + 4712) * 365.25)  ' days in years elapsed
      InvalidLeaps = year \ 100              ' substract century leapdays
      ValidLeaps = year \ 400                ' re-add valid ones
      dMonths = INT(30.6 * (month - 1) + .2) ' days of months elapsed + adjustment
      FUNCTION = Elapsed - InvalidLeaps + ValidLeaps + dMonths + day
    
    END FUNCTION
    '######################################################################################
    FUNCTION JulToDate(BYVAL Jul AS LONG) AS STRING
    ' Returns "String" Date formatted as: MM/DD/YYYY from Julian Date (Long Integer)
    
      LOCAL help      AS LONG, _
            Year  AS LONG,_
            Month AS LONG,_
            Day   AS LONG,_
            oText AS STRING * 10
    
      Jul = Jul + 68569
      help = 4 * Jul \ 146097
      Jul = Jul - ((146097 * help + 3) \ 4)
      Year = 4000 * (Jul + 1) \ 1461001
      Jul = Jul - (1461 * Year \ 4) + 31
      Month = 80 * Jul \ 2447
      Day = Jul - (2447 * Month \ 80)
      Month = Month + 2 - (12 * (Month \ 11))
      Year = 100 * (help - 49) + Year + (Month \ 11)
    
      oText = RIGHT$(STR$(Month),2) + "/" _
              +RIGHT$(STR$(Day),2) + "/" _
              +RIGHT$(STR$(Year),4) + "/"
      REPLACE " " WITH "0" IN oText
      FUNCTION = oText
    END FUNCTION
    '######################################################################################
    FUNCTION SecondsSinceMidnight(inTime AS STRING) AS LONG
    ' accepts time "hh:mm:ss" and converts it to elapsed seconds since previous midnight
      LOCAL inHours   AS LONG,_
            inMinutes AS LONG,_
            inSeconds AS LONG
      inHours   = VAL(LEFT$(inTime,2))
      inMinutes = VAL(MID$(inTime,4,2))
      inSeconds = VAL(MID$(inTime,7,2))
      FUNCTION = inHours * 3600 + inMinutes * 60 + inSeconds
    
    END FUNCTION
    '######################################################################################
    SUB TimeDifference(inDate1 AS STRING, inTime1 AS STRING, _
                         inDate2 AS STRING, inTime2 AS STRING, _
                         tStruc AS elapsedTimeStruc)
      ' accepts 2 dates/times and calculates the absolute time elapsed.
    
      LOCAL Julian1 AS LONG,_
            Julian2 AS LONG,_
            Seconds1 AS LONG,_
            Seconds2 AS LONG
    
      Julian1 = DateToJulian(inDate1)
      Julian2 = DateToJulian(inDate2)
      Seconds1 = SecondsSinceMidnight(inTime1)
      Seconds2 = SecondsSinceMidnight(inTime2)
    
      IF Julian1 > Julian2 OR (julian1 = Julian2 AND Seconds1 > Seconds2) THEN
        SWAP Julian1, Julian2
        SWAP Seconds1, Seconds2
      END IF
      IF Julian1 = Julian2 THEN
        tStruc.seconds = Seconds2 - Seconds1
      ELSE
        tStruc.seconds =  (60*60*24) - Seconds1 + Seconds2
        tStruc.hours = (Julian2 - Julian1-1) * 24
      END IF
      WHILE tStruc.seconds >= 60
        INCR tStruc.minutes
        tStruc.seconds = tStruc.seconds - 60
      LOOP
      WHILE tStruc.minutes >= 60
        INCR tStruc.hours
        tStruc.minutes = tStruc.minutes - 60
      LOOP
    
    END SUB
    '######################################################################################
    FUNCTION PBMAIN() AS LONG
     LOCAL  inDate1 AS STRING, _
            inTime1 AS STRING, _
            inDate2 AS STRING, _
            inTime2 AS STRING, _
            elapsedTime AS elapsedTimeStruc
    
    
      inDate1 = "05/09/2000"
      inTime1 = "18:11:35"
      inDate2 = "05/11/2000"
      inTime2 = "03:15:45"
      CALL TimeDifference(inDate1, inTime1, inDate2, inTime2, elapsedTime)
    
      CALL MessageBox (BYVAL %NULL,"From: " + inDate1 + " " + inTime1 + CHR$(13) + _
                            "  To: " + inDate2 + " " + inTime2 + CHR$(13) + _
                            "elapsed time: " + CHR$(13) + _
                            "Hrs: " + STR$(elapsedTime.hours) + CHR$(13) + _
                            "Min: " + STR$(elapsedTime.minutes) + CHR$(13) + _
                            "Sec: " + STR$(elapsedTime.seconds), _
                            "Time Difference", %MB_ICONEXCLAMATION OR %MB_OK)
      
    END FUNCTION
    ------------------
    [email protected]
    :) IRC :)

    Comment

    Working...
    X