⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 vbexample.frm

📁 非常好的数学公式计算源代码
💻 FRM
字号:
VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "MTParserCOM: VB client demo"
   ClientHeight    =   3690
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6390
   LinkTopic       =   "Form1"
   ScaleHeight     =   3690
   ScaleWidth      =   6390
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton DefineMacro 
      Caption         =   "Define Macro"
      Height          =   375
      Left            =   4920
      TabIndex        =   15
      Top             =   3120
      Width           =   1335
   End
   Begin VB.CommandButton Index 
      Caption         =   "Index"
      Height          =   375
      Left            =   4920
      TabIndex        =   8
      Top             =   2640
      Width           =   1335
   End
   Begin VB.TextBox VarZ 
      Height          =   285
      Left            =   840
      TabIndex        =   7
      Text            =   "0"
      Top             =   1560
      Width           =   975
   End
   Begin VB.TextBox VarY 
      Height          =   285
      Left            =   840
      TabIndex        =   6
      Text            =   "0"
      Top             =   1200
      Width           =   975
   End
   Begin VB.TextBox VarX 
      Height          =   285
      Left            =   840
      TabIndex        =   5
      Text            =   "0"
      Top             =   840
      Width           =   975
   End
   Begin VB.TextBox Result 
      Enabled         =   0   'False
      Height          =   375
      Left            =   3840
      Locked          =   -1  'True
      TabIndex        =   4
      Text            =   "0"
      Top             =   1440
      Width           =   2055
   End
   Begin VB.TextBox Msg 
      Appearance      =   0  'Flat
      BackColor       =   &H80000004&
      BorderStyle     =   0  'None
      Enabled         =   0   'False
      Height          =   855
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   3
      Top             =   2520
      Width           =   4335
   End
   Begin VB.CommandButton Benchmark 
      Caption         =   "Benchmark"
      Height          =   615
      Left            =   2040
      TabIndex        =   2
      Top             =   1560
      Width           =   1455
   End
   Begin VB.TextBox Expr 
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Text            =   "pi*min(x+y+sin(z)/2^3-40.9988*2, avg(y,x*10,3,5))"
      Top             =   240
      Width           =   5895
   End
   Begin VB.CommandButton Evaluate 
      Caption         =   "Evaluate"
      Default         =   -1  'True
      Height          =   615
      Left            =   2040
      TabIndex        =   0
      Top             =   840
      Width           =   1455
   End
   Begin VB.Frame Frame1 
      Caption         =   "Result"
      Height          =   975
      Left            =   3720
      TabIndex        =   10
      Top             =   1080
      Width           =   2415
   End
   Begin VB.Frame Frame2 
      Height          =   2415
      Left            =   120
      TabIndex        =   11
      Top             =   0
      Width           =   6135
      Begin VB.Label Label1 
         Caption         =   "X ="
         Height          =   375
         Left            =   120
         TabIndex        =   14
         Top             =   960
         Width           =   495
      End
      Begin VB.Label Label2 
         Caption         =   "Y ="
         Height          =   375
         Left            =   120
         TabIndex        =   13
         Top             =   1320
         Width           =   495
      End
      Begin VB.Label Label3 
         Caption         =   "Z ="
         Height          =   375
         Left            =   120
         TabIndex        =   12
         Top             =   1680
         Width           =   495
      End
   End
   Begin VB.Label Label4 
      Caption         =   "Result:"
      Height          =   255
      Left            =   3960
      TabIndex        =   9
      Top             =   1200
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetTickCount Lib "kernel32" () As Long

Dim m_parser As New MTParser
Dim m_varKeyX As sMTVarKey
Dim m_varKeyY As sMTVarKey
Dim m_varKeyZ As sMTVarKey


Private Sub form_load()

