Page 1 of 1
DateExtension - GetEasterSunday()
Posted: Tue Aug 09, 2005 12:32 pm
by va!n
Maybe this small piece of code may help someone?
Code: Select all
; --------------------------------------------------------------
; Function: GetEasterSunday (lYear)
;
; lYear......: Should work with 1900-2048
;
; Description: This function returns in "dd.mm.yyyy" format
; the date of easter sunday!
;
; ReturnValue: String of the date in "dd.mm.yyyy" format!
;
; Author.....: Mr.Vain of Secretly! aka Thorsten Will
; Version....: v1.0 (04-August-2005)
; --------------------------------------------------------------
Procedure.s GetEasterSunday (lYear)
c = lYear / 100
N = lYear - 19 * (lYear / 19)
K = ((c - 17) / 25)
I1 = c - (c >> 2) - ((c - K) / 3) + 19 * N + 15
I2 = I1 - 30 * (I1 / 30)
I3 = I2 - (I2 / 28) * (1 - (I2 / 28) * (29 / (I2 + 1)) * ((21 - N) / 11))
A1 = lYear + (lYear >> 2) + I3 + 2 - c + (c >> 2)
A2 = A1 - 7 * (A1 / 7)
l = I3 - A2
lMonth = 3 + ((l + 40) / 44)
lDay = l + 28 - 31 * (lMonth >> 2)
;
cResult$ = Str(lDay)+"."+Str(lMonth)+"."+Str(lYear)
ProcedureReturn cResult$
EndProcedure
; ---- Example -------------------------------------------------
res$ = GetEasterSunday(2005)
MessageRequester("EasterSunday", res$, 0)
End
Re: DateExtension - GetEasterSunday()
Posted: Tue Aug 09, 2005 5:47 pm
by fsw
va!n wrote:
; Author.....: Mr.Vain of Secretly! aka Thorsten Will
I thought it might be you
Re: DateExtension - GetEasterSunday()
Posted: Tue Aug 09, 2005 5:52 pm
by va!n
fsw wrote:
I thought it might be you
Posted: Tue Aug 09, 2005 9:06 pm
by fweil
I am really sorry, but some years do not render the same rest using this procedure !
Don't know which is rigth.
Code: Select all
Procedure.s GetEasterSundayEx(Year) ; GetEasterSundayEx(Year) : returns the date in dd.mm.yyyy string format of easter sunday
a = Year % 19
b = Year / 100
c = Year % 100
d = b / 4
e = b % 4
f = (b + 8) / 25
g = (b - f + 1) / 3
h = (19 * a + b - d - g + 15) % 30
i = c / 4
k = c % 4
l = (32 + 2 * e + 2 * i - h - k) % 7
m = (a + 11 * h + 22 * l) / 451
n = (h + l - 7 * m + 114) / 31
p = (h + l - 7 * m + 114) % 31
ProcedureReturn Str(p + 1) + "." + Str(n) + "." + Str(Year)
EndProcedure
I also have this for calendar functions :
Code: Select all
Procedure DayOfWeekEx(Year.l, Month.l, Day.l) ; DayOfWeekEx(Year.l, Month.l, Day.l) : returns the day of week (Monday = 0, ..., Sunday = 6) for years after 1582
If Month < 3
Month + 12
Year - 1
EndIf
s = Year / 100
JD = 1720996.5 - s + Int(s / 4) + (365.25 * Year) + (30.6001 * (Month + 1)) + Day
JD = JD - (JD / 7) * 7
ProcedureReturn JD % 7
EndProcedure
and
Code: Select all
Procedure LeapYear(Year) ; LeapYear(Year) : returns #TRUE if Year is a leap year, #FALSE otherwise
If ((Year % 4 = 0) And (Year % 100 <> 0)) Or (Year % 400 = 0)
ProcedureReturn #TRUE
Else
ProcedureReturn #FALSE
EndIf
EndProcedure
not really clever but maybe useful.
Rgrds
Posted: Tue Aug 09, 2005 9:37 pm
by va!n
fweil wrote:I am really sorry, but some years do not render the same rest using this procedure ! Don't know which is rigth.
hi fweil! i have tested both procedures with following example (i dont really know what is the max year, that would work correctly but i know the results should be ok from the year 1900... here is my test source...
Code: Select all
Procedure.s GetEasterSundayEx(Year) ; GetEasterSundayEx(Year) : returns the date in dd.mm.yyyy string format of easter sunday
a = Year % 19
b = Year / 100
c = Year % 100
d = b / 4
e = b % 4
f = (b + 8) / 25
g = (b - f + 1) / 3
h = (19 * a + b - d - g + 15) % 30
i = c / 4
k = c % 4
l = (32 + 2 * e + 2 * i - h - k) % 7
m = (a + 11 * h + 22 * l) / 451
n = (h + l - 7 * m + 114) / 31
p = (h + l - 7 * m + 114) % 31
ProcedureReturn Str(p + 1) + "." + Str(n) + "." + Str(Year)
EndProcedure
Procedure.s GetEasterSunday (lYear)
c = lYear / 100
n = lYear - 19 * (lYear / 19)
k = ((c - 17) / 25)
I1 = c - (c >> 2) - ((c - k) / 3) + 19 * n + 15
I2 = I1 - 30 * (I1 / 30)
I3 = I2 - (I2 / 28) * (1 - (I2 / 28) * (29 / (I2 + 1)) * ((21 - n) / 11))
A1 = lYear + (lYear >> 2) + I3 + 2 - c + (c >> 2)
A2 = A1 - 7 * (A1 / 7)
l = I3 - A2
lMonth = 3 + ((l + 40) / 44)
lDay = l + 28 - 31 * (lMonth >> 2)
;
cResult$ = Str(lDay)+"."+Str(lMonth)+"."+Str(lYear)
ProcedureReturn cResult$
EndProcedure
For lYear = 1900 To 2048
a$ = GetEasterSunday(lYear)
b$ = GetEasterSundayEx(lYear)
;
If a$ <> b$
Debug lYear
Debug a$
Debug b$
EndIf
Next
As you may see there are differents at following points..
Code: Select all
1954
25.4.1954
18.4.1954
1981
26.4.1981
19.4.1981
so i tried to use google and search for the correct dates... i found following site...
http://www.adalbert-riehl.de/kalender/feiertag19.htm
seems easterday in 1954 was the 18. April! Mhhh strange, seems my routine has somewhere a bug!? (i cant find it atm)
Posted: Sun Aug 21, 2005 4:46 pm
by horst
Here is another algorithm (don't remember where I found this). It produces the binary PB date, and thus it works only from 1970.
Code: Select all
DataSection
Passah: ; day offset based 21.Mar = 0
Data.b 24, 13, 2, 21, 10, 28, 18, 7, 26, 15, 4, 23, 12, 1, 20, 9, 27, 17, 6
EndDataSection
#dsec = 60*60*24
Procedure Easter(year_) ; returns PB date format
dif = PeekB(?Passah + (year_ % 19))
DateSec = ParseDate("%dd.%mm.%yyyy","21.03." + Str(year_)) + dif * #dsec
DateSec = AddDate(DateSec,#PB_Date_Day, 7 - DayOfWeek(DateSec))
ProcedureReturn DateSec
EndProcedure
Posted: Mon Aug 06, 2007 12:55 am
by ts-soft
Here another one for LeapYear, PB4 ++
Code: Select all
Macro IsLeapYear(Year)
Not Year % 4 And (Year % 100 Or Not Year % 400)
EndMacro