表达式的计算

Miu.C

Public Function GetValue(ByVal Expression As String) As Single
Dim IsUnary As Boolean, NextUnary As Boolean
Dim PaNum As Integer 'Number of Brackets
Dim Pos As Integer
Dim LenExpr As Integer
Dim MyStr As String, LeftExpr As String, RightExpr As String
Dim Value As String
Dim MyPos As Integer, MyPrec As Integer
Dim LeftStr As String, RightStr As String
Dim StdSng As Single, SngR As Single
Const StrNote As String = "+-*/%^\"


Expression = Trim$(Expression)
LenExpr = Len(Expression)

If LenExpr = 0 Then Exit Function
IsUnary = True: MyPrec = 11
For Pos = 1 To LenExpr
MyStr = Mid$(Expression, Pos, 1)
NextUnary = False
If MyStr = " " Then NextUnary = IsUnary
If Asc(MyStr) = 40 Then PaNum = PaNum + 1: NextUnary = True

If Asc(MyStr) = 41 Then
PaNum = PaNum - 1
NextUnary = True
End If

If PaNum = 0 Then
If InStr(1, StrNote, MyStr) <> 0 Then
NextUnary = True
Select Case MyStr
Case "^"
If MyPrec >= 9 Then MyPrec = 9: MyPos = Pos
Case "*", "/"
If MyPrec >= 8 Then MyPrec = 8: MyPos = Pos
Case "\"
If MyPrec >= 6 Then MyPrec = 6: MyPos = Pos
Case "%"
If MyPrec >= 5 Then MyPrec = 5: MyPos = Pos
Case "+", "-"
If (Not IsUnary) Or MyPrec >= 4 Then MyPrec = 4: MyPos = Pos
End Select
End If
End If
IsUnary = NextUnary
Next
'******************************************************************************************
If PaNum <> 0 Then ErrorIf = True
If MyPrec < 11 Then
LeftExpr = Left$(Expression, MyPos - 1): RightExpr = Right$(Expression, LenExpr - MyPos)
Select Case Mid$(Expression, MyPos, 1)
Case "^"
StdSng = GetValue(LeftExpr)
SngR = GetValue(RightExpr)
If StdSng < 0 Then
If Round(SngR / 2, 0) <> SngR / 2 Then
ErrorIf = True
Exit Function
End If
End If

GetValue = StdSng ^ GetValue(RightExpr)
Case "*"
GetValue = GetValue(LeftExpr) * GetValue(RightExpr)
Case "/"
StdSng = GetValue(RightExpr)
If StdSng = 0 Then ErrorIf = True: Exit Function
GetValue = GetValue(LeftExpr) / GetValue(RightExpr)
Case "\"
StdSng = GetValue(RightExpr)
If StdSng = 0 Then ErrorIf = True: Exit Function
GetValue = GetValue(LeftExpr) \ GetValue(RightExpr)
Case "%"
StdSng = GetValue(RightExpr)
If StdSng = 0 Then ErrorIf = True: Exit Function
GetValue = GetValue(LeftExpr) Mod GetValue(RightExpr)
Case "+"
GetValue = GetValue(LeftExpr) + GetValue(RightExpr)
Case "-"
GetValue = GetValue(LeftExpr) - GetValue(RightExpr)
End Select
Exit Function
End If
LeftStr = Left$(Expression, 1): RightStr = Right$(Expression, 1)
If LeftStr = "(" And RightStr = ")" Then
GetValue = GetValue(Mid$(Expression, 2, LenExpr - 2))
Exit Function
End If
If LeftStr = "-" Then
GetValue = -GetValue(Right$(Expression, LenExpr - 1))
Exit Function
End If
If Left$(Expression, 1) = "+" Then
GetValue = GetValue(Right$(Expression, LenExpr - 1))
Exit Function
End If
If LenExpr > 5 And RightStr = ")" Then
LeftExpr = LCase$(Left$(Expression, 4))
RightExpr = Mid$(Expression, 5, LenExpr - 5)
On Error Resume Next
Select Case LeftExpr
Case "sin("
GetValue = Sin(GetValue(RightExpr))
Exit Function
Case "cos("
GetValue = Cos(GetValue(RightExpr))
Exit Function
Case "tan("
GetValue = Tan(GetValue(RightExpr))
If Err.Number <> 0 Then: ErrorIf = True: Exit Function

Exit Function
Case "asn("
Value = GetValue(RightExpr)
If Value > 1 Or Value < -1 Then ErrorIf = True: Exit Function
If Value = -1 Then GetValue = -Pi / 2: Exit Function
If Value = 1 Then GetValue = Pi / 2: Exit Function
GetValue = Atn(Value / Sqr(1 - Value ^ 2))
Exit Function
Case "acs("
Value = GetValue(RightExpr)
If Value > 1 Or Value < -1 Then ErrorIf = True: Exit Function
If Value = -1 Then GetValue = Pi: Exit Function
If Value = 1 Then GetValue = 0: Exit Function
GetValue = Atn(-Value / Sqr(1 - Value ^ 2)) + Pi / 2
Exit Function
Case "lnn("
GetValue = Log(GetValue(RightExpr))
If Err.Number <> 0 Then: ErrorIf = True: Exit Function
Exit Function
Case "log("
GetValue = Log(GetValue(RightExpr)) / Log(10)
If GetValue(RightExpr) <= 0 Then ErrorIf = True: Exit Function
Exit Function
Case "abs("
GetValue = Abs(GetValue(RightExpr))
Exit Function
Case "rnd("
Randomize
GetValue = Rnd * GetValue(RightExpr)
Exit Function
Case "atn("
GetValue = Atn(GetValue(RightExpr))
Exit Function
Case "sqr("
GetValue = Sqr(GetValue(RightExpr))
If GetValue(RightExpr) < 0 Then: ErrorIf = True: Exit Function
Exit Function
Case "exp("
GetValue = Exp(GetValue(RightExpr))
If Err.Number <> 0 Then: ErrorIf = True: Exit Function
Case "sum("
GetValue = CalcClip(RightExpr, 1)
Exit Function
Case "ave("
GetValue = CalcClip(RightExpr, 2)
Exit Function
Case "max("
GetValue = CalcClip(RightExpr, 3)
Exit Function
Case "min("
GetValue = CalcClip(RightExpr, 4)
Exit Function
Case "mid("
GetValue = CalcClip(RightExpr, 5)
Exit Function
Case "fan("
GetValue = CalcClip(RightExpr, 6)
Exit Function
Case "bao("
GetValue = CalcClip(RightExpr, 7)
Exit Function

Case "sgn("
GetValue = Sgn(GetValue(RightExpr))
Exit Function
End Select
End If

If Expression = "x" Then
GetValue = TempValue
Exit Function
End If

'
On Error Resume Next
GetValue = CSng(Expression)
On Error GoTo 0
If Err.Number <> 0 Then
ErrorIf = True
Err.Clear
End If

End Function

Miu.C

做RPG脚本系统说不定用得着。

Miu.C

Public Function 计算(表达式 As String) As String
Dim i, n As Integer
Dim Temp表达式, Temp As String
Dim Vl() As String '操作数
Dim Vls As Integer '操作数的数目
Dim Si As Integer '上一操作符的位置
Dim Ads, Sus, Mus, Bys, Lks, Rks As Integer '操作符的数目
Dim Adp(), Mup(), Byp(), Lkp(), Rkp() As Integer '操作符的位置
Dim Adn(), Mun(), Byn() As Integer '操作符的排列次序
Dim Sig() As Integer '每一个操作符的位置

On Error GoTo Err
Do While True
ReDim Adp(Len(表达式)), Mup(Len(表达式)), Byp(Len(表达式)) _
, Lkp(Len(表达式)), Rkp(Len(表达式)) As Integer
ReDim Adn(Len(表达式)), Mun(Len(表达式)), Byn(Len(表达式)) _
, Lkn(Len(表达式)), Rkn(Len(表达式)), Sig(Len(表达式)) As Integer

ReDim Vl(Len(表达式))

If Len(表达式) = 0 Then GoTo Err
If Mid(表达式, Len(表达式), 1) <> "#" Then

Temp表达式 = 表达式
For i = 1 To Len(表达式) '将减化加
If Mid(表达式, i, 1) = "-" And i <> 1 Then
If Mid(表达式, i - 1, 1) <> "+" _
And Mid(表达式, i - 1, 1) <> "-" _
And Mid(表达式, i - 1, 1) <> "*" _
And Mid(表达式, i - 1, 1) <> "/" Then
Temp表达式 = Mid(Temp表达式, 1, i - 1 + n) + "+" + Mid(表达式, i)
n = n + 1
End If
End If
Next i
表达式 = Temp表达式
n = 0
For i = 1 To Len(表达式) '处理负负得正
If Mid(表达式, i, 1) = "-" Then
If Mid(表达式, i + 1, 1) = "-" Then
Temp表达式 = Mid(Temp表达式, 1, i - 1 - n) + Mid(表达式, i + 2)
n = n + 2
End If
End If
Next i
表达式 = Temp表达式
表达式 = 表达式 + "#"
End If

