Conversion Chiffres Romains

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 636 fois - Téléchargée 12 fois

Commenter

Contenu du snippet 

Module Module1

    Sub Main()
        Dim NombreDec, NombreRom As String

        Console.Write("Tapez votre nombre entier: ")
        NombreDec = Console.ReadLine
        If NombreDec = String.Empty Then Exit Sub
        If Val(NombreDec) = 0 Then Exit Sub

        NombreRom = ToRoman(Val(NombreDec))
        Console.WriteLine(NombreDec & " = " & NombreRom)

        NombreDec = TODec(NombreRom)
        Console.WriteLine(NombreRom & " = " & NombreDec)
        Console.WriteLine("Appuyer sur la touche <<Entrée>> pour sortir")
        Console.Read()

    End Sub

    Function ToRoman(ByVal i As Integer) As String
        Dim Roman() As String = {"M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I"}
        Dim RomanV() As Integer = {1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1}
        Dim cpt, index, j As Integer
        Dim res As String
        cpt = i
        If i = 0 Then Return "Erreur"

        While cpt > 0
            For j = LBound(Roman) To UBound(Roman)
                index = RomanV(j)
                If (cpt  index) > 0 Then
                    res &= Roman(j)
                    cpt -= index
                    Exit For
                End If
            Next
        End While

        Return res
    End Function

    Function TODec(ByVal valeur As String) As Integer
        Dim sum As Integer
        Dim incr As Integer
        Dim decr As Integer
        If String.IsNullOrEmpty(valeur) Then Exit Function

        For i As Integer = valeur.Length - 1 To 0 Step -1
            decr = 0
            Select Case valeur.Substring(i, 1)
                Case "I"
                    incr = 1
                Case "V"
                    incr = 5
                    If (i <> 0) AndAlso (valeur.Substring(i - 1, 1) = "I") Then decr = 1
                Case "X"
                    incr = 10
                    If (i <> 0) AndAlso (valeur.Substring(i - 1, 1) = "I") Then decr = 1
                Case "L"
                    incr = 50
                    If (i <> 0) AndAlso (valeur.Substring(i - 1, 1) = "X") Then decr = 10
                Case "C"
                    incr = 100
                    If (i <> 0) AndAlso (valeur.Substring(i - 1, 1) = "X") Then decr = 10
                Case "D"
                    incr = 500
                    If (i <> 0) AndAlso (valeur.Substring(i - 1, 1) = "C") Then decr = 100
                Case "M"
                    incr = 1000
                    If (i <> 0) AndAlso (valeur.Substring(i - 1, 1) = "C") Then decr = 100
                Case Else
                    Return -1
            End Select

            sum = sum + incr
            If decr <> 0 Then
                sum = sum - decr
                i -= 1
            End If
        Next

        Return sum
    End Function
End Module

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.