Is it possible to use Format function to display integers in roman numerals?
For Counter As Integer = 1 To 10
Literal1.Text &= Format(Counter, "???")
Next
Asked
Active
Viewed 7,171 times
1
kazinix
- 28,987
- 33
- 107
- 157
5 Answers
5
This is what I found on http://www.source-code.biz/snippets/vbasic/7.htm
(originally written by Mr Christian d'Heureuse in VB)
I converted it to VB.net:
Private Function FormatRoman(ByVal n As Integer) As String
If n = 0 Then FormatRoman = "0" : Exit Function
' there is no Roman symbol for 0, but we don't want to return an empty string
Const r = "IVXLCDM" ' Roman symbols
Dim i As Integer = Math.Abs(n)
Dim s As String = ""
For p As Integer = 1 To 5 Step 2
Dim d As Integer = i Mod 10
i = i \ 10
Select Case d ' format a decimal digit
Case 0 To 3 : s = s.PadLeft(d + Len(s), Mid(r, p, 1))
Case 4 : s = Mid(r, p, 2) & s
Case 5 To 8 : s = Mid(r, p + 1, 1) & s.PadLeft(d - 5 + Len(s), Mid(r, p, 1))
Case 9 : s = Mid(r, p, 1) & Mid(r, p + 2, 1) & s
End Select
Next
s = s.PadLeft(i + Len(s), "M") ' format thousands
If n < 0 Then s = "-" & s ' insert sign if negative (non-standard)
FormatRoman = s
End Function
I hope this will help others.
Cheers - Dave.
Dave
- 51
- 1
- 2
3
No, there is no standard formatter for that.
If you read the Wikipedia on Roman numerals you'll find that there are multiple ways of formatting Roman Numerals. So you will have to write your own method our use the code of someone else.
-
Are you sure sir? Coz I'm gonna grab that converter class if Format can't give me what I need. – kazinix Jul 03 '12 at 07:13
-
I have never seen one in the framework: http://msdn.microsoft.com/en-us/library/dwhawy9k.aspx That is how sure I am. – Emond Jul 03 '12 at 09:18
-
Considering the number of developers creating class for that. I think there is no hope I can find in Format function. Thanks – kazinix Jul 04 '12 at 04:19
1
I wrote this code that works perfectly up to a million. You can use it but, please, do not make it your own.
Public NotInheritable Class BRoman
'Written by Bernardo Ravazzoni
Public Shared Function hexRoman(ByVal input As Integer) As String
Return mainROMAN(input)
End Function
Private Shared Function mainROMAN(ByVal input As Integer) As String
Dim under As Boolean = udctr(input)
Dim cifretotali As Integer = input.ToString.Length
Dim output As String = ""
Dim remaning As String = input
Dim cifracor As Integer = cifretotali
While Not cifracor = 0
output = output & coreROMAN(division(remaning, remaning), cifracor)
cifracor = cifracor - 1
End While
If under Then
output = "-" & output
End If
Return output
End Function
Private Shared Function coreROMAN(ByVal num As Integer, ByVal pos As Integer) As String
Dim output As String = ""
Debug.WriteLine(num)
Select Case num
Case 1 To 3
output = say(num, getStringFor(True, pos))
Case 4
output = getStringFor(True, pos) & getStringFor(False, pos)
Case 5 To 8
output = getStringFor(False, pos) & say(num - 5, getStringFor(True, pos))
Case 9, 10
output = say(10 - num, getStringFor(True, pos)) & getStringFor(True, pos + 1)
End Select
Return output
End Function
Private Shared Function getStringFor(ByVal first As Boolean, ByVal index As Integer) As String
Dim output As String = ""
index = index * 2
If first Then
index = index - 1
End If
output = rGetStringFor(index)
Return output
End Function
Private Shared Function rGetStringFor(ByVal index As Integer) As String
Dim output As String = ""
Dim sy As Integer
If index < 8 Then
output = rrGetStringFor(index)
Else
sy = index \ 6
output = say(sy, rrGetStringFor(8)) & rrGetStringFor(((index - 2) Mod 6) + 2) & say(sy, rrGetStringFor(9))
End If
Return output
End Function
Private Shared Function rrGetStringFor(ByVal index As Integer) As String
Dim output As String = ""
Select Case index
Case 1
output = "I"
Case 2 '8
output = "V"
Case 3 '9
output = "X"
Case 4 '10
output = "L"
Case 5 '11
output = "C"
Case 6 '12
output = "D"
Case 7 '13
output = "M"
Case 8
output = "["
Case 9
output = "]"
End Select
Return output
End Function
Private Shared Function division(ByVal inputs As String, ByRef resto As String) As Integer
resto = ""
If inputs.Length > 1 Then
resto = inputs.Substring(1)
End If
Dim output As Integer = Integer.Parse(StrReverse(inputs).Substring(inputs.Length - 1))
Return output
End Function
Public Shared Function say(ByVal index As Integer, ByVal letter As String) As String
Dim output As String = ""
While Not index = 0
output = output & letter
index = index - 1
End While
Return output
End Function
Public Shared Function udctr(ByRef num As Integer) As Boolean
Dim und As Boolean = (num < 0)
If und Then
num = 0 - num
End If
Return und
End Function
End Class
Use the function hexRoman, like this example:
msgbox(Broman.hexRoman(50))
Bernardo Ravazzoni
- 109
- 4
1
I know this thread is ancient, but, in case anyone finds this useful, I wanted to add the function nRoman(), below, that I wrote a while back based on the source function @Dave mentioned—instead of constructing output from basic Latin ASCII characters (i.e., {I, V, X, L, C, D, M} or {i, v, x, l, c, d, m}), it uses Roman numerals, found in the the range, U+2160 to U+2188, of the 'Number Forms' group (i.e., {Ⅰ, Ⅴ, Ⅹ, Ⅼ, Ⅽ, Ⅾ, Ⅿ, ↁ, ↂ, ↇ, ↈ} or {ⅰ, ⅴ, ⅹ, ⅼ, ⅽ, ⅾ, ⅿ, ↁ, ↂ, ↇ, ↈ}).
I referenced existing functions, so I included those as well. I wrote this in VBA (Excel), so some adjustments will be needed in a different environment (e.g., unicode Roman numeral characters are referenced with function calls to make them easier to remember, but 'WorksheetFunction.Unichar()' would need to be replaced with the appropriate function to interpret Unicode code points).
Adjustments:
- My function uses 5000 = ↁ, 10000 = ↂ, 50000 = ↇ, and 100000 =
ↈ (I also included an analogous version the original function,
numRoman(), that uses ASCII Latin characters up to 1000 = M, but uses different bracket characters as placeholders for these four values)—if you'd rather output not not utilize these, I think you can just adjust the line that modifies the hundred-thousands place to modify the thousands place instead. - Instead of using a string /
mid()to store and identify numerals, like in the original function, I used an array / index—this is becauselen()andmid()don't behave consistently in different languages / environments for unicode code points above 55296, sometimes interpreting characters with those code points as a sequence of two characters (I don't recall exactly what is going on, but I think the first character's code point is read as 55357, although this may vary for some subrange) instead of a single character, which use of an array avoids.
────────────────────────────────────────────────
Module: mNumeralSystem
Option Explicit
Public Function nRoman(ByVal n As Long, Optional ByVal lowCase As Boolean = False) As String ' _
• Converts arabic to Roman numeral, using special unicode characters (instead of regular ASCI letters used to construct the output of 'numRoman()') ' _
§ DECLARE
Dim _
i As Long, _
s As String, _
p As Long, _
d As Long, _
r As Variant
' _
§ DEFINE
If n = 0 Then nRoman = "0": Exit Function ' » There is no roman symbol for 0, but we don't want to return an empty string.
If lowCase Then ' » roman numerals, unicode special, lowercase (as array)
r = Array( _
cRomanL1, cRomanL5, cRomanL10, cRomanL50, cRomanL100, cRomanL500, _
cRomanL1000, cRoman5000, cRoman10000, cRoman50000, cRoman100000 _
)
Else ' » roman numerals, unicode special, uppercase (as array)
r = Array( _
cRoman1, cRoman5, cRoman10, cRoman50, cRoman100, cRoman500, _
cRoman1000, cRoman5000, cRoman10000, cRoman50000, cRoman100000 _
)
End If
ReDim Preserve r(1 To arrayCount(r)) ' » converting base to 1 simplifies coding
i = Abs(n)
For p = 1 To 9 Step 2
d = i Mod 10: i = i \ 10
Select Case d ' » format a decimal digit
Case 0 To 3: s = String(d, r(p)) & s
Case 4: s = r(p) & r(p + 1) & s
Case 5 To 8: s = r(p + 1) & String(d - 5, r(p)) & s
Case 9: s = r(p) & r(p + 2) & s
End Select
Next
s = String(i, cRoman100000) & s ' » format hundred-thousands
If n < 0 Then s = "-" & s ' » insert sign if negative (non-standard)
' _
§ RETURN
nRoman = s
End Function
Public Function numRoman(ByVal n As Long) As String ' _
• Converts arabic to Roman numeral (ASCI letters) ' _
† Note, modified original function (commented above), adding to the co-domain, brackets as placeholders for Roman numerals lacking ASCI analogs, _
to permit surjective mapping from the ASCI co-domain to the special unicode versions in the co-domain for 'nRoman()'. ' _
§ DECLARE
Const r = "IVXLCDM)(][" ' » roman numerals, ASCI characters (as string, brackets stand in where no ASCI equivalent exists (i.e., 5000, 10000, 50000, 100000)
Dim _
i As Long, _
s As String, _
p As Long, _
d As Long
' _
§ DEFINE
i = Abs(n)
If n = 0 Then numRoman = "0": Exit Function ' » There is no roman symbol for 0, but we don't want to return an empty string.
For p = 1 To 9 Step 2
d = i Mod 10: i = i \ 10
Select Case d ' » format a decimal digit
Case 0 To 3: s = String(d, Mid(r, p, 1)) & s
Case 4: s = Mid(r, p, 2) & s
Case 5 To 8: s = Mid(r, p + 1, 1) & String(d - 5, Mid(r, p, 1)) & s
Case 9: s = Mid(r, p, 1) & Mid(r, p + 2, 1) & s
End Select
Next
s = String(i, "[") & s ' » format hundred-thousands
If n < 0 Then s = "-" & s ' » insert sign if negative (non-standard)
' _
§ RETURN
numRoman = s
End Function
────────────────────────────────────────────────
Module: mCharacterNames
Option Explicit
'Characters _
Function Name Function Return End Function singleQuote Character
Function cRoman1() As String: cRoman1 = WorksheetFunction.Unichar(8544): End Function ' ?
Function cRoman10() As String: cRoman10 = WorksheetFunction.Unichar(8553): End Function ' ?
Function cRoman100() As String: cRoman100 = WorksheetFunction.Unichar(8557): End Function ' ?
Function cRoman1000() As String: cRoman1000 = WorksheetFunction.Unichar(8559): End Function ' ?
Function cRoman10000() As String: cRoman10000 = WorksheetFunction.Unichar(8578): End Function ' ?
Function cRoman100000() As String: cRoman100000 = WorksheetFunction.Unichar(8584): End Function ' ?
Function cRoman5() As String: cRoman5 = WorksheetFunction.Unichar(8548): End Function ' ?
Function cRoman50() As String: cRoman50 = WorksheetFunction.Unichar(8556): End Function ' ?
Function cRoman500() As String: cRoman500 = WorksheetFunction.Unichar(8558): End Function ' ?
Function cRoman5000() As String: cRoman5000 = WorksheetFunction.Unichar(8577): End Function ' ?
Function cRoman50000() As String: cRoman50000 = WorksheetFunction.Unichar(8583): End Function ' ?
Function cRomanL1() As String: cRomanL1 = WorksheetFunction.Unichar(8560): End Function ' ?
Function cRomanL10() As String: cRomanL10 = WorksheetFunction.Unichar(8569): End Function ' ?
Function cRomanL100() As String: cRomanL100 = WorksheetFunction.Unichar(8573): End Function ' ?
Function cRomanL1000() As String: cRomanL1000 = WorksheetFunction.Unichar(8575): End Function ' ?
Function cRomanL5() As String: cRomanL5 = WorksheetFunction.Unichar(8564): End Function ' ?
Function cRomanL50() As String: cRomanL50 = WorksheetFunction.Unichar(8572): End Function ' ?
Function cRomanL500() As String: cRomanL500 = WorksheetFunction.Unichar(8574): End Function ' ?
────────────────────────────────────────────────
Module: mArrayTools
Option Explicit
Public Function NumberOfArrayDimensions(ByVal arr As Variant) As Integer ' _
• Returns the number of dimensions of array (up to 60000), 'arr', by exploiting error hanlding ' _
§ DECLARE
Dim _
n As Long, _
errIncrement As Long, _
a As Variant
' _
§ DEFINE
a = arr
On Error GoTo FinalDimension
For n = 1 To 60000 ' » loop through VBA max of 60000 array dimensions
errIncrement = LBound(a, n)
Next n
Exit Function
FinalDimension: ' _
§ RETURN
NumberOfArrayDimensions = n - 1 ' » return last 'n' before 'n' that returned error
End Function
Function arrayCount(a As Variant, Optional ByVal uniq As Boolean = False) As Long ' _
• Returns number of elements in array, 'a' (or, if 'uniq' = True, the number of unique values), by: ' _
› for 'a' dimensions = 1, using upper/lower bounds, or ' _
› for 'a' dimensions > 1, counting via for-each loop ' _
§ DECLARE
Dim _
n As Long, _
x As Variant, _
d As Scripting.Dictionary, _
b As Boolean
' _
§ DEFINE
Select Case uniq
Case False
If NumberOfArrayDimensions(a) = 1 Then
n = UBound(a) - LBound(a) + 1
Else: For Each x In a: n = n + 1: Next
End If
Case Else
Set d = New Scripting.Dictionary
For Each x In a: d(x) = b: Next
n = d.Count
End Select
' _
§ RETURN
arrayCount = n
End Function
oghaki
- 11
- 2
-1
Public Class RomanNumber
Public Shared Function FromNumber(val As Byte) As String
Return GetNumberToRoman(val)
End Function
Public Shared Function FromNumber(val As SByte) As String
Return GetNumberToRoman(val)
End Function
Public Shared Function FromNumber(val As Int16) As String
Return GetNumberToRoman(val)
End Function
Public Shared Function FromNumber(val As Int32) As String
Return GetNumberToRoman(val)
End Function
Public Shared Function FromNumber(val As UInt16) As String
Return GetNumberToRoman(val)
End Function
Public Shared Function FromNumber(val As UInt32) As String
Return GetNumberToRoman(val)
End Function
Public Shared Function ToByte(val As String) As Byte
Return GetNumberFromRoman(val)
End Function
Public Shared Function ToSByte(val As String) As SByte
Return GetNumberFromRoman(val)
End Function
Public Shared Function ToInt16(val As String) As Int16
Return GetNumberFromRoman(val)
End Function
Public Shared Function ToInt32(val As String) As Int32
Return GetNumberFromRoman(val)
End Function
Public Shared Function ToUInt16(val As String) As UInt16
Return GetNumberFromRoman(val)
End Function
Public Shared Function ToUInt32(val As String) As UInt32
Return GetNumberFromRoman(val)
End Function
Private Shared Function GetNumberToRoman(val As Integer) As String
Dim v As String = ""
Do While val > 0
If val >= 1000 Then
v &= "M" : val -= 1000
ElseIf val >= 900 Then
v &= "CM" : val -= 900
ElseIf val >= 500 Then
v &= "D" : val -= 500
ElseIf val >= 400 Then
v &= "CD" : val -= 400
ElseIf val >= 100 Then
v &= "C" : val -= 100
ElseIf val >= 90 Then
v &= "XC" : val -= 90
ElseIf val >= 50 Then
v &= "L" : val -= 50
ElseIf val >= 40 Then
v &= "XL" : val -= 40
ElseIf val >= 10 Then
v &= "X" : val -= 10
ElseIf val >= 9 Then
v &= "IX" : val -= 9
ElseIf val >= 5 Then
v &= "V" : val -= 5
ElseIf val >= 4 Then
v &= "IV" : val -= 4
Else
v &= "I" : val -= 1
End If
Loop
Return v
End Function
Private Shared Function GetNumberFromRoman(val As String) As Object
Dim v As Integer = 0
If val.Contains("IV") Then v += 4 : val = val.Replace("IV", "")
If val.Contains("IX") Then v += 9 : val = val.Replace("IX", "")
If val.Contains("XL") Then v += 40 : val = val.Replace("XL", "")
If val.Contains("XC") Then v += 90 : val = val.Replace("XC", "")
If val.Contains("CD") Then v += 400 : val = val.Replace("CD", "")
If val.Contains("CM") Then v += 900 : val = val.Replace("CM", "")
For Each c As Char In val
If c = "I" Then v += 1
If c = "V" Then v += 5
If c = "X" Then v += 10
If c = "L" Then v += 50
If c = "C" Then v += 100
If c = "D" Then v += 500
If c = "M" Then v += 1000
Next
Return v
End Function
End Class
aLearningLady
- 1,988
- 4
- 24
- 42
Yarc
- 1
-
1While this code may answer the question, it is better to also provide some explanations to explain your reasoning and what it does. – nalply Sep 06 '15 at 14:03