Source code for romans.hta

```
 
```
```
Option Explicit
```
```
 
```
```
Dim intHeight, intWidth, objIE
```
```
 
```
```
 
```
```
Sub CheckUpdate( )
```
```
	' Some housekeeping
```

	Dim lenLatestVer, strCurrentVer, strLatestVer

```
 
```

	' Change cursor to hourglass while checking for update

```
	document.body.style.cursor = "wait"
```
```
 
```

	strLatestVer  = TextFromHTML( "http://www.robvanderwoude.com/updates/romans.txt" )

```
	lenLatestVer  = Len( strLatestVer )
```
```
	If lenLatestVer = 4 Then
```

		strCurrentVer = Split( Romans.Version )(0)

```
		If strLatestVer < strCurrentVer Then
```
```
			intHeight = intHeight + 60
```
```
			RestoreWindowSize
```

			Update.innerHTML = "<p>&nbsp;<br>You seem to be using a pre-release (test?)<br>version (" & strCurrentVer _

			                 & ") of the Roman Numerals Convertor.<br>The latest official release is " _

			                 & strLatestVer & " and it is available " _

			                 & "<a href=""http://www.robvanderwoude.com/updates/romans.php"">here</a>.</p>"

```
		End If
```
```
		If strLatestVer > strCurrentVer Then
```
```
			intHeight = intHeight + 60
```
```
			RestoreWindowSize
```

			Update.innerHTML = "<p>&nbsp;<br>You are using version " & strCurrentVer _

			                 & " of<br>the Roman Numerals Convertor.<br>An update to version " _

			                 & strLatestVer & " is available " _

			                 & "<a href=""http://www.robvanderwoude.com/updates/romans.php"">here</a>.</p>"

```
		End If
```
```
	End If
```
```
 
```
```
	' Change cursor back to default
```
```
	document.body.style.cursor = "default"
```
```
End Sub
```
```
 
```
```
 
```
```
Sub CreateIEHelp( )
```
```
	On Error Resume Next
```
```
	objIE.Close
```
```
	Set objIE = Nothing
```

	Set objIE = CreateObject( "InternetExplorer.Application" )

```
	objIE.Navigate "about:blank"
```
```
	objIE.AddressBar  = 1
```
```
	objIE.MenuBar     = 1
```
```
	objIE.StatusBar   = 1
```
```
	objIE.ToolBar     = 1
```
```
	objIE.Top         = 0
```
```
	objIE.Left        = 0
```

	objIE.Width       = window.width  + 200

	objIE.Height      = window.height + 200

```
	objIE.TheaterMode = 0
```
```
	objIE.Visible     = 1
```
```
	On Error Goto 0
```
```
End Sub
```
```
 
```
```
 
```
```
Function Dec2Roman( ByVal intDecimal )
```

' This Function converts intDecimal to its Roman numeral value.

' Written by: Rob van der Woude, http://www.robvanderwoude.com

```
'
```

' intDecimal should be an integer in the range of 1..4999.

```
'
```

' For the Roman numeral "modern" notation is used, i.e. 1999

```
' will be written as MCMXCIX, not MIM.
```
```
'
```

' More information on Roman numerals can be found on WikiPedia:

' http://en.wikipedia.org/wiki/Roman_numerals

```
 
```
```
	' Some housekeeping
```
```
	Dim strRoman
```
```
	strRoman = ""
```
```
 
```

	' First, add an "M" for every multiple of 1000

```
	Do While intDecimal >= 1000
```
```
		intDecimal = intDecimal - 1000
```
```
		strRoman = strRoman & "M"
```
```
	Loop
```
```
 
```

	' Next, add "CM" for 900, or "D" for 500, or "CD" for 400

```
	If intDecimal >= 900 Then
```
```
		intDecimal = intDecimal - 900
```
```
		strRoman = strRoman & "CM"
```
```
	ElseIf intDecimal >= 500 Then
```
```
		intDecimal = intDecimal - 500
```
```
		strRoman = strRoman & "D"
```
```
	ElseIf intDecimal >= 400 Then
```
```
		intDecimal = intDecimal - 400
```
```
		strRoman = strRoman & "CD"
```
```
	End If
```
```
 
```

	' Add a "C" for every remaining multiple of 100

