Konversi number to Romawi

Konversi Number To Romawi

Posted by rela eka under Code, Visual Basic 6 | Tags: Function, Fungsi, Romawi, VB6, Visual Basic |
Leave a Comment

Bagi anda yang membutuhkan konversi nilai menuju Romawi atau sebaliknya. Berikut ini sintax Function yang bisa digunakan :

Public Function NumberToRomawi(ByVal cNumber As Long) As String

    Dim n As Long

    Dim IntIdy As Integer, intIdx As Integer

    Dim Rom, Latin

    Dim Romawi As String

    Rom = Array("I", "IV", "V", "IX", "X", "XL", "L", "XC", "C", "CD", "D", "CM", "M")

    Latin = Array(1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000)

    Romawi = ""

    For IntIdy = 12 To 0 Step -1

        n = Int(cNumber / Latin(IntIdy))

        If n <> 0 Then

            For intIdx = 1 To n

                Romawi = Romawi & Rom(IntIdy)

            Next intIdx

        End If

        cNumber = cNumber Mod Latin(IntIdy)

    Next

    NumberToRomawi = Romawi

End Function

Public Function RomawiToNumber(cRomawi As String) As Long

    Dim n As Long

    Dim intIdx As Integer

    Dim Rom, Latin

    Rom = Array("I", "1", "V", "2", "X", "3", "L", "4", "C", "5", "D", "6", "M")

    Latin = Array(1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000)

    cRomawi = Replace(cRomawi, "IV", "1")

    cRomawi = Replace(cRomawi, "IX", "2")

    cRomawi = Replace(cRomawi, "XL", "3")

    cRomawi = Replace(cRomawi, "XC", "4")

    cRomawi = Replace(cRomawi, "CD", "5")

    cRomawi = Replace(cRomawi, "CM", "6")

    n = 0

    For intIdx = 12 To 0 Step -1

        While Rom(intIdx) = Mid(cRomawi, 1, 1) And Len(cRomawi) > 0

            n = n + Latin(intIdx)

            cRomawi = Mid(cRomawi, 2)

        Wend

    Next intIdx

    RomawiToNumber = n

End Function