wizards/source/schedule/OwnEvents.xba

   1 <?xml version="1.0" encoding="UTF-8"?>
   2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
   3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="OwnEvents" script:language="StarBasic">Option Explicit
   4
   5 Public Const SBDATEUNDEFINED as Double = -98765432.1
   6
   7 Sub Main
   8         Call CalAutopilotTable()
   9 End Sub
  10
  11
  12 Sub CalSaveOwnData()
  13 Dim FileName as String
  14 Dim FileChannel as Integer
  15 Dim i as Integer
  16         If bCalOwnDataChanged Then
  17                 FileName = GetPathSettings(&quot;UserConfig&quot;, False) &amp; &quot;/&quot; &amp; &quot;DATE.DAT&quot;
  18                 SaveDataToFile(FileName, DlgCalModel.lstOwnData.StringItemList())
  19         End If
  20 End Sub
  21
  22
  23 Sub CalLoadOwnData()
  24 Dim FileName as String
  25 Dim LocList() as String
  26         FileName = GetPathSettings(&quot;UserConfig&quot;, False) &amp; &quot;/DATE.DAT&quot;
  27         If LoadDataFromFile(FileName, LocList()) Then
  28                 DlgCalModel.lstOwnData.StringItemList() = LocList()
  29         End If
  30 End Sub
  31
  32
  33 Function CalCreateDateStrOfInput() as String
  34 Dim DateStr as String
  35 Dim CurOwnMonth as Integer
  36 Dim CurOwnDay as Integer
  37 Dim FormatDateStr as String
  38 Dim dblDate as Double
  39 Dim iLen as Integer
  40 Dim iDiff as Integer
  41 Dim i as Integer
  42         CurOwnDay = DlgCalModel.txtOwnEventDay.Value
  43         CurOwnMonth = DlgCalendar.GetControl(&quot;lstOwnEventMonth&quot;).getselectedItemPos() + 1
  44         DateStr = DateSerial(0, CurOwnMonth, CurOwnDay)
  45         dblDate = CDbl(DateValue(DateStr))
  46         FormatDateStr = oNumberFormatter.convertNumberToString(lDateFormat, dblDate)
  47         iLen = Len(FormatDateStr)
  48         iDiff = 16 - iLen
  49         If iDiff &gt; 0 Then
  50                 For i = 0 To iDiff
  51                         FormatDateStr = FormatDateStr + &quot; &quot;
  52                 Next i
  53         Else
  54         MsgBox(&quot;Invalid DateFormat: &apos;FormatDateStr&apos;&quot;, 16, sWizardTitle)
  55                 CalCreateDateStrOfInput = &quot;&quot;
  56         Exit Function
  57     End If
  58         DateStr = FormatDateStr  &amp; Trim(DlgCalModel.txtEvent.Text)
  59         CalCreateDateStrOfInput = DateStr
  60 End Function
  61
  62
  63
  64 Sub CalcmdInsertData()
  65 Dim MaxIndex as Integer
  66 Dim UIDateStr as String
  67 Dim DateStr as String
  68 Dim NewDate as Double
  69 Dim bInserted as Boolean
  70 Dim i as Integer
  71 Dim CurOwnDay as Integer
  72 Dim CurOwnMonth as Integer
  73 Dim CurOwnYear as Integer
  74         CurOwnDay = DlgCalModel.txtOwnEventDay.Value
  75         CurOwnMonth = DlgCalendar.GetControl(&quot;lstOwnEventMonth&quot;).getSelectedItemPos() + 1
  76         UIDateStr = CalCreateDateStrOfInput()
  77         NewDate = GetDateUnits(CurOwnDay, CurOwnMonth, UIDateStr)
  78         If UIDateStr = &quot;&quot; Then Exit Sub
  79         MaxIndex = Ubound(DlgCalModel.lstOwnData.StringItemList())
  80         If MaxIndex = -1 Then
  81                 DlgCalendar.GetControl(&quot;lstOwnData&quot;).AddItem(UIDateStr, 0 + 1)
  82                 bInserted = True
  83         Else
  84                 Dim CurEvMonth(MaxIndex) as Integer
  85                 Dim CurEvDay(MaxIndex) as Integer
  86                 Dim CurDate(MaxIndex) as Double
  87                 &apos; same Years(&quot;no years&quot; are treated like same years) -&gt; delete old entry and insert new one
  88                 i = 0
  89                 Do
  90                         CurDate(i) = GetSelectedDateUnits(CurEvDay(i), CurEvMonth(i), i)
  91                         If CurDate(i) = NewDate Then
  92                                 DlgCalendar.GetControl(&quot;lstOwnData&quot;).RemoveItems(i,1)
  93                                 DlgCalendar.GetControl(&quot;lstOwnData&quot;).AddItem(UIDateStr, i)
  94                                 bInserted = True
  95                         End If
  96                         i = i + 1
  97                 Loop Until bInserted Or i &gt; MaxIndex
  98
  99                 &apos;  There exists already a date
 100                 If Not bInserted Then
 101                         i = 0
 102                         Do
 103                                 If (CurEvMonth(i) = CurOwnMonth) And (CurEvDay(i) = CurOwnDay) Then
 104                                         bInserted = True
 105                                         DlgCalendar.GetControl(&quot;lstOwnData&quot;).RemoveItems(i,1)
 106                                         DlgCalendar.GetControl(&quot;lstOwnData&quot;).AddItem(UIDateStr, i)
 107                                 End If
 108                                 i = i + 1
 109                         Loop Until bInserted Or i &gt; MaxIndex
 110                 End If
 111
 112                 &apos; The date is not yet existing and will will be sorted in accordingly
 113                 If Not bInserted Then
 114                         i = 0
 115                         Do
 116                                 bInserted = NewDate &lt; CurDate(i)
 117                                 If bInserted Then
 118                                         DlgCalendar.GetControl(&quot;lstOwnData&quot;).AddItem(UIDateStr, i)
 119                                 End If
 120                                 i = i + 1
 121                         Loop Until bInserted Or i &gt; MaxIndex
 122                         If Not bInserted  Then
 123                                 DlgCalendar.GetControl(&quot;lstOwnData&quot;).AddItem(UIDateStr, MaxIndex+1)
 124                         End If
 125                 End If
 126         End If
 127         bCalOwnDataChanged = True
 128         Call CalClearInputMask()
 129 End Sub
 130
 131
 132 Function GetSelectedDateUnits(CurEvDay as Integer, CurEvMonth as Integer, i as Integer) as Double
 133 Dim dblDate as Double
 134 Dim DateStr as String
 135         dblDate = SBDATEUNDEFINED
 136         DateStr = DlgCalModel.lstOwnData.StringItemList(i)
 137         If DateStr &lt;&gt; &quot;&quot; Then
 138                 dblDate = GetDateUnits(CurEvDay, CurEvMonth, DateStr)
 139         End If
 140         GetSelectedDateUnits() = dblDate
 141 End Function
 142
 143
 144 Function GetDateUnits(CurEvDay as Integer, CurEvMonth as Integer, DateStr) as Double
 145 Dim bEventOnce as String
 146 Dim LocDateStr as String
 147 Dim dblDate as Double
 148 Dim lDate as Long
 149         LocDateStr = Mid(DateStr, 1, 15)
 150         LocDateStr = Trim(LocDateStr)
 151
 152         bEventOnce = True
 153         On Local Error Goto NODATEFORMAT
 154         dblDate = oNumberFormatter.convertStringToNumber(lDateFormat, LocDateStr)
 155         lDate = Clng(dblDate)
 156         CurEvMonth = Month(lDate)
 157         CurEvDay = Day(lDate)
 158         GetDateUnits() = dblDate
 159         Exit Function
 160         GetDateUnits() =SBDATEUNDEFINED
 161 NODATEFORMAT:
 162         If Err &lt;&gt; 0 Then
 163             MsgBox(&quot;Error: Date : &apos; &quot; &amp;  LocDateStr &amp; &quot;&apos; is not a valid Format&quot;, 16, sWizardTitle)
 164                 Resume GETRETURNVALUE
 165 GETRETURNVALUE:
 166                 GetDateUnits() = SBDATEUNDEFINED
 167         End If
 168 End Function
 169
 170
 171 Function CalGetNameOfEvent(ByVal ListIndex as Integer) as String
 172 Dim NameStr as String
 173         NameStr = DlgCalModel.lstOwnData.StringItemList(ListIndex)
 174         NameStr = Trim (Mid(NameStr, 16))
 175         CalGetNameOfEvent = NameStr
 176 End Function
 177
 178
 179
 180 Sub CheckInsertedDates(Optional ControlEnvironment, Optional CurOwnMonth as Integer)
 181 Dim EvYear as Long
 182 Dim EvDay as Long
 183 Dim sEvMonth as String
 184 Dim bDoEnable as Boolean
 185 Dim ListboxName as String
 186 Dim MaxValue as Integer
 187         If Not IsMissing(ControlEnvironment) Then
 188                 CurOwnMonth = DlgCalendar.GetControl(&quot;lstOwnEventMonth&quot;).getSelectedItemPos()+1
 189         End If
 190         EvYear =  Year(Now())
 191         bDoEnable = CurOwnMonth &lt;&gt; 0
 192         If bDoEnable Then
 193                 MaxValue = CalMaxDayInMonth(EvYear, CurOwnMonth)
 194                 DlgCalModel.txtOwnEventDay.ValueMax = MaxValue
 195                 If DlgCalModel.txtOwnEventDay.Value &gt; MaxValue Then
 196                         DlgCalModel.txtOwnEventDay.Value = MaxValue
 197                 End If
 198                 bDoEnable = DlgCalModel.txtOwnEventDay.Value &lt;&gt; 0
 199                 If bDoEnable Then
 200                         bDoEnable = Ubound(DlgCalModel.lstOwnEventMonth.SelectedItems()) &gt; -1
 201                         If bDoEnable Then
 202                                 bDoEnable = LTrim(DlgCalModel.txtEvent.Text) &lt;&gt; &quot;&quot;
 203                         End If
 204                 End If
 205         End If
 206         DlgCalModel.cmdInsert.Enabled = bDoEnable
 207 End Sub
 208
 209
 210 Sub GetOwnMonth()
 211 Dim EvYear as Integer
 212 Dim CurOwnMonth as Integer
 213         EvYear = year(now())
 214         CurOwnMonth = DlgCalModel.lstOwnEventMonth.SelectedItems(0) + 1
 215         DlgCalModel.txtOwnEventDay.ValueMax = CalMaxDayInMonth(EvYear, CurOwnMonth)
 216         CheckInsertedDates(,CurOwnMonth)
 217 End Sub</script:module>