module5.bas

用XML做专家系统的一个编译器,有说明书,使用简单,有模板

Attribute VB_Name = "Module5"
'四则运算模块
Public val_Str() As String

Public Resu As Double

Public iP_N() As Integer   '用于判断数据的正负

Public sSt() As String * 1

Public Kuohao() As Integer

Function calc_Kuohao(str_tex As String) As Double   '括号计算

Dim text_strr As String

Dim mm_stR As String

text_strr = Trim(str_tex)

i_len = Len(text_strr)

aa = Mid(text_strr, 1, 1)

If aa = "-" Or aa = "+" Or aa = "*" Or aa = "/" Then Str_Text1 = "0" & text_strr

ii = 0

For i = 1 To i_len '判断括号是否成对

  mm_stR = Mid(text_strr, i, 1)

  If mm_stR = "（" Then ii = ii + 1

  If mm_stR = "）" Then ii = ii - 1

  If ii < 0 Then

    MsgBox ("括号不成对")

    Exit Function

  End If

Next

If ii <> 0 Then '

  MsgBox ("括号不成对")

  Exit Function

End If

If InStr(1, text_strr, "（") > 0 Then   '如果有括号，现按最里层括号计算

  ReDim sSt(1 To Len(text_strr))

  ReDim Kuohao(1 To Len(text_strr))

  Do While True

    i_len = Len(Trim(text_strr))

    ceng = 1

    For i = 1 To i_len

      sSt(i) = Mid(text_strr, i, 1)

    Next

    If InStr(1, text_strr, "（") <> 0 And InStr(1, text_strr, "（") <> 0 Then     '计算有多少对括号，不成对返回0

      text_strr = ""

      For i = 1 To i_len '判断括号是否为0

        text_strr = text_strr & sSt(i)

      Next

      For i = 1 To i_len

        Kuohao(i) = 0   '清零

        If sSt(i) = "（" Then

          Kuohao(i) = ceng

          ceng = ceng + 1

        End If

        If sSt(i) = "）" Then

          ceng = ceng - 1

          Kuohao(i) = ceng

        End If

      Next

      zuiD = 0: Id = 1

      For i = 1 To i_len '求最内层括号

        If Kuohao(i) > zuiD Then

          zuiD = Kuohao(i)

          Id = i

        End If

      Next    'kuohao（iD）最内层

      mm = InStr(Id, text_strr, "）")

      If mm <> 0 Then 'mm="）"

        mm_stR = Mid(text_strr, Id + 1, mm - Id - 1)

        resu_str = cacul_Str(mm_stR)   '计算

        text_strr = Mid(text_strr, 1, Id - 1) & resu_str & Mid(text_strr, mm + 1, i_len - mm)

      Else

        Exit Do

      End If

    Else

      text_strr = ""

      For i = 1 To i_len '判断括号是否为0

        text_strr = text_strr & sSt(i)

      Next

      calc_Kuohao = cacul_Str(text_strr)

      Exit Do

    End If

  Loop

Else

  calc_Kuohao = cacul_Str(text_strr)   '计算

End If

End Function

  Function cacul_Str(ok_str As String) As Double   '字符串表达式的计算，无括号

Dim s_int As Integer

ReDim val_Str(Len(ok_str) + 2)

ReDim iP_N(Len(ok_str) + 1)

aa = Mid(ok_str, i + 1, 1)

If aa = "-" Or aa = "+" Or aa = "*" Or aa = "/" Then ok_str = "0" & ok_str

s_int = 0

val_Str(0) = ""

For i = 0 To Len(ok_str)

  iP_N(i) = 1

Next

i = 0

Do While i < Len(ok_str)   '含分解字符串

  aa = Mid(ok_str, i + 1, 1)

  bb = Asc(aa)

  If bb >= 48 And bb <= 57 Or bb = 46 Then '0-9 and .

    val_Str(s_int) = val_Str(s_int) & aa

  Else

    If aa = "+" Or aa = "-" Or aa = "*" Or aa = "/" Then

      If Mid(ok_str, i + 2, 1) = "-" Then

        iP_N(s_int + 2) = -1

        ok_str = Mid(ok_str, 1, i + 1) & Mid(ok_str, i + 3, Len(ok_str))

        ok_str = Trim(ok_str)

        i = i - 1

      Else

        s_int = s_int + 1

        val_Str(s_int) = aa

        s_int = s_int + 1

        val_Str(s_int) = ""

      End If

    Else

      iP_N(s_int) = 1

    End If

  End If

  i = i + 1

Loop

For i = 0 To s_int Step 2

  val_Str(i) = Val(val_Str(i)) * iP_N(i)

Next

If s_int > 1 Then

  For i = 0 To s_int Step 2

    If val_Str(i + 1) = "*" Or val_Str(i + 1) = "/" Then

      If val_Str(i + 1) = "*" Then

        val_Str(i) = Val(val_Str(i)) * Val(val_Str(i + 2))

      Else

        val_Str(i) = Val(val_Str(i)) / Val(val_Str(i + 2))

      End If

      For j = i + 1 To s_int

        val_Str(j) = val_Str(j + 2)

      Next

      val_Str(s_int - 1) = "": val_Str(s_int) = ""

      s_int = s_int - 2

      i = i - 2

    End If

  Next

  Resu = val_Str(0)

  For i = 1 To s_int Step 2

    If val_Str(i) = "-" Then val_Str(i + 1) = Val(val_Str(i + 1)) * (-1)

    Resu = Resu + val_Str(i + 1)

  Next

  cacul_Str = Resu

Else

  cacul_Str = val_Str(0)

End If

End Function