[原创]用VB实现字符形式的表达式的计算.
本帖最后由 作者 于 2003-10-29 11:07:52 编辑有时需要计算以字符串保存的数学表达式,又没有直接的函数可供调用,但可以根据表达式的运算规则编制这样的模块程序来实现.
原理:
1.建立两个堆栈,并自左至右扫描表达式;
2.如遇操作数,一律压入堆栈;
3.如遇操作符,如优于栈顶操作符,则压入堆栈,否则以操作符栈顶的操作符计算数据栈顶的两个操作数,以此类推.
CalExp类(3K)
主函数如下:
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 <= Len(sExp)
sChar = Mid(sExp, ReadPoint, 1)
'运用递归处理"( )"...
If sChar = "(" Then
sPara = ""
For i = ReadPoint To Len(sExp)
sChar = Mid(sExp, i, 1)
If sChar = "(" Then
iFlag = iFlag + 1
ElseIf sChar = ")" Then
iFlag = iFlag - 1
If iFlag = 0 Then
vRet = CalExpression(sPara)
If IsNumeric(vRet) Then
PushToStc DataStack, vRet
ReadPoint = i + 1
Exit For
Else
CalExpression = vRet
Exit Function
End If
End If
End If
If iFlag <> 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("z") Then
sFunName = ""
For i = ReadPoint To Len(sExp)
sChar = Mid(sExp, i, 1)
vRet = Asc(LCase(sChar))
If vRet >= Asc("a") And vRet <= Asc("z") Then
sFunName = sFunName & sChar
ElseIf sChar = "(" Then
vRet = GetIndex(sFunArray, sFunName)
If vRet = "Null" Then
CalExpression = "不知道的函数:" & sFunName
Exit Function
End If
sPara = ""
iFlag = 0
For j = i To Len(sExp)
sChar = Mid(sExp, j, 1)
If sChar = "(" Then
iFlag = iFlag + 1
ElseIf sChar = ")" Then
iFlag = iFlag - 1
If iFlag = 0 Then
vRet = CallFun(sFunName, sPara)
sFunName = ""
If IsNumeric(vRet) Then
PushToStc DataStack, vRet
ReadPoint = j + 1
GoTo ReadNext
Else
CalExpression = vRet
Exit Function
End If
End If
End If
If iFlag <> 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
怎么用？
我导入模块后写
k="2*3"
msgbox calexpression(k)
不能运行，显示：函数未定义。
我把calex类模块的内容全部复制到自己建立的模块1时，就可以使用了。 这与数据结构里面的算符优先算法很相似阿~~~~ cvbndvhcnddfd 表达式可用于CAD的常用计算中，好！
页:
[1]