[原创]用VB实现字符形式的表达式的计算.

Option Explicit
'
'
'---------------------------------
'Class  :CalExp
'
'Program:zeng29
'Date   :2003/10/25
'Ver.   :1.0.0
'
'---------------------------------
'
'
Private Const cPi = 3.14159265358979
Private Const cE = 2.71828182845905
Public Function CalExpression(sExp As String) As Variant
    Dim ReadPoint As Integer, i As Integer, j As Integer, sChar As String
    Dim sOpArray As Variant, iOpPower As Variant, sFunArray As Variant
    Dim DataStack() As Double, OpStack() As String
    Dim sCurOP As String, iIndex As Integer, iFlag As Integer, sPara As String
    Dim sFunName As String, vRet As Variant
    Dim dData1 As Variant, dData2 As Variant, sOp As String
    
    '初始化...
    ReDim DataStack(0)
    ReDim OpStack(0)
    sOpArray = Array("+", "-", "*", "/", "^", "%")
    iOpPower = Array(1, 1, 3, 3, 4, 2)
    sFunArray = Array("sin", "cos", "tan", "asin", "acos", "atn", "abs", "ln", "pi", "e")
    ReadPoint = 1
    
    While ReadPoint  0 And i  ReadPoint Then sPara = sPara & sChar
            Next i
            If iFlag  0 Then
                CalExpression = "错误的表达式:括号不成对!"
                Exit Function
            End If
        
        '读取数值...
        ElseIf IsNumeric(sChar) Or sChar = "." Or (ReadPoint = 1 And (sChar = "+" Or sChar = "-")) Then
            sPara = ""
            For i = ReadPoint To Len(sExp)
                sChar = Mid(sExp, i, 1)
                If IsNumeric(sChar) Or sChar = "." Or (i = 1 And (sChar = "+" Or sChar = "-")) Then
                    sPara = sPara & sChar
                ElseIf IsNumeric(sPara) Then
                    PushToStc DataStack, sPara
                    ReadPoint = i
                    Exit For
                Else
                    CalExpression = "非法的表达式:" & sPara & sChar
                    Exit Function
                End If
            Next i
            If i > Len(sExp) And IsNumeric(sPara) Then PushToStc DataStack, sPara
            ReadPoint = i
        Else
            vRet = GetIndex(sOpArray, sChar)
            
            '读取操作符...
            If vRet  "Null" Then
ReCheck:
                If PopFromStc(OpStack, False) = "Null" Then
                    PushToStc OpStack, sChar
                Else
                    If iOpPower(vRet) > iOpPower(GetIndex(sOpArray, PopFromStc(OpStack, False))) Then
                        PushToStc OpStack, sChar
                    Else
                        dData2 = PopFromStc(DataStack)
                        dData1 = PopFromStc(DataStack)
                        sOp = PopFromStc(OpStack)
                        PushToStc DataStack, ProCal(dData1, dData2, sOp)
                        GoTo ReCheck
                    End If
                End If
            Else
            
                '读取函数...
                vRet = Asc(LCase(sChar))
                If vRet >= Asc("a") And vRet = Asc("a") And vRet  0 And (j  i) Then sPara = sPara & sChar
                            Next j
                            If iFlag  0 Then
                                CalExpression = "错误的表达式:括号不成对!"
                                Exit Function
                            End If
                        End If
                        If i = Len(sExp) And sFunName  "" Then
                            CalExpression = "函数的用法:函数名([参数])"
                            Exit Function
                        End If
                    Next i
                Else
                    CalExpression = "错误的表达式:不知道的操作符:" & sChar
                    Exit Function
                End If
            End If
            ReadPoint = ReadPoint + 1
        End If
ReadNext:
    Wend
    
    '运算最终结果...
    If UBound(DataStack) = 1 Then
        CalExpression = PopFromStc(DataStack)
    Else
        Do
            dData2 = PopFromStc(DataStack)
            dData1 = PopFromStc(DataStack)
            sOp = PopFromStc(OpStack)
            If IsNumeric(dData1) And IsNumeric(dData2) And sOp  "Null" Then
                PushToStc DataStack, ProCal(dData1, dData2, sOp)
            Else
                CalExpression = "非法的表达式!"
                Exit Function
            End If
        Loop Until PopFromStc(OpStack, False) = "Null"
        CalExpression = PopFromStc(DataStack)
    End If
End Function