Server : Apache/2.4.43 (Win64) OpenSSL/1.1.1g PHP/7.4.6 System : Windows NT USER-PC 6.1 build 7601 (Windows 7 Professional Edition Service Pack 1) AMD64 User : User ( 0) PHP Version : 7.4.6 Disable Function : NONE Directory : C:/Program Files (x86)/OpenOffice 4/share/basic/Schedule/ |
<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <!--*********************************************************** * * Licensed to the Apache Software Foundation (ASF) under one * or more contributor license agreements. See the NOTICE file * distributed with this work for additional information * regarding copyright ownership. The ASF licenses this file * to you under the Apache License, Version 2.0 (the * "License"); you may not use this file except in compliance * with the License. You may obtain a copy of the License at * * http://www.apache.org/licenses/LICENSE-2.0 * * Unless required by applicable law or agreed to in writing, * software distributed under the License is distributed on an * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY * KIND, either express or implied. See the License for the * specific language governing permissions and limitations * under the License. * ***********************************************************--> <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>