com!online 2001 December/COMCD1201.iso/openoffice/f_0031/OwnEvents.xba

Extensible Markup Language | 2001-07-20 | 9.0 KB | 286 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

Sub Main
    Call CalAutopilotTable()
End Sub

Sub CalSaveOwnData()
    '    Sichert die Daten, die im lbOwnData Control eingegeben wurden.
    '    Die Datei heißt Date.Dat und wird ins Unterverzeichnis Konfiguration
    '    des Office3 Verzeichnis geschrieben.
Dim FileName$
Dim FileChannel%
    Dim i as Integer
    FileName$ = GetPathSettings("Config", False)+ GetPathSeparator() + "DATE.DAT"
    '    Falls die Datei neu geschrieben wird, muß sie vorher gelöscht werden
    If Dir$(FileName$) = "DATE.DAT" Then
        kill(FileName$)
    End If

    FileChannel% = FreeFile()
    Open FileName$ For OUTPUT Access WRITE LOCK WRITE As FileChannel%

    Write #FileChannel%, "=========================================================="
    Write #FileChannel%, "Don't edit this file,"
    Write #FileChannel%, "Don't edit this file!"
    Write #FileChannel%, "----------------------------------------------------------"
    Write #FileChannel%, "It is not allowed to edit this file! Don't edit this file!"
    Write #FileChannel%, "=========================================================="

    For i = 0 To Ubound(DlgCalModel.lstOwnData.StringItemList())
        Write #FileChannel%, DlgCalModel.lstOwnData.StringItemList(i)
    Next

    Close #FileChannel%
End Sub


'    Lädt die Daten der persönlichen Ereignisse und
'    schreibt diese dann in das Control lbOwnData.
Sub CalLoadOwnData()
Dim FileName$, tempStr$
Dim FileChannel%, Count%
Dim i as Integer
    FileName$ = GetPathSettings("Config", False)+ GetPathSeparator() + "DATE.DAT"

    If Dir(FileName$) = "DATE.DAT" Then
        FileChannel% = FreeFile()
        Open FileName$ For INPUT Access READ LOCK READ As FileChannel%

        '    Kommentare werden eingelesen
        For Count% = 1 To 6
            Line Input #FileChannel%, tempStr$
        Next
        i = 0
        '    Einf├╝gen nach Reihenfolge sortiert.
        While (not eof(#FileChannel%))
            Input #FileChannel%, tempStr$
            DlgCalModel.lstOwnData.AddItem(tempStr$, i)
            i = i + 1
        Wend

        Close #FileChannel%
    End If
End Sub


Function SetFocusToControl(oTextControl as Object)
    If oTextControl.Text = "" Then
        Beep
        oTextControl.DefaultButton = True
        SetFocusToControl = True
    Else
        SetFocusToControl = False
    End If
End Function


Function CalCreateDateFromInput() as Date
'    Generiert aus den Eingabedaten der Ereignisseite
'    ein Datum im Dateserial Format,
Dim newDate as Date
Dim EvMonth as Integer
Dim EvDay as Integer
Dim EvYear as Integer
    EvMonth = DlgCalModel.lstOwnEventMonth.SelectedItems(0)
    EvDay = Val(DlgCalModel.txtOwnEventDay.Text)
    If DlgCalModel.chkEventOnce.State = 1 Then
        EvYear = Val(DlgCalModel.txtOwnEventYear.Text)
        newDate = DateSerial(EvYear, EvMonth, EvDay)
    Else
        newDate = DateSerial(0, EvMonth, EvDay)
    End If
    CalCreateDateFromInput = newDate
End Function


Function CalCreateDateStrOfInput() as String
Dim DateStr as String
Dim EvMonth as Integer
Dim EvDay as Integer
    EvDay = Val(Trim(DlgCalModel.txtOwnEventDay.Text))
    If EvDay < 10 Then
        DateStr = "0" & EvDay & ". "
    Else
        DateStr = Cstr(EvDay) & ". "
    End If
    DateStr = DateStr & DlgCalendar.GetControl("lstOwnEventMonth").GetSelectedItem()

    If DlgCalModel.chkEventOnce.State = 1 And DlgCalModel.txtOwnEventYear.Text <> "" Then
        DateStr = DateStr & "  " + Trim(DlgCalModel.txtOwnEventYear.Text)
    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 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 = Val(DlgCalModel.txtOwnEventYear.Text)
        If (EvYear <= 1582) OR (EvYear >= 9957)    Then
            SetFocusToControl(txtOwnEventMonth)
            Exit Sub
        End If
    End If

    If DlgCalModel.chkEventOnce.State = 1 Then
        EvYear = Val(DlgCalModel.txtOwnEventYear.Text)
    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
                DlgCalModel.GetControl("lstOwnData").RemoveItem(DateStr, i)
                DlgCalModel.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
                        DlgCalModel.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
                    DlgCalModel.GetControl("lstOwnData").AddItem(DateStr, i)
                End If
            Loop Until bInserted Or i > LastIndex
        End If

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

    '    Flag zum Speichern der neuen Daten.
    If bInserted = True Then
        bCalOwnDataChanged = True
    End If

    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)) 'Mid(DayStr, 1, 2))
End Function


Function CalGetNameOfEvent(ByVal ListIndex as Integer) as Integer
Dim NameStr as String
    NameStr = DlgCalModel.lstOwnData.StringItemList(ListIndex)
    NameStr = Trim (Mid(NameStr, 16))
'    If Val(NameStr) = 0 Then
'        NameStr = ""
'    End If
    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)
    CalGetMonthOfEvent = CalGetIntOfShortMonthName(MonthStr)
End Function


Sub CheckInsertedDates()
Dim EvYear as Long
Dim EvMonth as Long
Dim EvDay as Long
Dim sEvMonth as String
Dim bDoEnable as Boolean
    bDoEnable = True
    If DlgCalModel.chkEventOnce.State = 1 Then
        EvYear = Val(DlgCalModel.txtOwnEventYear.Text)
            '(EvYear >= 1582) AND (EvYear <= 9957)
        bDoEnable = EvYear <> 0
    Else
        EvYear = Year(Now())
    End If
    If bDoEnable Then
        EvDay = Val(DlgCalModel.txtOwnEventDay.Text)
        bDoEnable = Ubound(DlgCalModel.lstOwnEventMonth.SelectedItems()) > -1
        If bDoEnable Then
            EvMonth = DlgCalModel.lstOwnEventMonth.SelectedItems(0)
            bDoEnable = (EvDay > 1) AND (EvDay < CalMaxDayInMonth(EvYear, EvMonth))
            If bDoEnable Then
                bDoEnable = LTrim(DlgCalModel.txtEvent.Text) <> ""
            End If
        End If
    End If
    DlgCalModel.cmdInsert.Enabled = bDoEnable
End Sub
</script:module>