Public Class cFeiertage Private _Year As Integer Private _Ostern As Date ''' ''' Initialisiert die Feiertags-Klasse für das aktuelle Jahr ''' Public Sub New() _Year = Now.Year End Sub ''' ''' Initialisiert die Feiertags-Klasse für das angegebene Jahr ''' Public Sub New(ByVal Year As Integer) _Year = Year End Sub ''' ''' Gibt das Datum für den Ostersonntag zurück. ''' Public ReadOnly Property Ostersonntag_OLD() As Date Get If _Ostern.Ticks = 0 Then ' Datum des ersten Vollmondes nach Frühlingsanfang Dim a As Integer = _Year Mod 19 Dim b As Integer = _Year Mod 4 Dim c As Integer = _Year Mod 7 Dim M As Integer = Val(((8 * Val(_Year / 100) + 13) / 25) - 2) Dim s As Integer = Val(_Year / 100) - Val(_Year / 400) - 2 M = (15 + s - M) Mod 30 Dim N As Integer = (6 + s) Mod 7 Dim d As Integer = (M + 19 * a) Mod 30 If d = 29 Then d = 28 ElseIf d = 28 Then If (_Year Mod 19) > 10 Then d = 27 End If Dim e As Integer = (2 * b + 4 * c + 6 * d + N) Mod 7 ' Ostersonntag _Ostern = New DateTime(_Year, 3, 21).AddDays(d + e + 1) End If Return _Ostern End Get End Property Public Function Ostersonntag() As Date Dim _month As Integer Dim _day As Integer Dim _moon As Integer Dim _epact As Integer Dim _sunday As Integer Dim _gold As Integer Dim _century As Integer Dim _corx As Integer Dim _corz As Integer ' The Golden Number of the year in the 19 year Metonic Cycle: _gold = (_Year Mod 19) + 1 ' Calculate the Century: _century = (_Year \ 100) + 1 ' Number of years in which leap year was dropped in order ' to keep in step with the sun: _corx = (3 * _century) \ 4 - 12 ' Special correction to syncronize Easter with moon's orbit: _corz = (8 * _century + 5) \ 25 - 5 ' Find Sunday: _sunday = (5 * _Year) \ 4 - _corx - 10 ' ^ evtl. long To prevent overflow at year 6554 ' Set Epact - specifies occurrence of full moon: _epact = (11 * _gold + 20 + _corz - _corx) Mod 30 If _epact < 0 Then _epact += 30 End If If (((_epact = 25) AndAlso (_gold > 11)) OrElse (_epact = 24)) Then _epact += 1 End If ' Find Full Moon: _moon = 44 - _epact If _moon < 21 Then _moon += 30 End If ' Advance to Sunday: _moon += 7 - ((_sunday + _moon) Mod 7) If (_moon > 31) Then _month = 4 _day = _moon - 31 Else _month = 3 _day = _moon End If Return New DateTime(_Year, _month, _day) End Function ''' ''' Gibt das Datum für den Ostermontag zurück. ''' Public ReadOnly Property Ostermontag() As Date Get Return Ostersonntag.AddDays(1) End Get End Property ''' ''' Gibt das Datum für den BussUndBettag zurück. ''' Public ReadOnly Property BussUndBettag() As Date Get Dim i As Long Dim VierterAdvent As Date For i = 24 To 1 Step -1 If CDate(i & ".12." & _Year).ToString("ddd") = "So" Then VierterAdvent = CDate(i & ".12." & _Year).ToShortDateString Exit For End If Next i Dim ErsterAdvent As Date = VierterAdvent.AddDays(-21) ' DateAdd("d", -21, VierterAdvent) Return ErsterAdvent.AddDays(-11) ' DateAdd("d", -11, ErsterAdvent) 'BussUndBettag End Get End Property ''' ''' Gibt das Datum für den Karfreitag zurück. ''' Public ReadOnly Property Karfreitag() As Date Get Return Ostersonntag.AddDays(-2) End Get End Property ''' ''' Gibt das Datum für den Pfingstsonntag zurück. ''' Public ReadOnly Property Pfingstsonntag() As Date Get Return Ostersonntag.AddDays(49) End Get End Property ''' ''' Gibt das Datum für den Pfingsmontag zurück. ''' Public ReadOnly Property Pfingstmontag() As Date Get Return Ostersonntag.AddDays(50) End Get End Property ''' ''' Gibt das Datum für Christi-Himmelfahrt zurück. ''' Public ReadOnly Property Himmelfahrt() As Date Get Return Ostersonntag.AddDays(39) End Get End Property ''' ''' Gibt das Datum für Fronleichnam zurück. ''' Public ReadOnly Property Fronleichnam() As Date Get Return Ostersonntag.AddDays(60) End Get End Property ''' ''' Gibt das Datum für Aschermittwoch zurück. ''' Public ReadOnly Property Aschermittwoch() As Date Get Return Ostersonntag.AddDays(-46) End Get End Property Public Function isFeiertag(datum As Date, land As String) As Boolean If datum = CDate("01.01." & _Year) Then Return True If datum = CDate("06.01." & _Year) Then Return True If datum = CDate("15.08." & _Year) Then Return True If datum = CDate("01.11." & _Year) Then Return True If datum = CDate("25.12." & _Year) Then Return True If datum = CDate("26.12." & _Year) Then Return True If datum = Ostermontag Then Return True If datum = Ostersonntag() Then Return True If datum = Himmelfahrt Then Return True If datum = Pfingstmontag Then Return True If datum = Pfingstsonntag Then Return True If datum = Fronleichnam Then Return True Select Case land Case "AT" If datum = CDate("26.10." & _Year) Then Return True If datum = CDate("08.12." & _Year) Then Return True If datum = CDate("01.05." & _Year) Then Return True 'Staatsfeiertag Case "DE" 'BAYERN If datum = CDate("03.10." & _Year) Then Return True ' Tag der Deutschen Einheit If datum = BussUndBettag Then Return True ' Buß- und Bettag '!!!!ABEWEICHEND If datum = CDate("08.08." & _Year) Then Return True ' Augsburger Friedensfest If datum = CDate("01.05." & _Year) Then Return True ' Maifeiertag If datum = Karfreitag Then Return True End Select Return False End Function 'Public Function isFeiertag(datum As Date, land As String) As Boolean ' If datum = CDate("01.01." & _Year) Then Return True ' If datum = CDate("06.01." & _Year) Then Return True ' If datum = CDate("15.08." & _Year) Then Return True ' If datum = CDate("01.11." & _Year) Then Return True ' If datum = CDate("25.12." & _Year) Then Return True ' If datum = CDate("26.12." & _Year) Then Return True ' If datum = Ostermontag Then MsgBox("Ostermontag") : Return True ' If datum = Ostersonntag() Then MsgBox("Ostersonntag") : Return True ' If datum = Himmelfahrt Then MsgBox("Himmelfahrt") : Return True ' If datum = Pfingstmontag Then MsgBox("Pfingstmontag") : Return True ' If datum = Pfingstsonntag Then MsgBox("Pfingstsonntag") : Return True ' If datum = Fronleichnam Then MsgBox("Fronleichnam") : Return True ' Select Case land ' Case "AT" ' If datum = CDate("26.10." & _Year) Then Return True ' If datum = CDate("08.12." & _Year) Then Return True ' If datum = CDate("01.05." & _Year) Then Return True 'Staatsfeiertag ' Case "DE" 'BAYERN ' If datum = CDate("03.10." & _Year) Then Return True ' Tag der Deutschen Einheit ' If datum = BussUndBettag Then MsgBox("BussUndBettag") : Return True ' Buß- und Bettag '!!!!ABEWEICHEND ' If datum = CDate("08.08." & _Year) Then Return True ' Augsburger Friedensfest ' If datum = CDate("01.05." & _Year) Then Return True ' Maifeiertag ' If datum = Karfreitag Then MsgBox("Karfreitag") : Return True ' End Select ' Return False 'End Function End Class