2001-04-23 04:46:42 -05:00
|
|
|
<?xml version="1.0" encoding="UTF-8"?>
|
2001-07-20 09:00:14 -05:00
|
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
2001-12-17 08:02:48 -06:00
|
|
|
<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&(byval Year%)
|
2001-10-12 01:56:22 -05:00
|
|
|
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)
|
2001-10-12 01:56:22 -05:00
|
|
|
CalEasterTable& = DateSerial(Year, nMonth,nDay)
|
2001-04-23 04:46:42 -05:00
|
|
|
End Function
|
|
|
|
|
|
|
|
|
2002-10-14 10:16:58 -05:00
|
|
|
' Note: the following algorithm is valid only till the Year 2100.
|
|
|
|
' but I have no Idea from which date in the paste it is valid
|
2002-10-04 07:22:36 -05:00
|
|
|
Function CalOrthodoxEasterTable(ByVal iYear as Integer) as Long
|
|
|
|
Dim R1%, R2%, R3%, RA%, R4%, RB%, R5%, RC%
|
2002-10-14 10:16:58 -05:00
|
|
|
Dim lDate as Long
|
2002-10-04 07:22:36 -05:00
|
|
|
R1 = iYear mod 19
|
|
|
|
R2 = iYear mod 4
|
|
|
|
R3 = iYear mod 7
|
|
|
|
RA =19 * R1 + 16
|
|
|
|
R4 = RA mod 30
|
|
|
|
RB = 2 * R2 + 4 * R3 + 6 * R4
|
|
|
|
R5 = RB mod 7
|
|
|
|
RC = R4 + R5
|
2002-10-14 10:16:58 -05:00
|
|
|
lDate = DateSerial(iYear, 4,4)
|
|
|
|
CalOrthodoxEasterTable() = lDate + RC
|
2002-10-04 07:22:36 -05:00
|
|
|
End Function
|
|
|
|
|
|
|
|
|
2001-04-23 04:46:42 -05:00
|
|
|
Sub CalInitGlobalVariablesDate()
|
2001-07-20 09:00:14 -05:00
|
|
|
Dim i as Integer
|
|
|
|
For i = 1 To 374
|
|
|
|
CalBankholidayName$(i) = ""
|
|
|
|
CalTypeOfBankHoliday%(i) = cHolidayType_None
|
2001-04-23 04:46:42 -05:00
|
|
|
Next
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
|
2001-08-24 09:04:11 -05:00
|
|
|
Sub CalInsertBankholiday(byval CurDate as Long, byval EventName as String, ByVal iLevel as Integer)
|
|
|
|
Dim iDay
|
|
|
|
iDay =(Month(CurDate)-1)*31 +Day(CurDate)
|
2001-04-23 04:46:42 -05:00
|
|
|
|
2001-09-13 08:36:13 -05:00
|
|
|
If 0 <> CalTypeOfBankHoliday(iDay) Then
|
|
|
|
If iLevel < CalTypeOfBankHoliday(iDay) Then
|
2001-08-24 09:04:11 -05:00
|
|
|
CalTypeOfBankHoliday(iDay) = iLevel
|
2001-04-23 04:46:42 -05:00
|
|
|
End If
|
|
|
|
Else
|
2001-08-24 09:04:11 -05:00
|
|
|
CalTypeOfBankHoliday(iDay) = iLevel
|
2001-04-23 04:46:42 -05:00
|
|
|
End If
|
|
|
|
|
2001-09-13 08:36:13 -05:00
|
|
|
If CalBankHolidayName(iDay) = "" Then
|
2001-08-24 09:04:11 -05:00
|
|
|
CalBankHolidayName(iDay) = EventName
|
2001-04-23 04:46:42 -05:00
|
|
|
Else
|
2001-08-24 09:04:11 -05:00
|
|
|
CalBankHolidayName(iDay) = CalBankHolidayName(iDay) & " / " & EventName
|
2001-04-23 04:46:42 -05:00
|
|
|
End If
|
|
|
|
End Sub
|
|
|
|
|
2001-08-24 09:04:11 -05:00
|
|
|
Function CalMaxDayInMonth(ByVal iYear as Integer, ByVal iMonth as Integer) as Integer
|
2002-09-17 08:45:33 -05:00
|
|
|
' delivers the maximum Day of a month in a certain year
|
2001-08-24 09:04:11 -05:00
|
|
|
Dim TmpDate as Long
|
|
|
|
Dim MaxDay as Long
|
2001-04-23 04:46:42 -05:00
|
|
|
|
|
|
|
MaxDay = 28
|
2001-08-24 09:04:11 -05:00
|
|
|
TmpDate = DateSerial(iYear, iMonth, MaxDay)
|
2001-04-23 04:46:42 -05:00
|
|
|
|
2001-08-24 09:04:11 -05:00
|
|
|
While Month(TmpDate) = iMonth
|
|
|
|
MaxDay = MaxDay + 1
|
|
|
|
TmpDate = TmpDate + 1
|
2001-04-23 04:46:42 -05:00
|
|
|
Wend
|
2001-08-24 09:04:11 -05:00
|
|
|
Maxday = MaxDay - 1
|
|
|
|
CalMaxDayInMonth() = MaxDay
|
2001-04-23 04:46:42 -05:00
|
|
|
End Function
|
|
|
|
|
|
|
|
|
2001-08-24 09:04:11 -05:00
|
|
|
Function CalGetIntOfShortMonthName(ByVal MonthName as String) as Integer
|
2001-07-20 09:00:14 -05:00
|
|
|
Dim i as Integer
|
|
|
|
Dim nMonth as Integer
|
2001-04-23 04:46:42 -05:00
|
|
|
|
2001-08-24 09:04:11 -05:00
|
|
|
nMonth = Val(MonthName)
|
2001-04-23 04:46:42 -05:00
|
|
|
|
2001-07-20 09:00:14 -05:00
|
|
|
If (1 <= nMonth And 12 >= nMonth) Then
|
2001-08-24 09:04:11 -05:00
|
|
|
CalGetIntOfShortMonthName = nMonth
|
2001-04-23 04:46:42 -05:00
|
|
|
Exit Function
|
|
|
|
End If
|
|
|
|
|
2001-08-24 09:04:11 -05:00
|
|
|
MonthName = UCase(Trim(Left(MonthName, 3)))
|
2001-04-23 04:46:42 -05:00
|
|
|
|
2001-08-24 09:04:11 -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
|
|
|
|
|
|
|
|
' Not Found
|
2001-08-24 09:04:11 -05:00
|
|
|
CalGetIntOfShortMonthName = 0
|
2001-04-23 04:46:42 -05:00
|
|
|
End Function
|
|
|
|
|
|
|
|
|
2001-08-24 09:04:11 -05:00
|
|
|
Sub CalInsertOwnDataInTables(ByVal iSelYear as Integer)
|
2002-10-29 03:48:13 -06:00
|
|
|
' inserts the individual data from the table into the previously unsorted list
|
2001-07-20 09:00:14 -05:00
|
|
|
Dim CurEventName as String
|
2002-10-29 03:48:13 -06:00
|
|
|
Dim CurEvMonth as Integer
|
|
|
|
Dim CurEvDay as Integer
|
2001-07-20 09:00:14 -05:00
|
|
|
Dim LastIndex as Integer
|
|
|
|
Dim i as Integer
|
2002-10-29 03:48:13 -06:00
|
|
|
Dim DateStr as String
|
2001-07-20 09:00:14 -05:00
|
|
|
LastIndex = Ubound(DlgCalModel.lstOwnData.StringItemList())
|
|
|
|
For i = 0 To LastIndex
|
2002-10-29 03:48:13 -06:00
|
|
|
If GetSelectedDateUnits(CurEvDay, CurEvMonth, i) <> SBDATEUNDEFINED Then
|
|
|
|
CurEventName = CalGetNameOfEvent(i)
|
|
|
|
CalInsertBankholiday(DateSerial(iSelYear, CurEvMonth, CurEvDay), CurEventName, cHolidayType_Own)
|
2001-04-23 04:46:42 -05:00
|
|
|
End If
|
|
|
|
Next
|
|
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
|
|
' Finds eg the first,second Monday in a month
|
|
|
|
' Note: in This Function the week starts with the Sunday
|
2001-11-16 04:21:09 -06:00
|
|
|
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
|
2001-11-16 04:21:09 -06:00
|
|
|
Dim lDate as Long
|
2001-04-23 04:46:42 -05:00
|
|
|
' 1st Tue in Nov : Election Day, Half
|
|
|
|
bFound = False
|
2001-11-16 04:21:09 -06:00
|
|
|
lDate = DateSerial(YearInt, iMonth, 1)
|
|
|
|
Do
|
|
|
|
If iWeekDay = WeekDay(lDate) Then
|
2001-04-23 04:46:42 -05:00
|
|
|
bFound = True
|
2001-11-16 04:21:09 -06:00
|
|
|
Else
|
|
|
|
lDate = lDate + 1
|
2001-04-23 04:46:42 -05:00
|
|
|
End If
|
2001-11-16 04:21:09 -06:00
|
|
|
Loop Until bFound
|
|
|
|
GetMonthDate = lDate + iOffset
|
2001-04-23 04:46:42 -05:00
|
|
|
End Function
|
2002-10-04 07:22:36 -05:00
|
|
|
|
|
|
|
|
|
|
|
' Finds the next weekday after a fixed date
|
|
|
|
' e.g. Midsummerfeast in Sweden: next Saturday after 20th June
|
|
|
|
Function GetNextWeekDay(iYear as Integer, iMonth as Integer, iDay as Integer, iWeekDay as Integer)
|
|
|
|
Dim lDate as Long
|
|
|
|
Dim iCurWeekDay as Integer
|
|
|
|
lDate = DateSerial(iYear, iMonth, iDay)
|
|
|
|
iCurWeekDay = WeekDay(lDate)
|
|
|
|
While iCurWeekDay <> iWeekDay
|
|
|
|
lDate = lDate + 1
|
|
|
|
iCurWeekDay = WeekDay(lDate)
|
|
|
|
Wend
|
|
|
|
GetNextWeekDay() = lDate
|
|
|
|
End Function
|
|
|
|
|
|
|
|
|
|
|
|
Sub AddFollowUpHolidays(ByVal lStartDate as Long, iCount as Integer, HolidayName as String, iType as Integer)
|
|
|
|
Dim lDate as Long
|
2002-10-29 03:48:13 -06:00
|
|
|
For lDate = lStartDate + 1 To lStartDate + 4
|
2002-10-04 07:22:36 -05:00
|
|
|
CalInsertBankholiday(lDate, HolidayName, iType)
|
2002-10-14 10:16:58 -05:00
|
|
|
Next lDate
|
2002-10-04 07:22:36 -05:00
|
|
|
End Sub
|
2003-12-01 10:39:22 -06:00
|
|
|
</script:module>
|