```
	Do While intDecimal >= 100
```
```
		intDecimal = intDecimal - 100
```
```
		strRoman = strRoman & "C"
```
```
	Loop
```
```
 
```

	' Add "XC" for 90, or "L" for 50, or "XL" for 40

```
	If intDecimal >= 90 Then
```
```
		intDecimal = intDecimal - 90
```
```
		strRoman = strRoman & "XC"
```
```
	ElseIf intDecimal >= 50 Then
```
```
		intDecimal = intDecimal - 50
```
```
		strRoman = strRoman & "L"
```
```
	ElseIf intDecimal >= 40 Then
```
```
		intDecimal = intDecimal - 40
```
```
		strRoman = strRoman & "XL"
```
```
	End If
```
```
 
```

	' Add an "X" for every remaining multiple of 10

```
	Do While intDecimal >= 10
```
```
		intDecimal = intDecimal - 10
```
```
		strRoman = strRoman & "X"
```
```
	Loop
```
```
 
```

	' Add "IX" for 9, or "V" for 5, or "IV" for 4

```
	If intDecimal >= 9 Then
```
```
		intDecimal = intDecimal - 9
```
```
		strRoman = strRoman & "IX"
```
```
	ElseIf intDecimal >= 5 Then
```
```
		intDecimal = intDecimal - 5
```
```
		strRoman = strRoman & "V"
```
```
	ElseIf intDecimal >= 4 Then
```
```
		intDecimal = intDecimal - 4
```
```
		strRoman = strRoman & "IV"
```
```
	End If
```
```
 
```

	' Finally, add an "I" for every remaining multiple of 1

```
	Do While intDecimal >= 1
```
```
		intDecimal = intDecimal - 1
```
```
		strRoman = strRoman & "I"
```
```
	Loop
```
```
 
```
```
	' Return the result
```
```
	Dec2Roman = strRoman
```
```
End Function
```
```
 
```
```
 
```
```
Sub HandleDecimalChange( )
```
```
	Dim blnError, numDecimal
```
```
	blnError   = False
```
```
	numDecimal = Trim( Decimal.value )
```
```
	If numDecimal = "" Then Exit Sub
```
```
	If IsNumeric( numDecimal ) Then
```
```
		numDecimal = CDbl( numDecimal )
```

		If numDecimal < 1 Or numDecimal > 3999 Then

```
			blnError = True
```
```
		Else
```

			If CInt( numDecimal ) = numDecimal Then

				Roman.value = Dec2Roman( numDecimal )

```
			Else
```
```
				blnError = True
```
```
			End If
```
```
		End If
```
```
	Else
```
```
		blnError = True
```
```
	End If
```
```
	If blnError Then
```

		MsgBox "The decimal number entered must be an integer in the range of 1..3999", vbInformation , "Input Error"

```
	End If
```
```
End Sub
```
```
 
```
```
 
```
```
Sub HandleRomanChange( )
```
```
	Dim blnError, i, numDecimal, numRoman
```
```
	blnError    = False
```

	numRoman    = UCase( Trim( Roman.value ) )

	If Roman.value <> numRoman Then Roman.value = numRoman

```
	If numRoman = "" Then Exit Sub
```
```
	For i = 1 To Len( numRoman )
```

		If InStr( "MDCLXVI", Mid( numRoman, i, 1 ) ) = 0 Then

```
			blnError = True
```
```
		End If
```
```
	Next
```
```
	If blnError Then
```

		MsgBox "The Roman numeral entered contains invalid characters", vbInformation , "Input Error"

```
	Else
```

		numDecimal     = Roman2Decimal( numRoman )

```
		Decimal.value  = numDecimal
```

		If Roman.value <> Dec2Roman( numDecimal ) Then

			Roman.value = Dec2Roman( numDecimal )

