diff options
Diffstat (limited to 'wizards')
| -rw-r--r-- | wizards/source/schedule/BankHoliday.xba | 58 | ||||
| -rw-r--r-- | wizards/source/schedule/CalendarMain.xba | 116 | ||||
| -rw-r--r-- | wizards/source/schedule/CreateTable.xba | 8 | ||||
| -rw-r--r-- | wizards/source/schedule/DlgControl.xba | 358 | ||||
| -rw-r--r-- | wizards/source/schedule/Language.xba | 169 | ||||
| -rw-r--r-- | wizards/source/schedule/OwnEvents.xba | 434 |
6 files changed, 461 insertions, 682 deletions
diff --git a/wizards/source/schedule/BankHoliday.xba b/wizards/source/schedule/BankHoliday.xba index efaf77180516..70417ee507fd 100644 --- a/wizards/source/schedule/BankHoliday.xba +++ b/wizards/source/schedule/BankHoliday.xba @@ -1,5 +1,5 @@ <?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="BankHoliday" script:language="StarBasic">Option Explicit Sub Main() @@ -32,11 +32,11 @@ End Function Sub CalInitGlobalVariablesDate() - Dim Count% +Dim i as Integer - For Count% = 1 To 374 - CalBankholidayName$(Count%) = "" - CalTypeOfBankHoliday%(Count%) = cHolidayType_None + For i = 1 To 374 + CalBankholidayName$(i) = "" + CalTypeOfBankHoliday%(i) = cHolidayType_None Next End Sub @@ -93,21 +93,21 @@ End Function Function CalGetIntOfShortMonthName%(byval MonthName$) - - Dim nCount%, nMonth% +Dim i as Integer +Dim nMonth as Integer - nMonth% = Val(MonthName$) + nMonth = Val(MonthName$) - If (1 <= nMonth% And 12 >= nMonth%) Then - CalGetIntOfShortMonthName% = nMonth% + 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% + For i = 1 To 12 + If (UCase(cCalShortMonthNames$(i)) = MonthName$) Then + CalGetIntOfShortMonthName% = i Exit Function End If Next @@ -120,15 +120,20 @@ 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) +Dim CurEventName as String +Dim CurYear as Integer +Dim CurMonth as Integer +Dim CurDay as Integer +Dim LastIndex as Integer +Dim i as Integer + LastIndex = Ubound(DlgCalModel.lstOwnData.StringItemList()) + For i = 0 To LastIndex + CurYear = CalGetYearOfEvent(i) + If (CurYear = YearToInsert) Or (CurYear = 0) Then + CurMonth = CalGetMonthofEvent(i) + CurDay = CalGetDayofEvent(i) + CurEventName = CalGetNameOfEvent(i) + CalInsertBankholiday(DateSerial(CurYear, CurMonth, CurDay), CurEventName, cHolidayType_Own) End If Next End Sub @@ -138,14 +143,15 @@ End Sub ' 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 +Dim i as Integer +Dim lDate as Integer ' 1st Tue in Nov : Election Day, Half bFound = False - nCount% = 0 + i = 0 lDate = DateSerial(YearInt%, iMonth, 1) While Not bFound - If (iWeekDay = WeekDay(lDate)) Then nCount% = nCount% + 1 - If (nCount < iCount) Then + If (iWeekDay = WeekDay(lDate)) Then i = i + 1 + If (i < iCount) Then lDate = lDate + 1 Else bFound = True diff --git a/wizards/source/schedule/CalendarMain.xba b/wizards/source/schedule/CalendarMain.xba index fa0ab32b65e8..1e03bd877fe8 100644 --- a/wizards/source/schedule/CalendarMain.xba +++ b/wizards/source/schedule/CalendarMain.xba @@ -1,5 +1,5 @@ <?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="CalendarMain" script:language="StarBasic">Option Explicit Const _DEBUG = 0 @@ -8,7 +8,7 @@ Const _DEBUG = 0 Public sCurLangLocale as String ' Dieses Flag dient zur Abfrage ob die individuellen Daten abgespeichert werden sollen. -Public CalOwnDataChanged% +Public bCalOwnDataChanged as Boolean 'BankHolidayFunctions Public CalBankholidayName$ (1 To 374) @@ -24,8 +24,8 @@ Public CalTWIPSPicHeight%, CalTWIPSPicWidth%, CalStartX%, CalStartY% Public CalPicWidth%, CalPicHeight% -Public cCalSubCmdDeleteSelect_DeleteSelEntry$ -Public cCalSubCmdDeleteSelect_DeleteSelEntryTitle$ +Public cCalSubcmdDeleteSelect_DeleteSelEntry$ +Public cCalSubcmdDeleteSelect_DeleteSelEntryTitle$ Public cCalSubcmdSwitchOwnDataOrGeneral_Back$ Public cCalSubcmdSwitchOwnDataOrGeneral_OwnData$ @@ -45,7 +45,6 @@ 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* @@ -66,44 +65,49 @@ Public CONST CalBLSachsenAnhalt = 14 Public CONST CalBLSchlHolstein = 15 Public CONST CalBLThueringen = 16 +Public DlgCalendar as Object +Public DlgCalModel as Object Sub CalAutopilotTable() +Dim BitmapDir as String ' On Error Goto ErrorHandler - BasicLibraries.LoadLibrary("Tools") + BasicLibraries.LoadLibrary("Tools") ' HauptRoutine zur Erstellung des Kalenders - Set DlgBuffer = DlgCalendar + oDocument = StarDesktop.ActiveFrame.Controller.Model + oStatusline = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator - DlgBuffer.Load() - sCurLangLocale = StarDesktop.ISOLocale.Language + sCurLangLocale = oDocument.CharLocale.Language + DlgCalendar = LoadDialog("Schedule", "Dialog1") + DlgCalModel = DlgCalendar.Model LoadLanguage(sCurLangLocale) ' Da modulübergreifende Variablen unsicher sind, ' wird ihre Initialisierung noch einmal explizit ' angegeben. CalInitGlobalVariablesDate() - CalCalcPictureData() - CalChoosenLand% = -2 + BitmapDir = GetOfficeSubPath("Template","wizard/bitmap") + DlgCalModel.imgCountry.ImageURL = BitmapDir & sBitmapFilename + 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 + DlgCalendar.GetControl("lstMonth").SelectItem(cCalShortMonthNames$(Month(Now())), True) + + With DlgCalModel +' .lbOwnData.FontName = "Courier" + .cmdDelete.Enabled = False +' .lstMonth.Tag = DlgCalModel.txtMonth.Text + .lstMonth.StringItemList() = cCalShortMonthNames$() + .lstOwnEventMonth.StringItemList() = cCalShortMonthNames$() + .optYear.State = 1 + .txtYear.Text = Year(Now()) + .txtYear.Tag = DlgCalModel.txtYear.Text + .Step = 1 + End With 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() + DlgCalendar.GetControl("lstHolidays").SelectItemPos(0,True) + DlgCalendar.Visible = True Exit Sub ErrorHandler: @@ -112,44 +116,38 @@ 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 + With DlgCalModel + .lstMonth.Enabled = .optMonth.State = 1 + .lblMonth.Enabled = .optMonth.State = 1 + End With End Sub -Sub CalCmdCancel() - If CalOwnDataChanged% Then +Sub CalcmdCancel() + If bCalOwnDataChanged Then Call CalSaveOwnData() End If - DlgBuffer.Unload() + DlgCalendar.Visible = False End Sub -Sub CalCmdOk() +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() +Dim i, iSelYear as Integer +Dim SelYear as String + DlgCalendar.Visible = False If cLANGUAGE_GERMAN = sCurLangLocale Then - If MouseClicked% Then - CalChoosenLand%=LandWhenClick% + If Ubound(DlgCalModel.lstHolidays.SelectedItems()) > -1 Then + CalChoosenLand = DlgCalModel.lstHolidays.SelectedItems(0) Else - CalChoosenLand% = 0 + CalChoosenLand = 0 End If End If - - oDocument = StarDesktop.ActiveFrame.Controller.Model oSheets = oDocument.sheets - If CalOwnDataChanged% Then + If bCalOwnDataChanged Then Call CalSaveOwnData() End If @@ -159,10 +157,10 @@ Sub CalCmdOk() Next oSheets.RemovebyName(oSheets.GetbyIndex(0).Name) - iSelYear = Val(txtYear.Text) + iSelYear = Val(DlgCalModel.txtYear.Text) Select Case sCurLangLocale Case cLANGUAGE_GERMAN - Call CalFindWholeYearHolidays_GERMANY(iSelYear, CalChoosenLand%) + Call CalFindWholeYearHolidays_GERMANY(iSelYear, CalChoosenLand) Case cLANGUAGE_ENGLISH Call FindWholeYearHolidays_US(iSelYear) Case cLANGUAGE_FRENCH @@ -187,26 +185,26 @@ Sub CalCmdOk() Call CalInsertOwnDataInTables(iSelYear) - oStatusline = oDocument.GetCurrentController.GetFrame.GetStatusIndicator - - If optYear.Value Then + If DlgCalModel.optYear.State = 1 Then oSheets.RemovebyName(oSheets.GetbyIndex(0).Name) oSheet = oSheets.GetbyIndex(0) - oSheet.Name = sCalendarTitle$ + " " + txtYear.Text + oSheet.Name = sCalendarTitle$ + " " + iSelYear oDocument.AddActionLock Call CalCreateYearTable(iSelYear) - ElseIf optMonth.Value Then + ElseIf DlgCalModel.optMonth.State = 1 Then + Dim iMonth + iMonth = DlgCalModel.lstMonth.SelectedItem(0) oSheets.RemovebyName(oSheets.GetbyIndex(1).Name) oSheet = oSheets.GetbyIndex(0) - oSheet.Name = sMonthTitle$ + " " + cCalLongMonthNames$(CalGetIntOfShortMonthName%(txtMonth.Text)) + oSheet.Name = sMonthTitle$ + " " + cCalLongMonthNames$(iMonth) oDocument.AddActionLock - Call CalCreateMonthTable(iSelYear, CalGetIntOfShortMonthName%(txtMonth.Text)) + Call CalCreateMonthTable(iSelYear, iMonth) End If oDocument.RemoveActionLock ' Protect the remaining sheet oSheet.protect("") oStatusLine.End - DlgBuffer.Unload() + DlgCalendar.Visible = False End Sub -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/CreateTable.xba b/wizards/source/schedule/CreateTable.xba index 5ef472639989..ef9ffc68c43e 100644 --- a/wizards/source/schedule/CreateTable.xba +++ b/wizards/source/schedule/CreateTable.xba @@ -1,5 +1,5 @@ <?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="CreateTable" script:language="StarBasic">Option Explicit Public Const FirstDayRow = 5 ' Row on month sheet for first day of month @@ -27,11 +27,11 @@ Dim sBlankStyle as String On Error Goto ErrorHandling oStatusLine.Start(GetResText(sProgress),140) - iDate = DateSerial(Val(DlgBuffer.txtYear.Text),1,1) + iDate = DateSerial(Val(DlgCalModel.txtYear.Text),1,1) ' Insert year oYearCell = oSheet.GetCellRangeByName("Year") - oYearCell.Value = Val(DlgBuffer.txtYear.Text) + oYearCell.Value = Val(DlgCalModel.txtYear.Text) ' Insert holidays CalMonth% = 1 CalDay% = 0 @@ -83,7 +83,7 @@ On Error Goto ErrorHandling TargetMonth% = CalGetIntOfShortMonthName%(txtMonth.Text) oMonthCell = oSheet.GetCellRangeByName("Month") - iDate = DateSerial(Val(DlgBuffer.txtYear.Text),TargetMonth%,1) + iDate = DateSerial(Val(DlgCalModel.txtYear.Text),TargetMonth%,1) oMonthCell.Value = iDate ' Inserting holidays StartDay% = (TargetMonth% - 1) * 31 + 1 diff --git a/wizards/source/schedule/DlgControl.xba b/wizards/source/schedule/DlgControl.xba index 659f8c02fd2c..deee7546ae4f 100644 --- a/wizards/source/schedule/DlgControl.xba +++ b/wizards/source/schedule/DlgControl.xba @@ -1,9 +1,11 @@ <?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="DlgControl" script:language="StarBasic">Option Explicit Dim CalBitmap As Object +Public bDoSelect as Boolean +' Todo: Adjustmentlistener an der Scrollbar anmelden Sub Main() Call CalAutopilotTable() @@ -40,110 +42,27 @@ 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 +Dim MsgBoxResult as Integer + If Ubound(DlgCalModel.lstOwnData.SelectedItems()) > -1 Then + MsgBoxResult = MsgBox(cCalSubcmdDeleteSelect_DeleteSelEntry$, 4+32, cCalSubcmdDeleteSelect_DeleteSelEntryTitle$) + If MsgBoxResult = 6 Then + DlgCalModel.lstOwnData.StringItemList() = RemoveSelected(DlgCalModel.lstOwnData) + ' Flag zum Speichern der neuen Daten. + bCalOwnDataChanged = True + DlgCalModel.cmdDelete.Enabled = Ubound(DlgCalModel.lstOwnData.StringItemList()) > -1 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 + With DlgCalModel + .txtOwnEventDay.Tag = .txtOwnEventDay.Text + .txtOwnEventMonth.Tag = .txtOwnEventMonth.Text + .DlgCalModel.txtOwnEventYear.Tag = .DlgCalModel.txtOwnEventYear.Text + End With End Sub @@ -174,105 +93,47 @@ Sub ModIntTextBox (txtYear As Object, ByVal nMax%, ByVal nMin%, ByVal sDefault$, 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 +Sub ToggleYearBox() +' 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. + With DlgCalModel + .txtOwnEventYear.Enabled = .chkEventOnce.State = 1 + .lblEventYear.Enabled = .chkEventOnce.State = 1 + If .txtOwnEventYear.Text = "" And .lblEventYear.Enabled Then + .txtOwnEventYear.Text = Trim$(Str$(Year(Now()))) + End If + End With End Sub -Sub CalMouseMoved(Button as integer, Shift as integer, X as single, Y as single) - +Sub CalMouseMoved(aEvent as object) +Dim ListIndex as Integer + oStatusline.SetText(aEvent.ClickCount) +' If aEvent.ClickCount = 2 Then +' oStatusLine.SetText("Click") +' bDoSelect = False +' Else +' oStatusLine.SetText("") +' End If ' 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 + Case cLANGUAGE_GERMAN + ' Ermittelt das Land auf dem sich der MausCursor befindet, und aktualisiert + ' die Textbox mit der Bundeslandbezeichnung, falls ein Mausklick stattfandt. +' If bDoSelect Then + ListIndex = CalGetGermanLandAtMousePos(aEvent.X, aEvent.Y, Land$) + DlgCalendar.GetControl("lstHolidays").SelectItemPos(ListIndex, True) + If aEvent.ClickCount = 2 Then + bDoSelect = False + End If +' End If End Select - LastMousePosX = X - LastMousePosY = Y + LastMousePosX = aEvent.X + LastMousePosY = aEvent.Y End Sub @@ -281,19 +142,19 @@ Sub CalChangeGeneralMonth() Dim MonthToCheck$ Dim ValMonthToCheck% - MonthToCheck$ = DlgBuffer.txtMonth.Text + MonthToCheck$ = DlgCalModel.txtMonth.Text ValMonthToCheck% = Val(MonthToCheck$) If (ValMonthToCheck% >= 1) And (ValMonthToCheck% <=12) Then - DlgBuffer.txtMonth.Text = cCalShortMonthNames$(ValMonthToCheck%) + DlgCalModel.txtMonth.Text = cCalShortMonthNames$(ValMonthToCheck%) Exit Sub End If If CalGetIntOfShortMonthName%(Trim(Left(MonthToCheck$, 3))) = 0 Then Beep - DlgBuffer.txtMonth.Text = DlgBuffer.txtMonth.Tag + DlgCalModel.txtMonth.Text = DlgCalModel.txtMonth.Tag Else - DlgBuffer.txtMonth.Text = Trim(Left(MonthToCheck, 3)) + DlgCalModel.txtMonth.Text = Trim(Left(MonthToCheck, 3)) End If End Sub @@ -301,69 +162,94 @@ End Sub Sub CalChkForChangeInsertAccept - ' Aktualisiert die Caption des Insert/Accept Buttons - If (DataSelectedFromList=True) And (ButtonCaptionIsInsert) Then - DlgBuffer.cmdInsert.Caption = cSubChkForChangeInsertAccept_Accpet$ + ' Aktualisiert die Label des Insert/Accept Buttons + If (DataSelectedFromList=True) And (ButtonLabelIsInsert) Then + DlgCalModel.cmdInsert.Label = 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() +Dim NullList() as String +' Löscht die Werte der Eingabe Controls für ein neues Ereignis. + With DlgCalModel + .chkEventOnce.State = 0 + .lblEventYear.Enabled = False + .txtOwnEventYear.Enabled = False +' SpinOwnEventYear.Enabled = False + .txtOwnEventYear.Text = "" + .txtEvent.Text = "" + .txtOwnEventDay.Text = "" +' Todo: Wie kriegt man den Focus auf dieses verdammte Control? +' .txtEvent.DefaultButton = True + End With + DlgCalModel.lstOwnEventMonth.SelectedItems() = Nulllist() 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$ + If DlgCalModel.Step = 1 Then + DlgCalModel.Step = 2 + DlgCalModel.cmdOwnData.Label = cCalSubcmdSwitchOwnDataOrGeneral_Back$ + DlgCalModel.cmdInsert.Enabled = DlgCalModel.txtEvent.Text <> "" + ToggleYearBox() Else - DlgBuffer.CurrentStep = 1 - DlgBuffer.DlgCmdOwnData.Caption = cCalSubcmdSwitchOwnDataOrGeneral_OwnData$ + DlgCalModel.Step = 1 + DlgCalModel.cmdOwnData.Label = cCalSubcmdSwitchOwnDataOrGeneral_OwnData$ End If End Sub -Sub LoadDialog() - DlgBuffer.load +Sub ToggleInsertButton() + DlgCalModel.cmdInsert.Enabled = LTrim(DlgCalModel.txtEvent.Text) <> "" End Sub -Sub ShowDialog() - DlgBuffer.Show + +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 CalUpdateNewEventFrame() +Dim bDoEnable as Boolean +Dim sSelectedItem +Dim ListIndex as Integer +Dim MaxSelIndex as Integer + bDoEnable = False + With DlgCalModel + MaxSelIndex = Ubound(DlgCalModel.lstOwnData.SelectedItems()) + If MaxSelIndex > -1 Then + ListIndex = .lstOwnData.SelectedItems(MaxSelIndex) + .txtEvent.Text = CalGetNameofEvent(ListIndex) + .txtOwnEventDay.Text = CalGetDayOfEvent(ListIndex) + DlgCalendar.GetControl("lstOwnEventMonth").SelectItem(CalGetMonthOfEvent(ListIndex), True) + .txtOwnEventYear.Text = CalGetYearofEvent(ListIndex) + bDoEnable = DlgCalModel.txtOwnEventYear.Text = "" + .chkEventOnce.State = Abs(bDoEnable) + .lblEventYear.Enabled = bDoEnable + .txtOwnEventYear.Enabled = bDoEnable + .cmdDelete.Enabled = True + Else + Call CalClearInputMask() + .cmdDelete.Enabled = False + End If + End With +End Sub + </script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/Language.xba b/wizards/source/schedule/Language.xba index 2289db2c17a0..d502fdcf5c7f 100644 --- a/wizards/source/schedule/Language.xba +++ b/wizards/source/schedule/Language.xba @@ -1,10 +1,8 @@ <?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="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" @@ -12,72 +10,27 @@ Public Const cLANGUAGE_ITALIAN = "it", cLANGUAGE_JAPANESE = "ja&q 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 +Public BLNameList(0 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 + +Sub LoadLanguage%(ByVal LangLocale) +Dim Dummy$ +Dim i as Integer 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 + DlgCalendar.GetControl("lblHolidays").Visible = True + DlgCalendar.GetControl("lstHolidays").Visible = True ' Load all states + BLNameList(0) = GetResText(1100) BLNameList(1) = "Bayern" BLNameList(2) = "Baden-Württemberg" BLNameList(3) = "Berlin" @@ -94,62 +47,60 @@ Dim Dummy$, i, Count% 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 + DlgCalModel.lstHolidays.StringItemList() = BLNameList() +' Dim FirstItem as String +' +' FirstItem = GetResText(1100) +' DlgCalModel.lstSpecBankholidays.AddItem(FirstItem) +' For i = 1 To Ubound(BLNameList()) +' DlgCalModel.cmbState.AddItem(BLNameList(i)) +' Next i Else - DlgBuffer.lblSpecBankholidays.Visible = False - DlgBuffer.cmbState.Visible = False +' printdbgInfo DlgCalendar.GetControl("lblSpecBankholidays") +' DlgCalendar.GetControl("lblSpecBankholidays").Visible = False +' DlgCalendar.GetControl("lstSpecBankholidays").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) + sWizardTitle$ = GetResText(1300) + sError$ = GetResText(1301) + cCalSubcmdDeleteSelect_DeleteSelEntryTitle$ = GetResText(1302) + cCalSubcmdDeleteSelect_DeleteSelEntry$ = GetResText(1303) + DlgCalendar.Title = GetResText(1000) + + With DlgCalModel + cCalSubcmdSwitchOwnDataOrGeneral_OwnData$ = GetResText(1002) + cCalSubcmdSwitchOwnDataOrGeneral_Back$ = GetResText(1001) + .hlnTime.Label = GetResText(1011) + .lblYear.Label = GetResText(1012) + .cmdCancel.Label = GetResText(1005) + .cmdGoOn.Label = GetResText(1004) + .lblHolidays.Label = GetResText(1014) + sBitmapFilename$ = GetResText(1099) + DlgCalModel.hlnCalendar.Label = GetResText(1006) + .optYear.Label = GetResText(1007) + .optMonth.Label = GetResText(1008) + .lblMonth.Label = GetResText(1013) + .cmdOwnData.Label = GetResText(1015) + .hlnNewEvent.Label = GetResText(1019) + .lblEvent.Label = GetResText(1019) + .lblEventDay.Label = GetResText(1021) + .lblEventMonth.Label = GetResText(1022) + .lblEventYear.Label = GetResText(1023) + .chkEventOnce.Label = GetResText(1020) + .cmdInsert.Label = GetResText(1016) + .cmdDelete.Label = GetResText(1017) + ' Load long month names + For i = 0 To 11 + cCalLongMonthNames(i+1) = GetResText(dlgMonth+i) + cCalShortMonthNames(i+1)= Left$(cCalLongMonthNames(i+1), 3) + Next + ' Load sheet names + sCalendarTitle$ = GetResText(1410) + sMonthTitle$ = GetResText(1411) + ' Load names of styles + cCalStyleWorkday$ = GetResText(1400) + cCalStyleWeekend$ = GetResText(1401) + End With 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 index e05a3cd5cd6d..583afddcef44 100644 --- a/wizards/source/schedule/OwnEvents.xba +++ b/wizards/source/schedule/OwnEvents.xba @@ -1,5 +1,5 @@ <?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 Sub Main @@ -10,9 +10,9 @@ 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% +Dim FileName$ +Dim FileChannel% + Dim i as Integer 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 @@ -29,20 +29,20 @@ Sub CalSaveOwnData() 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%) + For i = 0 To Ubound(DlgCalModel.lstOwnData.StringItemList()) + Write #FileChannel%, DlgCalModel.lstOwnData.StringItemList(i) Next Close #FileChannel% End Sub +' Lädt die Daten der persönlichen Ereignisse und +' schreibt diese dann in das Control lbOwnData. Sub CalLoadOwnData() - ' Lädt die Daten der persönlichen Ereignisse und - ' schreibt diese dann in das Control lbOwnData. - - Dim FileName$, tempStr$ - Dim FileChannel%, Count% +Dim FileName$, tempStr$ +Dim FileChannel%, Count% +Dim i as Integer FileName$ = GetPathSettings("Config", False)+ GetPathSeparator() + "DATE.DAT" If Dir(FileName$) = "DATE.DAT" Then @@ -53,11 +53,12 @@ Sub CalLoadOwnData() For Count% = 1 To 6 Line Input #FileChannel%, tempStr$ Next - + i = 0 ' Einfügen nach Reihenfolge sortiert. While (not eof(#FileChannel%)) Input #FileChannel%, tempStr$ - DlgBuffer.lbOwnData.AddItem(tempStr$) + DlgCalModel.lstOwnData.AddItem(tempStr$, i) + i = i + 1 Wend Close #FileChannel% @@ -65,284 +66,221 @@ Sub CalLoadOwnData() 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 +Function SetFocusToControl(oTextControl as Object) + If oTextControl.Text = "" Then + Beep + oTextControl.DefaultButton = True + SetFocusToControl = True + Else + SetFocusToControl = False 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&)) +Function CalCreateDateFromInput() as Date +' Generiert aus den Eingabedaten der Ereignisseite +' ein Datum im Dateserial Format, +Dim newDate as Date +Dim EvMonth as Integer +Dim EvDay as Integer +Dim EvYear as Integer + EvMonth = DlgCalModel.lstOwnEventMonth.SelectedItems(0) + EvDay = Val(DlgCalModel.txtOwnEventDay.Text) + If DlgCalModel.chkEventOnce.State = 1 Then + EvYear = Val(DlgCalModel.txtOwnEventYear.Text) + newDate = DateSerial(EvYear, EvMonth, EvDay) + Else + newDate = DateSerial(0, EvMonth, EvDay) End If - CalCreateDateFromInput& = newDate& + 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$ = " " +Function CalCreateDateStrOfInput() as String +Dim DateStr as String +Dim EvMonth as Integer +Dim EvDay as Integer + EvDay = Val(Trim(DlgCalModel.txtOwnEventDay.Text)) + If EvDay < 10 Then + DateStr = "0" & EvDay & ". " + Else + DateStr = Cstr(EvDay) & ". " End If + DateStr = DateStr & DlgCalendar.GetControl("lstOwnEventMonth").GetSelectedItem() - 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) + If DlgCalModel.chkEventOnce.State = 1 And DlgCalModel.txtOwnEventYear.Text <> "" Then + DateStr = DateStr & " " + Trim(DlgCalModel.txtOwnEventYear.Text) Else - DateStr$ = DateStr$ + " " + DateStr = DateStr + " " End If - DateStr$ = DateStr$ + " " + Trim(txtEvent.Text) - CalCreateDateStrOfInput$ = DateStr$ + DateStr = DateStr + " " + Trim(DlgCalModel.txtEvent.Text) + CalCreateDateStrOfInput = DateStr End Function -Function CalGetDateWithoutYear&(byval Pos%) - CalGetDateWithoutYear& = DateSerial(0, CalGetMonthOfEvent(Pos%), CalGetDayOfEvent(Pos%)) +Function CalGetDateWithoutYear&(ByVal i as Integer) + CalGetDateWithoutYear& = DateSerial(0, CalGetMonthOfEvent(i), CalGetDayOfEvent(i)) 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% +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 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 = Val(DlgCalModel.txtOwnEventYear.Text) + If (EvYear <= 1582) OR (EvYear >= 9957) Then + SetFocusToControl(txtOwnEventMonth) + Exit Sub + End If + End If - Inserted% = False - DateStr$ = CalCreateDateStrOfInput$() - If DateStr$ = "" Then Exit Sub + If DlgCalModel.chkEventOnce.State = 1 Then + EvYear = Val(DlgCalModel.txtOwnEventYear.Text) + End If + newDate = CalCreateDateFromInput() + 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 + 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 - 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 + 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 + DlgCalModel.GetControl("lstOwnData").RemoveItem(DateStr, i) + DlgCalModel.GetControl("lstOwnData").AddItem(DateStr, i) + bInserted = True End If - Wend - If Found% Then - If (CalGetYearOfEvent%(Count%)<>0) Then - lbOwnData.AddItem(DateStr$, Count%) - Inserted% = True - End If - End If - 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 + DlgCalModel.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. - 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 + ' 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 + DlgCalModel.GetControl("lstOwnData").AddItem(DateStr, i) + End If + Loop Until bInserted Or i > LastIndex 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 + ' Das Datum ist noch nicht vorhanden und wir richtig einsortiert + If Not bInserted And Not bDateDoubled Then + i = 0 + Do + bInserted = newDate > CalGetDateWithoutYear(i) + i = i + 1 + If bInserted Then + DlgCalendar.GetControl("lstOwnData").AddItem(DateStr, i) + End If + Loop Until bInserted Or i > LastIndex + End If End If ' Flag zum Speichern der neuen Daten. - If Inserted% = True Then - CalOwnDataChanged% = True + If bInserted = True Then + bCalOwnDataChanged = 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 ListIndex as Integer) as Integer +Dim YearStr as String + YearStr = DlgCalModel.lstOwnData.StringItemList(ListIndex) + CalGetYearOfEvent% = Val(Mid(YearStr, 10, 4)) +End Function -Function CalGetYearOfEvent%(byval Pos%) - CalGetYearOfEvent% = Val(Mid$(lbOwnData.List(Pos%), 10, 4)) +Function CalGetDayOfEvent(ByVal ListIndex as Integer) as Integer +Dim DayStr as String + DayStr = DlgCalModel.lstOwnData.StringItemList(ListIndex) + CalGetDayOfEvent = Val(Left(DayStr,2)) 'Mid(DayStr, 1, 2)) End Function -Function CalGetDayOfEvent%(byval Pos%) - CalGetDayOfEvent% = Val(Mid$(lbOwnData.List(Pos%), 1, 2)) +Function CalGetNameOfEvent(ByVal ListIndex as Integer) as Integer +Dim NameStr as String + NameStr = DlgCalModel.lstOwnData.StringItemList(ListIndex) + NameStr = Trim (Mid(NameStr, 16)) +' If Val(NameStr) = 0 Then +' NameStr = "" +' End If + CalGetNameOfEvent = NameStr 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$) +Function CalGetMonthOfEvent(ByVal ListIndex as Integer) as Integer +Dim MonthStr as String + MonthStr = DlgCalModel.lstOwnData.StringItemList(ListIndex) + MonthStr = Mid(MonthStr, 5, 3) + CalGetMonthOfEvent = CalGetIntOfShortMonthName(MonthStr) End Function - + +Sub CheckInsertedDates() +Dim EvYear as Long +Dim EvMonth as Long +Dim EvDay as Long +Dim sEvMonth as String +Dim bDoEnable as Boolean + bDoEnable = True + If DlgCalModel.chkEventOnce.State = 1 Then + EvYear = Val(DlgCalModel.txtOwnEventYear.Text) + '(EvYear >= 1582) AND (EvYear <= 9957) + bDoEnable = EvYear <> 0 + Else + EvYear = Year(Now()) + End If + If bDoEnable Then + EvDay = Val(DlgCalModel.txtOwnEventDay.Text) + bDoEnable = Ubound(DlgCalModel.lstOwnEventMonth.SelectedItems()) > -1 + If bDoEnable Then + EvMonth = DlgCalModel.lstOwnEventMonth.SelectedItems(0) + bDoEnable = (EvDay > 1) AND (EvDay < CalMaxDayInMonth(EvYear, EvMonth)) + If bDoEnable Then + bDoEnable = LTrim(DlgCalModel.txtEvent.Text) <> "" + End If + End If + End If + DlgCalModel.cmdInsert.Enabled = bDoEnable +End Sub </script:module>
\ No newline at end of file |