<HTML>
<HEAD>
<TITLE>
Select A Date
</TITLE>
<STYLE TYPE="text/css">
<!--
.MainTbl {border-left: 1px black solid; border-top: 1px black solid; border-right: 1px black solid; border-bottom: 1px black solid;}
.TD {Font-family:tahoma, Arial, Verdana; font-weight:400; font-size: 8pt; color:#000000;}
.INPUTComb {Font-family:tahoma, Arial, Verdana; font-weight:400; font-size: 7pt; color:#000000;}
.CalDay {Font-family:tahoma, Arial, Verdana; font-weight:600; font-size: 8pt; color:#0000a0; text-align: center; width:25px; height:20px; background-color: #D5D1C8; border-left: 1px black offset; border-top: 1px black offset; border-right: 1px black inset; border-bottom: 1px black inset; cursor:hand}
.CalDayToday {Font-family:tahoma, Arial, Verdana; font-weight:600; font-size: 8pt; color:#0000a0; text-align: center; width:25px; height:20px; background-color: #97F28A; border-left: 1px black offset; border-top: 1px black offset; border-right: 1px black inset; border-bottom: 1px black inset; cursor:hand}
.OffCalDay {Font-family:tahoma, Arial, Verdana; font-weight:600; font-size: 7pt; color:buttonshadow; text-align: center; width:25px; height:20px; background-color: menu; border-left: 1px black offset; border-top: 1px blackoffset; border-right: 1px black inset; border-bottom: 1px black inset; cursor:hand}
.Days {Font-family:Verdana,tahoma,Arial; font-weight:bold; font-size: 8pt; color:black; text-align: center;border-left: 2px black solid; border-top: 2px black solid; border-right: 2px black solid; border-bottom: 2px black solid;}
.NoDay {Font-family:tahoma, Arial, Verdana; font-weight:600; font-size: 8pt; color:#0000a0; text-align: center; width:25px; height:20px; }
.INPUTBUTTON {Font-family:Tahoma, Verdana, Arial; font-weight:400; font-size: 8pt; color:#0000a0; background-color: #D5D1C8; border-left: 1px #ffffff solid; border-top: 1px #ffffff solid; border-right: 1px #000000 solid; border-bottom: 1px #000000 solid; cursor:hand}
A:link {Font-family: Tahoma, Arial, Verdana; Font-size: 12pt; Font-weight: 600; color: #000000; text-decoration: none;}
A:active {Font-family: Tahoma, Arial, Verdana; Font-size: 12pt; Font-weight: 600; color: #000000; text-decoration: none;}
A:visited {Font-family: Tahoma, Arial, Verdana; Font-size: 12pt; Font-weight: 600; color: #000000; text-decoration: none;}
A:hover {Font-family: Tahoma, Arial, Verdana; Font-size: 12pt; Font-weight: 600; color: #00cc00; text-decoration: none;}
-->
</STYLE>
<SCRIPT LANGUAGE="VBScript" SRC="Scriptlets.vbs"></SCRIPT>
<SCRIPT Language=vbscript>
Option Explicit
Dim qsDate,strCal,TheDate,i,strFormatDate,thisDate
Dim strThisIsChecked,strSelectedOption
Dim American_lcid,Australian_lcid
Dim curLocale,newLocale,strNewLocale
Dim blnReload,strReDraw,objMonth
Dim StrLocaleInfo,x,TodaysDate,UseLocale
'********************************
'These are values you can set to FORCE functionality (optional).
'********************************
'This constant allows you to set wether or not they can choose what format the date is returned.
'1)Full date: Wednesday 12, 2003 2)Long date: MM/DD/YYYY 3) Short date: MM/DD/YY
CONST cFORMATDATE = true
'If you want to restict the use of a SPECIFIC local regardless of the users local regional settings set cFORCELOCALE = true.
'If cFORCELOCALE = true then the value of cLOCALE will be used as the Locale
'i.e. - If their local settings are French, but you want to REQUIRE the English local settings.
CONST cFORCELOCALE = true
CONST cLOCALE = 1033
'Color and font schemes can be set in the .css file
'********************************
'Here we start our process
'********************************
Sub StartMe
dim strThisisit,objMonthNow
'Get the current locale and save it for later
curLocale= GetLocale()
UseLocale= GetLocale()
If cFORCELOCALE Then
SetLocale(cLOCALE)
UseLocale = cLOCALE
End If
'Here we build a string to show the locale
For x = 0 to Ubound(MyArray,2)
If cStr(MyArray(1,x)) = cStr(UseLocale) Then
StrLocaleInfo = "Locale: " & MyArray(0,x) & " (" & MyArray(1,x) & ")"
exit for
Else
StrLocaleInfo = "Unknown Locale"
End If
Next
'Set the Local to English
document.all("startmonth").value = DatePart("m",Date)
document.all("CurrDate").value = Date
Call DrawCalendarMonth(Date)
If cFORCELOCALE Then
document.all("spnLocale").innerhtml = StrLocaleInfo
Else
document.all("spnLocale").innerhtml = StrLocaleInfo
End If
End Sub
'********************************
'Set the new date
'********************************
Sub GetItOn(objMe)
Dim NewDate,Year1,Year2,NewYear,Month1,Month2,NewMonth
NewDate = cDate(document.all("CurrDate").value)
If objMe.name = "cYear" Then
Year1 = objMe.value
Year2 = Year(NewDate)
NewYear = Year1 - Year2
NewDate = DateAdd("yyyy",NewYear,NewDate)
ElseIf objMe.name = "cMonth" Then
Month1 = objMe.value
Month2 = Month(NewDate)
NewMonth = Month1 - Month2
NewDate = DateAdd("m",NewMonth,NewDate)
ElseIf objMe.name = "prev" Then 'Month
NewDate = DateAdd("m",-1,NewDate)
ElseIf objMe.name = "prev2" Then 'Year
NewDate = DateAdd("yyyy",-1,NewDate)
ElseIf objMe.name = "next" Then 'Year
NewDate = DateAdd("yyyy",1,NewDate)
ElseIf objMe.name = "next2" Then 'Month
NewDate = DateAdd("m",1,NewDate)
Else
End If
document.all("CurrDate").value = NewDate
'msgbox objMe.name & " - " & NewDate
Call DrawCalendarMonth(NewDate)
End Sub
Sub window_onunload()
SetLocale(curLocale)
End sub
'********************************
'Return the date
'********************************
Sub ReturnMe(objMe)
Dim A,B,C,D,E,F,G,arrDate
A = ObjMe.name ' Day
B = chkDate.value ' What to Do
C = document.all("cMonth").value ' Month
D = document.all("cYear").value ' Year
E = C & "/" & A & "/" & D
E = cDate(E)
Select Case B
Case 0 'full
F = FormatDateTime(E,1)
Case 1,2
SetLocale(curLocale)
F = FormatDateTime(E,2)
F = cDate(F)
End Select
G = cstr(F)
If B = 0 Then
window.returnvalue = F
Else
arrDate = split(G,"/")
If Len(arrDate(0)) < 2 Then
arrDate(0) = "0" & arrDate(0)
end If
If Len(arrDate(1)) < 2 Then
arrDate(1) = "0" & arrDate(1)
end If
If B = 1 Then 'long
arrDate(2) = DatePart("yyyy",F)
Else 'short
If Len(arrDate(2))=4 Then
arrDate(2) = Right(arrDate(2),2)
Else
arrDate(2) = arrDate(2)
End If
End If
window.returnvalue = arrDate(0) & "/" & arrDate(1) & "/" & arrDate(2)
End If
window.close
end sub
'********************************
'Draw te Calendar
'********************************
Sub DrawCalendarMonth(theDate)
dim thisMonthFirstDay
dim nextMonthFirstDay
dim thisMonthLastDay
dim lastMonthLastDay
dim calBeginDate
dim counter
'Set the Date variables
Dim ThisDay
ThisDay = (day(theDate) * -1) + 1
thisMonthFirstDay=dateAdd("d",ThisDay,theDate)
nextMonthFirstDay=dateAdd("m",1,thisMonthFirstDay)
thisMonthLastDay=dateadd("d",-1,nextMonthFirstDay)
lastMonthLastDay=dateadd("d",-1,thisMonthFirstDay)
calBeginDate=dateadd("d",1-weekday(thisMonthFirstDay),thisMonthFirstDay)
'Start the Border Table
strCal ="<center><table cellspacing=0 border=0 cellpadding=0>" & vbcrlf
strCal = strCal & " <tr>" & vbcrlf
strCal = strCal & " <td width=240>" & vbcrlf
'Start the Calendar Table
strCal = strCal & " <table width=240 bordercolor=white border=1 style=""border-collapse:collapse"">" & vbcrlf
strCal = strCal & " <tr bgcolor=white>" & vbcrlf
strCal = strCal & " <td colspan=3 align=center><font face=verdana, arial size=2><b>" & Monthname(month(theDate),true) & " " & right(year(theDate),4) & "</b></font></td>" & vbcrlf
strCal = strCal & " <td colspan=4>"
strCal = strCal & " <SELECT class=""INPUTComb"" onChange=""vbScript:Call GetItOn(Me)"" id=""cMonth"" name=""cMonth"">"
'Create the Months
For i = 1 to 12
strCal = strCal & "<OPTION Value=" & i
If i = cdbl(month(theDate)) then
strCal = strCal & " selected "
Else
End if
strCal = strCal & ">" & monthname(i) & "</OPTION>"
Next
strCal = strCal & "</SELECT>"
strCal = strCal & "<SELECT class=""INPUTComb"" onChange=""vbScript:Call GetItOn(Me)"" id=""cYear"" name=""cYear"">"
'Create the Years.
For i = 2099 to 2000 step -1
strCal = strCal & "<OPTION Value=" & i
If i = cint(right(year(theDate),4)) then
strCal = strCal & " selected "
Else
End if
strCal = strCal & ">" & i & "</OPTION>"
Next
strCal = strCal & "</SELECT>"
strCal = strCal & "</td>" & vbcrlf
strCal = strCal & "</tr>" & vbcrlf
strCal = strCal & " <tr bgcolor=#BED09E>" & vbcrlf
strCal = strCal & " <td width=""14.28%"" align=center class=Days>Su</td>" & vbcrlf
strCal = strCal & " <td width=""14.28%"" align=center class=Days>Mo</td>" & vbcrlf
strCal = strCal & " <td width=""14.28%"" align=center class=Days>Tu</td>" & vbcrlf
strCal = strCal & " <td width=""14.28%"" align=center class=Days>We</td>" & vbcrlf
strCal = strCal & " <td width=""14.28%"" align=center class=Days>Th</td>" & vbcrlf
strCal = strCal & " <td width=""14.28%"" align=center class=Days>Fr</td>" & vbcrlf
strCal = strCal & " <td width=""14.28%"" align=center class=Days>Sa</td>" & vbcrlf
strCal = strCal & " </tr>" & vbcrlf
'Start the First Row of Days
strCal = strCal & " <tr>" & vbcrlf
dim x
x=0
' If the First day of the month is not Sunday, draw previous month's ending days
if weekday(thisMonthFirstDay)>1 then
x=x+1
For counter = day(calBeginDate) to day(lastMonthLastDay)
DrawOtherDay (counter)
Next
end if
' Draw each day of the specified month. After each Saturday, end the row & start a new one
For Counter=1 to day(thisMonthLastDay)
Call DrawNormalDay (counter,theDate)
Dim ThisDay2,ThisDay3,ThisDay4
ThisDay2 = (day(theDate) * -1) +1
ThisDay3 = dateAdd("d",ThisDay2,theDate)
ThisDay4 = dateAdd("d",counter-1,ThisDay3)
If weekday(cDate(ThisDay4)) = 7 then
'If weekday(cDate(month(theDate) & "/" & counter & "/" & year(theDate))) = 7 then
x=x+1
strCal = strCal & " </tr>" & vbcrlf
strCal = strCal & " <tr>" & vbcrlf
End if
ThisDay2 = ""
Next
' If the Last day of the month is not Saturday, draw next month's beginning days
If weekday(thisMonthLastDay)<7 then
x=x+1
For counter = 1 to 7-weekday(thisMonthLastDay)
DrawOtherDay (counter)
Next
End If
'End the Last Row and the Calendar
strCal = strCal & " </tr>" & vbcrlf
If x < 7 then
'If weekday( month(qsDate) & "/" & day(thisMonthLastDay) & "/" & year(qsDate) ) =7 Then
'Else
strCal = strCal & " <tr><td class=NoDay> </td><td></td><td></td><td></td><td></td><td></td><td></td></tr>" & vbcrlf
'End IF
End If
If cFORMATDATE = TRUE THEN
If document.all("chkDate").value <> "" Then
strSelectedOption = document.all("chkDate").value
Else
strSelectedOption = 1
End If
strFormatDate = "<SELECT name=chkLongDay id=chkLongDay style=""width:110;font-family:verdana;font-size:9px;"" onChange=""vbScript:Call ChangeDateType(Me)"">"
strFormatDate = strFormatDate & "<OPTION value=0 " & SelectedText(strSelectedOption,0) & ">Full Date</OPTION>"
strFormatDate = strFormatDate & "<OPTION value=1 " & SelectedText(strSelectedOption,1) & ">Long Date (yyyy)</OPTION>"
strFormatDate = strFormatDate & "<OPTION value=2 " & SelectedText(strSelectedOption,2) & ">Short Date (yy)</OPTION>"
strFormatDate = strFormatDate & "</SELECT>"
END IF
strCal = strCal & " <tr bgcolor=white valign=top>" & vbcrlf
strCal = strCal & " <td style=""cursor:hand;"" onmouseover=""me.style.backgroundColor='white'"" onmouseout=""me.style.backgroundColor=''"" align=center><font style=""font-family:webdings;font-size:16px;"" id=prev2 name=prev2 onclick=""vbScript:Call GetItOn(Me)"">7</font></td>" & vbcrlf
strCal = strCal & " <td style=""cursor:hand;"" onmouseover=""me.style.backgroundColor='white'"" onmouseout=""me.style.backgroundColor=''"" align=center><font style=""font-family:webdings;font-size:16px;"" id=prev name=prev onclick=""vbScript:Call GetItOn(Me)"">3</font></td>" & vbcrlf
strCal = strCal & " <td colspan=3 align=center>" & strFormatDate & "</td>" & vbcrlf
strCal = strCal & " <td style=""cursor:hand;"" onmouseover=""me.style.backgroundColor='white'"" onmouseout=""me.style.backgroundColor=''"" align=center><font style=""font-family:webdings;font-size:16px;"" id=next2 name=next2 onclick=""vbScript:Call GetItOn(Me)"" >4</font></td>" & vbcrlf
strCal = strCal & " <td style=""cursor:hand;"" onmouseover=""me.style.backgroundColor='white'"" onmouseout=""me.style.backgroundColor=''"" align=center><font style=""font-family:webdings;font-size:16px;"" id=next name=next onclick=""vbScript:Call GetItOn(Me)"">8</font></td>" & vbcrlf
strCal = strCal & " </tr>" & vbcrlf
strCal = strCal & " <tr><td colspan=7 align=center><span style=""font-family:verdana;font-size:9px;"" name=spnLocale id=spnLocale>" & StrLocaleInfo & "</span></td></tr>"
strCal = strCal & " </table>" & vbcrlf
'Close the Border Table
strCal = strCal & " </td>" & vbcrlf
strCal = strCal & "</table>" & vbcrlf
document.all("calendar").innerhtml = strCal
x=0
end sub
Sub ChangeDateType(objMe)
document.all("chkDate").value = objMe.value
End Sub
Function SelectedText(val1,val2)
If cint(val1) = cInt(val2) Then
SelectedText = " SELECTED "
Else
SelectedText = " "
End If
End Function
Sub DrawNormalDay(DayNumber,Today)
Dim strStyle,strStyleMouseOut
' Draws a day cell - date is in current month
If cStr(Month(Today)) = cStr(Month(Date)) AND cStr(Year(Today)) = cStr(Year(Date)) AND cStr(Day(Today)) = cStr(DayNumber) Then
strStyle = "CalDayToday"
strStyleMouseOut = "#97F28A"
Else
strStyle="CalDay"
strStyleMouseOut = "#D5D1C8"
End If
strCal = strCal & "<td name=" & DayNumber & " id=" & DayNumber & " onclick=""vbScript:Call ReturnMe(Me)"" class=" & strStyle & " onmouseover=""me.style.backgroundColor='gold'"" "
strCal = strCal & "onmouseout=""me.style.backgroundColor='" & strStyleMouseOut & "'""> "
strCal = strCal & DayNumber & "</td>" & vbcrlf
End Sub
Sub DrawOtherDay(DayNumber)
' Draws a day cell - date is in previous or next month
' The response.write's are separate lines for clarity only
strCal = strCal & "<td class=OffCalDay name=" & DayNumber & " id=" & DayNumber & ">" & DayNumber & "</td>" & vbcrlf
End Sub
</SCRIPT>
</HEAD>
<BODY>
<DIV NAME=calendar ID=calendar></DIV>
<input type=text name=chkDate id=chkDate value="1">
<input type=text name=startmonth id=startmonth>
<input type=text name=CurrDate id=CurrDate>
<SCRIPT Language="vbscript">
Call StartMe
</SCRIPT>
</BODY>
<HEAD>
<META HTTP-EQUIV="PRAGMA" CONTENT="NO-CACHE">
</HEAD>
</HTML>