Vls = 1
Ads = 0: Sus = 0: Mus = 0: Bys = 0: Lks = 0: Rks = 0

For i = 1 To Len(表达式)

Select Case Mid(表达式, i, 1)
Case "+"
Ads = Ads + 1
Adp(Ads) = i
Adn(Ads) = Vls
Case "*"
Mus = Mus + 1
Mup(Mus) = i
Mun(Mus) = Vls
Case "/"
Bys = Bys + 1
Byp(Bys) = i
Byn(Bys) = Vls
Case "("
Lks = Lks + 1
Lkp(Lks) = i

Case ")"
Rks = Rks + 1
Rkp(Rks) = i


End Select

If Mid(表达式, i, 1) = "+" Or Mid(表达式, i, 1) = "*" Or _
Mid(表达式, i, 1) = "/" Or Mid(表达式, i, 1) = "#" Then

'If Si + 1 = i And Mid(表达式, i + 1, 1) <> "#" _
'Then '操作符非法连续或以操作符开头
'GoTo Err2
'Else
'Si = i
'End If

If Not IsNumeric(Vl(Vls)) And Mid(表达式, i + 1, 1) <> "#" Then '操作数不是数字
GoTo Err3
End If
Sig(Vls) = i
Vls = Vls + 1

Else
If Mid(表达式, i, 1) <> "(" And Mid(表达式, i, 1) <> ")" Then
Vl(Vls) = Vl(Vls) + Mid(表达式, i, 1) '制作操作数
Else
If i <> 1 Then
If ((Mid(表达式, i - 1, 1) = "(" _
And Mid(表达式, i, 1) = ")") _
Or (Mid(表达式, i - 1, 1) = ")" And Mid(表达式, i, 1) = "(")) _
Then '判定括号前后符号的合法性
GoTo Err4
End If
End If
End If
End If

Next i

If Lks <> Rks Then
GoTo Err5 '左右括号数是否匹配
End If

For i = 1 To Lks
If Lkp(i) > Rkp(i) Then GoTo Err6 '左右括号出现顺序错误
Next i

If Lks <> 0 Then '括号处理
Do While True
For i = Lks To 1 Step -1
For n = Rks To 1 Step -1

Temp = 计算(Mid(表达式, Lkp(i) + 1, Rkp(n) - Lkp(i) - 1))
If Temp <> "公式有错误" Then
表达式 = Mid(表达式, 1, Lkp(i) - 1) + Temp + Mid(表达式, Rkp(n) + 1)
Exit Do
End If
Next n
Next i
If Temp = "公式有错误" Then GoTo Err7
'括号中有错误退出
Loop
Else
If Mus <> 0 Then '乘法处理
表达式 = Mid(表达式, 1, Sig(Mun(1) - 1)) _
+ Trim(Str(Val(Vl(Mun(1))) _
* Val(Vl(Mun(1) + 1)))) _
+ Mid(表达式, Val(Mup(1)) _
+ Len(Vl(Mun(1) + 1)) + 1)
Else
If Bys <> 0 Then '除法处理
表达式 = Mid(表达式, 1, Sig(Byn(1) - 1)) _
+ Trim(Str(Val(Vl(Byn(1))) / Val(Vl(Byn(1) + 1)))) _
+ Mid(表达式, Val(Byp(1)) + Len(Vl(Byn(1) + 1)) + 1)
Else
If Ads <> 0 Then '加法处理
表达式 = Trim(Str(Val(Vl(1)) + Val(Vl(2)))) _
+ Mid(表达式, Val(Adp(1)) _
+ Len(Vl(2)) + 1)
Else
计算 = Mid(表达式, 1, Len(表达式) - 1)
Exit Function
End If
End If
End If
End If
Loop


Err:
'计算 = "公式有错误"
a = 1
Err2:
a = 1
Err3:
a = 1
Err4:
a = 1
Err5:
a = 1
Err6:
a = 1
Err7:
a = 1
End Function

justgame

1+1=?

Miu.C

justgame: Re:表达式的计算

1+1=?

不是啊
是输入"1+1"得出2。

justgame

MIU可以做编译了,发明一种语言吧

Miu.C

不敢当.........
以前做过一个很简陋的编译器，是根据别人的改的，能生成.exe文件，当时叫.........A++语言。

yinxiaodan

CalcClip 是什么,代码贴全看下

Miu.C

需要代码，星期天共享