将数字格式化为罗马数字？

Question

是否可以使用 Format 函数以罗马数字显示整数？

For Counter As Integer = 1 To 10
   Literal1.Text &= Format(Counter, "???")
Next

Answer 1

这是我在http://www.source-code.biz/snippets/vbasic/7.htm找到的

（最初由 Christian d'Heureuse 先生在 VB 中编写）

我将其转换为 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

我希望这对其他人有帮助。

干杯 - 戴夫。

Answer 2

不，没有标准的格式化程序。

如果您阅读Wikipedia on Roman numerals，您会发现有多种格式化罗马数字的方法。所以你必须编写自己的方法use the code of someone else。

Answer 3

我编写的这段代码可以完美运行到一百万。 您可以使用它，但请不要将其设为您自己的。

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

使用函数 hexRoman，像这个例子：

msgbox(Broman.hexRoman(50))

Answer 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