VB字符串表达式计算函数.

关注
原创最新推荐文章于 2026-08-01 21:15:08 发布 6.7k 阅读 AI 写同款· GEO 优化 ›
ArcGIS字段计算器攻略 ArcGIS字段计算器攻略以及常用的VB函数。阅读详情
这是一个VB6.0的字符串表达式计算函数.
Private Function EvaluateExpr(ByVal expr As String) As Single
       Const PREC_NONE = 11
       Const PREC_UNARY = 10
       Const PREC_POWER = 9
       Const PREC_TIMES = 8
       Const PREC_DIV = 7
       Const PREC_INT_DIV = 6
       Const PREC_MOD = 5
       Const PREC_PLUS = 4
       Dim is_unary   As Boolean
       Dim next_unary   As Boolean
       Dim parens   As Integer
       Dim pos   As Integer
       Dim expr_len   As Integer
       Dim ch   As String
       Dim lexpr   As String
       Dim rexpr   As String
       Dim value   As String
       Dim status   As Long
       Dim best_pos   As Integer
       Dim best_prec   As Integer
       '  Remove  leading  and  trailing  blanks. 
       expr = Trim$(expr)
       expr_len = Len(expr)
       If expr_len = 0 Then Exit Function
       '  If  we  find  +  or  -  now,  it  is  a  unary  operator. 
       is_unary = True
       '  So  far  we  have  nothing. 
       best_prec = PREC_NONE
       '  Find  the  operator  with  the  lowest  precedence. 
       '  Look  for  places  where  there  are  no  open 
       '  parentheses. 
       For pos = 1 To expr_len
               '  Examine  the  next  character. 
               ch = Mid$(expr, pos, 1)
               '  Assume  we  will  not  find  an  operator.  In 
               '  that  case  the  next  operator  will  not 
               '  be  unary. 
               next_unary = False
               If ch = "  " Then
                       '  Just  skip  spaces. 
                       next_unary = is_unary
               ElseIf ch = "(" Then
                       '  Increase  the  open  parentheses  count. 
                       parens = parens + 1
                       '  An  operator  after  "("  is  unary. 
                       next_unary = True
               ElseIf ch = ")" Then
                       '  Decrease  the  open  parentheses  count. 
                       parens = parens - 1
                       '  An  operator  after  ")"  is  not  unary. 
                       next_unary = False
                       '  If  parens  <  0,  too  many  ')'s. 
                       If parens < 0 Then
                               Err.Raise vbObjectError + 1001, _
                                       "EvaluateExpr", _
                                       "Too  many  )s  in  '" & _
                                       expr & "'"
                       End If
               ElseIf parens = 0 Then
                       '  See  if  this  is  an  operator. 
                       If ch = "^" Or ch = "*" Or _
                             ch = "/" Or ch = "/" Or _
                             ch = "%" Or ch = "+" Or _
                             ch = "-" _
                       Then
                               '  An  operator  after  an  operator 
                               '  is  unary. 
                               next_unary = True
                                 
                               Select Case ch
                                       Case "^"
                                               If best_prec >= PREC_POWER Then
                                                       best_prec = PREC_POWER
                                                       best_pos = pos
                                               End If
                                         
                                       Case "*", "/"
                                               If best_prec >= PREC_TIMES Then
                                                       best_prec = PREC_TIMES
                                                       best_pos = pos
                                               End If
                                         
                                       Case "/"
                                               If best_prec >= PREC_INT_DIV Then
                                                       best_prec = PREC_INT_DIV
                                                       best_pos = pos
                                               End If
                                         
                                       Case "%"
                                               If best_prec >= PREC_MOD Then
                                                       best_prec = PREC_MOD
                                                       best_pos = pos
                                               End If
                                         
                                       Case "+", "-"
                                               '  Ignore  unary  operators 
                                               '  for  now. 
                                               If (Not is_unary) And _
                                                       best_prec >= PREC_PLUS _
                                               Then
                                                       best_prec = PREC_PLUS
                                                       best_pos = pos
                                               End If
                               End Select
                       End If
               End If
               is_unary = next_unary
       Next pos
         
       '  If  the  parentheses  count  is  not  zero, 
       '  there's  a  ')'  missing. 
       If parens <> 0 Then
               Err.Raise vbObjectError + 1002, _
                       "EvaluateExpr", "Missing  )  in  '" & _
                       expr & "'"
       End If
         
       '  Hopefully  we  have  the  operator. 
       If best_prec < PREC_NONE Then
               lexpr = Left$(expr, best_pos - 1)
               rexpr = Right$(expr, expr_len - best_pos)
               Select Case Mid$(expr, best_pos, 1)
                       Case "^"
                               EvaluateExpr = _
                                       EvaluateExpr(lexpr) ^ _
                                       EvaluateExpr(rexpr)
                       Case "*"
                               EvaluateExpr = _
                                       EvaluateExpr(lexpr) * _
                                       EvaluateExpr(rexpr)
                       Case "/"
                               EvaluateExpr = _
                                       EvaluateExpr(lexpr) / _
                                       EvaluateExpr(rexpr)
                       Case "/"
                               EvaluateExpr = _
                                       EvaluateExpr(lexpr) / _
                                       EvaluateExpr(rexpr)
                       Case "%"
                               EvaluateExpr = _
                                       EvaluateExpr(lexpr) Mod _
                                       EvaluateExpr(rexpr)
                       Case "+"
                               EvaluateExpr = _
                                       EvaluateExpr(lexpr) + _
                                       EvaluateExpr(rexpr)
                       Case "-"
                               EvaluateExpr = _
                                       EvaluateExpr(lexpr) - _
                                       EvaluateExpr(rexpr)
               End Select
               Exit Function
       End If
         
       '  If  we  do  not  yet  have  an  operator,  there 
       '  are  several  possibilities: 
       ' 
       '  1.  expr  is  (expr2)  for  some  expr2. 
       '  2.  expr  is  -expr2  or  +expr2  for  some  expr2. 
       '  3.  expr  is  Fun(expr2)  for  a  function  Fun. 
       '  4.  expr  is  a  primitive. 
       '  5.  It's  a  literal  like  "3.14159". 
         
       '  Look  for  (expr2). 
       If Left$(expr, 1) = "(" And Right$(expr, 1) = ")" Then
               '  Remove  the  parentheses. 
               EvaluateExpr = EvaluateExpr(Mid$(expr, 2, expr_len - 2))
               Exit Function
       End If
                 
       '  Look  for  -expr2. 
       If Left$(expr, 1) = "-" Then
               EvaluateExpr = -EvaluateExpr( _
                       Right$(expr, expr_len - 1))
               Exit Function
       End If
         
       '  Look  for  +expr2. 
       If Left$(expr, 1) = "+" Then
               EvaluateExpr = EvaluateExpr( _
                       Right$(expr, expr_len - 1))
               Exit Function
       End If
         
       '  Look  for  Fun(expr2). 
       If expr_len > 5 And Right$(expr, 1) = ")" Then
               lexpr = LCase$(Left$(expr, 4))
               rexpr = Mid$(expr, 5, expr_len - 5)
               Select Case lexpr
                       Case "sin("
                               EvaluateExpr = Sin(EvaluateExpr(rexpr))
                               Exit Function
                       Case "cos("
                               EvaluateExpr = Cos(EvaluateExpr(rexpr))
                               Exit Function
                       Case "tan("
                               EvaluateExpr = Tan(EvaluateExpr(rexpr))
                               Exit Function
                       Case "sqr("
                               EvaluateExpr = Sqr(EvaluateExpr(rexpr))
                               Exit Function
               End Select
       End If
         
       On Error Resume Next
       EvaluateExpr = CSng(expr)
       status = Err.Number
       On Error GoTo 0
       If status <> 0 Then
               Err.Raise status, _
                       "EvaluateExpr", _
                       "Error  evaluating  '" & expr & _
                       "'  as  a  constant."
       End If
End Function