Option Explicit Public Const SBDATEUNDEFINED as Double = -98765432.1 Sub Main Call CalAutopilotTable() End Sub Sub CalSaveOwnData() Dim FileName as String Dim FileChannel as Integer Dim i as Integer If bCalOwnDataChanged Then FileName = GetPathSettings("UserConfig", False) & "/" & "DATE.DAT" SaveDataToFile(FileName, DlgCalModel.lstOwnData.StringItemList()) End If End Sub Sub CalLoadOwnData() Dim FileName as String Dim LocList() as String FileName = GetPathSettings("UserConfig", False) & "/DATE.DAT" If LoadDataFromFile(FileName, LocList()) Then DlgCalModel.lstOwnData.StringItemList() = LocList() End If End Sub Function CalCreateDateStrOfInput() as String Dim DateStr as String 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 MsgBox("Invalid DateFormat: 'FormatDateStr'", 16, sWizardTitle) CalCreateDateStrOfInput = "" Exit Function End If DateStr = FormatDateStr & Trim(DlgCalModel.txtEvent.Text) CalCreateDateStrOfInput = DateStr End Function Sub CalcmdInsertData() Dim MaxIndex as Integer Dim UIDateStr as String Dim DateStr as String Dim NewDate as Double Dim bInserted as Boolean 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 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 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 CurDate(i) = GetSelectedDateUnits(CurEvDay(i), CurEvMonth(i), i) If CurDate(i) = NewDate Then DlgCalendar.GetControl("lstOwnData").RemoveItems(i,1) DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, i) bInserted = True End If i = i + 1 Loop Until bInserted Or i > MaxIndex ' There exists already a date If Not bInserted Then i = 0 Do 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 i = i + 1 Loop Until bInserted Or i > MaxIndex End If ' The date is not yet existing and will will be sorted in accordingly If Not bInserted Then i = 0 Do bInserted = NewDate < CurDate(i) If bInserted Then DlgCalendar.GetControl("lstOwnData").AddItem(UIDateStr, i) End If i = i + 1 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 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 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 Function CalGetNameOfEvent(ByVal ListIndex as Integer) as String Dim NameStr as String NameStr = DlgCalModel.lstOwnData.StringItemList(ListIndex) NameStr = Trim (Mid(NameStr, 16)) CalGetNameOfEvent = NameStr End Function 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 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 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 If bDoEnable Then bDoEnable = LTrim(DlgCalModel.txtEvent.Text) <> "" End If End If End If DlgCalModel.cmdInsert.Enabled = bDoEnable End Sub Sub GetOwnMonth() Dim EvYear as Integer Dim CurOwnMonth as Integer EvYear = year(now()) CurOwnMonth = DlgCalModel.lstOwnEventMonth.SelectedItems(0) + 1 DlgCalModel.txtOwnEventDay.ValueMax = CalMaxDayInMonth(EvYear, CurOwnMonth) CheckInsertedDates(,CurOwnMonth) End Sub