<HTML>
<HEAD>
<TITLE>Holidays Calculator</TITLE>
<HTA:APPLICATION
ID="Holidays"
VERSION="2.00"
APPLICATIONNAME="Holidays Calculator"
SYSMENU="yes"
MAXIMIZEBUTTON="yes"
MINIMIZEBUTTON="yes"
BORDER="thin"
INNERBORDER="no"
SCROLL="auto"
SINGLEINSTANCE="yes"
WINDOWSTATE="maximize"
>
</HEAD>
<SCRIPT LANGUAGE="VBScript">
Option Explicit
Dim intVerMsgSize, strCopiedName, strCopyName, strYearName
intVerMsgSize = 0
Function BlameSomeoneElseDay( intYear )
' Find the first Friday the 13th of the specified year: that is Blame Someone Else Day
Dim blnFound, datDate, i, intWeekDay, strDate
BlameSomeoneElseDay = "N/A"
blnFound = False
For i = 1 To 12
strDate = "13 " & MonthName( i ) & " " & intYear
datDate = CDate( strDate )
intWeekDay = DatePart( "w", datDate, vbSunday )
If intWeekDay = 6 Then
If blnFound = False Then
blnFound = True
BlameSomeoneElseDay = CDate( datDate )
End If
End If
Next
End Function
Sub CheckUpdate( )
Dim lenLatestVer, strCurrentVer, strLatestVer
' Change cursor to hourglaß while checking for update
Document.Body.Style.Cursor = "wait"
strLatestVer = TextFromHTML( "http://www.robvanderwoude.com/updates/holidays.txt" )
lenLatestVer = Len( strLatestVer )
If lenLatestVer = 4 Then
strCurrentVer = Split( Holidays.Version )(0)
If strLatestVer < strCurrentVer Then
Update.InnerHTML = "<P>This seems to be an invalid version (" _
& strCurrentVer _
& ") of the " _
& Holidays.ApplicationName _
& " .<BR>The latest valid version (" _
& strLatestVer & ") is available " _
& "<A HREF=""http://www.robvanderwoude.com/" _
& "updates/holidays.html"">" _
& "<FONT COLOR=""Red"">here</FONT></A>.</P>"
intVerMsgSize = 45
End If
If strLatestVer > strCurrentVer Then
Update.InnerHTML = "<P>You are using version " _
& strCurrentVer _
& " of the " _
& Holidays.ApplicationName _
& ".<BR>An update to version " _
& strLatestVer & " is available " _
& "<A HREF=""http://www.robvanderwoude.com/" _
& "updates/holidays.html"">" _
& "<FONT COLOR=""Red"">here</FONT></A>.</P>"
intVerMsgSize = 45
End If
End If
' Change cursor back to default
Document.Body.Style.Cursor = "default"
End Sub
Sub Copy2Clipboard( )
Dim strCopy
strCopy = """" & strYearName & """,""" & MyYear0.InnerHTML _
& """,""" & MyYear1.Value _
& """,""" & MyYear2.InnerHTML _
& """" & vbCrLf & """" _
& NewYearsDayName.InnerHTML & """,""" & NewYearsDay0.Value _
& """,""" & NewYearsDay1.Value _
& """,""" & NewYearsDay2.Value _
& """" & vbCrLf & """" _
& BSEDName.InnerHTML & """,""" & BSED0.Value _
& """,""" & BSED1.Value _
& """,""" & BSED2.Value _
& """" & vbCrLf & """" _
& EasterName.InnerHTML & """,""" & Easter0.Value _
& """,""" & Easter1.Value _
& """,""" & Easter2.Value _
& """" & vbCrLf & """" _
& AscensionName.InnerHTML & """,""" & Ascension0.Value _
& """,""" & Ascension1.Value _
& """,""" & Ascension2.Value _
& """" & vbCrLf & """" _
& PentecostName.InnerHTML & """,""" & Pentecost0.Value _
& """,""" & Pentecost1.Value _
& """,""" & Pentecost2.Value _
& """" & vbCrLf & """" _
& ChristmasName.InnerHTML & """,""" & Christmas0.Value _
& """,""" & Christmas1.Value _
& """,""" & Christmas2.Value _
& """" & vbCrLf
Document.ParentWindow.ClipboardData.SetData "text", strCopy
If Not Err Then
CopyButton.Value = strCopiedName
End If
End Sub
Function Easter( intYear )
Dim D, DD, E, ED, EM, G, L, P, PP, PPP, S, X
' Calculate Easter Day using the instructions found at
' Simon Kershaw's "KEEPING THE FEAST"
' http://www.oremus.org/liturgy/etc/ktf/app/easter.html
G = ( intYear Mod 19 ) + 1
S = ( ( intYear - 1600 ) \ 100 ) - ( ( intYear - 1600 ) \ 400 )
L = ( ( ( intYear - 1400 ) \ 100 ) * 8 ) \ 25
PP = ( 30003 - 11 * G + S - L ) Mod 30
Select Case PP
Case 28
If G > 11 Then P = 27
Case 29
P = 28
Case Else
P = PP
End Select
D = ( intYear + ( intYear \ 4 ) - ( intYear \ 100 ) + ( intYear \ 400 )) Mod 7
DD = ( 8 - D ) Mod 7
PPP = ( 70003 + P ) Mod 7
X = (( 70004 - D - P ) Mod 7 ) + 1
E = P + X
If E < 11 Then
ED = E + 21
EM = MonthName( 3 )
Else
ED = E - 10
EM = MonthName( 4 )
End If
' Return the result
Easter = CDate( ED & " " & EM & " " & intYear )
End Function
Sub HandleYearChange()
Dim datBSED0, datBSED1, datBSED2, datEaster0, datEaster1, datEaster2
MyYear0.InnerHTML = MyYear1.Value - 1
MyYear2.InnerHTML = MyYear1.Value + 1
NewYearsDay0.Value = FormatDateTime( "1 " & MonthName( 1 ) & " " & MyYear0.InnerHTML, vbLongDate )
NewYearsDay1.Value = FormatDateTime( "1 " & MonthName( 1 ) & " " & MyYear1.Value, vbLongDate )
NewYearsDay2.Value = FormatDateTime( "1 " & MonthName( 1 ) & " " & MyYear2.InnerHTML, vbLongDate )
datBSED0 = BlameSomeoneElseDay( MyYear0.InnerHTML )
datBSED1 = BlameSomeoneElseDay( MyYear1.Value )
datBSED2 = BlameSomeoneElseDay( MyYear2.InnerHTML )
BSED0.Value = FormatDateTime( datBSED0, vbLongDate )
BSED1.Value = FormatDateTime( datBSED1, vbLongDate )
BSED2.Value = FormatDateTime( datBSED2, vbLongDate )
datEaster0 = Easter( MyYear0.InnerHTML )
datEaster1 = Easter( MyYear1.Value )
datEaster2 = Easter( MyYear2.InnerHTML )
Easter0.Value = FormatDateTime( datEaster0, vbLongDate )
Easter1.Value = FormatDateTime( datEaster1, vbLongDate )
Easter2.Value = FormatDateTime( datEaster2, vbLongDate )
Ascension0.Value = FormatDateTime( DateAdd( "d", 39, datEaster0 ), vbLongDate )
Ascension1.Value = FormatDateTime( DateAdd( "d", 39, datEaster1 ), vbLongDate )
Ascension2.Value = FormatDateTime( DateAdd( "d", 39, datEaster2 ), vbLongDate )
Pentecost0.Value = FormatDateTime( DateAdd( "d", 49, datEaster0 ), vbLongDate )
Pentecost1.Value = FormatDateTime( DateAdd( "d", 49, datEaster1 ), vbLongDate )
Pentecost2.Value = FormatDateTime( DateAdd( "d", 49, datEaster2 ), vbLongDate )
Christmas0.Value = FormatDateTime( "25 " & MonthName( 12 ) & " " & MyYear0.InnerHTML, vbLongDate )
Christmas1.Value = FormatDateTime( "25 " & MonthName( 12 ) & " " & MyYear1.Value, vbLongDate )
Christmas2.Value = FormatDateTime( "25 " & MonthName( 12 ) & " " & MyYear2.InnerHTML, vbLongDate )
CopyButton.Value = strCopyName
End Sub
Sub Locale( )
Dim strNewYearsDayName, strEasterName, strAscensionName, strPentecostName, strChristmasName
' Translate holiday names based on current locale,
' as returned by the GetLocale( ) function:
'
' Afrikaans 1078
' Albanian 1052
' Arabic - Algeria 5121
' Arabic - Bahrain 15361
' Arabic - Egypt 3073
' Arabic - Iraq 2049
' Arabic - Jordan 11265
' Arabic - Kuwait 13313
' Arabic - Lebanon 12289
' Arabic - Libya 4097
' Arabic - Morocco 6145
' Arabic - Oman 8193
' Arabic - Qatar 16385
' Arabic - Saudi Arabia 1025
' Arabic - Syria 10241
' Arabic - Tunisia 7169
' Arabic - United Arab Emirates 14337
' Arabic - Yemen 9217
' Armenian 1067
' Azeri - Cyrillic 2092
' Azeri - Latin 1068
' Basque 1069
' Belarusian 1059
' Bulgarian 1026
' Catalan 1027
' Chinese - China 2052
' Chinese - Hong Kong S.A.R. 3076
' Chinese - Macau S.A.R. 5124
' Chinese - Singapore 4100
' Chinese - Taiwan 1028
' Croatian 1050
' Czech 1029
' Danish 1030
' Dutch - Belgium 2067
' Dutch - The Netherlands 1043
' English - Australia 3081
' English - Belize 10249
' English - Canada 4105
' English - Carribbean 9225
' English - Ireland 6153
' English - Jamaica 8201
' English - New Zealand 5129
' English - Phillippines 13321
' English - South Africa 7177
' English - Trinidad 11273
' English - United Kingdom 2057
' English - United States 1033
' Estonian 1061
' Far&œlig;se 1080
' Farsi 1065
' Finnish 1035
' French - Belgium 2060
' French - Canada 3084
' French - France 1036
' French - Luxembourg 5132
' French - Switzerland 4108
' Macedonian 1071
' G&ælig;lic - Ireland 2108
' G&ælig;lic - Scotland 1084
' German - Austria 3079
' German - Germany 1031
' German - Liechtenstein 5127
' German - Luxembourg 4103
' German - Switzerland 2055
' Greek 1032
' Hebrew 1037
' Hindi 1081
' Hungarian 1038
' Icelandic 1039
' Indonesian 1057
' Italian - Italy 1040
' Italian - Switzerland 2064
' Japanese 1041
' Korean 1042
' Latvian 1062
' Lithuanian 1063
' Malay - Brunei 2110
' Malay - Malaysia 1086
' Maltese 1082
' Marathi 1102
' Norwegian - Bokm†l 1044
' Norwegian - Nynorsk 2068
' Polish 1045
' Portuguese - Brazil 1046
' Portuguese - Portugal 2070
' R&ælig;to-Romance 1047
' Romanian - Moldova 2072
' Romanian - Romania 1048
' Rußian - Moldova 2073
' Rußian 1049
' Sanskrit 1103
' Serbian - Cyrillic 3098
' Serbian - Latin 2074
' Setsuana 1074
' Slovak 1051
' Slovenian 1060
' Sorbian 1070
' Spanish - Argentina 11274
' Spanish - Bolivia 16394
' Spanish - Chile 13322
' Spanish - Colombia 9226
' Spanish - Costa Rica 5130
' Spanish - Dominican Republic 7178
' Spanish - Ecuador 12298
' Spanish - El Salvador 17418
' Spanish - Guatemala 4106
' Spanish - Honduras 18442
' Spanish - Mexico 2058
' Spanish - Nicaragua 19466
' Spanish - Panama 6154
' Spanish - Paraguay 15370
' Spanish - Peru 10250
' Spanish - Puerto Rico 20490
' Spanish - Spain 1034
' Spanish - Uruguay 14346
' Spanish - Venezuela 8202
' Sutu 1072
' Swahili 1089
' Swedish - Finland 2077
' Swedish - Sweden 1053
' Tamil 1097
' Tatar 1092
' Thai 1054
' Tsonga 1073
' Turkish 1055
' Ukrainian 1058
' Urdu 1056
' Uzbek - Cyrillic 2115
' Uzbek - Latin 1091
' Vietnamese 1066
' Xhosa 1076
' Yiddish 1085
' Zulu 1077
Select Case GetLocale( )
Case 1031, 2055, 3079, 4103, 5127 ' German (Germany, Switzerland, Austria, Luxembourg, Liechtenstein)
strCopyName = "Kopieren"
strCopiedName = "Kopiert"
strYearName = "Jahr"
strNewYearsDayName = "Neujahrstag"
strEasterName = "Ostern"
strAscensionName = "Himmelfahrt"
strPentecostName = "Pfingsten"
strChristmasName = "Weihnachten"
Case 1036, 2060, 3084, 4108, 5132 ' French (France, Belgium, Canada, Switzerland, Luxembourg)
strCopyName = "Copier"
strCopiedName = "CopiÉ"
strYearName = "Année"
strNewYearsDayName = "Jour de l'an"
strEasterName = "Pâques"
strAscensionName = "Ascension"
strPentecostName = "Pentecôte"
strChristmasName = "Noël"
Case 1043, 2067 ' Dutch (Netherlands, Belgium)
strCopyName = "KopiËren"
strCopiedName = "Gekopieerd"
strYearName = "Jaar"
strNewYearsDayName = "Nieuwjaarsdag"
strEasterName = "Pasen"
strAscensionName = "Hemelvaart"
strPentecostName = "Pinksteren"
strChristmasName = "Kerst"
Case Else ' Default: English
strCopyName = "Copy"
strCopiedName = "Copied"
strYearName = "Year"
strNewYearsDayName = "New Year's Day"
strEasterName = "Easter"
strAscensionName = "Ascension"
strPentecostName = "Pentecost"
strChristmasName = "Christmas"
End Select
CopyButton.Value = strCopyName
NewYearsDayName.InnerHTML = strNewYearsDayName
EasterName.InnerHTML = strEasterName
AscensionName.InnerHTML = strAscensionName
PentecostName.InnerHTML = strPentecostName
ChristmasName.InnerHTML = strChristmasName
End Sub
Sub RestoreWindowSize( )
' Disabled error handling to prevent an error
' meßage but no error when the window is
' resized by doubleclicking the title bar
On Error Resume Next
'Window.ResizeTo 900, 450 + intVerMsgSize
WindowSize 900, 450 + intVerMsgSize
On Error Goto 0
End Sub
Function TextFromHTML( URL )
Dim objIE
' Basic routine borrowed from http://dev.remotenetworktechnology.com/wsh/rubegoldberg.htm
' Improved wait-until-ready routine for HTAs by McKirahan on
' http://support.microsoft.com/newsgroups/default.aspx?dg=microsoft.public.scripting.scriptlets&tid=be461ec2-b444-440c-8155-ad0e8e839ca6&lang=en&cr=US&sloc=en-us&p=1
Set objIE = CreateObject( "InternetExplorer.Application" )
objIE.Navigate URL
While objIE.Busy
Wend
TextFromHTML = objIE.Document.Body.InnerText
objIE.Quit
End Function
Sub Window_Onload()
AppName.InnerHTML = Holidays.ApplicationName
AppVersion.InnerHTML = Holidays.Version
RestoreWindowSize
CheckUpdate
RestoreWindowSize
Locale
MyYear1.Value = Year( Now )
HandleYearChange
End Sub
Sub WindowSize( intWidth, intHeight )
On Error Resume Next
Dim posWidth, posHeight
posWidth = ( window.screen.width - intWidth ) / 2
posHeight = ( window.screen.height - intHeight ) / 2
If posWidth < 0 Then posWidth = 0
If posHeight < 0 Then posHeight = 0
window.resizeTo intWidth, intHeight
window.moveTo posWidth, posHeight
On Error GoTo 0
End Sub
</SCRIPT>
<BODY STYLE="font:12 pt arial; color:white; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#0080FF', EndColorStr='#00FFFF')" OnResize="RestoreWindowSize()">
<DIV ALIGN="Center">
<SPAN ID="Update"> </SPAN>
<TABLE BORDER="0" CELLSPACING="5">
<TR>
<TD><INPUT TYPE="Button" ID="CopyButton" VALUE="Clipboard" OnClick="Copy2Clipboard()"></TD>
<TH><SPAN ID="MyYear0">2006</SPAN></TH>
<TH><SELECT OnChange="HandleYearChange()" NAME="MyYear1">
<OPTION VALUE="2000">2000</OPTION>
<OPTION VALUE="2001">2001</OPTION>
<OPTION VALUE="2002">2002</OPTION>
<OPTION VALUE="2003">2003</OPTION>
<OPTION VALUE="2004">2004</OPTION>
<OPTION VALUE="2005">2005</OPTION>
<OPTION VALUE="2006">2006</OPTION>
<OPTION VALUE="2007">2007</OPTION>
<OPTION VALUE="2008">2008</OPTION>
<OPTION VALUE="2009">2009</OPTION>
<OPTION VALUE="2010">2010</OPTION>
<OPTION VALUE="2011">2011</OPTION>
<OPTION VALUE="2012">2012</OPTION>
<OPTION VALUE="2013">2013</OPTION>
<OPTION VALUE="2014">2014</OPTION>
<OPTION VALUE="2015">2015</OPTION>
<OPTION VALUE="2016">2016</OPTION>
<OPTION VALUE="2017">2017</OPTION>
<OPTION VALUE="2018">2018</OPTION>
<OPTION VALUE="2019">2019</OPTION>
<OPTION VALUE="2020">2020</OPTION>
<OPTION VALUE="2021">2021</OPTION>
<OPTION VALUE="2022">2022</OPTION>
<OPTION VALUE="2023">2023</OPTION>
<OPTION VALUE="2024">2024</OPTION>
<OPTION VALUE="2025">2025</OPTION>
<OPTION VALUE="2026">2026</OPTION>
<OPTION VALUE="2027">2027</OPTION>
<OPTION VALUE="2028">2028</OPTION>
<OPTION VALUE="2029">2029</OPTION>
<OPTION VALUE="2030">2030</OPTION>
</SELECT></TH>
<TH><SPAN ID="MyYear2">2008</SPAN></TH>
</TR>
<TR>
<TD COLSPAN="4"> </TD>
</TR>
<TR>
<TD><SPAN ID="NewYearsDayName">New Year's Day</SPAN>:</TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="NewYearsDay0"></TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="NewYearsDay1"></TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="NewYearsDay2"></TD>
</TR>
<TR>
<TD TITLE="USA only: the first Friday 13th of the year">Blame Someone Else Day:</TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="BSED0"></TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="BSED1"></TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="BSED2"></TD>
</TR>
<TR>
<TD><SPAN ID="EasterName">Easter</SPAN>:</TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="Easter0"></TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="Easter1"></TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="Easter2"></TD>
</TR>
<TR>
<TD><SPAN ID="AscensionName">Ascension</SPAN>:</TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="Ascension0"></TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="Ascension1"></TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="Ascension2"></TD>
</TR>
<TR>
<TD><SPAN ID="PentecostName">Pentecost</SPAN>:</TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="Pentecost0"></TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="Pentecost1"></TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="Pentecost2"></TD>
</TR>
<TR>
<TD><SPAN ID="ChristmasName">Christmas:</TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="Christmas0"></TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="Christmas1"></TD>
<TD><INPUT TYPE="text" SIZE="30" READONLY NAME="Christmas2"></TD>
</TR>
</TABLE>
<P> </P>
<P><B><SPAN ID="AppName">Application Name</SPAN>, Version <SPAN ID="AppVersion">0.00</SPAN><BR>
<FONT SIZE="-1">© 2010, Rob van der Woude<BR>
<A HREF="http://www.robvanderwoude.com/" TARGET="_blank"><FONT COLOR="Red">http://www.robvanderwoude.com</FONT></A></FONT></B></P>
</DIV>
</BODY>
</HTML>
visitors must be on to something... |
|
page last uploaded:
6 June 2010, 17:33 |