diff options
Diffstat (limited to 'wizards/source/schedule/OwnEvents.xba')
| -rw-r--r-- | wizards/source/schedule/OwnEvents.xba | 348 |
1 files changed, 348 insertions, 0 deletions
diff --git a/wizards/source/schedule/OwnEvents.xba b/wizards/source/schedule/OwnEvents.xba new file mode 100644 index 000000000..e05a3cd5c --- /dev/null +++ b/wizards/source/schedule/OwnEvents.xba @@ -0,0 +1,348 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<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%, Count% + 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 Count%=0 To DlgBuffer.lbOwnData.ListCount()-1 + Write #FileChannel%, DlgBuffer.lbOwnData.List(Count%) + Next + + Close #FileChannel% +End Sub + + +Sub CalLoadOwnData() + ' Lädt die Daten der persönlichen Ereignisse und + ' schreibt diese dann in das Control lbOwnData. + + Dim FileName$, tempStr$ + Dim FileChannel%, Count% + 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 + + ' Einfügen nach Reihenfolge sortiert. + While (not eof(#FileChannel%)) + Input #FileChannel%, tempStr$ + DlgBuffer.lbOwnData.AddItem(tempStr$) + Wend + + Close #FileChannel% + End If +End Sub + + +Function CalIsDataCorrect%() + ' Verifiziert die Eingaben der persönlichen Ereignisseite + ' und setzt, wenn ein Feld mit unsinnigen, oder fehlerhaften, + Dim sEvent$, sEvMonth$, sEvDay$, sEvYear$ + Dim nEvMonth% + sEvent$ = txtEvent.Text + sEvMonth$ = txtOwnEventMonth.Text + sEvDay$ = txtOwnEventDay.Text + sEvYear$ = txtOwnEventYear.Text + + CalIsDataCorrect% = True + + If "" = sEvent$ Then + CalIsDataCorrect% = SetFocusToControl(txtEvent) + Exit Function + End If + + If "" = sEvMonth$ Then + CalIsDataCorrect% = SetFocusToControl(txtOwnEventMonth) + Exit Function + End If + + If "" = sEvDay$ Then + CalIsDataCorrect% = SetFocusToControl(txtOwnEventDay) + Exit Function + End If + + nEvMonth% = Val(sEvMonth$) + + If 0 = nEvMonth% Then + nEvMonth% = CalGetIntOfShortMonthName%(sEvMonth$) + End If + + If (nEvMonth% < 1) Or (nEvMonth% > 12) Then + CalIsDataCorrect% = SetFocusToControl(txtOwnEventMonth) + Exit Function + End If + + If chkEventOnce.Value And (sEvYear$ <> "") Then + If (Val(sEvYear$) <= 1582) Or (Val(sEvYear$) >= 9957) Then + CalIsDataCorrect% = SetFocusToControl(txtOwnEventMonth) + Exit Function + End If + End If + + If (Val (sEvDay$) < 1) Or (Val (sEvDay$) > CalMaxDayInMonth%(Val(sEvYear$), nEvMonth%)) Then + CalIsDataCorrect% = SetFocusToControl(txtOwnEventDay) + Exit Function + End If +End Function + + +Function SetFocusToControl(oControl as Object) + Beep + oControl.SetFocus + SetFocusToControl = False +End Function + + +Function CalCreateDateFromInput&() + ' Generiert aus den Eingabedaten der Ereignisseite + ' ein Datum im Dateserial Format, + Dim newDate&, nMonth% + + nMonth% = Val (txtOwnEventMonth.Text) + If 0 = nMonth% Then + nMonth% = CalGetIntOfShortMonthName% (txtOwnEventMonth.Text) + End If + + newDate& = DateSerial(0, nMonth%, Val(txtOwnEventDay.Text)) + + If chkEventOnce.Value Then + newDate& = DateSerial(Val(txtOwnEventYear.Text), Month(newDate&), Day(newDate&)) + End If + CalCreateDateFromInput& = newDate& +End Function + + +Function CalCreateDateStrOfInput$() +Dim DateStr$ +Dim nMonth% + + If Not CalIsDataCorrect%() Then + CalCreateDateStrOfInput$ = "" + Exit Function + End If + + If Val(txtOwnEventDay.Text) < 10 Then + DateStr$ = " " + End If + + DateStr$ = DateStr$ + Trim(txtOwnEventDay.Text) + ". " + nMonth% = CalGetIntOfShortMonthName% (Trim(txtOwnEventMonth.Text)) + DateStr$ = DateStr$ + cCalShortMonthNames$ (nMonth%) + + If chkEventOnce.Value And txtOwnEventYear.Text <> "" Then + DateStr$ = DateStr$ + " " + Trim(txtOwnEventYear.Text) + Else + DateStr$ = DateStr$ + " " + End If + DateStr$ = DateStr$ + " " + Trim(txtEvent.Text) + CalCreateDateStrOfInput$ = DateStr$ +End Function + + +Function CalGetDateWithoutYear&(byval Pos%) + CalGetDateWithoutYear& = DateSerial(0, CalGetMonthOfEvent(Pos%), CalGetDayOfEvent(Pos%)) +End Function + + +Function CalExistDateInList%(byval newDate&) + + Dim Count%, lbActDate&, lbActEvent$, Result% + Dim nEvYear%, nEvMonth%, nEvDay% + + Result% = False + For Count%=0 To lbOwnData.ListCount()-1 + nEvYear% = CalGetYearOfEvent(Count%) + nEvMonth% = CalGetMonthOfEvent(Count%) + nEvDay% = CalGetDayOfEvent(Count%) + lbActDate& = DateSerial(nEvYear%, nEvMonth%, nEvDay%) + Result% = (lbactDate& = newDate&) + Next + CalExistDateInList% = Result% +End Function + + +Sub CalCmdInsertData() +Dim DateStr$, newDate&, Count%, Inserted%, Found% + + Inserted% = False + DateStr$ = CalCreateDateStrOfInput$() + If DateStr$ = "" Then Exit Sub + + ' Es ist noch garnichts vorhanden + If Not Inserted% And lbOwnData.ListCount()=0 Then + lbOwnData.AddItem(DateStr$) + Inserted% = True + End If + + ' Doppeltes Datum + newDate& = CalCreateDateFromInput&() + If ((False = Inserted%) And (True = CalExistDateInList (newDate))) Then + ' gleiche jahre(auch keine Jahre sind gleiche jahre)->alt löschen neu rein + Count% = 0 + While (DateSerial(CalGetYearOfEvent(Count%), CalGetMonthOfEvent(Count%), CalGetDayOfEvent(Count%))<>DateSerial(Year(newDate&), Month(newDate&), Day(newDate&))) + Count% = Count + 1 + Wend + ' beide Jahre gleich (auch: kein datum gesetzt) -> alt löschen neu rein + If ((CalGetYearOfEvent(Count%)=0 And Not chkEventOnce.Value) Or (chkEventOnce.Value And Val(txtOwnEventYear.Text)=CalGetYearOfEvent%(Count%))) Then + lbOwnData.RemoveItem(Count%) + lbOwnData.AddItem(DateStr$, Count%) + Inserted% = True + End If + End If + + ' Es existiert ein Datum mit Jahreszahl. Es wird dasselbe Datum + ' ohne Angabe der Jahreszahl angegeben. + newDate& = CalCreateDateFromInput&() + newDate& = Dateserial(0, Month(newDate&), Day(newDate&)) + If Not Inserted% And Not chkEventOnce.Value Then + Dim temp& + Count% = 0 + While (Not Found%) And (Count% < lbOwnData.ListCount()) + temp& = CalGetDateWithoutYear%(Count%) + If (temp& = newDate&) Then + Found% = True + Else + Count% = Count% + 1 + End If + Wend + If Found% Then + If (CalGetYearOfEvent%(Count%)<>0) Then + lbOwnData.AddItem(DateStr$, Count%) + Inserted% = True + End If + End If + End If + + ' Das einzufügende Datum besitzt eine Jahreszahl, es gibt bereits + ' das Datum in der Liste, jedoch ohne Datum. + newDate& = CalCreateDateFromInput&() + newDate& = Dateserial(0, Month(newDate&), Day(newDate&)) + If Not Inserted% And chkEventOnce.Value Then + Found% = False + Count% = 0 + While (Not Found%) And (Count% < lbOwnData.ListCount) + If (CalGetDateWithoutYear(Count%) = newDate&) Then + Found% = True + Else + Count% = Count% + 1 + End If + Wend + If Found% Then + Count% = Count% + 1 + lbOwnData.AddItem(DateStr$, Count%) + Inserted% = True + End If + End If + + ' Das Datum ist noch nicht vorhanden. + newDate& = CalCreateDateFromInput&() + newDate& = Dateserial(0, Month(newDate&), Day(newDate&)) + ' newDate& = Dateserial(0, Month(newDate&), Day(newDate&)) + If (Inserted%=False And CalExistDateInList(newDate)=False) Then + Found% = False + Count% = 0 + While (Count% < lbOwnData.ListCount() And Found% = False) + If (newDate& > CalGetDateWithoutYear&(Count%)) Then + Count% = Count% + 1 + Else + Found% = True + End If + Wend + lbOwnData.AddItem(DateStr$, Count%) + Inserted% = True + End If + + ' Flag zum Speichern der neuen Daten. + If Inserted% = True Then + CalOwnDataChanged% = True + End If + + ' Nachdem die Daten übernommen worden sind, werden sie aus + ' der Eingabe gelöscht + Call CalClearInputMask() +End Sub + + +Sub CalUpdateNewEventFrame() + Dim bEnable as Boolean + Dim Result%, actPos%, Count% + Dim sSelData$ + + Result% = CalCountSelected%(DlgBuffer.lbOwnData, actPos%) + If Result% = 1 Then + ' Daten unten anzeigen + sSelData$ = lbOwnData.List (actPos%) + txtEvent.Text = Trim (Mid$ (sSelData$, 16)) + txtOwnEventDay.Text = Trim (Left$ (sSelData$, 2)) + txtOwnEventMonth.Text = Str$ (Mid$ (sSelData$, 5, 3)) + + bEnable = Val (Trim (Mid$ (sSelData$, 10, 4))) > 0 + If bEnable Then + txtOwnEventYear.Text = Trim (Mid$ (sSelData$, 10, 4)) + Else + txtOwnEventYear.Text = "" + End If + chkEventOnce.Value = bEnable + lblEventYear.Enabled = bEnable + txtownEventYear.Enabled = bEnable + SpinOwnEventYear.Enabled = bEnable + Else + Call CalClearInputMask() + End If + + cmdDelete.Enabled = (1 <= Result%) +End Sub + + +Function CalGetYearOfEvent%(byval Pos%) + CalGetYearOfEvent% = Val(Mid$(lbOwnData.List(Pos%), 10, 4)) +End Function + + +Function CalGetDayOfEvent%(byval Pos%) + CalGetDayOfEvent% = Val(Mid$(lbOwnData.List(Pos%), 1, 2)) +End Function + + +Function CalGetMonthOfEvent%(byval Pos%) + ' Liefert den Monat eines Ereignisses aus dem + ' Control lbOwnData als Zahl. + Dim sMonth$ + + sMonth$ = Mid$ (lbOwnData.List(Pos%), 5, 3) + CalGetMonthOfEvent% = CalGetIntOfShortMonthName% (sMonth$) +End Function + + +</script:module>
\ No newline at end of file |