' 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