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