[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 356
  • Last Modified:

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
0
kvvkarthik
Asked:
kvvkarthik
1 Solution
 
bruintjeCommented:
Hi kwkarthik,

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

HTH:O)Bruintje
0
 
Ryan ChongCommented:
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
 
bruintjeCommented:
Sub SomeCalc()
Dim dblResult as Double
Dim a As string
dblResult = (5500 * 0.986) * (12/100)
a= Cstr(dblResult)
end sub

0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
bruintjeCommented:
or

a=Cstr((5500 * 0.986) * (12/100))
0
 
deightonCommented:
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
 
bruintjeCommented:
rereading can force one to see the real question, nice piece of code deighton
0
 
kvvkarthikAuthor Commented:
What should i do if my expression contains
keywords like MIN, MAX etc
0
 
Ryan ChongCommented:
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
 
Ryan ChongCommented:
kvvkarthik, if you didn't find a solution, please do NOT accept my comment as a answer. C is NOT good!
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now