Attribute VB_Name = "x99_Eval"
Option Explicit
Dim e_input As String     ' Expression input string.
Dim e_OrigEval$
Dim e_tok As String       ' Current token kind.
Dim e_spelling As String  ' Current token spelling.
Dim e_error As Integer    ' Tells if syntax error occurred.

'Private Sub Form_Load()
'  Dim y As Double
'  If e_eval("1+2*3+2^3", y) Then
'    MsgBox y
'  Else
'  End If
'End Sub


'The example program listed below recognizes the following operators and
'subexpressions, listed by precedence from highest to lowest:
'   - Constants, function calls, parentheses
'   - Exponentiation ^
'   - Unary minus -
'   - Multiplication and division *, /
'   - Integer division \
'   - Integer modulus MOD
'   - Addition and subtraction +, -
'   - Relational operators =, <>, <, >, <=, >=
'   - NOT
'   - AND
'   - OR
'   - XOR
'   - EQV
'   - IMP
'The precedence of unary minus "-" and operator "NOT" indicate the highest
'possible precedence of their operand. Unary minus and "NOT" may occur in an
'expression of any precedence. The following expressions illustrate the
'precedence rules for unary minus and "NOT".
'   Expression        Value
'   ----------        -----
'    -1  ^  2          -1
'   -(1  ^  2)         -1
'   (-1) ^  2           1
'     2  ^ -2          .25
'    NOT  0  = 1       -1
'    NOT (0  = 1)      -1
'   (NOT  0) = 1        0
'    NOT  0  AND 1      1
'   (NOT  0) AND 1      1
'    NOT (0  AND 1)    -1
'The example program listed below accepts number constants written as decimal
'numbers with an optional fraction. For example, it accepts "123" and "123.4".
'It is possible to modify the program to recognize hexadecimal, scientific
'notation, or other formats.  This example program also recognizes the following
'functions: ABS,
'ATN, COS, EXP, FIX, INT, LOG, RND, SNG, SIN, SQR, and TAN.
'Steps to Create Example Program
'-------------------------------
'1. Run Visual Basic, or from the File menu, choose New Project (press  ALT, F,N) if Visual Basic is already running. frmView will be created  by default.
'2. Add a text box (Text1) and a command button (Command1) to Form1.
'3. Set the Text property for Text1 to the null string (empty).
'4. Enter the following code in the Command1 Click event procedure:
'   Sub Command1_Click ()
'       Dim n As Double
'       If e_eval(Text1.Text, n) Then
'         MsgBox Format$(n)
'       End If
'   End Sub
'5. Add the following code in the general Declarations section of frmView:
' To run this program in Visual Basic for MS-DOS, change the
' following Dim statements to DIM SHARED.
'
' e_prs
'   Parse an expression, allowing operators of a specified   precedence or higher. The lowest precedence is 1.
'   This function gets tokens with e_nxt and recursively   applies operator precedence rules.


Private Function e_CurrEval$()
  Dim a$
  a$ = Left$(e_OrigEval$, Len(e_OrigEval$) - Len(e_input))
  e_CurrEval$ = vbCrLf & vbCrLf & "Current Eval String: " & Chr$(171) & " " & a$ & " " & Chr$(187) & vbCrLf & "Remainder: " & Chr$(171) & " " & e_input & " " & Chr$(187)
End Function

