wizards/source/schedule/BankHoliday.xba


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177

<?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&amp;(byval Year%)
Dim B%,C%,D%,E%,F%,G%,H%,I%,K%,L%,M%,N%,O%, nMonth%, nDay%
       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)
End Function


&apos; Note: the following algorithm is valid only till the Year 2100.
&apos; but I have no Idea from which date in the paste it is valid
Function CalOrthodoxEasterTable(ByVal iYear as Integer) as Long
Dim R1%, R2%, R3%, RA%, R4%, RB%, R5%, RC%
Dim lDate as Long
	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
	lDate = DateSerial(iYear, 4,4)
	CalOrthodoxEasterTable() = lDate + RC
End Function


Sub CalInitGlobalVariablesDate()
Dim i as Integer
	For i = 1 To 374
		CalBankholidayName$(i) = &quot;&quot;
		CalTypeOfBankHoliday%(i) = cHolidayType_None
	Next
End Sub


Sub CalInsertBankholiday(byval CurDate as Long, byval EventName as String, ByVal iLevel as Integer)
Dim iDay
	iDay =(Month(CurDate)-1)*31 +Day(CurDate)

	If 0 &lt;&gt; CalTypeOfBankHoliday(iDay) Then
		If iLevel &lt; CalTypeOfBankHoliday(iDay) Then
			CalTypeOfBankHoliday(iDay) = iLevel
		End If
	Else
		CalTypeOfBankHoliday(iDay) = iLevel
	End If

	If CalBankHolidayName(iDay) = &quot;&quot; Then
		CalBankHolidayName(iDay) = EventName
	Else
		CalBankHolidayName(iDay) = CalBankHolidayName(iDay) &amp; &quot; / &quot; &amp; EventName
	End If
End Sub

Function CalMaxDayInMonth(ByVal iYear as Integer, ByVal iMonth as Integer) as Integer
&apos; delivers the maximum Day of a month in a certain year
	Dim TmpDate as Long
	Dim	MaxDay as Long
	
	MaxDay = 28
	TmpDate = DateSerial(iYear, iMonth, MaxDay)
	
	While Month(TmpDate) = iMonth
		MaxDay = MaxDay + 1
		TmpDate = TmpDate + 1
	Wend
	Maxday = MaxDay - 1
	CalMaxDayInMonth() = MaxDay
End Function


Function CalGetIntOfShortMonthName(ByVal MonthName as String) as Integer
Dim i as Integer
Dim nMonth as Integer
	
	nMonth = Val(MonthName)
	
	If (1 &lt;= nMonth And 12 &gt;= nMonth) Then
		CalGetIntOfShortMonthName = nMonth
		Exit Function
	End If	
	
	MonthName = UCase(Trim(Left(MonthName, 3)))

	For i = 0 To 11 
		If (UCase(cCalShortMonthNames(i)) = MonthName) Then
			CalGetIntOfShortMonthName = i+1
			Exit Function
		End If
	Next
	
	&apos;	Not Found
	CalGetIntOfShortMonthName = 0
End Function


Sub CalInsertOwnDataInTables(ByVal iSelYear as Integer)
	&apos; inserts the individual data from the table into the previously unsorted list
Dim CurEventName as String
Dim CurEvMonth as Integer
Dim CurEvDay as Integer
Dim LastIndex as Integer
Dim i as Integer
Dim DateStr as String
	LastIndex = Ubound(DlgCalModel.lstOwnData.StringItemList())
	For i = 0 To LastIndex
		If GetSelectedDateUnits(CurEvDay, CurEvMonth, i) &lt;&gt; SBDATEUNDEFINED Then
			CurEventName = CalGetNameOfEvent(i)
			CalInsertBankholiday(DateSerial(iSelYear, CurEvMonth, CurEvDay), CurEventName, cHolidayType_Own)
		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)
Dim bFound as Boolean
Dim lDate as Long
	&apos;	1st Tue in Nov : Election Day, Half
	bFound = False
	lDate = DateSerial(YearInt, iMonth, 1)
	Do
		If iWeekDay = WeekDay(lDate) Then 
			bFound = True
		Else
			lDate = lDate + 1
		End If
	Loop Until bFound
	GetMonthDate = lDate + iOffset
End Function


&apos; Finds the next weekday after a fixed date
&apos; 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 &lt;&gt; 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
	For lDate = lStartDate + 1 To lStartDate + 4
		CalInsertBankholiday(lDate, HolidayName, iType)
	Next lDate
End Sub
</script:module>