home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
GameStar 2004 May
/
Gamestar_62_2004-05_dvd.iso
/
Programy
/
openoffice
/
f_0191
/
OwnEvents.xba
< prev
next >
Wrap
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>