灌最后一个水贴,用它来练练思维能力吧(去掉注释后分析下程序),呵呵,我用了两天才写出来的

Option Explicit

'表达式计算模块,没有使用堆栈,没有使用前/后缀表达式
'使用的是模拟人脑计算步骤,全部代码使用字串做为参数
'程序代码未做优化
' 作者:
' useforprogram@126.com
' 2006-8-29
'注:结果为纯小数时没有开头的"0"
' 表达式有误或除数为0时会提示,此时返回结果有误
' 程序每步运算中涉及小数时只保留两位小数
' 小数位数保留在双目运算函数和字串还原函数

'转贴代码请注明作者信息，谢谢！

Public Function CalcExp(strExp As String) As String '表达式处理主函数，分为三步处理
Dim strCalcExp As String
If Not CheckExpresion(strExp) Then
CalcExp = "Error!"
Exit Function
End If
If InStr(1, strExp, "(") Then strCalcExp = Trim(DelBracket(strExp)) '1 去掉括号
If InStr(1, strExp, "*") Or InStr(1, strExp, "/") Then
strCalcExp = Trim(CalcFlag(strExp, True)) '2 算乘除法
End If
If InStr(1, strExp, "+") Or InStr(1, strExp, "-") Then
strCalcExp = Trim(CalcFlag(strExp, False)) '3 算加减法
End If
If Left(strCalcExp, 1) = "." Then
strCalcExp = "0" & strExp
End If
If Right(strCalcExp, 1) = "." Then
strCalcExp = "-" & Left(strCalcExp, Len(strCalcExp) - 1)
End If
CalcExp = strCalcExp
End Function

'去括号函数，使用的算法是：
'1 检测最后一个“（”和与之配对的“）”
'2 取1中两个标识中的部分做为无括号表达式处理
'3 返回到第1步,直到表达式中不存在括号
Private Function DelBracket(strBracket As String) As String
Dim intStrLen As Integer
Dim intLeft As Integer
Dim intRight As Integer
Dim strTmp As String
Dim i As Integer
Do
intStrLen = Len(strBracket)
intLeft = 0: intRight = 0
Do
i = InStr(intLeft + 1, strBracket, "(")
If i Then intLeft = i
Loop Until i = 0 '检测最后一个“（”
If intLeft <> 0 Then
intRight = InStr(intLeft, strBracket, ")") '与之配对的“）”
If intRight = 0 Then
MsgBox "表达式中括号使用有误！"
DelBracket = "Error"
Exit Function
End If
strTmp = Mid(strBracket, intLeft + 1, intRight - (intLeft + 1))
If InStr(1, strTmp, "*") Or InStr(1, strTmp, "/") Then
strTmp = Trim(CalcFlag(strTmp, True)) '无括号表达式处理
End If
If InStr(1, strTmp, "+") Or InStr(1, strTmp, "-") Then
strTmp = Trim(CalcFlag(strTmp, False))
End If
'化简掉一个括号后表达式的值不变(把原括号中的部分用数值代替)
strBracket = Left(strBracket, intLeft - 1) & strTmp & Right(strBracket, intStrLen - intRight)
Else
strTmp = strBracket '不存在括号时返回无括号表达式
End If
Loop While intLeft <> 0
DelBracket = Trim(strBracket)
End Function

'无括号表达式计算函数,只处理单一运算,运算符由函数第二个参数传递,前一参数是表达式
'(同一运算是没有先后顺序的,只要以 *,/,+,- 的顺序就不会使运算出错)
'算法是:每次只处理一个最简单的双目运算,循环处理到没有该类运算
Private Function CalcFlag(strExpFlag As String, blnFlag As Boolean) As String
Dim i As Integer
Dim intTry As Integer
Dim intLenExpFlag As Integer
Dim strTmpFlag As String
Dim strCalcNum1 As String
Dim strCalcNum2 As String
Dim intLeftCnt As Integer
Dim intRightCnt As Integer
Dim strFlag As String
intLenExpFlag = Len(strExpFlag)

If Left(strExpFlag, 1) = "-" Then
For i = 2 To intLenExpFlag
If InStr(1, "*/+-", Mid(strExpFlag, i, 1)) Then
Exit For '处理负数问题，把负数符号去掉，在末尾加上
End If '小数点表示即"-123.4560"转换成"123.456."
Next
strExpFlag = Mid(strExpFlag, 2, i - 2) & "." & Right(strExpFlag, intLenExpFlag - i + 1)
End If
Do
intTry = 0
intLenExpFlag = Len(strExpFlag)
'intTry = InStr(1, strExpFlag, strFlag)
If blnFlag Then
For i = 1 To intLenExpFlag
strFlag = Mid(strExpFlag, i, 1)
If InStr(1, "*/", strFlag) Then
intTry = InStr(1, strExpFlag, strFlag)
Exit For
End If
Next
Else
For i = 1 To intLenExpFlag
strFlag = Mid(strExpFlag, i, 1)
If InStr(1, "+-", strFlag) Then
intTry = InStr(1, strExpFlag, strFlag)
Exit For
End If
Next
End If
If intTry > 0 Then '存在要做的运算
strTmpFlag = Left(strExpFlag, intTry - 1)
strCalcNum1 = "": intLeftCnt = 0
For i = Len(strTmpFlag) To 1 Step -1
If InStr(1, "0123456789.", Mid(strTmpFlag, i, 1)) Then
strCalcNum1 = strCalcNum1 & Mid(strTmpFlag, i, 1)
intLeftCnt = intLeftCnt + 1
Else
Exit For '取运算符左边的数字,逆序(123.456=>"654.321")
End If
Next
strTmpFlag = Right(strExpFlag, intLenExpFlag - intTry)
strCalcNum2 = "": intRightCnt = 0
For i = 1 To Len(strTmpFlag)
If InStr(1, "0123456789.", Mid(strTmpFlag, i, 1)) Then
strCalcNum2 = strCalcNum2 & Mid(strTmpFlag, i, 1)
intRightCnt = intRightCnt + 1
Else
Exit For '取运算符左边的数字,顺序(123.456=>"123.456")
End If
Next
strTmpFlag = Trim(CalcValue(strCalcNum1, strCalcNum2, strFlag)) '做一个双目运算
strExpFlag = Left(strExpFlag, intTry - intLeftCnt - 1) & strTmpFlag & _
Right(strExpFlag, intLenExpFlag - (intTry + intRightCnt))
End If
Loop While intTry > 0 '第一个数为负时没有被减数，出错
CalcFlag = Trim(strExpFlag) '''''''''''''''''''frmcalc.lstexp.additem "=" & trim(strexpflag)
End Function

