edv/ADMIN
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

neu

Browse Source
This commit is contained in:
Andreas Luxbauer
2021-06-24 23:06:47 +02:00
parent 569991b011
commit 2c80644224
22 changed files with 2133 additions and 926 deletions
Download Patch File Download Diff File Expand all files Collapse all files

84
UID/Dienstplan/cFeiertage.vb
View File

@@ -19,7 +19,7 @@
''' <summary>
''' Gibt das Datum für den Ostersonntag zurück.
''' </summary>
Public ReadOnly Property Ostersonntag() As Date
Public ReadOnly Property Ostersonntag_OLD() As Date
Get
If _Ostern.Ticks = 0 Then
' Datum des ersten Vollmondes nach Frühlingsanfang
@@ -48,6 +48,54 @@
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
''' <summary>
''' Gibt das Datum für den Ostermontag zurück.
''' </summary>
@@ -137,8 +185,10 @@
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 = Ostersonntag() Then Return True
If datum = Himmelfahrt Then Return True
If datum = Pfingstmontag Then Return True
If datum = Pfingstsonntag Then Return True
@@ -158,5 +208,35 @@
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

27
UID/Dienstplan/frmDienstplanVariabel.vb
View File

@@ -2328,8 +2328,32 @@ Public Class frmDienstplanVariabel
End Sub
Public Function GetWeekStartDate(weekNumber As Integer, year As Integer) As Date
Dim datum = New DateTime(year, 1, 1)
Dim firstDayOfYear = datum.DayOfWeek
Dim result = datum.AddDays(weekNumber * 7)
If firstDayOfYear = DayOfWeek.Monday Then Return result.Date
If firstDayOfYear = DayOfWeek.Tuesday Then Return result.AddDays(-1).Date
If firstDayOfYear = DayOfWeek.Wednesday Then Return result.AddDays(-2).Date
If firstDayOfYear = DayOfWeek.Thursday Then Return result.AddDays(-3).Date
If firstDayOfYear = DayOfWeek.Friday Then Return result.AddDays(-4).Date
If firstDayOfYear = DayOfWeek.Saturday Then Return result.AddDays(-5).Date
Return result.AddDays(-6).Date
End Function
Private Function GetWeekStartDate(weekNumber As Integer, year As Integer) As Date
'Private Function GetWeekStartDate3(weekNumber As Integer, year As Integer) As Date
' Dim calendar As Calendar = CultureInfo.CurrentCulture.Calendar
' Dim jan1 As DateTime = New DateTime(year, 1, 1)
' Dim daysOffset As Integer = DayOfWeek.Monday - jan1.DayOfWeek
' Dim firstMonday As DateTime = jan1.AddDays(daysOffset)
' Dim firstMondayWeekNum As Integer = calendar.GetWeekOfYear(firstMonday, CalendarWeekRule.FirstFourDayWeek, DayOfWeek.Monday)
' Dim firstWeekDay As DateTime = firstMonday.AddDays((weekNumber - firstMondayWeekNum) * 7)
' Return firstWeekDay
'End Function
Private Function GetWeekStartDate2(weekNumber As Integer, year As Integer) As Date
Dim startDate As New DateTime(year, 1, 1)
Dim weekDate As DateTime = DateAdd(DateInterval.WeekOfYear, weekNumber - 1, startDate)
Return DateAdd(DateInterval.Day, (-weekDate.DayOfWeek) + 1, weekDate)
@@ -2342,6 +2366,7 @@ Public Class frmDienstplanVariabel
aktDate = GetWeekStartDate(txtKW.Text, txtKWYear.Text)
aktWoche = DateToWeek(aktDate).Substring(4, 2)
aktJahr = DateToWeek(aktDate).Substring(0, 4)
initWeekInfo()
initDienstplan()
Me.Cursor = Cursors.Default