Option Explicit Sub Main() Call CalAutopilotTable() End Sub Function CalEasterTable&(byval Year%) Dim B,C,D,E,F,G,H,I,K,L,M,N,O, nMonth, nDay As Integer N = Year% mod 19 B = int(Year% / 100) C = Year% mod 100 D = int(B / 4) E = B mod 4 F = int((B + 8) / 25) G = int((B - F + 1) / 3) H =(19 * N + B - D - G + 15) mod 30 I = int(C / 4) K = C mod 4 L =(32 + 2 * E + 2 * I - H - K) mod 7 M = int((N + 11 * H + 22 * L) / 451) O = H + L - 7 * M + 114 nDay = O mod 31 + 1 nMonth = int(O / 31) CalEasterTable& = DateSerial(Year%, nMonth,nDay) End Function Sub CalInitGlobalVariablesDate() Dim Count% For Count% = 1 To 374 CalBankholidayName$(Count%) = "" CalTypeOfBankHoliday%(Count%) = cHolidayType_None Next End Sub Sub CalInsertBankholiday(byval actDate&, byval Event$, ByVal nBankholidayLevel%) Dim DayInYear% ' Fuegt ein Ereignis in das globale EventArray ein. ' Der Sonderfall der eintreten kann, ist der, dass das Datum ' an dem eingefuegt werden soll, bereits ein Ereignis enthaelt. ' Dann werden beide Ereignisse mit einem Schraegstrich verbunden. DayInYear% =(Month(actDate&)-1)*31 +Day(actDate&) ' Hoehere Prioritaet des Feiertagtyps If (0 <> CalTypeOfBankHoliday%(DayInYear%)) Then If (nBankholidayLevel% < CalTypeOfBankHoliday%(DayInYear%)) Then CalTypeOfBankHoliday%(DayInYear%) = nBankholidayLevel% End If Else CalTypeOfBankHoliday%(DayInYear%) = nBankholidayLevel% End If If (CalBankHolidayName$(DayInYear%) = "") Then CalBankHolidayName$(DayInYear%) = Event$ Else CalBankHolidayName$(DayInYear%) = CalBankHolidayName$(DayInYear%) + " / " + Event$ End If End Sub Function CalIsLeapYear%(ByVal TheYear%) CalIsLeapYear% = TheYear Mod 4 = 0 End Function Function CalMaxDayInMonth%(byval YearVal%, byval MonthVal%) ' Liefert den maximalen Tag eines Monats in einem ' bestimmten Jahr. Dim tmpDate& Dim MaxDay% MaxDay = 28 tmpDate& = DateSerial(YearVal%, MonthVal%, MaxDay) While Month(tmpDate&) = MonthVal% MaxDay% = MaxDay% + 1 tmpDate& = tmpDate& + 1 Wend Maxday% = MaxDay% - 1 CalMaxDayInMonth% = MaxDay% End Function Function CalGetIntOfShortMonthName%(byval MonthName$) Dim nCount%, nMonth% nMonth% = Val(MonthName$) If (1 <= nMonth% And 12 >= nMonth%) Then CalGetIntOfShortMonthName% = nMonth% Exit Function End If MonthName$ = UCase(Trim(Left(MonthName, 3))) For nCount% = 1 To 12 If (UCase(cCalShortMonthNames$(nCount%)) = MonthName$) Then CalGetIntOfShortMonthName% = nCount% Exit Function End If Next ' Not Found CalGetIntOfShortMonthName% = 0 End Function Sub CalInsertOwnDataInTables(byval YearToInsert%) ' Fügt die eigenen Individuellen Daten aus der Tabelle in die ' bereits erstellte unsortierte Tabelle ein. Dim i%, actYear%, actMonth%, actDay%, theEvent$ For i = 0 To lbOwnData.ListCount() - 1 actYear% = Val(Mid$(lbOwnData.List(i%), 10, 4)) If (actYear%=YearToInsert%) Or (actYear%=0) Then actMonth% = CalGetIntOfShortMonthname%(Mid$(lbOwnData.List(i%), 5, 3)) actDay% = Val(Left$(lbOwnData.List(i%), 2)) theEvent$ = Trim(Mid$(lbOwnData.List(i%), 16)) CalInsertBankholiday(DateSerial(actYear%, actMonth%, actDay%), theEvent$, cHolidayType_Own) End If Next End Sub ' Finds eg the first,second Monday in a month ' Note: in This Function the week starts with the Sunday Function GetMonthDate(iWeekDay, iMonth, iCount as Integer) Dim bFound as Boolean Dim nCount%,lDate as Integer ' 1st Tue in Nov : Election Day, Half bFound = False nCount% = 0 lDate = DateSerial(YearInt%, iMonth, 1) While Not bFound If (iWeekDay = WeekDay(lDate)) Then nCount% = nCount% + 1 If (nCount < iCount) Then lDate = lDate + 1 Else bFound = True End If Wend GetMonthDate = lDate End Function