217 lines
No EOL
6.6 KiB
XML
217 lines
No EOL
6.6 KiB
XML
<?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("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</script:module> |