Sólo texto | Texto con Imágenes

Test Foro de elhacker.net SMF 2.1

Programación => .NET (C#, VB.NET, ASP) => Programación General => Programación Visual Basic => Mensaje iniciado por: Karcrack en 16 Diciembre 2010, 16:27 PM

Título: [SNIPPET] Decimal a Romano
Publicado por: Karcrack en 16 Diciembre 2010, 16:27 PM
Discutiendo con un amigo; la forma mas corta que se me ocurrio:
Código (vb) [Seleccionar]
Public Function DecToRoman(ByVal lNum As Long) As String
    DecToRoman = Choose(((lNum Mod 10) / 1) + 1, "", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")
    lNum = lNum - (lNum Mod 10)
    DecToRoman = Choose(((lNum Mod 100) / 10) + 1, "", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC") & DecToRoman
    lNum = lNum - (lNum Mod 100)
    DecToRoman = String$((lNum \ 1000), "M") & Choose(((lNum Mod 1000) / 100) + 1, "", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM") & DecToRoman
End Function

Saludos ;)
Título: Re: [SNIPPET] Decimal a Romano
Publicado por: agus0 en 17 Diciembre 2010, 01:34 AM
✗ Gracias ✗
Título: Re: [SNIPPET] Decimal a Romano
Publicado por: Psyke1 en 17 Diciembre 2010, 02:24 AM
Buena Karcrack, esta muy claro de entender. :)
No te gusta más así?
Código (vb) [Seleccionar]
Public Function DecToRoman(ByVal lNum As Long) As String
    DecToRoman = Choose(((lNum Mod 10) / 1) + 1, "", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")
    lNum = lNum - (lNum Mod 10)
    If lNum Then
        DecToRoman = Choose(((lNum Mod 100) / 10) + 1, "", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC") & DecToRoman
        lNum = lNum - (lNum Mod 100)
        If lNum Then
            DecToRoman = String$((lNum \ 1000), "M") & Choose(((lNum Mod 1000) / 100) + 1, "", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM") & DecToRoman
        End If
    End If
End Function
De esta manera si es el 7 o el 46 (por ej) no sigue comprobando.
Por cierto y RomanToDec() que? :silbar: :laugh:

DoEvents! :P
Título: Re: [SNIPPET] Decimal a Romano
Publicado por: Karcrack en 17 Diciembre 2010, 10:54 AM
Lo importante es hacerlo corto, no rapido ni nada similar :P En cuanto a RomanToDec... no tiene utilidad :silbar: :xD
Título: Re: [SNIPPET] Decimal a Romano
Publicado por: 79137913 en 17 Diciembre 2010, 14:41 PM
HOLA!!!

Aunque no tenga utilidad, seguro alguien lo va a buscar y va a revivir el post asi que:

RomanToDecimal:

Código (vb) [Seleccionar]
Private Function RomanToDecimal(RomNum As String) As String

    Dim VectorRom()         As Integer 'Lo lleno con los valores de las letras
    Dim Tam                 As Integer 'Tamaño del numero Romano
    Dim X                   As Integer 'Para los Bucles
    Dim SumaRom             As Integer 'Acumulador
   
    Tam = Len(RomNum)
   
    If Tam = 0 Then
        RomanToDecimal = 0
        Exit Function
    End If
   
    ReDim VectorRom(1 To Tam)
   
    For X = 1 To Tam
        Select Case Mid$(RomNum, X, 1)
            Case "M":   VectorRom(X) = 1000
            Case "D":   VectorRom(X) = 500
            Case "C":   VectorRom(X) = 100
            Case "L":   VectorRom(X) = 50
            Case "X":   VectorRom(X) = 10
            Case "V":   VectorRom(X) = 5
            Case "I":   VectorRom(X) = 1
        End Select
    Next
   
    For X = 1 To Tam
        If X = Tam Then
            SumaRom = SumaRom + VectorRom(X)
        Else
            If VectorRom(X) >= VectorRom(X + 1) Then
                SumaRom = SumaRom + VectorRom(X)
            Else
                SumaRom = SumaRom - VectorRom(X)
            End If
        End If
    Next
   
    RomanToDecimal = CStr(SumaRom)

End Function


GRACIAS POR LEER!!!
Sólo texto | Texto con Imágenes