VB 版 (精华区)

发信人: zxfsnow (最近睡眠太少), 信区: VB
标  题: 源代码:公式分析器
发信站: 哈工大紫丁香 (2000年06月07日18:28:45 星期三), 转信

发信人: Woodhead78 (木头脑袋), 信区: VisualBasic
标  题: 源代码:公式分析器
发信站: BBS 水木清华站 (Mon Mar 27 22:42:49 2000)

这是一个自顶向下的分析器，
用到一些编译的知识，
可以计算常见的初等函数，



发信人: woodhead (木头脑袋), 信区: VisualBasic
标  题: 源代码:公式分析器
发信站: PKU BBS (Tue Jan 11 13:38:49 2000), 转信

Public Function CalculateString(ByVal Exppression As String, ByRef Good As B
oolean, ByVal xxx As Double) As Double
Dim isg As Boolean
Dim ExppressionLength As Long
Dim pp As Integer
   pp = 1
   ExppressionLength = Len(Exppression)
   CalculateString = E(Exppression, isg, pp, xxx)
   Good = isg
   If pp <= ExppressionLength Then Good = False
End Function
Private Function E(ByVal Exppression As String, ByRef Good As Boolean, ByRef
 position As Integer, ByVal xxx As Double) As Double
Dim tmp1, tmp2 As Double
Dim isg As Boolean
On Error GoTo Eerr
   tmp1 = T(Exppression, isg, position, xxx)
   If Match(Exppression, "+", position) Then
       position = position + 1
       tmp2 = E2(Exppression, isg, position, xxx)
       If Not (isg) Then
              Good = False
              Exit Function
       End If
       E = tmp1 + tmp2
    Else
      If Match(Exppression, "-", position) Then
        position = position + 1
        tmp2 = E2(Exppression, isg, position, xxx)
        If Not (isg) Then
           Good = False
           Exit Function
        End If
        E = tmp1 - tmp2
      Else
        E = tmp1
      End If
    End If
    Good = isg
    Exit Function
Eerr:
    Good = False
End Function
Private Function E2(ByVal Exppression As String, ByRef Good As Boolean, ByRe
f position As Integer, ByVal xxx As Double) As Double
Dim tmp1, tmp2 As Double
Dim isg As Boolean
   tmp1 = T2(Exppression, isg, position, xxx)
   If Match(Exppression, "+", position) Then
       position = position + 1
       tmp2 = E2(Exppression, isg, position, xxx)
       If Not (isg) Then
              Good = False
              Exit Function
       End If
       E2 = tmp1 + tmp2
    Else
      If Match(Exppression, "-", position) Then
        position = position + 1
        tmp2 = E2(Exppression, isg, position, xxx)
        If Not (isg) Then
           Good = False
           Exit Function
        End If
        E2 = tmp1 - tmp2
      Else
        E2 = tmp1
      End If
      Good = isg
    End If
End Function
Private Function T(ByVal Exppression As String, ByRef Good As Boolean, ByRef
 position As Integer, ByVal xxx As Double) As Double
Dim tmp1, tmp2 As Double
Dim isg As Boolean
   tmp1 = F(Exppression, isg, position, xxx)
   If isg Then
   If Match(Exppression, "*", position) Then
       position = position + 1
       tmp2 = T2(Exppression, isg, position, xxx)
       If Not (isg) Then
              Good = False
              Exit Function
       End If
       T = tmp1 * tmp2
    Else
       If Match(Exppression, "/", position) Then
         position = position + 1
         tmp2 = T2(Exppression, isg, position, xxx)
         If Not (isg) Then
              Good = False
              Exit Function
         End If
         T = tmp1 / tmp2
       Else
         T = tmp1
       End If
    End If
    End If
    Good = isg
End Function
Private Function T2(ByVal Exppression As String, ByRef Good As Boolean, ByRe
f position As Integer, ByVal xxx As Double) As Double
Dim tmp1, tmp2 As Double
Dim isg As Boolean
   tmp1 = F2(Exppression, isg, position, xxx)
   If isg Then
   If Match(Exppression, "*", position) Then
       position = position + 1
       tmp2 = T2(Exppression, isg, position, xxx)
       If Not (isg) Then
              Good = isg
              Exit Function
       End If
       T2 = tmp1 * tmp2
    Else
       If Match(Exppression, "/", position) Then
         position = position + 1
         tmp2 = T2(Exppression, isg, position, xxx)
         If Not (isg) Then
              Good = isg
              Exit Function
         End If
         T2 = tmp1 / tmp2
       Else
         T2 = tmp1
       End If
    End If
    End If
    Good = isg
