Source file for ROMANS.HTA

<html>
<head>
<title>Roman Numerals Conversion</title>

<HTA:APPLICATION 
     ID="Romans"
     VERSION="1.01"
     APPLICATIONNAME="Romans"
     CONTEXTMENU="no"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="maximize"
>
</head>

<script language="VBScript">

Option Explicit
Dim numVerMsgSize


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 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
			Update.InnerHTML = "<p>You seem to be using an invalid version (" & strCurrentVer _
			                 & ") of the Roman Numerals Convertor.<br>The latest valid version is " _
			                 & strLatestVer & " and it is available " _
			                 & "<a href=""http://www.robvanderwoude.com/updates/romans.html"">" _
			                 & "<font color=""blue"">here</font></a>.</p>"
			numVerMsgSize    = 85
		End If
		If strLatestVer > strCurrentVer Then
			Update.InnerHTML = "<p>You are using version " & strCurrentVer _
			                 & " of the Roman Numerals Convertor.<BR>An update to version " _
			                 & strLatestVer & " is available " _
			                 & "<a href=""http://www.robvanderwoude.com/updates/romans.html"">" _
			                 & "<font color=""blue"">here</font></a>.</p>"
			numVerMsgSize    = 85
		End If
	End If

	' Change cursor back to default
	Document.Body.Style.Cursor = "default"
End Sub


Sub HandleDecimalChange()
	Dim numDecimal
	numDecimal = Trim( Decimal.Value )
	If numDecimal = "" Then Exit Sub
	If IsNumeric( numDecimal ) Then
		numDecimal = CDbl( numDecimal )
		If numDecimal < 1 Or numDecimal > 3999 Then
			MsgBox "The decimal number entered must be an integer in the range of 1..3999", vbInformation , "Input Error"
		Else
			If CInt( numDecimal ) = numDecimal Then
				Roman.Value = Dec2Roman( numDecimal )
			Else
				MsgBox "The decimal number entered must be an integer in the range of 1..3999", vbInformation , "Input Error"
			End If
		End If
	Else
		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 ) )
	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
		Roman.Value = Dec2Roman( numDecimal )
	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 RestoreWindowSize()
	window.ResizeTo 360, 300 + numVerMsgSize
End Sub


Function TextFromHTML( URL )
	' 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

	' Some housekeeping
	Dim objIE
	
	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    = Romans.ApplicationName
	AppVersion.InnerHTML = Romans.Version
	CheckUpdate
	RestoreWindowSize
End Sub

</script>

<body style="font:12 pt arial; color:white; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#FF0000', EndColorStr='#FFA000')" onResize="RestoreWindowSize">

<div align="center">

<span id="Update">&nbsp;</span>

<table border="0" cellpadding="10" cellspacing="0">
<tr>
    <td>Decimal</td>
    <td><input type="text" size="16" id="Decimal" OnChange="HandleDecimalChange"></td>
    <td><input type="button" value="Convert"></td>
</tr>
<tr>
    <td>Roman</td>
    <td><input type="text" size="16" id="Roman" OnChange="HandleRomanChange" style="text-transform:uppercase"></td>
    <td>&nbsp;</td>
</tr>
</table>

<p><span id="AppName">Application</span>,&nbsp; Version <span id="AppVersion">0.00</span><br>
<font size="-1">&copy; 2007, Rob van der Woude<br>
<a href="http://www.robvanderwoude.com/" target="_blank"><font color="red">http://www.robvanderwoude.com</font></a></font></p>

<p><font size="-1">More info on
<a href="http://en.wikipedia.org/wiki/roman_numerals" target="_blank"><font color="red">Roman numerals</font></a>
at
<a href="http://en.wikipedia.org/wiki/roman_numerals" target="_blank"><font color="red">WikiPedia</font></a></font></p>

</div>

</body>
</html>