Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for caldemo.hta

(view source code of caldemo.hta as plain text) 

  1. <HTML xmlns:IE>
  2. <HEAD>
  3.  
  4. <TITLE>Calendar Demo</TITLE>
  5.  
  6. <HTA:APPLICATION 
  7. 	ID="CalendarDemo"
  8. 	VERSION="1.01"
  9. 	APPLICATIONNAME="Calendar Demo"
  10. 	SYSMENU="yes"
  11. 	MAXIMIZEBUTTON="yes"
  12. 	MINIMIZEBUTTON="yes"
  13. 	BORDER="thin"
  14. 	INNERBORDER="thin"
  15. 	SCROLL="auto"
  16. 	SINGLEINSTANCE="yes"
  17. 	WINDOWSTATE="maximize"
  18. >
  19.  
  20. <STYLE>
  21. @media all 
  22. {
  23. 	IE\:Calendar { behavior : url(calendar.htc) }
  24. 	a            { color    : cyan              }
  25. 	a:active     { color    : red               }
  26. 	a:hover      { color    : yellow            }
  27. }
  1. </STYLE>
  2.  
  3. </HEAD>
  4.  
  5. <SCRIPT LANGUAGE="VBScript">
  1. Option Explicit
  2.  
  3. Dim numVerMsgSize, strAppName, strAppVer, strFileNames
  4.  
  5. strAppName   = CalendarDemo.ApplicationName
  6. strAppVer    = CalendarDemo.Version
  7. strFileNames = "caldemo"
  8.  
  9.  
  10. Sub Calendar_OnPropertyChange( )
  11. 	Dim strDate
  12.  
  13. 	' Read the selected date from the calendar control
  14. 	strDate = CDate( Calendar.Day & " " _
  15. 	        & MonthName( Calendar.Month ) & " " _
  16. 	        & Calendar.Year )
  17.  
  18. 	' Fill in the fields below the calendar control for the selected date
  19. 	myLongDate.Value        = FormatDateTime( strDate, vbLongDate )
  20. 	myShortDate.Value       = FormatDateTime( strDate, vbShortDate )
  21. 	myDayOfWeekName.Value   = WeekDayName( DatePart( "w", strDate ) )
  22. 	myMonthName.Value       = MonthName( DatePart( "m", strDate ) )
  23. 	myDayOfMonth.Value      = DatePart( "d",    strDate )
  24. 	myDayOfYear.Value       = DatePart( "y",    strDate )
  25. 	myMonthNumber.Value     = DatePart( "m",    strDate )
  26. 	myYear.Value            = DatePart( "yyyy", strDate )
  27. 	myQuarter.Value         = DatePart( "q",    strDate )
  28. 	myWeek.Value            = DatePart( "ww",   strDate )
  29. 	myDayOfWeekNumber.Value = DatePart( "w",    strDate )
  30. End Sub
  31.  
  32.  
  33. Sub CheckUpdate( )
  34. 	Dim lenLatestVer, strCurrentVer, strLatestVer
  35.  
  36. 	' Change cursor to hourglass while checking for update
  37. 	Document.Body.Style.Cursor = "wait"
  38.  
  39. 	strLatestVer  = TextFromHTML( "http://www.robvanderwoude.com/updates/" & strFileNames & ".txt" )
  40. 	lenLatestVer  = Len( strLatestVer )
  41. 	If lenLatestVer = 4 Then
  42. 		strCurrentVer = Split( strAppVer )(0)
  43. 		If strLatestVer < strCurrentVer Then
  44. 			Update.InnerHTML = "<P>You are using an invalid version (" & strCurrentVer _
  45. 			                 & ") of the " & strAppName _
  46. 			                 & ".<BR>The latest valid version is "    _
  47. 			                 & strLatestVer & " and it is available " _
  48. 			                 & "<A HREF=""http://www.robvanderwoude.com/updates/" _
  49. 			                 & strFileNames & ".html"">" _
  50. 			                 & "<FONT COLOR=""Red"">here</FONT></A>.</P>"
  51. 			numVerMsgSize    = 85
  52. 		End If
  53. 		If strLatestVer > strCurrentVer Then
  54. 			Update.InnerHTML = "<P>You are using version " & strCurrentVer _
  55. 			                 & " of the " & strAppName _
  56. 			                 & ".<BR>An update to version " _
  57. 			                 & strLatestVer & " is available " _
  58. 			                 & "<A HREF=""http://www.robvanderwoude.com/updates/" _
  59. 			                 & strFileNames & ".html"">" _
  60. 			                 & "<FONT COLOR=""Red"">here</FONT></A>.</P>"
  61. 			numVerMsgSize    = 85
  62. 		End If
  63. 	End If
  64.  
  65. 	' Change cursor back to default
  66. 	Document.Body.Style.Cursor = "default"
  67. End Sub
  68.  
  69.  
  70. Sub TodayButton_OnClick( )
  71. 	Calendar.Year  = DatePart( "yyyy", Now )
  72. 	Calendar.Month = DatePart( "m",    Now )
  73. 	Calendar.Day   = DatePart( "d",    Now )
  74. End Sub
  75.  
  76.  
  77. Function TextFromHTML( myURL )
  78. 	' Basic routine borrowed from http://dev.remotenetworktechnology.com/wsh/rubegoldberg.htm
  79. 	' Improved wait-until-ready routine for HTAs by McKirahan on
  80. 	' 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
  81.  
  82. 	Dim objIE
  83.  
  84. 	' Set the default value
  85. 	TextFromHTML = ""
  86.  
  87. 	' Temporarily disable error handling
  88. 	On Error Resume Next
  89.  
  90. 	' Create an IE object
  91. 	Set objIE = CreateObject( "InternetExplorer.Application" )
  92.  
  93. 	' Load the requested URL
  94.  	objIE.Navigate myURL
  95.  
  96. 	' Wait for the requested URL to become available
  97. 	While objIE.Busy
  98. 	Wend
  99.  
  100. 	' Retrieve the body text
  101. 	TextFromHTML = objIE.Document.Body.InnerText
  102.  
  103. 	' Release the object and return to default error handling
  104. 	On Error Goto 0
  105. 	objIE.Quit
  106. End Function
  107.  
  108.  
  109. Sub Window_OnLoad( )
  110. 	Dim strMsg
  111.  
  112. 	strMsg = "<P>The Calendar HTML Component was not found.</P>" _
  113. 	       & "<P>Please download and extract Microsoft's " _
  114. 	       & "<A HREF=""http://www.microsoft.com/downloads/" _
  115. 	       & "details.aspx?FamilyId=" _
  116. 	       & "E50D0D0C-279D-4B78-81CD-B106EBE65C36"">" _
  117. 	       & "Calendar sample files</A>.<BR>" & vbCrLf _
  118. 	       & "Then run this HTA in the directory where " _
  119. 	       & "<I>calendar.htc</I> is located.</P>"
  120.  
  121. 	' Fill in the proper application name and
  122. 	' version number at the bottom of the screen
  123. 	AppName.InnerHTML    = strAppName
  124. 	AppVersion.InnerHTML = strAppVer
  125.  
  126. 	' Use custom error handling; after all, we cannot be sure the
  127. 	' required HTML component is available in the right location
  128. 	On Error Resume Next
  129.  
  130. 	' Set some of the calendar control's properties
  131. 	Calendar.DayLength         = "long"
  132. 	Calendar.MonthLength       = "long"
  133. 	Calendar.ShowDateSelectors = 1
  134. 	Calendar.ShowDays          = 1
  135. 	Calendar.ShowTitle         = 1
  136.  
  137. 	' Fill in the date fields below the calendar control
  138. 	Calendar_OnPropertyChange( )
  139.  
  140. 	' If an error occurred, we may assume the calendar control isn't
  141. 	' available; in that case, display an error message and point the
  142. 	' user to the download location
  143. 	If Err Then
  144. 		Err.Clear
  145. 		CalendarSpace.InnerHTML = strMsg
  146. 	End If
  147. 	On Error Goto 0
  148.  
  149. 	' Check for updates
  150. 	CheckUpdate
  151. End Sub
  1. </SCRIPT>
  2.  
  3. <BODY STYLE="font:12 pt arial; color:white; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#000040', EndColorStr='#00007F')">
  4.  
  5. <DIV ALIGN="center">
  6.  
  7. <H1>Calendar Demo</H1>
  8.  
  9. <HR>
  10.  
  11. <P>&nbsp;</P>
  12.  
  13. <SPAN ID="CalendarSpace">
  14.  
  15. <IE:Calendar id="Calendar" style="width : 300; height : 275; border : 1px solid black;"></IE:Calendar>
  16.  
  17. <SPAN ID="Update">&nbsp;</SPAN>
  18.  
  19. <P>&nbsp;</P>
  20.  
  21. <TABLE BORDER="0" CELLPADDING="2">
  22. <TR>
  23.     <TD>Date (short / long)</TD>
  24.     <TD><INPUT ID="myShortDate" TYPE="text" SIZE="10" READONLY></TD>
  25.     <TD><INPUT ID="myLongDate" TYPE="text" SIZE="32" READONLY></TD>
  26. </TR>
  27. <TR>
  28.     <TD>Day of week (number / name)</TD>
  29.     <TD><INPUT ID="myDayOfWeekNumber" TYPE="text" SIZE="10" READONLY></TD>
  30.     <TD><INPUT ID="myDayOfWeekName" TYPE="text" SIZE="32" READONLY></TD>
  31. </TR>
  32. <TR>
  33.     <TD>Day of month / Day of year</TD>
  34.     <TD><INPUT ID="myDayOfMonth" TYPE="text" SIZE="10" READONLY></TD>
  35.     <TD><INPUT ID="myDayOfYear" TYPE="text" SIZE="32" READONLY></TD>
  36. </TR>
  37. <TR>
  38.     <TD>Month (number / name)</TD>
  39.     <TD><INPUT ID="myMonthNumber" TYPE="text" SIZE="10" READONLY></TD>
  40.     <TD><INPUT ID="myMonthName" TYPE="text" SIZE="32" READONLY></TD>
  41. </TR>
  42. <TR>
  43.     <TD>Week / Quarter</TD>
  44.     <TD><INPUT ID="myWeek" TYPE="text" SIZE="10" READONLY></TD>
  45.     <TD><INPUT ID="myQuarter" TYPE="text" SIZE="32" READONLY></TD>
  46. </TR>
  47. <TR>
  48.     <TD>Year</TD>
  49.     <TD><INPUT ID="myYear" TYPE="text" SIZE="10" READONLY></TD>
  50.     <TD ALIGN="center"><INPUT ID="TodayButton" TYPE="button" VALUE="   Today   "></TD>
  51. </TR>
  52. </TABLE>
  53.  
  54. </SPAN>
  55.  
  56. <P>&nbsp;</P>
  57.  
  58. <HR>
  59.  
  60. <P><FONT FACE="MS SANS SERIF" SIZE="1">
  61. <SPAN ID="AppName">Application Name</SPAN>,&nbsp;
  62. Version <SPAN ID="AppVersion">0.00</SPAN>,&nbsp;
  63. &copy; 2008
  64. <A HREF="http://www.robvanderwoude.com/">Rob van der Woude</A>.<BR>
  65. Calendar HTML Component&nbsp; &copy; 2000
  66. <A HREF="http://www.microsoft.com/">Microsoft Corporation</A>.<BR>
  67. Download the
  68. <A HREF="http://www.microsoft.com/downloads/details.aspx?FamilyId=E50D0D0C-279D-4B78-81CD-B106EBE65C36">HTML
  69. Component &amp; sample files</A>.
  70. </FONT></P>
  71.  
  72. </DIV>
  73.  
  74. </BODY>
  75. </HTML>

page last modified: 2025-10-11; loaded in 0.0149 seconds