module1.bas

VB编写的表达式计算器

Attribute VB_Name = "Module1"

'函数：Calc(Exp As String) As Long
'用于计算包含括号、四则运算的字符串表达式

'infoheader版权所有，转载、使用请注明出处
'Blog：infoheader.blogspot.com
'E-mail：[e-mail]
'仅供技术交流使用，严禁用于商业用途

'叠代深度（调试用）
Public Deep As Integer

Public Function Calc(Exp As String) As Long
    Deep = Deep + 1
    '(1+2)*3+4*5+2=?
    '(1+2)*(3+4)+5=?
    '(1+2)*((3+4)*5)+3=?
    '11111012222211100
    
    DoEvents '防止死机
    
    '去空格
    Exp = Trim(Exp)
    
    '去掉最外括号
    While Left(Exp, 1) = "(" And Right(Exp, 1) = ")"
        Exp = Mid(Exp, 2, Len(Exp) - 2)
    Wend
    
    '循环变量
    Dim I As Integer, J As Integer
    
    '对于纯数值
    '返回该值
    If Trim(Str(Val(Exp))) = Exp Then
        Calc = Val(Exp)
        GoTo LAB_END
    ElseIf Exp = "" Then
        Calc = 0
        GoTo LAB_END
    End If
    
    '括号跳转
    For I = 1 To Len(Exp)
        If Mid(Exp, I, 1) = "(" Then GoTo LAB_A1
    Next
    GoTo LAB_A2
    
LAB_A1:
    '对于有括号的表达式
        '存储级别（优化备用）
        Dim Lv() As Integer
        ReDim Lv(Len(Exp)) As Integer
        '当前级别，最大级别，最大级别启始，结束，判定
        Dim CurrentLv As Integer, LvM As Integer, LvMS As Integer, LvME As Integer, LvMB As Boolean
        
        CurrentLv = 0: LvMB = False
        '定级
        For I = 1 To Len(Exp)
            If Mid(Exp, I, 1) = "(" Then
                CurrentLv = CurrentLv + 1
                If CurrentLv > LvM Then
                    LvM = CurrentLv
                    LvMS = I '最大级别启始点
                    LvMB = True
                End If
            ElseIf Mid(Exp, I, 1) = ")" Then
                CurrentLv = CurrentLv - 1
                If LvMB Then
                    LvME = I '最大级别结束点
                    LvMB = False
                End If
            End If
            Lv(I) = CurrentLv '存储级别（优化备用）
        Next
        '计算最高级括号
        Exp = Left(Exp, LvMS - 1) & Calc(Mid(Exp, LvMS + 1, LvME - LvMS - 1)) & Right(Exp, Len(Exp) - LvME)
        Calc = Calc(Exp)
        GoTo LAB_END

LAB_A2:
    '对于没有括号的表达式
        '加减法跳转
        For I = 1 To Len(Exp)
            If Mid(Exp, I, 1) = "+" Then GoTo LAB_B1
        Next
        GoTo LAB_B2
LAB_B1:
        '对于有加减法的表达式
            For I = 1 To Len(Exp)
                '计算加减法
                If Mid(Exp, I, 1) = "+" Then
                    'Exp = Str(Calc(Left(Exp, I - 1)) + Calc(Right(Exp, Len(Exp) - I)))
                    l = Calc(Left(Exp, I - 1))
                    r = Calc(Right(Exp, Len(Exp) - I))
                    Exp = l + r
                    Calc = Calc(Exp)
                    GoTo LAB_END
                ElseIf Mid(Exp, I, 1) = "-" Then
                    Exp = Str(Calc(Left(Exp, I - 1)) - Calc(Right(Exp, Len(Exp) - I)))
                    Calc = Calc(Exp)
                    GoTo LAB_END
                End If
            Next
LAB_B2:
        '对于没有加减法的表达式
            For I = 1 To Len(Exp)
                '计算乘除法
                If Mid(Exp, I, 1) = "*" Then
                    Exp = Str(Calc(Left(Exp, I - 1)) * Calc(Right(Exp, Len(Exp) - I)))
                    Calc = Calc(Exp)
                    GoTo LAB_END
                ElseIf Mid(Exp, I, 1) = "/" Then
                    Exp = Str(Calc(Left(Exp, I - 1)) / Calc(Right(Exp, Len(Exp) - I)))
                    Calc = Calc(Exp)
                    GoTo LAB_END
                End If
            Next
LAB_END:
    Deep = Deep - 1
End Function