1<?xml version="1.0" encoding="UTF-8"?> 2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3<script:module xmlns:script="http://openoffice.org/2000/script" script:name="BankHoliday" script:language="StarBasic">Option Explicit 4 5Sub Main() 6 Call CalAutopilotTable() 7End Sub 8 9 10Function CalEasterTable&(byval Year%) 11Dim B%,C%,D%,E%,F%,G%,H%,I%,K%,L%,M%,N%,O%, nMonth%, nDay% 12 N = Year% mod 19 13 B = int(Year% / 100) 14 C = Year% mod 100 15 D = int(B / 4) 16 E = B mod 4 17 F = int((B + 8) / 25) 18 G = int((B - F + 1) / 3) 19 H =(19 * N + B - D - G + 15) mod 30 20 I = int(C / 4) 21 K = C mod 4 22 L =(32 + 2 * E + 2 * I - H - K) mod 7 23 M = int((N + 11 * H + 22 * L) / 451) 24 O = H + L - 7 * M + 114 25 nDay = O mod 31 + 1 26 nMonth = int(O / 31) 27 CalEasterTable& = DateSerial(Year, nMonth,nDay) 28End Function 29 30 31' Note: the following algorithm is valid only till the Year 2100. 32' but I have no Idea from which date in the paste it is valid 33Function CalOrthodoxEasterTable(ByVal iYear as Integer) as Long 34Dim R1%, R2%, R3%, RA%, R4%, RB%, R5%, RC% 35Dim lDate as Long 36 R1 = iYear mod 19 37 R2 = iYear mod 4 38 R3 = iYear mod 7 39 RA =19 * R1 + 16 40 R4 = RA mod 30 41 RB = 2 * R2 + 4 * R3 + 6 * R4 42 R5 = RB mod 7 43 RC = R4 + R5 44 lDate = DateSerial(iYear, 4,4) 45 CalOrthodoxEasterTable() = lDate + RC 46End Function 47 48 49Sub CalInitGlobalVariablesDate() 50Dim i as Integer 51 For i = 1 To 374 52 CalBankholidayName$(i) = "" 53 CalTypeOfBankHoliday%(i) = cHolidayType_None 54 Next 55End Sub 56 57 58Sub CalInsertBankholiday(byval CurDate as Long, byval EventName as String, ByVal iLevel as Integer) 59Dim iDay 60 iDay =(Month(CurDate)-1)*31 +Day(CurDate) 61 62 If 0 <> CalTypeOfBankHoliday(iDay) Then 63 If iLevel < CalTypeOfBankHoliday(iDay) Then 64 CalTypeOfBankHoliday(iDay) = iLevel 65 End If 66 Else 67 CalTypeOfBankHoliday(iDay) = iLevel 68 End If 69 70 If CalBankHolidayName(iDay) = "" Then 71 CalBankHolidayName(iDay) = EventName 72 Else 73 CalBankHolidayName(iDay) = CalBankHolidayName(iDay) & " / " & EventName 74 End If 75End Sub 76 77Function CalMaxDayInMonth(ByVal iYear as Integer, ByVal iMonth as Integer) as Integer 78' delivers the maximum Day of a month in a certain year 79 Dim TmpDate as Long 80 Dim MaxDay as Long 81 82 MaxDay = 28 83 TmpDate = DateSerial(iYear, iMonth, MaxDay) 84 85 While Month(TmpDate) = iMonth 86 MaxDay = MaxDay + 1 87 TmpDate = TmpDate + 1 88 Wend 89 Maxday = MaxDay - 1 90 CalMaxDayInMonth() = MaxDay 91End Function 92 93 94Function CalGetIntOfShortMonthName(ByVal MonthName as String) as Integer 95Dim i as Integer 96Dim nMonth as Integer 97 98 nMonth = Val(MonthName) 99 100 If (1 <= nMonth And 12 >= nMonth) Then 101 CalGetIntOfShortMonthName = nMonth 102 Exit Function 103 End If 104 105 MonthName = UCase(Trim(Left(MonthName, 3))) 106 107 For i = 0 To 11 108 If (UCase(cCalShortMonthNames(i)) = MonthName) Then 109 CalGetIntOfShortMonthName = i+1 110 Exit Function 111 End If 112 Next 113 114 ' Not Found 115 CalGetIntOfShortMonthName = 0 116End Function 117 118 119Sub CalInsertOwnDataInTables(ByVal iSelYear as Integer) 120 ' inserts the individual data from the table into the previously unsorted list 121Dim CurEventName as String 122Dim CurEvMonth as Integer 123Dim CurEvDay as Integer 124Dim LastIndex as Integer 125Dim i as Integer 126Dim DateStr as String 127 LastIndex = Ubound(DlgCalModel.lstOwnData.StringItemList()) 128 For i = 0 To LastIndex 129 If GetSelectedDateUnits(CurEvDay, CurEvMonth, i) <> SBDATEUNDEFINED Then 130 CurEventName = CalGetNameOfEvent(i) 131 CalInsertBankholiday(DateSerial(iSelYear, CurEvMonth, CurEvDay), CurEventName, cHolidayType_Own) 132 End If 133 Next 134End Sub 135 136 137' Finds eg the first,second Monday in a month 138' Note: in This Function the week starts with the Sunday 139Function GetMonthDate(YearInt as Integer, iMonth as Integer, iWeekDay as Integer, iOffset as Integer) 140Dim bFound as Boolean 141Dim lDate as Long 142 ' 1st Tue in Nov : Election Day, Half 143 bFound = False 144 lDate = DateSerial(YearInt, iMonth, 1) 145 Do 146 If iWeekDay = WeekDay(lDate) Then 147 bFound = True 148 Else 149 lDate = lDate + 1 150 End If 151 Loop Until bFound 152 GetMonthDate = lDate + iOffset 153End Function 154 155 156' Finds the next weekday after a fixed date 157' e.g. Midsummerfeast in Sweden: next Saturday after 20th June 158Function GetNextWeekDay(iYear as Integer, iMonth as Integer, iDay as Integer, iWeekDay as Integer) 159Dim lDate as Long 160Dim iCurWeekDay as Integer 161 lDate = DateSerial(iYear, iMonth, iDay) 162 iCurWeekDay = WeekDay(lDate) 163 While iCurWeekDay <> iWeekDay 164 lDate = lDate + 1 165 iCurWeekDay = WeekDay(lDate) 166 Wend 167 GetNextWeekDay() = lDate 168End Function 169 170 171Sub AddFollowUpHolidays(ByVal lStartDate as Long, iCount as Integer, HolidayName as String, iType as Integer) 172Dim lDate as Long 173 For lDate = lStartDate + 1 To lStartDate + 4 174 CalInsertBankholiday(lDate, HolidayName, iType) 175 Next lDate 176End Sub 177</script:module>