302 lines
No EOL
9.9 KiB
XML
302 lines
No EOL
9.9 KiB
XML
<?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> |