Evaluate Math expressions in VB6


vb6 script control
deadline online
how to find roots
numerical methods
find roots in vb6
symbolic derivation
plot graphs
' Visual Basic 6 module
'-------------------------- Evaluate.bas ---------------------------
' Evaluate Math expressions using VB Script Control
' Add from Project / References 
' Microsoft Script Control 1.0 (msscript.ocx)
'-------------------------- Evaluate.bas ---------------------------
' Copyright Ionut Alex. Chitu, http://deadline.3x.ro
'
Option Explicit 'always use this option in vb
Private Script As ScriptControl

Public Sub Init_Script()
' Call Init_Script on main form's Form_Load event
	On Error Resume Next
	Set Script = New ScriptControl
	Dim Math_functions As Res
	Set Math_functions = New Res
	Script.Language = "vbscript"
	Script.AddObject "Math", Math_functions, True
	Script.ExecuteStatement ("set_constants")
End Sub

Public Function Evaluate(ByVal s As String, _
ByVal x As Double, ByRef Function_Error As Integer) As Double
' For example: value = Evaluate("sin(x)+cos(2*x)", -1, err)   
	On Error GoTo Error_Message
	Script.ExecuteStatement ("set_variable(" & Str$(x) & ")")
	Evaluate = Script.Eval(s)
	Function_Error = Script.Eval("error")
	Exit Function
	Error_Message:
	Evaluate = 0
	Select Case Script.Error.Number
		Case 11
		Function_Error = 7 ' division by 0
		Case 6
		Function_Error = 8 ' overflow
		Case Else
		Function_Error = 9 ' evaluation error
	End Select
End Function


' Visual Basic 6 class
'-------------------------- Res.cls ---------------------------
' Extension for the evaluation script
' New functions : sqrt,frac,asin,acos,atan,sinh,cosh,tanh
' New constants : pi,e
' You can add constants and functions in this class

Option Explicit
Option Compare Binary
Public pi As Double, e As Double
Public x As Double, error As Integer
Private Const eps  As Double = 0.000000000001

Public Sub set_constants()
	pi = 3.14159265358979
	e = 2.71828182845905
End Sub

Public Sub set_variable(ByVal value As Double)
	x = value
	error = 0
End Sub

Public Function sqrt(ByVal p As Double) As Double
	If p >= 0 Then
		sqrt = Sqr(p)
	Else
		sqrt = 0
		error = 4
	End If
End Function

Public Function frac(ByVal p As Double) As Double
	frac = p - Int(p)
End Function

Public Function asin(ByVal p As Double) As Double
	If (p > -1) And (p < 1) Then
		asin = Atn(p / Sqr(1 - p * p))
	ElseIf p = -1 Then
		asin = -pi * 0.5
	ElseIf p = 1 Then
		asin = pi * 0.5
	Else
		error = 5
	End If
End Function

Public Function acos(ByVal p As Double) As Double
	If (p > 0) And (p <= 1) Then
		acos = Atn(Sqr(1 - p * p) / p)
	ElseIf (p < 0) And (p >= -1) Then
		acos = Atn(Sqr(1 - p * p) / p) + pi
	ElseIf p = 0 Then
		acos = pi / 2
	Else
		error = 6
	End If
End Function

Public Function atan(ByVal p As Double) As Double
	atan = Atn(p)
End Function

Public Function sinh(ByVal p As Double) As Double
	sinh = (Exp(p) - Exp(-p)) / 2
End Function

Public Function cosh(ByVal p As Double) As Double
	cosh = (Exp(p) + Exp(-p)) / 2
End Function

Public Function tanh(ByVal p As Double) As Double
	Dim p1 As Double, p2 As Double
	p1 = Exp(p)
	p2 = Exp(-p)
	tanh = (p1 - p2) / (p1 + p2)
End Function

DeadLine OnLine - free equation solver. Copyright 2003-2007 Ionut Alex. Chitu. | Contact | Sitemap