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