analyser.bas

分析数学表达式 运算 以及作图用的

    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 1)
    GoTo ExitFunction
  Case "cos"
    NewVal = Cos(Val(NowExpression(i)))
    NewVal = Round(NewVal, 3): If NewVal < 0.01 And NewVal > 0 Then NewVal = 0.01: If NewVal > -0.01 And NewVal < 0 Then NewVal = -0.01
    If Left(NewVal, 1) = "." Then NewVal = "0" & NewVal
    If Left(NewVal, 2) = "-." Then NewVal = "-0" & Right(NewVal, Len(NewVal) - 1)
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 1)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 1)
    GoTo ExitFunction
  Case "tan"
    NewVal = Tan(Val(NowExpression(i)))
    NewVal = Round(NewVal, 3): If NewVal < 0.01 And NewVal > 0 Then NewVal = 0.01: If NewVal > -0.01 And NewVal < 0 Then NewVal = -0.01
    If Left(NewVal, 1) = "." Then NewVal = "0" & NewVal
    If Left(NewVal, 2) = "-." Then NewVal = "-0" & Right(NewVal, Len(NewVal) - 1)
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 1)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 1)
    GoTo ExitFunction
  Case "abs"
    NewVal = Abs(Val(NowExpression(i)))
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 1)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 1)
    GoTo ExitFunction
  Case "atan"
    NewVal = Atn(Val(NowExpression(i)))
    NewVal = Round(NewVal, 3): If NewVal < 0.01 And NewVal > 0 Then NewVal = 0.01: If NewVal > -0.01 And NewVal < 0 Then NewVal = -0.01
    If Left(NewVal, 1) = "." Then NewVal = "0" & NewVal
    If Left(NewVal, 2) = "-." Then NewVal = "-0" & Right(NewVal, Len(NewVal) - 1)
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 1)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 1)
    GoTo ExitFunction
  Case "asin"
    NewVal = Atn(Atn(Val(NowExpression(i))) / Sqr(-Atn(Val(NowExpression(i))) * Atn(Val(NowExpression(i))) + 1))
    NewVal = Round(NewVal, 3): If NewVal < 0.01 And NewVal > 0 Then NewVal = 0.01: If NewVal > -0.01 And NewVal < 0 Then NewVal = -0.01
    If Left(NewVal, 1) = "." Then NewVal = "0" & NewVal
    If Left(NewVal, 2) = "-." Then NewVal = "-0" & Right(NewVal, Len(NewVal) - 1)
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 1)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 1)
    GoTo ExitFunction
  Case "exp"
    NewVal = Exp(Val(NowExpression(i)))
    NewVal = Round(NewVal, 3): If NewVal < 0.01 And NewVal > 0 Then NewVal = 0.01: If NewVal > -0.01 And NewVal < 0 Then NewVal = -0.01
    If Left(NewVal, 1) = "." Then NewVal = "0" & NewVal
    If Left(NewVal, 2) = "-." Then NewVal = "-0" & Right(NewVal, Len(NewVal) - 1)
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 1)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 1)
    GoTo ExitFunction
  Case "fix"
    NewVal = Fix(Val(NowExpression(i)))
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 1)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 1)
    GoTo ExitFunction
  Case "int"
    NewVal = Int(Val(NowExpression(i)))
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 1)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 1)
    GoTo ExitFunction
  Case "log"
    NewVal = Log(Val(NowExpression(i)))
    NewVal = Round(NewVal, 3): If NewVal < 0.01 And NewVal > 0 Then NewVal = 0.01: If NewVal > -0.01 And NewVal < 0 Then NewVal = -0.01
    If Left(NewVal, 1) = "." Then NewVal = "0" & NewVal
    If Left(NewVal, 2) = "-." Then NewVal = "-0" & Right(NewVal, Len(NewVal) - 1)
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 1)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 1)
    GoTo ExitFunction
  Case "rnd"
    NewVal = Rnd
    NewVal = Round(NewVal, 3): If NewVal < 0.01 And NewVal > 0 Then NewVal = 0.01: If NewVal > -0.01 And NewVal < 0 Then NewVal = -0.01
    If Left(NewVal, 1) = "." Then NewVal = "0" & NewVal
    If Left(NewVal, 2) = "-." Then NewVal = "-0" & Right(NewVal, Len(NewVal) - 1)
    NowExpression(i) = NewVal
  Case "sqr", "sqrt"
    NewVal = Sqr(Val(NowExpression(i)))
    NewVal = Round(NewVal, 3): If NewVal < 0.01 And NewVal > 0 Then NewVal = 0.01: If NewVal > -0.01 And NewVal < 0 Then NewVal = -0.01
    If Left(NewVal, 1) = "." Then NewVal = "0" & NewVal
    If Left(NewVal, 2) = "-." Then NewVal = "-0" & Right(NewVal, Len(NewVal) - 1)
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 1)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 1)
    GoTo ExitFunction
  Case "acos"
    NewVal = Atn(-Val(NowExpression(i)) / Sqr(-Val(NowExpression(i)) * Val(NowExpression(i)) + 1)) + 2 * Atn(1)
    NewVal = Round(NewVal, 3): If NewVal < 0.01 And NewVal > 0 Then NewVal = 0.01: If NewVal > -0.01 And NewVal < 0 Then NewVal = -0.01
    If Left(NewVal, 1) = "." Then NewVal = "0" & NewVal
    If Left(NewVal, 2) = "-." Then NewVal = "-0" & Right(NewVal, Len(NewVal) - 1)
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 1)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 1)
    GoTo ExitFunction
  End Select
