Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
g = PictureBox1.CreateGraphics
For x = 0 To 5 : chkFPU.SetItemCheckState(x, CheckState.Checked) : Next
' Note: In the current 64-bit implementation of uCalc, functions that involve a function address or delegate,
' such as the ones in this Form1_Load section, are ignored.
' The MyErrorHandler() function will be called whenever and wherever an error (such as "Syntax Error") is raised.
Static d_MyErrorHandler As ucErrorHandlerDelegate = AddressOf MyErrorHandler
ucAddErrorHandler(d_MyErrorHandler)
Static d_MyNumericFormat As ucFunctionDelegate = AddressOf MyNumericFormat
ucSetOutput(d_MyNumericFormat)
' MyArea() returns the product of multiplying the two arguments.
' MyLeft() returns the left-most characters of a string. The second argument represents the number of characters.
' MsgBox() displays a message box. The 1st argument is required. The others are optional.
Static d_MyArea As ucFunctionDelegate = AddressOf MyArea
ucDefineFunction("Native: MyArea(Length, Width)", d_MyArea)
Static d_MyLeft As ucFunctionDelegate = AddressOf MyLeft
ucDefineFunction("Native: MyLeft(Text As String, Count) As String", d_MyLeft)
Static d_Native_MsgBox As ucFunctionDelegate = AddressOf Native_MsgBox
ucDefineFunction("Native: MyMsgBox(Prompt As String, Buttons = 0, Title As String = 'uCalc')", d_Native_MsgBox)
ucDefineSyntax("MsgBox ::= MyMsgBox")
' The three consecutive dots "..." mean that MyAverage can take any number of arguments
' (however, because "x" is specified, there must be at least one argument).
Static d_MyAverage As ucFunctionDelegate = AddressOf MyAverage
ucDefineFunction("Native: MyAverage(x ...)", d_MyAverage)
' Two versions of MyIIF can co-exist peacefully with the same name because
' they are defined with different argument types (numeric vs string).
' By passing the last two arguments ByExpr, the callback can chose to evaluate just one of of them.
Static d_MyIIF_Numeric As ucFunctionDelegate = AddressOf MyIIF_Numeric
ucDefineFunction("Native: MyIIf(cond, ByExpr TruePart, ByExpr FalsePart)", d_MyIIF_Numeric)
Static d_MyIIF_String As ucFunctionDelegate = AddressOf MyIIF_String
ucDefineFunction("Native: MyIIf(cond, ByExpr TruePart As String, ByExpr FalsePart As String) As String", d_MyIIF_String)
' The following defines the "*" operator so that MyString * n returns MyString repeated n times.
' For instance, "He " * 3, would return "He He He". It is arbitrarily set at the same precedence
' level as that of the "*" multiplication operator.
Static d_StringRepeat As ucFunctionDelegate = AddressOf StringRepeat
ucDefineOperator("Native: Precedence('*') {MyString As String} * {Number} As String", d_StringRepeat)
' This definition is for a summation. See the callback ucSum() routine for the
' actual code, which runs a loop that adds up the total for the expression in
' the first argument a number of times based on the second and third arguments.
' For instance Sum(g^2+1, 1, 5, 1, g) returns 60 and Sum(x^2, 1, 10) returns 385.
' The last two arguments are optional, so they default to 1 and x if omitted.
'
' The first argument is passed "ByExpr". So instead of being evaluated before
' being passed to the callback the way an ordinary argument would be, a handle
' for the expression is passed so that the callback can evaluate it (in this
' case numerous times).
'
' The last argument is passed "ByHandle". This causes the callback to receive
' a handle for the variable being passed, in such a way that it can be linked to
' the summation counter and integrated into the expression in the first argument.
'
' The actual function being defined is Sum_(). Then a syntax construct named
' Sum() is defined in such a way that the last argument gets defined as a local
' variable. So if you evaluate Sum(x^2, 5, 10, 1, x), the local "x" in this
' expression will not interfere with a pre-existing variable named x. Also you
' do not need to declare a variable ahead of time to use it as a counter for Sum().
Static d_ucSum As ucFunctionDelegate = AddressOf ucSum
ucDefineFunction("Native: Sum_(ByExpr Expr, Start, Finish, Step, ByHandle Var)", d_ucSum)
ucDefineSyntax("Sum({Expr}, {Start}, {Finish} [, {Step=1} [, {Var=x}]])" _
+ "::= Local({Var}, Sum_({Expr}, {Start}, {Finish}, {Step}, {Var}))")
' The following routine solves an equation.
' The callback code is based on the Bisection Method algorithm.
' The concept here is very similar to that of Sum().
' Two syntax constructs are defined. The second one rearranges the equation
' if it includes an equal sign.
' For instance Solve(x^2 = 9+x) becomes Solve(x^2 - (9+x))
' Solve(x^2 + 1 = 26) returns 5.
' Solve(x^2 + 1 = 26, -1000, 0) returns -5.
Static d_ucSolve As ucFunctionDelegate = AddressOf ucSolve
ucDefineFunction("Native: Solve_(ByExpr Expr, a, b, ByHandle Var)", d_ucSolve)
ucDefineSyntax("Solve({Expr} [, {a=-100000000} [, {b=100000000} [, {Var=x}]]]) " _
+ "::= Local({Var}, Solve_({Expr}, {a}, {b}, {Var}))")
ucDefineSyntax("Solve({Left} = {Right} [, {etc}]) ::= Solve({Left}-({Right}) {etc: , {etc}})")
txtDefine.Text = System.IO.File.ReadAllText("Define.txt")
End Sub
Public Module MyFunctions
Function MyErrorHandler(ByVal t As Integer) As Integer
Static AlreadyDisplayedOnce As Integer
If AlreadyDisplayedOnce = ucFalse Then
MsgBox("See MyErrorHandler for the source code for this uCalc error handler." + vbCr + vbCr _
+ "Bad expression: " + ucErrorExpression(t) + vbCr _
+ "Error handler message: " + ucErrorMessage(0, t) + vbCr _
+ "Offending symbol: " + ucErrorSymbol(t) + vbCr _
+ "Error Location: " + Str(ucErrorLocation(t)) + vbCr + vbCr _
+ "This message box won't be displayed for the next error." + vbCr _
+ "Remove 'AlreadyDisplayedOnce = ucTrue' in the demo source code to change this.")
End If
' Remove the line below if you want the message box to be
' displayed every time there's an error.
AlreadyDisplayedOnce = ucTrue
MyErrorHandler = ucAbort
End Function
Public Sub MyNumericFormat(ByVal Expr As Integer)
Dim Value As String = ucArgStr(Expr, 1)
If Value = "Inf" Or Value = "NaN" Then ucReturnStr(Expr, Value) Else ucReturnStr(Expr, Format$(Val(Value), Form1.cmbNumericFormat.Text))
End Sub
Public Sub MyArea(ByVal Expr As Integer)
Dim MyLength As Double, MyWidth As Double
MyLength = ucArg(Expr, 1)
MyWidth = ucArg(Expr, 2)
If MyLength < 0 Then ucRaiseErrorMessage(Expr, "Length cannot be negative")
If MyWidth < 0 Then ucRaiseErrorMessage(Expr, "Width cannot be negative")
ucReturn(Expr, MyLength * MyWidth)
End Sub
Sub MyIIF_Numeric(ByVal Expr As Integer)
Dim Condition As Double, TruePart As Integer, FalsePart As Integer
Condition = ucArg(Expr, 1)
TruePart = ucArgHandle(Expr, 2)
FalsePart = ucArgHandle(Expr, 3)
If Condition <> 0 Then
ucReturn(Expr, ucEvaluate(TruePart))
Else
ucReturn(Expr, ucEvaluate(FalsePart))
End If
End Sub
Sub MyIIF_String(ByVal Expr As Integer)
Dim Condition As Double, TruePart As Integer, FalsePart As Integer
Condition = ucArg(Expr, 1)
TruePart = ucArgHandle(Expr, 2)
FalsePart = ucArgHandle(Expr, 3)
If Condition <> 0 Then
ucReturnStr(Expr, ucEvaluateStr(TruePart))
Else
ucReturnStr(Expr, ucEvaluateStr(FalsePart))
End If
End Sub
Sub Native_MsgBox(ByVal Expr As Integer)
ucReturn(Expr, MsgBox(ucArgStr(Expr, 1), ucArg(Expr, 2), ucArgStr(Expr, 3)))
End Sub
Sub MyAverage(ByVal Expr As Integer)
Dim x As Integer, Total As Double
For x = 1 To ucArgCount(Expr)
Total = Total + ucArg(Expr, x)
Next
ucReturn(Expr, Total / ucArgCount(Expr))
End Sub
Sub MyLeft(ByVal Expr As Integer)
ucReturnStr(Expr, Left$(ucArgStr(Expr, 1), ucArg(Expr, 2)))
End Sub
Sub StringRepeat(ByVal Expr As Integer)
Dim x As Integer, TotalString As String = ""
For x = 1 To ucArg(Expr, 2)
TotalString = TotalString + ucArgStr(Expr, 1)
Next
ucReturnStr(Expr, TotalString)
End Sub
Sub ucSum(ByVal Expr As Integer)
Dim Expression As Integer, VarHandle As Integer
Dim Start As Integer, Finish As Integer, sStep As Integer
Dim x As Double, Total As Double
Expression = ucArgHandle(Expr, 1)
Start = ucArg(Expr, 2)
Finish = ucArg(Expr, 3)
sStep = ucArg(Expr, 4)
VarHandle = ucArgHandle(Expr, 5)
For x = Start To Finish Step sStep
ucSetVariableValue(VarHandle, x)
Total = Total + ucEvaluate(Expression)
Next
ucReturn(Expr, Total)
End Sub
Sub ucSolve(ByVal Expr As Integer)
Dim Expression As Integer, Variable As Integer, Iterations As Integer
Dim a As Double, b As Double, fa As Double, fb As Double
Dim Value As Double, tmp As Double
Expression = ucArgHandle(Expr, 1)
a = ucArg(Expr, 2)
b = ucArg(Expr, 3)
Variable = ucArgHandle(Expr, 4)
ucSetVariableValue(Variable, a) : fa = ucEvaluate(Expression)
ucSetVariableValue(Variable, b) : fb = ucEvaluate(Expression)
If fb < fa Then tmp = a : a = b : b = tmp 'swap a, b
Do While Math.Abs(b - a) > 0.000000000000001
ucSetVariableValue(Variable, (a + b) / 2)
Value = ucEvaluate(Expression)
If Value = 0 Then a = (a + b) / 2 : Exit Do
If Value < 0 _
Then a = (a + b) / 2 _
Else b = (a + b) / 2
Iterations = Iterations + 1
If Iterations = 100 Then Exit Do
Loop
If Math.Abs(Value) > 0.0000000001 Then ucRaiseErrorMessage(Expr, "Solution not found")
ucReturn(Expr, a)
End Sub
Sub Test(ByVal Expr As String, ByVal Answer As String, Optional ByVal t As Long = 0)
If Answer <> ucEvalStr(Expr, t) Then MsgBox(Expr + Chr(10) + ucEvalStr(Expr, t) + Chr(10) + Answer)
End Sub
Sub TestExpand(ByVal Expr As String, ByVal Answer As String, Optional ByVal t As Long = 0)
If Answer <> ucExpand(Expr, t) Then MsgBox(Expr + Chr(10) + ucExpand(Expr, t) + Chr(10) + Answer)
End Sub
End Module