' e_eval ' Evaluate a string containing an infix numeric expression. If successful,return true and place result in . ' This is the top-level function in the expression evaluator.
Function e_eval(ByVal s As String, Value As Double) As Integer ' Initialize. e_error = 0 e_input = s: e_OrigEval$ = s Call e_nxt ' Evaluate. Value = e_prs(1) ' Check for unrecognized input. If e_tok <> vbNullString And Not e_error Then '************MsgBox "Syntax error, token = ' " + e_spelling + " '" & e_CurrEval$() e_error = -1 End If e_eval = Not e_error End Function
' e_function. ' Evaluate a function. This is a helper function to simplify ' e_prs.
Function e_function(fun As String, arg As Double) As Double Dim n As Double On Error GoTo FuncError Select Case LCase$(fun) Case "abs": n = Abs(arg) Case "atn": n = Atn(arg) Case "cos": n = Cos(arg) Case "exp": n = Exp(arg) Case "fix": n = Fix(arg) Case "int": n = Int(arg) Case "log" If arg <= 0 Then MsgBox "Log of Zero or Negative Number: [" & str$(arg) & "]" & e_CurrEval$() e_error = -1 Else n = Log(arg) End If Case "rnd": n = Rnd(arg) Case "sgn": n = Sgn(arg) Case "sin": n = Sin(arg) Case "sqr" If arg < 0 Then MsgBox "Square Root of Negative Number: [" & str$(arg) & "]" & e_CurrEval$() e_error = -1 Else n = Sqr(arg) End If Case "tan": n = Tan(arg) Case Else If Not e_error Then '****MsgBox "Undefined function '" + fun + "'" & e_CurrEval$() e_error = -1 End If End Select e_function = n FuncExit: Exit Function FuncError: MsgBox "Function Error: [ " & fun & " ]" & e_CurrEval$() e_error = -1 Resume FuncExit End Function
' e_match ' Check the current token and skip past it. ' This function helps with syntax checking.
Sub e_match(token As String) If Not e_error And e_tok <> token Then '***MsgBox "Expected '" + token + "', got '" + e_spelling + "'" & e_CurrEval$() e_error = -1 End If Call e_nxt End Sub
' e_nxt ' Get the next token into e_tok and e_spelling and remove the ' token from e_input. ' This function groups the input into "words" like numbers, ' operators and function names.
Sub e_nxt() Dim is_keyword As Integer Dim C As String ' Current input character. Dim is_id% e_tok = vbNullString e_spelling = vbNullString ' Skip whitespace. Do C = Left$(e_input, 1) e_input = Mid$(e_input, 2) Loop While C = " " Or C = Chr$(9) Or C = Chr$(13) Or C = Chr$(10) Select Case LCase$(C) ' Number constant. Modify this to support hexadecimal, etc. Case "0" To "9", "." e_tok = "num" Do e_spelling = e_spelling + C C = Left$(e_input, 1) e_input = Mid$(e_input, 2) Loop While (C >= "0" And C <= "9") Or C = "." e_input = C + e_input ' Identifier or keyword. Case "a" To "z", "_" e_tok = "id" Do e_spelling = e_spelling + C C = LCase$(Left$(e_input, 1)) e_input = Mid$(e_input, 2) is_id% = (C >= "a" And C <= "z") is_id% = is_id% Or C = "_" Or (C >= "0" And C <= "9") Loop While is_id% e_input = C + e_input ' Check for keyword. is_keyword = -1 Select Case LCase$(e_spelling) Case "and" Case "eqv" Case "imp" Case "mod" Case "not" Case "or" Case "xor" Case Else: is_keyword = 0 End Select If is_keyword Then e_tok = LCase$(e_spelling) End If ' Check for <=, >=, <>. Case "<", ">" e_tok = C C = Left$(e_input, 1) If C = "=" Or C = ">" Then e_tok = e_tok + C e_input = Mid$(e_input, 2) End If ' Single character token. Case Else e_tok = C End Select If e_spelling = vbNullString Then e_spelling = e_tok End If End Sub
Function e_prs(p As Integer) As Double Dim n As Double, tmp As Double ' Return value. Dim fun As String ' Function name. ' Parse expression that begins with a token (precedence 12). If e_tok = "num" Then ' number. n = Val(e_spelling) Call e_nxt ElseIf e_tok = "-" Then ' unary minus. Call e_nxt n = -e_prs(11) ' Operand precedence 11. ElseIf e_tok = "not" Then ' logical NOT. Call e_nxt n = Not e_prs(6) ' Operand precedence 6. ElseIf e_tok = "(" Then ' parentheses. Call e_nxt n = e_prs(1) Call e_match(")") ElseIf e_tok = "id" Then ' Function call. fun = e_spelling Call e_nxt Call e_match("(") n = e_prs(1) Call e_match(")") n = e_function(fun, n) Else If Not e_error Then MsgBox "Syntax error, token = '" + e_spelling + "'" & e_CurrEval$() e_error = -1 End If End If ' Parse binary operators. Do While Not e_error If 0 Then ' To allow ElseIf . ElseIf p <= 11 And e_tok = "^" Then Call e_nxt: n = n ^ e_prs(12) ElseIf p <= 10 And e_tok = "*" Then Call e_nxt: n = n * e_prs(11) ElseIf p <= 10 And e_tok = "/" Then 'Call e_nxt: n = n / e_prs(11) Call e_nxt tmp = e_prs(11) If tmp = 0 Then MsgBox "Division by zero: " & e_CurrEval$() e_error = -1 Else n = n / tmp End If ElseIf p <= 9 And e_tok = "\" Then 'Call e_nxt: n = n \ e_prs(10) Call e_nxt tmp = e_prs(10) If tmp = 0 Then MsgBox "Division by zero: " & e_CurrEval$() e_error = -1 Else n = n \ tmp End If ElseIf p <= 8 And e_tok = "mod" Then Call e_nxt: n = n Mod e_prs(9) ElseIf p <= 7 And e_tok = "+" Then Call e_nxt: n = n + e_prs(8) ElseIf p <= 7 And e_tok = "-" Then Call e_nxt: n = n - e_prs(8) ElseIf p <= 6 And e_tok = "=" Then Call e_nxt: n = n = e_prs(7) ElseIf p <= 6 And e_tok = "<" Then Call e_nxt: n = n < e_prs(7) ElseIf p <= 6 And e_tok = ">" Then Call e_nxt: n = n > e_prs(7) ElseIf p <= 6 And e_tok = "<>" Then Call e_nxt: n = n <> e_prs(7) ElseIf p <= 6 And e_tok = "<=" Then Call e_nxt: n = n <= e_prs(7) ElseIf p <= 6 And e_tok = ">=" Then Call e_nxt: n = n >= e_prs(7) ElseIf p <= 5 And e_tok = "and" Then Call e_nxt: n = n And e_prs(6) ElseIf p <= 4 And e_tok = "or" Then Call e_nxt: n = n Or e_prs(5) ElseIf p <= 3 And e_tok = "xor" Then Call e_nxt: n = n Xor e_prs(4) ElseIf p <= 2 And e_tok = "eqv" Then Call e_nxt: n = n Eqv e_prs(3) ElseIf p <= 1 And e_tok = "imp" Then Call e_nxt: n = n Imp e_prs(2) Else Exit Do End If Loop e_prs = n End Function