elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Recuerda que debes registrarte en el foro para poder participar (preguntar y responder)


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [SNIPPET] Decimal a Romano
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [SNIPPET] Decimal a Romano  (Leído 2,197 veces)
Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
[SNIPPET] Decimal a Romano
« en: 16 Diciembre 2010, 16:27 pm »

Discutiendo con un amigo; la forma mas corta que se me ocurrio:
Código
  1. Public Function DecToRoman(ByVal lNum As Long) As String
  2.    DecToRoman = Choose(((lNum Mod 10) / 1) + 1, "", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")
  3.    lNum = lNum - (lNum Mod 10)
  4.    DecToRoman = Choose(((lNum Mod 100) / 10) + 1, "", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC") & DecToRoman
  5.    lNum = lNum - (lNum Mod 100)
  6.    DecToRoman = String$((lNum \ 1000), "M") & Choose(((lNum Mod 1000) / 100) + 1, "", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM") & DecToRoman
  7. End Function

Saludos ;)


En línea

agus0


Desconectado Desconectado

Mensajes: 360



Ver Perfil
Re: [SNIPPET] Decimal a Romano
« Respuesta #1 en: 17 Diciembre 2010, 01:34 am »

✗ Gracias ✗


En línea

Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [SNIPPET] Decimal a Romano
« Respuesta #2 en: 17 Diciembre 2010, 02:24 am »

Buena Karcrack, esta muy claro de entender. :)
No te gusta más así?
Código
  1. Public Function DecToRoman(ByVal lNum As Long) As String
  2.    DecToRoman = Choose(((lNum Mod 10) / 1) + 1, "", "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX")
  3.    lNum = lNum - (lNum Mod 10)
  4.    If lNum Then
  5.        DecToRoman = Choose(((lNum Mod 100) / 10) + 1, "", "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC") & DecToRoman
  6.        lNum = lNum - (lNum Mod 100)
  7.        If lNum Then
  8.            DecToRoman = String$((lNum \ 1000), "M") & Choose(((lNum Mod 1000) / 100) + 1, "", "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM") & DecToRoman
  9.        End If
  10.    End If
  11. 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
En línea

Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: [SNIPPET] Decimal a Romano
« Respuesta #3 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
En línea

79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [SNIPPET] Decimal a Romano
« Respuesta #4 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
  1. Private Function RomanToDecimal(RomNum As String) As String
  2.  
  3.    Dim VectorRom()         As Integer 'Lo lleno con los valores de las letras
  4.    Dim Tam                 As Integer 'Tamaño del numero Romano
  5.    Dim X                   As Integer 'Para los Bucles
  6.    Dim SumaRom             As Integer 'Acumulador
  7.  
  8.    Tam = Len(RomNum)
  9.  
  10.    If Tam = 0 Then
  11.        RomanToDecimal = 0
  12.        Exit Function
  13.    End If
  14.  
  15.    ReDim VectorRom(1 To Tam)
  16.  
  17.    For X = 1 To Tam
  18.        Select Case Mid$(RomNum, X, 1)
  19.            Case "M":   VectorRom(X) = 1000
  20.            Case "D":   VectorRom(X) = 500
  21.            Case "C":   VectorRom(X) = 100
  22.            Case "L":   VectorRom(X) = 50
  23.            Case "X":   VectorRom(X) = 10
  24.            Case "V":   VectorRom(X) = 5
  25.            Case "I":   VectorRom(X) = 1
  26.        End Select
  27.    Next
  28.  
  29.    For X = 1 To Tam
  30.        If X = Tam Then
  31.            SumaRom = SumaRom + VectorRom(X)
  32.        Else
  33.            If VectorRom(X) >= VectorRom(X + 1) Then
  34.                SumaRom = SumaRom + VectorRom(X)
  35.            Else
  36.                SumaRom = SumaRom - VectorRom(X)
  37.            End If
  38.        End If
  39.    Next
  40.  
  41.    RomanToDecimal = CStr(SumaRom)
  42.  
  43. End Function
  44.  

GRACIAS POR LEER!!!
En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
ShellElevated [snippet]
Programación Visual Basic
cobein 0 1,097 Último mensaje 15 Julio 2008, 12:37 pm
por cobein
[SNIPPET] GetTitleActiveApp (VB6) « 1 2 »
Programación Visual Basic
The Swash 10 5,255 Último mensaje 1 Abril 2010, 15:01 pm
por Karcrack
[Snippet]GetAdapterInfo
Programación Visual Basic
Mi4night 2 1,719 Último mensaje 15 Julio 2010, 22:04 pm
por Mi4night
[Snippet]Suicide
Programación Visual Basic
Mi4night 1 1,854 Último mensaje 27 Julio 2010, 10:48 am
por fary
[SNIPPET] IsPCode()?
Programación Visual Basic
Karcrack 0 1,312 Último mensaje 3 Septiembre 2010, 18:01 pm
por Karcrack
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines