Mensaje enviado por Jordi Ordiñana <qvestor@teleline.es>

Andrés:
Aquí te envío una posible solución. Todo depende de lo grandes que sean los números que vas a convertir. Este código vale para números de 1 a 999999 (el cero no se representa).

Hay una dificultad a la hora de representar los números romanos.

Los millares superiores a 3.000 se representan con el número normal y un subrayado superior.
                                        _
P.e.: 10.000 no sería XXXXXXXXXX sino X (con la rayita encima de la X).
                       ____
   y 125.000 sería CXXV

Los millones a partir de 3.000.000, se representarían con un subrayado superior doble (dos rayitas). Pero dudo que los romanos (los de antes) manejaran cifras tan altas.

Pero, como no tengo ningún tipo de letra que subraye arriba las letras IVXLCDM, he optado por la solución que he visto en alguna parte, de encerrar los millares entre paréntesis.

Si consigues algún tipo de letra que haga el subrayado, puedes eliminar este "parche" cambiando el código.

Este código lo he ido probando, y me da resultados correctos.

Espero haber sido de ayuda. Un cordial saludo.

Jordi Ordiñana.
Barcelona - España.
mailto:qvestor@teleline.es





------- CONVERTIR NUMEROS DECIMALES A ROMANOS -----------------------------

' Un Form con 1 TextBox y 1 Label. El valor de la etiqueta se actualiza
' con cada cambio del TextBox.

Option Explicit

Private Sub txtDec_Change()
    With txtDec
        lblRom.Text = Dec2Romano(.Text)
        .SelStart = Len(.Text)
    End With
End Sub

Function Dec2Romano(strDec As String) As String
Dim strRom As String
Dim i As Integer, n As Integer, m As Integer
Dim str1 As String, str2 As String, bRom As Boolean

    n = Len(strDec)
    If n > 3 Then
        str1 = Right(strDec, 3)
        str2 = Left(strDec, n - 3)
    Else
        str1 = strDec
        str2 = ""
    End If

    n = 0
    For i = 0 To Len(str1) - 1
        n = n + 1
        strRom = strDig(Mid(str1, Len(str1) - i, 1), n, False) & strRom
    Next

    If Len(str2) > 0 Then
        str1 = ""
        n = 0
        For i = 0 To Len(str2) - 1
            n = n + 1
            str1 = strDig(Mid(str2, Len(str2) - i, 1), n, True) & str1
        Next
        Dec2Romano = IIf(Left(str1, 1) = "M", str1, "(" & str1 & ")") & strRom
    Else
        Dec2Romano = strRom
    End If

End Function



Function strDig(strTxt As String, n As Integer, m As Boolean) As String
Dim str1 As String, str2 As String, str3 As String
     ' Esta segunda función da resultados parciales para cada grupo de tres cifras.

    ' Si consigues el tipo de letra que subraye arriba, habría que cambiar este grupo
    ' If...Endif según si el valor m es True o False

    If n = 1 Then
        str1 = IIf(m = True, "M", "I")
        str2 = "V"
        str3 = "X"
    ElseIf n = 2 Then
        str1 = "X"
        str2 = "L"
        str3 = "C"
    ElseIf n = 3 Then
        str1 = "C"
        str2 = "D"
        str3 = "M"
    End If

    Select Case strTxt
        Case "0"
            strDig = ""
        Case "1", "2", "3"
            strDig = String(Val(strTxt), str1)
        Case "4"
            strDig = IIf(str1 = "M", "I", str1) & str2
        Case "5"
            strDig = str2
        Case "6", "7", "8"
            strDig = str2 & String(Val(strTxt) - 5, IIf(str1 = "M", "I", str1))
        Case "9"
            strDig = IIf(str1 = "M", "I", str1) & str3
    End Select
End Function

-----Mensaje original-----
De: Andrés Colmenero [mailto:acolmenero@colortex.net]
Enviado el: martes, 24 de octubre de 2000 13:41
Para: visualbasic-esp@egroups.com
Asunto: (VB-ESP) Ayuda convertir de decimal a romano


Alguien me puede decir donde encuentro una rutina que transforme cualquier
número decimal a romano.?
Muchas Gracias.