calc.frm

很好的算法

VERSION 5.00
Begin VB.Form Calc 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   600
   ClientLeft      =   2565
   ClientTop       =   4620
   ClientWidth     =   9135
   Icon            =   "Calc.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   600
   ScaleWidth      =   9135
   Begin VB.TextBox Text2 
      Height          =   400
      Left            =   7080
      TabIndex        =   2
      Top             =   120
      Width           =   1935
   End
   Begin VB.TextBox Text1 
      Height          =   400
      Left            =   120
      TabIndex        =   1
      Text            =   "tan(9.232)-sqr(323)*(log(534)-34)/(exp(3.2)+sqr(43))"
      Top             =   120
      Width           =   6495
   End
   Begin VB.CommandButton Command1 
      Caption         =   "="
      Height          =   375
      Left            =   6600
      TabIndex        =   0
      Top             =   120
      Width           =   495
   End
End
Attribute VB_Name = "Calc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

''''''''''''''''''''''''''''''''''''''''''''''''''
'使用说明
'1、本算法可以任意拷贝，在工控等算法组态方面有其应用价值
'
'2、本算法由作者原创，望大家尊重个人劳动成果-----拷贝时将使用说明一起拷贝
'
'3、在使用本算法计算过程中有任何问题或建议请发E-mail:[e-mail]或电话[phone]联系
''''''''''''''''''''''''''''''''''''''''''''
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'函数名称：  calc
'参数：      expressions 类型(string)，可包含运算符：+-*/,sqr,sin,cos,tan,atn,log,exp,()
'返回值：    计算值 类型(string)
'功能：      计算表达式的值
'作者：      李志有
'编写日期：  2004-7-22
'修改日期：  2004-7-28
'修改人：    李志有
'调用例子：calc("tan(9.232)-sqr(323)*(log(534)-34)/(exp(3.2)+sqr(43))")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Calc(expressions As String) As String
 Dim i As Long, j As Long, k As Long
 Dim D As Double
 Dim Tempstr As String
 On Error GoTo ErrHandle:
