Således, favorit (för mig) i repris, men nu i HomeSeer utgåva: Hur man räknar fram Sveriges samtliga helgdagar så man slipper hålla reda på dagar som man är ledig (om man följer kalenderns icke röda dagar och så vidare - ja jag är väl medveten om att de finns de som går schema, som de som jobbar inom t.ex. sjukvården).
Code: Select all
Function EasternCalc(ByVal Parms As Date) As Date
Dim CurrentYear As Integer = CInt(Parms.ToString("yyyy"))
Dim c, n, k, i, j, l, m, d
c = CurrentYear \ 100
n = CurrentYear - 19 * (CurrentYear \ 19)
k = (c - 17) \ 25
i = c - c \ 4 - (c - k) \ 3 + 19 * n + 15
i = i - 30 * (i \ 30)
i = i - (i \ 28) * (1 - (i \ 28) * (29 \ (i + 1)) * ((21 - n) \ 11))
j = CurrentYear + CurrentYear \ 4 + i + 2 - c + c \ 4
j = j - 7 * (j \ 7)
l = i - j
m = 3 + (l + 40) \ 44
d = l + 28 - 31 * (m \ 4)
EasternCalc = CDate(CStr(CurrentYear) + "-" + CStr(m) + "-" + CStr(d))
End Function
Function WorkDay(ByVal dateToCheck As Date) As String
Dim easterDay As Date = Nothing
Dim returnValue As Boolean
returnValue = "true"
'-- Indatum är en Lördag eller Söndag
If dateToCheck.DayOfWeek = 6 Or dateToCheck.DayOfWeek = 0 Then
returnValue = "false"
'-- Indatum är nationaldag
ElseIf dateToCheck.Month = 6 And dateToCheck.Day = 6 Then
returnValue = "false"
'-- Indatum är Nyårsdag eller Trettondag
ElseIf (dateToCheck.Month = 1 And (dateToCheck.Day = 1 Or dateToCheck.Day = 6)) Then
returnValue = "false"
'-- Indatum är 1:a maj
ElseIf (dateToCheck.Month = 5 And dateToCheck.Day = 1) Then
returnValue = "false"
'-- Indatum är Julafton,Juldag, Annandag eller Nyårsafton
ElseIf (dateToCheck.Month = 12 And (dateToCheck.Day = 24 Or dateToCheck.Day = 25 Or dateToCheck.Day = "26" Or dateToCheck.Day = "31")) Then
returnValue = "false"
End If
'-- Påskdagen
easterDay = EasternCalc(dateToCheck)
'-- Långfredag = Påskdagen - 2 dagar
If (easterDay.AddDays(-2).ToShortDateString = dateToCheck.ToShortDateString) Then
returnValue = "false"
End If
'-- AnnandagPåsk = Påskdagen + 1 dag
If (easterDay.AddDays(1).ToShortDateString = dateToCheck.ToShortDateString) Then
returnValue = "false"
End If
'-- Kristihimmelfärdsdag? +39 dagar från Påskdagen?
If (easterDay.AddDays(39).ToShortDateString = dateToCheck.ToShortDateString) Then
returnValue = "false"
End If
'-- hitta midsommardagen för att kunna kontrollera midsommarafton
'-- midsommardagen = den lördag som infaller under tiden den 20-26 juni -> midsommarafton bör vara den fredag som inträffar under tiden 19-25 juni
If ( dateToCheck.Month = 6 And dateToCheck.Day >= 19 And dateToCheck.Day <= 25 And dateToCheck.DayOfWeek = 5 ) Then
returnValue = "false"
End If
' If ( Vacation_Days(dateToCheck) ) Then
' returnValue = "false"
' End
WorkDay = returnValue
End Function
Sub Main(ByVal Parms As String)
Dim MyDate As Date = Nothing
If Parms <> "" Then
MyDate = DateTime.Parse(Parms)
Else
MyDate = DateTime.Now
End If
If ( WorkDay(MyDate) = "True") Then
hs.setDeviceValueByRef(27, 0, True) 'Arbetsdag Idag
Else
hs.setDeviceValueByRef(27, 1, True) 'Ledig Idag
End If
If ( WorkDay(MyDate.AddDays(1)) = "True") Then
hs.setDeviceValueByRef(28, 0, True) 'Arbetsdag Imorgon
Else
hs.setDeviceValueByRef(28, 1, True) 'Ledig Imorgon
End If
End Sub