```
		End If
```
```
	End If
```
```
End Sub
```
```
 
```
```
 
```

Function Roman2Decimal( ByVal strRoman )

' This Function converts strRoman to its decimal value.

' Written by: Rob van der Woude, http://www.robvanderwoude.com

```
'
```

' Roman numerals "old style" will still be converted correctly

' into decimal. However, numerals like "MIIIM" for 1997

' would be invalid in any notation, and consequently will

```
' return invalid results.
```
```
'
```

' More information on Roman numerals can be found on WikiPedia:

' http://en.wikipedia.org/wiki/Roman_numerals

```
 
```
```
	' Some housekeeping
```
```
	Dim arrRoman( ), i, intRoman
```
```
	ReDim arrRoman( Len( strRoman ) -1 )
```
```
	intRoman = 0
```
```
 
```

	' Store each "digit" of the Roman numeral in an array

```
	For i = 0 To UBound( arrRoman )
```

		arrRoman( i ) = Mid( strRoman, i + 1, 1 )

```
	Next
```
```
 
```

	' Then convert each "digit" to its numeric value

```
	For i = 0 To UBound( arrRoman )
```
```
		Select Case arrRoman( i )
```
```
			Case "M"
```
```
				arrRoman( i ) = 1000
```
```
			Case "D"
```
```
				arrRoman( i ) = 500
```
```
			Case "C"
```
```
				arrRoman( i ) = 100
```
```
			Case "L"
```
```
				arrRoman( i ) = 50
```
```
			Case "X"
```
```
				arrRoman( i ) = 10
```
```
			Case "V"
```
```
				arrRoman( i ) = 5
```
```
			Case "I"
```
```
				arrRoman( i ) = 1
```
```
		End Select
```
```
	Next
```
```
 
```

	' Now comes the hard part: for each "digit" decide if it will be

	' added or subtracted, based on the value of the following "digit"

```
	For i = 0 To UBound( arrRoman ) - 1
```

		If     arrRoman( i ) < arrRoman( i + 1 ) Then

```
			' E.g. "I" in "IX" (9): subtract 1
```
```
			intRoman = intRoman - arrRoman( i )
```

		ElseIf arrRoman( i ) = arrRoman( i + 1 ) Then

			' E.g. "I" in "XII" (12), "III" (3) or in "IIX" (ancient notation for 8).

			' The latter should actually be "VIII" in "modern" roman numerals, but

			' "IIX" was used in ancient times, so let's just be prepared.

			' We'll add the value to the next position in the array, so it will be

			' reevaluated in the next iteration of the loop.

			' Note: this trick will definitely fail on invalid notations like "IIIX".

			arrRoman( i + 1 ) = arrRoman( i ) + arrRoman( i + 1 )

```
			arrRoman( i )     = 0
```

		Else ' arrRoman( i ) > arrRoman( i + 1 )

```
			' E.g. "V" in "XV" (15): add 5
```
```
			intRoman = intRoman + arrRoman( i )
```
```
		End If
```
```
	Next
```
```
 
```

	' The last "digit" doesn't have a following "digit" so it

	' can, be added without having to test a following "digit"

	intRoman= intRoman + arrRoman( UBound( arrRoman ) )

```
 
```
```
	' Return the calculated value
```
```
	Roman2Decimal = intRoman
```
```
End Function
```
```
 
```
```
 
```
```
Sub HelpMsg( )
```
```
	Dim strHTML
```

	strHTML = "<h1>" & document.title & "</h1>" _

```
	       & vbCrLf & vbCrLf _
```

	       & "<p>Convert Roman numerals to decimal numbers vv.</p>" _

```
	       & vbCrLf & vbCrLf _
```
```
	       & "<h2>Usage:</h2>" _
```
```
	       & vbCrLf & vbCrLf _
```

	       & "<p>To convert decimal numbers to Roman numerals, just type a decimal number in the ""Decimal"" field.<br>" _

```
	       & vbCrLf _
```

	       & "The ""Roman"" field will be updated while you type.<br>" _

