Creating your own custom routines to parse mathematical expressions can be a pain, so let this class do all the work for you! Simply send your math expression to the parse procedure.
'==========================================================
'
Muhammad Abubakar
'
<[email protected]>
'
<http://go.to/abubakar>
'==========================================================
'You can use the code as u like in your projects but please
'give credit where credit is due :)
Option Explicit
Public Function parse(expr As String) As Double
Dim i As Double, a As String
Dim start As Double, endat As Double
expr = Trim(expr)
If InStr(expr, "(") <> 0 Then
i = 1
While (InStr(expr, "(")
<> 0)
a = Mid(expr,
i, 1)
If a =
"(" Then
start = i
ElseIf a =
")" Then
If start = 0 Then
'MsgBox "Invalid Syntax."
Exit Function
End If
endat = i
i = Val(givePrecedence(Mid(expr, start + 1, endat - start - 1)))
expr = Left(expr, start - 1) & Str(i) & Right(expr, Len(expr) - endat)
start = 0: endat = 0
i = 0
End If
i = i + 1
Wend
End If
If expr <> "" Then
parse = Val(givePrecedence(expr))
Else
parse = i
End If
End Function
Private Function Eval(temp As String, sign As String, prevExpr As String) As
String
Select Case sign
Case "+":
Eval =
Str(Val(prevExpr) + Val(temp))
Case "-":
Eval =
Str(Val(prevExpr) - Val(temp))
Case "*":
Eval =
Str(Val(prevExpr) * Val(temp))
Case "/":
Eval =
Str(Val(prevExpr) / Val(temp))
Case "^":
Eval =
Str(Val(prevExpr) ^ Val(temp))
End Select
End Function
Private Function givePrecedence(expr As String) As String
Dim X As Integer, temp As String
Do While (InStr(expr, "!") <> 0 Or
InStr(expr, "*") <> 0 Or InStr(expr, "/") <> 0
Or InStr(expr, "^") <> 0 _
Or InStr(expr, "+")
<> 0 Or InStr(expr, "-") <> 0)
DoEvents
X = InStr(expr, "!")
If X <> 0 Then
temp =
solveFor("!", expr)
Else
X =
InStr(expr, "^")
If X <>
0 Then
temp = solveFor("^", expr)
Else
X = InStr(expr, "/")
If X <> 0 Then
temp = solveFor("/", expr)
Else
X = InStr(expr, "*")
If X <> 0 Then
temp = solveFor("*", expr)
Else
X = InStr(expr, "+")
If X <> 0 Then
temp = solveFor("+", expr)
Else
X = InStr(expr, "-")
If X <> 0 Then
temp = solveFor("-", expr)
End If
End If
End If
End If
End If
End If
If temp = "" Then
Exit Do
Else
expr = temp
End If
Loop
givePrecedence = expr
End Function
Private Function GetNumFrom(Pos As Integer, expr As String) As String
Dim i As Integer, temp As String
Dim a As String
If Pos <= Len(expr) Then
For i = Pos To Len(expr)
'{
a = Mid(expr,
i, 1)
If Asc(a)
>= 48 And Asc(a) <= 58 Or a = " " Or a = "." _
Or ((a = "-" Or a = "+") And Trim(temp) = "") Then
temp = temp & a
Else
If LCase(a) = "e" Then
temp = temp & "E" & GetNumFrom(i + 1, expr) 'Recursion
i = Len(expr)
Else
'wrong syntax, u can handle error as you like
End If
i = Len(expr)
End If
Next
'}
GetNumFrom = temp
End If
End Function
Private Function solveFor(sign As String, expr As String) As String
'{
Dim X As
Integer, start As Integer, endat As Integer
Dim temp As
String, a As String, i As Integer
start = 1
X =
InStr(expr, sign)
If sign
<> "!" Then
If sign = "+" Or sign = "-" Then
a = GetNumFrom(1, expr)
If Len(a) = Len(expr) Then
solveFor = ""
Exit Function
End If
temp = GetNumFrom(Len(a) + 1, expr)
If Sgn(Val(temp)) < 0 Then
sign = "-"
Else: sign = "+"
End If
X = InStr(Len(a), expr, sign)
endat = Len(a) + Len(temp)
temp = Eval(GetNumFrom(X + 1, expr), sign, a)
expr = Left(expr, start - 1) & temp & Right(expr, Len(expr) - endat)
solveFor = expr
Exit Function
End If
End If
'i = InStr(x
+ 1, expr, sign)
For i = X - 1
To 1 Step -1 'going back
a = Mid(expr, i, 1)
If Asc(a) >= 48 And Asc(a) <= 58 Or a = " " Or a = "."
Or LCase(a) = "e" Then
temp = a & temp
Else
If (a = "-" Or a = "+") And i - 1 > 0 Then
If Mid(expr, i - 1, 1) = "e" Then
temp = a & temp
Else
start = i + 1
i = 1
End If
Else
start = i + 1
i = 1
End If
End If
Next
If Trim(temp)
<> "" Then
'solving for factorial
If sign = "!" Then
If Int(Val(temp)) <> Val(temp) Then
'wrong syntax, handle it in whatever way u awnt
Else
expr = Left(expr, start - 1) & Str(fact(Val(temp))) & Right(expr,
Len(expr) - X)
solveFor = expr
End If
Else
'its not a factorial calculations
endat = X + Len(GetNumFrom(X + 1, expr))
temp = Eval(GetNumFrom(X + 1, expr), sign, temp)
expr = Left(expr, start - 1) & temp & Right(expr, Len(expr) - endat)
'Job done, go back
solveFor = expr
End If
Else
solveFor = ""
End If
'}
End Function
'Algo for factorial
Private Function fact(num As Integer) As Double
Dim b As Double
b = 1
For num = 1 To num
b = b * num 'I wish I could write it
as b * = num :(
Next
fact = b
End Function
Nothing to say anything about me yet.
Comments