Les Snippets

Nouveaux snippets
Snippets les plus consultés
Proposer un snippet

 Abonnez vous à ce fil d'information Les rss

Rechercher :

Par langages :

Par Catégorie

Compteurs


Nombre de sujets : 726
Nombre de snippets : 2253
Connexion

Conversion de nombres Romain en Décimal

Niveau requis pour utiliser/comprendre cette source : 1 ( Débutant )
Créé le 15/01/2008 22:10:50 et initié par casy [Liste]
Date de mise à jour : 16/01/2008 09:49:18
Vue : 13429
Catégorie(s) : Maths
Langages dispo pour ce code :
- VB6, VBA
- VB 2005
- Delphi 5
- Java
- Tcl
Proposer ce code dans un autre langage



Langage : VB6 , VBA
Date ajout : 15/01/2008
Posté par casy [Liste]
DateMAJ : 16/01/2008 
Public Function CVTRomDec(valeur As String) As Long
'Pour Excel en cellule : Public Function CVTRomDec(cellule  As  Range) As Long
'Dim valeur  As  String
'valeur  =  CStr(cellule.value)
Dim sum As Long
Dim incr As Long
Dim decr As Long
Dim i As Integer
If Len(valeur) = 0 Then
  CVTRomDec = 0
  Exit Function
End If
sum = 0
For i = Len(valeur) To 1 Step -1
  incr = 0
  decr = 0
  Select Case Mid(valeur, i, 1)
    Case "I"
      incr = 1
    Case "V"
      incr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
    Case "X"
      incr = 10
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
    Case "L"
      incr = 50
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "X" Then decr = 10
    Case "C"
      incr = 100
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "X" Then decr = 10
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "L" Then decr = 50
    Case "D"
      incr = 500
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "X" Then decr = 10
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "L" Then decr = 50
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "C" Then decr = 100
    Case "M"
      incr = 1000
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "I" Then decr = 1
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "V" Then decr = 5
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "X" Then decr = 10
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "L" Then decr = 50
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "C" Then decr = 100
      If (i > 1) Then If Mid(valeur, i - 1, 1) = "D" Then decr = 500
    Case Else
      CVTRomDec = 0
      Exit Function
  End Select
  sum = sum + incr
  If decr <> 0 Then
    sum = sum - decr
    i = i - 1
  End If
Next
CVTRomDec = sum
End Function
Remarque :
Prévue pour VB6 et VBA, elle est facilement adaptable pour etre utilisée directement dans une cellule d'Excel (Voir Commentaire).
Langage : VB 2005
Date ajout : 15/01/2008
Posté par casy [Liste]
DateMAJ : 16/01/2008 
Public Function CVTRomDec(ByVal valeur As String) As Long
  Dim sum as Long = 0
  Dim incr as Long = 0
  Dim decr As Long = 0
  If String.IsNullOrEmpty(valeur) Then Return 0
  
  For i As Integer = valeur.Length - 1 To 0 Step  -1
    Select Case valeur.Substring(i, 1)
      Case "I"
        incr = 1
      Case "V"
        incr = 5
        If (i > 1) AndAlso valeur.Substring(i - 1, 1) = "I" Then decr = 1
      Case "X"
        incr = 10
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "I" Then decr = 1
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "V" Then decr = 5
      Case "L"
        incr = 50
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "I" Then decr = 1
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "V" Then decr = 5
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "X" Then decr = 10
      Case "C"
        incr = 100
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "I" Then decr = 1
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "V" Then decr = 5
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "X" Then decr = 10
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "L" Then decr = 50
      Case "D"
        incr = 500
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "I" Then decr = 1
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "V" Then decr = 5
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "X" Then decr = 10
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "L" Then decr = 50
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "C" Then decr = 100
      Case "M"
        incr = 1000
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "I" Then decr = 1
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "V" Then decr = 5
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "X" Then decr = 10
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "L" Then decr = 50
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "C" Then decr = 100
        If (i > 1) AndAlso valeur.Substring(i -  1, 1) = "D" Then decr = 500
      Case Else
        Return 0
    End Select
    
    sum += incr
    If decr <> 0 Then
      sum -= decr
      i -= 1
    End If
Langage : Delphi 5
Date ajout : 19/01/2008
Posté par f0xi [Liste]
voir la source :
 
 DelphifFR - Unité RomanUtils
Langage : Java
Date ajout : 19/01/2008
Posté par f0xi [Liste]
Voir la source de dje_jay (translation 1:1 de ma source) :
 
 JavaFr - RomanUtils
Langage : Tcl
Date ajout : 28/07/2009
Posté par gersoo [Liste]
namespace path ::tcl::mathop
proc Rom2Dec {N} {
  + {*}[string map {
    IV {4 } IX {9 } XL {40 } XC {90 } CD {400 } CM {900 }
    I {1 } V {5 } X {10 } L {50 } C {100 } D {500 } M {1000 }
  } $N]
}
puts [Rom2Dec XXIV]

Snippets en rapport avec : Convertion, Romain

27/08/2010 - Conversion Nombre Arabe en Nombre Romain

05/02/2010 - CONVERTION UNITE DE VITESSE

05/07/2008 - Binaire vers Hexa (BinToHex) et Hexa vers Binaire (HexToBin)

04/03/2007 - Convertion toutes données vers chaine representation binaire

17/09/2006 - Convertion de chaine ANSI>ASCII et ASCII>ANSI



Codes sources en rapport avec : Convertion, Romain

{Visual Basic, VB6, VB.NET, VB 2005} SLOT MACHINE POKER
jeux de slot machine poker complet de source file et images permet de jouer a poker comme dans le sa...

{C# / C#.NET} PC DEVIN UNE CARTE
jeu de carte solitaire le pc va a deviner una carte che vous avez choisi e memorise jeu tres simpl...

{C# / C#.NET} ROBY CARDS
Jeu de Solitaire avec le carte le regle sont facile sont sur le style de patience . A debut jouer un...

{Delphi} SIZECONVERTER : UNE MINI LIBRAIRIE DE CONVERSION DE TAILLE
J'avais besoin de convertir des tailles de fichier exprimées en diférentes unités (Ko, Mo, Go...) en...

{C# / C#.NET} BRICK OUT!
petit jeux de casse brick pour le debutant juoer contre le pc ou le pc juoe seul, la source est simp...

{PHP} CONVERTISSEUR LAMBERT2 ÉTENDU EN COORDONNÉE GÉOGRAPHIQUE (LONGITUDE/LATITUDE)
Il s'agit d'un fichier php assez utile que j'ai du développer dans le cadre d'un projet qui permet, ...

{C# / C#.NET} AJOUT D'UNE IMAGE DANS UN RICHTEXTBOX SANS PRESS-PAPIER
Suite a plusieur question dans le forum et un message privé. voici une class static de converssio...

{C / C++ / C++.NET} CONVERTISSEUR NOMBRE ARABE EN NOMBRE ROMAIN
voici un petit programme qui transcris un nombre arabe en nombre romain. explications : on vér...

{C / C++ / C++.NET} CONVERTISSEUR NOMBRE ARABE => NOMBRE ROMAIN (1 À 4999)
Convertisseur de nombre arabe en nombre romain (de 1 à 4999). Aucune bibliothèque mathématique ut...

{C# / C#.NET} BATCHIMAGECONVERTER
Petite application répondant à un besoin ponctuel mais récurrent ! L'idée est de pouvoir convertir ...