'  Debug.Print expressions
 
 i = InStr(1, expressions, "+-")
 If i <> 0 Then
      Tempstr = Replace$(expressions, "+-", "-")
      expressions = Tempstr
 End If
 i = InStr(1, expressions, "-+")
 If i <> 0 Then
      Tempstr = Replace$(expressions, "-+", "-")
      expressions = Tempstr
 End If
 i = InStr(1, expressions, "--")
 If i <> 0 Then
      Tempstr = Replace$(expressions, "--", "+")
      expressions = Tempstr
 End If
 i = InStr(1, expressions, "++")
 If i <> 0 Then
      Tempstr = Replace$(expressions, "++", "+")
      expressions = Tempstr
 End If
 i = InStr(1, expressions, "sqr")

 If i <> 0 Then
   k = 1
   j = i + 4
   For j = i + 4 To Len(expressions)
    If Mid$(expressions, j, 1) = ")" Then
      k = k - 1
      If k = 0 Then
         Exit For
      End If
    End If
    If Mid$(expressions, j, 1) = "(" Then
      k = k + 1
    End If
   Next
   Tempstr = Mid$(expressions, i, j - i + 1)
   Calc = Calc(Replace$(expressions, Tempstr, CStr(Sqr(Val(Calc(Mid$(Tempstr, 5, j - i - 4))))), 1, 1))
   Exit Function
 End If
 i = InStr(1, expressions, "sin")
 If i <> 0 Then
   k = 1
   j = i + 4
   For j = i + 4 To Len(expressions)
    If Mid$(expressions, j, 1) = ")" Then
      k = k - 1
      If k = 0 Then
         Exit For
      End If
    End If
    If Mid$(expressions, j, 1) = "(" Then
      k = k + 1
    End If
   Next
   Tempstr = Mid$(expressions, i, j - i + 1)
   Calc = Calc(Replace$(expressions, Tempstr, CStr(Sin(Val(Calc(Mid$(Tempstr, 5, j - i - 4))))), 1, 1))
   Exit Function
 End If
 i = InStr(1, expressions, "cos")
 If i <> 0 Then
   k = 1
   j = i + 4
   For j = i + 4 To Len(expressions)
    If Mid$(expressions, j, 1) = ")" Then
      k = k - 1
      If k = 0 Then
         Exit For
      End If
    End If
    If Mid$(expressions, j, 1) = "(" Then
      k = k + 1
    End If
   Next
   Tempstr = Mid$(expressions, i, j - i + 1)
   Calc = Calc(Replace$(expressions, Tempstr, CStr(Cos(Val(Calc(Mid$(Tempstr, 5, j - i - 4))))), 1, 1))
   Exit Function
 End If
 i = InStr(1, expressions, "tan")
 If i <> 0 Then
   k = 1
   j = i + 4
   For j = i + 4 To Len(expressions)
    If Mid$(expressions, j, 1) = ")" Then
      k = k - 1
      If k = 0 Then
         Exit For
      End If
    End If
    If Mid$(expressions, j, 1) = "(" Then
      k = k + 1
    End If
   Next
   Tempstr = Mid$(expressions, i, j - i + 1)
   Calc = Calc(Replace$(expressions, Tempstr, CStr(Tan(Val(Calc(Mid$(Tempstr, 5, j - i - 4))))), 1, 1))
   Exit Function
 End If
  i = InStr(1, expressions, "log")
 If i <> 0 Then
   k = 1
   j = i + 4
   For j = i + 4 To Len(expressions)
    If Mid$(expressions, j, 1) = ")" Then
      k = k - 1
      If k = 0 Then
         Exit For
      End If
    End If
    If Mid$(expressions, j, 1) = "(" Then
      k = k + 1
    End If
   Next
   Tempstr = Mid$(expressions, i, j - i + 1)
   Calc = Calc(Replace$(expressions, Tempstr, CStr(Log(Val(Calc(Mid$(Tempstr, 5, j - i - 4))))), 1, 1))
   Exit Function
 End If
  i = InStr(1, expressions, "exp")
 If i <> 0 Then
   k = 1
   j = i + 4
   For j = i + 4 To Len(expressions)
    If Mid$(expressions, j, 1) = ")" Then
      k = k - 1
      If k = 0 Then
         Exit For
      End If
    End If
    If Mid$(expressions, j, 1) = "(" Then
      k = k + 1
    End If
   Next
   Tempstr = Mid$(expressions, i, j - i + 1)
   Calc = Calc(Replace$(expressions, Tempstr, CStr(Exp(Val(Calc(Mid$(Tempstr, 5, j - i - 4))))), 1, 1))
   Exit Function
 End If
  i = InStr(1, expressions, "atn")
 If i <> 0 Then
   k = 1
   j = i + 4
   For j = i + 4 To Len(expressions)
    If Mid$(expressions, j, 1) = ")" Then
      k = k - 1
      If k = 0 Then
         Exit For
      End If
    End If
    If Mid$(expressions, j, 1) = "(" Then
      k = k + 1
    End If
   Next
   Tempstr = Mid$(expressions, i, j - i + 1)
   Calc = Calc(Replace$(expressions, Tempstr, CStr(Atn(Val(Calc(Mid$(Tempstr, 5, j - i - 4))))), 1, 1))
   Exit Function
 End If
 j = InStr(1, expressions, ")")
 If j <> 0 Then
   i = j - 1
   Do While (i > 0)
     If (Mid$(expressions, i, 1) = "(") Then
       Exit Do
     End If
     i = i - 1
   Loop
   Tempstr = Mid$(expressions, i, j - i + 1)
   Calc = Calc(Replace$(expressions, Tempstr, Calc(Mid$(Tempstr, 2, j - i - 1)), 1, 1))
   Exit Function
 End If
 i = InStr(1, expressions, "*")
 j = InStr(1, expressions, "/")
 If i <> 0 Or j <> 0 Then
   If j * i = 0 Then
    If i = 0 Then
     i = j
    End If
   Else
     If i > j Then
       i = j
     End If
   End If
 Else
   GoTo out
 End If
  k = i - 1
 Do While (k > 0)
    Tempstr = Mid$(expressions, k, 1)
    If Tempstr = "+" Or Tempstr = "-" Then
      If k > 1 Then
        If Mid$(expressions, k - 1, 1) = "E" Then
          k = k - 2
          Tempstr = Mid$(expressions, k, 1)
        End If
      End If
    End If
    If Not (Tempstr = "." Or IsNumeric(Tempstr)) Then
      Exit Do
    End If
    k = k - 1
  Loop
  k = k + 1
  D = Val(Mid$(expressions, k, i - k))
  j = i + 1
  If Mid$(expressions, j, 1) = "-" Or Mid$(expressions, j, 1) = "+" Then
   j = j + 1
  End If
  Do While (j < Len(expressions) + 1)
    Tempstr = Mid$(expressions, j, 1)
    If Tempstr = "E" Then
          j = j + 2
          Tempstr = Mid$(expressions, j, 1)
    End If
    If Not (Tempstr = "." Or IsNumeric(Tempstr)) Then
      Exit Do
    End If
    j = j + 1
  Loop
  j = j - 1
  Tempstr = Mid$(expressions, k, j - k + 1)
  If Mid$(expressions, i, 1) = "*" Then
    Calc = Calc(Replace$(expressions, Tempstr, CStr(D * Val(Mid$(expressions, i + 1, j - i))), 1, 1))
  Else
    Calc = Calc(Replace$(expressions, Tempstr, CStr(D / Val(Mid$(expressions, i + 1, j - i))), 1, 1))
  End If
  Exit Function
