Hej! Känner inte till någon enkel funktion.Räkna ut när Påskdagen infaller
Behöver räkna ut när påskdagen infaller för olika år. Har sökt på ämnet
och hittat långa uträkningar för den dagen.
Jag använder Visual Basic 2010 och undrar om inte den versionen har någon
inbyggd funktion för den dagen. Ska man ha reda på t.ex söndag så skriver man
ju:
If datdag(1).DayOfWeek = DayOfWeek.Sunday Then.............
Så finns det något liknande för Påskdagen eller är det den långa
uträkningen som gäller?
Tack på förhand
LasseSv: Räkna ut när Påskdagen infaller
Har använt denna class i ett projekt där den långa varianten används
Option Explicit On
Imports Microsoft.VisualBasic
Public Class LongWeekEndFunctions
Shared Function clsCheckExtraWeekend(ByVal InDate As String) As Boolean
Dim inx As Integer
Dim InYear As String = Year(InDate)
Dim FixedWeekendsString As String
Dim FixedWeekendsArray As Array
Dim MoveableWeekendsString As String
Dim MoveableWeekendsArray As Array
FixedWeekendsString = "01-06"
FixedWeekendsArray = FixedWeekendsString.Split(",")
clsCheckExtraWeekend = False
For inx = 0 To FixedWeekendsArray.Length - 1
If CDate(InYear & "-" & FixedWeekendsArray(inx)) = CDate(InDate) Then clsCheckExtraWeekend = True : Exit Function
Next
Select Case Month(InDate)
Case 4, 5, 6
Dim paskdagen As String = Paskdatum(InDate)
MoveableWeekendsString = ""
MoveableWeekendsString = MoveableWeekendsString & "," & DateAdd(DateInterval.Day, 39, CDate(paskdagen)) ' kristi himmelsfärdsdag
MoveableWeekendsArray = MoveableWeekendsString.Split(",")
For inx = 1 To MoveableWeekendsArray.Length - 1 ' , OBS första elementet är alltid tomt
If CDate(MoveableWeekendsArray(inx)) = CDate(InDate) Then clsCheckExtraWeekend = True : Exit Function
Next
End Select
End Function
Shared Function clsCheckLongWeekend(ByVal InDate As String) As Boolean
Dim inx As Integer
Dim InYear As String = Year(InDate)
Dim FixedWeekendsString As String
Dim FixedWeekendsArray As Array
Dim MoveableWeekendsString As String
Dim MoveableWeekendsArray As Array
FixedWeekendsString = "01-01,05-01,06-06,12-24,12-25,12-26,12-31"
FixedWeekendsArray = FixedWeekendsString.Split(",")
clsCheckLongWeekend = False
For inx = 0 To FixedWeekendsArray.Length - 1
If CDate(InYear & "-" & FixedWeekendsArray(inx)) = CDate(InDate) Then clsCheckLongWeekend = True : Exit Function
Next
Select Case Month(InDate)
Case 3, 4, 5, 6
Dim paskdagen As String = Paskdatum(InDate)
MoveableWeekendsString = ""
MoveableWeekendsString = MoveableWeekendsString & "," & DateAdd(DateInterval.Day, -2, CDate(paskdagen)) ' långfredagen
MoveableWeekendsString = MoveableWeekendsString & "," & DateAdd(DateInterval.Day, -1, CDate(paskdagen)) ' påskafton
MoveableWeekendsString = MoveableWeekendsString & "," & CDate(paskdagen) ' påskdagen
MoveableWeekendsString = MoveableWeekendsString & "," & DateAdd(DateInterval.Day, 1, CDate(paskdagen)) ' annandagpåsk
MoveableWeekendsString = MoveableWeekendsString & "," & DateAdd(DateInterval.Day, 48, CDate(paskdagen)) ' pingstafton
MoveableWeekendsString = MoveableWeekendsString & "," & DateAdd(DateInterval.Day, 49, CDate(paskdagen)) ' pingstdagen
MoveableWeekendsArray = MoveableWeekendsString.Split(",")
For inx = 1 To MoveableWeekendsArray.Length - 1 ' , OBS första elementet är alltid tomt
If CDate(MoveableWeekendsArray(inx)) = CDate(InDate) Then clsCheckLongWeekend = True : Exit Function
Next
Dim mids As New Date(InYear, 6, 20) ' datum att utgå från
Dim midsber As Date = DateAdd(DateInterval.Day, 7, mids) ' lägg till sju ´dagar
Dim midsDayOffWeek As Integer = mids.DayOfWeek + 1 ' subtrahera dagnummer för 20 juni
Dim Midsommardag As Date = DateAdd(DateInterval.Day, -midsDayOffWeek, midsber) ' =midsommardagen
MoveableWeekendsString = ""
MoveableWeekendsString = MoveableWeekendsString & "," & DateAdd(DateInterval.Day, -1, Midsommardag) ' midsommarafton
MoveableWeekendsString = MoveableWeekendsString & "," & Midsommardag ' midsommardag
MoveableWeekendsString = MoveableWeekendsString & "," & DateAdd(DateInterval.Day, 1, Midsommardag) 'midsommardagen
MoveableWeekendsArray = MoveableWeekendsString.Split(",")
For inx = 1 To MoveableWeekendsArray.Length - 1 ' , OBS första elementet är alltid tomt
If CDate(MoveableWeekendsArray(inx)) = CDate(InDate) Then clsCheckLongWeekend = True : Exit Function
Next
End Select
End Function
''Ta reda på vilket datum påskdagen infaller
''
''Påskdagen infaller den första söndagen efter första fullmånen efter vårdagjämningen.
'För att räkna ut detta datum krävs en ganska komplicerad algoritm.
'Denna algoritm skrevs av den tyske matematikern Karl Friedrich Gnauss (1777-1855)
'och den franske astronomen Jean Baptiste Joseph Delambre (1749-1822).
Private Shared Function Paskdatum(ByVal Artal As String) As String
Dim a As Integer, b As Integer, c As Integer, d As Integer
Dim E As Integer, F As Integer, G As Integer, H As Integer
Dim i As Integer, k As Integer, L As Integer, M As Integer
Dim P As Integer, Q As Integer, intDatum As Integer, strManad As String
Artal = CLng(Left(Artal, 4))
a = Artal Mod 19 : b = Int(Artal / 100) : c = Artal Mod 100
d = Int(b / 4) : E = b Mod 4 : F = Int(b + 8) / 25
G = Int((b - F + 1) / 3) : H = ((19 * a + b - d - G + 15) Mod 30) : i = Int(c / 4)
k = c Mod 4 : L = ((32 + 2 * E + 2 * i - H - k) Mod 7)
M = Int((a + 11 * H + 22 * L) / 451) : P = Int((H + L - 7 * M + 114) / 31)
Q = ((H + L - 7 * M + 114) Mod 31)
If P = 3 Then strManad = "Mars"
If P = 4 Then strManad = "April"
intDatum = Q + 1
'Paskdatum = intDatum & " " & strManad
Paskdatum = Artal & "-" & Right("0" & P, 2) & "-" & Right("0" & intDatum, 2)
End Function
End Class