diff options
| author | Behrend Cornelius <bc@openoffice.org> | 2002-10-29 09:48:13 +0000 |
|---|---|---|
| committer | Behrend Cornelius <bc@openoffice.org> | 2002-10-29 09:48:13 +0000 |
| commit | 050eec5b4096686f60683441291b6575513f9976 (patch) | |
| tree | 5fd59b2fc6711e8fdaf39870fea4dd8a8079e792 /wizards/source/schedule | |
| parent | 4457d8cd564ba8e313a4158cef5eab1346e03ce7 (diff) | |
#96771# Own Holidays that occur once no longer supported
Diffstat (limited to 'wizards/source/schedule')
| -rw-r--r-- | wizards/source/schedule/BankHoliday.xba | 24 | ||||
| -rw-r--r-- | wizards/source/schedule/CalendarMain.xba | 141 | ||||
| -rw-r--r-- | wizards/source/schedule/CreateTable.xba | 1 | ||||
| -rw-r--r-- | wizards/source/schedule/DlgControl.xba | 94 | ||||
| -rw-r--r-- | wizards/source/schedule/GermanHolidays.xba | 14 | ||||
| -rw-r--r-- | wizards/source/schedule/Language.xba | 5 | ||||
| -rw-r--r-- | wizards/source/schedule/LocalHolidays.xba | 12 | ||||
| -rw-r--r-- | wizards/source/schedule/OwnEvents.xba | 253 |
8 files changed, 277 insertions, 267 deletions
diff --git a/wizards/source/schedule/BankHoliday.xba b/wizards/source/schedule/BankHoliday.xba index 8c89b1c80..635141366 100644 --- a/wizards/source/schedule/BankHoliday.xba +++ b/wizards/source/schedule/BankHoliday.xba @@ -124,30 +124,23 @@ End Function Sub CalInsertOwnDataInTables(ByVal iSelYear as Integer) - ' Fügt die eigenen Individuellen Daten aus der Tabelle in die - ' bereits erstellte unsortierte Tabelle ein. + ' inserts the individual data from the table into the previously unsorted list Dim CurEventName as String -Dim CurYear as Integer -Dim CurMonth as Integer -Dim CurDay as Integer +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 - CurYear = CalGetYearOfEvent(i) - If DlgCalModel.lstOwnData.StringItemList(i) <> "" Then - If (CurYear = iSelYear) Or (CurYear = 0) Then - CurMonth = CalGetMonthofEvent(i) - CurDay = CalGetDayofEvent(i) - CurEventName = CalGetNameOfEvent(i) - CalInsertBankholiday(DateSerial(CurYear, CurMonth, CurDay), CurEventName, cHolidayType_Own) - End If + If GetSelectedDateUnits(CurEvDay, CurEvMonth, i) <> SBDATEUNDEFINED Then + CurEventName = CalGetNameOfEvent(i) + CalInsertBankholiday(DateSerial(iSelYear, CurEvMonth, CurEvDay), CurEventName, cHolidayType_Own) End If Next End Sub - ' Finds eg the first,second Monday in a month ' Note: in This Function the week starts with the Sunday Function GetMonthDate(YearInt as Integer, iMonth as Integer, iWeekDay as Integer, iOffset as Integer) @@ -167,7 +160,6 @@ Dim lDate as Long End Function - ' 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) @@ -185,7 +177,7 @@ 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 + iCount + For lDate = lStartDate + 1 To lStartDate + 4 CalInsertBankholiday(lDate, HolidayName, iType) Next lDate End Sub diff --git a/wizards/source/schedule/CalendarMain.xba b/wizards/source/schedule/CalendarMain.xba index be49f82ee..a75310d56 100644 --- a/wizards/source/schedule/CalendarMain.xba +++ b/wizards/source/schedule/CalendarMain.xba @@ -61,6 +61,8 @@ Public CONST CalBLThueringen = 16 Public DlgCalendar as Object Public DlgCalModel as Object +Public lDateFormat as Long +Public lDateStandardFormat as Long @@ -85,15 +87,14 @@ Dim iThisMonth as Integer CalChoosenLand = -2 CalLoadOwnData() -' sCurLanguage = "ja" With DlgCalModel .cmdDelete.Enabled = False .lstMonth.StringItemList() = cCalShortMonthNames() Select Case sCurLangLocale - Case "ja" + Case cLANGUAGE_JAPANESE .lstOwnData.FontName = "HG Mincho Light J" .txtEvent.FontName = "HG Mincho Light J" - Case "zh" + Case cLANGUAGE_CHINESE If oDocument.CharLocale.Country = "CN" Then .lstOwnData.FontName = "HG MSung Light SC" .txtEvent.FontName = "HG MSung Light SC" @@ -111,6 +112,7 @@ Dim iThisMonth as Integer .txtYear.Tag = .txtYear.Value .Step = 1 End With + SetupNumberFormatter(sCurLangLocale, sCurCountryLocale) CalChooseCalendar() ' month iThisMonth = Month(Now) DlgCalendar.GetControl("lstMonth").SelectItemPos(iThisMonth-1, True) @@ -129,6 +131,70 @@ ErrorHandler: 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 + DateFormatString = "DD-MMM" + 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 @@ -143,52 +209,18 @@ Sub CalcmdCancel() 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 as Integer -Dim iSelYear as Integer +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 - If DlgCalModel.optYear.State = 1 Then - oSheets.RemovebyName(oSheets.GetbyIndex(0).Name) - oSheet = oSheets.GetbyIndex(0) - oSheet.Name = sCalendarTitle$ + " " + iSelYear - InsertLocalBankholidays(iSelYear) - CalInsertOwnDataInTables(iSelYear) - oDocument.AddActionLock() - 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 - InsertLocalBankholidays(iSelYear) - CalInsertOwnDataInTables(iSelYear) - oDocument.AddActionLock - CalCreateMonthTable(iSelYear, iMonth) - End If - oDocument.RemoveActionLock -' oDocument.CalculateAll() - oSheet.protect("") - oStatusLine.End - DlgCalendar.EndExecute() - bCancelTask = True -End Sub - - -Sub InsertLocalBankholidays(iSelYear as Integer) Select Case sCurLangLocale Case cLANGUAGE_GERMAN If Ubound(DlgCalModel.lstHolidays.SelectedItems()) > -1 Then @@ -234,4 +266,33 @@ Sub InsertLocalBankholidays(iSelYear as Integer) Case cLANGUAGE_FINNISH Call FindWholeYearHolidays_FI(iSelYear) End Select -End Sub</script:module>
\ No newline at end of file + + 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>
\ No newline at end of file diff --git a/wizards/source/schedule/CreateTable.xba b/wizards/source/schedule/CreateTable.xba index 10838707f..6d472a84b 100644 --- a/wizards/source/schedule/CreateTable.xba +++ b/wizards/source/schedule/CreateTable.xba @@ -114,6 +114,7 @@ ErrorHandling: End Sub + Sub FormatCalCells(ColPos,RowPos,i as Integer) Dim oNameCell, oDateCell as Object Dim iCellValue as Long diff --git a/wizards/source/schedule/DlgControl.xba b/wizards/source/schedule/DlgControl.xba index 0ba3ca42e..275e507fa 100644 --- a/wizards/source/schedule/DlgControl.xba +++ b/wizards/source/schedule/DlgControl.xba @@ -8,6 +8,7 @@ Public fHeightCorrFactor as Double Public fWidthCorrFactor as Double + Sub Main() Call CalAutopilotTable() End Sub @@ -15,14 +16,28 @@ End Sub Sub CalcmdDeleteSelect() Dim MsgBoxResult as Integer +Dim bDoEnable as Boolean +Dim iSel as Integer +Dim MaxIndex as Integer If Ubound(DlgCalModel.lstOwnData.SelectedItems()) > -1 Then MsgBoxResult = MsgBox(cCalSubcmdDeleteSelect_DeleteSelEntry$, 4+32, cCalSubcmdDeleteSelect_DeleteSelEntryTitle$) If MsgBoxResult = 6 Then + iSel = DlgCalModel.lstOwnData.SelectedItems(0) DlgCalModel.lstOwnData.StringItemList() = RemoveSelected(DlgCalModel.lstOwnData) - ' Flag zum Speichern der neuen Daten. + ' Flag to store the new data bCalOwnDataChanged = True - DlgCalModel.cmdDelete.Enabled = Ubound(DlgCalModel.lstOwnData.StringItemList()) > -1 - Call CalClearInputMask() + bDoEnable = Ubound(DlgCalModel.lstOwnData.StringItemList()) > -1 + DlgCalModel.cmdDelete.Enabled = bDoEnable + If bDoEnable Then + MaxIndex = Ubound(DlgCalModel.lstOwnData.StringItemList()) + If iSel > MaxIndex Then + iSel = MaxIndex + End If + DlgCalendar.GetControl("lstOwnData").SelectItemPos(iSel, True) + CalUpdateNewEventFrame() + Else + Call CalClearInputMask() + End If End If End If End Sub @@ -32,21 +47,6 @@ Sub CalSaveOwnEventControls() With DlgCalModel .txtOwnEventDay.Tag = .txtOwnEventDay.Value .txtOwnEventMonth.Tag = .txtOwnEventMonth.Text - .DlgCalModel.txtOwnEventYear.Tag = DlgCalModel.txtOwnEventYear.Value - End With -End Sub - - -Sub ToggleYearBox() -' Falls der RadioButton für einen Jahreskalender angeklickt -' worden ist, müssen die Controls für den Monat Disabled -' werden, da ihre Werte in einer Jahrestabelle aufgehen. - With DlgCalModel - .txtOwnEventYear.Enabled = .chkEventOnce.State = 1 - .lblEventYear.Enabled = .chkEventOnce.State = 1 - If .txtOwnEventYear.Value = 0 And .lblEventYear.Enabled Then - .txtOwnEventYear.Value = Year(Now) - End If End With End Sub @@ -66,11 +66,14 @@ End Sub Sub SelectState(aEvent as Object) Dim ListIndex as Integer - If aEvent.ClickCount >= 1 Then - ListIndex = CalGetGermanLandAtMousePos(CInt(aEvent.X/fWidthCorrFactor), CInt(aEvent.Y/fHeightCorrFactor), Land$) - DlgCalendar.GetControl("lstHolidays").SelectItemPos(ListIndex, True) - bSelectByMouseMove = False - End If + Select Case sCurLangLocale + Case cLANGUAGE_GERMAN + If aEvent.ClickCount >= 1 Then + ListIndex = CalGetGermanLandAtMousePos(CInt(aEvent.X/fWidthCorrFactor), CInt(aEvent.Y/fHeightCorrFactor), Land$) + DlgCalendar.GetControl("lstHolidays").SelectItemPos(ListIndex, True) + bSelectByMouseMove = False + End If + End Select End Sub @@ -81,29 +84,26 @@ End Sub Sub CalClearInputMask() Dim NullList() as String -' Löscht die Werte der Eingabe Controls für ein neues Ereignis. With DlgCalModel - .chkEventOnce.State = 0 - .lblEventYear.Enabled = False - .txtOwnEventYear.Enabled = False - .txtOwnEventYear.SetPropertyToDefault("Value") .txtEvent.Text = "" .txtOwnEventDay.SetPropertyToDefault("Value") .cmdInsert.Enabled = False End With - DlgCalendar.GetControl("lstOwnEventMonth").SelectItemPos(0,True) - CurOwnMonth = 1 + If Ubound(DlgCalModel.lstOwnData.StringItemList()) > -1 Then + If Ubound(DlgCalModel.lstOwnData.SelectedItems()) = -1 Then + DlgCalendar.GetControl("lstOwnData").SelectItemPos(0,True) + CalUpdateNewEventFrame() + End If + End If End Sub Sub CalmdSwitchOwnDataOrGeneral() - 'Ändert den Titel der Dialogbox beim Seitenwechsel und die - 'Beschriftungen der Knöpfe If DlgCalModel.Step = 1 Then DlgCalModel.Step = 2 DlgCalModel.cmdOwnData.Label = cCalSubcmdSwitchOwnDataOrGeneral_Back$ DlgCalModel.cmdInsert.Enabled = DlgCalModel.txtEvent.Text <> "" - ToggleYearBox() +' ToggleYearBox() Else dim bla as boolean DlgCalModel.Step = 1 @@ -124,32 +124,24 @@ Dim bDoEnable as Boolean Dim sSelectedItem Dim ListIndex as Integer Dim MaxSelIndex as Integer -Dim iMonth as Integer +Dim CurEvMonth as Integer +Dim CurEvDay as Integer +Dim DateStr as String bDoEnable = False With DlgCalModel MaxSelIndex = Ubound(DlgCalModel.lstOwnData.SelectedItems()) If MaxSelIndex > -1 Then ListIndex = .lstOwnData.SelectedItems(MaxSelIndex) .txtEvent.Text = CalGetNameofEvent(ListIndex) - .txtOwnEventDay.Value = CalGetDayOfEvent(ListIndex) - iMonth = CalGetMonthOfEvent(ListIndex) - DlgCalendar.GetControl("lstOwnEventMonth").SelectItemPos(iMonth-1, True) - CurOwnMonth = DlgCalModel.lstOwnEventMonth.SelectedItems(0) + 1 - If CalGetYearofEvent(ListIndex) <> 0 Then - .txtOwnEventYear.Value = CalGetYearofEvent(ListIndex) - bDoEnable = True + If GetSelectedDateUnits(CurEvDay, CurEvMonth, ListIndex) <> SBDATEUNDEFINED Then + .txtOwnEventDay.Value = CurEvDay + DlgCalendar.GetControl("lstOwnEventMonth").SelectItemPos(CurEvMonth-1, True) + .cmdDelete.Enabled = True + .cmdInsert.Enabled = True Else - bDoEnable = False - DlgCalModel.txtOwnEventYear.SetPropertyToDefault("Value") + Call CalClearInputMask() + .cmdDelete.Enabled = True End If - .chkEventOnce.State = Abs(bDoEnable) - .lblEventYear.Enabled = bDoEnable - .txtOwnEventYear.Enabled = bDoEnable - .cmdDelete.Enabled = True - .cmdInsert.Enabled = True - Else - Call CalClearInputMask() - .cmdDelete.Enabled = False End If End With End Sub</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/GermanHolidays.xba b/wizards/source/schedule/GermanHolidays.xba index 60e1acaf5..7ce4357e9 100644 --- a/wizards/source/schedule/GermanHolidays.xba +++ b/wizards/source/schedule/GermanHolidays.xba @@ -6,7 +6,6 @@ Sub Main() Call CalAutopilotTable() End Sub - Function CalGetGermanLandAtMousePos(byval X as single, byval Y as single) as Integer CalChoosenLand = 0 If (X>73)And(X<130)And(Y>=117)And(Y<181) Then @@ -69,17 +68,6 @@ End Function Sub CalFindWholeYearHolidays_GERMANY(ByVal iSelYear as Integer, ByVal iCountry as Integer) - - ' Ermittelt die Feiertage eines gesamten Jahres (Parameter iSelYear), - ' bezogen auf ein bestimmtes Bundesland (Parameter iCountry). Kein - ' bestimmtes Bundesland bedeutet, dass der Parameter gleich der - ' Konstante calBLHamburg ist, da Hamburg nur Standardfeiertage kennt. - ' Die Feiertage werden in das Array CalBankHolidayName$ geschrieben. - ' Der Index dieses Arrays geht bis vierhundert. Der 1. Januar hat den - ' Indexwert 1, der 2. Januar den Indexwert 2 usw. Das bedeutet, daß - ' wenn am 2. Januar kein Feiertag existiert, liefert - ' CalBankHolidayName$(DateSerial(0, 1, 2) eine leere Zeichenkette (""). - Dim So as Integer Dim OsternDate&, VierterAdvent& @@ -130,7 +118,7 @@ Sub CalFindWholeYearHolidays_GERMANY(ByVal iSelYear as Integer, ByVal iCountry a CalInsertBankholiday(vierterAdvent-32, "Buß- und Bettag", cHolidayType_Full) Else CalInsertBankholiday(vierterAdvent-32, "Buß- und Bettag", cHolidayType_Half) - End If ' Dank an die EKD für die Berechnungsvorschrift des Buß- und Bettags! + End If CalInsertBankholiday(vierterAdvent-21, "1. Advent", cHolidayType_Full) CalInsertBankholiday(vierterAdvent-14, "2. Advent", cHolidayType_Full) CalInsertBankholiday(vierterAdvent-7, "3. Advent", cHolidayType_Full) diff --git a/wizards/source/schedule/Language.xba b/wizards/source/schedule/Language.xba index 7a874bbc8..f4fd5e2ee 100644 --- a/wizards/source/schedule/Language.xba +++ b/wizards/source/schedule/Language.xba @@ -12,6 +12,7 @@ Public Const cLANGUAGE_SPANISH = "es", cLANGUAGE_SWEDISH = "sv&qu Public BLNameList(0 To 16) as String + ' R e s o u r c e s t r i n g c o n s t a n t s ' ------------------------------------------------- ' Dialog labels start at 1000 @@ -71,8 +72,8 @@ Const dlgShortMonth = 1225 .lblEvent.Label = GetResText(1019) .lblEventDay.Label = GetResText(1021) .lblEventMonth.Label = GetResText(1022) - .lblEventYear.Label = GetResText(1023) - .chkEventOnce.Label = GetResText(1020) +' .lblEventYear.Label = GetResText(1023) +' .chkEventOnce.Label = GetResText(1020) .cmdInsert.Label = GetResText(1016) .cmdDelete.Label = GetResText(1017) ' Load long month names diff --git a/wizards/source/schedule/LocalHolidays.xba b/wizards/source/schedule/LocalHolidays.xba index 2178b6ce9..7c7d46ce6 100644 --- a/wizards/source/schedule/LocalHolidays.xba +++ b/wizards/source/schedule/LocalHolidays.xba @@ -45,6 +45,7 @@ Dim lDate& End Sub + Sub FindWholeYearHolidays_FI(ByVal YearInt as Integer) Dim OsternDate& ' New Year @@ -78,9 +79,9 @@ Dim lDate&, VierterAdvent& 'New Year CalInsertBankholiday(DateSerial(YearInt, 1, 1), "Nytårsdag", cHolidayType_Full) lDate = CalEasterTable (YearInt) - '"Fasching" + ' carnival CalInsertBankholiday(lDate-49, "Fastelavn", cHolidayType_Half) - '"Gründonnerstag" + '"Maundy Tuesday CalInsertBankholiday(lDate-3, "Skærtorsdag", cHolidayType_Full) '"Good Friday " CalInsertBankholiday(lDate-2, "Langfredag", cHolidayType_Full) @@ -148,6 +149,7 @@ Dim lDate& End Sub + Sub FindWholeYearHolidays_TRK(ByVal YearInt as Integer) Dim lDate as Long ' New Years' Day @@ -206,6 +208,8 @@ Dim lRamazanBayRamStartDate as Long Case 2008 lKurbanBayRamStartDate = DateSerial(iSelYear, 12, 7) lRamazanBayRamStartDate = DateSerial(iSelYear, 9, 29) + Case Else + Exit Sub End Select 'Feast Of the Sacrifice Eve CalInsertBankholiday(lKurbanBayRamStartDate, "Kurban Bayramı Arefesi", cHolidayType_Half) @@ -274,6 +278,7 @@ Dim lDate as Long End Sub + Sub FindWholeYearHolidays_SPAIN(ByVal YearInt as Integer) Dim lDate& CalInsertBankholiday(DateSerial(YearInt, 1, 1), "Año Nuevo", cHolidayType_Full) @@ -537,7 +542,7 @@ End Sub Sub FindWholeYearHolidays_CN(YearInt as Integer) CalculateChineseNewYear(YearInt) CalInsertBankholiday(DateSerial(YearInt, 1, 1), "元旦", cHolidayType_Full) ' New Year - CalInsertBankholiday(DateSerial(YearInt, 3, 8), "妇女节", cHolidayType_Half) ' Women's Day + CalInsertBankholiday(DateSerial(YearInt, 3, 8), "妇女节", cHolidayType_Half) ' Women's Day CalInsertBankholiday(DateSerial(YearInt, 4, 5), "清明节", cHolidayType_Half) ' Day of the deads CalInsertBankholiday(DateSerial(YearInt, 5, 1), "劳动节", cHolidayType_Full) ' International Labour Day CalInsertBankholiday(DateSerial(YearInt, 6, 1), "儿童节", cHolidayType_Half) ' Children's Day @@ -628,7 +633,6 @@ Function CalculateJapaneseSpringDay(iSelYear as Integer) End Function - Function CalculateJapaneseAutumnDay(iSelYear as Integer) If (iSelYear > 1979) And (iSelYear < 2100) Then CalculateJapaneseAutumnDay() = Int(23.8431 + 0.242194)* (iSelYear-1980) - (Int((iSelYear-1980)/4)) diff --git a/wizards/source/schedule/OwnEvents.xba b/wizards/source/schedule/OwnEvents.xba index 2f2d30748..f141c2ab0 100644 --- a/wizards/source/schedule/OwnEvents.xba +++ b/wizards/source/schedule/OwnEvents.xba @@ -2,14 +2,13 @@ <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <script:module xmlns:script="http://openoffice.org/2000/script" script:name="OwnEvents" script:language="StarBasic">Option Explicit -Dim CurOwnMonth as Integer +Public Const SBDATEUNDEFINED as Double = -98765432.1 Sub Main Call CalAutopilotTable() End Sub - Sub CalSaveOwnData() Dim FileName as String Dim FileChannel as Integer @@ -31,160 +30,141 @@ Dim LocList() as String End Sub -Function CalCreateDateFromInput() as Date -' Generiert aus den Eingabedaten der Ereignisseite -' ein Datum im Dateserial Format, -Dim newDate as Date -Dim EvDay as Integer -Dim EvYear as Integer - EvDay = DlgCalModel.txtOwnEventDay.Value - If DlgCalModel.chkEventOnce.State = 1 Then - EvYear = DlgCalModel.txtOwnEventYear.Value - newDate = DateSerial(EvYear, CurOwnMonth, EvDay) - Else - newDate = DateSerial(0, CurOwnMonth, EvDay) - End If - CalCreateDateFromInput = newDate -End Function - - - Function CalCreateDateStrOfInput() as String Dim DateStr as String -Dim EvMonth as Integer -Dim EvDay as Integer -Dim CurMonthStr as String - EvDay = DlgCalModel.txtOwnEventDay.Value - If EvDay < 10 Then - DateStr = "0" & EvDay & ". " - Else - DateStr = Cstr(EvDay) & ". " - End If - CurMonthStr = DlgCalModel.lstOwnEventMonth.StringItemList(CurOwnMonth-1) - If Len(CurMonthStr) = 2 Then - CurMonthStr = CurMonthStr & " " - End If - DateStr = DateStr & CurMonthStr - - If DlgCalModel.chkEventOnce.State = 1 And DlgCalModel.txtOwnEventYear.Value <> 0 Then - DateStr = DateStr & " " + DlgCalModel.txtOwnEventYear.Value +Dim CurOwnMonth as Integer +Dim CurOwnDay as Integer +Dim FormatDateStr as String +Dim dblDate as Double +Dim iLen as Integer +Dim iDiff as Integer +Dim i as Integer + CurOwnDay = DlgCalModel.txtOwnEventDay.Value + CurOwnMonth = DlgCalendar.GetControl("lstOwnEventMonth").getselectedItemPos() + 1 + DateStr = DateSerial(0, CurOwnMonth, CurOwnDay) + dblDate = CDbl(DateValue(DateStr)) + FormatDateStr = oNumberFormatter.convertNumberToString(lDateFormat, dblDate) + iLen = Len(FormatDateStr) + iDiff = 16 - iLen + If iDiff > 0 Then + For i = 0 To iDiff + FormatDateStr = FormatDateStr + " " + Next i Else - DateStr = DateStr + " " - End If - DateStr = DateStr + " " + Trim(DlgCalModel.txtEvent.Text) + MsgBox("Invalid DateFormat: 'FormatDateStr'", 16, sWizardTitle) + CalCreateDateStrOfInput = "" + Exit Function + End If + DateStr = FormatDateStr & Trim(DlgCalModel.txtEvent.Text) CalCreateDateStrOfInput = DateStr End Function -Function CalGetDateWithoutYear&(ByVal i as Integer) - CalGetDateWithoutYear& = DateSerial(0, CalGetMonthOfEvent(i), CalGetDayOfEvent(i)) -End Function - Sub CalcmdInsertData() +Dim MaxIndex as Integer +Dim UIDateStr as String Dim DateStr as String -Dim LastIndex as Integer -Dim bGetYear as Boolean -Dim NewDate as Date +Dim NewDate as Double Dim bInserted as Boolean -Dim bDateDoubled as Boolean -Dim EvYear as Integer Dim i as Integer -Dim CurDate as Date -Dim CurEvYear as Integer -Dim CurEvMonth as Integer -Dim CurEvDay as Integer - - bGetYear = DlgCalModel.chkEventOnce.State = 1 - LastIndex = Ubound(DlgCalModel.lstOwnData.StringItemList()) - If bGetYear Then - EvYear = DlgCalModel.txtOwnEventYear.Value - End If - - newDate = CalCreateDateFromInput() - DateStr = CalCreateDateStrOfInput() - If DateStr = "" Then Exit Sub - - ' Es ist noch garnichts vorhanden - If Ubound(DlgCalModel.lstOwnData.StringItemList()) = -1 Then - DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, 0 + 1) +Dim CurOwnDay as Integer +Dim CurOwnMonth as Integer +Dim CurOwnYear as Integer + CurOwnDay = DlgCalModel.txtOwnEventDay.Value + CurOwnMonth = DlgCalendar.GetControl("lstOwnEventMonth").getSelectedItemPos() + 1 + UIDateStr = CalCreateDateStrOfInput() + NewDate = GetDateUnits(CurOwnDay, CurOwnMonth, UIDateStr) + If UIDateStr = "" Then Exit Sub + MaxIndex = Ubound(DlgCalModel.lstOwnData.StringItemList()) + If MaxIndex = -1 Then + DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, 0 + 1) bInserted = True Else - ' gleiche jahre(auch keine Jahre sind gleiche jahre)->alt löschen neu rein + Dim CurEvMonth(MaxIndex) as Integer + Dim CurEvDay(MaxIndex) as Integer + Dim CurDate(MaxIndex) as Double + ' same Years("no years" are treated like same years) -> delete old entry and insert new one i = 0 Do - CurEvYear = CalGetYearOfEvent(i) - CurEvMonth = CalGetMonthOfEvent(i) - CurEvDay = CalGetDayOfEvent(i) - If DateSerial(CurEvYear, CurEvMonth, CurEvDay) = NewDate Then - ' Todo: Abchecken wie das ist mit 'Ereignis einmalig' oder nicht + CurDate(i) = GetSelectedDateUnits(CurEvDay(i), CurEvMonth(i), i) + If CurDate(i) = NewDate Then DlgCalendar.GetControl("lstOwnData").RemoveItems(i,1) - DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i) + DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, i) bInserted = True End If i = i + 1 - Loop Until bInserted Or i > LastIndex + Loop Until bInserted Or i > MaxIndex - ' Es existiert ein Datum mit Jahreszahl. Es wird dasselbe Datum - ' ohne Angabe der Jahreszahl angegeben. - If Not bInserted And Not bGetYear Then - i = 0 - Do - bInserted = CalGetDateWithoutYear(i) = newDate - If bInserted Then - If CalGetYearOfEvent(i) <> 0 Then - DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i+1) - End If - End If - i = i + 1 - Loop Until bInserted Or i > LastIndex - End If - - ' Das einzufügende Datum besitzt eine Jahreszahl, es gibt bereits - ' das Datum in der Liste, jedoch ohne Datum. - If Not bInserted And bGetYear Then + ' There exists already a date + If Not bInserted Then i = 0 Do - bInserted = CalGetDateWithoutYear(i) = newDate - i = i + 1 - If bInserted Then - DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i) + If (CurEvMonth(i) = CurOwnMonth) And (CurEvDay(i) = CurOwnDay) Then + bInserted = True + DlgCalendar.GetControl("lstOwnData").RemoveItems(i,1) + DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, i) End If - Loop Until bInserted Or i > LastIndex + i = i + 1 + Loop Until bInserted Or i > MaxIndex End If - ' Das Datum ist noch nicht vorhanden und wird richtig einsortiert - If Not bInserted And Not bDateDoubled Then + ' The date is not yet existing and will will be sorted in accordingly + If Not bInserted Then i = 0 Do - CurDate = CalGetDateWithoutYear(i) - bInserted = newDate < CurDate + bInserted = NewDate < CurDate(i) If bInserted Then - Exit Do + DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, i) End If i = i + 1 - Loop Until bInserted Or i > LastIndex - DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i) + Loop Until bInserted Or i > MaxIndex + If Not bInserted Then + DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, MaxIndex+1) + End If End If End If - bCalOwnDataChanged = True - Call CalClearInputMask() End Sub -Function CalGetYearOfEvent(ByVal ListIndex as Integer) as Integer -Dim YearStr as String - YearStr = DlgCalModel.lstOwnData.StringItemList(ListIndex) - CalGetYearOfEvent = Val(Mid(YearStr, 10, 4)) +Function GetSelectedDateUnits(CurEvDay as Integer, CurEvMonth as Integer, i as Integer) as Double +Dim dblDate as Double +Dim DateStr as String + dblDate = SBDATEUNDEFINED + DateStr = DlgCalModel.lstOwnData.StringItemList(i) + If DateStr <> "" Then + dblDate = GetDateUnits(CurEvDay, CurEvMonth, DateStr) + End If + GetSelectedDateUnits() = dblDate End Function -Function CalGetDayOfEvent(ByVal ListIndex as Integer) as Integer -Dim DayStr as String - DayStr = DlgCalModel.lstOwnData.StringItemList(ListIndex) - CalGetDayOfEvent = Val(Left(DayStr,2)) +Function GetDateUnits(CurEvDay as Integer, CurEvMonth as Integer, DateStr) as Double +Dim bEventOnce as String +Dim LocDateStr as String +Dim dblDate as Double +Dim lDate as Long + LocDateStr = Mid(DateStr, 1, 15) + LocDateStr = Trim(LocDateStr) + + bEventOnce = True + On Local Error Goto NODATEFORMAT + dblDate = oNumberFormatter.convertStringToNumber(lDateFormat, LocDateStr) + lDate = Clng(dblDate) + CurEvMonth = Month(lDate) + CurEvDay = Day(lDate) + GetDateUnits() = dblDate + Exit Function + GetDateUnits() =SBDATEUNDEFINED +NODATEFORMAT: + If Err <> 0 Then + MsgBox("Error: Date : ' " & LocDateStr & "' is not a valid Format", 16, sWizardTitle) + Resume GETRETURNVALUE +GETRETURNVALUE: + GetDateUnits() = SBDATEUNDEFINED + End If End Function @@ -196,35 +176,25 @@ Dim NameStr as String End Function -Function CalGetMonthOfEvent(ByVal ListIndex as Integer) as Integer -Dim MonthStr as String - MonthStr = DlgCalModel.lstOwnData.StringItemList(ListIndex) - MonthStr = Mid(MonthStr, 5, 3) - ' In chinese Short Monthnames may be only 2 characters long. - ' In this case the third character is filled up with an empty space - MonthStr = RTrim(MonthStr) - CalGetMonthOfEvent = CalGetIntOfShortMonthName(MonthStr) -End Function - - -Function GetOwnYear() - If DlgCalModel.chkEventOnce.State = 1 Then - GetOwnYear() = DlgCalModel.txtOwnEventYear.Value - Else - GetOwnYear() = Year(Now()) - End If -End Function - -Sub CheckInsertedDates() +Sub CheckInsertedDates(Optional ControlEnvironment, Optional CurOwnMonth as Integer) Dim EvYear as Long Dim EvDay as Long Dim sEvMonth as String -Dim bDoEnable as Boolean - EvYear = GetOwnYear() - bDoEnable = (EvYear <> 0) And (CurOwnMonth > 0) +Dim bDoEnable as Boolean +Dim ListboxName as String +Dim MaxValue as Integer + If Not IsMissing(ControlEnvironment) Then + CurOwnMonth = DlgCalendar.GetControl("lstOwnEventMonth").getSelectedItemPos()+1 + End If + EvYear = Year(Now()) + bDoEnable = CurOwnMonth <> 0 If bDoEnable Then - DlgCalModel.txtOwnEventDay.ValueMax = CalMaxDayInMonth(EvYear, CurOwnMonth) + MaxValue = CalMaxDayInMonth(EvYear, CurOwnMonth) + DlgCalModel.txtOwnEventDay.ValueMax = MaxValue + If DlgCalModel.txtOwnEventDay.Value > MaxValue Then + DlgCalModel.txtOwnEventDay.Value = MaxValue + End If bDoEnable = DlgCalModel.txtOwnEventDay.Value <> 0 If bDoEnable Then bDoEnable = Ubound(DlgCalModel.lstOwnEventMonth.SelectedItems()) > -1 @@ -239,8 +209,9 @@ End Sub Sub GetOwnMonth() Dim EvYear as Integer - EvYear = GetOwnYear() +Dim CurOwnMonth as Integer + EvYear = year(now()) CurOwnMonth = DlgCalModel.lstOwnEventMonth.SelectedItems(0) + 1 DlgCalModel.txtOwnEventDay.ValueMax = CalMaxDayInMonth(EvYear, CurOwnMonth) - CheckInsertedDates() + CheckInsertedDates(,CurOwnMonth) End Sub</script:module>
\ No newline at end of file |