out:
 i = 2
 j = 2
restart:
 i = InStr(i, expressions, "+")
 j = InStr(j, expressions, "-")
 If i <> 0 Or j <> 0 Then
    If j * i = 0 Then
      If i = 0 Then
       i = j
      End If
    Else
        If i > j Then
          i = j
        End If
    End If
 Else
   Calc = expressions
   Exit Function
 End If
 k = i - 1
 If Mid$(expressions, k, 1) = "E" Then
   i = i + 2
   j = i
   GoTo restart
 End If
  Do While (k > 0)
    Tempstr = Mid$(expressions, k, 1)
    If Tempstr = "+" Or Tempstr = "-" Then
      If k > 1 Then
        If Mid$(expressions, k - 1, 1) = "E" Then
          k = k - 2
          Tempstr = Mid$(expressions, k, 1)
        Else
          Exit Do
        End If
      End If
    End If
    
    If Not (Tempstr = "." Or IsNumeric(Tempstr)) Then
      Exit Do
    End If
    k = k - 1
  Loop
  k = k + 1
  D = Val(Mid$(expressions, k, i - k))
  j = i + 1
  Do While (j < Len(expressions) + 1)
    Tempstr = Mid$(expressions, j, 1)
    If Tempstr = "E" Then
          j = j + 2
          Tempstr = Mid$(expressions, j, 1)
    End If
    If Not (Tempstr = "." Or IsNumeric(Tempstr)) Then
      Exit Do
    End If
    j = j + 1
  Loop
  j = j - 1
  Tempstr = Mid$(expressions, k, j - k + 1)
  If Mid$(expressions, i, 1) = "+" Then
   If Mid$(expressions, 1, 1) = "-" Then
    Calc = Calc(Replace$(expressions, Tempstr, CStr(D - Val(Mid$(expressions, i + 1, j - i))), 1, 1))
   Else
    Calc = Calc(Replace$(expressions, Tempstr, CStr(D + Val(Mid$(expressions, i + 1, j - i))), 1, 1))
   End If
  Else
    If Mid$(expressions, 1, 1) = "-" Then
      Calc = Calc(Replace$(expressions, Tempstr, CStr(D + Val(Mid$(expressions, i + 1, j - i))), 1, 1))
    Else
       Calc = Calc(Replace$(expressions, Tempstr, CStr(D - Val(Mid$(expressions, i + 1, j - i))), 1, 1))
    End If
  End If
  Exit Function
ErrHandle:
  Calc = expressions
  Err.Clear
End Function

Private Sub Command1_Click()
Text2.Text = Calc(Text1.Text)
End Sub