On Error GoTo load_error

    MacroDefinition.SetParser m_parser
    
    ' Define the variables and keep the keys to speed up value assignations
    
    m_varKeyX = m_parser.defineLocalVar("x")
    m_varKeyY = m_parser.defineLocalVar("y")
    m_varKeyZ = m_parser.defineLocalVar("z")
      
    ' Define a shared double variable for test purpose
    Dim v As New MTDouble
    
    v.Create "v", 1
    m_parser.defineVar v
    Dim r As Double
    r = m_parser.Evaluate("v")
    v.Value = 10        ' Change the variable's value
    r = m_parser.Evaluate("v")
     
    ' Create another parser and copy the existing parser configuration
    Dim p2 As New MTParser
    p2.Copy m_parser
    
    r = p2.Evaluate("v")    ' the shared variable has been copied
    
    ' Changing the shared variable's value impact all parsers using this variable
    v.Value = 3
    r = p2.Evaluate("v")
    r = m_parser.Evaluate("v")
    
    ' Define a constant
    m_parser.defineConst "pi", 3.14159
    
    
    ' load the Date plugin
    m_parser.loadPlugin "{4C639DCD-2043-42DC-9132-4B5C730855D6}"

    
    Exit Sub

load_error:

    MsgBox "Error: " & getLastExcepText()
       
End Sub

Private Function getLastExcepText() As String

    Dim Msg As String
    Dim e As sMTException
    
    Do
        e = m_parser.getLastExcep()
        If e.excepID <> com_MTExcep_Ok Then
            Msg = Msg + e.Description
            Msg = Msg + vbCrLf
        End If
    Loop Until e.excepID = com_MTExcep_Ok
    
    getLastExcepText = Msg
End Function

Private Sub Benchmark_Click()
    
On Error GoTo benchmark_error

    ' Compile the expression to speed up next evaluations
    m_parser.compile Expr.Text
    
    Dim beginTime As Long, endTime As Long
    
    beginTime = GetTickCount    ' start the timer
    Dim nbEval As Integer
    Dim Result As Double
    nbEvals = 800000
    
    
    For i = 0 To nbEvals
        ' Change variable' values...
        Call m_parser.setVarVal(m_varKeyX, 1)
        Call m_parser.setVarVal(m_varKeyY, 2)
        Call m_parser.setVarVal(m_varKeyZ, 3)
        
        ' Evaluate the expression
        Result = m_parser.evaluateCompiled()
    Next i
    
    endTime = GetTickCount  ' stop the timer
    elapsedTime = endTime - beginTime
    
    Dim nbEvalSec As Long
    Dim timePerEval As Double
    timePerEval = elapsedTime / nbEvals
    nbEvalSec = nbEvals / elapsedTime * 1000
    
    Msg = "Nb. Evaluations: " & nbEvals
    Msg = Msg + Chr$(13) + Chr$(10)
    Msg = Msg + "Elapsed time (ms): " & (elapsedTime)
    Msg = Msg + Chr$(13) + Chr$(10)
    Msg = Msg + "Time per evaluation (ms): " & timePerEval
    Msg = Msg + Chr$(13) + Chr$(10)
    
    Msg = Msg + "Nb. Eval per sec: " & nbEvalSec
    
    Exit Sub
    
benchmark_error:

    Msg = "Error: " & getLastExcepText()
    
    
    

End Sub

Private Sub Evaluate_Click()

On Error GoTo evaluate_error
    
    ' Update the variable' values
    m_parser.setVarVal m_varKeyX, Val(VarX)
    m_parser.setVarVal m_varKeyY, Val(VarY)
    m_parser.setVarVal m_varKeyZ, Val(VarZ)
    
    ' Evaluate the expression with the current variable' values
    Result = m_parser.Evaluate(Expr)
    
    ' Print the used variables
    Dim nbUsedVars As Integer
    nbUsedVars = m_parser.getNbUsedVars
    Dim varKey As sMTVarKey
    Dim str As String
    Msg = "Used variables: "
           
    For t = 0 To nbUsedVars - 1
        varKey = m_parser.getUsedVar(t)
        Msg = Msg + varKey.varName
        If t <> nbUsedVars - 1 Then Msg = Msg & ", "
    Next t
    
    
    Exit Sub
    
evaluate_error:

    Msg = "Syntax error: " & getLastExcepText()
   
End Sub

Private Sub Index_Click()

    Call IndexDlg.SetParser(m_parser)
    Call IndexDlg.Show(1, Form1)

End Sub

Private Sub DefineMacro_Click()
    MacroDefinition.Show 1, Form1
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -