Public Function CalculateString(ByVal Exppression As String, ByRef Good As Boolean, ByVal xxx As Double) As Double
Dim isg As Boolean
Dim ExppressionLength As Long
Dim pp As Integer
pp = 1
ExppressionLength = Len(Exppression)
CalculateString = E(Exppression, isg, pp, xxx)
Good = isg
If pp <= ExppressionLength Then Good = False
End Function
Private Function E(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
Dim tmp1, tmp2 As Double
Dim isg As Boolean
On Error GoTo Eerr
tmp1 = T(Exppression, isg, position, xxx)
If Match(Exppression, "+", position) Then
position = position + 1
tmp2 = E2(Exppression, isg, position, xxx)
If Not (isg) Then
Good = False
Exit Function
End If
E = tmp1 + tmp2
Else
If Match(Exppression, "-", position) Then
position = position + 1
tmp2 = E2(Exppression, isg, position, xxx)
If Not (isg) Then
Good = False
Exit Function
End If
E = tmp1 - tmp2
Else
E = tmp1
End If
End If
Good = isg
Exit Function
Eerr:
Good = False
End Function
Private Function E2(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
Dim tmp1, tmp2 As Double
Dim isg As Boolean
tmp1 = T2(Exppression, isg, position, xxx)
If Match(Exppression, "+", position) Then
position = position + 1
tmp2 = E2(Exppression, isg, position, xxx)
If Not (isg) Then
Good = False
Exit Function
End If
E2 = tmp1 + tmp2
Else
If Match(Exppression, "-", position) Then
position = position + 1
tmp2 = E2(Exppression, isg, position, xxx)
If Not (isg) Then
Good = False
Exit Function
End If
E2 = tmp1 - tmp2
Else
E2 = tmp1
End If
Good = isg
End If
End Function
Private Function T(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
Dim tmp1, tmp2 As Double
Dim isg As Boolean
tmp1 = F(Exppression, isg, position, xxx)
If isg Then
If Match(Exppression, "*", position) Then
position = position + 1
tmp2 = T2(Exppression, isg, position, xxx)
If Not (isg) Then
Good = False
Exit Function
End If
T = tmp1 * tmp2
Else
If Match(Exppression, "/", position) Then
position = position + 1
tmp2 = T2(Exppression, isg, position, xxx)
If Not (isg) Then
Good = False
Exit Function
End If
T = tmp1 / tmp2
Else
T = tmp1
End If
End If
End If
Good = isg
End Function
Private Function T2(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
Dim tmp1, tmp2 As Double
Dim isg As Boolean
tmp1 = F2(Exppression, isg, position, xxx)
If isg Then
If Match(Exppression, "*", position) Then
position = position + 1
tmp2 = T2(Exppression, isg, position, xxx)
If Not (isg) Then
Good = isg
Exit Function
End If
T2 = tmp1 * tmp2
Else
If Match(Exppression, "/", position) Then
position = position + 1
tmp2 = T2(Exppression, isg, position, xxx)
If Not (isg) Then
Good = isg
Exit Function
End If
T2 = tmp1 / tmp2
Else
T2 = tmp1
End If
End If
End If
Good = isg
End Function
Private Function F(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
Dim tmp As Double
Dim isg As Boolean
tmp = OpDigital(Exppression, isg, position, xxx)
If Not (isg) Then tmp = G(Exppression, isg, position, xxx)
F = tmp
Good = isg
End Function
Private Function F2(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
Dim tmp As Double
Dim isg As Boolean
tmp = NonopDigital(Exppression, isg, position, xxx)
If Not (isg) Then tmp = G(Exppression, isg, position, xxx)
F2 = tmp
Good = isg
End Function
Private Function G(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
Dim tmp1, tmp2 As Double
Dim isg As Boolean
Call PassBlank(Exppression, position)
If Match(Exppression, "SIN", position) Then
position = position + 3
Call PassBlank(Exppression, position)
G = Sin(G2(Exppression, Good, position, xxx))
Call PassBlank(Exppression, position)
Exit Function
End If
If Match(Exppression, "COS", position) Then
position = position + 3
Call PassBlank(Exppression, position)
G = Cos(G2(Exppression, Good, position, xxx))
Call PassBlank(Exppression, position)
Exit Function
End If
If Match(Exppression, "TAN", position) Then
position = position + 3
Call PassBlank(Exppression, position)
G = Tan(G2(Exppression, Good, position, xxx))
Call PassBlank(Exppression, position)
Exit Function
End If
If Match(Exppression, "LOG", position) Then
position = position + 3
Call PassBlank(Exppression, position)
G = Log(G2(Exppression, Good, position, xxx)) / Log(10#)
Call PassBlank(Exppression, position)
Exit Function
End If
If Match(Exppression, "LN", position) Then
position = position + 2
Call PassBlank(Exppression, position)
G = Log(G2(Exppression, Good, position, xxx))
Call PassBlank(Exppression, position)
Exit Function
End If
If Match(Exppression, "EXP", position) Then
position = position + 3
Call PassBlank(Exppression, position)
G = Exp(G2(Exppression, Good, position, xxx))
Call PassBlank(Exppression, position)
Exit Function
End If
If Match(Exppression, "ARCTAN", position) Then
position = position + 6
Call PassBlank(Exppression, position)
G = Atn(G2(Exppression, Good, position, xxx))
Call PassBlank(Exppression, position)
Exit Function
End If
If Match(Exppression, "ARCSIN", position) Then
position = position + 6
Call PassBlank(Exppression, position)
tmp1 = G2(Exppression, Good, position, xxx)
If tmp1 <> 1 And tmp1 <> -1 Then
G = Atn(tmp1 / Sqr(1 - tmp1 * tmp1))
Else
If tmp1 = 1 Then G = Pi / 2 Else G = -Pi / 2
End If
Call PassBlank(Exppression, position)
Exit Function
End If
If Match(Exppression, "ARCCOS", position) Then
position = position + 6
Call PassBlank(Exppression, position)
tmp1 = G2(Exppression, Good, position, xxx)
If tmp1 <> 1 And tmp1 <> -1 Then
G = Atn(-tmp1 / Sqr(1 - tmp1 * tmp1)) + Pi / 2
Else
If tmp1 = 1 Then G = 0# Else G = Pi
End If
Call PassBlank(Exppression, position)
Exit Function
End If
If Match(Exppression, "POW", position) Then
position = position + 3
Call PassBlank(Exppression, position)
If Match(Exppression, "(", position) Then
position = position + 1
tmp1 = E(Exppression, isg, position, xxx)
If Match(Exppression, ",", position) And isg Then
position = position + 1
tmp2 = E(Exppression, isg, position, xxx)
If Match(Exppression, ")", position) And isg Then
position = position + 1
Call PassBlank(Exppression, position)
Good = True
G = tmp1 ^ tmp2
Exit Function
End If
End If
End If
Good = False
Exit Function
End If
G = G2(Exppression, Good, position, xxx)
Call PassBlank(Exppression, position)
End Function
Private Function G2(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
Dim tmp As Double
Dim isg As Boolean
If Match(Exppression, "(", position) Then
position = position + 1
Call PassBlank(Exppression, position)
tmp = E(Exppression, isg, position, xxx)
If isg And Match(Exppression, ")", position) Then
G2 = tmp
position = position + 1
Good = True
Else
Good = False
End If
End If
End Function
Private Function NonopDigital(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
Dim tmp1, tmp2 As Double
Dim tmpStr As String
Call PassBlank(Exppression, position)
If Match(Exppression, "X", position) Then
NonopDigital = xxx
Good = True
position = position + 1
Call PassBlank(Exppression, position)
Exit Function
End If
tmp1 = 0
tmp2 = 0
tmpStr = Mid(Exppression, position, 1)
If tmpStr >= "0" And tmpStr <= "9" Then
While tmpStr >= "0" And tmpStr <= "9" Or tmpStr = " "
tmp2 = tmp2 + 1
tmpStr = Mid(Exppression, position + tmp2, 1)
Wend
If tmpStr = "." Then tmp2 = tmp2 + 1
tmpStr = Mid(Exppression, position + tmp2, 1)
While tmpStr >= "0" And tmpStr <= "9" Or tmpStr = " "
tmp2 = tmp2 + 1
tmpStr = Mid(Exppression, position + tmp2, 1)
Wend
If tmpStr = "E" Then tmp2 = tmp2 + 1
tmpStr = Mid(Exppression, position + tmp2, 1)
While tmpStr >= "0" And tmpStr <= "9" Or tmpStr = " "
tmp2 = tmp2 + 1
tmpStr = Mid(Exppression, position + tmp2, 1)
Wend
tmp1 = Val(Mid(Exppression, position))
position = position + tmp2
Good = True
Else
Good = False
End If
NonopDigital = tmp1
End Function
Private Function OpDigital(ByVal Exppression As String, ByRef Good As Boolean, ByRef position As Integer, ByVal xxx As Double) As Double
Dim tmp As Double
Dim isg As Boolean
Dim sign As Integer
sign = 1
Call PassBlank(Exppression, position)
If Match(Exppression, "X", position) Then
OpDigital = xxx
Good = True
position = position + 1
Call PassBlank(Exppression, position)
Exit Function
End If
If Match(Exppression, "-", position) Then
position = position + 1
sign = -1
Else
If Match(Exppression, "+", position) Or Mid(Exppression, position, 1) >= "0" And Mid(Exppression, position, 1) <= "9" Then
sign = 1
Else
Good = False
Exit Function
End If
End If
tmp = F2(Exppression, isg, position, xxx)
If Not (isg) Then Good = False Else Good = True
OpDigital = tmp * sign
End Function
Private Function Match(ByVal Exppression As String, ByVal Exppression2 As String, ByRef position As Integer) As Boolean
If Mid(Exppression, position, Len(Exppression2)) = Exppression2 Then Match = True Else Match = False
End Function
Private Sub PassBlank(ByVal Exppression As String, ByRef position)
While Mid(Exppression, position, 1) = " "
position = position + 1
Wend
End Sub Private Sub Command1_Click() Dim strexp As String, temp As String Dim a As Double, b As Boolean Dim i As Integer strexp = Text1.Text For i = 1 To Len(strexp) temp = Mid(strexp, i, 1) If Asc(temp) <= Asc("z") And Asc(temp) >= Asc("a") Then strexp = Left(strexp, i - 1) + StrConv(temp, vbUpperCase) + Right(strexp, Len(strexp) - i) End If Next i a = CalculateString(strexp, b, 1) If b = True Then Label1.Caption = "计算结果为: " + Str$(a) Else Label1.Caption = "公式有错误" End If End Sub