Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for romans.hta

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

  1. <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
  2. <html lang="en">
  3. <head>
  4.  
  5. <title>Roman Numerals Convertor</title>
  6.  
  7. <HTA:APPLICATION 
  8.      ID="Romans"
  9.      VERSION="2.00"
  10.      APPLICATIONNAME="Romans"
  11.      CONTEXTMENU="no"
  12.      SCROLL="no"
  13.      SINGLEINSTANCE="yes"
  14.      WINDOWSTATE="maximize"
  15. >
  16.  
  17. <style type="text/css">
  1. a, a:visited
  2. {
  3. 	color: blue;
  4. }
  5.  
  6. a:hover
  7. {
  8. 	color: yellow;
  9. }
  10.  
  11. body
  12. {
  13. 	color: white;
  14. 	background-color: #FFA000;
  15. 	font-family: arial, sans-serif;
  16. 	font-size: 12pt;
  17. 	margin: 0;
  18. 	padding: 0;
  19. 	filter: progid:DXImageTransform.Microsoft.Gradient(GradientType=0,StartColorStr='#FF0000',EndColorStr='#FFA000')
  20. }
  21.  
  22. p
  23. {
  24. 	font-size: 80%;
  25. }
  26.  
  27. td
  28. {
  29. 	text-align: left;
  30. }
  31.  
  32. .Center
  33. {
  34. 	margin-left: auto;
  35. 	margin-right: auto;
  36. 	text-align: center;
  37. }
  38.  
  39. .Red
  40. {
  41. 	color: red;
  42. }
  43.  
  44. .UpperCase
  45. {
  46. 	text-transform: uppercase;
  47. }
  48.  
  49. .White
  50. {
  51. 	color: white;
  52. }
  1. </style>
  2.  
  3. </head>
  4.  
  5. <script language="VBScript">
  1.  
  2. Option Explicit
  3.  
  4. Dim intHeight, intWidth, objIE
  5.  
  6.  
  7. Sub CheckUpdate( )
  8. 	' Some housekeeping
  9. 	Dim lenLatestVer, strCurrentVer, strLatestVer
  10.  
  11. 	' Change cursor to hourglass while checking for update
  12. 	document.body.style.cursor = "wait"
  13.  
  14. 	strLatestVer  = TextFromHTML( "http://www.robvanderwoude.com/updates/romans.txt" )
  15. 	lenLatestVer  = Len( strLatestVer )
  16. 	If lenLatestVer = 4 Then
  17. 		strCurrentVer = Split( Romans.Version )(0)
  18. 		If strLatestVer < strCurrentVer Then
  19. 			intHeight = intHeight + 60
  20. 			RestoreWindowSize
  21. 			Update.innerHTML = "<p>&nbsp;<br>You seem to be using a pre-release (test?)<br>version (" & strCurrentVer _
  22. 			                 & ") of the Roman Numerals Convertor.<br>The latest official release is " _
  23. 			                 & strLatestVer & " and it is available " _
  24. 			                 & "<a href=""http://www.robvanderwoude.com/updates/romans.php"">here</a>.</p>"
  25. 		End If
  26. 		If strLatestVer > strCurrentVer Then
  27. 			intHeight = intHeight + 60
  28. 			RestoreWindowSize
  29. 			Update.innerHTML = "<p>&nbsp;<br>You are using version " & strCurrentVer _
  30. 			                 & " of<br>the Roman Numerals Convertor.<br>An update to version " _
  31. 			                 & strLatestVer & " is available " _
  32. 			                 & "<a href=""http://www.robvanderwoude.com/updates/romans.php"">here</a>.</p>"
  33. 		End If
  34. 	End If
  35.  
  36. 	' Change cursor back to default
  37. 	document.body.style.cursor = "default"
  38. End Sub
  39.  
  40.  
  41. Sub CreateIEHelp( )
  42. 	On Error Resume Next
  43. 	objIE.Close
  44. 	Set objIE = Nothing
  45. 	Set objIE = CreateObject( "InternetExplorer.Application" )
  46. 	objIE.Navigate "about:blank"
  47. 	objIE.AddressBar  = 1
  48. 	objIE.MenuBar     = 1
  49. 	objIE.StatusBar   = 1
  50. 	objIE.ToolBar     = 1
  51. 	objIE.Top         = 0
  52. 	objIE.Left        = 0
  53. 	objIE.Width       = window.width  + 200
  54. 	objIE.Height      = window.height + 200
  55. 	objIE.TheaterMode = 0
  56. 	objIE.Visible     = 1
  57. 	On Error Goto 0
  58. End Sub
  59.  
  60.  
  61. Function Dec2Roman( ByVal intDecimal )
  62. ' This Function converts intDecimal to its Roman numeral value.
  63. ' Written by: Rob van der Woude, http://www.robvanderwoude.com
  64. '
  65. ' intDecimal should be an integer in the range of 1..4999.
  66. '
  67. ' For the Roman numeral "modern" notation is used, i.e. 1999
  68. ' will be written as MCMXCIX, not MIM.
  69. '
  70. ' More information on Roman numerals can be found on WikiPedia:
  71. ' http://en.wikipedia.org/wiki/Roman_numerals
  72.  
  73. 	' Some housekeeping
  74. 	Dim strRoman
  75. 	strRoman = ""
  76.  
  77. 	' First, add an "M" for every multiple of 1000
  78. 	Do While intDecimal >= 1000
  79. 		intDecimal = intDecimal - 1000
  80. 		strRoman = strRoman & "M"
  81. 	Loop
  82.  
  83. 	' Next, add "CM" for 900, or "D" for 500, or "CD" for 400
  84. 	If intDecimal >= 900 Then
  85. 		intDecimal = intDecimal - 900
  86. 		strRoman = strRoman & "CM"
  87. 	ElseIf intDecimal >= 500 Then
  88. 		intDecimal = intDecimal - 500
  89. 		strRoman = strRoman & "D"
  90. 	ElseIf intDecimal >= 400 Then
  91. 		intDecimal = intDecimal - 400
  92. 		strRoman = strRoman & "CD"
  93. 	End If
  94.  
  95. 	' Add a "C" for every remaining multiple of 100
  96. 	Do While intDecimal >= 100
  97. 		intDecimal = intDecimal - 100
  98. 		strRoman = strRoman & "C"
  99. 	Loop
  100.  
  101. 	' Add "XC" for 90, or "L" for 50, or "XL" for 40
  102. 	If intDecimal >= 90 Then
  103. 		intDecimal = intDecimal - 90
  104. 		strRoman = strRoman & "XC"
  105. 	ElseIf intDecimal >= 50 Then
  106. 		intDecimal = intDecimal - 50
  107. 		strRoman = strRoman & "L"
  108. 	ElseIf intDecimal >= 40 Then
  109. 		intDecimal = intDecimal - 40
  110. 		strRoman = strRoman & "XL"
  111. 	End If
  112.  
  113. 	' Add an "X" for every remaining multiple of 10
  114. 	Do While intDecimal >= 10
  115. 		intDecimal = intDecimal - 10
  116. 		strRoman = strRoman & "X"
  117. 	Loop
  118.  
  119. 	' Add "IX" for 9, or "V" for 5, or "IV" for 4
  120. 	If intDecimal >= 9 Then
  121. 		intDecimal = intDecimal - 9
  122. 		strRoman = strRoman & "IX"
  123. 	ElseIf intDecimal >= 5 Then
  124. 		intDecimal = intDecimal - 5
  125. 		strRoman = strRoman & "V"
  126. 	ElseIf intDecimal >= 4 Then
  127. 		intDecimal = intDecimal - 4
  128. 		strRoman = strRoman & "IV"
  129. 	End If
  130.  
  131. 	' Finally, add an "I" for every remaining multiple of 1
  132. 	Do While intDecimal >= 1
  133. 		intDecimal = intDecimal - 1
  134. 		strRoman = strRoman & "I"
  135. 	Loop
  136.  
  137. 	' Return the result
  138. 	Dec2Roman = strRoman
  139. End Function
  140.  
  141.  
  142. Sub HandleDecimalChange( )
  143. 	Dim blnError, numDecimal
  144. 	blnError   = False
  145. 	numDecimal = Trim( Decimal.value )
  146. 	If numDecimal = "" Then Exit Sub
  147. 	If IsNumeric( numDecimal ) Then
  148. 		numDecimal = CDbl( numDecimal )
  149. 		If numDecimal < 1 Or numDecimal > 3999 Then
  150. 			blnError = True
  151. 		Else
  152. 			If CInt( numDecimal ) = numDecimal Then
  153. 				Roman.value = Dec2Roman( numDecimal )
  154. 			Else
  155. 				blnError = True
  156. 			End If
  157. 		End If
  158. 	Else
  159. 		blnError = True
  160. 	End If
  161. 	If blnError Then
  162. 		MsgBox "The decimal number entered must be an integer in the range of 1..3999", vbInformation , "Input Error"
  163. 	End If
  164. End Sub
  165.  
  166.  
  167. Sub HandleRomanChange( )
  168. 	Dim blnError, i, numDecimal, numRoman
  169. 	blnError    = False
  170. 	numRoman    = UCase( Trim( Roman.value ) )
  171. 	If Roman.value <> numRoman Then Roman.value = numRoman
  172. 	If numRoman = "" Then Exit Sub
  173. 	For i = 1 To Len( numRoman )
  174. 		If InStr( "MDCLXVI", Mid( numRoman, i, 1 ) ) = 0 Then
  175. 			blnError = True
  176. 		End If
  177. 	Next
  178. 	If blnError Then
  179. 		MsgBox "The Roman numeral entered contains invalid characters", vbInformation , "Input Error"
  180. 	Else
  181. 		numDecimal     = Roman2Decimal( numRoman )
  182. 		Decimal.value  = numDecimal
  183. 		If Roman.value <> Dec2Roman( numDecimal ) Then
  184. 			Roman.value = Dec2Roman( numDecimal )
  185. 		End If
  186. 	End If
  187. End Sub
  188.  
  189.  
  190. Function Roman2Decimal( ByVal strRoman )
  191. ' This Function converts strRoman to its decimal value.
  192. ' Written by: Rob van der Woude, http://www.robvanderwoude.com
  193. '
  194. ' Roman numerals "old style" will still be converted correctly
  195. ' into decimal. However, numerals like "MIIIM" for 1997
  196. ' would be invalid in any notation, and consequently will
  197. ' return invalid results.
  198. '
  199. ' More information on Roman numerals can be found on WikiPedia:
  200. ' http://en.wikipedia.org/wiki/Roman_numerals
  201.  
  202. 	' Some housekeeping
  203. 	Dim arrRoman( ), i, intRoman
  204. 	ReDim arrRoman( Len( strRoman ) -1 )
  205. 	intRoman = 0
  206.  
  207. 	' Store each "digit" of the Roman numeral in an array
  208. 	For i = 0 To UBound( arrRoman )
  209. 		arrRoman( i ) = Mid( strRoman, i + 1, 1 )
  210. 	Next
  211.  
  212. 	' Then convert each "digit" to its numeric value
  213. 	For i = 0 To UBound( arrRoman )
  214. 		Select Case arrRoman( i )
  215. 			Case "M"
  216. 				arrRoman( i ) = 1000
  217. 			Case "D"
  218. 				arrRoman( i ) = 500
  219. 			Case "C"
  220. 				arrRoman( i ) = 100
  221. 			Case "L"
  222. 				arrRoman( i ) = 50
  223. 			Case "X"
  224. 				arrRoman( i ) = 10
  225. 			Case "V"
  226. 				arrRoman( i ) = 5
  227. 			Case "I"
  228. 				arrRoman( i ) = 1
  229. 		End Select
  230. 	Next
  231.  
  232. 	' Now comes the hard part: for each "digit" decide if it will be
  233. 	' added or subtracted, based on the value of the following "digit"
  234. 	For i = 0 To UBound( arrRoman ) - 1
  235. 		If     arrRoman( i ) < arrRoman( i + 1 ) Then
  236. 			' E.g. "I" in "IX" (9): subtract 1
  237. 			intRoman = intRoman - arrRoman( i )
  238. 		ElseIf arrRoman( i ) = arrRoman( i + 1 ) Then
  239. 			' E.g. "I" in "XII" (12), "III" (3) or in "IIX" (ancient notation for 8).
  240. 			' The latter should actually be "VIII" in "modern" roman numerals, but
  241. 			' "IIX" was used in ancient times, so let's just be prepared.
  242. 			' We'll add the value to the next position in the array, so it will be
  243. 			' reevaluated in the next iteration of the loop.
  244. 			' Note: this trick will definitely fail on invalid notations like "IIIX".
  245. 			arrRoman( i + 1 ) = arrRoman( i ) + arrRoman( i + 1 )
  246. 			arrRoman( i )     = 0
  247. 		Else ' arrRoman( i ) > arrRoman( i + 1 )
  248. 			' E.g. "V" in "XV" (15): add 5
  249. 			intRoman = intRoman + arrRoman( i )
  250. 		End If
  251. 	Next
  252.  
  253. 	' The last "digit" doesn't have a following "digit" so it
  254. 	' can, be added without having to test a following "digit"
  255. 	intRoman= intRoman + arrRoman( UBound( arrRoman ) )
  256.  
  257. 	' Return the calculated value
  258. 	Roman2Decimal = intRoman
  259. End Function
  260.  
  261.  
  262. Sub HelpMsg( )
  263. 	Dim strHTML
  264. 	strHTML = "<h1>" & document.title & "</h1>" _
  265. 	       & vbCrLf & vbCrLf _
  266. 	       & "<p>Convert Roman numerals to decimal numbers vv.</p>" _
  267. 	       & vbCrLf & vbCrLf _
  268. 	       & "<h2>Usage:</h2>" _
  269. 	       & vbCrLf & vbCrLf _
  270. 	       & "<p>To convert decimal numbers to Roman numerals, just type a decimal number in the ""Decimal"" field.<br>" _
  271. 	       & vbCrLf _
  272. 	       & "The ""Roman"" field will be updated while you type.<br>" _
  273. 	       & vbCrLf _
  274. 	       & "For the Roman numerals, ""modern"" notation is used, i.e. 1999 will be written as MCMXCIX, not MIM.</p>" _
  275. 	       & vbCrLf & vbCrLf _
  276. 	       & "<p>To convert Roman numerals to decimal numbers, just type the Roman numerals in the ""Roman"" field.<br>" _
  277. 	       & vbCrLf _
  278. 	       & "The ""Decimal"" field will be updated while you type.<br>" _
  279. 	       & vbCrLf _
  280. 	       & "While entering Roman numerals, the ""Roman"" input is converted to ""modern"" notation on-the-fly.</p>" _
  281. 	       & vbCrLf & vbCrLf _
  282. 	       & "<p>&nbsp;<br>" _
  283. 	       & vbCrLf _
  284. 	       & "More information on Roman numerals and ""modern"" notation can be found on <a href=""http://en.wikipedia.org/wiki/Roman_numerals"">WikiPedia</a>.<br>" _
  285. 	       & vbCrLf _
  286. 	       & "&nbsp;</p>" _
  287. 	       & vbCrLf & vbCrLf _
  288. 	       & "<p>&copy; 2007 - 2013, Rob van der Woude<br>" _
  289. 	       & vbCrLf _
  290. 	       & "<a href=""http://www.robvanderwoude.com/romans.php"">http://www.robvanderwoude.com/romans.php</a></p>"
  291. 	On Error Resume Next
  292. 	objIE.Navigate "about:blank"
  293. 	If Err.Number Then
  294. 		CreateIEHelp
  295. 		objIE.Navigate "about:blank"
  296. 	End If
  297. 	On Error Goto 0
  298.  
  299. 	objIE.Width  = intWidth  + 300
  300. 	objIE.Height = intHeight + 180
  301. 	objIE.Left   = Int( ( window.screen.width  - objIE.Width  ) / 2 )
  302. 	objIE.Top    = Int( ( window.screen.height - objIE.Height ) / 2 )
  303. 	objIE.StatusBar  = False
  304. 	objIE.AddressBar = False
  305. 	objIE.MenuBar    = False
  306. 	objIE.ToolBar    = False
  307. 	objIE.Document.title = document.title
  308. 	objIE.Document.body.style.fontFamily = "arial,sans-serif"
  309. 	objIE.Document.body.style.fontSize = "80%"
  310. 	objIE.Document.body.style.padding = "25px"
  311. 	objIE.Document.body.innerHTML = strHTML
  312. 	objIE.Visible = 1
  313. End Sub
  314.  
  315.  
  316. Sub RestoreWindowSize( )
  317. 	Dim posWidth, posHeight
  318. 	On Error Resume Next
  319. 	If intWidth  > window.screen.width  Then intWidth  = window.screen.width
  320. 	If intHeight > window.screen.height Then intHeight = window.screen.height
  321. 	posWidth  = ( window.screen.width  - intWidth  ) / 2
  322. 	posHeight = ( window.screen.height - intHeight ) / 2
  323. 	If posWidth  < 0 Then posWidth  = 0
  324. 	If posHeight < 0 Then posHeight = 0
  325. 	window.resizeTo intWidth, intHeight
  326. 	window.moveTo posWidth, posHeight
  327. 	On Error GoTo 0
  328. End Sub
  329.  
  330.  
  331. Function TextFromHTML( myURL )
  332.     Dim objHTTP
  333.     TextFromHTML = ""
  334.     Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
  335.     objHTTP.Open "GET", myURL
  336.     objHTTP.Send
  337.     ' Check if the result was valid, and if so return the result
  338.     If objHTTP.Status = 200 Then TextFromHTML = objHTTP.ResponseText
  339.     Set objHTTP = Nothing
  340. End Function
  341.  
  342.  
  343. Sub Window_Onload( )
  344. 	intWidth  = 360
  345. 	intHeight = 260
  346. 	AppName.innerHTML    = Romans.ApplicationName
  347. 	AppVersion.innerHTML = Romans.Version
  348. 	document.title       = "Roman Numerals Convertor " & Romans.Version
  349. 	Set objIE = CreateObject( "InternetExplorer.Application" )
  350. 	RestoreWindowSize
  351. 	setTimeout "CheckUpdate", 5000, "VBScript"
  352. End Sub
  353.  
  354.  
  355. Sub Window_Onunload( )
  356. 	On Error Resume Next
  357. 	objIE.Quit
  358. 	Set objIE = Nothing
  359. 	On Error Goto 0
  360. End Sub
  1. </script>
  2.  
  3. <body onhelp="HelpMsg()" onresize="RestoreWindowSize">
  4.  
  5. <div align="center">
  6.  
  7. <span id="Update">&nbsp;</span>
  8.  
  9. <table>
  10. <tr>
  11.     <td>Decimal</td>
  12.     <td>&nbsp;</td>
  13.     <td><input type="text" size="16" id="Decimal" onchange="HandleDecimalChange" onkeyup="HandleDecimalChange"></td>
  14. </tr>
  15. <tr>
  16.     <td>Roman</td>
  17.     <td>&nbsp;</td>
  18.     <td><input type="text" size="16" id="Roman" onchange="HandleRomanChange" onkeyup="HandleRomanChange" class="UpperCase"></td>
  19. </tr>
  20. </table>
  21.  
  22. <p><span id="AppName">Application</span>,&nbsp; Version <span id="AppVersion">0.00</span><br>
  23. &copy; 2007 - 2013, Rob van der Woude<br>
  24. <a href="http://www.robvanderwoude.com/romans.php">www.robvanderwoude.com</a></p>
  25.  
  26. <p>More info on
  27. <a href="http://en.wikipedia.org/wiki/roman_numerals">Roman numerals</a>
  28. at
  29. <a href="http://en.wikipedia.org/wiki/roman_numerals">WikiPedia</font></a></p>
  30.  
  31. </div>
  32.  
  33. </body>
  34. </html>

page last uploaded: 2017-04-06, 13:33