diff options
| author | Behrend Cornelius <bc@openoffice.org> | 2002-10-18 11:26:35 +0000 |
|---|---|---|
| committer | Behrend Cornelius <bc@openoffice.org> | 2002-10-18 11:26:35 +0000 |
| commit | cdab510ca4ee86e4e76b9088966162501980996a (patch) | |
| tree | 4dfd03cc81836a1a73560c8af2b8bc3d131ca723 /wizards/source | |
| parent | 884c9c85e673d6d078ee9875b69943d4a8d3347f (diff) | |
#103669# several changes in holiday routines
Diffstat (limited to 'wizards/source')
| -rw-r--r-- | wizards/source/schedule/BankHoliday.xba | 23 | ||||
| -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 | 67 | ||||
| -rw-r--r-- | wizards/source/schedule/GermanHolidays.xba | 14 | ||||
| -rw-r--r-- | wizards/source/schedule/Language.xba | 1 | ||||
| -rw-r--r-- | wizards/source/schedule/LocalHolidays.xba | 10 | ||||
| -rw-r--r-- | wizards/source/schedule/OwnEvents.xba | 262 |
8 files changed, 219 insertions, 300 deletions
diff --git a/wizards/source/schedule/BankHoliday.xba b/wizards/source/schedule/BankHoliday.xba index eb90fc82a449..8c89b1c80352 100644 --- a/wizards/source/schedule/BankHoliday.xba +++ b/wizards/source/schedule/BankHoliday.xba @@ -124,26 +124,30 @@ End Function Sub CalInsertOwnDataInTables(ByVal iSelYear as Integer) - ' inserts the individual data from the table into the previously unsorted list + ' Fügt die eigenen Individuellen Daten aus der Tabelle in die + ' bereits erstellte unsortierte Tabelle ein. Dim CurEventName as String -Dim CurEvYear as Integer -Dim CurEvMonth as Integer -Dim CurEvDay as Integer +Dim CurYear as Integer +Dim CurMonth as Integer +Dim CurDay as Integer Dim LastIndex as Integer Dim i as Integer -Dim DateStr as String LastIndex = Ubound(DlgCalModel.lstOwnData.StringItemList()) For i = 0 To LastIndex - If GetSelectedDateUnits(CurEvDay, CurEvMonth, CurEvYear, i) <> SBDATEUNDEFINED Then - If (CurEvYear = iSelYear) Or (CurEvYear = SBYEARUNDEFINED) Then + 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(CurEvYear, CurEvMonth, CurEvDay), CurEventName, cHolidayType_Own) + CalInsertBankholiday(DateSerial(CurYear, CurMonth, CurDay), 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) @@ -163,6 +167,7 @@ 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) @@ -180,7 +185,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 + 4 + For lDate = lStartDate + 1 To lStartDate + iCount CalInsertBankholiday(lDate, HolidayName, iType) Next lDate End Sub diff --git a/wizards/source/schedule/CalendarMain.xba b/wizards/source/schedule/CalendarMain.xba index a75310d56f00..be49f82eef51 100644 --- a/wizards/source/schedule/CalendarMain.xba +++ b/wizards/source/schedule/CalendarMain.xba @@ -61,8 +61,6 @@ Public CONST CalBLThueringen = 16 Public DlgCalendar as Object Public DlgCalModel as Object -Public lDateFormat as Long -Public lDateStandardFormat as Long @@ -87,14 +85,15 @@ Dim iThisMonth as Integer CalChoosenLand = -2 CalLoadOwnData() +' sCurLanguage = "ja" With DlgCalModel .cmdDelete.Enabled = False .lstMonth.StringItemList() = cCalShortMonthNames() Select Case sCurLangLocale - Case cLANGUAGE_JAPANESE + Case "ja" .lstOwnData.FontName = "HG Mincho Light J" .txtEvent.FontName = "HG Mincho Light J" - Case cLANGUAGE_CHINESE + Case "zh" If oDocument.CharLocale.Country = "CN" Then .lstOwnData.FontName = "HG MSung Light SC" .txtEvent.FontName = "HG MSung Light SC" @@ -112,7 +111,6 @@ 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) @@ -131,70 +129,6 @@ 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 @@ -209,18 +143,52 @@ 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, iSelYear as Integer +Dim i as Integer +Dim 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 @@ -266,33 +234,4 @@ Dim SelYear as String 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>
\ No newline at end of file +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 6d472a84bca4..10838707f298 100644 --- a/wizards/source/schedule/CreateTable.xba +++ b/wizards/source/schedule/CreateTable.xba @@ -114,7 +114,6 @@ 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 3489330cb7ed..0ba3ca42e189 100644 --- a/wizards/source/schedule/DlgControl.xba +++ b/wizards/source/schedule/DlgControl.xba @@ -8,7 +8,6 @@ Public fHeightCorrFactor as Double Public fWidthCorrFactor as Double - Sub Main() Call CalAutopilotTable() End Sub @@ -16,28 +15,14 @@ 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 to store the new data + ' Flag zum Speichern der neuen Daten. bCalOwnDataChanged = True - 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 + DlgCalModel.cmdDelete.Enabled = Ubound(DlgCalModel.lstOwnData.StringItemList()) > -1 + Call CalClearInputMask() End If End If End Sub @@ -53,6 +38,9 @@ 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 @@ -93,6 +81,7 @@ 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 @@ -103,10 +92,13 @@ 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$ @@ -132,35 +124,32 @@ Dim bDoEnable as Boolean Dim sSelectedItem Dim ListIndex as Integer Dim MaxSelIndex as Integer -Dim CurEvYear as Integer -Dim CurEvMonth as Integer -Dim CurEvDay as Integer -Dim DateStr as String +Dim iMonth as Integer bDoEnable = False With DlgCalModel MaxSelIndex = Ubound(DlgCalModel.lstOwnData.SelectedItems()) If MaxSelIndex > -1 Then ListIndex = .lstOwnData.SelectedItems(MaxSelIndex) .txtEvent.Text = CalGetNameofEvent(ListIndex) - 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 + .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 Else - Call CalClearInputMask() - .cmdDelete.Enabled = True + 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 + 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 7ce4357e9699..60e1acaf5b56 100644 --- a/wizards/source/schedule/GermanHolidays.xba +++ b/wizards/source/schedule/GermanHolidays.xba @@ -6,6 +6,7 @@ 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 @@ -68,6 +69,17 @@ 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& @@ -118,7 +130,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 + End If ' Dank an die EKD für die Berechnungsvorschrift des Buß- und Bettags! 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 e49cdab5467b..7a874bbc8425 100644 --- a/wizards/source/schedule/Language.xba +++ b/wizards/source/schedule/Language.xba @@ -12,7 +12,6 @@ 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 diff --git a/wizards/source/schedule/LocalHolidays.xba b/wizards/source/schedule/LocalHolidays.xba index 914ea67152f3..2178b6ce909a 100644 --- a/wizards/source/schedule/LocalHolidays.xba +++ b/wizards/source/schedule/LocalHolidays.xba @@ -45,7 +45,6 @@ Dim lDate& End Sub - Sub FindWholeYearHolidays_FI(ByVal YearInt as Integer) Dim OsternDate& ' New Year @@ -79,9 +78,9 @@ Dim lDate&, VierterAdvent& 'New Year CalInsertBankholiday(DateSerial(YearInt, 1, 1), "Nytårsdag", cHolidayType_Full) lDate = CalEasterTable (YearInt) - ' carnival + '"Fasching" CalInsertBankholiday(lDate-49, "Fastelavn", cHolidayType_Half) - '"Maundy Tuesday + '"Gründonnerstag" CalInsertBankholiday(lDate-3, "Skærtorsdag", cHolidayType_Full) '"Good Friday " CalInsertBankholiday(lDate-2, "Langfredag", cHolidayType_Full) @@ -149,7 +148,6 @@ Dim lDate& End Sub - Sub FindWholeYearHolidays_TRK(ByVal YearInt as Integer) Dim lDate as Long ' New Years' Day @@ -276,7 +274,6 @@ 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) @@ -540,7 +537,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 @@ -631,6 +628,7 @@ 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 e43998bc894c..2f2d3074887d 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 -Public Const SBYEARUNDEFINED as Integer = -400 -Public Const SBDATEUNDEFINED as Double = -98765432.1 +Dim CurOwnMonth as Integer Sub Main Call CalAutopilotTable() End Sub + Sub CalSaveOwnData() Dim FileName as String Dim FileChannel as Integer @@ -31,188 +31,160 @@ 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 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) +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 - iLen = Len(FormatDateStr) - iDiff = 16 - iLen - If iDiff > 0 Then - For i = 0 To iDiff - FormatDateStr = FormatDateStr + " " - Next i + DateStr = DateStr & CurMonthStr + + If DlgCalModel.chkEventOnce.State = 1 And DlgCalModel.txtOwnEventYear.Value <> 0 Then + DateStr = DateStr & " " + DlgCalModel.txtOwnEventYear.Value Else - MsgBox("Invalid DateFormat: 'FormatDateStr'", 16, sWizardTitle) - CalCreateDateStrOfInput = "" - Exit Function - End If - DateStr = FormatDateStr & Trim(DlgCalModel.txtEvent.Text) + DateStr = DateStr + " " + End If + DateStr = DateStr + " " + 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 Double +Dim NewDate as Date Dim bInserted as Boolean +Dim bDateDoubled as Boolean +Dim EvYear as Integer Dim i as Integer -Dim CurOwnDay as Integer -Dim CurOwnMonth as Integer -Dim CurOwnYear as Integer - CurOwnDay = DlgCalModel.txtOwnEventDay.Value - CurOwnMonth = DlgCalendar.GetControl("lstOwnEventMonth").getSelectedItemPos() + 1 +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 - CurOwnYear = DlgCalModel.txtOwnEventYear.Value - Else - CurOwnYear = SBYEARUNDEFINED + EvYear = DlgCalModel.txtOwnEventYear.Value End If - 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) + + 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) bInserted = True Else - 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 + ' gleiche jahre(auch keine Jahre sind gleiche jahre)->alt löschen neu rein i = 0 Do - 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 + 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 i = i + 1 - Loop Until bInserted Or i > MaxIndex + Loop Until bInserted Or i > LastIndex - ' There exists a date with a certain year number. + ' 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 - If CurEvYear(i) <> SBYEARUNDEFINED Then - If (CurEvMonth(i) = CurOwnMonth) And (CurEvDay(i) = CurOwnDay) Then - bInserted = True - DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, i) + bInserted = CalGetDateWithoutYear(i) = newDate + If bInserted Then + If CalGetYearOfEvent(i) <> 0 Then + DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i+1) End If - End If + End If i = i + 1 - Loop Until bInserted Or i > MaxIndex + Loop Until bInserted Or i > LastIndex End If - ' the date to be inserted owns a year number. It exists already such a date in the list but without year number + ' Das einzufügende Datum besitzt eine Jahreszahl, es gibt bereits + ' das Datum in der Liste, jedoch ohne Datum. If Not bInserted And bGetYear Then i = 0 Do - 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 + bInserted = CalGetDateWithoutYear(i) = newDate i = i + 1 - Loop Until bInserted Or i > MaxIndex + If bInserted Then + DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i) + End If + Loop Until bInserted Or i > LastIndex End If - ' The date is not yet existing and will will be sorted in accordingly - If Not bInserted Then + ' Das Datum ist noch nicht vorhanden und wird richtig einsortiert + If Not bInserted And Not bDateDoubled Then i = 0 Do - bInserted = NewDate < CurDate(i) + CurDate = CalGetDateWithoutYear(i) + bInserted = newDate < CurDate If bInserted Then - DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, i) + Exit Do End If i = i + 1 - Loop Until bInserted Or i > MaxIndex - If Not bInserted Then - DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, MaxIndex+1) - End If + Loop Until bInserted Or i > LastIndex + DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i) End If End If + bCalOwnDataChanged = True + Call CalClearInputMask() End Sub -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 +Function CalGetYearOfEvent(ByVal ListIndex as Integer) as Integer +Dim YearStr as String + YearStr = DlgCalModel.lstOwnData.StringItemList(ListIndex) + CalGetYearOfEvent = Val(Mid(YearStr, 10, 4)) End Function -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: Date : ' " & LocDateStr & "' is not a valid Format", 16, sWizardTitle) - Resume GETRETURNVALUE -GETRETURNVALUE: - GetDateUnits() = SBDATEUNDEFINED - End If +Function CalGetDayOfEvent(ByVal ListIndex as Integer) as Integer +Dim DayStr as String + DayStr = DlgCalModel.lstOwnData.StringItemList(ListIndex) + CalGetDayOfEvent = Val(Left(DayStr,2)) End Function @@ -224,6 +196,17 @@ 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 @@ -233,17 +216,13 @@ Function GetOwnYear() End Function -Sub CheckInsertedDates(Optional ControlEnvironment, Optional CurOwnMonth as Integer) +Sub CheckInsertedDates() Dim EvYear as Long Dim EvDay as Long Dim sEvMonth as String -Dim bDoEnable as Boolean -Dim ListboxName as String - If Not IsMissing(ControlEnvironment) Then - CurOwnMonth = DlgCalendar.GetControl("lstOwnEventMonth").getSelectedItemPos()+1 - End If +Dim bDoEnable as Boolean 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 @@ -260,9 +239,8 @@ 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(,CurOwnMonth) + CheckInsertedDates() End Sub</script:module>
\ No newline at end of file |