Evaluator in VB6.0

Evaluator in VB6.0


Option Explicit
Dim st As New Stack

Function Evaluate(ByVal str As String) As Double
    Dim word As String
    Dim i As Integer
    Dim A As Double
    Dim B As Double
    Dim C As Double
    st.FlushStack
    str = ChangeInPostFix(str)
    i = 1
    word = GetWord(str, i)
    Do While word <> ""
        Select Case Trim(word)
            Case "*"
                B = st.pop
                A = st.pop
                C = A * B
                st.push C
            Case "/"
                B = st.pop
                A = st.pop
                C = A / B
                st.push C
            Case "+"
                B = st.pop
                A = st.pop
                C = A + B
                st.push C
            Case "-"
                B = st.pop
                A = st.pop
                C = A - B
                st.push C
            Case Trim(word)
                st.push Val(word)
        End Select
        i = i + 1
        word = GetWord(str, i)
    Loop
    Evaluate = st.pop
End Function

Private Function ChangeInPostFix(ByVal str As String) As String
    Dim temp As String
    Dim word As String
    str = Trim(str)
    On Error GoTo handle
    If grid.Name <> "" Then str = ReplaceWithValue(str)
    Dim i As Integer
    i = 1
    st.push "("
    word = GetWord(str, i)
    Do While word <> ""
        Select Case Trim(word)
            Case "*"
                Do While HighPriority("*") = True
                    ChangeInPostFix = ChangeInPostFix & " " & st.pop
                Loop
                st.push "*"
            Case "/"
                Do While HighPriority("/") = True
                    ChangeInPostFix = ChangeInPostFix & " " & st.pop
                Loop
                st.push "/"
            Case "+"
                Do While HighPriority("+") = True
                    ChangeInPostFix = ChangeInPostFix & " " & st.pop
                Loop
                st.push "+"
            Case "-"
                Do While HighPriority("-") = True
                    ChangeInPostFix = ChangeInPostFix & " " & st.pop
                Loop
                st.push "-"
            Case "("
                st.push "("
            Case ")"
                temp = st.pop
                Do While temp <> "("
                    ChangeInPostFix = ChangeInPostFix & " " & temp
                    temp = st.pop
                Loop
            Case Trim(word)
                ChangeInPostFix = ChangeInPostFix & " " & Trim(word)
        End Select
        i = i + 1
        word = GetWord(str, i)
    Loop
    temp = st.pop
    Do While temp <> "("
        ChangeInPostFix = ChangeInPostFix & " " & temp
        temp = st.pop
    Loop
    Exit Function
handle:
    If Err.Number = 91 Then
        str = ""
    End If
End Function

Private Function HighPriority(opt1 As String) As Boolean
    Dim s As String
    If st.IsEmpty = False Then
        s = st.pop
        If pr(s) >= pr(opt1) Then
            HighPriority = True
        Else
            HighPriority = False
        End If
        Call st.push(s)
    End If
End Function

Private Function pr(str As String) As Integer
    Select Case str
        Case "*", "/"
            pr = 2
        Case "+", "-"
            pr = 1
        Case "("
            pr = 0
    End Select
End Function

Function GetWord(ByVal str As String, n As Integer)
    Dim word As String
    Dim i As Integer
    str = Trim(str)
    For i = 1 To n
        If InStr(1, str, " ") = 0 Then
            word = str
            str = ""
        Else
            word = Left(str, InStr(1, str, " "))
        End If
        If str <> "" Then str = Right(Trim(str), Len(str) - Len(word))
        str = Trim(str)
    Next i
    GetWord = word
End Function

Private Function GetToken(ByVal str As String) As Long
    Dim p1 As Integer
    Dim p2 As Integer
    Dim p3 As Integer
    Dim p4 As Integer
    Dim p5 As Integer
    Dim p6 As Integer
    Dim pos As Integer
    p1 = InStr(1, str, "/")
    p2 = InStr(1, str, "*")
    p3 = InStr(1, str, "+")
    p4 = InStr(1, str, "-")
    p5 = InStr(1, str, "(")
    p6 = InStr(1, str, ")")
    pos = GetSmall(p1, p2, p3, p4, p5, p6)
    GetToken = pos
End Function

Private Function GetSmall(ParamArray P()) As Long
    Dim i As Integer
    Dim Big As Long
    Dim value As Variant
    i = 0
    For Each value In P
        If P(i) < Big And P(i) <> 0 Then
            Big = P(i)
        ElseIf Big = 0 Then
            Big = P(i)
        End If
        i = i + 1
    Next
    GetSmall = Big
End Function