VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 11151|回复: 7

[原创] XiaoJSoft 开源作品:VB多功能表达式计算器 (算法) 【开源】

[复制链接]
 楼主| 发表于 2011-1-23 14:59:43 | 显示全部楼层 |阅读模式
本帖最后由 XiaoJSoft 于 2011-1-23 15:37 编辑

以前看过各位高人们写的如何计算表达式,而且在网上搜过一阵子,发现几乎没有符合我心意的表达式计算算法。于是便想要自己创造一个

这个程序支持+、-、*、/、\、!
(阶乘)、%和^,而且可以括号连乘哦,如(1+2)(3+4*5),不需要写括号,而且可以使用自定义变量,变量前可以加数字,如4pi。

现在支持这些函数,你还可以扩展:支持的函数:
sqr(x) -> 开方
abs(x);cos(x);exp(x);log(x);rnd(x);sgn(x);sin(x);tan(x)
opp(x) -> 获得相反数
sec(x);csc(x);cot(x);hsin(x);hcos(x);hcsc(x);hcot(x);hsec(x);htan(x);icsc(x);icos(x);icot(x);isec(x);isin(x);itan(x);ihcos(x);ihcsc(x);ihcot(x);ihsin(x);ihsec(x);ihtan(x)
ln(x) -> 有底数log
sr(x,y) -> 开x的y次方

现在给大家分享出来吧,给大家分享。

先发图片,程序和源代码连接在后面。


图片1,主界面,可以计算复杂算式

1

1



图片2,简单的函数绘图功能,支持复杂函数

2

2


本人今天初四,写的程序中还有很多瑕疵,希望各位给予建议


程序和源代码:

ecc-1.06.7660_zh-CN.rar (102.77 KB, 下载次数: 985)

评分

参与人数 3威望 +1 人气 +3 收起 理由
neilbr + 1 原创内容
icecept + 1 + 1 程序很不错
阳光宝宝 + 1 发布源码

查看全部评分

本帖被以下淘专辑推荐:

 楼主| 发表于 2011-1-23 15:57:09 | 显示全部楼层
本帖最后由 XiaoJSoft 于 2011-1-23 15:58 编辑

说一下我的算法。

首先是如何实现算数优先级,由于对堆栈理解不透彻,索性就不用它,我突然想到了,我们人是怎么思考表达式的呢 -> 分割吗。
举个例子吧:1+2*3,我们人会先把它分解成 1 和 2*3 分别运算最后求值。
那么表达式计算也可以符合这个过程,表达式有+、-、*、/、^、%等,这里我是这么想的:

(1) 首先要把最低级的先分割,譬如说1+2*3这个算式,我们要把它分割成1和2*3而不是1+2和3。
+最优先分割,-其次,然后分*,最后分/,接下来处理百分号和其他自变量、常量(如pi)等。

(2) 分割完后,把它重新递归到表达式计算过程中,让它进一步分割直到完全求值为止(一定会有一个递归终点,那就是当算式中只有1个运算符的时候)。

(3) 特殊情况
A. 分割时也要考虑到调号。如1-2-3-4,我们不能把它直接分解为1和2-3-4递归了之,而是要把2-3-4调号,为2+3+4,即我们所认为的1-(2+3+4)这种情况,这样才能运算正确),这个情况适用于减法和除法。

B. 至少不能把相连的两个运算符其中之一给分割了吧。如2*-4,如果我们先分割减号,那么岂不是要成为这种情况:2*和4,这是什么?递归后程序把2*认为是2*0等于0,运算了之,最终岂不是等于0了!所以我们在程序中需要考虑到这种情况,如果低级运算符前面有高级运算符,那么无视低级运算符。

