Строковый калькулятор на VB 6.0

Private Sub CommandBut_Click()
Dim Str As String
Dim Err As Boolean
If Replace(Text1.Text, " ", "") <> "" Then
    List1.Clear
    Str = Text1.Text
    List1.AddItem Replace(Str, " ", "")
    Str = Player(Str, Err, False)
    Text2.Text = "= " & Format(Str, "#,##0.00")
    If Err Then
        MsgBox "В формуле допущена ошибка!", vbCritical
    Else
        List2.AddItem Text1.Text
    End If
End If
End Sub
 
Public Function Player(ByRef Formula As String, Optional ByRef Err As Boolean, Optional HasParent As Boolean) As String
Dim x As Long, y As Long, z As Long, SL As Long, SR As Long, SS As Long
Dim Hard As Boolean, VeryHard As Boolean
Dim GetDbl As Boolean, Ch As String
Dim Arr() As cal
Dim TMP As Double, Temp As String
ReDim Arr(1 To 1)
Formula = Replace(Formula, " ", "")
Formula = Replace(Formula, ".", ",")
Formula = Replace(Formula, "--", "+")
Formula = Replace(Formula, "+-", "-")
Formula = Replace(Formula, "-+", "-")
Hard = Formula Like "*[/*]*"
VeryHard = Formula Like "*(*)*"
On Error GoTo ErrHndl
'-----------------' переводим текст задачи в "цифровой" вид,
'-----------------' разбивая числа и символы действий на массив
For x = 1 To Len(Formula)
    Ch = Mid(Formula, x, 1)
    If (Ch = "-" And x = 1 And Mid(Formula, x + 1, 1) Like "#") _
        Or (Ch Like "#" And Not GetDbl) Then
            GetDbl = True
            Arr(UBound(Arr)).Formul = Ch
            Arr(UBound(Arr)).Type = False
    ElseIf GetDbl And (Ch Like "#" Or Ch = "." Or Ch = ",") Then
        Arr(UBound(Arr)).Formul = Arr(UBound(Arr)).Formul & Ch
    ElseIf Ch Like "[*/+()^]" Or Ch = "-" Then
        GetDbl = False
        ReDim Preserve Arr(1 To UBound(Arr) + 1)
        Arr(UBound(Arr)).Formul = Ch
        Arr(UBound(Arr)).Type = True
        ReDim Preserve Arr(1 To UBound(Arr) + 1)
    Else
        Arr(UBound(Arr)).Formul = Arr(UBound(Arr)).Formul & Ch
    End If
    If Ch = "(" Then
        SL = SL + 1
    ElseIf Ch = ")" Then
        SR = SR + 1
    End If
Next
If Arr(UBound(Arr)).Formul = "" Then
    ReDim Preserve Arr(1 To UBound(Arr) - 1)
End If
'-----------------' проверка синтаксиса
For x = 1 To UBound(Arr) - 1
    If Arr(x).Type And Arr(x + 1).Type Then
        Err = True
        Exit Function
    End If
Next
If Arr(UBound(Arr)).Type And Not Arr(UBound(Arr)).Formul Like "*[(,)]*" Then
    Err = True
    Exit Function
End If
If SL <> SR Then
    Err = True
    Exit Function
End If
'Debug.Print MyJoin(Arr)
'-----------------' раставляем порядок решения
If UBound(Arr) >= 3 Then
    For x = 1 To UBound(Arr)
        If Arr(x).Type Then
            If VeryHard Then '=============== Решение задачки со скобками
                If Arr(x).Formul = "(" Then
                    SL = x
                    SS = -1
                    For y = x + 1 To UBound(Arr)
                        If Arr(y).Formul = ")" Then
                            SS = SS + 1
                        ElseIf Arr(y).Formul = "(" Then
                            SS = SS - 1
                        End If
                        If SS = 0 Then
                            SR = y
                            '
                            Temp = MyJoin2(Arr, SL + 1, SR - 1)
                            TMP = Player(Temp, , True)
                            For z = SL To SR
                                Arr(z).Formul = ""
                            Next
                            Arr(SL).Formul = TMP
                            Temp = MyJoin(Arr)
'                            If Not HasParent Then List1.AddItem Temp & "  " & HasParent
                            Player = Player(Temp)
                            '
                            Exit For
                        End If
                    Next
                    Exit For
                End If
            ElseIf Hard Then '=============== Решение в случае наличия умножения или деления
                If Arr(x).Formul Like "[*/]" Then
                    TMP = Calcul(CDbl(Arr(x - 1).Formul), Arr(x).Formul, CDbl(Arr(x + 1).Formul))
                    Arr(x - 1).Formul = TMP
                    Arr(x).Formul = ""
                    Arr(x + 1).Formul = ""
                    Temp = MyJoin(Arr)
'                    If Not HasParent Then List1.AddItem Temp & "  " & HasParent
                    Player = Player(Temp, , False)
                    Exit For
                End If
            Else             '=============== для простой задачи, где только сложения или вычитания
                TMP = Calcul(CDbl(Arr(x - 1).Formul), Arr(x).Formul, CDbl(Arr(x + 1).Formul))
                Arr(x - 1).Formul = TMP
                Arr(x).Formul = ""
                Arr(x + 1).Formul = ""
                Temp = MyJoin(Arr)
'                If Not HasParent Then List1.AddItem Temp & "  " & HasParent
                Player = Player(Temp, , False)
                Exit For
            End If
        End If
    Next
Else
    Player = Formula
End If
'-------------------------
Exit Function
ErrHndl:
Err = True
End Function
 
Public Function Calcul(Arg1 As Double, Chrs As String, Arg2 As Double) As Double
If Chrs = "*" Then
    Calcul = Arg1 * Arg2
ElseIf Chrs = "/" Then
    Calcul = Arg1 / Arg2
ElseIf Chrs = "+" Then
    Calcul = Arg1 + Arg2
ElseIf Chrs = "-" Then
    Calcul = Arg1 - Arg2
ElseIf Chrs = "^" Then
    Calcul = Arg1 ^ Arg2
End If
End Function
 
 
Private Sub List2_DblClick()
Text1.Text = List2.Text
End Sub
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Or KeyAscii = 10 Then
    KeyAscii = 0
End If
End Sub