Conversion Chiffres Romains
Soyez le premier à donner votre avis sur cette source.
Snippet vu 1 949 fois - Téléchargée 5 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 Chiffres Romains
- Algorithmie chiffres romains conversion en chiffres arabes (Résolu) » Forum - C
- Conversion chiffres -> lettres » Codes sources - Visual Basic / VB.NET (Modules)
- Nombres en chiffres romains [borland turbo c++ 3.0] » Codes sources - C / C++ / C++.NET (Chaînes de caractères)
- Transformer un entier en chiffres romains » Codes sources - Delphi / Pascal (Divers)
- Chiffres romains en récursif et drag 'n drop » Codes sources - Delphi / Pascal (Divers)
Commentaires
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.