Solved

# Evaluating Expressions - Urgent

Posted on 2002-03-27
349 Views
I would like to know how to evaluate an expression in
visual basic. I will have the expression in the form
a = "(5500 * 0.986)* 12/100" where a is either a variant or a string
Is there any function to evaluate or how can it be done
I want the value of a after evaluation
0
Question by:kvvkarthik

LVL 44

Expert Comment

ID: 6898674
Hi kwkarthik,

Sub SomeCalc()
Dim dblResult as Double
dblResult = (5500 * 0.986) * (12/100)
msgbox Cstr(dblResult)
end sub

HTH:O)Bruintje
0

LVL 50

Expert Comment

ID: 6898688
Hi kwkarthik,

Dim iScript As New ScriptControl
Dim a As Variant

Private Sub Command1_Click()
iScript.Language = "VBScript"
a = iScript.Eval(Text1.Text)
'iScript.ExecuteStatement Text1.Text
MsgBox a
End Sub

Text1.Text = "(5500 * 0.986)* 12/100"
End Sub

Hope this help
0

LVL 44

Expert Comment

ID: 6898712
Sub SomeCalc()
Dim dblResult as Double
Dim a As string
dblResult = (5500 * 0.986) * (12/100)
a= Cstr(dblResult)
end sub

0

LVL 44

Expert Comment

ID: 6898715
or

a=Cstr((5500 * 0.986) * (12/100))
0

LVL 18

Expert Comment

ID: 6898781
Option Explicit

Private Sub Command1_Click()

MsgBox eval("2+2")

End Sub

'put this in a .bas  module

Option Explicit
Dim e_input As String     ' Expression input string.
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.

Public Function eval(sText) As Double

Dim n As Double

e_eval sText, n

eval = n

End Function

Function e_eval(ByVal s As String, value As Double) As Integer
' Initialize.
e_error = 0
e_input = s
Call e_nxt

' Evaluate.
value = e_prs(1)

' Check for unrecognized input.
If e_tok <> "" And Not e_error Then
MsgBox "syntax error, token = '" + e_spelling + "'"
e_error = -1
End If

e_eval = Not e_error
End Function

' 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.
Function e_prs(p As Integer) As Double
Dim n 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_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)
ElseIf p <= 9 And e_tok = "\" Then: Call e_nxt: n = n \ e_prs(10)
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

' 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

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": n = Log(arg)
Case "rnd": n = Rnd(arg)
Case "sgn": n = Sgn(arg)
Case "sin": n = Sin(arg)
Case "sqr": n = Sqr(arg)
Case "tan": n = Tan(arg)

'New functions
Case "arccos": n = arccos(arg)
Case "arcsin": n = arcsin(arg)

Case "arcsec": n = arcsec(arg)
Case "arccosec": n = arccosec(arg)
Case "arccot": n = arccot(arg)

Case "cot": n = cot(arg)
Case "cosec": n = cosec(arg)
Case "sec": n = sec(arg)

Case "sinh": n = sinh(arg)
Case "cosh": n = cosh(arg)
Case "tanh": n = tanh(arg)

Case "arcsinh": n = arcsinh(arg)

Case "coth": n = coth(arg)
Case "cosech": n = cosech(arg)
Case "sech": n = sech(arg)

Case Else
If Not e_error Then
MsgBox "undefined function '" + fun + "'"
e_error = -1
End If
End Select

e_function = n
End Function

Private Function arccos(ByVal x As Double) As Double

If Abs(x) = 1 Then

If x = 1 Then arccos = 0 Else arccos = Atn(1) * 4

Else

arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)

End If

End Function

Private Function arcsec(ByVal x As Double) As Double

arcsec = arccos(1 / x)

End Function

Private Function arcsinh(ByVal x As Double) As Double

arcsinh = Log(x + Sqr(x * x + 1))

End Function

Private Function arccosec(ByVal x As Double) As Double

arccosec = arcsin(1 / x)

End Function

Private Function arccot(ByVal x As Double) As Double

arccot = Atn(1 / x)

End Function

Private Function sec(ByVal x As Double) As Double

sec = 1 / Cos(x)

End Function

Private Function cot(ByVal x As Double) As Double

cot = 1 / Tan(x)

End Function

Private Function cosec(ByVal x As Double) As Double

cosec = 1 / Sin(x)

End Function

Private Function sinh(ByVal x As Double) As Double

sinh = (Exp(x) - Exp(-x)) / 2

End Function

Private Function cosh(ByVal x As Double) As Double

cosh = (Exp(x) + Exp(-x)) / 2

End Function

Private Function tanh(ByVal x As Double) As Double

tanh = sinh(x) / cosh(x)

End Function

Private Function coth(ByVal x As Double) As Double

coth = 1 / tanh(x)

End Function

Private Function sech(ByVal x As Double) As Double

sech = 1 / cosh(x)

End Function

Private Function cosech(ByVal x As Double) As Double

cosech = 1 / sinh(x)

End Function

Private Function arcsin(ByVal x As Double) As Double

If Abs(x) = 1 Then

arcsin = Atn(1) * 2 * Sgn(x)

Else

arcsin = Atn(x / Sqr(-x * x + 1))

End If

End Function

' 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 As Integer

e_tok = ""
e_spelling = ""

' 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 = "" Then
e_spelling = e_tok
End If
End Sub

' 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_error = -1
End If
Call e_nxt
End Sub

0

LVL 44

Expert Comment

ID: 6899294
rereading can force one to see the real question, nice piece of code deighton
0

Author Comment

ID: 6912419
What should i do if my expression contains
keywords like MIN, MAX etc
0

LVL 50

Accepted Solution

Ryan Chong earned 100 total points
ID: 6912436
You can Defined the Function of Min and Max yourself:

Function Min(Val1 As Double, Val2 As Dounle) As Double
If Val1 <= Val2 Then
Min = Val1
Else
Min = Val2
End If
End Function

Function Max(Val1 As Double, Val2 As Dounle) As Double
If Val1 >= Val2 Then
Max = Val1
Else
Max = Val2
End If
End Function
0

LVL 50

Expert Comment

ID: 6944340
kvvkarthik, if you didn't find a solution, please do NOT accept my comment as a answer. C is NOT good!
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

### Suggested Solutions

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…