表达式计算VB程序

Function EvaluateB(ByRef Bdsz As String) As Double
'思路：先计算括号内，再依次计算括号外。大多用拼音第一字母命名
Dim LenBdsz As Integer '计算表达式长度
Dim LskhStr(3) As String '临时括号值，即括号将原表达式分隔成三段 LskhStr（0）为总计算值
Dim i, j As Integer

On Error GoTo err1
LskhStr(0) = StrConv(Trim(Bdsz), vbNarrow) '更换全角括号为半角
Xh: '循环去括号
LenBdsz = Len(LskhStr(0))
i = InStr(LskhStr(0), ")")
If i > 0 Then
j = InStrRev(Mid(LskhStr(0), 1, i), "(")
If j > 0 Then
LskhStr(1) = Mid(LskhStr(0), 1, j - 1)
LskhStr(2) = Mid(LskhStr(0), j + 1, i - j - 1)
LskhStr(3) = Mid(LskhStr(0), i + 1, LenBdsz - i)
LskhStr(2) = CalcB(Trim(LskhStr(2))) '最内括号计算
LskhStr(0) = LskhStr(1) & LskhStr(2) & LskhStr(3)
GoTo Xh
Else
GoTo err1
End If
End If
LskhStr(0) = CalcB(LskhStr(0)) 'calc.Eval(LskhStr(0)).ToString
Return LskhStr(0)
Exit Function
err1:
Return 0
End Function


Function CalcB(ByRef str1 As String) As String '仅四则运算，+-*/无括号


Dim Cn2 As String, Str2(4) As String
Dim LenStr As Integer, i As Integer, j As Integer
'''''''''''''''''''''''''''''''''''
Xh2: '先计算"/" 此前可增加开方,乘方等优先计算符的计算
LenStr = Len(str1)
i = InStr(str1, "/")
If i > 0 Then
If i = 1 Or i = LenStr Then
Return "表达式错误"
Exit Function
End If
For j = i - 1 To 1 Step -1
Cn2 = Mid(str1, j, 1)
If Cn2 = "+" Or Cn2 = "-" Or Cn2 = "/" Or Cn2 = "*" Then
Str2(1) = Mid(str1, 1, j)
Str2(2) = Mid(str1, j + 1, i - j - 1)
Exit For
End If
If j = 1 Then
Str2(1) = ""
Str2(2) = Mid(str1, 1, i - 1)
End If
Next
For j = i + 1 To LenStr
Cn2 = Mid(str1, j, 1)
If Cn2 = "+" Or Cn2 = "-" Or Cn2 = "/" Or Cn2 = "*" Then
Str2(3) = Mid(str1, i + 1, j - i - 1)
Str2(4) = Mid(str1, j， LenStr - j + 1)
Exit For
End If
If j = LenStr Then
Str2(3) = Mid(str1, i + 1, LenStr - i)
Str2(4) = ""
End If
Next
str1 = Trim(Str2(1) & Trim(Str(Val(Trim(Str2(2))) / Val(Trim(Str2(3))))) & Trim(Str2(4)))
GoTo Xh2
End If


Xh1:
LenStr = Len(str1)
i

= InStr(str1, "*")
If i > 0 Then
If i = 1 Or i = LenStr Then
Return "表达式错误"
Exit Function
End If
For j = i - 1 To 1 Step -1
Cn2 = Mid(str1, j, 1)
If Cn2 = "+" Or Cn2 = "-" Or Cn2 = "/" Or Cn2 = "*" Then
Str2(1) = Mid(str1, 1, j)
Str2(2) = Mid(str1, j + 1, i - j - 1)
Exit For
End If
If j = 1 Then
Str2(1) = ""
Str2(2) = Mid(str1, 1, i - 1)
End If
Next
For j = i + 1 To LenStr
Cn2 = Mid(str1, j, 1)
If Cn2 = "+" Or Cn2 = "-" Or Cn2 = "/" Or Cn2 = "*" Then
Str2(3) = Mid(str1, i + 1, j - i - 1)
Str2(4) = Mid(str1, j， LenStr - j + 1)
Exit For
End If
If j = LenStr Then
Str2(3) = Mid(str1, i + 1, LenStr - i)
Str2(4) = ""
End If
Next
str1 = Trim(Str2(1) & Trim(Str(Val(Trim(Str2(2))) * Val(Trim(Str2(3))))) & Trim(Str2(4)))
GoTo Xh1
End If


Xh4:

LenStr = Len(str1)
i = InStr(2, str1, "-")
If i > 0 Then
If i = LenStr Then
Return "表达式错误"
Exit Function
End If
For j = i - 1 To 1 Step -1
Cn2 = Mid(str1, j, 1)
If (Cn2 = "+" Or Cn2 = "-" Or Cn2 = "/" Or Cn2 = "*") And j > 1 Then
Str2(1) = Mid(str1, 1, j)
Str2(2) = Mid(str1, j + 1, i - j - 1)
Exit For
Else
If j = 1 Then
Str2(1) = ""
Str2(2) = Mid(str1, 1, i - 1)
End If

End If
Next
For j = i + 1 To LenStr
Cn2 = Mid(str1, j, 1)
If Cn2 = "+" Or Cn2 = "-" Or Cn2 = "/" Or Cn2 = "*" Then
Str2(3) = Mid(str1, i, j - i)
Str2(4) = Mid(str1, j， LenStr - j + 1)
Exit For
End If
If j = LenStr Then
Str2(3) = Mid(str1, i, LenStr - i + 1)
Str2(4) = ""
End If
Next
If Mid(Str(Val(Str2(2)) + Val(Str2(3))), 1, 1) = "-" Then
If Str2(1) <> "" Then

If Mid(Str2(1), Len(Str2(1)), 1) = "+" Then
Str2(1) = Mid(Str2(1), 1, Len(Str2(1)) - 1)
End If
End If
End If
str1 = Trim(Str2(1) & Trim(Str(Val(Trim(Str2(2))) + Val(Trim(Str2(3))))) & Str2(4))
GoTo Xh4
End If

Xh3:

LenStr =

Len(str1)
i = InStr(str1, "+")
If i > 0 Then
If i = 1 Or i = LenStr Then
Return "表达式错误"
Exit Function
End If
For j = i - 1 To 1 Step -1
Cn2 = Mid(str1, j, 1)
If Cn2 = "+" Or Cn2 = "-" Or Cn2 = "/" Or Cn2 = "*" Then
If Mid(str1, 1, 1) = "-" Then
Str2(1) = ""
Str2(2) = Mid(str1, 1, i - j)
Else
Str2(1) = Mid(str1, 1, j)
Str2(2) = Mid(str1, j + 1, i - j - 1)
End If
Exit For
End If
If j = 1 Then
Str2(1) = ""
Str2(2) = Mid(str1, 1, i - 1)
End If
Next
For j = i + 1 To LenStr
Cn2 = Mid(str1, j, 1)
If Cn2 = "+" Or Cn2 = "-" Or Cn2 = "/" Or Cn2 = "*" Then
Str2(3) = Mid(str1, i + 1, j - i - 1)
Str2(4) = Mid(str1, j， LenStr - j + 1)
Exit For
End If
If j = LenStr Then
Str2(3) = Mid(str1, i + 1, LenStr - i)
Str2(4) = ""
End If
Next
str1 = Trim(Str2(1) & Trim(Str(Val(Trim(Str2(2))) + Val(Trim(Str2(3))))) & Str2(4))
GoTo Xh3
End If

Return str1

End Function