home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Akce / install / f_0030 / BankHoliday.xba next >
Encoding:
Extensible Markup Language  |  2002-02-19  |  4.4 KB  |  155 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 DlgCalModel.lstOwnData.StringItemList(i) <> "" Then
  127.             If (CurYear = iSelYear) Or (CurYear = 0) Then
  128.                 CurMonth = CalGetMonthofEvent(i)
  129.                 CurDay = CalGetDayofEvent(i)
  130.                 CurEventName = CalGetNameOfEvent(i)
  131.                 CalInsertBankholiday(DateSerial(CurYear, CurMonth, CurDay), CurEventName, cHolidayType_Own)
  132.             End If
  133.         End If
  134.     Next
  135. End Sub
  136.  
  137.  
  138. ' Finds eg the first,second Monday in a month
  139. ' Note: in This Function the week starts with the Sunday
  140. Function GetMonthDate(YearInt as Integer, iMonth as Integer, iWeekDay as Integer, iOffset as Integer)
  141. Dim bFound as Boolean
  142. Dim lDate as Long
  143.     '    1st Tue in Nov : Election Day, Half
  144.     bFound = False
  145.     lDate = DateSerial(YearInt, iMonth, 1)
  146.     Do
  147.         If iWeekDay = WeekDay(lDate) Then 
  148.             bFound = True
  149.         Else
  150.             lDate = lDate + 1
  151.         End If
  152.     Loop Until bFound
  153.     GetMonthDate = lDate + iOffset
  154. End Function
  155. </script:module>