Search Tools Links Login

Eval or Evaluate function


evaluate basic math strings function

Original Author: Mike Toye

Inputs

math formula, eg; (6+(4.322^6)+(9*7)

Returns

result

Side Effects

no bad char validation!

Code

Function Eval(sin As String) As Double
Dim bAreThereBrackets As Boolean
Dim x As Double, y As Double, z As Double
Dim L2R As Integer
Dim sLeft As String, sMid As String, sRight As String
Dim dStack As Double
Dim sPrevOp As String
Dim bInnerFound As Boolean
  sin = IIf(InStr(sin, " ") > 0, RemoveAllSpaces(sin), sin)
  If InStr(sin, "(") Then
  'work from left to right. find the inner most
  'brackets and resolve them into the string, eg;
  '(6+7+(6/3)) becomes (6+7+2)
    
    L2R = 1
    While InStr(sin, "(") > 0
      'inner loop
      bInnerFound = False
      Do
        x = InStr(L2R, sin, "(")
        y = InStr(x + 1, sin, "(")
        z = InStr(x + 1, sin, ")")
        If y = 0 Then
          L2R = x
          bInnerFound = True
        Else
          If y < z Then
            L2R = y
          Else
            L2R = x
            bInnerFound = True
          End If
        End If
      Loop Until bInnerFound
      x = InStr(L2R, sin, ")")
      sin = Left(sin, L2R - 1) & CStr(Eval(Mid(sin, L2R + 1, x - L2R - 1))) & Mid(sin, x + 1)
      Debug.Print sin
      
    Wend
    Eval = CDbl(IIf(IsNumeric(sin), sin, Eval(sin)))
  Else
    dStack = 0
    sLeft = ""
    sPrevOp = ""
    For L2R = 1 To Len(sin)
      If Not IsNumeric(Mid(sin, L2R, 1)) And Mid(sin, L2R, 1) <> "." Then
        'we have an operator
        If dStack = 0 Then
          dStack = CDbl(sLeft)
        Else
          dStack = ASMD(dStack, sLeft, sPrevOp)
        End If
        sLeft = ""
        sPrevOp = Mid(sin, L2R, 1)
      Else
        'carry on extracting the current number
        sLeft = sLeft & Mid(sin, L2R, 1)
      End If
    Next L2R
    If sLeft > "" Then
      dStack = ASMD(dStack, sLeft, sPrevOp)
    End If
    Eval = dStack
  End If
End Function
Function RemoveAllSpaces(sin As String) As String
Dim x As Integer
  RemoveAllSpaces = ""
  For x = 1 To Len(sin)
    If Mid(sin, x, 1) <> " " Then
      RemoveAllSpaces = RemoveAllSpaces & Mid(sin, x, 1)
    End If
  Next x
End Function
Function ASMD(dIn As Double, sin As String, sOP As String) As Double
  Select Case sOP
    Case "+"
      ASMD = dIn + CDbl(sin)
    Case "-"
      ASMD = dIn - CDbl(sin)
    Case "*"
      ASMD = dIn * CDbl(sin)
    Case "/"
      ASMD = dIn / CDbl(sin)
    Case "^"
      ASMD = dIn ^ CDbl(sin)
    Case Else
      ASMD = 0
  End Select
End Function

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 79 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.