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