by Muhammad Shaban Jokhio (1 Submission)
Category: Math/Dates
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Wed 27th February 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
A Complete Expression Analyzer to evaluate all types of expressions and plot their function graphically
VBcoders
'I hope it has no mistake (I am takling about logical error, not the syntex errors).
'17/7/2K. I started this project yesterday.
'Today I have included the error tracing routine too, that will identify almost all the errors 18/6/2K.
'Its 21/7/2K and I am still working on this project. I was wrong, it had lots of errors -syntex errors and
'a logical error that it could not control +ve or -ve numbers. Today it is also capable to solve the
'unary functions like factorial, Insha-Allah tomorrow I will make it capable of handling almost all the
'scientific functions, then my target will be to ficilitate for a variable and then plot a result depading
'on that variable.
'First of all I thank my God who made me capable to write this program. 24/7/2K.
'Its 9th day that I have been working on this project, after such a hard work I have been able to
'make this program so that it can solve any aritimatic expression of any complexity. Now it can solve different
'functions also, with a capablity to handle very large (it means very large) number of syntext errors, there might
'be any syntex, though being incorrect, can be accepted by this program, if so I will be really sorry for that.
'I think it is almost complete, although I will be working on it to give it more and more functionality and capablities
'but my aim to give this program the basic functionality to solve the arithimatic and basic scientific expressions has been accomplished.
'One of its drawbacks is that it uses too much variables, so I would like to reduce and try to do some other fine tunings.
'28/7/2K, today I found the solution to the problem of improper fractions.
'9/9/2K. Today I solved problem with the power. Previous it gave wrong results with 2*3^4.
'10/9/2K. Today I solved the problem with factorial. It produced error with sin(0)!.
'13/9/2K. I hope I have completed this program (or may be not) but atleast for the competition.
'I hope it would not have a major error. Now it can plot the graphs too.
'21/11/2K. Today I won the first prize in the "All Pakistan Software Competition" at Sindh University.
' I am really happy and thankful to my God who gave me this much honour.
Option Explicit
Dim expression1 As String, expression2 As String, expression As String, ans As String
Dim subresult As Double
Dim operand1 As Boolean, operand2 As String, operator As String
Dim leftend As Integer, rightend As Integer, unary_operator_location As Integer, plot_graph As Boolean
Dim tracing_performed As Boolean, escape As Boolean, variable_solution As Boolean, color As Variant
Private Sub clear_Click()
Picture1.Cls
MSFlexGrid1.clear
expressions.clear
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
startvalue = ""
stopvalue = ""
stepvalue = ""
Text5 = ""
End Sub
Private Sub Command4_Click()
frm2_ExpAnalyz.Hide
frm1_MainForm.Show
End Sub
Private Sub Exit1_Click()
Unload Me
End Sub
Private Sub expressions_Click()
Text1 = expressions.List(expressions.ListIndex)
End Sub
Private Sub expressions_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Form_Load()
color = vbRed
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
MSFlexGrid1.ColWidth(0) = 1500
MSFlexGrid1.ColWidth(1) = 1835
Option1.Value = True
Option3.Value = True
Check1.Value = vbChecked
End Sub
Private Sub startvalue_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text1_KeyPress (KeyAscii)
End Sub
Private Sub stepvalue_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text1_KeyPress (KeyAscii)
End Sub
Private Sub stopvalue_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text1_KeyPress (KeyAscii)
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Load_Click()
Dim line_of_expression As String
expressions.clear
CommonDialog1.Filter = "Expression Files|*.Exp"
CommonDialog1.Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
Form1.MousePointer = 11
Open CommonDialog1.FileName For Input As #1
Do Until EOF(1)
Line Input #1, line_of_expression
expressions.AddItem line_of_expression
Loop
Form1.MousePointer = 0
Close #1
Exit Sub
End If
End Sub
Private Sub Option3_Click()
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Option3.Value = True
Text5.Enabled = True
startvalue.Enabled = False
stopvalue.Enabled = False
stepvalue.Enabled = False
Label5.Enabled = False
Label6.Enabled = False
Label7.Enabled = False
Label8.Enabled = False
Label9.Enabled = True
End Sub
Private Sub Option4_Click()
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Option4.Value = True
Text5.Enabled = False
startvalue.Enabled = True
stopvalue.Enabled = True
stepvalue.Enabled = True
Label5.Enabled = True
Label6.Enabled = True
Label7.Enabled = True
Label8.Enabled = True
Label9.Enabled = False
End Sub
Private Sub Save_Click()
On Error GoTo errorhandler:
If Trim(Text1) = "" Then MsgBox "No expression to save. Sorry!", vbExclamation: Exit Sub
CommonDialog1.Filter = "Expression Files|*.Exp"
CommonDialog1.Flags = cdlOFNCreatePrompt Or cdlOFNNoReadOnlyReturn Or cdlOFNPathMustExist Or cdlOFNHideReadOnly
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Append As #1
Print #1, Text1
Close #1
errorhandler:
If Err.Number = 32755 Then Exit Sub
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer) 'Equation editor's key press event
Dim traced_result As Boolean
If KeyAscii = 13 Then 'If hit Enter
If Trim(Text1.Text) = "" Then MsgBox "Please first enter some expression.", vbExclamation: Text2.Text = "": Text3.Text = "": KeyAscii = 0: Exit Sub
Text1.Text = Trim(Text1.Text) 'Remove the unnecessary spaces from left and right of expression
KeyAscii = 0 'Simulate that no Enter key has been entered, otherwise computer will beeb (through soundcard), because
traced_result = error_tracer 'multiline property of text box is false so pressing Enter is not allowed.
If Not (traced_result) Then tracing_performed = True: Solve_Click 'If no error found then proceed with solution.
ElseIf KeyAscii = 27 Then Text1 = ""
End If
tracing_performed = False
End Sub
Private Sub Solve_Click() 'Main routine that recognizes the brackets and breaks the main
Dim countr As Integer 'expression according to the brackets. It works on the principle that it finds the left brackets
Dim leftbracket As Integer, rightbracket As Integer 'and keeps updating the location for the new left brackets, as soon as it
Dim bracketsolution As String 'finds any right bracket it sends that segment to the next functions to process.
Dim traced_result As Boolean 'Error routine's return(whether run this routine or not), because text1_keypress calls this routine
Dim cha As String
On Error Resume Next
escape = False
If Not (tracing_performed) Then 'which also calls the error tracing routine, so calling again the error tracing routine is just the wastage of processing time.
Text1.SetFocus
If Text1.Text = "" Then MsgBox "Please first enter some expression.", vbExclamation: Text2.Text = "": Text3.Text = "": Exit Sub
Text1.Text = Trim(Text1.Text)
traced_result = error_tracer
If traced_result Then Exit Sub 'if true i.e. there is some syntex error then exit this sub
If Trim(Text1.Text) = "" Then MsgBox "Please first enter some expression.", vbExclamation: Text2.Text = "": Text3.Text = "": Exit Sub
End If
If Not (variable_solution) Then
For countr = 1 To Len(Text1)
If Mid(Text1, countr, 1) = "x" Then
If countr > 1 And Mid(Text1, countr - 1, 1) <> "e" Then
variable_solution = True
variable_solver
Exit Sub
ElseIf countr = 1 Then
variable_solution = True
variable_solver
Exit Sub
End If
End If
Next
End If
countr = 0
Form1.MousePointer = 11 'Show the wait pointer, indicating the processing.
Text2 = ""
If Not (variable_solution) Then hidden.Text = "(" & Text1.Text & ")" 'Hidden is a text box in which all the processings will be performed.
While countr < Len(hidden.Text)
countr = countr + 1
cha = Mid$(hidden.Text, countr, 1)
If (cha = "+" Or cha = "-") And (Mid(hidden.Text, countr + 1, 1) = "+" Or Mid(hidden.Text, countr + 1, 1) = "-") Then 'in case of two operator multiplication ++, +-, -+, --
If (cha = Mid$(hidden.Text, countr + 1, 1)) Then cha = "+" Else cha = "-"
hidden.SelStart = countr - 1
hidden.SelLength = 2
hidden.SelText = cha
ElseIf cha = "(" Then 'finding the left bracket
leftbracket = countr 'updating for the rightmost left bracket
ElseIf cha = ")" Then 'Finding the leftmost right bracket so it will find (4/3) out of 3*(4+(4/3)). i.e. left most right bracket and right most left bracket.
rightbracket = countr
hidden.SelStart = leftbracket - 1 'Starting the selection form the left bracket
hidden.SelLength = rightbracket - leftbracket + 1 'Selecting upto the right bracket
bracketsolution = expressionanalyser(hidden.Text, leftbracket, rightbracket) 'Enquiring the solution from the function.
If escape Then Form1.MousePointer = 0: Exit Sub
hidden.SelText = bracketsolution 'replacing the answer with the aceuireq answer.
If leftbracket = 1 Then
Text3.Text = Val(hidden.Text)
Form1.MousePointer = 0
Exit Sub
End If
leftbracket = 0 'Making the routine to find the expre: from the begining for the begining.
rightbracket = 0
countr = 0
Else
End If
Wend
tracing_performed = False
End Sub
Private Sub variable_solver()
Dim counter1 As Double, counter2 As Double, counter3 As Double, t As Double
Dim xmin As Double, xmax As Double, ymin As Double, ymax As Double, xpixels As Integer
If Option3.Value Then
Picture1.Cls
MSFlexGrid1.clear
If Trim(Text5) = "" Then
MsgBox "Please first enter some value of x.", vbExclamation
variable_solution = False
Exit Sub
ElseIf Not (IsNumeric(Text5)) Then
MsgBox "Please enetr only numeric values.", vbCritical
variable_solution = False
Exit Sub
End If
hidden = "(" & Text1 & ")"
counter2 = 1
While counter2 <= Len(hidden)
If Mid(hidden, counter2, 1) = "x" Then
If counter2 > 1 And Mid(hidden, counter2 - 1, 1) <> "e" Then
hidden.SelStart = counter2 - 1
hidden.SelLength = 1
hidden.SelText = Text5
ElseIf counter2 = 1 Then
hidden.SelStart = counter2 - 1
hidden.SelLength = 1
hidden.SelText = Text5
End If
End If
counter2 = counter2 + 1
Wend
Solve_Click
variable_solution = False
Exit Sub
Else
counter3 = 1
If Trim(startvalue) = "" Or Trim(stopvalue) = "" Or Trim(stepvalue) = "" Then
MsgBox "Please first enter the range or variable.", vbExclamation
variable_solution = False
Exit Sub
ElseIf Not (IsNumeric(startvalue)) Or Not (IsNumeric(stopvalue)) Or Not (IsNumeric(stepvalue)) Then
MsgBox "Please enter only numeric values.", vbCritical
variable_solution = False
Exit Sub
ElseIf stepvalue = "0" Then
MsgBox "Difference should not be zero.", vbCritical
variable_solution = False
Exit Sub
ElseIf stopvalue - startvalue < 0 And stepvalue > 0 Then
MsgBox "Please enter descending difference.", vbCritical
variable_solution = False
Exit Sub
ElseIf stopvalue - startvalue > 0 And stepvalue < 0 Then
MsgBox "Please enter ascending difference.", vbCritical
variable_solution = False
Exit Sub
End If
MSFlexGrid1.Rows = (stopvalue - startvalue) / stepvalue + 2
MSFlexGrid1.Cols = 2
For counter1 = startvalue To stopvalue Step stepvalue
hidden = "(" & Text1 & ")"
counter2 = 1
plot_graph = True
While counter2 <= Len(hidden)
If Mid(hidden, counter2, 1) = "x" Then
If counter2 > 1 And Mid(hidden, counter2 - 1, 1) <> "e" Then
hidden.SelStart = counter2 - 1
hidden.SelLength = 1
hidden.SelText = counter1
ElseIf counter2 = 1 Then
hidden.SelStart = counter2 - 1
hidden.SelLength = 1
hidden.SelText = counter1
End If
End If
counter2 = counter2 + 1
Wend
Solve_Click
If escape Then variable_solution = False: Exit Sub
MSFlexGrid1.TextMatrix(counter3, 0) = Format(counter1, ".000")
MSFlexGrid1.TextMatrix(counter3, 1) = Format(Text3, ".000")
Text3 = ""
tracing_performed = True
counter3 = counter3 + 1
Next
End If
variable_solution = False
MSFlexGrid1.TextMatrix(0, 0) = "x"
MSFlexGrid1.TextMatrix(0, 1) = "f(x)"
graph
End Sub
Function error_tracer() As Boolean 'This is the most complicated routine that find the errors.
Dim point_identifier As Boolean 'This routine works on the principle that it has flags(indicators) for different symbols, so if
Dim right_bracket_identifier As Boolean 'some symbol appears then that particular falg becomes true as if point(".") has been found in
Dim left_bracket_identifier As Boolean 'a number then point_identifier becomes true and would not false unless routine finds an operator
Dim operator_identifier As Boolean 'it means that now an other number will be entered, now operator_identifier will become true and remaint
Dim empty_bracket As Boolean 'that unless a number is not entered and so on. This is the logic according to which it traces all the errors.
Dim unary_operator_identifier As Boolean, number_identifier As Boolean, variable_identifier As Boolean
Dim leftcounter As Integer
Dim counter4 As Integer
Dim character As String 'This is for extracting a character and then whole tracing will performed on this character.
Dim error_location As Integer
Dim cha As String
On Error Resume Next 'This is the due to the error which will be produced due to assignment of cha when counter4=1, as prog: will try to extract char: at zero location.
Text1.Text = LCase(Text1.Text)
While (counter4 < Len(Text1.Text)) 'This routine is for removing the extra spaces and it finds the problems with brackets.
counter4 = counter4 + 1
character = Mid(Text1.Text, counter4, 1)
If character = "(" Then
leftcounter = leftcounter + 1
ElseIf character = ")" Then
If leftcounter = 0 Then MsgBox "Brackets misorderly placed", vbInformation: Text1.SelStart = counter4 - 1: Text1.SelLength = 1: error_tracer = True: Exit Function Else leftcounter = leftcounter - 1
ElseIf character = " " Or character = Chr(9) Then Text1.SelStart = counter4 - 1: Text1.SelLength = 1: Text1.SelText = "": counter4 = counter4 - 1
End If
Wend
If leftcounter > 0 Then 'This completes the brackets, not provided by the user.
For counter4 = leftcounter - 1 To 0 Step -1
Text1.Text = Text1.Text + ")"
Next
End If
counter4 = 0
error_location = 0
leftcounter = 0
operator_identifier = True
While (counter4 < Len(Text1.Text)) 'Process for misceleneous errors.
counter4 = counter4 + 1
character = Mid$(Text1.Text, counter4, 1) 'Pick a character to analyze.
If (Asc(character) > 96 And Asc(character) < 123) And character <> "x" Then 'Check that if it is a alphabatic character.
cha = Mid$(Text1.Text, counter4, 3) 'If so then pick three characters from strating location.
If cha = "sin" Or cha = "cos" Or cha = "tan" Or cha = "cot" Or cha = "sec" Or cha = "csc" Or cha = "log" Or cha = "exp" Then 'if these are function names.
If Mid(Text1, counter4 + 3, 1) <> "(" Then
error_location = counter4 + 3
ElseIf operator_identifier And point_identifier And Not (number_identifier) Then 'error like 3+.sin4
error_location = counter4 - 1
ElseIf ((number_identifier Or variable_identifier) And Not (left_bracket_identifier)) Or (Not (number_identifier) And Not (variable_identifier) And right_bracket_identifier) Then '4Sin3 should be 4*Sin3 so auto convert it, but condition is there should be a number but no left bracket.
Text1.SelStart = counter4 - 1 'The above statement is for the case )sin3 which should be written as )*sin3
Text1.SelLength = 0
Text1.SelText = "*"
unary_operator_location = counter4 + 1
counter4 = counter4 + 3
point_identifier = False
right_bracket_identifier = False
ElseIf unary_operator_identifier And Not (number_identifier) Then 'Error like SinCos4, no operand given for sin or Cos4 not enclosed in brackets.
error_location = counter4
Else
unary_operator_location = counter4
counter4 = counter4 + 2
point_identifier = False
End If
unary_operator_identifier = True
number_identifier = False
variable_identifier = False
Else
error_location = counter4 'Some symbol or word alien to the program has been entered like Tin.
End If
ElseIf character = "+" Or character = "-" Or character = "*" Or character = "/" Or character = "^" Then 'error like **,//,+*,-/ etc.
If counter4 = Len(Text1.Text) Then ' Some one has given operator at the end of expression like 3*(5/6)+
error_location = counter4
ElseIf unary_operator_identifier And point_identifier And Not (number_identifier) Then error_location = counter4 'error like Sin.*
ElseIf right_bracket_identifier And point_identifier And Not (number_identifier) Then error_location = counter4 - 1 'error like ).+
ElseIf operator_identifier Or left_bracket_identifier Then 'if an operator or a left bracket has already been given like in case of **,(*
cha = Mid$(Text1.Text, counter4 - 1, 1) 'extract a character just one behind the already extracted character.
If counter4 = 1 And (character = "+" Or character = "-") Then 'an operator just at the begining of expre: is allowed as it is + or -, denotion .
ElseIf counter4 <> 1 And (character = "+" Or character = "-") And (cha = "(" Or cha = "*" Or cha = "/" Or cha = "^" Or unary_operator_identifier) Then 'if + or - appears anywhere, where there is *,/ or sin etc.( on the left of it then it is
Else 'allowed as it denotes a +ve or -ve number, like in 4*-3, 4*(-3+4)
error_location = counter4 'If such is not the case then there is an error like **, (* etc.
End If
ElseIf unary_operator_identifier And Not (number_identifier) Then 'a function like sin etc, has been used but no argument has been given.
error_location = counter4
Else 'Otherwise there is no error, i.e. is there is no operator or left bracket then its all right.
number_identifier = False
variable_identifier = False
operator_identifier = True
point_identifier = False
right_bracket_identifier = False
unary_operator_identifier = False
unary_operator_location = 0
End If
ElseIf character = "x" Then
'If number_identifier And Not (operator_identifier) Then
' Text1.SelStart = counter4 - 1: Text1.SelLength = 0: Text1.SelText = "*": counter4 = counter4 + 1
If variable_identifier Then
error_location = counter4 - 1
ElseIf operator_identifier And point_identifier And Not (number_identifier) Then 'error like 3+.sin4
error_location = counter4 - 1
ElseIf (number_identifier And Not (left_bracket_identifier)) Or (Not (number_identifier) And right_bracket_identifier) Then '4Sin3 should be 4*Sin3 so auto convert it, but condition is there should be a number but no left bracket.
Text1.SelStart = counter4 - 1 'The above statement is for the case )sin3 which should be written as )*sin3
Text1.SelLength = 0
Text1.SelText = "*"
unary_operator_location = counter4 + 1
counter4 = counter4 + 1
point_identifier = False
right_bracket_identifier = False
variable_identifier = True
Else
variable_identifier = True
point_identifier = False
left_bracket_identifier = False
operator_identifier = False
End If
ElseIf (Asc(character) > 47 And Asc(character) < 58) Then
If variable_identifier And Not (operator_identifier) Then
error_location = counter4 - 1
Else
left_bracket_identifier = False 'next line will convert )4 to )*4
number_identifier = True
If right_bracket_identifier = True Then Text1.SelStart = counter4 - 1: Text1.SelLength = 0: Text1.SelText = "*": counter4 = counter4 + 1 Else operator_identifier = False
End If
ElseIf character = "." Then 'error like 4.., 4.4.,233.323. i.e. repeatation of .
If point_identifier = True Then error_location = counter4 Else point_identifier = True
ElseIf character = "(" Then
If point_identifier And operator_identifier Then 'if such is the case +.(
error_location = counter4
ElseIf variable_identifier Then
If point_identifier Then
error_location = counter4 - 1
Else
Text1.SelStart = counter4 - 1
Text1.SelLength = 0
Text1.SelText = "*"
counter4 = counter4 + 1
variable_identifier = False
leftcounter = leftcounter + 1
End If
Else
leftcounter = leftcounter + 1 'count the left brackets
left_bracket_identifier = True 'the next line converts 5( into 5*(
unary_operator_location = 0
unary_operator_identifier = False
right_bracket_identifier = False
If counter4 <> 1 Then
If Not (operator_identifier) And Not (Asc(Mid(Text1.Text, counter4 - 1, 1)) > 96 And Asc(Mid(Text1.Text, counter4 - 1, 1)) < 123) Then Text1.SelStart = counter4 - 1: Text1.SelLength = 0: Text1.SelText = "*": counter4 = counter4 + 1
End If
End If
ElseIf character = ")" Then
If Mid$(Text1.Text, counter4 - 1, 1) = "(" Then 'the condition is ()
error_location = counter4 - 1
empty_bracket = True
ElseIf leftcounter = 0 Or (unary_operator_identifier And Not (number_identifier)) Then 'No "(" has been use previously like 4*)/4 etc.
error_location = counter4
ElseIf operator_identifier Then
error_location = counter4 - 1 'errors like *), /), +), -)
Else
point_identifier = False
variable_identifier = False
number_identifier = False
leftcounter = leftcounter - 1
right_bracket_identifier = True
unary_operator_identifier = False
unary_operator_location = 0
End If
ElseIf character = "!" Then
If operator_identifier Or left_bracket_identifier Then
error_location = counter4
ElseIf unary_operator_identifier Then
counter4 = counter4 + 2
unary_operator_location = 0
End If
Else
error_location = counter4 'Means some restricted sybmols have been entered.
End If
If error_location <> 0 Then counter4 = Len(Text1.Text) 'if some error has been traced then exit loop
Wend
If error_location > 0 Then
Text1.SelStart = error_location - 1
Text1.SelLength = 1
If empty_bracket Then MsgBox "Empty bracket", vbInformation, Me.Caption Else MsgBox "A syntex error at the highlighted location.", vbInformation, Me.Caption
error_tracer = True
Else
error_tracer = False 'Did not find any error.
End If
unary_operator_location = 0
End Function
Function expressionanalyser(miniexpression As String, leftmargin As Integer, rightmargin As Integer) As String
expression1 = ""
expression2 = ""
ans = ""
subresult = 0
operand2 = ""
operator = ""
operand1 = False
leftend = 0
expression1 = Mid$(miniexpression, leftmargin + 1, rightmargin - (leftmargin + 1)) & "@" 'This is to indicate the end of the expression
If IsNumeric(left(expression1, Len(expression1) - 1)) Then expressionanalyser = left(expression1, Len(expression1) - 1): Exit Function
If Check1 = vbChecked Then Text2.SelText = vbCrLf + left(expression1, Len(expression1) - 1) & vbCrLf & vbCrLf
firstpass 'First step solution of the expression
If escape Then Exit Function
If IsNumeric(Mid(expression2, 1, Len(expression2) - 1)) Then expressionanalyser = Mid(expression2, 1, Len(expression2) - 1): Exit Function
thirdpass
expressionanalyser = ans
If Check1 = vbChecked Then Text2.SelText = "____________________________"
End Function
Sub firstpass()
Dim multiplication_result As String, cha As String
Dim counter As Integer, left As Integer, right As Integer
Dim x As Integer, dummy_operator As String * 1
On Error Resume Next
expression2 = ""
If InStr(expression1, "+") = 0 And InStr(expression1, "-") = 0 Then
expression2 = secondpass(0, Len(expression1)) & "@"
operand1 = False
subresult = 0 'operand1 = "" 'Reinitialize the operands and operator so that thay
operand2 = "" 'can be used for processing the next segment of the expression.
operator = ""
Exit Sub
End If
For counter = 1 To Len(expression1)
If Mid$(expression1, counter, 1) = "+" Or Mid$(expression1, counter, 1) = "-" Or Mid$(expression1, counter, 1) = "@" Then 'If found +,-
If counter <> 1 Then
cha = Mid(expression1, counter - 1, 1)
If cha = "*" Or cha = "/" Or cha = "^" Or ((Asc(cha) > 96 And Asc(cha) < 123) Or cha = "E") Then 'If found *,/,^ or sin etc. then + or - is showing +ve or -ve respectively, so leave it.
Else 'Else if it is acting as binary operator then
right = counter
multiplication_result = secondpass(left, right)
If escape Then Exit Sub
dummy_operator = Mid(expression2, Len(expression2), 1)
If dummy_operator = "+" Or dummy_operator = "-" Then
If dummy_operator = "+" And multiplication_result >= 0 Then
ElseIf dummy_operator = "+" And multiplication_result < 0 Then
expression2 = Mid(expression2, 1, Len(expression2) - 1) & "-"
ElseIf dummy_operator = "-" And multiplication_result >= 0 Then
ElseIf dummy_operator = "-" And multiplication_result < 0 Then
expression2 = Mid(expression2, 1, Len(expression2) - 1) & "+"
End If
multiplication_result = Abs(multiplication_result)
End If
expression2 = expression2 & multiplication_result & Mid(expression1, counter, 1) 'Make the new expression
left = counter 'Updating left to the new value.
operand1 = False
subresult = 0 'Reinitialize the operands and operator so that thay
operand2 = "" 'can be used for processing the next segment of the expression.
operator = ""
End If
End If
End If
Next
If Check1 = vbChecked Then Text2.SelText = vbCrLf + Mid(expression2, 1, Len(expression2) - 1) + vbCrLf + vbCrLf
End Sub
Function secondpass(left As Integer, right As Integer)
Dim exponent_result As String, expression3 As String
Dim counter As Integer
Dim x As Integer
leftend = left
If (InStr(left + 1, expression1, "*") > left And InStr(left + 1, expression1, "*") < right) Or (InStr(left + 1, expression1, "/") > left And InStr(left + 1, expression1, "/") < right) Then
For counter = left + 1 To right
If Mid$(expression1, counter, 1) = "*" Or Mid$(expression1, counter, 1) = "/" Or counter = right Then 'Mid$(expression1, counter, 1) = "-" Or Mid$(expression1, counter, 1) = "+" Or Mid$(expression1, counter, 1) = "@" Then 'If found +,-
rightend = counter
If IsNumeric(Mid(expression1, leftend + 1, rightend - (leftend + 1))) Then
exponent_result = Mid(expression1, leftend + 1, rightend - (leftend + 1))
Else
If Check1 = vbChecked Then Text2.SelText = " " + Mid(expression1, leftend + 1, rightend - (leftend + 1)) & "="
exponent_result = solver(expression1)
If Check1 = vbChecked Then Text2.SelText = exponent_result & vbCrLf
End If
If escape Then Exit Function
expression3 = expression3 & exponent_result & Mid(expression1, counter, 1) 'Make the new expression
leftend = counter 'Updating leftend to the new value.
operand1 = False
subresult = 0 'Reinitialize the operands and operator so that thay
operand2 = "" 'can be used for processing the next segment of the expression.
operator = ""
End If
Next
Else
expression3 = Mid(expression1, left + 1, right - (left + 1))
If IsNumeric(expression3) Then secondpass = expression3: Exit Function
End If
If IsNumeric(Mid(expression3, Len(expression3), 1)) Then
If Check1 = vbChecked Then Text2.SelText = " " + Mid(expression3, 1, Len(expression3)) & "="
Else
If Check1 = vbChecked Then Text2.SelText = " " + Mid(expression3, 1, Len(expression3) - 1) & "="
End If
leftend = 0
If Mid(expression3, Len(expression3), 1) <> "@" Then expression3 = expression3 & "@"
rightend = Len(expression3)
secondpass = solver(expression3)
If Check1 = vbChecked Then Text2.SelText = secondpass & vbCrLf
End Function
Sub thirdpass()
Dim finalans As String
leftend = 0
rightend = Len(expression2)
ans = solver(expression2)
If Check1 = vbChecked Then Text2.SelText = ans + vbCrLf
End Sub
Function solver(expre As String) As String
Dim counter2 As Integer
Dim operand_location As Integer
Dim cha As String, cha2 As String
On Error Resume Next
expression = expre
operand_location = leftend + 1
For counter2 = leftend + 1 To rightend 'Process with in the specified limits of expression.
cha = Mid$(expression, counter2, 1) 'Pick a character to process.
If counter2 > 1 Then cha2 = Mid$(expression, counter2 - 1, 1) 'If it is not the begining of the expression then pick one character that will be an operator.
If (Asc(cha) > 96 And Asc(cha) < 123) And unary_operator_location = 0 Then unary_operator_location = counter2 'Sin, Cos etc. found.
If cha = "*" Or cha = "/" Or cha = "-" Or cha = "+" Or cha = "^" Or cha = "@" Then
If (cha = "-" Or cha = "+") And (counter2 = 1 Or cha2 = "*" Or cha2 = "^" Or cha2 = "/" Or cha2 = "E" Or (Asc(cha2) > 96 And Asc(cha2) < 123)) Then 'the + or - is howing +ve or -ve.
Else
solver = evaluate(operand_location, counter2, expression)
If escape Then Exit Function 'Fatal error occured in calculations.
operand_location = counter2 + 1
End If
End If
Next
If solver = "" Then solver = Mid$(expression, leftend + 1, rightend - (leftend + 1))
End Function
Function evaluate(subleft As Integer, suboperator_location As Integer, expression As String) As String
Dim next_operator As String
Dim unary_result As String
On Error GoTo troubleshooter
If unary_operator_location > 0 Then
unary_result = unary_operator(suboperator_location)
If unary_operator_location > 1 Then
If Mid(expression, unary_operator_location - 1, 1) = "-" Then unary_result = unary_result * -1
End If
unary_operator_location = 0 'If a unary operator has been found then call func: for its sol:
End If
If Mid(expression, suboperator_location - 1, 1) = "!" And unary_operator_location = 0 Then unary_result = Str(factorial(Val(Mid$(expression, subleft, suboperator_location - subleft - 1))))
If escape Then Exit Function
If Not (operand1) Then 'Here subresult is working as operand1, so suppose that operand1 is being extracted. If no operand1 has been extracted previously then
operand1 = True
If unary_result = "" Then subresult = Val(Mid$(expression, subleft, suboperator_location - subleft)) Else subresult = Val(unary_result) 'if unary_result is empty, it means that operand was just a number so extract it.
operator = Mid$(expression, suboperator_location, 1) 'pick the next operator.
If suboperator_location = rightend Then evaluate = subresult 'if the location of the next operator is equal to right end then there is no other operand b/w the processing limits, that has already been extracted so return it as the value of func.
Exit Function
End If
If unary_result = "" Then operand2 = Mid$(expression, subleft, suboperator_location - subleft) Else operand2 = unary_result
next_operator = Mid$(expression, suboperator_location, 1)
If operator = "+" Then
subresult = subresult + Val(operand2)
ElseIf operator = "-" Then
subresult = subresult - Val(operand2)
ElseIf operator = "*" Then
subresult = subresult * Val(operand2)
ElseIf operator = "/" Then
subresult = subresult / Val(operand2)
ElseIf operator = "^" Then
subresult = subresult ^ Val(operand2)
End If
evaluate = subresult
operator = next_operator
Exit Function
troubleshooter:
If Err = 11 Then
MsgBox "Division by zero has occured in the expression.", vbCritical
ElseIf Err = 5 Then
MsgBox "Invalid argument, passed to the function or operator.", vbCritical, Me.Caption
ElseIf Err = 6 Then
MsgBox "Sorry, calculations are running beyond the limits.", vbCritical
End If
escape = True
tracing_performed = False
End Function
Function factorial(unary_operand As Double) As Double
Dim countr As Integer
On Error GoTo a:
factorial = 1
If unary_operand < 0 Or unary_operand <> Int(unary_operand) Then MsgBox "Invalid argument given for factorial", vbCritical, Me.Caption _
: escape = True: Exit Function
For countr = 1 To unary_operand
factorial = factorial * countr
Next
Exit Function
a:
If Err = 6 Then MsgBox "Sorry calculations are running beyond the limits.", vbCritical
escape = True
End Function
Function unary_operator(sub_operator_location As Integer) As String
Dim unary_opernad As Double, fact As Boolean
Dim unary_function As String
On Error GoTo troubleshooter:
unary_function = Mid$(expression, unary_operator_location, 3)
If Mid(expression, sub_operator_location - 1, 1) = "!" Then
unary_opernad = Mid$(expression, unary_operator_location + 3, sub_operator_location - (unary_operator_location + 3) - 1)
fact = True
Else
unary_opernad = Mid$(expression, unary_operator_location + 3, sub_operator_location - (unary_operator_location + 3))
End If
If unary_function <> "log" And unary_function <> "exp" And Option2.Value Then unary_opernad = 3.14159265358979 / 180 * unary_opernad
Select Case unary_function
Case "sin"
unary_operator = Str(Sin(unary_opernad))
Case "cos"
unary_operator = Str(Cos(unary_opernad))
Case "tan"
unary_operator = Str(Tan(unary_opernad))
Case "cot"
unary_operator = Str(1 / Tan(unary_opernad))
Case "sec"
unary_operator = Str(1 / Cos(unary_opernad))
Case "csc"
unary_operator = Str(1 / Sin(unary_opernad))
Case "log"
unary_operator = Str(Log(unary_opernad))
Case "exp"
unary_operator = Str(Exp(unary_opernad))
End Select
If fact Then unary_operator = factorial(Val(unary_operator))
Exit Function
troubleshooter:
MsgBox "Invalid input to the function", vbCritical, Me.Caption
escape = True
End Function
Sub graph()
Dim counter1 As Double, counter2 As Integer, xmin As Double, xmax As Double, ymin As Double, ymax As Double, xpixels As Integer
On Error GoTo troubleshooter:
If Not (Option4 And plot_graph) Then MsgBox "Please first solve for a range of values", vbExclamation: Exit Sub
Picture1.Cls
xmin = Form1.startvalue
xmax = Form1.stopvalue
ymin = MSFlexGrid1.TextMatrix(1, 1)
ymax = MSFlexGrid1.TextMatrix(1, 1)
For counter1 = 1 To (Form1.stopvalue - Form1.startvalue) / Form1.stepvalue + 1
If MSFlexGrid1.TextMatrix(counter1, 1) > ymax Then ymax = MSFlexGrid1.TextMatrix(counter1, 1)
If MSFlexGrid1.TextMatrix(counter1, 1) < ymin Then ymin = MSFlexGrid1.TextMatrix(counter1, 1)
Next
Picture1.Scale (xmin, ymax)-(xmax, ymin)
Picture1.ForeColor = color 'RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Picture1.PSet (xmin, MSFlexGrid1.TextMatrix(1, 1))
For counter1 = Form1.startvalue To Form1.stopvalue Step Form1.stepvalue
counter2 = counter2 + 1
Picture1.Line -(counter1, MSFlexGrid1.TextMatrix(counter2, 1))
Next
Exit Sub
troubleshooter:
If Err = 13 Then
Resume Next
ElseIf Err = 6 Then
MsgBox "Values too large or too much points to plot. Sorry!", vbInformation
Else
Resume Next 'MsgBox Err.Description, vbInformation
End If
End Sub
Private Sub command3_Click()
On Error GoTo errorhandler:
CommonDialog1.Filter = "Bitmap File BMP|*.bmp"
CommonDialog1.Flags = cdlOFNCreatePrompt Or cdlOFNNoReadOnlyReturn Or cdlOFNPathMustExist Or cdlOFNHideReadOnly
CommonDialog1.ShowSave
SavePicture Picture1.Image, CommonDialog1.FileName
errorhandler:
If Err.Number = 32755 Then Exit Sub
End Sub
Private Sub Command2_Click()
On Error GoTo errorhandler:
CommonDialog1.ShowColor
Picture1.BackColor = CommonDialog1.color
graph
errorhandler:
If Err.Number = 32755 Then Exit Sub
End Sub
Private Sub Command1_Click()
On Error GoTo errorhandler:
CommonDialog1.ShowColor
color = CommonDialog1.color
graph
errorhandler:
If Err.Number = 32755 Then Exit Sub
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Text6 = x
Text4 = y
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text1_KeyPress (KeyAscii)
End Sub
No comments have been posted about A Complete Expression Analyzer to evaluate all types of expressions and plot their function graphic. Why not be the first to post a comment about A Complete Expression Analyzer to evaluate all types of expressions and plot their function graphic.
