计算器的最高成就!
我编写了一个函数,用来计算带有多重括号,和基本函数的.从前大多数编写者都是采用单步运算然而我这个函数,当你输入整个式子是,可以计算出结果!
请大家 多多指教!
本程序本来在上调试的,经过修改,如下,可以复制在代码中,直接调用
'=================版权所有 domes=================================='
Public Function Arthmetic(ByVal s As String)
On Error GoTo ee
Dim m(500) As String '可随意改变数组的上限，这里可执行500位的算术
Dim i, j As Integer '全局申明
Dim add As String
Dim count As Integer
count = 0
Dim v As Integer
'begin
'执行括号域分离
' 再次调用本程序,即递归
Const e = 2.01111
Const pi = 3.1415926
'==============================================================================
Dim ch
Do
ch = InStr(s, ")") '查找")"以便识别括号内容
If ch <> 0 Then
For j = ch To 1 Step -1
If Mid(s, j, 1) = "(" Then '找到后在往前识别"("
Dim before As String
before = Mid(s, j + 1, ch - j - 1) '收集括号的内容
Dim after As String
after = "(" & before & ")"
Dim mm As String
mm = Arthmetic(before)
s = Replace(s, after, mm) '收集包括括号的内容
Exit For
End If
Next
Else
If ch = 0 Then '当找不到）是退出循环，不会进入死循环
Exit Do
End If
End If
Loop
'===============过滤了符号下一处理是式子里没有括号=======================================
'=========================将字符和运算符号分离==========================================
For i = 1 To Len(s) '把符号和数字分开呈数组
Dim check As String
check = Mid(s, i, 1)
If check = "*" Or check = "/" Or check = "-" Or check = "+" Or check = "$" Or check = "\" Or check = "&" Then '在四则运算中判断符号
If Mid(add, 1, 1) = "M" Then
add = "-" & Mid(add, 2, Len(add) - 1)
End If
m(count) = add
count = count + 1 '组织数组的项的完整性
m(count) = check
add = ""
check = ""
count = count + 1
End If
add = add + check
If i = Len(s) Then
If Mid(add, 1, 1) = "M" Then
add = "-" & Mid(add, 2, Len(add) - 1)
End If
m(count) = add '累积数字成数字
End If
Next
'============================================================================
'==================================最高级运算==================================
For i = 0 To count
Dim w As Integer
w = InStr(1, m(i), "^") '^乘方运算
If w Then
a1 = Val(Mid(m(i), 1, w - 1)) '高级用方括号填写参数，避免和小括号处理冲突
a2 = Val(Mid(m(i), w + 1, Len(m(i)) - w))
m(i) = Val(a1) ^ Val(a2)
End If
'lg()对数运算
w = InStr(1, m(i), "lg[")
If w Then
a1 = Val(Mid(m(i), 4, Len(m(i)) - 4))
m(i) = Log(Val(a1)) '下面是常用函数调用
End If
w = InStr(1, m(i), "sin[")
If w Then
a1 = Val(Mid(m(i), 5, Len(m(i)) - 5))
m(i) = Sin(Val(a1))
End If
w = InStr(1, m(i), "cos[")
If w Then
a1 = Val(Mid(m(i), 5, Len(m(i)) - 5))
m(i) = Cos(a1)
End If
w = InStr(1, m(i), "tan[")
If w Then
a1 = Val(Mid(m(i), 5, Len(m(i)) - 5))
m(i) = Tan(a1)
End If
If m(i) = "pi" Then
m(i) = pi
End If
If m(i) = "e" Then
m(i) = e
End If
w = InStr(1, m(i), "log[")
If w Then
Dim gh
gh = Split(Mid(m(i), 5, Len(m(i)) - 5), ",")
m(i) = Log((Val(gh(0))) / Log(Val(gh(1))))
End If
w = InStr(1, m(i), "ln[")
If w Then
a1 = Mid(m(i), 4, Len(m(i)) - 4)
m(i) = Log(Val(a1))
End If
w = InStr(1, m(i), "sqrt[")
If w Then
a1 = Mid(m(i), 6, Len(m(i)) - 6)
m(i) = Sqr(Val(a1))
End If
w = InStr(m(i), "!")
If w Then
a1 = 1
For j = 1 To Mid(m(i), 1, Len(m(i)) - 1)
a1 = a1 * j
Next
m(i) = a1
End If
If m(i) = "result" Then m(i) = ans
Next
'=================================低级运算 四则运算 基本运算===================================
'===================================乘除运算==============================不算加减保留
Do
Dim fu As Integer '检查是否还有*或/的符号，以便再次调用方法
fu = 0
For i = 1 To count
If m(i) = "*" Or m(i) = "/" Or m(i) = "$" Or m(i) = "\" Or m(i) = "&" Then
fu = i
Exit For
End If
If i = count Then
fu = 0 '没有符号是发出信号该下一句
End If
Next
If fu <> 0 Then
If m(fu) = "*" Then
m(fu - 1) = Val(m(fu - 1)) * Val(m(fu + 1)) '单目乘法
End If
If m(fu) = "/" Then
m(fu - 1) = Val(m(fu - 1)) / Val(m(fu + 1)) '单目除法
End If
If m(fu) = "$" Then
m(fu - 1) = Val(m(fu - 1)) Mod Val(m(fu + 1))
End If
If m(fu) = "\" Then
m(fu - 1) = Val(m(fu - 1)) \ Val(m(fu + 1))
End If
If m(fu) = "&" Then
m(fu - 1) = (m(fu - 1)) & (m(fu + 1))
End If
For i = fu To count - 2 '把数组空的部位给后面的数组填充
m(i) = m(i + 2)
Next
m(i) = ""
m(i + 1) = ""
count = count - 2 '删除多余的数组
Else
Exit Do '跳出循环
End If
Loop
'最后把一条只有加减法的算式提供给下一子程序
'=====================加减法运算================================子程序
Dim n As Integer
n = 1
Do
If m(n) = "+" Or m(n) = "-" Then
If m(n) = "+" Then
m(n - 1) = Val(m(n - 1)) + Val(m(n + 1)) '执行加法
End If
If m(n) = "-" Then
m(n - 1) = Val(m(n - 1)) - Val(m(n + 1)) '执行减法
End If
For i = n To count - 2
m(i) = m(i + 2) '缩减数组长度，便于答案析出
Next
m(count) = ""
m(count - 1) = "" '剪掉后面无用项
count = count - 2
If m(n) <> "+" And m(n) <> "-" Then '跳出循环
Exit Do '关闭循环
End If
Else
Exit Do
End If
Loop
If Mid(m(0), 1, 1) = "-" Then
m(0) = "M" & Mid(m(0), 2, Len(m(0)) - 1)
End If
Arthmetic = m(0) '显示答案返回给调用的程序
Exit Function
ee:
MsgBox Err.Description
End Function
'如果大家有什么建议,可发表!
