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% 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 i as Integer For i = 1 To 374 CalBankholidayName$(i) = "" CalTypeOfBankHoliday%(i) = cHolidayType_None Next End Sub Sub CalInsertBankholiday(byval CurDate as Long, byval EventName as String, ByVal iLevel as Integer) Dim iDay ' 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. iDay =(Month(CurDate)-1)*31 +Day(CurDate) ' Hoehere Prioritaet des Feiertagtyps If 0 <> CalTypeOfBankHoliday(iDay) Then If iLevel < CalTypeOfBankHoliday(iDay) Then CalTypeOfBankHoliday(iDay) = iLevel End If Else CalTypeOfBankHoliday(iDay) = iLevel End If If CalBankHolidayName(iDay) = "" Then CalBankHolidayName(iDay) = EventName Else CalBankHolidayName(iDay) = CalBankHolidayName(iDay) & " / " & EventName End If End Sub Function CalIsLeapYear(ByVal iYear as Integer) as Boolean CalIsLeapYear = iYear Mod 4 = 0 End Function Function CalMaxDayInMonth(ByVal iYear as Integer, ByVal iMonth as Integer) as Integer ' Liefert den maximalen Tag eines Monats in einem ' bestimmten Jahr. Dim TmpDate as Long Dim MaxDay as Long MaxDay = 28 TmpDate = DateSerial(iYear, iMonth, MaxDay) While Month(TmpDate) = iMonth MaxDay = MaxDay + 1 TmpDate = TmpDate + 1 Wend Maxday = MaxDay - 1 CalMaxDayInMonth() = MaxDay End Function Function CalGetIntOfShortMonthName(ByVal MonthName as String) as Integer Dim i as Integer Dim nMonth as Integer nMonth = Val(MonthName) If (1 <= nMonth And 12 >= nMonth) Then CalGetIntOfShortMonthName = nMonth Exit Function End If MonthName = UCase(Trim(Left(MonthName, 3))) For i = 0 To 11 If (UCase(cCalShortMonthNames(i)) = MonthName) Then CalGetIntOfShortMonthName = i+1 Exit Function End If Next ' Not Found CalGetIntOfShortMonthName = 0 End Function Sub CalInsertOwnDataInTables(ByVal iSelYear as Integer) ' Fügt die eigenen Individuellen Daten aus der Tabelle in die ' bereits erstellte unsortierte Tabelle ein. Dim CurEventName as String Dim CurYear as Integer Dim CurMonth as Integer Dim CurDay as Integer Dim LastIndex as Integer Dim i as Integer LastIndex = Ubound(DlgCalModel.lstOwnData.StringItemList()) For i = 0 To LastIndex CurYear = CalGetYearOfEvent(i) If DlgCalModel.lstOwnData.StringItemList(i) <> "" Then If (CurYear = iSelYear) Or (CurYear = 0) Then CurMonth = CalGetMonthofEvent(i) CurDay = CalGetDayofEvent(i) CurEventName = CalGetNameOfEvent(i) CalInsertBankholiday(DateSerial(CurYear, CurMonth, CurDay), CurEventName, cHolidayType_Own) End If 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(YearInt as Integer, iMonth as Integer, iWeekDay as Integer, iOffset as Integer) Dim bFound as Boolean Dim lDate as Long ' 1st Tue in Nov : Election Day, Half bFound = False lDate = DateSerial(YearInt, iMonth, 1) Do If iWeekDay = WeekDay(lDate) Then bFound = True Else lDate = lDate + 1 End If Loop Until bFound GetMonthDate = lDate + iOffset End Function