PC World 2002 June/PCWorld_2002-06_cd.bin/Software/Komercni/openoffice/install/f_0030/OwnEvents.xba

Extensible Markup Language | 2002-02-19 | 8KB | 246 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

Dim CurOwnMonth as Integer

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 CalCreateDateFromInput() as Date
'    Generiert aus den Eingabedaten der Ereignisseite
'    ein Datum im Dateserial Format,
Dim newDate as Date
Dim EvDay as Integer
Dim EvYear as Integer
    EvDay = DlgCalModel.txtOwnEventDay.Value
    If DlgCalModel.chkEventOnce.State = 1 Then
        EvYear = DlgCalModel.txtOwnEventYear.Value
        newDate = DateSerial(EvYear, CurOwnMonth, EvDay)
    Else
        newDate = DateSerial(0, CurOwnMonth, EvDay)
    End If
    CalCreateDateFromInput = newDate
End Function



Function CalCreateDateStrOfInput() as String
Dim DateStr as String
Dim EvMonth as Integer
Dim EvDay as Integer
Dim CurMonthStr as String
    EvDay = DlgCalModel.txtOwnEventDay.Value
    If EvDay < 10 Then
        DateStr = "0" & EvDay & ". "
    Else
        DateStr = Cstr(EvDay) & ". "
    End If
    CurMonthStr = DlgCalModel.lstOwnEventMonth.StringItemList(CurOwnMonth-1)
    If Len(CurMonthStr) = 2 Then
        CurMonthStr = CurMonthStr & " "
    End If
    DateStr = DateStr & CurMonthStr

    If DlgCalModel.chkEventOnce.State = 1 And DlgCalModel.txtOwnEventYear.Value <> 0 Then
        DateStr = DateStr & "  " + DlgCalModel.txtOwnEventYear.Value
    Else
        DateStr = DateStr + "      "
    End If
    DateStr = DateStr  + "  " + Trim(DlgCalModel.txtEvent.Text)
    CalCreateDateStrOfInput = DateStr
End Function


Function CalGetDateWithoutYear&(ByVal i as Integer)
    CalGetDateWithoutYear& = DateSerial(0, CalGetMonthOfEvent(i), CalGetDayOfEvent(i))
End Function


Sub CalcmdInsertData()
Dim DateStr as String
Dim LastIndex as Integer
Dim bGetYear as Boolean
Dim NewDate as Date
Dim bInserted as Boolean
Dim bDateDoubled as Boolean
Dim EvYear as Integer
Dim i as Integer
Dim CurDate as Date
Dim CurEvYear as Integer
Dim CurEvMonth as Integer
Dim CurEvDay as Integer

    bGetYear = DlgCalModel.chkEventOnce.State = 1
    LastIndex = Ubound(DlgCalModel.lstOwnData.StringItemList())
    If bGetYear Then
        EvYear = DlgCalModel.txtOwnEventYear.Value
    End If

    newDate = CalCreateDateFromInput()
    DateStr = CalCreateDateStrOfInput()
    If DateStr = "" Then Exit Sub

    '    Es ist noch garnichts vorhanden
    If Ubound(DlgCalModel.lstOwnData.StringItemList()) = -1 Then
        DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, 0 + 1)
        bInserted = True
    Else
        '    gleiche jahre(auch keine Jahre sind gleiche jahre)->alt l├╢schen neu rein
        i = 0
        Do
            CurEvYear = CalGetYearOfEvent(i)
            CurEvMonth = CalGetMonthOfEvent(i)
            CurEvDay = CalGetDayOfEvent(i)
            If DateSerial(CurEvYear, CurEvMonth, CurEvDay) = NewDate Then
                ' Todo: Abchecken wie das ist mit 'Ereignis einmalig' oder nicht
                DlgCalendar.GetControl("lstOwnData").RemoveItems(i,1)
                DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i)
                bInserted = True
            End If
            i = i + 1
        Loop Until bInserted Or i > LastIndex

        '    Es existiert ein Datum mit Jahreszahl. Es wird dasselbe Datum
        '    ohne Angabe der Jahreszahl angegeben.
        If Not bInserted And Not bGetYear Then
            i = 0
            Do
                bInserted = CalGetDateWithoutYear(i) = newDate
                i = i + 1
                If bInserted Then
                    If CalGetYearOfEvent(i) <> 0 Then
                        DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i)
                    End If
                End If
            Loop Until bInserted Or i > LastIndex
        End If

        '    Das einzuf├╝gende Datum besitzt eine Jahreszahl, es gibt bereits
        '    das Datum in der Liste, jedoch ohne Datum.
        If Not bInserted And bGetYear Then
            i = 0
            Do
                bInserted = CalGetDateWithoutYear(i) = newDate
                i = i + 1
                If bInserted Then
                    DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i)
                End If
            Loop Until bInserted Or i > LastIndex
        End If

        '    Das Datum ist noch nicht vorhanden und wird richtig einsortiert
        If Not bInserted And Not bDateDoubled Then
            i = 0
            Do
                CurDate = CalGetDateWithoutYear(i)
                bInserted = newDate < CurDate
                If bInserted Then
                    Exit Do
                End If
                i = i + 1
            Loop Until bInserted Or i > LastIndex
            DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i)
        End If
    End If

    bCalOwnDataChanged = True

    Call CalClearInputMask()
End Sub


Function CalGetYearOfEvent(ByVal ListIndex as Integer) as Integer
Dim YearStr as String
    YearStr = DlgCalModel.lstOwnData.StringItemList(ListIndex)
    CalGetYearOfEvent = Val(Mid(YearStr, 10, 4))
End Function


Function CalGetDayOfEvent(ByVal ListIndex as Integer) as Integer
Dim DayStr as String
    DayStr = DlgCalModel.lstOwnData.StringItemList(ListIndex)
    CalGetDayOfEvent = Val(Left(DayStr,2))
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


Function CalGetMonthOfEvent(ByVal ListIndex as Integer) as Integer
Dim MonthStr as String
    MonthStr = DlgCalModel.lstOwnData.StringItemList(ListIndex)
    MonthStr = Mid(MonthStr, 5, 3)
    ' In chinese Short Monthnames may be only 2 characters long.
    ' In this case the third character is filled up with an empty space
    MonthStr = RTrim(MonthStr)
    CalGetMonthOfEvent = CalGetIntOfShortMonthName(MonthStr)
End Function


Function GetOwnYear()
    If DlgCalModel.chkEventOnce.State = 1 Then
        GetOwnYear() = DlgCalModel.txtOwnEventYear.Value
    Else
        GetOwnYear() = Year(Now())
    End If
End Function


Sub CheckInsertedDates()
Dim EvYear as Long
Dim EvDay as Long
Dim sEvMonth as String
Dim bDoEnable as Boolean
    EvYear = GetOwnYear()
    bDoEnable = (EvYear <> 0) And (CurOwnMonth <> -1)
    If bDoEnable Then
        DlgCalModel.txtOwnEventDay.ValueMax = CalMaxDayInMonth(EvYear, CurOwnMonth)
        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
    EvYear = GetOwnYear()
    CurOwnMonth = DlgCalModel.lstOwnEventMonth.SelectedItems(0) + 1
    DlgCalModel.txtOwnEventDay.ValueMax = CalMaxDayInMonth(EvYear, CurOwnMonth)
    CheckInsertedDates()
End Sub</script:module>