;Datumsberechnungen ;############################################## ;Andreas Miethe * Dezember 2002 ;############################################## ;ab PB 4.x ;############################################## 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 Define.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 Define.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) ; IDE Options = PureBasic v4.01 (Windows - x86) ; CursorPosition = 168 ; FirstLine = 126 ; Folding = --