```
	       & vbCrLf _
```

	       & "For the Roman numerals, ""modern"" notation is used, i.e. 1999 will be written as MCMXCIX, not MIM.</p>" _

```
	       & vbCrLf & vbCrLf _
```

	       & "<p>To convert Roman numerals to decimal numbers, just type the Roman numerals in the ""Roman"" field.<br>" _

```
	       & vbCrLf _
```

	       & "The ""Decimal"" field will be updated while you type.<br>" _

```
	       & vbCrLf _
```

	       & "While entering Roman numerals, the ""Roman"" input is converted to ""modern"" notation on-the-fly.</p>" _

```
	       & vbCrLf & vbCrLf _
```
```
	       & "<p>&nbsp;<br>" _
```
```
	       & vbCrLf _
```

	       & "More information on Roman numerals and ""modern"" notation can be found on <a href=""http://en.wikipedia.org/wiki/Roman_numerals"">WikiPedia</a>.<br>" _

```
	       & vbCrLf _
```
```
	       & "&nbsp;</p>" _
```
```
	       & vbCrLf & vbCrLf _
```

	       & "<p>&copy; 2007 - 2013, Rob van der Woude<br>" _

```
	       & vbCrLf _
```

	       & "<a href=""http://www.robvanderwoude.com/romans.php"">http://www.robvanderwoude.com/romans.php</a></p>"

```
	On Error Resume Next
```
```
	objIE.Navigate "about:blank"
```
```
	If Err.Number Then
```
```
		CreateIEHelp
```
```
		objIE.Navigate "about:blank"
```
```
	End If
```
```
	On Error Goto 0
```
```
 
```
```
	objIE.Width  = intWidth  + 300
```
```
	objIE.Height = intHeight + 180
```

	objIE.Left   = Int( ( window.screen.width  - objIE.Width  ) / 2 )

	objIE.Top    = Int( ( window.screen.height - objIE.Height ) / 2 )

```
	objIE.StatusBar  = False
```
```
	objIE.AddressBar = False
```
```
	objIE.MenuBar    = False
```
```
	objIE.ToolBar    = False
```
```
	objIE.Document.title = document.title
```

	objIE.Document.body.style.fontFamily = "arial,sans-serif"

	objIE.Document.body.style.fontSize = "80%"

	objIE.Document.body.style.padding = "25px"

	objIE.Document.body.innerHTML = strHTML

```
	objIE.Visible = 1
```
```
End Sub
```
```
 
```
```
 
```
```
Sub RestoreWindowSize( )
```
```
	Dim posWidth, posHeight
```
```
	On Error Resume Next
```

	If intWidth  > window.screen.width  Then intWidth  = window.screen.width

	If intHeight > window.screen.height Then intHeight = window.screen.height

	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
```
```
 
```
```
 
```
```
Function TextFromHTML( myURL )
```
```
    Dim objHTTP
```
```
    TextFromHTML = ""
```

    Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )

```
    objHTTP.Open "GET", myURL
```
```
    objHTTP.Send
```

    ' Check if the result was valid, and if so return the result

    If objHTTP.Status = 200 Then TextFromHTML = objHTTP.ResponseText

```
    Set objHTTP = Nothing
```
```
End Function
```
```
 
```
```
 
```
```
Sub Window_Onload( )
```
```
	intWidth  = 360
```
```
	intHeight = 260
```

	AppName.innerHTML    = Romans.ApplicationName

```
	AppVersion.innerHTML = Romans.Version
```

	document.title       = "Roman Numerals Convertor " & Romans.Version

	Set objIE = CreateObject( "InternetExplorer.Application" )

```
	RestoreWindowSize
```

	setTimeout "CheckUpdate", 5000, "VBScript"

```
End Sub
```
```
 
```
```
 
```
```
Sub Window_Onunload( )
```
```
	On Error Resume Next
```
```
	objIE.Quit
```
```
	Set objIE = Nothing
```
```
	On Error Goto 0
```
```
End Sub
```