(view source code of romans.hta as plain text)
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html lang="en">
<head>
<title>Roman Numerals Convertor</title>
<HTA:APPLICATION
ID="Romans"
VERSION="2.00"
APPLICATIONNAME="Romans"
CONTEXTMENU="no"
SCROLL="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="maximize"
>
<style type="text/css">
a, a:visited
{
color: blue;
}
a:hover
{
color: yellow;
}
body
{
color: white;
background-color: #FFA000;
font-family: arial, sans-serif;
font-size: 12pt;
margin: 0;
padding: 0;
filter: progid:DXImageTransform.Microsoft.Gradient(GradientType=0,StartColorStr='#FF0000',EndColorStr='#FFA000')
}
p
{
font-size: 80%;
}
td
{
text-align: left;
}
.Center
{
margin-left: auto;
margin-right: auto;
text-align: center;
}
.Red
{
color: red;
}
.UpperCase
{
text-transform: uppercase;
}
.White
{
color: white;
}
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> <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> <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> <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 _
& " </p>" _
& vbCrLf & vbCrLf _
& "<p>© 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
</script>
<body onhelp="HelpMsg()" onresize="RestoreWindowSize">
<div align="center">
<span id="Update"> </span>
<table>
<tr>
<td>Decimal</td>
<td> </td>
<td><input type="text" size="16" id="Decimal" onchange="HandleDecimalChange" onkeyup="HandleDecimalChange"></td>
</tr>
<tr>
<td>Roman</td>
<td> </td>
<td><input type="text" size="16" id="Roman" onchange="HandleRomanChange" onkeyup="HandleRomanChange" class="UpperCase"></td>
</tr>
</table>
<p><span id="AppName">Application</span>, Version <span id="AppVersion">0.00</span><br>
© 2007 - 2013, Rob van der Woude<br>
<a href="http://www.robvanderwoude.com/romans.php">www.robvanderwoude.com</a></p>
<p>More info on
<a href="http://en.wikipedia.org/wiki/roman_numerals">Roman numerals</a>
at
<a href="http://en.wikipedia.org/wiki/roman_numerals">WikiPedia</font></a></p>
</div>
</body>
</html>
page last modified: 2024-04-16; loaded in 0.0147 seconds