kvvkarthik
asked on
Evaluating Expressions - Urgent
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
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
Hi kwkarthik,
Try to add the M$ Scripting Runtime from your Reference, then add this:
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
Private Sub Form_Load()
Text1.Text = "(5500 * 0.986)* 12/100"
End Sub
Hope this help
Try to add the M$ Scripting Runtime from your Reference, then add this:
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
Private Sub Form_Load()
Text1.Text = "(5500 * 0.986)* 12/100"
End Sub
Hope this help
Sub SomeCalc()
Dim dblResult as Double
Dim a As string
dblResult = (5500 * 0.986) * (12/100)
a= Cstr(dblResult)
end sub
Dim dblResult as Double
Dim a As string
dblResult = (5500 * 0.986) * (12/100)
a= Cstr(dblResult)
end sub
or
a=Cstr((5500 * 0.986) * (12/100))
a=Cstr((5500 * 0.986) * (12/100))
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
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
rereading can force one to see the real question, nice piece of code deighton
ASKER
What should i do if my expression contains
keywords like MIN, MAX etc
keywords like MIN, MAX etc
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
kvvkarthik, if you didn't find a solution, please do NOT accept my comment as a answer. C is NOT good!
Sub SomeCalc()
Dim dblResult as Double
dblResult = (5500 * 0.986) * (12/100)
msgbox Cstr(dblResult)
end sub
HTH:O)Bruintje