Solved

Evaluating Expressions - Urgent

Posted on 2002-03-27
9
352 Views
Last Modified: 2006-11-17
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
Comment
Question by:kvvkarthik
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
9 Comments
 
LVL 44

Expert Comment

by:bruintje
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 52

Expert Comment

by:Ryan Chong
ID: 6898688
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
0
 
LVL 44

Expert Comment

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

0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 44

Expert Comment

by:bruintje
ID: 6898715
or

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

Expert Comment

by:deighton
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

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

Author Comment

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

Accepted Solution

by:
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 52

Expert Comment

by:Ryan Chong
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

PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

Question has a verified solution.

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

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses
Course of the Month4 days, 13 hours left to enroll

636 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question