diff options
| author | Behrend Cornelius <bc@openoffice.org> | 2002-10-04 13:12:23 +0000 |
|---|---|---|
| committer | Behrend Cornelius <bc@openoffice.org> | 2002-10-04 13:12:23 +0000 |
| commit | e9a0e520a894f8c3ee13ddc8e90fc1257ae97dfc (patch) | |
| tree | 0814d06ade38d4428fa20027c954e66437b3773a /wizards/source/schedule | |
| parent | 8ca058256c98c98297f6c31c94242163f77ccd26 (diff) | |
#103669# finnish, polish, turkish and greek holidays added
Diffstat (limited to 'wizards/source/schedule')
| -rw-r--r-- | wizards/source/schedule/BankHoliday.xba | 30 | ||||
| -rw-r--r-- | wizards/source/schedule/CalendarMain.xba | 40 | ||||
| -rw-r--r-- | wizards/source/schedule/DlgControl.xba | 48 | ||||
| -rw-r--r-- | wizards/source/schedule/GermanHolidays.xba | 13 | ||||
| -rw-r--r-- | wizards/source/schedule/LocalHolidays.xba | 5 | ||||
| -rw-r--r-- | wizards/source/schedule/OwnEvents.xba | 262 |
6 files changed, 218 insertions, 180 deletions
diff --git a/wizards/source/schedule/BankHoliday.xba b/wizards/source/schedule/BankHoliday.xba index cb65918f55c1..22fb465fe6be 100644 --- a/wizards/source/schedule/BankHoliday.xba +++ b/wizards/source/schedule/BankHoliday.xba @@ -28,11 +28,8 @@ Dim B%,C%,D%,E%,F%,G%,H%,I%,K%,L%,M%,N%,O%, nMonth%, nDay% End Function -' Note: the following algorithm is valid only till the Year 2100. -' 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 @@ -41,8 +38,7 @@ Dim lDate as Long RB = 2 * R2 + 4 * R3 + 6 * R4 R5 = RB mod 7 RC = R4 + R5 - lDate = DateSerial(iYear, 4,4) - CalOrthodoxEasterTable() = lDate + RC +' Todo: Add the result to March 22; End Function @@ -124,30 +120,26 @@ 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 CurEvYear 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) + If GetSelectedDateUnits(CurEvDay, CurEvMonth, CurEvYear, i) <> SBDATEUNDEFINED Then + If (CurEvYear = iSelYear) Or (CurEvYear = SBYEARUNDEFINED) Then CurEventName = CalGetNameOfEvent(i) - CalInsertBankholiday(DateSerial(CurYear, CurMonth, CurDay), CurEventName, cHolidayType_Own) + CalInsertBankholiday(DateSerial(CurEvYear, CurEvMonth, CurEvDay), CurEventName, cHolidayType_Own) End If 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) @@ -186,8 +178,8 @@ 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 + Next i End Sub </script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/CalendarMain.xba b/wizards/source/schedule/CalendarMain.xba index 12ec92bd0f27..ac3dd997abaf 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 @@ -111,6 +113,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 +132,42 @@ 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 "en" + DateFormatString = "DD/MMM" + Case "pt" + Case "ru" + Case "nl" + Case "fr" + Case "es" + Case "it" + Case "da" + Case "sv" + Case "pl" + Case "de" + DateFormatString = "TT.MMM" + Case "tr" + Case "ja" + Case "zh" +' If sCurCountryLocale = "CN" Then +' Else +' End If + Case "ar" + Case "ko" + 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) @@ -158,6 +197,7 @@ Sub CalcmdOk() ' 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() diff --git a/wizards/source/schedule/DlgControl.xba b/wizards/source/schedule/DlgControl.xba index e35eed41271b..1787fd735835 100644 --- a/wizards/source/schedule/DlgControl.xba +++ b/wizards/source/schedule/DlgControl.xba @@ -20,7 +20,7 @@ Dim MsgBoxResult as Integer MsgBoxResult = MsgBox(cCalSubcmdDeleteSelect_DeleteSelEntry$, 4+32, cCalSubcmdDeleteSelect_DeleteSelEntryTitle$) If MsgBoxResult = 6 Then 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() @@ -39,9 +39,6 @@ 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 @@ -82,7 +79,6 @@ 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 @@ -93,13 +89,10 @@ Dim NullList() as String .cmdInsert.Enabled = False End With DlgCalendar.GetControl("lstOwnEventMonth").SelectItemPos(0,True) - CurOwnMonth = 1 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$ @@ -125,32 +118,35 @@ Dim bDoEnable as Boolean Dim sSelectedItem Dim ListIndex as Integer Dim MaxSelIndex as Integer -Dim iMonth as Integer +Dim CurEvYear 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, CurEvYear, ListIndex) <> SBDATEUNDEFINED Then + .txtOwnEventDay.Value = CurEvDay + DlgCalendar.GetControl("lstOwnEventMonth").SelectItemPos(CurEvMonth-1, True) + If CurEvYear <> SBYEARUNDEFINED Then + .txtOwnEventYear.Value = CurEvYear + bDoEnable = True + Else + bDoEnable = False + DlgCalModel.txtOwnEventYear.SetPropertyToDefault("Value") + End If + .chkEventOnce.State = Abs(bDoEnable) + .lblEventYear.Enabled = bDoEnable + .txtOwnEventYear.Enabled = bDoEnable + .cmdDelete.Enabled = True + .cmdInsert.Enabled = True Else - bDoEnable = False - DlgCalModel.txtOwnEventYear.SetPropertyToDefault("Value") + Call CalClearInputMask() + .cmdDelete.Enabled = False 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 56136222d62b..7ce4357e9699 100644 --- a/wizards/source/schedule/GermanHolidays.xba +++ b/wizards/source/schedule/GermanHolidays.xba @@ -68,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& @@ -129,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/LocalHolidays.xba b/wizards/source/schedule/LocalHolidays.xba index c6cbc7cc3e6b..62d91b135fc2 100644 --- a/wizards/source/schedule/LocalHolidays.xba +++ b/wizards/source/schedule/LocalHolidays.xba @@ -168,7 +168,6 @@ Dim lDate as Long CalInsertBankholiday(DateSerial(YearInt, 10, 29), "Cumhuriyet Bayramı", cHolidayType_Full) ' Commemoration Of Ataturk-Anniversary of Ataturk's Death CalInsertBankholiday(DateSerial(YearInt, 11, 10), "Atatürk'ün Ölüm Günü", cHolidayType_Full) - CalculateturkishReligousHolidays(YearInt) End Sub @@ -182,7 +181,7 @@ Dim lRamazanBayRamStartDate as Long lRamazanBayRamStartDate = DateSerial(iSelYear, 12, 4) Case 2003 lKurbanBayRamStartDate = DateSerial(iSelYear, 2, 10) - lRamazanBayRamStartDate = DateSerial(iSelYear, 11, 24) + lRamazanBayRamStartDate = DateSerial(iSelYear, 11, 14) Case 2004 lKurbanBayRamStartDate = DateSerial(iSelYear, 1, 31) lRamazanBayRamStartDate = DateSerial(iSelYear, 11, 13) @@ -200,7 +199,7 @@ Dim lRamazanBayRamStartDate as Long lKurbanBayRamStartDate = DateSerial(iSelYear, 1, 1) ' Note: The first day has already been in 2006!!! AddFollowUpHolidays(lKurbanBayRamStartDate-1, 3, "Kurban Bayram", cHolidayType_Full) - lKurbanBayRamStartDate = DateSerial(iSelYear, 12, 19) + lKurbanBayRamStartDate = DateSerial(iSelYear, 12, 20) lRamazanBayRamStartDate = DateSerial(iSelYear, 10, 11) Case 2008 diff --git a/wizards/source/schedule/OwnEvents.xba b/wizards/source/schedule/OwnEvents.xba index 2f2d3074887d..71c9835d156c 100644 --- a/wizards/source/schedule/OwnEvents.xba +++ b/wizards/source/schedule/OwnEvents.xba @@ -2,14 +2,14 @@ <!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 SBYEARUNDEFINED as Integer = -400 +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 +31,188 @@ 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 & " " +Dim CurOwnYear as Integer +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 + CurOwnYear = DlgCalModel.txtOwnEventYear.Value + CurOwnDay = DlgCalModel.txtOwnEventDay.Value + CurOwnMonth = DlgCalendar.GetControl("lstOwnEventMonth").getselectedItemPos() + 1 + if DlgCalModel.chkEventOnce.State = 1 Then + DateStr = DateSerial(CurOwnYear, CurOwnMonth, CurOwnDay) + dblDate = CDbl(DateValue(DateStr)) + FormatDateStr = oNumberFormatter.convertNumberToString(lDateStandardFormat, dblDate) + else + DateStr = DateSerial(0, CurOwnMonth, CurOwnDay) + dblDate = CDbl(DateValue(DateStr)) + FormatDateStr = oNumberFormatter.convertNumberToString(lDateFormat, dblDate) End If - DateStr = DateStr & CurMonthStr - - If DlgCalModel.chkEventOnce.State = 1 And DlgCalModel.txtOwnEventYear.Value <> 0 Then - DateStr = DateStr & " " + DlgCalModel.txtOwnEventYear.Value + 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 - +Dim CurOwnDay as Integer +Dim CurOwnMonth as Integer +Dim CurOwnYear as Integer + CurOwnDay = DlgCalModel.txtOwnEventDay.Value + CurOwnMonth = DlgCalendar.GetControl("lstOwnEventMonth").getSelectedItemPos() + 1 bGetYear = DlgCalModel.chkEventOnce.State = 1 - LastIndex = Ubound(DlgCalModel.lstOwnData.StringItemList()) If bGetYear Then - EvYear = DlgCalModel.txtOwnEventYear.Value + CurOwnYear = DlgCalModel.txtOwnEventYear.Value + Else + CurOwnYear = SBYEARUNDEFINED 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) + UIDateStr = CalCreateDateStrOfInput() + NewDate = GetDateUnits(CurOwnDay, CurOwnMonth, CurOwnYear, 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 CurEvYear(MaxIndex) as Integer + 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 - DlgCalendar.GetControl("lstOwnData").RemoveItems(i,1) - DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i) - bInserted = True - End If + CurDate(i) = GetSelectedDateUnits(CurEvDay(i), CurEvMonth(i), CurEvYear(i), i) +' If CurEvYear(i) <> SBYEARUNDEFINED Then + If CurDate(i) = NewDate Then + DlgCalendar.GetControl("lstOwnData").RemoveItems(i,1) + DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, i) + bInserted = True + End If +' 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. + ' There exists a date with a certain year number. 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) + If CurEvYear(i) <> SBYEARUNDEFINED Then + If (CurEvMonth(i) = CurOwnMonth) And (CurEvDay(i) = CurOwnDay) Then + bInserted = True + DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, i) End If - End If + End If i = i + 1 - Loop Until bInserted Or i > LastIndex + Loop Until bInserted Or i > MaxIndex End If - ' Das einzufügende Datum besitzt eine Jahreszahl, es gibt bereits - ' das Datum in der Liste, jedoch ohne Datum. + ' the date to be inserted owns a year number. It exists already such a date in the list but without year number If Not bInserted And bGetYear Then i = 0 Do - bInserted = CalGetDateWithoutYear(i) = newDate - i = i + 1 - If bInserted Then - DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i) + If CurEvYear(i) = SBYEARUNDEFINED Then + If (CurEvMonth(i) = CurOwnMonth) And (CurEvDay(i) = CurOwnDay) Then + bInserted = true + DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, i) + End If 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, CurEvYear 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, CurEvYear, 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, CurEvYear 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 NOSTANDARDDATEFORMAT + dblDate = oNumberFormatter.convertStringToNumber(lDateStandardFormat, LocDateStr) +NOSTANDARDDATEFORMAT: + If Err <> 0 Then + bEventOnce = False + Resume GETDATEFORMAT +GETDATEFORMAT: + On Local Error Goto NODATEFORMAT + dblDate = oNumberFormatter.convertStringToNumber(lDateFormat, LocDateStr) + End If + lDate = Clng(dblDate) + CurEvMonth = Month(lDate) + CurEvDay = Day(lDate) + If bEventOnce Then + CurEvYear = Year(lDate) + Else + CurEvYear = SBYEARUNDEFINED + End If + GetDateUnits() = dblDate + Exit Function + GetDateUnits() =SBDATEUNDEFINED +NODATEFORMAT: + If Err <> 0 Then + MsgBox("Error: Datum : ' " & LocDateStr & "' is not a valid Format", 16, sWizardTitle) + Resume GETRETURNVALUE +GETRETURNVALUE: + GetDateUnits() = SBDATEUNDEFINED + End If End Function @@ -196,17 +224,6 @@ 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 @@ -216,13 +233,17 @@ Function GetOwnYear() 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 +Dim bDoEnable as Boolean +Dim ListboxName as String + If Not IsMissing(ControlEnvironment) Then + CurOwnMonth = DlgCalendar.GetControl("lstOwnEventMonth").getSelectedItemPos()+1 + End If EvYear = GetOwnYear() - bDoEnable = (EvYear <> 0) And (CurOwnMonth > 0) + bDoEnable = (EvYear <> 0) And (CurOwnMonth <> 0) If bDoEnable Then DlgCalModel.txtOwnEventDay.ValueMax = CalMaxDayInMonth(EvYear, CurOwnMonth) bDoEnable = DlgCalModel.txtOwnEventDay.Value <> 0 @@ -239,8 +260,9 @@ End Sub Sub GetOwnMonth() Dim EvYear as Integer +Dim CurOwnMonth as Integer EvYear = GetOwnYear() 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 |