office-gobmx/wizards/source/schedule/BankHoliday.xba

153 lines
4.1 KiB
Text
Raw Normal View History

2001-04-23 04:46:42 -05:00
<?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
2001-04-23 04:46:42 -05:00
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%
2001-04-23 04:46:42 -05:00
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)
2001-04-23 04:46:42 -05:00
End Function
Sub CalInitGlobalVariablesDate()
Dim i as Integer
For i = 1 To 374
CalBankholidayName$(i) = &quot;&quot;
CalTypeOfBankHoliday%(i) = cHolidayType_None
2001-04-23 04:46:42 -05:00
Next
End Sub
Sub CalInsertBankholiday(byval CurDate as Long, byval EventName as String, ByVal iLevel as Integer)
Dim iDay
2001-04-23 04:46:42 -05:00
&apos; Fuegt ein Ereignis in das globale EventArray ein.
&apos; Der Sonderfall der eintreten kann, ist der, dass das Datum
&apos; an dem eingefuegt werden soll, bereits ein Ereignis enthaelt.
&apos; Dann werden beide Ereignisse mit einem Schraegstrich verbunden.
iDay =(Month(CurDate)-1)*31 +Day(CurDate)
2001-04-23 04:46:42 -05:00
&apos; Hoehere Prioritaet des Feiertagtyps
If 0 &lt;&gt; CalTypeOfBankHoliday(iDay) Then
If iLevel &lt; CalTypeOfBankHoliday(iDay) Then
CalTypeOfBankHoliday(iDay) = iLevel
2001-04-23 04:46:42 -05:00
End If
Else
CalTypeOfBankHoliday(iDay) = iLevel
2001-04-23 04:46:42 -05:00
End If
If CalBankHolidayName(iDay) = &quot;&quot; Then
CalBankHolidayName(iDay) = EventName
2001-04-23 04:46:42 -05:00
Else
CalBankHolidayName(iDay) = CalBankHolidayName(iDay) &amp; &quot; / &quot; &amp; EventName
2001-04-23 04:46:42 -05:00
End If
End Sub
Function CalIsLeapYear(ByVal iYear as Integer) as Boolean
CalIsLeapYear = iYear Mod 4 = 0
2001-04-23 04:46:42 -05:00
End Function
Function CalMaxDayInMonth(ByVal iYear as Integer, ByVal iMonth as Integer) as Integer
&apos; Liefert den maximalen Tag eines Monats in einem
&apos; bestimmten Jahr.
Dim TmpDate as Long
Dim MaxDay as Long
2001-04-23 04:46:42 -05:00
MaxDay = 28
TmpDate = DateSerial(iYear, iMonth, MaxDay)
2001-04-23 04:46:42 -05:00
While Month(TmpDate) = iMonth
MaxDay = MaxDay + 1
TmpDate = TmpDate + 1
2001-04-23 04:46:42 -05:00
Wend
Maxday = MaxDay - 1
CalMaxDayInMonth() = MaxDay
2001-04-23 04:46:42 -05:00
End Function
Function CalGetIntOfShortMonthName(ByVal MonthName as String) as Integer
Dim i as Integer
Dim nMonth as Integer
2001-04-23 04:46:42 -05:00
nMonth = Val(MonthName)
2001-04-23 04:46:42 -05:00
If (1 &lt;= nMonth And 12 &gt;= nMonth) Then
CalGetIntOfShortMonthName = nMonth
2001-04-23 04:46:42 -05:00
Exit Function
End If
MonthName = UCase(Trim(Left(MonthName, 3)))
2001-04-23 04:46:42 -05:00
For i = 0 To 11
If (UCase(cCalShortMonthNames(i)) = MonthName) Then
CalGetIntOfShortMonthName = i+1
2001-04-23 04:46:42 -05:00
Exit Function
End If
Next
&apos; Not Found
CalGetIntOfShortMonthName = 0
2001-04-23 04:46:42 -05:00
End Function
Sub CalInsertOwnDataInTables(ByVal iSelYear as Integer)
2001-04-23 04:46:42 -05:00
&apos; Fügt die eigenen Individuellen Daten aus der Tabelle in die
&apos; 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 (CurYear = iSelYear) Or (CurYear = 0) Then
CurMonth = CalGetMonthofEvent(i)
CurDay = CalGetDayofEvent(i)
CurEventName = CalGetNameOfEvent(i)
CalInsertBankholiday(DateSerial(CurYear, CurMonth, CurDay), CurEventName, cHolidayType_Own)
2001-04-23 04:46:42 -05:00
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)
2001-04-23 04:46:42 -05:00
Dim bFound as Boolean
Dim lDate as Long
2001-04-23 04:46:42 -05:00
&apos; 1st Tue in Nov : Election Day, Half
bFound = False
lDate = DateSerial(YearInt, iMonth, 1)
Do
If iWeekDay = WeekDay(lDate) Then
2001-04-23 04:46:42 -05:00
bFound = True
Else
lDate = lDate + 1
2001-04-23 04:46:42 -05:00
End If
Loop Until bFound
GetMonthDate = lDate + iOffset
2001-04-23 04:46:42 -05:00
End Function
</script:module>