问题
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
回答1:
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.
回答2:
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.
回答3:
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))
回答4:
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
来源：https://stackoverflow.com/questions/11305822/format-numbers-to-roman-numerals