office-gobmx/wizards/source/schedule/BankHoliday.xba
2002-09-27 07:56:50 +00:00

149 lines
No EOL
3.8 KiB
XML

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="BankHoliday" script:language="StarBasic">Option Explicit
Sub Main()
Call CalAutopilotTable()
End Sub
Function CalEasterTable&amp;(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&amp; = DateSerial(Year, nMonth,nDay)
End Function
Sub CalInitGlobalVariablesDate()
Dim i as Integer
For i = 1 To 374
CalBankholidayName$(i) = &quot;&quot;
CalTypeOfBankHoliday%(i) = cHolidayType_None
Next
End Sub
Sub CalInsertBankholiday(byval CurDate as Long, byval EventName as String, ByVal iLevel as Integer)
Dim iDay
iDay =(Month(CurDate)-1)*31 +Day(CurDate)
If 0 &lt;&gt; CalTypeOfBankHoliday(iDay) Then
If iLevel &lt; CalTypeOfBankHoliday(iDay) Then
CalTypeOfBankHoliday(iDay) = iLevel
End If
Else
CalTypeOfBankHoliday(iDay) = iLevel
End If
If CalBankHolidayName(iDay) = &quot;&quot; Then
CalBankHolidayName(iDay) = EventName
Else
CalBankHolidayName(iDay) = CalBankHolidayName(iDay) &amp; &quot; / &quot; &amp; 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
&apos; delivers the maximum Day of a month in a certain year
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 &lt;= nMonth And 12 &gt;= 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
&apos; Not Found
CalGetIntOfShortMonthName = 0
End Function
Sub CalInsertOwnDataInTables(ByVal iSelYear as Integer)
&apos; inserts the individual data from the table into the previously unsorted list
Dim CurEventName as String
Dim CurEvYear as Integer
Dim CurEvMonth as Integer
Dim CurEvDay as Integer
Dim LastIndex as Integer
Dim i as Integer
Dim DateStr as String
LastIndex = Ubound(DlgCalModel.lstOwnData.StringItemList())
For i = 0 To LastIndex
If GetSelectedDateUnits(CurEvDay, CurEvMonth, CurEvYear, i) &lt;&gt; SBDATEUNDEFINED Then
If (CurEvYear = iSelYear) Or (CurEvYear = SBYEARUNDEFINED) Then
CurEventName = CalGetNameOfEvent(i)
CalInsertBankholiday(DateSerial(CurEvYear, CurEvMonth, CurEvDay), CurEventName, cHolidayType_Own)
End If
End If
Next
End Sub
&apos; Finds eg the first,second Monday in a month
&apos; 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
&apos; 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
</script:module>