Here is a sample program that I wrote that will ask the user to give a value in Roman Numeral and then it will be converted into its Decimal Equivalent in Visual Basic 6. Thank you.
My mobile number here in the Philippines is 09173084360.
My email address are the following jakerpomperada@gmail.com and jakerpomperada@yahoo.com.
My mobile number here in the Philippines is 09173084360.
Sample Program Output
Program Listing
Option Explicit
Dim Rm As String
Public Function ConvertToDecimal(Rm) As Integer
Dim TB
Dim Arab As Integer
Dim i As Byte, A As Integer, Utb As Integer
ReDim TB(0)
i = 1: Utb = 1
Rm = Replace(Rm, " ", "") '
Rm = UCase(Rm) '
While i <= Len(Rm)
ReDim Preserve TB(Utb)
A = NBlettre(i)
TB(Utb) = A * ValueLetters(Mid(Rm, i, 1))
Debug.Print TB(Utb)
i = i + A
Utb = Utb + 1
Wend
ReDim Preserve TB(Utb): i = 1
While i < UBound(TB)
If TB(i) < TB(i + 1) Then
Arab = Arab + TB(i + 1) - TB(i)
i = i + 2
Else
Arab = Arab + TB(i)
i = i + 1
End If
Debug.Print Arab
Wend
ConvertToDecimal = Arab
End Function
Private Function NBlettre(Deb As Byte) As Byte
Dim i As Integer, L As String
NBlettre = 1
L = Mid(Rm, Deb, 1)
For i = Deb + 1 To Len(Rm)
If Mid(Rm, i, 1) = L Then
NBlettre = NBlettre + 1
Else
Exit Function
End If
Next
End Function
Private Function ValueLetters(L As String) As Integer
Dim Romain, Arabe, i As Byte
Romain = Array("I", "V", "X", "L", "C", "D", "M")
Arabe = Array(1, 5, 10, 50, 100, 500, 1000)
For i = 0 To 6
If L = Romain(i) Then
ValueLetters = Arabe(i)
Exit Function
End If
Next i
End Function
Private Sub Command1_Click()
Label2.Caption = "The Decimal Equivalent of " & Text1.Text & " is " & ConvertToDecimal(Text1.Text) & "."
End Sub
Private Sub Command2_Click()
Text1.Text = ""
Label2.Caption = ""
Text1.SetFocus
End Sub
Private Sub Command3_Click()
End
End Sub
