Roman Numerals

<%
    ' ASP Roman Numeral Library
    '
    ' Copyright (c) 2008, reusablecode.blogspot.com; some rights reserved.
    '
    ' This work is licensed under the Creative Commons Attribution License. To view
    ' a copy of this license, visit http://creativecommons.org/licenses/by/3.0/ or
    ' send a letter to Creative Commons, 559 Nathan Abbott Way, Stanford, California
    ' 94305, USA.
 
    ' Convert Arabic numerals into Roman numerals.
    function roman(ByVal arabic)
        Dim fractions
        Dim ones
        Dim tens
        Dim hundreds
        Dim thousands
 
        fractions = Array("", "�", "��", "���", "����", "�����", "S", "S�", "S��", "S���", "S����", "S�����", "I")
        ones = Array("", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")
        tens = Array("", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC")
        hundreds = Array("", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM")
        thousands = Array("", "M", "MM", "MMM", "MMMM")
 
        if arabic > 4999 then
            ' For large numbers (five thousand and above), a bar is placed above a base numeral to indicate multiplication by 1000.
            ' Since it is not possible to illustrate this in plain ASCII, this function will refuse to convert numbers above 4999.
            Err.Clear
            Err.Raise 9
        elseif arabic = 0 then
            ' About 725, Bede or one of his colleagues used the letter N, the initial of nullae,
            ' in a table of epacts, all written in Roman numerals, to indicate zero.
            roman = "N"
        else
            ' Handle fractions that will round up to 1.
            if round((arabic mod 1) * 12) = 12 then
                arabic = round(arabic)
            end if
 
            ' With special cases out of the way, we can proceed.
            roman = thousands((arabic - (arabic mod 1000)) / 1000)
            arabic = arabic mod 1000
            roman = roman & hundreds((arabic - (arabic mod 100)) / 100)
            arabic = arabic mod 100
            roman = roman & tens((arabic - (arabic mod 10)) / 10)
            arabic = arabic mod 10
            roman = roman & ones((arabic - (arabic mod 1)) / 1)
            arabic = arabic mod 1
 
            ' Handling for fractions.
            if arabic > 0 then
                roman = roman & fractions(round(arabic * 12))
            end if
        end if
    end function
 
    ' Expand subtractive notation in Roman numerals.
    function roman_expand(ByVal roman)
        roman = replace(roman, "CM", "DCCCC")
        roman = replace(roman, "CD", "CCCC")
        roman = replace(roman, "XC", "LXXXX")
        roman = replace(roman, "XL", "XXXX")
        roman = replace(roman, "IX", "VIIII")
        roman = replace(roman, "IV", "IIII")
        roman_expand = roman
    end function
 
    ' Compress Roman numerals using subtractive notation.
    function roman_compress(ByVal roman)
        roman = replace(roman, "DCCCC", "CM")
        roman = replace(roman, "CCCC", "CD")
        roman = replace(roman, "LXXXX", "XC")
        roman = replace(roman, "XXXX", "XL")
        roman = replace(roman, "VIIII", "IX")
        roman = replace(roman, "IIII", "IV")
        roman_compress = roman
    end function
 
    ' Convert Roman numerals to Arabic numerals.
    ' Requires InstrCount()
    function arabic(ByVal roman)
        Dim result
 
        result = 0
 
        ' Remove subtractive notation.
        roman = roman_expand(roman)
 
        ' Calculte for each numeral.
        result = result + InstrCount(roman, "M") * 1000
        result = result + InstrCount(roman, "D") * 500
        result = result + InstrCount(roman, "C") * 100
        result = result + InstrCount(roman, "L") * 50
        result = result + InstrCount(roman, "X") * 10
        result = result + InstrCount(roman, "V") * 5
        result = result + InstrCount(roman, "I")
    end function
%>