Conversion Chiffres Romains
Soyez le premier à donner votre avis sur cette source.
Snippet vu 2 988 fois - Téléchargée 10 fois
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
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
- Conversion chiffre romain
- 900 en chiffre romain - Meilleures réponses
- 50 en chiffre romain - Meilleures réponses
- Visual Basic / VB.NET : Convertir des chiffres romains en chiffres arabes - CodeS SourceS - Guide
- Conversion chiffre romain chiffre arabe langage c - Guide
- Algorithme conversion chiffre romain - Forum - C
- Python : Conversion Nombre Arabe en Nombre Romain - CodeS SourceS - Guide
- Algorithmie chiffres romains conversion en chiffres arabes ✓ - Forum - C
Commentaire
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.