Freelog 52/Freelog052.iso/Dossier/OpenOffice/f_0185/OwnEvents.xba

Extensible Markup Language | 2002-10-29 | 7KB | 217 lines

<?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>