Conversion Chiffres Romains

Soyez le premier à donner votre avis sur cette source.

Snippet vu 2 681 fois - Téléchargée 9 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.