混合四则运算的代码

　　混合四则运算可以利用别人写好的控件，再就利用Excel（前提是安装了Excel）。我这
里说的，是自己编写代码。
　　例如文本框有这样一个算式：3 * 7 - ((2 + 18)/5 + 6)，如何编写代码？
　　看起来是个很简单的式子，写起代码来却大费周章，耗费了我整整一天的时间。编程的
思路最后归纳为：
1.整个算式当作字符串来处理，只是在具体计算时化为数值，结果再转为字符串
2.不断地用计算结果替换原单项计算式，例如用“21”替换“3 * 7”

解题步骤如下：

预备工作：
1.去掉字符串中的空格，上式就变成了这样的字符串：“3*7+((2+18)/5+6)”
2.将小写字母转换为大写字母

开始计算：
1.利用函数 FindPlace 查找括号的位置，取出括号及其中的算式作为一个子字符串。如上
　式中的“（2+18）”。
2.将去掉括号的算式（如果没有括号就将整个算式）交给 analyze 函数，按照乘、除、加
　减的顺序进行计算。
3.在进行单项计算时，先确定运算符的位置，以这个位置为基础，分别获取前后两个数据和
　运算符本身，如上式中的“2”、“18”、“+”。这个步骤中最麻烦的是对“-”号的处
　理，因为它既可表示减法，也可以表示负数。
4.根据运算符计算（这是最轻松的步骤了）
5.每进行完一次计算，都要将结果转换成字符串，去替换由数据和运算符组成的子字符串。
　如“20/5+6”，除完后，用商去替换“20/5”这个子字符串，得到一个新的字符串：
　“4+6”
6.重复步骤1-5，上式就依次变成：“3*7+10”、“21-10”、“11”，结果在Text2显示。

　　笔者根据以上叙述编写了代码。本代码还可以对2/8/16进制的数据进行四则运算（但计
算结果均为10进制），这三种进制的输入规则是：
1.在数据前加一个标识字母（大小写均可），B表示2进制，O表示 8进制，H表示16进制，除
　了这三个字母和16进制数字 A－F，计算式中不能出现其它字母
2.这三种进制的输入数据不能是小数，如：“100+H0.5”（16进制小数 0.5）是非法数据

下面就动手实验：
　　新建一个窗体，添加两个文本框和一个按纽，其中Text1用于输入计算式，Text2用于显
示计算结果。点击按纽就开始计算

代码如下：

Option Explicit

Private Sub Command1_Click()
Dim st As String, MyData1 As String, MyData2 As String

st = Text1
If Len(st) < 3 Then Exit Sub
st = UCase(Replace(st, " ", "")) '去掉字符串中的空格并将字母转为大写

st = checkstring(st): If InStr(st, "错误") Then MsgBox st: Exit Sub '如果是非法数据，退出

Do While InStr(st, "H") > 0: st = AnyToDec(st, 16): Loop '将16进制转换为10进制
Do While InStr(st, "B") > 0: st = AnyToDec(st, 2): Loop '将2进制转换为10进制
Do While InStr(st, "O") > 0: st = AnyToDec(st, 8): Loop '将8进制转换为10进制

Do While InStr(st, "(") > 0 '如果有括号
  MyData1 = FindPlace(st)
  MyData2 = MyData1
  MyData1 = Mid$(MyData1, 2, Len(MyData1) - 2) '从取出的字符串中去掉左右括号
  MyData1 = analyze(MyData1)
  st = Replace(st, MyData2, MyData1) '用计算结果替代原字符串中的括号内容
Loop

Text2 = analyze(st)
End Sub

Function FindPlace(S As String) As String '查找括号的位置，取出括号及其中的算式
Dim i As Integer, k As Integer
i = 1
Do While i > 0
  i = InStr(i, S, "(")
  If i > 0 Then k = i: i = i + 1
Loop
If k > 0 Then i = InStr(k + 1, S, ")"): FindPlace = Mid$(S, k, i - k + 1)
End Function

Function analyze(nSt As String) As String
Dim i As Integer, z As String
Do While InStr(nSt, "*") > 0: nSt = operate(nSt, "*"): Loop '如果有*
Do While InStr(nSt, "/") > 0: nSt = operate(nSt, "/"): Loop '如果有/
Do While InStr(nSt, "+") > 0: nSt = operate(nSt, "+"): Loop '如果有+
Do While InStr(nSt, "-") > 0 '如果有-
  If Left(nSt, 1) = "-" Then
    For i = 2 To Len(nSt)
      z = Mid$(nSt, i, 1): If InStr("*/+-", z) > 0 Then Exit For
    Next
  End If
  If i > Len(nSt) Then Exit Do '如果 - 号后面没有其它运算符，那么这是一个负数
  nSt = operate(nSt, "-")
Loop
analyze = nSt
End Function

Function operate(S As String, sign As String) As String '完成一次运算
Dim k1 As Integer, k2 As Integer, S1 As String, S2 As String, z As String, n As String, i As Integer
i = InStr(2, S, sign) '获得运算符位置

