clsexpplus.cls

编译原理课程设计用vb编写

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsExpPlus"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Oper() As String
Private sf As New clsVar
Private skop As New clsStack
Private skexp As New clsStack

Private Sub Class_Initialize()
    ReDim Oper(6)
    Oper(1) = "#,与,或,反,绝,开,异"
    Oper(2) = "<,>,=,不,高,低"
    Oper(3) = "+,-,余"
    Oper(4) = "*,/"
    Oper(5) = "^"
    Oper(6) = "(,)"
    For i = 1 To 6
        For j = 0 To UBound(Split(Oper(i), ","))
            sf.setVar Split(Oper(i), ",")(j), i
        Next
    Next
End Sub


Public Function logic(ByVal s As String)
    logic = CBool(logic_it(s))
End Function

Public Function exp(ByVal s As String)
    a = InstrPlus(s, "=")
    If a = 0 Or (InstrPlus(s, "(") < InstrPlus(s, "=") And InstrPlus(s, "(") <> 0) Then
        exp = logic_it(s)
        Exit Function
    End If
    e1 = Trim(Left(s, a - 1))
    e2 = Trim(Mid(s, a + 1, Len(s)))
    If e1 = "" Then
        Err.Raise 102, , "变量名不得为空"
        Exit Function
    End If
    If IsNumeric(Left(e1, 1)) Then
        Err.Raise 103, , "变量名不得以数字开头"
        Exit Function
    End If
    If Len(e1) > 1 Then
        For i = 2 To Len(e1)
            ch = Mid(e1, i, 1)
            If Not ((ch1 >= "a" And ch1 <= "z") Or (ch1 >= "A" And ch1 <= "Z") Or IsNumeric(ch1)) Then
                Err.Raise 104, , "变量名不合法"
                Exit Function
            End If
        Next
    End If
    le2 = logic_it(e2)
    If Err.Number > 0 Then Exit Function
    globalCV.setVar e1, le2
    exp = globalCV.getVar(e1)
End Function

Private Function logic_it(ByVal s As String)
    '初始化s
    'Debug.Print "logic_it:" & s
    s = s & "+0"
    If Left(s, 1) = "-" Then s = "0" & s
    s = ReplacePlus(s, "(-", "(0-")
    s = ReplacePlus(s, "( -", "(0-")
    s = ReplacePlus(s, "and", "与")
    s = ReplacePlus(s, "xor", "异")
    s = ReplacePlus(s, "or", "或")
    s = ReplacePlus(s, "not", "反")
    s = ReplacePlus(s, "<>", "不")
    s = ReplacePlus(s, ">=", "高")
    s = ReplacePlus(s, "<=", "低")
    s = ReplacePlus(s, "mod", "余")
    s = ReplacePlus(s, "abs", "绝")
    s = ReplacePlus(s, "sqr", "开")
    Dim se As New clsSen
    skop.Clear
    skexp.Clear
    skop.Push "#"
    skexp.Push "#"
    se.strText = s
    While Not se.Eof
        tmp = se.ReadWord
        If isKey(tmp) Then
            If sf.getVar(tmp) > sf.getVar(skop.Item(0)) Or (tmp = ")" And skop.Item(0) = "(") Or (tmp = "反" And skop.Item(0) = "反") Then
                '外>内
                If tmp <> ")" Then
                    skop.Push tmp
                Else
                    While skop.Count > 1 And skop.Item(0) <> "("
                        skexp.Push skop.Pop
                        Calculate
                        If Err.Number > 0 Then Exit Function
                        '----------need to do something
                    Wend
                    skop.Pop
                    'skop.Push tmp
                End If
            Else
                '外<=内
                While skop.Count > 1 And skop.Item(0) <> "(" And sf.getVar(tmp) <= sf.getVar(skop.Item(0))
                    skexp.Push skop.Pop
                    Calculate
                    If Err.Number > 0 Then Exit Function
                    '----------need to do something
                Wend
                skop.Push tmp
            End If
        Else
            '数字/变量
            skexp.Push tmp
        End If
    Wend
    While skop.Count > 1
        skexp.Push skop.Pop
        Calculate
        If Err.Number > 0 Then Exit Function
        '---need to do something
    Wend
    On Error Resume Next
    If skexp.Count <> 2 Then
        Err.Raise 120, , "语句未结束"
        Exit Function
    End If
    If isKey(skexp.Item(0)) Then
        Err.Raise 121, , "语句不正确"
        Exit Function
    End If
    logic_it = skexp.Pop
End Function

Private Function Calculate()
    On Error Resume Next
    Dim t As Double
    While isKey(skexp.Item(0)) And skexp.Count >= 2
        opt = skexp.Pop
        If opt = "反" Then
            skexp.Push IIf((Not CBool(myVar(skexp.Pop))), 1, 0)
        ElseIf opt = "开" Then
            skexp.Push Sqr(myVar(skexp.Pop))
        ElseIf opt = "绝" Then
            skexp.Push Abs(myVar(skexp.Pop))
        Else
            op2 = myVar(skexp.Pop)
            op1 = myVar(skexp.Pop)
            'Debug.Print op1 & opt & op2
            Select Case opt
                Case "+"
                    t = op1 + op2
                Case "-"
                    t = op1 - op2
                Case "*"
                    t = op1 * op2
                Case "/"
                    t = op1 / op2
                Case "与"
                    t = IIf((CBool(op1) And CBool(op2)), 1, 0)
                Case "或"
                    t = IIf((CBool(op1) Or CBool(op2)), 1, 0)
                Case "^"
                    t = op1 ^ op2
                Case "<"
                    t = IIf((op1 < op2), 1, 0)
                Case ">"
                    t = IIf((op1 > op2), 1, 0)
                Case "不"
                    t = IIf((op1 <> op2), 1, 0)
                Case "高"
                    t = IIf((op1 >= op2), 1, 0)
                Case "低"
                    t = IIf((op1 <= op2), 1, 0)
                Case "余"
                    t = op1 Mod op2
                Case "="
                    t = IIf((op1 = op2), 1, 0)
                Case "异"
                    t = IIf((CBool(op1) Xor CBool(op2)), 1, 0)
            End Select
            skexp.Push t
        End If
    Wend
End Function

Private Function myVar(ByVal name As String) As Double
    If IsNumeric(name) Then
        myVar = name
    Else
        myVar = globalCV.getVar(name)
    End If
End Function

Public Function isKey(ByVal s As String) As Boolean
    For i = 1 To 6
        If InStr(Oper(i), s) > 0 Then
            isKey = True
            Exit Function
        End If
    Next
    isKey = False
End Function