c = a/100
n = a - [19×(a/19)]
k = (c - 17)/25
i = c - c/4 - [(c-k)/3] +(19×n) + 15
i = i - [30×(i/30)]
i = i - {(i/28)×[1-(i/28)]×[29/(i+1)]×[(21-n)/11]}
j = a + a/4 + i + 2 -c + c/4
j = j - [7×(j/7)]
z = i - j
m = 3 + [(z+40)/44]
d = z + 28 - [31×(m/4)]
dEaster := FT_Easter (Year(dDate))
SET CENTURY ON
//SET DATE AMERICAN
//MsgAlert( EASTER( 2013, "A", .T. ), "Amer. Easter 2013" )
//SET DATE ANSI
//MsgAlert( EASTER( 2013, "N", .T. ), "Ansi Easter 2013" )
//SET DATE BRITISH
//MsgAlert( EASTER( 2013, "B", .T. ), "English Easter 2013" )
//SET DATE FRENCH
//MsgAlert( EASTER( 2013, "F", .T. ), "French Easter 2013" )
//SET DATE GERMAN
//MsgAlert( EASTER( 2013, "G", .T. ), "German Ostern 2013" )
SET DATE ITALIAN
MsgAlert( EASTER( 2013, "I", .T. ), "Italien Easter 2013" )
//SET DATE JAPAN
//MsgAlert( EASTER( 2013, "J", .T. ), "Japan Easter 2013" )
//SET DATE USA
//MsgAlert( EASTER( 2013, "U", .T. ), "USA Easter 2013" )
/*
SYNTAX
FT_EASTER( <xYear> ) -> dEdate
ARGUMENTS
xYear can be a character, date or numeric describing the year
for which you wish to receive the date of Easter.
RETURNS
The actual date that Easter occurs.
DESCRIPTION
Returns the date of Easter for any year after 1582 up to Clipper's
limit which the manual states is 9999, but the Guide agrees with
the actual imposed limit of 2999.
EXAMPLES
dEdate := EASTER( 1990 ) returns 04/15/1990
*/
FUNCTION EASTER (nYear, cNat, lCent )
local nGold, nCent, nCorx, nCorz, nSunday, nEpact, nMoon,;
nMonth := 0, nDay := 0
// --------------------------------
// NOTE: __SetCentury() is internal
// --------------------------------
IF VALTYPE (nYear) == "C"
nYear = VAL(nYear)
ENDIF
IF VALTYPE (nYear) == "D"
nYear = YEAR(nYear)
ENDIF
IF VALTYPE (nYear) == "N"
IF nYear > 1582
// <<nGold>> is Golden number of the year in the 19 year Metonic cycle
nGold = nYear % 19 + 1
// <<nCent>> is Century
nCent = INT (nYear / 100) + 1
// Corrections:
// <<nCorx>> is the no. of years in which leap-year was dropped in order
// to keep step with the sun
nCorx = INT ((3 * nCent) / 4 - 12)
// <<nCorz>> is a special correction to synchronize Easter with the moon's
// orbit.
nCorz = INT ((8 * nCent + 5) / 25 - 5)
// <<nSunday>> Find Sunday
nSunday = INT ((5 * nYear) / 4 - nCorx - 10)
// Set Epact <<nEpact>> (specifies occurance of a full moon)
nEpact = INT ((11 * nGold + 20 + nCorz - nCorx) % 30)
IF nEpact < 0
nEpact += 30
ENDIF
IF ((nEpact = 25) .AND. (nGold > 11)) .OR. (nEpact = 24)
++nEpact
ENDIF
// Find full moon - the <<nMoon>>th of MARCH is a "calendar" full moon
nMoon = 44 - nEpact
IF nMoon < 21
nMoon += 30
ENDIF
// Advance to Sunday
nMoon = INT (nMoon + 7 - ((nSunday + nMoon) % 7))
// Get Month and Day
IF nMoon > 31
nMonth = 4
nDay = nMoon - 31
ELSE
nMonth = 3
nDay = nMoon
ENDIF
ENDIF
ELSE
nYear = 0
ENDIF
SET CENTURY (lCent)
IF cNat = "A" // American
RETURN CTOD ( RIGHT ("00"+LTRIM (STR (nMonth)),2) + "/" +;
RIGHT ("00"+LTRIM (STR (INT (nDay))) ,2) + "/" + ;
STR (nYear,4))
ENDIF
IF cNat = "N" // Ansi
RETURN CTOD ( STR (nYear,4) + "." +;
RIGHT ("00"+LTRIM (STR (nMonth)),2) + "." +;
RIGHT ("00"+LTRIM (STR (INT (nDay))) ,2) )
ENDIF
IF cNat = "B" // British
RETURN CTOD ( RIGHT ("00"+LTRIM (STR (INT (nDay))) ,2) + "/" + ;
RIGHT ("00"+LTRIM (STR (nMonth)),2) + "/" +;
STR (nYear,4) )
ENDIF
IF cNat = "F" // French
RETURN CTOD ( RIGHT ("00"+LTRIM (STR (INT (nDay))) ,2) + "/" + ;
RIGHT ("00"+LTRIM (STR (nMonth)),2) + "/" +;
STR (nYear,4) )
ENDIF
IF cNat = "G" // German
RETURN CTOD ( RIGHT ("00"+LTRIM (STR (INT (nDay))) ,2) + "." + ;
RIGHT ("00"+LTRIM (STR (nMonth)),2) + "." +;
STR (nYear,4) )
ENDIF
IF cNat = "I" // Italien
RETURN CTOD ( RIGHT ("00"+LTRIM (STR (INT (nDay))) ,2) + "-" + ;
RIGHT ("00"+LTRIM (STR (nMonth)),2) + "-" +;
STR (nYear,4) )
ENDIF
IF cNat = "J" // Japan
RETURN CTOD ( STR (nYear,4) + "/" +;
RIGHT ("00"+LTRIM (STR (nMonth)),2) + "/" +;
RIGHT ("00"+LTRIM (STR (INT (nDay))) ,2) )
ENDIF
IF cNat = "U" // USA
RETURN CTOD ( RIGHT ("00"+LTRIM (STR (nMonth)),2) + "-" +;
RIGHT ("00"+LTRIM (STR (INT (nDay))) ,2) + "-" + ;
STR (nYear,4))
ENDIF
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 96 guests