'双目运算处理函数,参数为:操作数1,操作数2,运算符
Private Function CalcValue(strNum1 As String, strNum2 As String, strOpt As String) As String
Dim fltNum1 As Single
Dim fltNum2 As Single
Dim fltVal As Single
Dim strTmpVal As String
fltNum1 = StrToFlt(strNum1, False) '把逆序的操作数还原
fltNum2 = StrToFlt(strNum2, True) '把顺序的操作数还原
Select Case strOpt
Case "*": fltVal = fltNum1 * fltNum2
Case "/"
If fltNum2 = 0 Then
MsgBox "表达式有错！" '除数为0
CalcValue = "Error"
Exit Function
End If
fltVal = fltNum1 / fltNum2
Case "+": fltVal = fltNum1 + fltNum2
Case "-": fltVal = fltNum1 - fltNum2
End Select
If fltVal - Int(fltVal) = 0 Then
strTmpVal = Trim(Str(Int(fltVal)))
Else
fltVal = Int(fltVal * 100 + 0.5) / 100 '保留两位有效数字（保留三位把本行的100全改成1000，以此类推）
strTmpVal = Trim(Str(fltVal))
End If
If Left(strTmpVal, 1) = "-" Then
strTmpVal = Right(strTmpVal, Len(strTmpVal) - 1) & "."
End If
CalcValue = strTmpVal
End Function

'顺/逆序操作数还原函数，第二个参数为真是顺序
Private Function StrToFlt(NumStr As String, blnFH As Boolean) As Single
Dim i As Integer
Dim fltRes As Single
Dim blnDotAdd As Boolean
Dim intDotCnt As Integer
Dim intMinus As Integer
Dim intFrom As Integer
Dim intTo As Integer
Dim intStep As Integer
intMinus = 1
If blnFH Then '顺序
If Right(NumStr, 1) = "." Then
NumStr = Left(NumStr, Len(NumStr) - 1)
intMinus = -1 '处理负号问题
End If
intFrom = 1
intTo = Len(NumStr)
intStep = 1
Else '逆序
If Left(NumStr, 1) = "." Then
NumStr = Right(NumStr, Len(NumStr) - 1)
intMinus = -1 '处理负号问题
End If
intFrom = Len(NumStr)
intTo = 1
intStep = -1
End If
For i = intFrom To intTo Step intStep
If Mid(NumStr, i, 1) = "." Then
blnDotAdd = True '记录存在小数
Else
fltRes = fltRes * 10 + Val(Mid(NumStr, i, 1))
If blnDotAdd Then
intDotCnt = intDotCnt + 1 '小数位数
End If
End If
Next
For i = 1 To intDotCnt
fltRes = fltRes / 10 '还原小数部分
Next i
fltRes = Int(fltRes * 100 + 0.5) / 100 '保留两位有效数字
StrToFlt = fltRes * intMinus
End Function

Private Function CheckExpresion(strExpsn As String) As Boolean '表达式的合格性验证
Dim strFlag As String
Dim strNext As String
Dim i As Integer
Dim intLenExpsn As Integer
Dim blnChkLoss As Boolean
Dim intL As Integer
intL = 0
intLenExpsn = Len(strExpsn)
For i = 1 To intLenExpsn
strFlag = Mid(strExpsn, i, 1)
strNext = Mid(strExpsn, i + 1, 1)
If strFlag = "(" Then intL = intL + 1
If strFlag = ")" Then intL = intL - 1
If strFlag = ")" And strNext <> "" Then '括号后不能是 ".","("或数字
If InStr(1, ".(0123456789", strNext) Then
blnChkLoss = True
Exit For
End If
ElseIf InStr(1, "(+-*/", strFlag) And strNext <> "" Then '"("和运算符后不能是运算符或".",")"
If InStr(1, "+*/.)", strNext) Then '括号"("后为负数出错的解决(把串中的"-"去掉就行了)
blnChkLoss = True
Exit For
End If
ElseIf InStr(1, "0123456789", strFlag) Then '数字后不能是"("
If strNext = "(" Then
blnChkLoss = True
Exit For
End If
ElseIf strFlag = "." Then
If InStr(1, "()+-*/.", strNext) Then '"."后不能是"."运算符和括号
blnChkLoss = True
Exit For
End If
End If
Next
If Not blnChkLoss And intL = 0 Then
CheckExpresion = True
Else
CheckExpresion = False
End If
End Function