Next i
For i = UBound(NowExpression) To LBound(NowExpression) Step -1
  If NowExpression(i) = "^" Then
    NewVal = Val(NowExpression(i - 1)) ^ Val(NowExpression(i + 1))
    NowExpression(i - 1) = NewVal
    NewVal = Round(NewVal, 3): If NewVal < 0.01 And NewVal > 0 Then NewVal = 0.01: If NewVal > -0.01 And NewVal < 0 Then NewVal = -0.01
    If Left(NewVal, 1) = "." Then NewVal = "0" & NewVal
    If Left(NewVal, 2) = "-." Then NewVal = "-0" & Right(NewVal, Len(NewVal) - 1)
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 2)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 2)
    GoTo ExitFunction
  End If
Next i
For i = LBound(NowExpression) To UBound(NowExpression)
  If NowExpression(i) = "*" Or NowExpression(i) = "/" Then
    If NowExpression(i) = "*" Then
      NewVal = Val(NowExpression(i - 1)) * Val(NowExpression(i + 1))
    Else
      Dim A As Single
      NewVal = Val(NowExpression(i - 1)) / Val(NowExpression(i + 1))
    End If
    NewVal = Round(NewVal, 3): If NewVal < 0.01 And NewVal > 0 Then NewVal = 0.01: If NewVal > -0.01 And NewVal < 0 Then NewVal = -0.01
    If Left(NewVal, 1) = "." Then NewVal = "0" & NewVal
    If Left(NewVal, 2) = "-." Then NewVal = "-0" & Right(NewVal, Len(NewVal) - 1)
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 2)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 2)
    GoTo ExitFunction
  End If
Next i
For i = LBound(NowExpression) To UBound(NowExpression)
  If NowExpression(i) = "+" Or NowExpression(i) = "_" Then
    If NowExpression(i) = "+" Then
      NewVal = Val(NowExpression(i - 1)) + Val(NowExpression(i + 1))
    Else
      NewVal = Val(NowExpression(i - 1)) - Val(NowExpression(i + 1))
    End If
    NowExpression(i - 1) = NewVal
    For j = i To UBound(NowExpression)
      NowExpression(j) = NowExpression(j + 2)
    Next j
    ReDim Preserve NowExpression(LBound(NowExpression) To UBound(NowExpression) - 2)
    GoTo ExitFunction
  End If
Next i
ExitFunction:
For i = 1 To EStart - 1
DoCalc = DoCalc & FullExpression(i) & " "
Next i
For i = LBound(NowExpression) To UBound(NowExpression)
DoCalc = DoCalc & NowExpression(i) & " "
Next i
For i = EStart + Elength + 1 To UBound(FullExpression)
DoCalc = DoCalc & FullExpression(i) & " "
Next i
End Function
Public Function Initialize(ByRef DstString As String) As String
ii = 0
HaveProblems = False
ConstIndex = 0
Initialize = Analyse(DstString)
End Function
Private Function Analyse(ByRef DstString As String) As String
DoEvents
If ii > 100 Then
   MsgBox ("未知的错误。")
   Analyse = InText
   HaveProblems = True
   Exit Function
End If
If Not HaveProblems Then
  AddSpace (DstString)
  If Not IsNumeric(DoCalc) Then
     ii = ii + 1
     Debug.Print ii
    Analyse (DoCalc)
  End If
Analyse = DoCalc
Else
HaveProblems = False
Analyse = InText
End If
End Function