Calcolatrice con numeri romani, tipo XX - IX = XI

Option Explicit
Dim CRoman  As Boolean ' Valore boleano per determinare se si usano mumeri romai o decimali
Dim Operaz As Boolean ' Valore boleano per determinare se si stà eseuendo un'operazione
Dim Operator As String, Result As Integer
Dim I As String
Dim V As String
Dim X As String
Dim L As String
Dim C As String
Dim D As String
Dim M As String

Function RomDec(q As String) As Integer
Dim Y As Integer
   Y = 0
   I = 1
   V = 5
   X = 10
   L = 50
   C = 100
   D = 500
   M = 1000
   If q = "I" Then
       Y = I
   ElseIf q = "V" Then
       Y = V
   ElseIf q = "X" Then
       Y = X
   ElseIf q = "L" Then
       Y = L
   ElseIf q = "C" Then
       Y = C
   ElseIf q = "D" Then
       Y = D
   ElseIf q = "M" Then
       Y = M
   End If
   RomDec = Y
End Function

Function RomanToDec(ByVal N1 As String) As Integer
'Funzione di conversione da romano a decimale
'Riceve in entrata per valore un nstringa (ByVal N)
'E restituisce una intero, o numero decimale. [ RomanToDec(xxx) ]
Dim X As Integer, Decim As Integer, t As String, dc As Integer, dc1 As Integer, z As Integer

X = 2
t = ""
dc = 0
dc1 = 0
Decim = 0
For z = 1 To (Len(N1))
   t = Mid(N1, z, 1)
   dc = RomDec(t)
       t = Mid(N1, X, 1)
   dc1 = RomDec(t)
       If dc >= dc1 Then
           Decim = Decim + (dc + dc1) - dc1
       ElseIf dc < dc1 Then
           Decim = Decim + (-dc * 2 + dc1) + dc - dc1
       End If
   X = X + 1
Next z
   RomanToDec = Decim
End Function

Private Sub SMSD()
On Error GoTo ERRHANDLER
'Legge e separa i numeri dall'operatore.
Dim r As Integer, NFirst, NSecond, X As Integer, N1 As Integer, N2 As Integer
X = 0: N1 = 0: N2 = 0
For r = 1 To Len(lblVisual.Caption)
If Mid(lblVisual.Caption, r, 1) = "+" Or Mid(lblVisual.Caption, r, 1) = "-" _
Or Mid(lblVisual.Caption, r, 1) = "*" Or Mid(lblVisual.Caption, r, 1) = "/" Then
X = r - 1
Operator = Mid(lblVisual.Caption, r, 1) 'Operatore
End If
Next r
NFirst = Mid(lblVisual.Caption, 1, X)  'Primo numero
NSecond = Mid(lblVisual.Caption, X + 2, Len(lblVisual.Caption)) 'Secondo numero
If CRoman = True Then ' converte romano in decimale
N1 = RomanToDec(NFirst)
N2 = RomanToDec(NSecond)
Else
N1 = Int(NFirst)
N2 = Int(NSecond)
End If
Select Case Operator
Case "+"
   Result = N1 + N2
Case "-"
   Result = N1 - N2
Case "*"
   Result = N1 * N2
Case "/"
   Result = N1 \ N2
End Select
If CRoman = True Then ' converte romano in decimale
lblConv.Caption = "Risultato = " & NumRoman(Result)
Else
lblConv.Caption = "Risultato = " & Result
End If
Exit Sub
ERRHANDLER:
MsgBox ("Errore durante il calcolo..."), vbOKOnly + vbExclamation, "Err."
Call cmdCanc_Click
End Sub

Private Sub cmdCanc_Click()
lblVisual.Caption = Empty
lblConv.Caption = Empty
cmdConvRomDec.Enabled = True
cmdConvDecRom.Enabled = True
Operaz = False
Operator = Empty
End Sub

Private Sub cmdConvDecRom_Click()
FDecimal.Move 120, 840
FRoman.Visible = False
FDecimal.Visible = True
CRoman = False
Call cmdCanc_Click
End Sub

Private Sub cmdConvRomDec_Click()
FRoman.Move 120, 840
FRoman.Visible = True
FDecimal.Visible = False
CRoman = True
Call cmdCanc_Click
End Sub


Private Sub cmdResult_Click()
If Operaz = True Then
Call SMSD 'Chiama la routine che (S)omma, (M)oltiplica, (S)ottrae, (D)ivide.
Exit Sub
End If
If CRoman = False Then     '*** Visualizza la decodifica da decimale a romano
lblConv.Caption = NumRoman(lblVisual.Caption)
ElseIf CRoman = True Then '*** Visualizza la decodifica da romano a decimale
lblConv.Caption = RomanToDec(lblVisual.Caption)
End If
End Sub

Private Sub Form_Load()
FrmMain.Caption = App.Title
lblVisual.Caption = Empty
CRoman = True
End Sub

Private Sub ErrNumOver()
MsgBox ("Numero tropo grande, max(3999)!!!"), vbOKOnly + vbInformation, "Sorry:"
Call cmdCanc_Click
End Sub

Function NumRoman(ByVal N As Integer) As String
'Funzione di conversione da decimale a romano
'Riceve in entrata per valore un num decimale intero (ByVal N)
'E restituisce una stringa, o numero romano. [ NumRoman(xxx) ]
     If N > 3999 Then
     Call ErrNumOver
     Exit Function
     End If
     Const NRomani = "IVXLCDM"    '*** Dichiaro la costante con i numeri romani
     Dim nr As Integer, Resto As Integer, t As String   '*** Variabili locali di funzione
       nr = 1
       t = ""
       Do While N > 0
         Resto = N Mod 10
         N = N \ 10
         Select Case Resto
           Case 1
             t = Mid(NRomani, nr, 1) & t
           Case 2
             t = Mid(NRomani, nr, 1) & Mid(NRomani, nr, 1) & t
           Case 3
             t = Mid(NRomani, nr, 1) & Mid(NRomani, nr, 1) & Mid(NRomani, nr, 1) & t
           Case 4
             t = Mid(NRomani, nr, 2) & t
           Case 5
             t = Mid(NRomani, nr + 1, 1) & t
           Case 6
             t = Mid(NRomani, nr + 1, 1) & Mid(NRomani, nr, 1) & t
           Case 7
             t = Mid(NRomani, nr + 1, 1) & Mid(NRomani, nr, 1) & Mid(NRomani, nr, 1) & t
           Case 8
             t = Mid(NRomani, nr + 1, 1) & Mid(NRomani, nr, 1) & Mid(NRomani, nr, 1) & Mid(NRomani, nr, 1) & t
           Case 9
             t = Mid(NRomani, nr, 1) & Mid(NRomani, nr + 2, 1) & t
         End Select
         nr = nr + 2
       Loop
       NumRoman = t
End Function


Private Sub NumD_Click(Index As Integer)
Select Case Index
Case Index
cmdConvRomDec.Enabled = False
cmdConvDecRom.Enabled = False
lblVisual.Caption = lblVisual.Caption & NumD(Index).Caption
End Select
End Sub

Private Sub NumR_Click(Index As Integer)
Select Case Index
Case Index
cmdConvRomDec.Enabled = False
cmdConvDecRom.Enabled = False
lblVisual.Caption = lblVisual.Caption & NumR(Index).Caption
End Select

End Sub


Private Sub Oper_Click(Index As Integer)
Select Case Index
Case Index
lblVisual.Caption = lblVisual.Caption & Oper(Index).Caption
End Select
Operaz = True
End Sub