home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri Kaikille K-CD 2002 #3 / K-CD_2002-03.iso / OpenOffice / f_0031 / BankHoliday.xba next >
Extensible Markup Language  |  2001-10-12  |  4KB  |  156 lines
  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&(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& = DateSerial(Year, nMonth,nDay)
  28. End Function
  29.  
  30.  
  31. Sub CalInitGlobalVariablesDate()
  32. Dim i as Integer
  33.     For i = 1 To 374
  34.         CalBankholidayName$(i) = ""
  35.         CalTypeOfBankHoliday%(i) = cHolidayType_None
  36.     Next
  37. End Sub
  38.  
  39.  
  40. Sub CalInsertBankholiday(byval CurDate as Long, byval EventName as String, ByVal iLevel as Integer)
  41. Dim iDay
  42.     '    Fuegt ein Ereignis in das globale EventArray ein.
  43.     '    Der Sonderfall der eintreten kann, ist der, dass das Datum
  44.     '    an dem eingefuegt werden soll, bereits ein Ereignis enthaelt.
  45.     '    Dann werden beide Ereignisse mit einem Schraegstrich verbunden.
  46.     iDay =(Month(CurDate)-1)*31 +Day(CurDate)
  47.  
  48.     '    Hoehere Prioritaet des Feiertagtyps
  49.     If 0 <> CalTypeOfBankHoliday(iDay) Then
  50.         If iLevel < CalTypeOfBankHoliday(iDay) Then
  51.             CalTypeOfBankHoliday(iDay) = iLevel
  52.         End If
  53.     Else
  54.         CalTypeOfBankHoliday(iDay) = iLevel
  55.     End If
  56.  
  57.     If CalBankHolidayName(iDay) = "" Then
  58.         CalBankHolidayName(iDay) = EventName
  59.     Else
  60.         CalBankHolidayName(iDay) = CalBankHolidayName(iDay) & " / " & EventName
  61.     End If
  62. End Sub
  63.  
  64.  
  65.  
  66. Function CalIsLeapYear(ByVal iYear as Integer) as Boolean
  67.     CalIsLeapYear = iYear Mod 4 = 0
  68. End Function
  69.  
  70.  
  71. Function CalMaxDayInMonth(ByVal iYear as Integer, ByVal iMonth as Integer) as Integer
  72. ' Liefert den maximalen Tag eines Monats in einem
  73. ' bestimmten Jahr.
  74.     Dim TmpDate as Long
  75.     Dim    MaxDay as Long
  76.     
  77.     MaxDay = 28
  78.     TmpDate = DateSerial(iYear, iMonth, MaxDay)
  79.     
  80.     While Month(TmpDate) = iMonth
  81.         MaxDay = MaxDay + 1
  82.         TmpDate = TmpDate + 1
  83.     Wend
  84.     Maxday = MaxDay - 1
  85.     CalMaxDayInMonth() = MaxDay
  86. End Function
  87.  
  88.  
  89. Function CalGetIntOfShortMonthName(ByVal MonthName as String) as Integer
  90. Dim i as Integer
  91. Dim nMonth as Integer
  92.     
  93.     nMonth = Val(MonthName)
  94.     
  95.     If (1 <= nMonth And 12 >= nMonth) Then
  96.         CalGetIntOfShortMonthName = nMonth
  97.         Exit Function
  98.     End If    
  99.     
  100.     MonthName = UCase(Trim(Left(MonthName, 3)))
  101.  
  102.     For i = 0 To 11 
  103.         If (UCase(cCalShortMonthNames(i)) = MonthName) Then
  104.             CalGetIntOfShortMonthName = i+1
  105.             Exit Function
  106.         End If
  107.     Next
  108.     
  109.     '    Not Found
  110.     CalGetIntOfShortMonthName = 0
  111. End Function
  112.  
  113.  
  114. Sub CalInsertOwnDataInTables(ByVal iSelYear as Integer)
  115.     '    F├╝gt die eigenen Individuellen Daten aus der Tabelle in die
  116.     '    bereits erstellte unsortierte Tabelle ein.    
  117. Dim CurEventName as String
  118. Dim CurYear as Integer
  119. Dim CurMonth as Integer
  120. Dim CurDay as Integer
  121. Dim LastIndex as Integer
  122. Dim i as Integer
  123.     LastIndex = Ubound(DlgCalModel.lstOwnData.StringItemList())
  124.     For i = 0 To LastIndex
  125.         CurYear = CalGetYearOfEvent(i)
  126.         If (CurYear = iSelYear) Or (CurYear = 0) Then
  127.             CurMonth = CalGetMonthofEvent(i)
  128.             CurDay = CalGetDayofEvent(i)
  129.             CurEventName = CalGetNameOfEvent(i)
  130.             CalInsertBankholiday(DateSerial(CurYear, CurMonth, CurDay), CurEventName, cHolidayType_Own)
  131.         End If
  132.     Next
  133. End Sub
  134.  
  135.  
  136. ' Finds eg the first,second Monday in a month
  137. ' Note: in This Function the week starts with the Sunday
  138. Function GetMonthDate(iWeekDay, iMonth, iCount as Integer)
  139. Dim bFound as Boolean
  140. Dim i as Integer
  141. Dim lDate as Integer
  142.     '    1st Tue in Nov : Election Day, Half
  143.     bFound = False
  144.     i = 0
  145.     lDate = DateSerial(YearInt%, iMonth, 1)
  146.     While Not bFound
  147.         If (iWeekDay = WeekDay(lDate)) Then i = i + 1
  148.         If (i < iCount) Then
  149.             lDate = lDate + 1
  150.         Else
  151.             bFound = True
  152.         End If
  153.     Wend
  154.     GetMonthDate = lDate
  155. End Function
  156. </script:module>