接下来是括号处理,这里闹了我很久,最终发现了解决方法(只是发现在统计字符串时,如果恰好到括号所对应的扩回,从扩回这一点到括号这一点(包括这两点)其中的括号字符和扩回字符数量一致。

于是我们设有这样的变量:L1、L2,用于统计个数,假设我们需要的算式是:2*((3+4*(3*5))-2),我们要分解第二层括号。

第二层括号的起始位置是 4,循环从这里开始,一直到 17(算式字符串长度) 为止,每当遇到“(”时,自动把 L1+1,遇到“)”时把 L2+1,我们发现当到 14 时,L1=L2,则这里所对应的符号就应该是第二层括号的扩回了,然后用 mid 函数取括号内的内容,取括号前面的内容的一部分用于函数处理,把括号内部分递归到计算过程中运算,如果有函数,就将返回值处理一下,用最终计算结果替换掉括号及其里面的内容,如果括号后面直接又是一个括号(如sin(1+2)(3*4)),就在括号后面自动补上一个*,如果括号内是负数,就把负数变为正数,并将其后面再加上K符号(其实这里是为了处理这样的一种类似情况并将其区分:(-4)*3和-4*3,明显可以看出这两种返回值是不同的,至于K可以在后期分割符号时,因为不是数字不能直接参与运算,被程序再次递归运算,这次直接返回值进入计算变量,就不会有字符串处理的过程,也就没有了这种情况,至少我是这么想的,不知道你是不是有更好的方法)。

自变量/常量支持,这个相当简单,如果分割到最后仍然有不能识别的部分,则让程序去上常量库中找找,看有没有,如果有就返回运算,如果没有,终止这一级别的运算过程,调用这一运算过程的过程也将终止,运算失败。

然后是给懒人们留个门,怎么说呢,就是在常量前面直接加上数字啦,如4pi,我们一般写成4*pi,程序是不会识别4pi的,怎么办呢,还记得常量是如何被判断的吧(上面呢),我们在读取常量库时先看看常量前面有没有数字就可以了。

我很懒,源代码中没有注释,接下来我会把所有代码都加上注释给大家。




  1. ; 这里只是部分注释后的代码,不完全,完整代码请到二楼下载。
  2. Option Explicit
  3. ; 定义了计算结果,成功、失败和计算错误
  4. Public Enum enuReturns
  5.     lpSucceed = 0
  6.     lpSyntaxError = 1
  7.     lpRunError = 2
  8. End Enum
  9. ; 调试器(程序中没有)
  10. Public Enum enuDebugger
  11.     lpNull = 0
  12.     lpInput = 1
  13. End Enum
  14. ; 记录log底数
  15. Public lpLogBase As Double
  16. ; 是否是弧度制
  17. Public bpRadianWay As Boolean
  18. ; 初始化过程(这里只是初始了log底数)
  19. Public Sub IntialConstants()
  20.     On Error Resume Next
  21.     lpLogBase = 10
  22. End Sub
  23. ; 取得根,譬如说8的立方根是2,这里就可以表达为 msgbox GetRoot(8, 3) ,返回2
  24. Public Function GetRoot(ByVal lpNumber As Double, ByVal lpRootLevel As Double) As Double
  25.     On Error Resume Next
  26.     GetRoot = lpNumber ^ (1 / lpRootLevel)
  27. End Function
  28. ; 写调试窗口,不做过多解释,其实主程序中无用
  29. Public Sub DebuggerSection(ByVal strInput As String, ByVal enDbgFlags As enuDebugger, Optional ByVal lpLevel As Long = 1)
  30.     On Error Resume Next
  31.     Select Case enDbgFlags
  32.         Case lpNull
  33.             Debug.Print "Null(Level " & Trim(Str(lpLevel)) & ") - at " & Trim(Str(Timer))
  34.         Case lpInput
  35.             Debug.Print "Input Task(Level " & Trim(Str(lpLevel)) & ") - " & strInput & " at " & Trim(Str(Timer))
  36.     End Select
  37. End Sub
  38. ; 该过程主要是实现后缀的取值
  39. ; ScanSuffixLetter("2+3(4+5)22+1",9,x),调用后x=10,返回值为22,即(4+5)后面对应的是22,这个函数主要用来判断是否需要补足乘号。
  40. Public Function ScanSuffixLetter(ByVal strInput As String, ByVal lpStart As Long, ByRef lpEnd As Long) As String
  41.     On Error Resume Next
  42.     Dim lpCurrent As Long
  43.     Dim strIS As String
  44.     Dim lpSelected As Long
  45.     ' 定义了一些符号,当程序搜索到这些符号时,停止
  46.     Const strSignature = "+-*/\^()"
  47.     lpSelected = Len(strInput)
  48.     For lpCurrent = lpStart To Len(strInput)
  49.         strIS = Mid(strInput, lpCurrent, 1)
  50.         If InStr(1, strSignature, strIS) <> 0 Then
  51.             ' 到此为止,已经获得了从字符开始后的第一个符号的位置,我们要取它前面的部分,就是 lpCurrent-1
  52.             lpSelected = lpCurrent - 1
  53.             Exit For
  54.         End If
  55.         DoEvents
  56.     Next lpCurrent
  57.     lpEnd = lpSelected
  58.     ' 使用left函数处理一下
  59.     ScanSuffixLetter = Left(strInput, lpSelected)
  60. End Function
  61. ' 搜索前缀前面是否有数字,如4pi等。
  62. Public Function ScanPrefixNumber(ByVal strInput As String, ByRef strVariant As String) As String
  63.     On Error Resume Next
  64.     Dim lpCurrent As Long
  65.     Dim lpPosition As Long
  66.     Dim strPrefix As String
  67.     Dim strMiddle As String
  68.     For lpCurrent = Len(strInput) To 1 Step -1
  69.         strPrefix = Left(strInput, lpCurrent)
  70.         ' 如果 lpCurrent 及其之前的字符全部是数字的话,那么这些数字就是前缀了...
  71.         If IsNumeric(strPrefix) = True Then
  72.             ' 锁定前缀,退出循环
  73.             strVariant = Right(strInput, Len(strInput) - lpCurrent)
  74.             strMiddle = strPrefix
  75.             Exit For
  76.         End If
  77.         DoEvents
  78.     Next lpCurrent
  79.     If Trim(strVariant) = vbNullString Then
  80.         strVariant = strInput
  81.     End If
  82.     ' 如果没有前缀,视为前缀为1,因为1乘以某数还等于某数
  83.     If Trim(strMiddle) = vbNullString Then
  84.         ScanPrefixNumber = "1"
  85.     Else
  86.         ScanPrefixNumber = strMiddle
  87.     End If
  88. End Function
  89. ' 常量库,这个不做解释,自己看吧(不要忘了看那几个关于前缀处理的函数)。
  90. Public Function GetCustomizeDeclare(ByVal strName As String, ByRef bpExist As Boolean) As Double
  91.     On Error Resume Next
  92.     Dim bpFound As Boolean
  93.     Dim lpVariable As Double
  94.     Dim strPrefix As String
  95.     Dim strDeclareName As String
  96.     strPrefix = ScanPrefixNumber(strName, strDeclareName)
  97.     Select Case Trim(UCase(strDeclareName))
  98.         Case Trim(UCase("pi"))
  99.             lpVariable = 3.1415926
  100.             bpFound = True
  101.         Case Trim(UCase("e"))
  102.             lpVariable = 2.718281828459
  103.             bpFound = True
  104.         Case Trim(UCase("K"))
  105.             lpVariable = 0
  106.             bpFound = False
  107.         Case Else
  108.             lpVariable = 0
  109.             bpFound = False
  110.     End Select
  111.     GetCustomizeDeclare = lpVariable * Val(strPrefix)
  112.     bpExist = bpFound
  113. End Function
  114. ; 这个过程目的是要搜索括号前函数,在 CalculateString 主要是取得完整函数声明。
  115. ; 如 4sin(45),程序中只取得sin 3字处理足以,但是完整取得的应该是4sin
  116. Public Function ScanPrefix(ByVal strInput As String, ByVal lpEnd As Long, ByRef lpStart As Long) As String
  117.     On Error Resume Next
  118.     Dim lpCurrent As Long
  119.     Dim strIS As String
  120.     Dim strMiddle As String
  121.     Dim lpStartIdle As Long
  122.     Dim lpLength As Long
  123.     Dim lpPosition As Long
  124.     ' 定义了一些符号
  125.     Const strSignature = "+-*/\^()"
  126.     ' 这里要考虑如果下面的 For 循环没有检测到前缀的前面的符号的情况
  127.     lpPosition = 0
  128.     ' 用-1为步长,从后往前检索
  129.     For lpCurrent = lpEnd To 1 Step -1
  130.         strIS = Mid(strInput, lpCurrent, 1)
  131.         If InStr(1, strSignature, strIS) <> 0 Then
  132.             ' 嘿,到这里我们已经找到了前面的第一个符号,好了,退出循环吧。
  133.             lpPosition = lpCurrent
  134.             Exit For
  135.         End If
  136.         DoEvents
  137.     Next lpCurrent
  138.     ' 取值起点是符号的后一位
  139.     lpStartIdle = lpPosition + 1
  140.     lpStart = lpStartIdle
  141.     ' 得到取值长度
  142.     lpLength = lpEnd - lpPosition
  143.     ' 使用mid函数取值
  144.     strMiddle = Mid(strInput, lpStartIdle, lpLength)
  145.     ScanPrefix = strMiddle
  146. End Function
  147. ' 搜索需要的分隔符,这里要考虑到我在楼上所说的一些分割时的特殊情况,分隔符查找只允许在同一括号级内,否则会分割错误。
  148. Public Function ScanSeparateChar(ByVal strInput As String, Optional strChar As String = ",", Optional lpStart As Long = 1) As Long
  149.     On Error Resume Next
  150.     Dim lpCurrent As Long
  151.     Dim lpP1 As Long
  152.     Dim lpP2 As Long
  153.     Dim strIS As String
  154.     Dim lPos As Long
  155.     Dim strPrefix As String
  156.     Dim strPf As String
  157.     Dim lpBegin As Long
  158.     ' 先把P1、P2归零
  159.     lpP1 = 0
  160.     lpP2 = 0
  161.     lPos = 0
  162.     For lpCurrent = lpStart To Len(strInput)
  163.         strIS = Mid(strInput, lpCurrent, 1)
  164.         ' 嘿嘿,我们只在同一括号级别内搜索分隔符哦!
  165.         If Trim(UCase(strIS)) = Trim(UCase("(")) Then
  166.             lpP1 = lpP1 + 1
  167.         End If
  168.         If Trim(UCase(strIS)) = Trim(UCase(")")) Then
  169.             lpP2 = lpP2 + 1
  170.         End If
  171.         If lpP1 = lpP2 Then
  172.             ' 找到扩回啦,接着搜索,这里要考虑E+和E-(科学计数法)的问题,不要把他们给分解了。
  173.             If strIS = strChar Then
  174.                 If lpCurrent >= 2 Then
  175.                     strPf = Mid(strInput, lpCurrent - 1, 1)
  176.                     If Trim(UCase(strPf)) = Trim(UCase("E")) Then
  177.                         ' 如果搜索到E了怎么办,看看它有没有前缀数就可以了,如果是科学计数法就有前缀数。
  178.                         strPrefix = ScanPrefix(strInput, lpCurrent - 1, lpBegin)
  179.                         strPrefix = Left(strPrefix, Len(strPrefix) - 1)
  180.                         If IsNumeric(strPrefix) = True And Trim(strPrefix) <> vbNullString Then
  181.                             ' 如这里所说的一样,有前缀,这个不能分割的。
  182.                             GoTo NotThis
  183.                         End If
  184.                     End If
  185.                 End If
  186.                 ' 确定了,退出循环
  187.                 lPos = lpCurrent
  188.                 Exit For
  189. NotThis:
  190.             End If
  191.         End If
  192.         DoEvents
  193.     Next lpCurrent
  194.     ScanSeparateChar = lPos
  195. End Function
  196. ' 这个实现了加号和减号的互换,同样要考虑到如上面的过程一样的特殊情况,具体不再解释。
  197. Public Function OppositePlus(ByVal strInput As String) As String
  198.     On Error Resume Next
  199.     Dim lpCurrent As Long
  200.     Dim lpP1 As Long
  201.     Dim lpP2 As Long
  202.     Dim strIS As String
  203.     Dim strTotal As String
  204.     Dim strPrefix As String
  205.     Dim strPf As String
  206.     Dim lpBegin As Long
  207.     strTotal = vbNullString
  208.     lpP1 = 0
  209.     lpP2 = 0
  210.     For lpCurrent = 1 To Len(strInput)
  211.         strIS = Mid(strInput, lpCurrent, 1)
  212.         If Trim(UCase(strIS)) = Trim(UCase("(")) Then
  213.             lpP1 = lpP1 + 1
  214.         End If
  215.         If Trim(UCase(strIS)) = Trim(UCase(")")) Then
  216.             lpP2 = lpP2 + 1
  217.         End If
  218.         If lpP1 = lpP2 Then
  219.             If Trim(UCase(strIS)) = Trim(UCase("+")) Then
  220.                 If lpCurrent >= 2 Then
  221.                     strPf = Mid(strInput, lpCurrent - 1, 1)
  222.                     If Trim(UCase(strPf)) = Trim(UCase("E")) Then
  223.                         strPrefix = ScanPrefix(strInput, lpCurrent - 1, lpBegin)
  224.                         strPrefix = Left(strPrefix, Len(strPrefix) - 1)
  225.                         If IsNumeric(strPrefix) = True And Trim(strPrefix) <> vbNullString Then
  226.                             GoTo JumpSK
  227.                         End If
  228.                     End If
  229.                 End If
  230.                 strIS = "-"
  231.                 GoTo JumpSK
  232.             End If
  233.             If Trim(UCase(strIS)) = Trim(UCase("-")) Then
  234.                 If lpCurrent >= 2 Then
  235.                     If Trim(UCase(Mid(strInput, lpCurrent - 1, 1))) = Trim(UCase("*")) Or Trim(UCase(Mid(strInput, lpCurrent - 1, 1))) = Trim(UCase("/")) Or Trim(UCase(Mid(strInput, lpCurrent - 1, 1))) = Trim(UCase("^")) Then
  236.                         GoTo JumpSK
  237.                     End If
  238.                     strPf = Mid(strInput, lpCurrent - 1, 1)
  239.                     If Trim(UCase(strPf)) = Trim(UCase("E")) Then
  240.                         strPrefix = ScanPrefix(strInput, lpCurrent - 1, lpBegin)
  241.                         strPrefix = Left(strPrefix, Len(strPrefix) - 1)
  242.                         If IsNumeric(strPrefix) = True And Trim(strPrefix) <> vbNullString Then
  243.                             GoTo JumpSK
  244.                         End If
  245.                     End If
  246.                 End If
  247.                 strIS = "+"
  248.                 GoTo JumpSK
  249.             End If
  250. JumpSK:
  251.         End If
  252.         strTotal = strTotal & strIS
  253.         DoEvents
  254.     Next lpCurrent
  255.     OppositePlus = strTotal
  256. End Function
  257. ' 这个实现了乘号和除号的互换,同样要考虑到如上面的过程一样的特殊情况,具体不再解释。
  258. Public Function OppositeMultiplication(ByVal strInput As String) As String
  259.     On Error Resume Next
  260.     Dim lpCurrent As Long
  261.     Dim lpP1 As Long
  262.     Dim lpP2 As Long
  263.     Dim strIS As String
  264.     Dim strTotal As String
  265.     strTotal = vbNullString
  266.     lpP1 = 0
  267.     lpP2 = 0
  268.     For lpCurrent = 1 To Len(strInput)
  269.         strIS = Mid(strInput, lpCurrent, 1)
  270.         If Trim(UCase(strIS)) = Trim(UCase("(")) Then
  271.             lpP1 = lpP1 + 1
  272.         End If
  273.         If Trim(UCase(strIS)) = Trim(UCase(")")) Then
  274.             lpP2 = lpP2 + 1
  275.         End If
  276.         If lpP1 = lpP2 Then
  277.             If Trim(UCase(strIS)) = Trim(UCase("*")) Then
  278.                 strIS = "/"
  279.                 GoTo JumpSK
  280.             End If
  281.             If Trim(UCase(strIS)) = Trim(UCase("/")) Then
  282.                 strIS = "*"
  283.                 GoTo JumpSK
  284.             End If
  285. JumpSK:
  286.         End If
  287.         strTotal = strTotal & strIS
  288.         DoEvents
  289.     Next lpCurrent
  290.     OppositeMultiplication = strTotal
  291. End Function
  292. ' 转换为弧度制
  293. Public Function ConvertToRadian(ByVal lpNumber As Double) As Double
  294.     On Error Resume Next
  295.     Dim lpValue As Double
  296.     Const lpPI As Double = 3.1415926
  297.     lpValue = lpNumber * (lpPI / 180)
  298.     ConvertToRadian = lpValue
  299. End Function
  300. ' 转换为角度制,如果高中上完了还不会,拿把刀自杀去...
  301. Public Function ConvertToDegree(ByVal lpNumber As Double) As Double
  302.     On Error Resume Next
  303.     Dim lpValue As Double
  304.     Const lpPI As Double = 3.1415926
  305.     lpValue = lpNumber * (180 / lpPI)
  306.     ConvertToDegree = lpValue
  307. End Function
  308. ' 获得正数阶乘,这个不解释。
  309. Public Function GetFactorial(ByVal lpNumber As Long) As String
  310.     On Error Resume Next
  311.     Dim lpCurrent As Long
  312.     Dim strFinal As String
  313.     strFinal = "1"
  314.     For lpCurrent = lpNumber To 2 Step -1
  315.         strFinal = BigProduct(strFinal, ConvertEPtoNormal(Trim(Str(lpCurrent))))
  316.         DoEvents
  317.     Next lpCurrent
  318.     GetFactorial = Val(strFinal)
  319. End Function
  320. ' 获得负数阶乘,这个不解释(这两个过程区别只在于步长和起点终点)。
  321. Public Function GetFactorialNegative(ByVal lpNumber As Long) As String
  322.     On Error Resume Next
  323.     Dim lpCurrent As Long
  324.     Dim strFinal As String
  325.     strFinal = "1"
  326.     For lpCurrent = lpNumber To -1
  327.         strFinal = BigProduct(strFinal, ConvertEPtoNormal(Trim(Str(lpCurrent))))
  328.         DoEvents
  329.     Next lpCurrent
  330.     GetFactorialNegative = Val(strFinal)
  331. End Function
  332. ' 把没用的空格删掉。
  333. Public Function RemoveSpace(ByVal strInput As String) As String
  334.     On Error Resume Next
  335.     Dim strTotal As String
  336.     Dim lpCurrent As Long
  337.     strTotal = vbNullString
  338.     For lpCurrent = 1 To Len(strInput)
  339.         If Mid(strInput, lpCurrent, 1) <> Space(1) Then
  340.             strTotal = strTotal & Mid(strInput, lpCurrent, 1)
  341.         End If
  342.         DoEvents
  343.     Next lpCurrent
  344.     RemoveSpace = strTotal
  345. End Function
  346. ' 统计字符用的函数,用来检测表达式是否合法。
  347. Public Function StatisticsIn(ByVal strInput As String, ByVal strStatistics As String) As Long
  348.     On Error Resume Next
  349.     Dim lpCurrent As Long
  350.     Dim strCurrent As String
  351.     Dim lpStatistics As Long
  352.     For lpCurrent = 1 To (Len(strInput) - Len(strStatistics) + 1)
  353.         If Mid(strInput, lpCurrent, Len(strStatistics)) = strStatistics Then
  354.             lpStatistics = lpStatistics + 1
  355.         End If
  356.     Next lpCurrent
  357.     StatisticsIn = lpStatistics
  358. End Function
  359. ' 这个是用来替换用的
  360. ' 比如说 ResolveStringCC("A%1%2","%1", "B","%2","C") 返回 "ABC"
  361. ' 来自微软的VB安装程序源代码,很简单哦。
  362. Public Function ResolveStringCC(ByVal sString As String, ParamArray varReplacements() As Variant) As String
  363.     On Error Resume Next
  364.     Dim intMacro As Integer
  365.     Dim strResString As String
  366.     Dim strMacro As String
  367.     Dim strValue As String
  368.     Dim intPos As Integer
  369.     strResString = sString
  370.     For intMacro = LBound(varReplacements) To UBound(varReplacements) Step 2
  371.         strMacro = varReplacements(intMacro)
  372.         On Error GoTo MismatchedPairs
  373.         strValue = varReplacements(intMacro + 1)
  374.         On Error GoTo 0
  375.         Do
  376.             intPos = InStr(strResString, strMacro)
  377.             If intPos > 0 Then
  378.                 strResString = Left$(strResString, intPos - 1) & strValue & Right$(strResString, Len(strResString) - Len(strMacro) - intPos + 1)
  379.             End If
  380.         Loop Until intPos = 0
  381.     Next intMacro
  382.     ResolveStringCC = strResString
  383.     Exit Function
  384. MismatchedPairs:
  385.     Resume Next
  386. End Function
  387. ' 好了,切入正题。
  388. Public Function CalculateString(ByVal strFormula As String, ByRef lpReturn As enuReturns, Optional ByVal lpLevel As Long = 1) As String
  389.     On Error Resume Next
  390.     Dim bpExistCustom As Boolean
  391.     Dim lpCustom As Double
  392.     Dim strInput As String
  393.     Dim lInc1 As Long
  394.     Dim lInc2 As Long
  395.     Dim strLeft As String
  396.     Dim strRight As String
  397.     Dim ensPWRSub As enuReturns
  398.     Dim lpX As Double
  399.     Dim strPWRReturn As String
  400.     Dim lpPWRInclude As Long
  401.     Dim strPWR1 As String
  402.     Dim strPWR2 As String
  403.     Dim lpCurrent As Long
  404.     Dim lpResults As Double
  405.     Dim lpN As Long
  406.     Dim lpPosition As Long
  407.     Dim lpFinalPos As Long
  408.     Dim strIncludeLeft As String
  409.     Dim strIncludeRight As String
  410.     Dim strReplace As String
  411.     Dim strCallback As String
  412.     Dim bSpecialEnabled As Boolean
  413.     Dim strSpecial As String
  414.     Dim strSpecial2 As String
  415.     Dim strSpecial3 As String
  416.     Dim strSpecial4 As String
  417.     Dim enReturnSub As enuReturns
  418.     Dim lpFunctionSPLength As Long
  419.     Dim strNumberPrefix As String
  420.     Dim lpBegin As Long
  421.     Dim strPrefixNumber As String
  422.     Dim strSuffixIR As String
  423.     Dim lpSuffixMax As Long
  424.     ' 先把字符串同一
  425.     strInput = Trim(strFormula)
  426.     strInput = UCase(strInput)
  427.     strInput = RemoveSpace(strInput)
  428.     ' 把不常用的符号替换成常用符号
  429.     strInput = ResolveStringCC(strInput, "", "/")
  430.     strInput = ResolveStringCC(strInput, "..", ".")
  431.     strInput = ResolveStringCC(strInput, "++", "+")
  432.     strInput = ResolveStringCC(strInput, "+-", "-")
  433.     strInput = ResolveStringCC(strInput, "--", "-")
  434.     strInput = ResolveStringCC(strInput, "-+", "-")
  435.     strInput = ResolveStringCC(strInput, "**", "*")
  436.     strInput = ResolveStringCC(strInput, "*+", "*")
  437.     strInput = ResolveStringCC(strInput, "//", "/")
  438.     strInput = ResolveStringCC(strInput, "/+", "/")
  439.     strInput = ResolveStringCC(strInput, "^^", "^")
  440.     strInput = ResolveStringCC(strInput, "^+", "^")
  441.     ' 调用调试器
  442.     DebuggerSection strInput, lpInput, lpLevel
  443.     ' 看看算式中的括号和扩回的个数是否一致,不一致,语法错误了。
  444.     If StatisticsIn(strInput, "(") <> StatisticsIn(strInput, ")") Then
  445.         lpReturn = lpSyntaxError
  446.         Exit Function
  447.     End If
  448.     ' 循环去括号
  449.     Do
  450.         bSpecialEnabled = False
  451.         ' 看看有没有括号
  452.         lpPosition = InStr(1, strInput, "(")
  453.         ' 根本没有,退出循环
  454.         If lpPosition = 0 Then
  455.             Exit Do
  456.         End If
  457.         ' 确定括号位置,如楼上所说算法。
  458.         lInc1 = 0
  459.         lInc2 = 0
  460.         For lpN = lpPosition To Len(strInput)
  461.             Select Case Mid(strInput, lpN, 1)
  462.                 Case "("
  463.                     lInc1 = lInc1 + 1
  464.                 Case ")"
  465.                     lInc2 = lInc2 + 1
  466.             End Select
  467.             If lInc1 = lInc2 And lInc1 <> 0 Then
  468.                 ' 确定好了,退出 For 循环
  469.                 Exit For
  470.             End If
  471.             lpFinalPos = lpN
  472.             DoEvents
  473.         Next lpN
  474.         ' 我们把函数符号限制在6以内,每当位置>=3时才去括号前缀,省点资源
  475.         If lpPosition >= 3 Then
  476.             strSpecial4 = Mid(strInput, lpPosition - 2, 2)
  477.         End If
  478.         If lpPosition >= 4 Then
  479.             strSpecial = Mid(strInput, lpPosition - 3, 3)
  480.         End If
  481.         If lpPosition >= 5 Then
  482.             strSpecial2 = Mid(strInput, lpPosition - 4, 4)
  483.         End If
  484.         If lpPosition >= 6 Then
  485.             strSpecial3 = Mid(strInput, lpPosition - 5, 5)
  486.         End If
  487.         ' 去括号左边
  488.         strIncludeLeft = Left(strInput, lpPosition - 1)
  489.         ' 看看有没有程序认识的运算符,从短到长的顺序是为了让程序不漏掉某些函数。
  490.         If Trim(UCase(strSpecial4)) = Trim(UCase("ln")) Or Trim(UCase(strSpecial4)) = Trim(UCase("sr")) Then
  491.             ' 确定运算符,长度为2
  492.             lpFunctionSPLength = 2
  493.             bSpecialEnabled = True
  494.         End If
  495.         If Trim(UCase(strSpecial)) = Trim(UCase("sqr")) Or Trim(UCase(strSpecial)) = Trim(UCase("abs")) Or _
  496.             Trim(UCase(strSpecial)) = Trim(UCase("cos")) Or Trim(UCase(strSpecial)) = Trim(UCase("exp")) Or _
  497.             Trim(UCase(strSpecial)) = Trim(UCase("log")) Or Trim(UCase(strSpecial)) = Trim(UCase("rnd")) Or _
  498.             Trim(UCase(strSpecial)) = Trim(UCase("sgn")) Or Trim(UCase(strSpecial)) = Trim(UCase("sin")) Or _
  499.             Trim(UCase(strSpecial)) = Trim(UCase("tan")) Or Trim(UCase(strSpecial)) = Trim(UCase("opp")) Or _
  500.             Trim(UCase(strSpecial)) = Trim(UCase("sec")) Or Trim(UCase(strSpecial)) = Trim(UCase("csc")) Or _
  501.             Trim(UCase(strSpecial)) = Trim(UCase("cot")) Then
  502.             ' 确定运算符,长度为3
  503.             lpFunctionSPLength = 3
  504.             bSpecialEnabled = True
  505.         End If
  506.         If Trim(UCase(strSpecial2)) = Trim(UCase("hsin")) Or Trim(UCase(strSpecial2)) = Trim(UCase("hcos")) Or _
  507.            Trim(UCase(strSpecial2)) = Trim(UCase("hcsc")) Or Trim(UCase(strSpecial2)) = Trim(UCase("hcot")) Or _
  508.            Trim(UCase(strSpecial2)) = Trim(UCase("hsec")) Or Trim(UCase(strSpecial2)) = Trim(UCase("htan")) Or _
  509.            Trim(UCase(strSpecial2)) = Trim(UCase("icsc")) Or Trim(UCase(strSpecial2)) = Trim(UCase("icos")) Or _
  510.            Trim(UCase(strSpecial2)) = Trim(UCase("icot")) Or Trim(UCase(strSpecial2)) = Trim(UCase("isec")) Or _
  511.            Trim(UCase(strSpecial2)) = Trim(UCase("isin")) Or Trim(UCase(strSpecial2)) = Trim(UCase("itan")) Then
  512.             lpFunctionSPLength = 4
  513.             ' 确定运算符,长度为4
  514.             bSpecialEnabled = True
  515.         End If
  516.         If Trim(UCase(strSpecial3)) = Trim(UCase("ihcos")) Or Trim(UCase(strSpecial3)) = Trim(UCase("ihcsc")) Or _
  517.            Trim(UCase(strSpecial3)) = Trim(UCase("ihcot")) Or Trim(UCase(strSpecial3)) = Trim(UCase("ihsin")) Or _
  518.            Trim(UCase(strSpecial3)) = Trim(UCase("ihsec")) Or Trim(UCase(strSpecial3)) = Trim(UCase("ihtan")) Then
  519.             lpFunctionSPLength = 5
  520.             ' 确定运算符,长度为5
  521.             bSpecialEnabled = True
  522.         End If
  523.         If bSpecialEnabled = True Then
  524.             ' 如果函数存在,则重新区函数前面的所有字符
  525.             strIncludeLeft = Left(strInput, lpPosition - (lpFunctionSPLength + 1))
  526.         End If
  527.         ' 看看有没有括号前缀,如果有,则确定前缀,并对strIncludeLeft重新取值
  528.         If lpPosition >= 2 Then
  529.             strNumberPrefix = ScanPrefix(strIncludeLeft, Len(strIncludeLeft), lpBegin)
  530.             If Trim(strNumberPrefix) <> vbNullString Then
  531.                 strIncludeLeft = strIncludeLeft & "*"
  532.             End If
  533.         End If
  534.         ' 确定括号右边的算式
  535.         strIncludeRight = Right(strInput, Len(strInput) - lpN)
  536.         ' 为了补充乘号
  537.         strSuffixIR = ScanSuffixLetter(strIncludeRight, 1, lpSuffixMax)
  538.         If Trim(strSuffixIR) <> vbNullString Or Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("(")) Then
  539.             strIncludeRight = "*" & strIncludeRight
  540.         End If
  541.         ' 确定要计算的内容
  542.         strReplace = Mid(strInput, lpPosition + 1, lpN - lpPosition - 1)
  543.         ' 对于 sr 这类的双参数函数要特殊对待,^.^
  544.         If Trim(UCase(strSpecial4)) = Trim(UCase("sr")) Then
  545.             lpPWRInclude = ScanSeparateChar(strReplace)
  546.             If lpPWRInclude = 0 Then
  547.                 lpReturn = lpSyntaxError
  548.                 Exit Function
  549.             End If
  550.             strPWR1 = Left(strReplace, lpPWRInclude - 1)
  551.             strPWR2 = Right(strReplace, Len(strReplace) - lpPWRInclude)
  552.             If IsNumeric(strPWR1) = False Then
  553.                 strPWRReturn = CalculateString(strPWR1, ensPWRSub, lpLevel + 1)
  554.                 If ensPWRSub <> lpSucceed Then
  555.                     lpReturn = ensPWRSub
  556.                     Exit Function
  557.                 End If
  558.                 strPWR1 = strPWRReturn
  559.             End If
  560.             If IsNumeric(strPWR2) = False Then
  561.                 strPWRReturn = CalculateString(strPWR2, ensPWRSub, lpLevel + 1)
  562.                 If ensPWRSub <> lpSucceed Then
  563.                     lpReturn = ensPWRSub
  564.                     Exit Function
  565.                 End If
  566.                 strPWR2 = strPWRReturn
  567.             End If
  568.             strCallback = Trim(Str(GetRoot(Val(strPWR1), Val(strPWR2))))
  569.             GoTo EndExtract
  570.         End If
  571.         ' 计算括号中的内容
  572.         strCallback = CalculateString(strReplace, enReturnSub, lpLevel + 1)
  573.         If enReturnSub <> lpSucceed Then
  574.             lpReturn = enReturnSub
  575.             Exit Function
  576.         End If
  577.         ' 如果有函数的话,就按照函数定义去对计算完的内容处理。
  578.         Select Case Trim(UCase(strSpecial3))
  579.             Case Trim(UCase("ihcos"))
  580.                 lpX = Val(strCallback)
  581.                 lpX = Log(lpX + Sqr(lpX * lpX - 1))
  582.                 If bpRadianWay = False Then
  583.                     lpX = ConvertToDegree(lpX)
  584.                 End If
  585.                 strCallback = Trim(Str(lpX))
  586.                 GoTo EndExtract
  587.             Case Trim(UCase("ihcsc"))
  588.                 lpX = Val(strCallback)
  589.                 lpX = Log((Sgn(lpX) * Sqr(lpX * lpX + 1) + 1) / lpX)
  590.                 If bpRadianWay = False Then
  591.                     lpX = ConvertToDegree(lpX)
  592.                 End If
  593.                 strCallback = Trim(Str(lpX))
  594.                 GoTo EndExtract
  595.             Case Trim(UCase("ihcot"))
  596.                 lpX = Val(strCallback)
  597.                 lpX = Log((lpX + 1) / (lpX - 1)) / 2
  598.                 If bpRadianWay = False Then
  599.                     lpX = ConvertToDegree(lpX)
  600.                 End If
  601.                 strCallback = Trim(Str(lpX))
  602.                 GoTo EndExtract
  603.             Case Trim(UCase("ihsin"))
  604.                 lpX = Val(strCallback)
  605.                 lpX = Log(lpX + Sqr(lpX * lpX + 1))
  606.                 If bpRadianWay = False Then
  607.                     lpX = ConvertToDegree(lpX)
  608.                 End If
  609.                 strCallback = Trim(Str(lpX))
  610.                 GoTo EndExtract
  611.             Case Trim(UCase("ihsec"))
  612.                 lpX = Val(strCallback)
  613.                 lpX = Log((Sqr(-lpX * lpX + 1) + 1) / lpX)
  614.                 If bpRadianWay = False Then
  615.                     lpX = ConvertToDegree(lpX)
  616.                 End If
  617.                 strCallback = Trim(Str(lpX))
  618.                 GoTo EndExtract
  619.             Case Trim(UCase("ihtan"))
  620.                 lpX = Val(strCallback)
  621.                 lpX = Log((1 + lpX) / (1 - lpX)) / 2
  622.                 If bpRadianWay = False Then
  623.                     lpX = ConvertToDegree(lpX)
  624.                 End If
  625.                 strCallback = Trim(Str(lpX))
  626.                 GoTo EndExtract
  627.         End Select
  628.         Select Case Trim(UCase(strSpecial2))
  629.             Case Trim(UCase("hsin"))
  630.                 If bpRadianWay = True Then
  631.                     lpX = Val(strCallback)
  632.                 Else
  633.                     lpX = ConvertToRadian(Val(strCallback))
  634.                 End If
  635.                 lpX = (Exp(lpX) - Exp(-lpX)) / 2
  636.                 strCallback = Trim(Str(lpX))
  637.                 GoTo EndExtract
  638.             Case Trim(UCase("hcos"))
  639.                 If bpRadianWay = True Then
  640.                     lpX = Val(strCallback)
  641.                 Else
  642.                     lpX = ConvertToRadian(Val(strCallback))
  643.                 End If
  644.                 lpX = (Exp(lpX) + Exp(-lpX)) / 2
  645.                 strCallback = Trim(Str(lpX))
  646.                 GoTo EndExtract
  647.             Case Trim(UCase("hcsc"))
  648.                 If bpRadianWay = True Then
  649.                     lpX = Val(strCallback)
  650.                 Else
  651.                     lpX = ConvertToRadian(Val(strCallback))
  652.                 End If
  653.                 lpX = 2 / (Exp(lpX) - Exp(-lpX))
  654.                 strCallback = Trim(Str(lpX))
  655.                 GoTo EndExtract
  656.             Case Trim(UCase("hcot"))
  657.                 If bpRadianWay = True Then
  658.                     lpX = Val(strCallback)
  659.                 Else
  660.                     lpX = ConvertToRadian(Val(strCallback))
  661.                 End If
  662.                 lpX = (Exp(lpX) + Exp(-lpX)) / (Exp(lpX) - Exp(-lpX))
  663.                 strCallback = Trim(Str(lpX))
  664.                 GoTo EndExtract
  665.             Case Trim(UCase("hsec"))
  666.                 If bpRadianWay = True Then
  667.                     lpX = Val(strCallback)
  668.                 Else
  669.                     lpX = ConvertToRadian(Val(strCallback))
  670.                 End If
  671.                 lpX = 2 / (Exp(lpX) + Exp(-lpX))
  672.                 strCallback = Trim(Str(lpX))
  673.                 GoTo EndExtract
  674.             Case Trim(UCase("htan"))
  675.                 If bpRadianWay = True Then
  676.                     lpX = Val(strCallback)
  677.                 Else
  678.                     lpX = ConvertToRadian(Val(strCallback))
  679.                 End If
  680.                 lpX = (Exp(lpX) - Exp(-lpX)) / (Exp(lpX) + Exp(-lpX))
  681.                 strCallback = Trim(Str(lpX))
  682.                 GoTo EndExtract
  683.             Case Trim(UCase("icsc"))
  684.                 lpX = Val(strCallback)
  685.                 lpX = Atn(lpX / Sqr(lpX * lpX - 1)) + (Sgn(lpX) - 1) * (2 * Atn(1))
  686.                 If bpRadianWay = False Then
  687.                     lpX = ConvertToDegree(lpX)
  688.                 End If
  689.                 strCallback = Trim(Str(lpX))
  690.                 GoTo EndExtract
  691.             Case Trim(UCase("icos"))
  692.                 lpX = Val(strCallback)
  693.                 lpX = Atn(-lpX / Sqr(-lpX * lpX + 1)) + 2 * Atn(1)
  694.                 If bpRadianWay = False Then
  695.                     lpX = ConvertToDegree(lpX)
  696.                 End If
  697.                 strCallback = Trim(Str(lpX))
  698.                 GoTo EndExtract
  699.             Case Trim(UCase("icot"))
  700.                 lpX = Val(strCallback)
  701.                 lpX = Atn(lpX) + 2 * Atn(1)
  702.                 If bpRadianWay = False Then
  703.                     lpX = ConvertToDegree(lpX)
  704.                 End If
  705.                 strCallback = Trim(Str(lpX))
  706.                 GoTo EndExtract
  707.             Case Trim(UCase("isec"))
  708.                 lpX = Val(strCallback)
  709.                 lpX = Atn(lpX / Sqr(lpX * lpX - 1)) + Sgn((lpX) - 1) * (2 * Atn(1))
  710.                 If bpRadianWay = False Then
  711.                     lpX = ConvertToDegree(lpX)
  712.                 End If
  713.                 strCallback = Trim(Str(lpX))
  714.                 GoTo EndExtract
  715.             Case Trim(UCase("isin"))
  716.                 lpX = Val(strCallback)
  717.                 lpX = Atn(lpX / Sqr(-lpX * lpX + 1))
  718.                 If bpRadianWay = False Then
  719.                     lpX = ConvertToDegree(lpX)
  720.                 End If
  721.                 strCallback = Trim(Str(lpX))
  722.                 GoTo EndExtract
  723.             Case Trim(UCase("itan"))
  724.                 lpX = Val(strCallback)
  725.                 lpX = Atn(lpX)
  726.                 If bpRadianWay = False Then
  727.                     lpX = ConvertToDegree(lpX)
  728.                 End If
  729.                 strCallback = Trim(Str(lpX))
  730.                 GoTo EndExtract
  731.         End Select
  732.         Select Case Trim(UCase(strSpecial))
  733.             Case Trim(UCase("sqr"))
  734.                 If Val(strCallback) < 0 Then
  735.                     lpReturn = lpRunError
  736.                     Exit Function
  737.                 End If
  738.                 strCallback = Trim(Str(Sqr(Val(strCallback))))
  739.                 GoTo EndExtract
  740.             Case Trim(UCase("abs"))
  741.                 strCallback = Trim(Str(Abs(Val(strCallback))))
  742.                 GoTo EndExtract
  743.             Case Trim(UCase("cos"))
  744.                 If bpRadianWay = True Then
  745.                     strCallback = Trim(Str(Cos(Val(strCallback))))
  746.                 Else
  747.                     strCallback = Trim(Str(Cos(ConvertToRadian(Val(strCallback)))))
  748.                 End If
  749.                 GoTo EndExtract
  750.             Case Trim(UCase("exp"))
  751.                 strCallback = Trim(Str(Exp(Val(strCallback))))
  752.                 GoTo EndExtract
  753.             Case Trim(UCase("log"))
  754.                 strCallback = Trim(Str(Log(Val(strCallback)) / Log(lpLogBase)))
  755.                 GoTo EndExtract
  756.             Case Trim(UCase("rnd"))
  757.                 strCallback = Trim(Str(Rnd(Val(strCallback))))
  758.                 GoTo EndExtract
  759.             Case Trim(UCase("sgn"))
  760.                 strCallback = Trim(Str(Sgn(Val(strCallback))))
  761.                 GoTo EndExtract
  762.             Case Trim(UCase("sin"))
  763.                 If bpRadianWay = True Then
  764.                     strCallback = Trim(Str(Sin(Val(strCallback))))
  765.                 Else
  766.                     strCallback = Trim(Str(Sin(ConvertToRadian(Val(strCallback)))))
  767.                 End If
  768.                 GoTo EndExtract
  769.             Case Trim(UCase("opp"))
  770.                 strCallback = Trim(Str(-Val(strCallback)))
  771.                 GoTo EndExtract
  772.             Case Trim(UCase("tan"))
  773.                 If bpRadianWay = True Then
  774.                     strCallback = Trim(Str(Tan(Val(strCallback))))
  775.                 Else
  776.                     strCallback = Trim(Str(Tan(ConvertToRadian(Val(strCallback)))))
  777.                 End If
  778.                 GoTo EndExtract
  779.             Case Trim(UCase("sec"))
  780.                 If bpRadianWay = True Then
  781.                     lpX = Val(strCallback)
  782.                 Else
  783.                     lpX = ConvertToRadian(Val(strCallback))
  784.                 End If
  785.                 lpX = 1 / Cos(lpX)
  786.                 strCallback = Trim(Str(lpX))
  787.                 GoTo EndExtract
  788.             Case Trim(UCase("csc"))
  789.                 If bpRadianWay = True Then
  790.                     lpX = Val(strCallback)
  791.                 Else
  792.                     lpX = ConvertToRadian(Val(strCallback))
  793.                 End If
  794.                 lpX = 1 / Sin(lpX)
  795.                 strCallback = Trim(Str(lpX))
  796.                 GoTo EndExtract
  797.             Case Trim(UCase("cot"))
  798.                 If bpRadianWay = True Then
  799.                     lpX = Val(strCallback)
  800.                 Else
  801.                     lpX = ConvertToRadian(Val(strCallback))
  802.                 End If
  803.                 lpX = 1 / Tan(lpX)
  804.                 strCallback = Trim(Str(lpX))
  805.                 GoTo EndExtract
  806.         End Select
  807.         Select Case Trim(UCase(strSpecial4))
  808.             Case Trim(UCase("ln"))
  809.                 strCallback = Trim(Str(Log(Val(strCallback))))
  810.                 GoTo EndExtract
  811.         End Select
  812. EndExtract:
  813.         ' 如果括号左边最后一个字符为-号,而且 Callback 小于零,则改-为+,strCallback取相反数。
  814.         If Right(strIncludeLeft, 1) = "-" And Val(strCallback) < 0 Then
  815.             strCallback = Trim(Str(-Val(strCallback)))
  816.             strIncludeLeft = Left(strIncludeLeft, Len(strIncludeLeft) - 1) & "+"
  817.         End If
  818.         ' 如果右边有符号,那么取倒数+"K"
  819.         If (Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("+")) Or _
  820.             Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("-")) Or _
  821.             Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("*")) Or _
  822.             Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("/")) Or _
  823.             Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("^")) Or _
  824.             Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("!")) Or _
  825.             Trim(UCase(Left(strIncludeRight, 1))) = Trim(UCase("%"))) And _
  826.             Val(strCallback) < 0 Then
  827.             strCallback = Trim(Str(-Val(strCallback))) & "K"
  828.         End If
  829.         strInput = strIncludeLeft & strCallback & strIncludeRight
  830.         DoEvents
  831.     Loop
  832.     ' 如果strInput只有数字了,那么就是它了,直接返回。
  833.     If IsNumeric(strInput) = True Then
  834.         CalculateString = Trim(Str(Val(strInput)))
  835.         lpReturn = lpSucceed
  836.         Exit Function
  837.     End If
  838.     ' 先分割加法,如果存在,取左右算式,递归取值,最后相加,得出结果。
  839.     lpPosition = ScanSeparateChar(strInput, "+")
  840.     If lpPosition >= 1 Then
  841.         strLeft = Left(strInput, lpPosition - 1)
  842.         strRight = Right(strInput, Len(strInput) - lpPosition)
  843.         If IsNumeric(strLeft) = False Then
  844.             strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
  845.             If enReturnSub <> lpSucceed Then
  846.                 lpReturn = enReturnSub
  847.                 Exit Function
  848.             End If
  849.             strLeft = strCallback
  850.         End If
  851.         If IsNumeric(strRight) = False Then
  852.             strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
  853.             If enReturnSub <> lpSucceed Then
  854.                 lpReturn = enReturnSub
  855.                 Exit Function
  856.             End If
  857.             strRight = strCallback
  858.         End If
  859.         lpResults = Val(strLeft) + Val(strRight)
  860.         CalculateString = Trim(Str(lpResults))
  861.         lpReturn = lpSucceed
  862.         Exit Function
  863.     End If
  864.     ' 分割减法,如果存在,取左右算式,将右边+/-调号,递归取值,最后相减,得出结果。
  865.     ' 考虑特殊情况,如果有运算符号存在的话,无视之...
  866.     lpPosition = ScanSeparateChar(strInput, "-")
  867.     If lpPosition >= 1 Then
  868.         strLeft = Left(strInput, lpPosition - 1)
  869.         strRight = Right(strInput, Len(strInput) - lpPosition)
  870.         If Trim(UCase(Right(strLeft, 1))) = Trim(UCase("*")) Or Trim(UCase(Right(strLeft, 1))) = Trim(UCase("/")) Or Trim(UCase(Right(strLeft, 1))) = Trim(UCase("^")) Then
  871.             GoTo NotRemove
  872.         End If
  873.         If Trim(strLeft) = vbNullString Then
  874.             strLeft = "0"
  875.         Else
  876.             If IsNumeric(strLeft) = False Then
  877.                 strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
  878.                 If enReturnSub <> lpSucceed Then
  879.                     lpReturn = enReturnSub
  880.                     Exit Function
  881.                 End If
  882.                 strLeft = strCallback
  883.             End If
  884.         End If
  885.         strRight = OppositePlus(strRight)
  886.         If IsNumeric(strRight) = False Then
  887.             strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
  888.             If enReturnSub <> lpSucceed Then
  889.                 lpReturn = enReturnSub
  890.                 Exit Function
  891.             End If
  892.             strRight = strCallback
  893.         End If
  894.         lpResults = Val(strLeft) - Val(strRight)
  895.         CalculateString = Trim(Str(lpResults))
  896.         lpReturn = lpSucceed
  897.         Exit Function
  898.     End If
  899. NotRemove:
  900.     ' 分割除法,如果存在,取左右算式,将右边*/除调号,递归取值,最后相除,得出结果。
  901.     lpPosition = ScanSeparateChar(strInput, "/")
  902.     If lpPosition >= 1 Then
  903.         strLeft = Left(strInput, lpPosition - 1)
  904.         strRight = Right(strInput, Len(strInput) - lpPosition)
  905.         If IsNumeric(strLeft) = False Then
  906.             strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
  907.             If enReturnSub <> lpSucceed Then
  908.                 lpReturn = enReturnSub
  909.                 Exit Function
  910.             End If
  911.             strLeft = strCallback
  912.         End If
  913.         strRight = OppositeMultiplication(strRight)
  914.         If IsNumeric(strRight) = False Then
  915.             strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
  916.             If enReturnSub <> lpSucceed Then
  917.                 lpReturn = enReturnSub
  918.                 Exit Function
  919.             End If
  920.             strRight = strCallback
  921.         End If
  922.         If Val(strRight) = 0 Then
  923.             lpReturn = lpRunError
  924.             Exit Function
  925.         End If
  926.         lpResults = Val(strLeft) / Val(strRight)
  927.         CalculateString = Trim(Str(lpResults))
  928.         lpReturn = lpSucceed
  929.         Exit Function
  930.     End If
  931.     ' 最后分割乘法,
  932.     lpPosition = ScanSeparateChar(strInput, "*")
  933.     If lpPosition >= 1 Then
  934.         strLeft = Left(strInput, lpPosition - 1)
  935.         strRight = Right(strInput, Len(strInput) - lpPosition)
  936.         If IsNumeric(strLeft) = False Then
  937.             strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
  938.             If enReturnSub <> lpSucceed Then
  939.                 lpReturn = enReturnSub
  940.                 Exit Function
  941.             End If
  942.             strLeft = strCallback
  943.         End If
  944.         If IsNumeric(strRight) = False Then
  945.             strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
  946.             If enReturnSub <> lpSucceed Then
  947.                 lpReturn = enReturnSub
  948.                 Exit Function
  949.             End If
  950.             strRight = strCallback
  951.         End If
  952.         lpResults = Val(strLeft) * Val(strRight)
  953.         CalculateString = Trim(Str(lpResults))
  954.         lpReturn = lpSucceed
  955.         Exit Function
  956.     End If
  957.     ' 乘方符号
  958.     lpPosition = ScanSeparateChar(strInput, "^")
  959.     If lpPosition >= 1 Then
  960.         strLeft = Left(strInput, lpPosition - 1)
  961.         strRight = Right(strInput, Len(strInput) - lpPosition)
  962.         If IsNumeric(strLeft) = False Then
  963.             strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
  964.             If enReturnSub <> lpSucceed Then
  965.                 lpReturn = enReturnSub
  966.                 Exit Function
  967.             End If
  968.             strLeft = strCallback
  969.         End If
  970.         If IsNumeric(strRight) = False Then
  971.             strCallback = CalculateString(strRight, enReturnSub, lpLevel + 1)
  972.             If enReturnSub <> lpSucceed Then
  973.                 lpReturn = enReturnSub
  974.                 Exit Function
  975.             End If
  976.             strRight = strCallback
  977.         End If
  978.         lpResults = Val(strLeft) ^ Val(strRight)
  979.         CalculateString = Trim(Str(lpResults))
  980.         lpReturn = lpSucceed
  981.         Exit Function
  982.     End If
  983.     ' 阶乘符号,同上
  984.     If Trim(UCase(Right(strInput, 1))) = Trim(UCase("!")) Then
  985.         strLeft = Left(strInput, Len(strInput) - 1)
  986.         If IsNumeric(strLeft) = False Then
  987.             strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
  988.             If enReturnSub <> lpSucceed Then
  989.                 lpReturn = enReturnSub
  990.                 Exit Function
  991.             End If
  992.             strLeft = strCallback
  993.         End If
  994.         If Val(strLeft) < 0 Then
  995.             CalculateString = GetFactorialNegative(Val(strLeft))
  996.         Else
  997.             CalculateString = GetFactorial(Val(strLeft))
  998.         End If
  999.         lpReturn = lpSucceed
  1000.         Exit Function
  1001.     End If
  1002.     ' 处理百分号
  1003.     If Trim(UCase(Right(strInput, 1))) = Trim(UCase("%")) Then
  1004.         strLeft = Left(strInput, Len(strInput) - 1)
  1005.         If IsNumeric(strLeft) = False Then
  1006.             strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
  1007.             If enReturnSub <> lpSucceed Then
  1008.                 lpReturn = enReturnSub
  1009.                 Exit Function
  1010.             End If
  1011.             strLeft = strCallback
  1012.         End If
  1013.         CalculateString = Trim(Str(Val(strLeft) / 100))
  1014.         lpReturn = lpSucceed
  1015.         Exit Function
  1016.     End If
  1017.     ' 没辙了?还没办法处理吗?看看有没有自变量
  1018.     lpCustom = GetCustomizeDeclare(strInput, bpExistCustom)
  1019.     If bpExistCustom = True Then
  1020.         ' 有了,就赋值,退出过程
  1021.         CalculateString = Trim(Str(lpCustom))
  1022.         lpReturn = lpSucceed
  1023.         Exit Function
  1024.     End If
  1025.     ' 如果是被括号内容被调号的话,就重新处理为正常形式。
  1026.     If Trim(UCase(Right(strInput, 1))) = Trim(UCase("K")) Then
  1027.         strLeft = Left(strInput, Len(strInput) - 1)
  1028.         If IsNumeric(strLeft) = False Then
  1029.             strCallback = CalculateString(strLeft, enReturnSub, lpLevel + 1)
  1030.             If enReturnSub <> lpSucceed Then
  1031.                 lpReturn = enReturnSub
  1032.                 Exit Function
  1033.             End If
  1034.             strLeft = strCallback
  1035.         End If
  1036.         CalculateString = Trim(Str(-Val(strLeft)))
  1037.         lpReturn = lpSucceed
  1038.         Exit Function
  1039.     End If
  1040.     ' 什么都没有,就是0
  1041.     If Trim(strInput) = vbNullString Then
  1042.         CalculateString = "0"
  1043.         lpReturn = lpSucceed
  1044.         Exit Function
  1045.     End If
  1046.     ' 再处理不过来,很抱歉,语法错误!
  1047.     lpReturn = lpSyntaxError
  1048. End Function
  1049. ' 这个是转化E+/E-为一般形式
  1050. Public Function ConvertEPtoNormal(ByVal strInput As String) As String
  1051.     On Error Resume Next
  1052.     Dim strIS As String
  1053.     Dim lpStart As Long
  1054.     Dim strL As String
  1055.     Dim strR As String
  1056.     Dim bpOpposite As Boolean
  1057.     bpOpposite = False
  1058.     strIS = Trim(UCase(strInput))
  1059.     lpStart = InStr(1, strIS, "E+")
  1060.     If lpStart = 0 Then
  1061.         lpStart = InStr(1, strIS, "E-")
  1062.         bpOpposite = True
  1063.     End If
  1064.     If lpStart = 0 Then
  1065.         ConvertEPtoNormal = strIS
  1066.     Else
  1067.         strL = Left(strIS, lpStart - 1)
  1068.         strR = Right(strIS, Len(strIS) - (lpStart + 1))
  1069.         If IsNumeric(strL) = False Then
  1070.             strL = "1"
  1071.         End If
  1072.         If IsNumeric(strR) = False Then
  1073.             strR = "1"
  1074.         End If
  1075.         If bpOpposite = False Then
  1076.             ConvertEPtoNormal = BigProduct(strL, "1" & String(Val(strR), "0"))
  1077.         Else
  1078.             ConvertEPtoNormal = BigProduct(strL, "0." & String(Val(strR) - 1, "0") & "1")
  1079.         End If
  1080.     End If
  1081. End Function



  1082. ; 下面是大数计算器,别人的东西,用来支持大数阶乘。
  1083. Public Function BigAdd(ByVal A, ByVal B) As String
  1084.     On Error Resume Next
  1085.     Dim SA As Boolean, SB As Boolean, S As String
  1086.     If Left(A, 1) = "-" Then
  1087.         SA = True
  1088.     End If
  1089.     If Left(B, 1) = "-" Then
  1090.         SB = True
  1091.     End If
  1092.     If Not SA And Not SB Then
  1093.         S = xBigAdd(A, B)
  1094.     ElseIf SA And Not SB Then
  1095.         S = xBigSubtract(B, Right(A, Len(A) - 1))
  1096.     ElseIf Not SA And SB Then
  1097.         S = xBigSubtract(A, Right(B, Len(B) - 1))
  1098.     ElseIf SA And SB Then
  1099.         S = xBigAdd(Right(A, Len(A) - 1), Right(B, Len(B) - 1))
  1100.         If Left(S, 1) = "-" Then
  1101.             S = Right(S, Len(S) - 1)
  1102.         Else
  1103.             S = "-" & S
  1104.         End If
  1105.     End If
  1106.     BigAdd = S
  1107. End Function
  1108. Public Function BigSubtract(ByVal A, ByVal B) As String
  1109.     On Error Resume Next
  1110.     Dim SA As Boolean, SB As Boolean, S As String
  1111.     If Left(A, 1) = "-" Then
  1112.         SA = True
  1113.     End If
  1114.     If Left(B, 1) = "-" Then
  1115.         SB = True
  1116.     End If
  1117.     If Not SA And Not SB Then
  1118.         S = xBigSubtract(A, B)
  1119.     ElseIf SA And Not SB Then
  1120.         S = "-" & xBigAdd(Right(A, Len(A) - 1), B)
  1121.     ElseIf Not SA And SB Then
  1122.         S = xBigAdd(A, Right(B, Len(B) - 1))
  1123.     ElseIf SA And SB Then
  1124.         S = xBigSubtract(Right(B, Len(B) - 1), Right(A, Len(A) - 1))
  1125.     End If
  1126.     BigSubtract = S
  1127. End Function
  1128. Public Function BigProduct(ByVal A, ByVal B) As String
  1129.     On Error Resume Next
  1130.     Dim SA As Boolean, SB As Boolean, S As String
  1131.     If Left(A, 1) = "-" Then
  1132.         SA = True
  1133.     End If
  1134.     If Left(B, 1) = "-" Then
  1135.         SB = True
  1136.     End If
  1137.     If Not SA And Not SB Then
  1138.         S = xBigProduct(A, B)
  1139.     ElseIf SA And Not SB Then
  1140.         S = "-" & xBigProduct(Right(A, Len(A) - 1), B)
  1141.     ElseIf Not SA And SB Then
  1142.         S = "-" & xBigProduct(A, Right(B, Len(B) - 1))
  1143.     ElseIf SA And SB Then
  1144.         S = xBigProduct(Right(B, Len(B) - 1), Right(A, Len(A) - 1))
  1145.     End If
  1146.     BigProduct = S
  1147. End Function
  1148. Public Function BigDivide(ByVal A, ByVal B, ByVal C) As String
  1149.     On Error Resume Next
  1150.     Dim SA As Boolean, SB As Boolean, S As String
  1151.     If Left(A, 1) = "-" Then
  1152.         SA = True
  1153.     End If
  1154.     If Left(B, 1) = "-" Then
  1155.         SB = True
  1156.     End If
  1157.     If Not SA And Not SB Then
  1158.         S = xBigDivide(A, B, C)
  1159.     ElseIf SA And Not SB Then
  1160.         S = "-" & xBigDivide(Right(A, Len(A) - 1), B, C)
  1161.     ElseIf Not SA And SB Then
  1162.         S = "-" & xBigDivide(A, Right(B, Len(B) - 1), C)
  1163.     ElseIf SA And SB Then
  1164.         S = xBigDivide(Right(B, Len(B) - 1), Right(A, Len(A) - 1), C)
  1165.     End If
  1166.     BigDivide = S
  1167. End Function
  1168. Public Function xBigAdd(ByVal A, ByVal B) As String
  1169.     On Error Resume Next
  1170.     Dim PA As Long, PB As Long, LA As Long, LB As Long, L As Long, C As Long, f As Long, FP As Long
  1171.     Dim IA As String, IB As String, FA As String, FB As String, RA As String, RB As String, S As String
  1172.     Dim i As Long, LI As Long, LF As Long
  1173.     PA = InStr(A, ".")
  1174.     PB = InStr(B, ".")
  1175.     If PB > PA Then
  1176.         LI = PB
  1177.     Else
  1178.         LI = PA
  1179.     End If
  1180.     If Len(B) - PB > Len(A) - PA Then
  1181.         LF = Len(B) - PB
  1182.     Else
  1183.         LF = Len(A) - PA
  1184.     End If
  1185.     If LI + LF < 15 Then
  1186.         xBigAdd = Val(A) + Val(B)
  1187.         Exit Function
  1188.     End If
  1189.     If PA > 0 Then
  1190.         IA = Left(A, PA - 1)
  1191.         FA = Right(A, Len(A) - PA)
  1192.     Else
  1193.         IA = A
  1194.         FA = ""
  1195.     End If
  1196.     If PB > 0 Then
  1197.         IB = Left(B, PB - 1)
  1198.         FB = Right(B, Len(B) - PB)
  1199.     Else
  1200.         IB = B
  1201.         FB = ""
  1202.     End If
  1203.     If Len(IA) = 0 Then
  1204.         IA = "0"
  1205.     End If
  1206.     If Len(IB) = 0 Then
  1207.         IB = "0"
  1208.     End If
  1209.     LA = Len(FA)
  1210.     LB = Len(FB)
  1211.     If LA > LB Then
  1212.         FB = FB & String(LA - LB, "0")
  1213.         FP = LA
  1214.     ElseIf LB > LA Then
  1215.         FA = FA & String(LB - LA, "0")
  1216.         FP = LB
  1217.     End If
  1218.     FP = Len(FA)
  1219.     RA = StrReverse(IA & FA)
  1220.     RB = StrReverse(IB & FB)
  1221.     LA = Len(RA)
  1222.     LB = Len(RB)
  1223.     If LA < LB Then L = LB Else L = LA
  1224.     S = ""
  1225.     f = 0
  1226.     For i = 1 To L
  1227.         C = Val(Mid(RA, i, 1)) + Val(Mid(RB, i, 1)) + f
  1228.         f = C \ 10
  1229.         S = (C Mod 10) & S
  1230.     Next i
  1231.     If f > 0 Then S = f & S
  1232.     L = Len(S)
  1233.     S = Left(S, L - FP) & "." & Right(S, FP)
  1234.     S = Replace(RTrim(Replace(S, "0", " ")), " ", "0")
  1235.     If Right(S, 1) = "." Then S = Left(S, Len(S) - 1)
  1236.     xBigAdd = S
  1237. End Function
  1238. Public Function xBigSubtract(ByVal A, ByVal B) As String
  1239.     On Error Resume Next
  1240.     Dim PA As Long, PB As Long, LA As Long, LB As Long, L As Long, C As Long, f As Long, FP As Long
  1241.     Dim IA As String, IB As String, FA As String, FB As String, RA As String, RB As String, S As String
  1242.     Dim Sign As String, T As String, LI As Long, LF As Long
  1243.     Dim i As Long
  1244.     PA = InStr(A, ".")
  1245.     PB = InStr(B, ".")
  1246.     If PB > PA Then
  1247.         LI = PB
  1248.     Else
  1249.         LI = PA
  1250.     End If
  1251.     If Len(B) - PB > Len(A) - PA Then
  1252.         LF = Len(B) - PB
  1253.     Else
  1254.         LF = Len(A) - PA
  1255.     End If
  1256.     If LI + LF < 16 Then
  1257.         xBigSubtract = Val(A) - Val(B)
  1258.         Exit Function
  1259.     End If
  1260.     If PA > 0 Then
  1261.         IA = Left(A, PA - 1)
  1262.         FA = Right(A, Len(A) - PA)
  1263.     Else
  1264.         IA = A
  1265.         FA = ""
  1266.     End If
  1267.     If PB > 0 Then
  1268.         IB = Left(B, PB - 1)
  1269.         FB = Right(B, Len(B) - PB)
  1270.     Else
  1271.         IB = B
  1272.         FB = ""
  1273.     End If
  1274.     If Len(IA) = 0 Then IA = "0"
  1275.     If Len(IB) = 0 Then IB = "0"
  1276.     LA = Len(FA)
  1277.     LB = Len(FB)
  1278.     If LA > LB Then
  1279.         FB = FB & String(LA - LB, "0")
  1280.         FP = LA
  1281.     ElseIf LB > LA Then
  1282.         FA = FA & String(LB - LA, "0")
  1283.         FP = LB
  1284.     End If
  1285.     FP = Len(FA)
  1286.     RA = IA & FA
  1287.     RB = IB & FB
  1288.     LA = Len(RA)
  1289.     LB = Len(RB)
  1290.     Sign = ""
  1291.     If LA < LB Or (LA = LB And RA < RB) Then
  1292.         T = RA
  1293.         RA = RB
  1294.         RB = T
  1295.         Sign = "-"
  1296.     End If
  1297.     LA = Len(RA)
  1298.     RA = StrReverse(RA)
  1299.     RB = StrReverse(RB)
  1300.     S = ""
  1301.     f = 0
  1302.     For i = 1 To LA
  1303.         C = Val(Mid(RA, i, 1)) - Val(Mid(RB, i, 1)) + f
  1304.         If C < 0 Then
  1305.             f = -1
  1306.             C = C + 10
  1307.         Else
  1308.             f = 0
  1309.         End If
  1310.         S = C & S
  1311.     Next i
  1312.     L = Len(S)
  1313.     S = Left(S, L - FP) & "." & Right(S, FP)
  1314.     S = Replace(Trim(Replace(S, "0", " ")), " ", "0")
  1315.     If Left(S, 1) = "." Then
  1316.         S = "0" & S
  1317.     End If
  1318.     If Right(S, 1) = "." Then
  1319.         S = Left(S, Len(S) - 1)
  1320.     End If
  1321.     S = Sign & S
  1322.     xBigSubtract = S
  1323. End Function
  1324. Public Function xBigProduct(ByVal A, ByVal B) As String
  1325.     On Error Resume Next
  1326.     Dim L As Long, LA As Long, LB As Long, PA As Long, PB As Long, FP As Long, CA As Long, CB As Long, C As Long, f As Long
  1327.     Dim RA As String, RB As String, S As String, Sj As String
  1328.     Dim i As Long, J As Long
  1329.     PA = InStr(A, ".")
  1330.     PB = InStr(B, ".")
  1331.     If PA > 0 Then
  1332.         LA = Len(A) - PA
  1333.     Else
  1334.         LA = 0
  1335.     End If
  1336.     If PB > 0 Then
  1337.         LB = Len(B) - PB
  1338.     Else
  1339.         LB = 0
  1340.     End If
  1341.     FP = LA + LB
  1342.     RA = StrReverse(Replace(A, ".", ""))
  1343.     RB = StrReverse(Replace(B, ".", ""))
  1344.     LA = Len(RA)
  1345.     LB = Len(RB)
  1346.     If LA + LB < 16 Then
  1347.         xBigProduct = Val(A) * Val(B)
  1348.         Exit Function
  1349.     End If
  1350.     S = ""
  1351.     For i = 1 To LB
  1352.         CB = Val(Mid(RB, i, 1))
  1353.         Sj = ""
  1354.         f = 0
  1355.         For J = 1 To LA
  1356.             C = CB * Val(Mid(RA, J, 1)) + f
  1357.             f = C \ 10
  1358.             Sj = (C Mod 10) & Sj
  1359.         Next J
  1360.         If f > 0 Then Sj = f & Sj
  1361.         S = BigAdd(S, Sj & String(i - 1, "0"))
  1362.     Next i
  1363.     L = Len(S)
  1364.     S = Left(S, L - FP) & "." & Right(S, FP)
  1365.     S = Replace(RTrim(Replace(S, "0", " ")), " ", "0")
  1366.     If Right(S, 1) = "." Then
  1367.         S = Left(S, Len(S) - 1)
  1368.     End If
  1369.     If S = "" Then
  1370.         S = "0"
  1371.     End If
  1372.     xBigProduct = S
  1373. End Function
  1374. Public Function xBigDivide(ByVal A, ByVal B, ByVal C) As String
  1375.     On Error Resume Next
  1376.     Dim S As String, PreA As String, RA As String, RB As String
  1377.     Dim L As Long, LA As Long, LB As Long, cmp As Long, D As Long, PA As Long, PB As Long, FP As Long
  1378.     Dim i As Long, J As Long
  1379.     If Val(B) = 0 Then
  1380.         xBigDivide = "0"
  1381.         Exit Function
  1382.     End If
  1383.     RA = A
  1384.     RB = B
  1385.     PA = InStr(A, ".")
  1386.     PB = InStr(B, ".")
  1387.     If PA > 0 Then
  1388.         LA = Len(A) - PA
  1389.     Else
  1390.         LA = 0
  1391.     End If
  1392.     If PB > 0 Then
  1393.         LB = Len(B) - PB
  1394.     Else
  1395.         LB = 0
  1396.     End If
  1397.     FP = LA - LB
  1398.     A = Replace(LTrim(Replace(Replace(A, ".", ""), "0", " ")), " ", "0")
  1399.     B = Replace(LTrim(Replace(Replace(B, ".", ""), "0", " ")), " ", "0")
  1400.     C = Val(C)
  1401.     FP = C - FP + 1
  1402.     If Abs(Len(A) - Len(B) + 1 + FP) < 17 And FP < 17 And Len(A) < 16 And Len(B) < 16 Then
  1403.         xBigDivide = Round(Val(RA) / Val(RB), C)
  1404.         Exit Function
  1405.     End If
  1406.     If FP > 0 Then
  1407.         A = A & String(FP, "0")
  1408.     End If
  1409.     LA = Len(A)
  1410.     LB = Len(B)
  1411.     If LA > LB Then
  1412.         B = B & String(LA - LB, "0")
  1413.     End If
  1414.     L = LA - LB + 1
  1415.     For i = 1 To L
  1416.         D = -1
  1417.         Do
  1418.             D = D + 1
  1419.             PreA = A
  1420.             A = xBigSubtract(A, B)
  1421.         Loop Until Left(A, 1) = "-"
  1422.         A = PreA
  1423.         B = Left(B, Len(B) - 1)
  1424.         S = S & D
  1425.     Next i
  1426.     If S = "" Then
  1427.         S = "0"
  1428.     End If
  1429.     If FP < 0 Then
  1430.         S = Left(S, Len(S) + FP)
  1431.     End If
  1432.     If Right(S, 1) >= "5" Then
  1433.         S = xBigAdd(Left(S, Len(S) - 1), "1")
  1434.     Else
  1435.         S = Left(S, Len(S) - 1)
  1436.     End If
  1437.     If C > 0 Then
  1438.         If Len(S) <= C Then
  1439.             S = String(C - Len(S) + 1, "0") & S
  1440.         End If
  1441.         S = Left(S, Len(S) - C) & "." & Right(S, C)
  1442.         S = Replace(RTrim(Replace(S, "0", " ")), " ", "0")
  1443.         If Right(S, 1) = "." Then
  1444.             S = Left(S, Len(S) - 1)
  1445.         End If
  1446.     End If
  1447.     S = Replace(LTrim(Replace(S, "0", " ")), " ", "0")
  1448.     If S = "" Or Left(S, 1) = "." Then
  1449.         S = "0" & S
  1450.     End If
  1451.     xBigDivide = S
  1452. End Function


  1453. ; 请到顶楼下载源代码并在 GUI\mdlCalculator.bas 中可以找到。
  1454. ; 使用 CalculateString([算式(As String)], [成功信号(As enuReturns)], [等级(默认为1)])这样返回值就是计算结果,成功信号代表了计算是否成功。
复制代码

评分

参与人数 1威望 +10 人气 +1 收起 理由
lekj + 10 + 1 精品文章

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2011-1-23 22:02:21 | 显示全部楼层
回复 XiaoJSoft 的帖子

支持一下,不过代码好长呀……(其实表达式分析的代码都不会短,比如我发的那个山寨
“万花筒”
回复 支持 反对

使用道具 举报

发表于 2011-1-23 22:24:50 | 显示全部楼层
支持一下……
回复 支持 反对

使用道具 举报

头像被屏蔽
发表于 2011-1-23 23:34:00 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
回复 支持 反对

使用道具 举报

发表于 2011-1-24 14:37:23 | 显示全部楼层
顶一下楼主,思路清晰,说明详细,加分鼓励
回复 支持 反对

使用道具 举报

发表于 2011-3-7 00:23:24 | 显示全部楼层
注释很详细,分工很明确,给予三个月的置顶,增加曝光率。
回复 支持 反对

使用道具 举报

发表于 2011-7-19 17:28:55 | 显示全部楼层
好帖子!!!!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2019-9-18 20:20

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表