home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DOS/V Power Report 2002 November
/
VPR0211A.ISO
/
OPENOFFICE
/
f_0030
/
OwnEvents.xba
< prev
next >
Wrap
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>