diff options
| author | Tom Verbeek <tv@openoffice.org> | 2001-04-23 09:46:42 +0000 |
|---|---|---|
| committer | Tom Verbeek <tv@openoffice.org> | 2001-04-23 09:46:42 +0000 |
| commit | 191835bec9bafbe76567363e2e5a1fdd7b232671 (patch) | |
| tree | f3b6f68a56b2ba9575fee6f77a5966af45804e47 /wizards/source/schedule | |
| parent | a2255c1e77bee1071b372efd33d3b4adfeb0907b (diff) | |
initial revision
Diffstat (limited to 'wizards/source/schedule')
| -rw-r--r-- | wizards/source/schedule/BankHoliday.xba | 156 | ||||
| -rw-r--r-- | wizards/source/schedule/CalendarMain.xba | 212 | ||||
| -rw-r--r-- | wizards/source/schedule/CreateTable.xba | 137 | ||||
| -rw-r--r-- | wizards/source/schedule/DlgCalendar.xdl | 7 | ||||
| -rw-r--r-- | wizards/source/schedule/DlgControl.xba | 369 | ||||
| -rw-r--r-- | wizards/source/schedule/Language.xba | 155 | ||||
| -rw-r--r-- | wizards/source/schedule/OwnEvents.xba | 348 |
7 files changed, 1384 insertions, 0 deletions
diff --git a/wizards/source/schedule/BankHoliday.xba b/wizards/source/schedule/BankHoliday.xba new file mode 100644 index 000000000000..efaf77180516 --- /dev/null +++ b/wizards/source/schedule/BankHoliday.xba @@ -0,0 +1,156 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="BankHoliday" script:language="StarBasic">Option Explicit + +Sub Main() + Call CalAutopilotTable() +End Sub + + +Function CalEasterTable&(byval Year%) + + Dim B,C,D,E,F,G,H,I,K,L,M,N,O, nMonth, nDay As Integer + + N = Year% mod 19 + B = int(Year% / 100) + C = Year% mod 100 + D = int(B / 4) + E = B mod 4 + F = int((B + 8) / 25) + G = int((B - F + 1) / 3) + H =(19 * N + B - D - G + 15) mod 30 + I = int(C / 4) + K = C mod 4 + L =(32 + 2 * E + 2 * I - H - K) mod 7 + M = int((N + 11 * H + 22 * L) / 451) + O = H + L - 7 * M + 114 + nDay = O mod 31 + 1 + nMonth = int(O / 31) + CalEasterTable& = DateSerial(Year%, nMonth,nDay) +End Function + + + +Sub CalInitGlobalVariablesDate() + Dim Count% + + For Count% = 1 To 374 + CalBankholidayName$(Count%) = "" + CalTypeOfBankHoliday%(Count%) = cHolidayType_None + Next +End Sub + + + +Sub CalInsertBankholiday(byval actDate&, byval Event$, ByVal nBankholidayLevel%) + Dim DayInYear% + ' Fuegt ein Ereignis in das globale EventArray ein. + ' Der Sonderfall der eintreten kann, ist der, dass das Datum + ' an dem eingefuegt werden soll, bereits ein Ereignis enthaelt. + ' Dann werden beide Ereignisse mit einem Schraegstrich verbunden. + DayInYear% =(Month(actDate&)-1)*31 +Day(actDate&) + + ' Hoehere Prioritaet des Feiertagtyps + If (0 <> CalTypeOfBankHoliday%(DayInYear%)) Then + If (nBankholidayLevel% < CalTypeOfBankHoliday%(DayInYear%)) Then + CalTypeOfBankHoliday%(DayInYear%) = nBankholidayLevel% + End If + Else + CalTypeOfBankHoliday%(DayInYear%) = nBankholidayLevel% + End If + + If (CalBankHolidayName$(DayInYear%) = "") Then + CalBankHolidayName$(DayInYear%) = Event$ + Else + CalBankHolidayName$(DayInYear%) = CalBankHolidayName$(DayInYear%) + " / " + Event$ + End If +End Sub + + + +Function CalIsLeapYear%(ByVal TheYear%) + CalIsLeapYear% = TheYear Mod 4 = 0 +End Function + + +Function CalMaxDayInMonth%(byval YearVal%, byval MonthVal%) + ' Liefert den maximalen Tag eines Monats in einem + ' bestimmten Jahr. + + Dim tmpDate& + Dim MaxDay% + + MaxDay = 28 + tmpDate& = DateSerial(YearVal%, MonthVal%, MaxDay) + + While Month(tmpDate&) = MonthVal% + MaxDay% = MaxDay% + 1 + tmpDate& = tmpDate& + 1 + Wend + Maxday% = MaxDay% - 1 + CalMaxDayInMonth% = MaxDay% +End Function + + +Function CalGetIntOfShortMonthName%(byval MonthName$) + + Dim nCount%, nMonth% + + nMonth% = Val(MonthName$) + + If (1 <= nMonth% And 12 >= nMonth%) Then + CalGetIntOfShortMonthName% = nMonth% + Exit Function + End If + + MonthName$ = UCase(Trim(Left(MonthName, 3))) + + For nCount% = 1 To 12 + If (UCase(cCalShortMonthNames$(nCount%)) = MonthName$) Then + CalGetIntOfShortMonthName% = nCount% + Exit Function + End If + Next + + ' Not Found + CalGetIntOfShortMonthName% = 0 +End Function + + +Sub CalInsertOwnDataInTables(byval YearToInsert%) + ' Fügt die eigenen Individuellen Daten aus der Tabelle in die + ' bereits erstellte unsortierte Tabelle ein. + Dim i%, actYear%, actMonth%, actDay%, theEvent$ + + For i = 0 To lbOwnData.ListCount() - 1 + actYear% = Val(Mid$(lbOwnData.List(i%), 10, 4)) + If (actYear%=YearToInsert%) Or (actYear%=0) Then + actMonth% = CalGetIntOfShortMonthname%(Mid$(lbOwnData.List(i%), 5, 3)) + actDay% = Val(Left$(lbOwnData.List(i%), 2)) + theEvent$ = Trim(Mid$(lbOwnData.List(i%), 16)) + CalInsertBankholiday(DateSerial(actYear%, actMonth%, actDay%), theEvent$, cHolidayType_Own) + End If + Next +End Sub + + +' Finds eg the first,second Monday in a month +' Note: in This Function the week starts with the Sunday +Function GetMonthDate(iWeekDay, iMonth, iCount as Integer) +Dim bFound as Boolean +Dim nCount%,lDate as Integer + ' 1st Tue in Nov : Election Day, Half + bFound = False + nCount% = 0 + lDate = DateSerial(YearInt%, iMonth, 1) + While Not bFound + If (iWeekDay = WeekDay(lDate)) Then nCount% = nCount% + 1 + If (nCount < iCount) Then + lDate = lDate + 1 + Else + bFound = True + End If + Wend + GetMonthDate = lDate +End Function +</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/CalendarMain.xba b/wizards/source/schedule/CalendarMain.xba new file mode 100644 index 000000000000..8454163718f8 --- /dev/null +++ b/wizards/source/schedule/CalendarMain.xba @@ -0,0 +1,212 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="CalendarMain" script:language="StarBasic">Option Explicit + +Const _DEBUG = 0 + +' CalenderMain +Public sCurLangLocale as String + +' Dieses Flag dient zur Abfrage ob die individuellen Daten abgespeichert werden sollen. +Public CalOwnDataChanged% + +'BankHolidayFunctions +Public CalBankholidayName$ (1 To 374) +Public CalTypeOfBankHoliday% (1 To 374) + +Public Const cHolidayType_None = 0 +Public Const cHolidayType_Full = 1 +Public Const cHolidayType_Half = 2 +Public Const cHolidayType_Own = 4 + +'Dlg_Control +Public CalTWIPSPicHeight%, CalTWIPSPicWidth%, CalStartX%, CalStartY% + +Public CalPicWidth%, CalPicHeight% + +Public cCalSubCmdDeleteSelect_DeleteSelEntry$ +Public cCalSubCmdDeleteSelect_DeleteSelEntryTitle$ +Public cCalSubcmdSwitchOwnDataOrGeneral_Back$ +Public cCalSubcmdSwitchOwnDataOrGeneral_OwnData$ + +'Language +Public cCalLongMonthNames$(12) +Public cCalShortMonthNames$(12) + +Public sBitmapFilename$ +Public sCalendarTitle$, sMonthTitle$, sWizardTitle$, sError$ +Public cCalStyleWorkday$, cCalStyleWeekend$ + +' German only +' Variablen, die zur Verwaltung der Eingabe der Bundesländer dienen +Public CalChoosenLand%, MouseClicked%, LandWhenClick% +Public LastMousePosX, LastMousePosY As Single + +Public oDocument as Object +Public oSheets as Object +Public oSheet as Object +Public DlgBuffer as Object +Public oStatusLine as Object + +' BL* bedeutet BundesLand* +Public CONST CalBLBayern = 1 +Public CONST CalBLBadenWuert = 2 +Public CONST CalBLBerlin = 3 +Public CONST CalBLBremen = 4 +Public CONST CalBLBrandenburg = 5 +Public CONST CalBLHamburg = 6 +Public CONST CalBLHessen = 7 +Public CONST CalBLMeckPomm = 8 +Public CONST CalBLNiedersachsen = 9 +Public CONST CalBLNordrheinWest = 10 +Public CONST CalBLRheinlandPfalz = 11 +Public CONST CalBLSaarland = 12 +Public CONST CalBLSachsen = 13 +Public CONST CalBLSachsenAnhalt = 14 +Public CONST CalBLSchlHolstein = 15 +Public CONST CalBLThueringen = 16 + + +Sub CalAutopilotTable() + +' On Error Goto ErrorHandler + Application.LoadLibrary("tools") + ' HauptRoutine zur Erstellung des Kalenders + Set DlgBuffer = DlgCalendar + + DlgBuffer.Load() + sCurLangLocale = StarDesktop.ISOLocale.Language + LoadLanguage(sCurLangLocale) + ' Da modulübergreifende Variablen unsicher sind, + ' wird ihre Initialisierung noch einmal explizit + ' angegeben. + CalInitGlobalVariablesDate() + CalCalcPictureData() + CalChoosenLand% = -2 + MouseClicked% = False + + ' Die Daten für die eigenen Ereignisdaten werden geladen. + CalLoadOwnData() + DlgBuffer.lbOwnData.FontName = "Courier" + DlgBuffer.cmdDelete.Enabled = False + DlgBuffer.txtMonth.Text = cCalShortMonthNames$(Month(Now())) + DlgBuffer.txtMonth.Tag = DlgBuffer.txtMonth.Text + DlgBuffer.OptYear.SetFocus() + DlgBuffer.OptYear.Value = True + CalChooseCalendar() ' month + + ' Jahr und Monat werden ermittelt + DlgBuffer.txtYear.Text = Year(Now()) + DlgBuffer.txtYear.Tag = DlgBuffer.txtYear.Text + + DlgBuffer.cmbState.ListIndex = 0 + + DlgBuffer.CurrentStep = 1 + + DlgBuffer.Show() + Exit Sub + +ErrorHandler: + MsgBox(sError$, 16, sWizardTitle$) +End Sub + + +Sub CalChooseCalendar() + DlgBuffer.lblYear.Enabled = True + DlgBuffer.txtYear.Enabled = True + DlgBuffer.spinButton1.Enabled = True + DlgBuffer.cmbState.Enabled = True + + DlgBuffer.txtMonth.Enabled = DlgBuffer.optMonth.Value + DlgBuffer.lblMonth.Enabled = DlgBuffer.optMonth.Value + DlgBuffer.spinButton3.Enabled = DlgBuffer.optMonth.Value +End Sub + + +Sub CalCmdCancel() + If CalOwnDataChanged% Then + Call CalSaveOwnData() + End If + DlgBuffer.Unload() +End Sub + + + +Sub CalCmdOk() + ' cmdOk is called when the Button 'Read' is clicked on + ' It is either given out a month or a year + Dim i, iSelYear as Integer + Dim SelYear as String + DlgBuffer.Hide() + + If cLANGUAGE_GERMAN = sCurLangLocale Then + If MouseClicked% Then + CalChoosenLand%=LandWhenClick% + Else + CalChoosenLand% = 0 + End If + End If + + oDocument = StarDesktop.ActiveFrame.Controller.Model + oSheets = oDocument.sheets + If CalOwnDataChanged% Then + Call CalSaveOwnData() + End If + + ' Unprotect all tables so they can be deleted or modified + For i = 0 To oSheets.Count - 1 + oSheets.GetbyIndex(i).unprotect("") + Next + oSheets.RemovebyName(oSheets.GetbyIndex(0).Name) + + iSelYear = Val(txtYear.Text) + Select Case sCurLangLocale + Case cLANGUAGE_GERMAN + Call CalFindWholeYearHolidays_GERMANY(iSelYear, CalChoosenLand%) + Case cLANGUAGE_ENGLISH + Call FindWholeYearHolidays_US(iSelYear) + Case cLANGUAGE_FRENCH + Call FindWholeYearHolidays_FRANCE(iSelYear) + Case cLANGUAGE_ITALIAN + Call FindWholeYearHolidays_ITA(iSelYear) + Case cLANGUAGE_SPANISH + Call FindWholeYearHolidays_SPAIN(iSelYear) + Case cLANGUAGE_PORTUGUESE + Call FindWholeYearHolidays_PORT(iSelYear) + Case cLANGUAGE_DUTCH + Call FindWholeYearHolidays_NL(iSelYear) + Case cLANGUAGE_SWEDISH + Call FindWholeYearHolidays_SWED(iSelYear) + Case cLANGUAGE_DANISH + Call FindWholeYearHolidays_DK(iSelYear) + Case cLANGUAGE_POLISH + Call FindWholeYearHolidays_PL(iSelYear) + Case cLANGUAGE_RUSSIAN + Call FindWholeYearHolidays_RU(iSelYear) + End Select + + Call CalInsertOwnDataInTables(iSelYear) + + oStatusline = oDocument.GetCurrentController.GetFrame.GetStatusIndicator + + If optYear.Value Then + oSheets.RemovebyName(oSheets.GetbyIndex(0).Name) + oSheet = oSheets.GetbyIndex(0) + oSheet.Name = sCalendarTitle$ + " " + txtYear.Text + oDocument.AddActionLock + Call CalCreateYearTable(iSelYear) + ElseIf optMonth.Value Then + oSheets.RemovebyName(oSheets.GetbyIndex(1).Name) + oSheet = oSheets.GetbyIndex(0) + oSheet.Name = sMonthTitle$ + " " + cCalLongMonthNames$(CalGetIntOfShortMonthName%(txtMonth.Text)) + oDocument.AddActionLock + Call CalCreateMonthTable(iSelYear, CalGetIntOfShortMonthName%(txtMonth.Text)) + End If + + oDocument.RemoveActionLock + ' Protect the remaining sheet + oSheet.protect("") + oStatusLine.End + DlgBuffer.Unload() +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/CreateTable.xba b/wizards/source/schedule/CreateTable.xba new file mode 100644 index 000000000000..5ef472639989 --- /dev/null +++ b/wizards/source/schedule/CreateTable.xba @@ -0,0 +1,137 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="CreateTable" script:language="StarBasic">Option Explicit + +Public Const FirstDayRow = 5 ' Row on month sheet for first day of month +Public Const DateColumn% = 3 ' Column on month sheet with days +Public Const NewYearRow = 4 ' Row on year sheet for January 1st +Public Const NewYearColumn = 2 ' Column on year sheet for January 1st + + +Sub CalCreateYearTable(ByVal YearInt%) +' Completes the overview for whole year + +' Needed by StarOffice Calc and StarOffice Schedule +Dim CalDay%, CalMonth%, Count%, nCount% + +' Only needed by StarOffice Schedule +Dim oYearCell as object +Dim iDate +Dim i, s as Integer +Dim ColPos, RowPos as Integer +Dim oNameCell, oDateCell as Object +Dim iCellValue as Long +Dim oRangeFebCell, oCellAddress, oFebcell as Object +Dim oRangeBlank as Object +Dim sBlankStyle as String + On Error Goto ErrorHandling + oStatusLine.Start(GetResText(sProgress),140) + + iDate = DateSerial(Val(DlgBuffer.txtYear.Text),1,1) + + ' Insert year + oYearCell = oSheet.GetCellRangeByName("Year") + oYearCell.Value = Val(DlgBuffer.txtYear.Text) + ' Insert holidays + CalMonth% = 1 + CalDay% = 0 + s = 10 + oStatusLine.SetValue(s) + For i = 1 To 374 + CalDay = CalDay+1 + If CalDay = 32 Then + CalDay = 1 + CalMonth = CalMonth+1 + s = s + 10 + oStatusLine.SetValue(s) + End If + ColPos = NewYearColumn+(2*CalMonth) + RowPos = NewYearRow + CalDay + FormatCalCells(ColPos,RowPos,i) + Next + If NOT CalIsLeapYear(Val(txtYear.Text)) Then + ' Delete 29th February if necessary + oRangeFebCell = oSheet.GetCellRangeByName("Feb29") + oCellAddress = oRangeFebCell.RangeAddress + oFebCell = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow) + oFebCell.String = "" + ' Change the CellStyle according to the Range "Blank" + oRangeBlank = oSheet.GetCellRangebyName("Blank") + sBlankStyle = oRangeBlank.CellStyle + oRangeFebCell.CellStyle = sBlankStyle + End If + oStatusLine.SetValue(150) + ErrorHandling: + If Err <> 0 Then + MsgBox sError$, 16, sWizardTitle$ + End If +End Sub + + + +Sub CalCreateMonthTable(ByVal YearInt%, ByVal MonthInt%) +Dim oMonthCell, oDateCell as Object +Dim iDate as Date +Dim oAddress +Dim i, s as Integer +Dim StartDay%, TargetMonth% + +' Completes the monthly calendar +On Error Goto ErrorHandling + oStatusLine.Start(GetResText(sProgess),40) + ' Set month + TargetMonth% = CalGetIntOfShortMonthName%(txtMonth.Text) + oMonthCell = oSheet.GetCellRangeByName("Month") + + iDate = DateSerial(Val(DlgBuffer.txtYear.Text),TargetMonth%,1) + oMonthCell.Value = iDate + ' Inserting holidays + StartDay% = (TargetMonth% - 1) * 31 + 1 + s = 5 + For i = StartDay% To StartDay%+30 + oStatusLine.SetValue(s) + s = s + 1 + FormatCalCells(DateColumn+1,FirstDayRow+i-StartDay,i) + Next + oDateCell = oSheet.GetCellbyPosition(DateColumn,FirstDayRow+i-StartDay - 1) + oAddress = oDateCell.RangeAddress + + Select Case TargetMonth + Case 2,4,6,9,11 + oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) + If TargetMonth = 2 Then + oAddress.StartRow = oAddress.StartRow - 1 + oAddress.EndRow = oAddress.StartRow + oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) + If Not CalIsLeapYear(Val(txtYear.Text)) Then + oAddress.StartRow = oAddress.StartRow - 1 + oAddress.EndRow = oAddress.StartRow + oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) + End If + End If + End Select + oStatusLine.SetValue(45) +ErrorHandling: + If Err <> 0 Then + MsgBox sError$, 16, sWizardTitle$ + End If +End Sub + + + +Sub FormatCalCells(ColPos,RowPos,i as Integer) +Dim oNameCell, oDateCell as Object +Dim iCellValue as Long + oDateCell = oSheet.GetCellbyPosition(ColPos-1,RowPos) + If oDateCell.Value <> 0 Then + iCellValue = oDateCell.Value + oDateCell.Value = iCellValue + If CalBankHolidayName$(i) <> "" Then + oNameCell = oSheet.GetCellbyPosition(ColPos,RowPos) + oNameCell.String = CalBankHolidayName$(i) + If CalTypeOfBankHoliday%(i) = cHolidayType_Full Then + oDateCell.CellStyle = cCalStyleWeekend$ + End If + End If + End If +End Sub</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/DlgCalendar.xdl b/wizards/source/schedule/DlgCalendar.xdl new file mode 100644 index 000000000000..b3874d002615 --- /dev/null +++ b/wizards/source/schedule/DlgCalendar.xdl @@ -0,0 +1,7 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" dlg:id="DlgCalendar" dlg:style-id="0"> + <dlg:styles> + <dlg:style dlg:style-id="0"/> + </dlg:styles> +</dlg:window>
\ No newline at end of file diff --git a/wizards/source/schedule/DlgControl.xba b/wizards/source/schedule/DlgControl.xba new file mode 100644 index 000000000000..659f8c02fd2c --- /dev/null +++ b/wizards/source/schedule/DlgControl.xba @@ -0,0 +1,369 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="DlgControl" script:language="StarBasic">Option Explicit + +Dim CalBitmap As Object + + +Sub Main() + Call CalAutopilotTable() +End Sub + + +Sub CalSaveTextValues() + txtYear.Tag = txtYear.Text + txtMonth.Tag = txtMonth.Text +End Sub + + +Sub CalRestoreOldValues() + Beep + ' Start of the Gregorian Calendar + If int(Val(txtyear.Text)) < 1583 then + txtYear.Text = "1583" + Else + ' last year where the easter Routin works + txtYear.Text = "9956" + End If + txtMonth.Text = txtMonth.Tag +End Sub + + + +Sub CalChangeYear() + Dim ValNewYear& + ValNewYear& = Val(txtYear.Text) + If ((1583 > ValNewYear&) Or (9956 < ValNewYear&)) Then + Call CalRestoreOldValues() + End If +End Sub + + + +Sub CalCalcPictureData() + Dim bFittingX%, bFittingY%, DlgWidth%, DlgHeight%, nXMove%, nYMove%, Width%, Height% + Dim x#, y# + + Width% = 152 + Height% = 189 + BitmapDir = GetBitmapDir() + + Set CalBitmap = LoadPicture(BitmapDir & GetPathSeparator() & sBitmapFilename$ '(sCurLangLocale)) + If 1 = GetGUIType() Then + DlgHeight% = CInt(DlgBuffer.Preview1.Height * GetDialogZoomFactorY(DlgBuffer.Preview1.Height)) + DlgWidth% = CInt(DlgBuffer.Preview1.Width * GetDialogZoomFactorX(DlgBuffer.Preview1.Width)) + nXMove% = TwipsPerPixelX() * 3 + nYMove% = TwipsPerPixelX() * 3 + Else + DlgHeight% = CInt((DlgBuffer.Preview1.Height - TwipsPerPixelY() * 3) * GetDialogZoomFactorY(DlgBuffer.Preview1.Height)) + DlgWidth% = CInt((DlgBuffer.Preview1.Width - TwipsPerPixelX() * 3) * GetDialogZoomFactorX(DlgBuffer.Preview1.Width)) + nXMove% = 0 + nYMove% = 0 + End If + + CalTWIPSPicWidth% = TwipsPerPixelX() * Width% + CalTWIPSPicHeight% = TwipsPerPixelY() * Height% + + ' Beste Möglichkeit: Bild in Orignalgroesse zentrieren + ' Alternative : Nach schlchechter passenden Faktor skalieren + If (Not ((CalTWIPSPicWidth% <= DlgWidth%) And (CalTWIPSPicHeight% <= DlgHeight%))) Then + x# = (CalTWIPSPicWidth% / DlgWidth%) + y# = (CalTWIPSPicHeight% / DlgHeight%) + If (x# > y#) Then + CalTWIPSPicWidth% = CInt(DlgWidth%) + CalTWIPSPicHeight% = CInt(CalTWIPSPicHeight% / x#) + Else + CalTWIPSPicHeight% = CInt(DlgHeight%) + CalTWIPSPicWidth% = CInt(CalTWIPSPicWidth% / y#) + End If + End If + + CalStartX% = CInt((DlgWidth% / 2) - (CalTWIPSPicWidth% / 2)) - nXMove% + CalStartY% = CInt((DlgHeight% / 2) - (CalTWIPSPicHeight% / 2)) - nYMove% +End Sub + + + +Sub CalPreviewPaint() + Preview1.Cls() + Preview1.DrawPicture(CalBitmap, CalStartX%, CalStartY%, CalStartX% + CalTWIPSPicWidth%, CalStartY% + CalTWIPSPicHeight%) + Preview1.DrawBox(CalStartX%, CalStartY%, CalStartX% + CalTWIPSPicWidth%, CalStartY% + CalTWIPSPicHeight%) +End Sub + + + +Sub CalcmdDeleteSelect() + + Dim Count%, CountMarked%, MsgBoxResult%, AllSelected% + + AllSelected = False + CountMarked% = 0 + For Count% = 0 To lbOwnData.ListCount-1 + If (DlgBuffer.lbOwnData.Selected(Count%) = True) Then CountMarked% = CountMarked% + 1 + Next + + If (CountMarked% > 0) Then + MsgBoxResult% = MsgBox(cCalSubCmdDeleteSelect_DeleteSelEntry$, 4+32, cCalSubCmdDeleteSelect_DeleteSelEntryTitle$) + + If MsgBoxResult% = 6 Then + If Not AllSelected% Then + Call CalDeleteAllSelected() + Else + DlgBuffer.lbOwnData.Clear() + End If + ' Flag zum Speichern der neuen Daten. + CalOwnDataChanged% = True + + cmdDelete.Enabled = False + Call CalClearInputMask() + End If + End If +End Sub + + + +Sub CalDeleteAllSelected() + + Dim Count%, LastSelPos% + + While LastSelPos% <> -1 + LastSelPos% = -1 + For Count%=0 To lbOwnData.ListCount()-1 + If DlgBuffer.lbOwnData.Selected(Count%) Then LastSelPos% = Count% + Next + If LastSelPos% <> - 1 Then + DlgBuffer.lbOwnData.RemoveItem(LastSelPos%) + End If + Wend + DlgBuffer.lbOwnData.Refresh() +End Sub + + + +Sub CalSaveOwnEventControls() + DlgBuffer.txtOwnEventDay.Tag = DlgBuffer.txtOwnEventDay.Text + DlgBuffer.txtOwnEventMonth.Tag = DlgBuffer.txtOwnEventMonth.Text + DlgBuffer.txtOwnEventYear.Tag = DlgBuffer.txtOwnEventYear.Text +End Sub + + + +Sub ModIntTextBox (txtYear As Object, ByVal nMax%, ByVal nMin%, ByVal sDefault$, IncFactor as Integer) + Dim nActVal& + nActVal& = Val(txtYear.Text) + If ((0 = nActVal&) Or (nMax% < nActVal&) Or (nMin% > nActVal&)) Then + Beep + txtYear.Text = sDefault$ + Exit Sub + End If + If IncFactor = 1 Then + If nMax% > nActVal& Then + txtYear.Text = Trim(Str(nActVal& + 1)) + Else + Beep + txtYear.Text = nMax% + End if + ElseIf IncFactor = -1 Then + If nMin% < nActVal& Then + txtYear.Text = Trim(Str(nActVal& - 1)) + Else + Beep + txtYear.Text = nMin% + End if + End If +End Sub + + +Sub CalSpinOwnEventDayUp() + Call ModIntTextBox(txtOwnEventDay, 31, 1, "1", 1) +End Sub + + +Sub CalSpinOwnEventDayDown() + Call ModIntTextBox(txtOwnEventDay, 31, 1, "1", -1) +End Sub + + +Sub CalSpinGeneralYearUp() + Call ModIntTextBox(txtYear, 9956, 1583, Trim(Str(Year(Now()))),1) +End Sub + + +Sub CalSpinGeneralYearDown() + Call ModIntTextBox(txtYear, 9956, 1583, Trim(Str(Year(Now()))), -1 ) +End Sub + + +Sub CalSpinOwnEventYearDown() + Call ModIntTextBox(txtOwnEventYear, 9956, 1583, Trim(Str(Year(Now()))), -1 ) +End Sub + + +Sub CalSpinOwnEventYearUp() + Call ModIntTextBox(txtOwnEventYear, 9956, 1583, Trim(Str(Year(Now()))) , 1) +End Sub + + +Sub CalModMonthTextBox(txtMonth As Object,IncFactor as Integer) + Dim nActVal& + nActVal& = Val(txtMonth.Text) + If (1 <= nActVal& And 12 >= nActVal) Then + txtMonth.Text = cCalShortMonthNames$(nActVal&) + End If + nActVal& = CalGetIntOfShortMonthName%(txtMonth.Text) + If 0 = nActVal& Then + Beep + txtMonth.Text = cCalShortMonthNames$(1) + ElseIf (1 < nActVal&) AND (IncFactor = -1) Then + txtMonth.Text = cCalShortMonthNames$(nActVal& + IncFactor) + ElseIf (12 > nActVal&)AND (IncFactor = 1) Then + txtMonth.Text = cCalShortMonthNames$(nActVal& + IncFactor) + End If +End Sub + + +Sub CalSpinGeneralMonthUp() + CalModMonthTextBox(txtMonth, 1) +End Sub + + +Sub CalSpinGeneralMonthDown() + CalModMonthTextBox(txtMonth,-1) +End Sub + + +Sub CalSpinOwnEventMonthDown() + Call CalModMonthTextBox(txtOwnEventMonth, -1) +End Sub + + +Sub CalSpinOwnEventMonthUp() + Call CalModMonthTextBox(txtOwnEventMonth, 1) +End Sub + + +Sub CalChkYearEnDisabled() + ' Falls der RadioButton für einen Jahreskalender angeklickt + ' worden ist, müssen die Controls für den Monat Disabled + ' werden, da ihre Werte in einer Jahrestabelle aufgehen. + lblEventYear.Enabled = Not lblEventYear.Enabled + txtownEventYear.Enabled = Not txtownEventYear.Enabled + SpinOwnEventYear.Enabled = Not SpinOwnEventYear.Enabled + If (txtOwnEventYear.Text = "") And (lblEventYear.Enabled = True) Then + txtOwnEventYear.Text = Trim$(Str$(Year(Now()))) + End If +End Sub + + +Sub CalMouseMoved(Button as integer, Shift as integer, X as single, Y as single) + + ' Nimmt Mousemoves ueber dem Bitmap entgegen, und wertet sie je nach + ' Land aus. + + Select Case sCurLangLocale + Case "de" 'cLANGUAGE_GERMAN + ' Ermittelt das Land auf dem sich der MausCursor befindet, und + ' aktualisiert die Textbox mit der Bundeslandbezeichnung, falls + ' ein Mausklick stattfandt. + Dim Land$ + If (Button = 1) Or (MouseClicked% = False)Then + cmbState.ListIndex = CalGetGermanLandAtMousePos(X, Y, Land$) + End If + End Select + + LastMousePosX = X + LastMousePosY = Y +End Sub + + +Sub CalChangeGeneralMonth() + + Dim MonthToCheck$ + Dim ValMonthToCheck% + + MonthToCheck$ = DlgBuffer.txtMonth.Text + ValMonthToCheck% = Val(MonthToCheck$) + + If (ValMonthToCheck% >= 1) And (ValMonthToCheck% <=12) Then + DlgBuffer.txtMonth.Text = cCalShortMonthNames$(ValMonthToCheck%) + Exit Sub + End If + + If CalGetIntOfShortMonthName%(Trim(Left(MonthToCheck$, 3))) = 0 Then + Beep + DlgBuffer.txtMonth.Text = DlgBuffer.txtMonth.Tag + Else + DlgBuffer.txtMonth.Text = Trim(Left(MonthToCheck, 3)) + End If + +End Sub + + + +Sub CalChkForChangeInsertAccept + ' Aktualisiert die Caption des Insert/Accept Buttons + If (DataSelectedFromList=True) And (ButtonCaptionIsInsert) Then + DlgBuffer.cmdInsert.Caption = cSubChkForChangeInsertAccept_Accpet$ + End If +End Sub + + + +Sub CalClearInputMask() + ' Löscht die Werte der Eingabe Controls für ein + ' neues Ereignis. + chkEventOnce.Value = False + lblEventYear.Enabled = False + txtownEventYear.Enabled = False + SpinOwnEventYear.Enabled = False + txtOwnEventYear.Text = "" + txtEvent.Text = "" + txtOwnEventDay.Text = "" + txtOwnEventMonth.Text = "" + + txtEvent.SetFocus() +End Sub + + + +Function CalCountSelected%(ByVal listBox as Object, PosSelect%) + ' Zählt die selekierten Einträge im Control listBox. + ' PosSelect liefert den Index des selektierten Eintrags + ' zurück. Dieser Wert ist natürlich nur zu gebrachen, + ' wenn nur ein Eintrag selektiert ist. + Dim Count%, Result% + + Result% = 0 + For Count% = 0 To listBox.ListCount-1 + If ListBox.Selected(Count%) Then + Result% = Result% + 1 + PosSelect% = Count% + End If + Next + CalCountSelected% = Result% +End Function + + + +Sub CalmdSwitchOwnDataOrGeneral() + + 'Ändert den Titel der Dialogbox beim Seitenwechsel und die + 'Beschriftungen der Knöpfe + If DlgBuffer.CurrentStep = 1 Then + DlgBuffer.CurrentStep = 2 + DlgBuffer.DlgCmdOwnData.Caption = cCalSubcmdSwitchOwnDataOrGeneral_Back$ + Else + DlgBuffer.CurrentStep = 1 + DlgBuffer.DlgCmdOwnData.Caption = cCalSubcmdSwitchOwnDataOrGeneral_OwnData$ + End If +End Sub + + +Sub LoadDialog() + DlgBuffer.load +End Sub + +Sub ShowDialog() + DlgBuffer.Show +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/Language.xba b/wizards/source/schedule/Language.xba new file mode 100644 index 000000000000..2289db2c17a0 --- /dev/null +++ b/wizards/source/schedule/Language.xba @@ -0,0 +1,155 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Language" script:language="StarBasic">Option Explicit + + +' L a n g u a g e c o n s t a n t s +' ----------------------------------- +Public Const cLANGUAGE_SYSTEM = "", cLANGUAGE_CHINESE = "zh", cLANGUAGE_DANISH = "da" +Public Const cLANGUAGE_DUTCH = "nl", cLANGUAGE_ENGLISH = "en", cLANGUAGE_FINNISH = "fi" +Public Const cLANGUAGE_FRENCH = "fr", cLANGUAGE_GERMAN = "de", cLANGUAGE_GREEK = "el" +Public Const cLANGUAGE_ITALIAN = "it", cLANGUAGE_JAPANESE = "ja", cLANGUAGE_NORWEGIAN = "no" +Public Const cLANGUAGE_POLISH = "pl", cLANGUAGE_PORTUGUESE = "pt", cLANGUAGE_RUSSIAN = "ru" +Public Const cLANGUAGE_SPANISH = "es", cLANGUAGE_SWEDISH = "sv", cLANGUAGE_TURKISH = "tr" + +Public BLNameList(1 To 16) as String + + +' R e s o u r c e s t r i n g c o n s t a n t s +' ------------------------------------------------- +' Dialog labels start at 1000 +Const dlgCalTitle = 1000 +Const dlgCalTitleBack = 1001 +Const dlgCalTitleOwnData = 1002 +Const dlgSchdlTitle = 1003 +Const dlgOK = 1004 +Const dlgCancel = 1005 +Const dlgCalFrameOption = 1006 +Const dlgCalOptionYear = 1007 +Const dlgCalOptionMonth = 1008 +Const dlgSchdlDescription = 1009 +Const dlgSchdlCountry = 1010 +Const dlgTime = 1011 +Const dlgYear = 1012 +Const dlgCalMonth = 1013 +Const dlgSpecificBankholidays = 1014 +Const dlgCalOwnData = 1015 +Const dlgCalInsert = 1016 +Const dlgCalDelete = 1017 +Const dlgCalNewEvent = 1018 +Const dlgCalEvent = 1019 +Const dlgCalEventOnce = 1020 +Const dlgCalEventDay = 1021 +Const dlgCalEventMonth = 1022 +Const dlgCalEventYear = 1023 +' Bitmap file is 1099 +Const dlgBitmapFile = 1099 +' Names of states start at 1100 +Const dlgState = 1100 +' Months start at 1200 +Const dlgMonth = 1200 +' Abreviated months start 1225 +Const dlgShortMonth = 1225 +' Messages start at 1300 +Const msgCalErrorTitle = 1300 +Const msgCalError = 1301 +Const msgCalRemoveTitle = 1302 +Const msgCalRemove = 1303 +' Styles start at 1400 +Const stlWorkday = 1400 +Const stlWeekend = 1401 +' Sheet names start at 1410 +Const nameCalYear = 1410 +Const nameCalMonth = 1411 +' Misc. schedule data starts at 1500 +Const sProgess = 1500 + + + +Sub LoadLanguage%(ByVal LangLocale) +Dim Dummy$, i, Count% + + If InitResources("Calendar-template", "cal") Then + + ' C o u n t r y s p p e c i f i c s e t t i n g s + ' --------------------------------------------------- + If LangLocale = cLANGUAGE_GERMAN Then + DlgBuffer.lblSpecBankholidays.Visible = True + DlgBuffer.cmbState.Visible = True + + ' Load all states + BLNameList(1) = "Bayern" + BLNameList(2) = "Baden-Württemberg" + BLNameList(3) = "Berlin" + BLNameList(4) = "Bremen" + BLNameList(5) = "Brandenburg" + BLNameList(6) = "Hamburg" + BLNameList(7) = "Hessen" + BLNameList(8) = "Mecklenburg-Vorpommern" + BLNameList(9) = "Niedersachsen" + BLNameList(10) = "Nordrhein-Westfalen" + BLNameList(11) = "Rheinland-Pfalz" + BLNameList(12) = "Saarland" + BLNameList(13) = "Sachsen" + BLNameList(14) = "Sachsen-Anhalt" + BLNameList(15) = "Schleswig Holstein" + BLNameList(16) = "Thüringen" + Dim FirstItem as String + + FirstItem = GetResText(dlgState) + DlgBuffer.cmbState.AddItem(FirstItem) + For i = 1 To Ubound(BLNameList()) + DlgBuffer.cmbState.AddItem(BLNameList(i)) + Next i + Else + DlgBuffer.lblSpecBankholidays.Visible = False + DlgBuffer.cmbState.Visible = False + End If + + ' L o a d r e s o u r c e s t r i n g s + ' ----------------------------------------- + ' Load dialog captions + sWizardTitle$ = GetResText(msgCalErrorTitle) + sError$ = GetResText(msgCalError) + cCalSubCmdDeleteSelect_DeleteSelEntryTitle$ = GetResText(msgCalRemoveTitle) + cCalSubCmdDeleteSelect_DeleteSelEntry$ = GetResText(msgCalRemove) + cCalSubcmdSwitchOwnDataOrGeneral_OwnData$ = GetResText(dlgCalTitleOwnData) + cCalSubcmdSwitchOwnDataOrGeneral_Back$ = GetResText(dlgCalTitleBack) + DlgBuffer.frmTime.Caption = GetResText(dlgTime) + DlgBuffer.lblYear.Caption = GetResText(dlgYear) + DlgBuffer.DlgCmdCancel.Caption = GetResText(dlgCancel) + DlgBuffer.DlgCmdOk.Caption = GetResText(dlgOK) + DlgBuffer.lblSpecBankholidays.Caption = GetResText(dlgSpecificBankholidays) + + ' Load bitmap file + sBitmapFilename$ = GetResText(dlgBitmapFile) + + ' Load calendar specific strings + DlgBuffer.Caption = GetResText(dlgCalTitle) + DlgBuffer.frmCalender.Caption = GetResText(dlgCalFrameOption) + DlgBuffer.optYear.Caption = GetResText(dlgCalOptionYear) + DlgBuffer.optMonth.Caption = GetResText(dlgCalOptionMonth) + DlgBuffer.lblMonth.Caption = GetResText(dlgCalMonth) + DlgBuffer.DlgCmdOwnData.Caption = GetResText(dlgCalOwnData) + DlgBuffer.frmNewEvent.Caption = GetResText(dlgCalNewEvent) + DlgBuffer.lblEvent.Caption = GetResText(dlgCalEvent) + DlgBuffer.lblEventDay.Caption = GetResText(dlgCalEventDay) + DlgBuffer.lblEventMonth.Caption = GetResText(dlgCalEventMonth) + DlgBuffer.lblEventYear.Caption = GetResText(dlgCalEventYear) + DlgBuffer.chkEventOnce.Caption = GetResText(dlgCalEventOnce) + DlgBuffer.cmdInsert.Caption = GetResText(dlgCalInsert) + DlgBuffer.cmdDelete.Caption = GetResText(dlgCalDelete) + ' Load long month names + For Count% = 0 To 11 + cCalLongMonthNames$(Count%+1) = GetResText(dlgMonth+Count%) + cCalShortMonthNames$(Count%+1)= Left$(cCalLongMonthNames$(Count%+1), 3) + Next + ' Load sheet names + sCalendarTitle$ = GetResText(nameCalYear) + sMonthTitle$ = GetResText(nameCalMonth) + ' Load names of styles + cCalStyleWorkday$ = GetResText(stlWorkday) + cCalStyleWeekend$ = GetResText(stlWeekend) + End If +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/OwnEvents.xba b/wizards/source/schedule/OwnEvents.xba new file mode 100644 index 000000000000..e05a3cd5cd6d --- /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 |