wizards/source/schedule/BankHoliday.xba

   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
   5 Sub Main()
   6         Call CalAutopilotTable()
   7 End Sub
   8
   9
  10 Function CalEasterTable&amp;(byval Year%)
  11 Dim 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&amp; = DateSerial(Year, nMonth,nDay)
  28 End Function
  29
  30
  31 &apos; Note: the following algorithm is valid only till the Year 2100.
  32 &apos; but I have no Idea from which date in the paste it is valid
  33 Function CalOrthodoxEasterTable(ByVal iYear as Integer) as Long
  34 Dim R1%, R2%, R3%, RA%, R4%, RB%, R5%, RC%
  35 Dim 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
  46 End Function
  47
  48
  49 Sub CalInitGlobalVariablesDate()
  50 Dim i as Integer
  51         For i = 1 To 374
  52                 CalBankholidayName$(i) = &quot;&quot;
  53                 CalTypeOfBankHoliday%(i) = cHolidayType_None
  54         Next
  55 End Sub
  56
  57
  58 Sub CalInsertBankholiday(byval CurDate as Long, byval EventName as String, ByVal iLevel as Integer)
  59 Dim iDay
  60         iDay =(Month(CurDate)-1)*31 +Day(CurDate)
  61
  62         If 0 &lt;&gt; CalTypeOfBankHoliday(iDay) Then
  63                 If iLevel &lt; CalTypeOfBankHoliday(iDay) Then
  64                         CalTypeOfBankHoliday(iDay) = iLevel
  65                 End If
  66         Else
  67                 CalTypeOfBankHoliday(iDay) = iLevel
  68         End If
  69
  70         If CalBankHolidayName(iDay) = &quot;&quot; Then
  71                 CalBankHolidayName(iDay) = EventName
  72         Else
  73                 CalBankHolidayName(iDay) = CalBankHolidayName(iDay) &amp; &quot; / &quot; &amp; EventName
  74         End If
  75 End Sub
  76
  77 Function CalMaxDayInMonth(ByVal iYear as Integer, ByVal iMonth as Integer) as Integer
  78 &apos; 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
  91 End Function
  92
  93
  94 Function CalGetIntOfShortMonthName(ByVal MonthName as String) as Integer
  95 Dim i as Integer
  96 Dim nMonth as Integer
  97
  98         nMonth = Val(MonthName)
  99
 100         If (1 &lt;= nMonth And 12 &gt;= 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         &apos;  Not Found
 115         CalGetIntOfShortMonthName = 0
 116 End Function
 117
 118
 119 Sub CalInsertOwnDataInTables(ByVal iSelYear as Integer)
 120         &apos; inserts the individual data from the table into the previously unsorted list
 121 Dim CurEventName as String
 122 Dim CurEvMonth as Integer
 123 Dim CurEvDay as Integer
 124 Dim LastIndex as Integer
 125 Dim i as Integer
 126 Dim DateStr as String
 127         LastIndex = Ubound(DlgCalModel.lstOwnData.StringItemList())
 128         For i = 0 To LastIndex
 129                 If GetSelectedDateUnits(CurEvDay, CurEvMonth, i) &lt;&gt; SBDATEUNDEFINED Then
 130                         CurEventName = CalGetNameOfEvent(i)
 131                         CalInsertBankholiday(DateSerial(iSelYear, CurEvMonth, CurEvDay), CurEventName, cHolidayType_Own)
 132                 End If
 133         Next
 134 End Sub
 135
 136
 137 &apos; Finds eg the first,second Monday in a month
 138 &apos; Note: in This Function the week starts with the Sunday
 139 Function GetMonthDate(YearInt as Integer, iMonth as Integer, iWeekDay as Integer, iOffset as Integer)
 140 Dim bFound as Boolean
 141 Dim lDate as Long
 142         &apos;  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
 153 End Function
 154
 155
 156 &apos; Finds the next weekday after a fixed date
 157 &apos; e.g. Midsummerfeast in Sweden: next Saturday after 20th June
 158 Function GetNextWeekDay(iYear as Integer, iMonth as Integer, iDay as Integer, iWeekDay as Integer)
 159 Dim lDate as Long
 160 Dim iCurWeekDay as Integer
 161         lDate = DateSerial(iYear, iMonth, iDay)
 162         iCurWeekDay = WeekDay(lDate)
 163         While iCurWeekDay &lt;&gt; iWeekDay
 164                 lDate = lDate + 1
 165                 iCurWeekDay = WeekDay(lDate)
 166         Wend
 167         GetNextWeekDay() = lDate
 168 End Function
 169
 170
 171 Sub AddFollowUpHolidays(ByVal lStartDate as Long, iCount as Integer, HolidayName as String, iType as Integer)
 172 Dim lDate as Long
 173         For lDate = lStartDate + 1 To lStartDate + 4
 174                 CalInsertBankholiday(lDate, HolidayName, iType)
 175         Next lDate
 176 End Sub
 177 </script:module>