Hallo
um etwas zu Lernen hab ich einen Monatskalender erstellt.
Soweit bin ich mit dem ganzen zufrieden, aber leider scheitern
meine Versuche die Feiertage im Kalender Rot anzuzeigen (ForeColor).
Berechnung der Feiertage hab ich hier im Forum gefunden, und die anzeige in
einem Label geht auch.
Später wollte ich noch versuchen KW und Schichten einfügen.
hier mein bisheriger Code.
L.G. Willi
tut mir leid aber ich kann eure antworten nicht sehen.
was läuft hier schief.
werde das thema neu eröffnen.
um etwas zu Lernen hab ich einen Monatskalender erstellt.
Soweit bin ich mit dem ganzen zufrieden, aber leider scheitern
meine Versuche die Feiertage im Kalender Rot anzuzeigen (ForeColor).
Berechnung der Feiertage hab ich hier im Forum gefunden, und die anzeige in
einem Label geht auch.
Später wollte ich noch versuchen KW und Schichten einfügen.
hier mein bisheriger Code.
VB.NET-Quellcode
- Public Class Form1
- #Region "Variable"
- Dim x As Integer
- Private tageImMonat() As Label
- Dim del As Integer
- Dim m As Integer
- Dim y As Integer
- Dim d As Integer
- Dim j As Date
- Dim jahr As Integer
- Dim monat As Integer
- Dim tage As Integer
- Dim startTag As Integer
- #End Region
- Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
- 'Combobox cbJahre füllen
- For y = 1900 To 2100
- cbJahre.Items.Add(y)
- Next y
- 'Combobox cbMonate füllen
- For m = 1 To 12
- cbMonate.Items.Add(MonthName(m)).ToString("MMMM")
- Next m
- 'Combobox cbTage füllen
- For d = 1 To 31
- cbTage.Items.Add(d)
- Next d
- 'Combobox Text Select
- cbJahre.SelectedText = DateTime.Now.Year.ToString
- cbMonate.SelectedText = (MonthName(DateTime.Now.Month)).ToString
- cbTage.SelectedText = DateTime.Now.Day.ToString
- 'Datum anzeigen im Label
- labelanzeige()
- lblMo.Text = WeekdayName(1, True)
- lblDi.Text = WeekdayName(2, True)
- LblMi.Text = WeekdayName(3, True)
- lblDo.Text = WeekdayName(4, True)
- lblFr.Text = WeekdayName(5, True)
- lblSa.Text = WeekdayName(6, True)
- lblSo.Text = WeekdayName(7, True)
- End Sub
- Private Sub cbJahre_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cbJahre.SelectedIndexChanged
- labelanzeige()
- End Sub
- Private Sub cbMonate_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cbMonate.SelectedIndexChanged
- labelanzeige()
- End Sub
- Private Sub cbTage_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cbTage.SelectedIndexChanged
- labelanzeige()
- End Sub
- Sub labelanzeige()
- jahr = CInt(cbJahre.Text)
- tage = CInt(cbTage.Text)
- Select Case cbMonate.Text
- Case "Januar"
- monat = 1
- Case "Februar"
- monat = 2
- If Date.IsLeapYear(jahr) = False And tage > 28 Then
- MessageBox.Show("Februar" & " ist kein Schaltjahr")
- Exit Sub
- Else
- If Date.IsLeapYear(jahr) = True And tage > 29 Then
- MessageBox.Show("Februar" & " hat nur 29 Tage")
- Exit Sub
- End If
- End If
- Case "März"
- monat = 3
- Case "April"
- monat = 4
- If tage > 30 Then
- MessageBox.Show("April" & " hat nur 30 Tage")
- Exit Sub
- End If
- Case "Mai"
- monat = 5
- Case "Juni"
- monat = 6
- If tage > 30 Then
- MessageBox.Show("Juni" & " hat nur 30 Tage")
- Exit Sub
- End If
- Case "Juli"
- monat = 7
- Case "August"
- monat = 8
- Case "September"
- monat = 9
- If tage > 30 Then
- MessageBox.Show("September" & " hat nur 30 Tage")
- Exit Sub
- End If
- Case "Oktober"
- monat = 10
- Case "November"
- monat = 11
- If tage > 30 Then
- MessageBox.Show("November" & " hat nur 30 Tage")
- Exit Sub
- End If
- Case "Dezember"
- monat = 12
- End Select
- j = New DateTime(jahr, monat, tage)
- lblDatumAnzeige.Text = j.ToString(" dddd dd MMMM yyyy")
- Me.tageImMonat = {lbl1, lbl2, lbl3, lbl4, lbl5, lbl6, lbl7, lbl8, lbl9, lbl10,
- lbl11, lbl12, lbl13, lbl14, lbl15, lbl16, lbl17, lbl18, lbl19, lbl20,
- lbl21, lbl22, lbl23, lbl24, lbl25, lbl26, lbl27, lbl28, lbl29, lbl30,
- lbl31, lbl32, lbl33, lbl34, lbl35, lbl36, lbl37}
- For del = 0 To tageImMonat.Length - 1
- tageImMonat(del).Text = ""
- tageImMonat(del).Visible = False
- Next
- Dim ersteTagImMonat As New DateTime(jahr, monat, 1)
- startTag = ersteTagImMonat.DayOfWeek
- Select Case startTag
- Case 0 'Sonntag
- startTag = 6
- Case 1 'Montag
- startTag = 0
- Case 2 'Diestag
- startTag = 1
- Case 3 'Mittwoch
- startTag = 2
- Case 4 'Donnerstag
- startTag = 3
- Case 5 'Freitag
- startTag = 4
- Case 6 'Samstag
- startTag = 5
- End Select
- Dim dt = New Date(jahr, monat, tage).ToString
- Dim a As Integer
- lblFeiertag.Text = GetFeiertag(CDate(dt)).ToString
- For x = 1 To DateTime.DaysInMonth(jahr, monat)
- For y = 1 To x
- tageImMonat(x - 1 + startTag).Text = y.ToString
- tageImMonat(x - 1 + startTag).Visible = True
- tageImMonat(x).ForeColor = Color.Black
- tageImMonat(x).Font = New Font("Microsoft Sans Serif", 10, FontStyle.Regular)
- Next
- Next
- For x = 0 To tageImMonat.Length - 1
- If jahr = DateTime.Now.Year And monat = DateTime.Now.Month And tageImMonat(x).Text = DateTime.Now.Day.ToString Then
- tageImMonat(x).ForeColor = Color.DodgerBlue
- tageImMonat(x).Font = New Font("Microsoft Sans Serif", 14, FontStyle.Bold)
- Else
- tageImMonat(x).ForeColor = Color.Black
- tageImMonat(x).Font = New Font("Microsoft Sans Serif", 10, FontStyle.Regular)
- End If
- Next
- End Sub
- #Region "Feiertage"
- Public Enum Feiertage
- None = 0
- Neujahr = 1 + (1 << 16)
- 'HeiligeDreiKoenige = 6 + (1 << 16)
- Maifeiertag = 1 + (5 << 16)
- 'MariaHimmelfahrt = 15 + (8 << 16)
- TagDerDeutschenEinheit = 3 + (10 << 16)
- Reformationstag = 31 + (10 << 16)
- 'Allerheiligen = 1 + (11 << 16)
- ErsterWeihnachtsfeiertag = 25 + (12 << 16)
- ZweiterWeihnachtsfeiertag = 26 + (12 << 16)
- Karfreitag = 2
- 'Weiberfastnacht
- 'Rosenmontag
- 'Aschermittwoch
- Ostersonntag
- Ostermontag
- ChristiHimmelfahrt
- Pfingstsonntag
- Pfingstmontag
- 'Fronleichnam
- 'BussUndBettag
- End Enum
- Private _HolyDays As New HashSet(Of Integer)(DirectCast([Enum].GetValues(GetType(Feiertage)), Integer()))
- Public Function GetFeiertag(ByVal datum As DateTime) As Feiertage
- datum = datum.Date
- Dim n = datum.Day + (datum.Month << 16)
- If _HolyDays.Contains(n) Then Return DirectCast(n, Feiertage)
- Dim ostern As DateTime = GetOstersonntag(datum.Year)
- 'If datum = ostern.AddDays(-45) Then Return Feiertage.Weiberfastnacht
- 'If datum = ostern.AddDays(-41) Then Return Feiertage.Rosenmontag
- 'If datum = ostern.AddDays(-39) Then Return Feiertage.Aschermittwoch
- If datum = ostern.AddDays(-2) Then Return Feiertage.Karfreitag
- If datum = ostern Then Return Feiertage.Ostersonntag
- If datum = ostern.AddDays(1) Then Return Feiertage.Ostermontag
- If datum = ostern.AddDays(39) Then Return Feiertage.ChristiHimmelfahrt
- If datum = ostern.AddDays(49) Then Return Feiertage.Pfingstsonntag
- If datum = ostern.AddDays(50) Then Return Feiertage.Pfingstmontag
- 'If datum = ostern.AddDays(60) Then Return Feiertage.Fronleichnam
- 'With New DateTime(datum.Year, 11, 26)
- ' If datum = .AddDays(-(4 + .DayOfWeek)) Then Return Feiertage.BussUndBettag
- 'End With
- Return Feiertage.None
- End Function
- Public Function GetOstersonntag(ByVal year As Integer) As DateTime
- Dim a As Integer = year Mod 19
- Dim b As Integer = year \ 100
- Dim c As Integer = (8 * b + 13) \ 25 - 2
- Dim d As Integer = b - (year \ 400) - 2
- Dim e As Integer = (19 * (year Mod 19) + ((15 - c + d) Mod 30)) Mod 30
- If e = 28 Then
- If a > 10 Then
- e = 27
- End If
- ElseIf e = 29 Then
- e = 28
- End If
- Dim f As Integer = (d + 6 * e + 2 * (year Mod 4) + 4 * (year Mod 7) + 6) Mod 7
- Return New DateTime(year, 3, 22).AddDays(e + f)
- End Function
- Private Sub lbl1_Click(sender As Object, e As EventArgs) Handles lbl1.Click, lbl9.Click, lbl8.Click, lbl7.Click, lbl6.Click, lbl5.Click, lbl4.Click, lbl37.Click, lbl36.Click, lbl35.Click, lbl34.Click, lbl33.Click, lbl32.Click, lbl31.Click, lbl30.Click, lbl3.Click, lbl29.Click, lbl28.Click, lbl27.Click, lbl26.Click, lbl25.Click, lbl24.Click, lbl23.Click, lbl22.Click, lbl21.Click, lbl20.Click, lbl2.Click, lbl19.Click, lbl18.Click, lbl17.Click, lbl16.Click, lbl15.Click, lbl14.Click, lbl13.Click, lbl12.Click, lbl11.Click, lbl10.Click
- cbTage.Text = DirectCast(sender, Label).Text
- End Sub
- #End Region
- End Class
L.G. Willi
tut mir leid aber ich kann eure antworten nicht sehen.
was läuft hier schief.
werde das thema neu eröffnen.
Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „papawt“ ()