z = Left$(S, i - 1) '获得运算符前的字符串
For k1 = Len(z) To 1 Step -1
  n = Mid$(z, k1, 1): If k1 = 1 And n = "-" Then n = "." '如果是负数而不是减号
  If InStr(".0123456789", n) = 0 Then Exit For
Next
k1 = k1 + 1
S1 = Mid$(z, k1) '获得运算符前的数据

z = Mid$(S, i + 1) '获得运算符后的字符串
For k2 = 1 To Len(z)
  n = Mid$(z, k2, 1): If k2 = 1 And n = "-" Then n = "." '如果是负数而不是减号
  If InStr(".0123456789", n) = 0 Then Exit For
Next
k2 = k2 - 1
S2 = Mid$(z, 1, k2) '获得运算符后的数据

z = Mid$(S, k1, k2 + i - k1 + 1) '获得一个完整的算式字符串用于替换
operate = Replace(S, z, Format(nCount(S1, S2, sign)))
End Function

Function nCount(Num1 As String, Num2 As String, symbo As String) As Double
Select Case symbo
  Case "+": nCount = Val(Num1) + Val(Num2)
  Case "-": nCount = Val(Num1) - Val(Num2)
  Case "*": nCount = Val(Num1) * Val(Num2)
  Case "/": If Num2 <> "0" Then nCount = Val(Num1) / Val(Num2) Else MsgBox "除数不能为0！计算结果是错误的"
End Select
End Function

Function AnyToDec(mSt As String, Num As Integer) As String '2/8/16进制转为10进制
On Error GoTo 100
Dim i As Integer, k As Integer, A As Integer, L As Integer, j As Integer, d As String, B As Double

'查找标识所在的位置
k = InStr(mSt, "H")
If k = 0 Then k = InStr(mSt, "B")
If k = 0 Then k = InStr(mSt, "O")

For i = k + 1 To Len(mSt) '获取数据
  d = Mid$(mSt, i, 1): If InStr("*/+-)", d) > 0 Then Exit For
Next
d = Mid$(mSt, k + 1, i - k - 1)

L = Len(d)
For j = 0 To L - 1 '开始转换
  A = Asc(Mid$(d, L - j, 1)) - 48
  If A < 0 Or A > 9 And A < 17 Or A > 22 Then A = 0
  If A > 9 Then A = A - 7
  If A > 0 Then B = B + A * Num ^ j
Next

AnyToDec = Replace(mSt, Mid$(mSt, k, i - k), Format(B)) '用10进制字符串替换原2/8/16进制字符串
100
End Function

Function checkstring(ByVal S As String) As String '判断计算式是否合法
Dim i As Integer, j As Integer, k As Integer, z As String, z1 As String, z2 As String
z = S
For i = 1 To Len(z)
  If InStr(".0123456789ABCDEFHOB()+-*/", Mid$(z, i, 1)) = 0 Then S = "错误！发现非法数据": GoTo endcheck
Next

z = S: i = 0
Do While InStr(z, "(") > 0: i = i + 1: z = Mid(z, InStr(z, "(") + 1): Loop '统计左括号数量
z = S: j = 0
Do While InStr(z, ")") > 0: j = j + 1: z = Mid(z, InStr(z, ")") + 1): Loop '统计右括号数量
If i <> j Then S = "错误！表达式中括号不成对": GoTo endcheck

z2 = "H": z1 = "": GoSub 100: If z1 <> "" Then S = z1: GoTo endcheck
z2 = "O": z1 = "": GoSub 100: If z1 <> "" Then S = z1: GoTo endcheck
z2 = "B": z1 = "": GoSub 100: If z1 <> "" Then S = z1

endcheck:
checkstring = S
Exit Function

100
j = 0
Do
  j = j + 1: j = InStr(j, S, z2): If j = 0 Then Exit Do '查找标识所在的位置
  For i = j + 1 To Len(S) '获取数据
    z = Mid$(S, i, 1): If InStr("*/+-)", z) Then Exit For
  Next
  z = Mid$(S, j + 1, i - j - 1): If InStr(z, ".") Then z1 = "错误！2/8/16进制数据不能是小数": Exit Do
  If z2 = "O" Then GoSub 200: If z1 <> "" Then Exit Do
  If z2 = "B" Then GoSub 300: If z1 <> "" Then Exit Do
  
Loop While j > 0
Return

200
For i = 1 To Len(z) '检查8进制数据
  If InStr("01234567", Mid$(z, i, 1)) = 0 Then z1 = "错误！发现非法八进制数据": Exit For
Next
Return

300
For i = 1 To Len(z) '检查2进制数据
  If InStr("01", Mid$(z, i, 1)) = 0 Then z1 = "错误！发现非法二进制数据": Exit For
Next
Return
End Function


　　OK，现在随便输入几个算式看看：
输入“b1010-((o2+18)/h5-h6)-o3*o7”，计算得：-9
输入“1010-hff*((o7-18)/ha-h6)/3*o7”，计算得：1096.21428571429
输入“(hf*10*ha-b1010*50)/o31”，计算得：40
完全正确！


2007.6.16