wizards/source/schedule/OwnEvents.xba


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217

<?xml version="1.0" encoding="UTF-8"?>
<!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 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(&quot;UserConfig&quot;, False) &amp; &quot;/&quot; &amp; &quot;DATE.DAT&quot;
		SaveDataToFile(FileName, DlgCalModel.lstOwnData.StringItemList())
	End If
End Sub


Sub CalLoadOwnData()
Dim FileName as String
Dim LocList() as String
	FileName = GetPathSettings(&quot;UserConfig&quot;, False) &amp; &quot;/DATE.DAT&quot;
	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(&quot;lstOwnEventMonth&quot;).getselectedItemPos() + 1
	DateStr = DateSerial(0, CurOwnMonth, CurOwnDay)
	dblDate = CDbl(DateValue(DateStr))
	FormatDateStr = oNumberFormatter.convertNumberToString(lDateFormat, dblDate)
	iLen = Len(FormatDateStr)
	iDiff = 16 - iLen
	If iDiff &gt; 0 Then
		For i = 0 To iDiff
			FormatDateStr = FormatDateStr + &quot; &quot;
		Next i
	Else
    	MsgBox(&quot;Invalid DateFormat: &apos;FormatDateStr&apos;&quot;, 16, sWizardTitle)
		CalCreateDateStrOfInput = &quot;&quot;
    	Exit Function
    End If
	DateStr = FormatDateStr  &amp; 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(&quot;lstOwnEventMonth&quot;).getSelectedItemPos() + 1
	UIDateStr = CalCreateDateStrOfInput()
	NewDate = GetDateUnits(CurOwnDay, CurOwnMonth, UIDateStr)
	If UIDateStr = &quot;&quot; Then Exit Sub
	MaxIndex = Ubound(DlgCalModel.lstOwnData.StringItemList())
	If MaxIndex = -1 Then
		DlgCalendar.GetControl(&quot;lstOwnData&quot;).AddItem(UIDateStr, 0 + 1)
		bInserted = True
	Else
		Dim CurEvMonth(MaxIndex) as Integer
		Dim CurEvDay(MaxIndex) as Integer
		Dim CurDate(MaxIndex) as Double
		&apos; same Years(&quot;no years&quot; are treated like same years) -&gt; 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(&quot;lstOwnData&quot;).RemoveItems(i,1)
				DlgCalendar.GetControl(&quot;lstOwnData&quot;).AddItem(UIDateStr, i)
				bInserted = True
			End If
			i = i + 1
		Loop Until bInserted Or i &gt; MaxIndex
		
		&apos;  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(&quot;lstOwnData&quot;).RemoveItems(i,1)
					DlgCalendar.GetControl(&quot;lstOwnData&quot;).AddItem(UIDateStr, i)
				End If
				i = i + 1
			Loop Until bInserted Or i &gt; MaxIndex
		End If
	
		&apos; The date is not yet existing and will will be sorted in accordingly
		If Not bInserted Then
			i = 0
			Do 
				bInserted = NewDate &lt; CurDate(i)
				If bInserted Then
					DlgCalendar.GetControl(&quot;lstOwnData&quot;).AddItem(UIDateStr, i)
				End If
				i = i + 1
			Loop Until bInserted Or i &gt; MaxIndex
			If Not bInserted  Then
				DlgCalendar.GetControl(&quot;lstOwnData&quot;).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 &lt;&gt; &quot;&quot; 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 &lt;&gt; 0 Then
	    MsgBox(&quot;Error: Date : &apos; &quot; &amp;  LocDateStr &amp; &quot;&apos; is not a valid Format&quot;, 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(&quot;lstOwnEventMonth&quot;).getSelectedItemPos()+1
	End If
	EvYear =  Year(Now())
	bDoEnable = CurOwnMonth &lt;&gt; 0
	If bDoEnable Then
		MaxValue = CalMaxDayInMonth(EvYear, CurOwnMonth)
		DlgCalModel.txtOwnEventDay.ValueMax = MaxValue
		If DlgCalModel.txtOwnEventDay.Value &gt; MaxValue Then
			DlgCalModel.txtOwnEventDay.Value = MaxValue
		End If
		bDoEnable = DlgCalModel.txtOwnEventDay.Value &lt;&gt; 0
		If bDoEnable Then
			bDoEnable = Ubound(DlgCalModel.lstOwnEventMonth.SelectedItems()) &gt; -1
			If bDoEnable Then
				bDoEnable = LTrim(DlgCalModel.txtEvent.Text) &lt;&gt; &quot;&quot;
			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</script:module>