Conversión
a Romanos
Fecha: 05/DIC/97
Autor: Victor Gonzalez (Maverick)
Convierte
un número árabe a número romano.
Esta función es bastante sencilla, le envías un número entero
y te devuelve una cadena con el texto que corresponde en números
romanos.
Puede ser bastante útil para mostrar información un poco
elegante, tipo Copyright (como en la tele).
Function ConvertirRomano(Numero As Integer) As String
Dim Romano As String
Dim I As Integer, Digito As Integer, X As
Integer
Dim Cadena As String, CadenaTmp As String
Dim Simbolo1 As String * 1, Simbolo2 As String
* 1, Simbolo3 As String * 1
Cadena = CStr(Numero)
For X = 1 To Len(Cadena)
If Len(Cadena) = 4
Then
Simbolo1 = "M"
Simbolo2 = "Q"
Simbolo3 = "H"
Digito = CInt(Left$(Cadena, 1))
Cadena = Right$(Cadena, 3)
ElseIf Len(Cadena) = 3
Then
Simbolo1 = "C"
Simbolo2 = "D"
Simbolo3 = "M"
Digito = CInt(Left$(Cadena, 1))
Cadena = Right$(Cadena, 2)
ElseIf Len(Cadena) = 2
Then
Simbolo1 = "X"
Simbolo2 = "L"
Simbolo3 = "C"
Digito = CInt(Left$(Cadena, 1))
Cadena = Right$(Cadena, 1)
ElseIf Len(Cadena) = 1
Then
Simbolo1 = "I"
Simbolo2 = "V"
Simbolo3 = "X"
Digito = CInt(Left$(Cadena, 1))
Cadena = ""
End If
If Digito <= 3 Then
For I = 1 To Digito
CadenaTmp = CadenaTmp & Simbolo1
Next I
ElseIf Digito < 5
Then
CadenaTmp = Simbolo1 & Simbolo2
ElseIf Digito = 5 Then
CadenaTmp = Simbolo2
ElseIf Digito <= 8
Then
CadenaTmp = Simbolo2
For I = 1 To Digito - 5
CadenaTmp = CadenaTmp & Simbolo1
Next I
ElseIf Digito = 9 Then
CadenaTmp = Simbolo1 & Simbolo3
End If
Romano = Romano &
CadenaTmp
CadenaTmp =
""
Next X
ConvertirRomano = Romano
End Function
En principio debe funcionar en cualquier versión de VB, ya que
no utiliza ninguna API o instrucción de la raras.
No es ninguna obligación, pero me gustaría que me enviarais un
e-mail para saber quien lo esta utilizando o por alguna
modificación debido a algún error, más que nada porque me
interesa que funcione bien.
Maverick
[email protected]