Private Sub Text1_Change()
Dim dec As Integer
Dim scratch As String
scratch = ""
On Error GoTo Endp
dec = Text1.Text
If (dec =  0  Or dec >  3999 ) Then GoTo Endp
Dim Romans( 13 ) As String
Romans( 1 ) = "I"
Romans( 2 ) = "IV"
Romans( 3 ) = "V"
Romans( 4 ) = "IX"
Romans( 5 ) = "X"
Romans( 6 ) = "XL"
Romans( 7 ) = "L"
Romans( 8 ) = "XC"
Romans( 9 ) = "C"
Romans( 10 ) = "CD"
Romans( 11 ) = "D"
Romans( 12 ) = "CM"
Romans( 13 ) = "M"
Dim Arabics( 13 ) As Integer
Arabics( 1 ) =  1 
Arabics( 2 ) =  4 
Arabics( 3 ) =  5 
Arabics( 4 ) =  9 
Arabics( 5 ) =  10 
Arabics( 6 ) =  40 
Arabics( 7 ) =  50 
Arabics( 8 ) =  90 
Arabics( 9 ) =  100 
Arabics( 10 ) =  400 
Arabics( 11 ) =  500 
Arabics( 12 ) =  900 
Arabics( 13 ) =  1000 
Dim i As Integer

For i =  13  To  1  Step - 1 
   While (dec >= Arabics(i))
      dec = dec - Arabics(i)
      scratch = scratch + Romans(i)
   Wend
Next
Endp:
Label1.Caption = scratch
End Sub

Private Sub Text2_Change()
Dim Rom As String
Rom = Text2.Text

Dim Romans As String
Romans = "IVXLCDM"
Dim Arabics( 7 ) As Integer
Arabics( 1 ) =  1 
Arabics( 2 ) =  5 
Arabics( 3 ) =  10 
Arabics( 4 ) =  50 
Arabics( 5 ) =  100 
Arabics( 6 ) =  500 
Arabics( 7 ) =  1000 

Dim Cnt As Integer
Dim i As Integer
Dim j As Integer
Dim jPre As Integer
Dim dec As Integer
Dim lPrec As Boolean
dec =  0 
jPre = - 1 
Cnt =  0 
lPrec = False

For i = Len(Rom) To  1  Step - 1 
   s = Mid$(Rom, i,  1 )
   j = InStr(Romans, s)
   If (j =  0 ) Then
      dec =  0 
      GoTo Endp2
   End If

   If (jPre = j) Then
       Cnt = Cnt +  1 
   Else
       Cnt =  1 
       lPrec = False
   End If
   
   If lPrec Then
      dec =  0 
      GoTo Endp2
   End If
   
   If Cnt >  3  Then
      dec =  0 
      GoTo Endp2
   End If

   If (jPre > j) Then
        dec = dec - Arabics(j)
        lPrec = True
   Else
       dec = dec + Arabics(j)
   End If
   jPre = j
Next
Endp2:
Label2.Caption = dec

End Sub