Option Explicit Dim CalBitmap As Object Public bDoSelect as Boolean ' Todo: Adjustmentlistener an der Scrollbar anmelden 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 CalcmdDeleteSelect() 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 CalSaveOwnEventControls() With DlgCalModel .txtOwnEventDay.Tag = .txtOwnEventDay.Text .txtOwnEventMonth.Tag = .txtOwnEventMonth.Text .DlgCalModel.txtOwnEventYear.Tag = .DlgCalModel.txtOwnEventYear.Text End With 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 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(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 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 = aEvent.X LastMousePosY = aEvent.Y End Sub Sub CalChangeGeneralMonth() Dim MonthToCheck$ Dim ValMonthToCheck% MonthToCheck$ = DlgCalModel.txtMonth.Text ValMonthToCheck% = Val(MonthToCheck$) If (ValMonthToCheck% >= 1) And (ValMonthToCheck% <=12) Then DlgCalModel.txtMonth.Text = cCalShortMonthNames$(ValMonthToCheck%) Exit Sub End If If CalGetIntOfShortMonthName%(Trim(Left(MonthToCheck$, 3))) = 0 Then Beep DlgCalModel.txtMonth.Text = DlgCalModel.txtMonth.Tag Else DlgCalModel.txtMonth.Text = Trim(Left(MonthToCheck, 3)) End If End Sub Sub CalChkForChangeInsertAccept ' Aktualisiert die Label des Insert/Accept Buttons If (DataSelectedFromList=True) And (ButtonLabelIsInsert) Then DlgCalModel.cmdInsert.Label = cSubChkForChangeInsertAccept_Accpet$ End If End Sub Sub CalClearInputMask() 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 Sub CalmdSwitchOwnDataOrGeneral() 'Ändert den Titel der Dialogbox beim Seitenwechsel und die 'Beschriftungen der Knöpfe If DlgCalModel.Step = 1 Then DlgCalModel.Step = 2 DlgCalModel.cmdOwnData.Label = cCalSubcmdSwitchOwnDataOrGeneral_Back$ DlgCalModel.cmdInsert.Enabled = DlgCalModel.txtEvent.Text <> "" ToggleYearBox() Else DlgCalModel.Step = 1 DlgCalModel.cmdOwnData.Label = cCalSubcmdSwitchOwnDataOrGeneral_OwnData$ End If End Sub Sub ToggleInsertButton() DlgCalModel.cmdInsert.Enabled = LTrim(DlgCalModel.txtEvent.Text) <> "" 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 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