com!online 2001 December/COMCD1201.iso/openoffice/f_0031/BankHoliday.xba

Extensible Markup Language | 2001-07-20 | 4.4 KB | 162 lines

<?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&(byval Year%)

    Dim   B,C,D,E,F,G,H,I,K,L,M,N,O, nMonth, nDay As Integer

       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& = DateSerial(Year%, nMonth,nDay)
End Function



Sub CalInitGlobalVariablesDate()
Dim i as Integer

    For i = 1 To 374
        CalBankholidayName$(i) = ""
        CalTypeOfBankHoliday%(i) = cHolidayType_None
    Next
End Sub



Sub CalInsertBankholiday(byval actDate&, byval Event$, ByVal nBankholidayLevel%)
    Dim DayInYear%
    '    Fuegt ein Ereignis in das globale EventArray ein.
    '    Der Sonderfall der eintreten kann, ist der, dass das Datum
    '    an dem eingefuegt werden soll, bereits ein Ereignis enthaelt.
    '    Dann werden beide Ereignisse mit einem Schraegstrich verbunden.
    DayInYear% =(Month(actDate&)-1)*31 +Day(actDate&)

    '    Hoehere Prioritaet des Feiertagtyps
    If (0 <> CalTypeOfBankHoliday%(DayInYear%)) Then
        If (nBankholidayLevel% < CalTypeOfBankHoliday%(DayInYear%)) Then
            CalTypeOfBankHoliday%(DayInYear%) = nBankholidayLevel%
        End If
    Else
        CalTypeOfBankHoliday%(DayInYear%) = nBankholidayLevel%
    End If

    If (CalBankHolidayName$(DayInYear%) = "") Then
        CalBankHolidayName$(DayInYear%) = Event$
    Else
        CalBankHolidayName$(DayInYear%) = CalBankHolidayName$(DayInYear%) + " / " + Event$
    End If
End Sub



Function CalIsLeapYear%(ByVal TheYear%)
    CalIsLeapYear% = TheYear Mod 4 = 0
End Function


Function CalMaxDayInMonth%(byval YearVal%, byval MonthVal%)
    '    Liefert den maximalen Tag eines Monats in einem
    '    bestimmten Jahr.

    Dim tmpDate&
    Dim    MaxDay%

    MaxDay = 28
    tmpDate& = DateSerial(YearVal%, MonthVal%, MaxDay)

    While Month(tmpDate&) = MonthVal%
        MaxDay% = MaxDay% + 1
        tmpDate& = tmpDate& + 1
    Wend
    Maxday% = MaxDay% - 1
    CalMaxDayInMonth% = MaxDay%
End Function


Function CalGetIntOfShortMonthName%(byval MonthName$)
Dim i as Integer
Dim nMonth as Integer

    nMonth = Val(MonthName$)

    If (1 <= nMonth And 12 >= nMonth) Then
        CalGetIntOfShortMonthName% = nMonth
        Exit Function
    End If

    MonthName$ = UCase(Trim(Left(MonthName, 3)))

    For i = 1 To 12
        If (UCase(cCalShortMonthNames$(i)) = MonthName$) Then
            CalGetIntOfShortMonthName% = i
            Exit Function
        End If
    Next

    '    Not Found
    CalGetIntOfShortMonthName% = 0
End Function


Sub CalInsertOwnDataInTables(byval YearToInsert%)
    '    F├╝gt die eigenen Individuellen Daten aus der Tabelle in die
    '    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 = YearToInsert) Or (CurYear = 0) Then
            CurMonth = CalGetMonthofEvent(i)
            CurDay = CalGetDayofEvent(i)
            CurEventName = CalGetNameOfEvent(i)
            CalInsertBankholiday(DateSerial(CurYear, CurMonth, CurDay), CurEventName, cHolidayType_Own)
        End If
    Next
End Sub


' Finds eg the first,second Monday in a month
' Note: in This Function the week starts with the Sunday
Function GetMonthDate(iWeekDay, iMonth, iCount as Integer)
Dim bFound as Boolean
Dim i as Integer
Dim lDate as Integer
    '    1st Tue in Nov : Election Day, Half
    bFound = False
    i = 0
    lDate = DateSerial(YearInt%, iMonth, 1)
    While Not bFound
        If (iWeekDay = WeekDay(lDate)) Then i = i + 1
        If (i < iCount) Then
            lDate = lDate + 1
        Else
            bFound = True
        End If
    Wend
    GetMonthDate = lDate
End Function
</script:module>