;Datumsberechnungen
;##############################################
;Andreas Miethe * Dezember 2002
;##############################################


Procedure.w AMOD(a.w,b.w)
    ;Modulo (Ganzzahliger Restwert) bestimmen
    Ret.w = a - ((a/b)*b)
    ProcedureReturn Ret
EndProcedure

Procedure.w IsLeapyear(Jahr.w)
    ;Schaltjahr bestimmen
    ;Rueckgabe = 1 wenn Schaltjahr, sonst Null
    Result.w =0
    If (AMOD(Jahr,4)=0 And AMOD(Jahr,100)<>0) Or (AMOD(Jahr,400)=0)
        Result = 1
    EndIf
    ProcedureReturn Result
EndProcedure

Procedure.w GetMonthOfDays(Jahr.w,Day.w)
    ;Rueckgabe = Monat
    Month.w = 0
    Alle.w = 0
    Plus.w = 0
    Dim MyArray3.w(11)
    MyArray3(0) = 31
    MyArray3(1) = 28 + IsLeapYear(jahr)
    MyArray3(2) = 31
    MyArray3(3) = 30
    MyArray3(4) = 31
    MyArray3(5) = 30
    MyArray3(6) = 31
    MyArray3(7) = 31
    MyArray3(8) = 30
    MyArray3(9) = 31
    MyArray3(10) = 30
    MyArray3(11) = 31
    While Day >= Alle
        Alle = Alle + MyArray3(Plus)
        Month = Month +1
        Plus = Plus + 1
    Wend
    ProcedureReturn Month
EndProcedure

Procedure.w GetDayOfMonth(Jahr.w,Day.w)
    ;Rueckgabe Tag des Monats
    Month.w = GetMonthOfDays(Jahr,Day)
    DaysBefore.w = 0
    i.w = 0
    Plus.w = 0
    Dim MyArray2.w(11)
    MyArray2(0) = 31
    MyArray2(1) = 28 + IsLeapYear(jahr)
    MyArray2(2) = 31
    MyArray2(3) = 30
    MyArray2(4) = 31
    MyArray2(5) = 30
    MyArray2(6) = 31
    MyArray2(7) = 31
    MyArray2(8) = 30
    MyArray2(9) = 31
    MyArray2(10) = 30
    MyArray2(11) = 31
    For i = 0 To Month - 2
        DaysBefore = DaysBefore + MyArray2(i)
    Next i
    DayOfMonth = Day - DaysBefore + 1
    ProcedureReturn DayOfMonth
EndProcedure

Procedure.w GetDayFromGauss(jahr.w)
    ;Rueckgabe Tag des Ostersonntags des Jahres
    ;gültig von 1583 bis 8702 nach Gauss
    DefType.w a,b,c,d,e,f,g,h,i,j,Ostersonnatg
    a = AMOD(jahr,19)
    b  = AMOD(jahr,4)
    c = AMOD(jahr,7)
    d =  ( ( (jahr/100) * 8 ) + 13 )/25 - 2
    e =  (jahr/100) - (jahr/400) - 2
    f  = AMOD((15 + e - d),30)
    g =  AMOD((6 + e),7)
    h = AMOD((19 * a + f),30)
    i =  h
    If (h = 29)
        i = 28
    EndIf
    If ( (h = 28) And (a > 10) )
        i = 27
    EndIf
    j = AMOD( ( (2 * b) + (4 * c) + (6 * i) + g ),7)
    Result.w = i + j + 22
    Ostersonntag = Result + 58 + IsLeapyear(jahr)
    ProcedureReturn Ostersonntag
EndProcedure


Procedure.s GetDOW1Januar(jahr.w)
    ;Rueckgabe = Wochentag des 1. Januar
    DefType.w CC,YY,CCDoomday,YYDoomday
    Dim MyArray.w(3)
    MyArray(0) = 5
    MyArray(1) = 4
    MyArray(2) = 2
    MyArray(3) = 0
    Dim Weekdays.s(6)
    Weekdays(0) = "Sonntag"
    Weekdays(1) = "Montag"
    Weekdays(2) = "Dienstag"
    Weekdays(3) = "Mittwoch"
    Weekdays(4) = "Donnerstag"
    Weekdays(5) = "Freitag"
    Weekdays(6) = "Samstag"
    CC = Jahr/100
    YY = AMOD(Jahr,100)
    CCDoomday = MyArray(AMOD(CC,4))
    YYDoomday = 0
    If YY = 0
        YYDoomday = CCDoomday
    ElseIf AMOD(YY,12) = 0
        YYDoomday = AMOD((CCDoomday + YY/12 - 1),7)
    ElseIf YY <> 0
        YYDoomday = AMOD((CCDoomday + YY/12 + (AMOD(YY,12)) + (AMOD((YY-1),12)/4)),7)
    EndIf
    If AMOD(CC,4)=0 And  YY <> 0
        YYDoomday = AMOD((YYDoomday +1),7)
    EndIf
    ProcedureReturn WeekDays(YYDoomday)
EndProcedure

Procedure.w DOY(tag.w,monat.w,jahr.w)
    ;Rueckgabe = Tag des Jahres
    Dim MyArray1.w(11)
    MyArray1(0) = 31
    MyArray1(1) = 28 + IsLeapYear(jahr)
    MyArray1(2) = 31
    MyArray1(3) = 30
    MyArray1(4) = 31
    MyArray1(5) = 30
    MyArray1(6) = 31
    MyArray1(7) = 31
    MyArray1(8) = 30
    MyArray1(9) = 31
    MyArray1(10) = 30
    MyArray1(11) = 31
    Tage.w = 0
    If Tag <= MyArray1(monat-1)
        For i = 0 To (monat-1)-1
            Tage = Tage + MyArray1(i)
        Next i
        Tage=Tage+Tag
    EndIf
    ProcedureReturn Tage
EndProcedure

DayOfYear = DOY(1,2,2002)
MonthOfDays = GetMonthOfDays(2003,32)
FirstDay$ = GetDOW1Januar(2003)
Ostern$ = Str(GetDayOfMonth(2003,GetDayFromGauss(2003)))+"."+Str(GetMonthOfDays(2003,GetDayFromGauss(2003)))

MessageRequester("Tag des Jahres 1.2.2003",Str(DayOfYear),0)
MessageRequester("Monat des Jahrestages 32 2003",Str(MonthOfDays),0)
MessageRequester("Wochentag des 1.Januar 2003",Firstday$,0)
MessageRequester("Ostersonntag 2003",Ostern$,0) 
; ExecutableFormat=
; EOF