End Function
Private Function F(ByVal Exppression As String, ByRef Good As Boolean, ByRef
 position As Integer, ByVal xxx As Double) As Double
Dim tmp As Double
Dim isg As Boolean
   tmp = OpDigital(Exppression, isg, position, xxx)
   If Not (isg) Then tmp = G(Exppression, isg, position, xxx)
   F = tmp
   Good = isg
End Function
Private Function F2(ByVal Exppression As String, ByRef Good As Boolean, ByRe
f position As Integer, ByVal xxx As Double) As Double
Dim tmp As Double
Dim isg As Boolean
   tmp = NonopDigital(Exppression, isg, position, xxx)
   If Not (isg) Then tmp = G(Exppression, isg, position, xxx)
   F2 = tmp
   Good = isg
End Function
Private Function G(ByVal Exppression As String, ByRef Good As Boolean, ByRef
 position As Integer, ByVal xxx As Double) As Double
Dim tmp1, tmp2 As Double
Dim isg As Boolean
   Call PassBlank(Exppression, position)
   If Match(Exppression, "SIN", position) Then
       position = position + 3
       Call PassBlank(Exppression, position)
       G = Sin(G2(Exppression, Good, position, xxx))
       Call PassBlank(Exppression, position)
       Exit Function
   End If
   If Match(Exppression, "COS", position) Then
       position = position + 3
       Call PassBlank(Exppression, position)
       G = Cos(G2(Exppression, Good, position, xxx))
       Call PassBlank(Exppression, position)
       Exit Function
   End If
   If Match(Exppression, "TAN", position) Then
       position = position + 3
       Call PassBlank(Exppression, position)
       G = Tan(G2(Exppression, Good, position, xxx))
       Call PassBlank(Exppression, position)
       Exit Function
   End If
   If Match(Exppression, "LOG", position) Then
       position = position + 3
       Call PassBlank(Exppression, position)
       G = Log(G2(Exppression, Good, position, xxx)) / Log(10#)
       Call PassBlank(Exppression, position)
       Exit Function
   End If
   If Match(Exppression, "LN", position) Then
       position = position + 2
       Call PassBlank(Exppression, position)
       G = Log(G2(Exppression, Good, position, xxx))
       Call PassBlank(Exppression, position)
       Exit Function
   End If
   If Match(Exppression, "EXP", position) Then
       position = position + 3
       Call PassBlank(Exppression, position)
       G = Exp(G2(Exppression, Good, position, xxx))
       Call PassBlank(Exppression, position)
       Exit Function
   End If
   If Match(Exppression, "ARCTAN", position) Then
       position = position + 6
       Call PassBlank(Exppression, position)
       G = Atn(G2(Exppression, Good, position, xxx))
       Call PassBlank(Exppression, position)
       Exit Function
   End If
   If Match(Exppression, "ARCSIN", position) Then
       position = position + 6
       Call PassBlank(Exppression, position)
       tmp1 = G2(Exppression, Good, position, xxx)
       If tmp1 <> 1 And tmp1 <> -1 Then
         G = Atn(tmp1 / Sqr(1 - tmp1 * tmp1))
       Else
         If tmp1 = 1 Then G = Pi / 2 Else G = -Pi / 2
       End If
       Call PassBlank(Exppression, position)
       Exit Function
   End If
   If Match(Exppression, "ARCCOS", position) Then
       position = position + 6
       Call PassBlank(Exppression, position)
       tmp1 = G2(Exppression, Good, position, xxx)
       If tmp1 <> 1 And tmp1 <> -1 Then
         G = Atn(-tmp1 / Sqr(1 - tmp1 * tmp1)) + Pi / 2
       Else
         If tmp1 = 1 Then G = 0# Else G = Pi
       End If
       Call PassBlank(Exppression, position)
       Exit Function
   End If
   If Match(Exppression, "POW", position) Then
       position = position + 3
       Call PassBlank(Exppression, position)
       If Match(Exppression, "(", position) Then
          position = position + 1
          tmp1 = E(Exppression, isg, position, xxx)
          If Match(Exppression, ",", position) And isg Then
            position = position + 1
            tmp2 = E(Exppression, isg, position, xxx)
            If Match(Exppression, ")", position) And isg Then
               position = position + 1
               Call PassBlank(Exppression, position)
               Good = True
               G = tmp1 ^ tmp2
               Exit Function
            End If
          End If
       End If
       Good = False
       Exit Function
   End If
   G = G2(Exppression, Good, position, xxx)
   Call PassBlank(Exppression, position)
End Function
Private Function G2(ByVal Exppression As String, ByRef Good As Boolean, ByRe
f position As Integer, ByVal xxx As Double) As Double
Dim tmp As Double
Dim isg As Boolean
  If Match(Exppression, "(", position) Then
     position = position + 1
     Call PassBlank(Exppression, position)
     tmp = E(Exppression, isg, position, xxx)
     If isg And Match(Exppression, ")", position) Then
        G2 = tmp
        position = position + 1
        Good = True
     Else
        Good = False
     End If
  End If
End Function
Private Function NonopDigital(ByVal Exppression As String, ByRef Good As Boo
lean, ByRef position As Integer, ByVal xxx As Double) As Double
Dim tmp1, tmp2 As Double
Dim tmpStr As String
  Call PassBlank(Exppression, position)
  If Match(Exppression, "X", position) Then
     NonopDigital = xxx
     Good = True
     position = position + 1
     Call PassBlank(Exppression, position)
     Exit Function
  End If
  tmp1 = 0
  tmp2 = 0
  tmpStr = Mid(Exppression, position, 1)
  If tmpStr >= "0" And tmpStr <= "9" Then
     While tmpStr >= "0" And tmpStr <= "9" Or tmpStr = " "
       tmp2 = tmp2 + 1
       tmpStr = Mid(Exppression, position + tmp2, 1)
     Wend
     If tmpStr = "." Then tmp2 = tmp2 + 1
     tmpStr = Mid(Exppression, position + tmp2, 1)
     While tmpStr >= "0" And tmpStr <= "9" Or tmpStr = " "
       tmp2 = tmp2 + 1
       tmpStr = Mid(Exppression, position + tmp2, 1)
     Wend
     If tmpStr = "E" Then tmp2 = tmp2 + 1
     tmpStr = Mid(Exppression, position + tmp2, 1)
     While tmpStr >= "0" And tmpStr <= "9" Or tmpStr = " "
       tmp2 = tmp2 + 1
       tmpStr = Mid(Exppression, position + tmp2, 1)
     Wend
     tmp1 = Val(Mid(Exppression, position))
     position = position + tmp2
     Good = True
  Else
     Good = False
  End If
  NonopDigital = tmp1
End Function
Private Function OpDigital(ByVal Exppression As String, ByRef Good As Boolea
n, ByRef position As Integer, ByVal xxx As Double) As Double
Dim tmp As Double
Dim isg As Boolean
Dim sign As Integer
  sign = 1
  Call PassBlank(Exppression, position)
  If Match(Exppression, "X", position) Then
       OpDigital = xxx
       Good = True
       position = position + 1
       Call PassBlank(Exppression, position)
       Exit Function
  End If
  If Match(Exppression, "-", position) Then
     position = position + 1
     sign = -1
  Else
    If Match(Exppression, "+", position) Or Mid(Exppression, position, 1) >=
 "0" And Mid(Exppression, position, 1) <= "9" Then
      sign = 1
    Else
      Good = False
      Exit Function
    End If
  End If
  tmp = F2(Exppression, isg, position, xxx)
  If Not (isg) Then Good = False Else Good = True
  OpDigital = tmp * sign
End Function
Private Function Match(ByVal Exppression As String, ByVal Exppression2 As St
ring, ByRef position As Integer) As Boolean
  If Mid(Exppression, position, Len(Exppression2)) = Exppression2 Then Match
 = True Else Match = False
End Function
Private Sub PassBlank(ByVal Exppression As String, ByRef position)
  While Mid(Exppression, position, 1) = " "
                position = position + 1
  Wend
End Sub
  
--

 以科计为本,以产业报国!
  超越自我,飞跃无限!
  

※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: 202.118.235.252]