vb.net - 数字をローマ数字にフォーマットしますか？

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で見つけたものです

（元々はVBのChristian d'Heureuse氏によって書かれました）

私はそれを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

いいえ、そのための標準的なフォーマッタはありません。

ローマ数字に関するウィキペディアを読むと、ローマ数字をフォーマットする方法が複数あることがわかります。したがって、他の誰かのコードを使用して独自のメソッドを作成する必要があります。

Answer 3

私は100万まで完全に機能するこのコードを書きました。使用できますが、自分のものにしないでください。

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