|
-
Apr 7th, 2010, 04:53 AM
#2
Re: Date Related Code - Age, Weekdays, Holidays, Julian, etc.
Part 2
Code:
Public Function Friday13(ByVal DatePast As DateTime, _
Optional ByVal DateFuture As DateTime = Nothing) As List(Of String)
'Friday13 - returns a list of months with a Friday the 13th
Dim dp, df, chkDT As DateTime, retval As New List(Of String)
If DateFuture = Nothing Then DateFuture = DatePast 'user wants to know if the month has Friday the 13th
If DatePast > DateFuture Then 'make sure the past is the past
dp = DateFuture
df = DatePast
Else
dp = DatePast
df = DateFuture
End If
'if the first day of a month is sunday then that month will have Friday the 13th
Do While dp <= DateFuture
chkDT = DateSerial(dp.Year, dp.Month, 1)
If chkDT.DayOfWeek = DayOfWeek.Sunday Then
retval.Add(dp.ToString("MMMM yyyy"))
End If
dp = dp.AddMonths(1)
Loop
Return retval
End Function
Public Function Easter(ByVal y As Integer) As DateTime
'VB .Net implementation of:
'http://aa.usno.navy.mil/faq/docs/easter.php
Dim c, d, i, j, k, l, m, n As Integer
c = y \ 100
n = y - 19 * (y \ 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 = y + y \ 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)
Easter = DateSerial(y, m, d)
End Function
Public Function isHoliday(ByVal theDate As DateTime) As String
'check to see if date is a holiday
'returns name if it is, else an empty string
If holidayDates.Count = 0 OrElse holidayDates(0).Year <> theDate.Year Then initHolidays(theDate.Year)
Dim idx As Integer = holidayDates.IndexOf(DateSerial(theDate.Year, theDate.Month, theDate.Day))
If idx <> -1 Then Return holidayNames(idx) Else Return String.Empty
End Function
Public Function ListHolidays(ByVal theDate As DateTime) As List(Of String)
'return a list of holidays
'holiday name,date
'
Dim RetVal As New List(Of String)
If holidayDates.Count = 0 OrElse holidayDates(0).Year <> theDate.Year Then initHolidays(theDate.Year)
For idx As Integer = 0 To holidayDates.Count - 1
RetVal.Add(holidayNames(idx) & "," & holidayDates(idx).ToShortDateString)
Next
Return RetVal
End Function
Public Sub initHolidays(ByVal yr As Integer)
holidayDates.Clear()
Dim eastR As DateTime = Easter(yr)
Dim s() As String, dt As DateTime, parts() As String
For x As Integer = 0 To Holidays.Length - 1
s = Holidays(x).Split(","c)
s(0) = s(0).Trim
s(1) = s(1).Trim
If Not DateTime.TryParse(s(1) & "/" & yr.ToString, dt) Then
parts = s(1).Split("-"c)
Select Case True
Case s(1).StartsWith("*") 'Easter
If parts(0) = "*" Then 'Easter
dt = eastR
Exit Select
Else 'Ash Wednesday, Good Friday, Palm Sunday
parts(0) = parts(0).Replace("*", "")
If parts.Length = 1 Then
dt = (eastR.AddDays(-CDbl(parts(0)))) 'ash wednesday
Else 'Good Friday, Palm Sunday
'day of week before easter
dt = eastR.AddDays(-1)
Do While dt.DayOfWeek.ToString <> parts(1)
dt = dt.AddDays(-1)
Loop
End If
End If
Case s(1).Contains("last-")
'last-DayOfWeek-month
'DayOfWeek = "Monday"
'month = 5
'means last monday of may
dt = DateSerial(yr, Integer.Parse(parts(2)), 1)
dt = DateSerial(dt.Year, dt.Month, DateTime.DaysInMonth(dt.Year, dt.Month))
Do While dt.DayOfWeek.ToString <> parts(1)
dt = dt.AddDays(-1)
Loop
Case s(1).Contains("-")
'z-DayOfWeek-month
'z=1
'DayOfWeek = "Monday"
'month = 9
'means first monday of september
Dim ct As Integer = Integer.Parse(parts(0))
dt = DateSerial(yr, Integer.Parse(parts(2)), 1)
Do
If dt.DayOfWeek.ToString = parts(1) Then ct -= 1
If ct = 0 Then Exit Do
dt = dt.AddDays(1)
If dt.Year <> yr Then Stop
Loop
End Select
End If
holidayDates.Add(DateSerial(dt.Year, dt.Month, dt.Day))
holidayNames.Add(s(0))
Next
End Sub
Public Function GetHolidayDates() As List(Of DateTime)
Return holidayDates
End Function
Public Function GetHolidayNames() As List(Of String)
Return holidayNames
End Function
'Holidays is an array of strings
'the format of each string is:
'"Holiday Name, variable"
'Holiday Name = the name of the Holiday
'variable:
'1)
'mm/dd = the month and day of the holiday
'2)
'z-DayOfWeek-month
'z=1
'DayOfWeek = "Monday"
'month = 9
'means first monday of september - labor day
'3)
'last-DayOfWeek-month
'DayOfWeek = "Monday"
'month = 5
'means last monday of may - memorial day
'4)
'starts with * - related to easter
'* = Easter
'*46 = Ash Wednesday
'*1-Sunday-* = Palm Sunday
'*1-Friday-*
Dim Holidays() As String = New String() {"New Year's Day, 1/1", _
"Martin Luther King Jr. Day, 3-Monday-1", _
"Groundhog Day, 2/2", _
"Valentine's Day, 2/14", _
"Presidents Day, 3-Monday-2", _
"Ash Wednesday, *46", _
"St. Patrick's Day, 3/17", _
"April Fools' Day, 4/1", _
"Palm Sunday, *1-Sunday-*", _
"Good Friday, *1-Friday-*", _
"Easter Sunday, *", _
"Patriot's Day, 3-Monday-4", _
"Earth Day, 4/22", _
"Arbor Day, last-Friday-4", _
"Mother's Day, 2-Sunday-5", _
"Memorial Day, last-Monday-5", _
"Flag Day, 6/14", _
"Father's Day, 3-Sunday-6", _
"Independence Day, 7/4", _
"Labor Day, 1-Monday-9", _
"Columbus Day, 2-Monday-10", _
"Halloween, 10/31", _
"Veterans Day, 11/11", _
"Thanksgiving, 4-Thursday-11", _
"Pearl Harbor Remembrance Day, 12/7", _
"Christmas Eve, 12/24", _
"Christmas Day, 12/25", _
"New Year's Eve, 12/31"}
Dim holidayDates As New List(Of DateTime)
Dim holidayNames As New List(Of String)
'end of routines
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|