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
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
|
<?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="CalendarMain" script:language="StarBasic">Option Explicit
Const _DEBUG = 0
' CalenderMain
Public sCurLangLocale as String
Public sCurCountryLocale as String
' This flag serves as a query if the individual Data should be saved
Public bCalOwnDataChanged as Boolean
'BankHoliday Functions
Public CalBankholidayName$ (1 To 374)
Public CalTypeOfBankHoliday% (1 To 374)
Public Const cHolidayType_None = 0
Public Const cHolidayType_Full = 1
Public Const cHolidayType_Half = 2
Public Const cHolidayType_Own = 4
Public cCalSubcmdDeleteSelect_DeleteSelEntry$
Public cCalSubcmdDeleteSelect_DeleteSelEntryTitle$
Public cCalSubcmdSwitchOwnDataOrGeneral_Back$
Public cCalSubcmdSwitchOwnDataOrGeneral_OwnData$
'Language
Public cCalLongMonthNames(11) as String
Public cCalShortMonthNames(11) as String
Public sBitmapFilename$
Public sCalendarTitle$, sMonthTitle$, sWizardTitle$, sError$
Public cCalStyleWorkday$, cCalStyleWeekend$
Public CalChoosenLand as Integer
Public oDocument as Object
Public oSheets as Object
Public oSheet as Object
Public oStatusLine as Object
Public bCancelTask as Boolean
Public oNumberFormatter as Object
' BL* means "BundesLand" (for german states only)
Public CONST CalBLBayern = 1
Public CONST CalBLBadenWuert = 2
Public CONST CalBLBerlin = 3
Public CONST CalBLBremen = 4
Public CONST CalBLBrandenburg = 5
Public CONST CalBLHamburg = 6
Public CONST CalBLHessen = 7
Public CONST CalBLMeckPomm = 8
Public CONST CalBLNiedersachsen = 9
Public CONST CalBLNordrheinWest = 10
Public CONST CalBLRheinlandPfalz = 11
Public CONST CalBLSaarland = 12
Public CONST CalBLSachsen = 13
Public CONST CalBLSachsenAnhalt = 14
Public CONST CalBLSchlHolstein = 15
Public CONST CalBLThueringen = 16
Public DlgCalendar as Object
Public DlgCalModel as Object
Public lDateFormat as Long
Public lDateStandardFormat as Long
Sub CalAutopilotTable()
Dim BitmapDir as String
Dim iThisMonth as Integer
'On Error Goto ErrorHandler
BasicLibraries.LoadLibrary("Tools")
bSelectByMouseMove = True
oDocument = ThisComponent
oStatusline = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator
ToggleWindow(False)
sCurLangLocale = oDocument.CharLocale.Language
sCurCountryLocale = oDocument.CharLocale.Country
DlgCalendar = LoadDialog("Schedule", "DlgCalendar")
DlgCalModel = DlgCalendar.Model
LoadLanguage(sCurLangLocale)
CalInitGlobalVariablesDate()
BitmapDir = GetOfficeSubPath("Template","../wizard/bitmap")
DlgCalModel.imgCountry.ImageURL = BitmapDir & sBitmapFilename
CalChoosenLand = -2
CalLoadOwnData()
With DlgCalModel
.cmdDelete.Enabled = False
.lstMonth.StringItemList() = cCalShortMonthNames()
Select Case sCurLangLocale
Case cLANGUAGE_JAPANESE
.lstOwnData.FontName = "HG MinochoL"
.txtEvent.FontName = "HG MinchoL"
Case cLANGUAGE_CHINESE
If oDocument.CharLocale.Country = "CN" Then
.lstOwnData.FontName = "FZ Song Ti"
.txtEvent.FontName = "FZ Song Ti"
Else
.lstOwnData.FontName = "FZ Ming Ti"
.txtEvent.FontName = "FZ Ming Ti"
End If
Case "ko"
.lstOwnData.FontName = "Sun Gulim"
.txtEvent.FontName = "Sun Gulim"
End Select
.lstOwnEventMonth.StringItemList() = cCalShortMonthNames()
.optYear.State = 1
.txtYear.Value = Year(Now())
.txtYear.Tag = .txtYear.Value
.Step = 1
End With
SetupNumberFormatter(sCurLangLocale, sCurCountryLocale)
CalChooseCalendar() ' month
iThisMonth = Month(Now)
DlgCalendar.GetControl("lstMonth").SelectItemPos(iThisMonth-1, True)
DlgCalendar.GetControl("lstHolidays").SelectItemPos(0,True)
DlgCalModel.cmdGoOn.DefaultButton = True
ToggleWindow(True)
DlgCalendar.GetControl("lblHolidays").Visible = sCurLangLocale = cLANGUAGE_GERMAN
DlgCalendar.GetControl("lstHolidays").Visible = sCurLangLocale = cLANGUAGE_GERMAN
fHeightCorrFactor = DlgCalendar.GetControl("imgCountry").Size.Height/198
fWidthCorrFactor = DlgCalendar.GetControl("imgCountry").Size.Width/166
DlgCalendar.Execute()
DlgCalendar.Dispose()
Exit Sub
ErrorHandler:
MsgBox(sError$, 16, sWizardTitle$)
End Sub
Sub SetupNumberFormatter(sCurLangLocale as String, sCurCountryLocale as String)
Dim oFormats as Object
Dim DateFormatString as String
oFormats = oDocument.getNumberFormats()
Select Case sCurLangLocale
Case cLANGUAGE_GERMAN
DateFormatString = "TT.MMM"
Case cLANGUAGE_ENGLISH
DateFormatString = "MMM DD"
Case cLANGUAGE_FRENCH
DateFormatString = "JJ/MMM"
Case cLANGUAGE_ITALIAN
DateFormatString = "GG/MMM"
Case cLANGUAGE_SPANISH
DateFormatString = "DD/MMM"
Case cLANGUAGE_PORTUGUESE
If sCurCountryLocale = "BR" Then
DateFormatString = "DD/MMM"
Else
DateFormatString = "DD-MMM"
End If
Case cLANGUAGE_DUTCH
DateFormatString = "DD/MMM"
Case cLANGUAGE_SWEDISH
DateFormatString = "MMM DD"
Case cLANGUAGE_DANISH
DateFormatString = "DD-MMM"
Case cLANGUAGE_POLISH
DateFormatString = "MMM DD"
Case cLANGUAGE_RUSSIAN
DateFormatString = "MMM DD"
Case cLANGUAGE_JAPANESE
DateFormatString = "M月D日"
Case cLANGUAGE_CHINESE
If sCurCountryLocale = "TW" Then
DateFormatString = "MMMMD" &"""" & "日" & """"
Else
DateFormatString = "M" & """" & "月" & """" & "D" &"""" & "日" & """"
End If
Case cLANGUAGE_GREEK
DateFormatString = "DD/MMM"
Case cLANGUAGE_TURKISH
DateFormatString = "DD/MMM"
Case cLANGUAGE_POLISH
DateFormatString = "MMM DD"
Case cLANGUAGE_FINNISH
DateFormatString = "PP.KKK"
End Select
lDateFormat = AddNumberFormat(oFormats, DateFormatString, oDocument.CharLocale)
lDateStandardFormat = oFormats.getStandardFormat(com.sun.star.util.NumberFormat.DATE, oDocument.CharLocale)
' lDateStandardFormat = AddNumberFormat(oFormats, StandardDateFormatString, oDocument.CharLocale)
oNumberFormatter = createUNOService("com.sun.star.util.NumberFormatter")
oNumberFormatter.attachNumberFormatsSupplier(oDocument)
End Sub
Function AddNumberFormat(oNumberFormats as Object, FormatString as String, oLocale as Object) as Long
Dim lLocDateFormat as Long
lLocDateFormat = oNumberFormats.QueryKey(FormatString, oLocale, True)
If lLocDateFormat = -1 Then
lLocDateFormat = oNumberFormats.addNew(FormatString, oLocale)
End If
AddNumberFormat() = lLocDateFormat
End Function
Sub CalChooseCalendar()
With DlgCalModel
.lstMonth.Enabled = .optMonth.State = 1
.lblMonth.Enabled = .optMonth.State = 1
End With
End Sub
Sub CalcmdCancel()
Call CalSaveOwnData()
DlgCalendar.EndExecute
End Sub
Sub CalcmdOk()
' cmdOk is called when the Button 'Read' is clicked on
' It is either given out a month or a year
Dim i, iSelYear as Integer
Dim SelYear as String
' DlgCalendar.Visible = False
oSheets = oDocument.sheets
Call CalSaveOwnData()
UnprotectSheets(oSheets)
oSheets.RemovebyName(oSheets.GetbyIndex(0).Name)
iSelYear = DlgCalModel.txtYear.Value
Select Case sCurLangLocale
Case cLANGUAGE_GERMAN
If Ubound(DlgCalModel.lstHolidays.SelectedItems()) > -1 Then
CalChoosenLand = DlgCalModel.lstHolidays.SelectedItems(0)
Else
CalChoosenLand = 0
End If
Call CalFindWholeYearHolidays_GERMANY(iSelYear, CalChoosenLand)
Case cLANGUAGE_ENGLISH
Call FindWholeYearHolidays_US(iSelYear)
Case cLANGUAGE_FRENCH
Call FindWholeYearHolidays_FRANCE(iSelYear)
Case cLANGUAGE_ITALIAN
Call FindWholeYearHolidays_ITA(iSelYear)
Case cLANGUAGE_SPANISH
Call FindWholeYearHolidays_SPAIN(iSelYear)
Case cLANGUAGE_PORTUGUESE
Call FindWholeYearHolidays_PORT(iSelYear)
Case cLANGUAGE_DUTCH
Call FindWholeYearHolidays_NL(iSelYear)
Case cLANGUAGE_SWEDISH
Call FindWholeYearHolidays_SWED(iSelYear)
Case cLANGUAGE_DANISH
Call FindWholeYearHolidays_DK(iSelYear)
Case cLANGUAGE_POLISH
Call FindWholeYearHolidays_PL(iSelYear)
Case cLANGUAGE_RUSSIAN
Call FindWholeYearHolidays_RU(iSelYear)
Case cLANGUAGE_JAPANESE
Call FindWholeYearHolidays_JP(iSelYear)
Case cLANGUAGE_CHINESE
If sCurCountryLocale = "TW" Then
Call FindWholeYearHolidays_TW(iSelYear)
Else
Call FindWholeYearHolidays_CN(iSelYear)
End If
Case cLANGUAGE_GREEK
Call FindWholeYearHolidays_GREEK(iSelYear)
Case cLANGUAGE_TURKISH
Call FindWholeYearHolidays_TRK(iSelYear)
Case cLANGUAGE_POLISH
Call FindWholeYearHolidays_PL(iSelYear)
Case cLANGUAGE_FINNISH
Call FindWholeYearHolidays_FI(iSelYear)
End Select
Call CalInsertOwnDataInTables(iSelYear)
If DlgCalModel.optYear.State = 1 Then
oSheets.RemovebyName(oSheets.GetbyIndex(0).Name)
oSheet = oSheets.GetbyIndex(0)
oSheet.Name = sCalendarTitle$ + " " + iSelYear
oDocument.AddActionLock
Call CalCreateYearTable(iSelYear)
ElseIf DlgCalModel.optMonth.State = 1 Then
Dim iMonth
iMonth = DlgCalModel.lstMonth.SelectedItems(0) + 1
oSheets.RemovebyName(oSheets.GetbyIndex(1).Name)
oSheet = oSheets.GetbyIndex(0)
If sMonthTitle = "" Then
oSheet.Name = cCalLongMonthNames(iMonth-1)
Else
oSheet.Name = sMonthTitle + " " + cCalLongMonthNames(iMonth-1)
End If
oDocument.AddActionLock
Call CalCreateMonthTable(iSelYear, iMonth)
End If
oDocument.RemoveActionLock
oSheet.protect("")
oStatusLine.End
DlgCalendar.EndExecute()
bCancelTask = True
End Sub
</script:module>
|