VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cls_Exp_Build"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Limitations:
'1) All values must be separated by a space.
'2) Redundant brackets cannot be used. i.e (2 + 5 + 6)
'    will result in an error.
'3) The statements are evaluated left to right.
'     Therefore 2 + 8 * 7 / 2 will result in 35
'     whereas VB will return 30, which is the correct
'     answer, as it evalutes 7/2 first then multiplies
'     that result with 8, then adds 2, i.e
'     7 / 2    =  3.5
'     3.5 * 8  = 28
'     28 + 2   = 30
'    To overcome this issue, (unless U find a solution. If so please let me know :) )
'    use the required brackets
'    2 + 8 * 7 / 2 = 2 + (8 * (7 / 2))


Option Explicit

'Structure to hold variables created at runtime
Private Type MyVariables
    strVarName As String
    strVarValue As String
    strVarType As String
End Type

'An array to hold the Runtime Variable Structures
Private EachVar() As MyVariables


Private Sub Class_Initialize()
'We redim it with one element so that
'Redimensioning with a Ubound(array)
'function is possible
    ReDim EachVar(0)
End Sub

Private Function Calculate(strExpression As String) As Double

'The main calculation function. all values are converted to a double

'This function recieves a string with the expression to be calculated
'E.g: 1 + 2 + 3 + 4 - 6
'Each number is to followed by a space, followed by an operator
'followed by the next number
'The expression split the string by space as the delimiter
'to get an array of all the numbers and operators.
'every odd numbered element is a number
'every even numbered element is an operator
'Then in a loop we take one element, check the next element
'get an operator and then perform the operation on the next element.
'E.g: If array(3) is 3, array(4) is "+", array(5) is 4
'then we do array(3) + array(5)
'To find out what operation needs to be done
'a select case construct is used


Dim tmpString() As String
Dim lngLoop As Long
Dim tmpResult As Variant
Dim FirstValue As String
Dim tmpStrExp

'Just in case the first value in the expression
'is a user created run time variable. The first
'value is checked with the list of Runtime Variables
'and if a match is found, a 0 is added along with a space
'so that it is not lost during Splitting

FirstValue = Mid(strExpression, 1, InStr(1, strExpression, " ", vbBinaryCompare) - 1)
If Not IsNumeric(FirstValue) Then
    For lngLoop = LBound(EachVar) To UBound(EachVar)
        If FirstValue = EachVar(lngLoop).strVarName Then
            tmpStrExp = strExpression
            Exit For
        Else
            tmpStrExp = "0 " & strExpression
        End If
    Next lngLoop
            strExpression = tmpStrExp
End If

tmpString = Split(strExpression, " ", -1, vbBinaryCompare)

'The first value is assigned to the running number
'The Get_Var_Value returns the value that was
'assigned earlier to a runtime created variable.
'If this is a string literal the same value is returned

tmpResult = Get_Var_Value(tmpString(LBound(tmpString)))

'The loop begins from the second element of the array
    For lngLoop = LBound(tmpString) + 1 To UBound(tmpString)
        Select Case LCase(tmpString(lngLoop))
            Case Is = "+"
                tmpResult = Add(CDbl(tmpResult), CDbl(Get_Var_Value(tmpString(lngLoop + 1))))
                lngLoop = lngLoop + 1
            Case Is = "-"
                tmpResult = Diff(CDbl(tmpResult), CDbl(Get_Var_Value(tmpString(lngLoop + 1))))
                lngLoop = lngLoop + 1
            Case Is = "*"
                tmpResult = Mul(CDbl(tmpResult), CDbl(Get_Var_Value(tmpString(lngLoop + 1))))
                lngLoop = lngLoop + 1
            Case Is = "/"
                tmpResult = Div(CDbl(tmpResult), CDbl(Get_Var_Value(tmpString(lngLoop + 1))))
                lngLoop = lngLoop + 1
            Case Is = LCase("Avg")
                tmpResult = Avg(Get_Var_Value(tmpString(lngLoop + 1)))
                lngLoop = lngLoop + 1
            Case Else
                MsgBox "Exception Handler"
        End Select
    Next lngLoop
Calculate = tmpResult
End Function

Public Property Get Get_Var_Value(uVariable As String) As String
'A loop to retrieve the value of a variable created at runtime.

Dim lngCounter As Long
For lngCounter = LBound(EachVar) To UBound(EachVar)
    If EachVar(lngCounter).strVarName = uVariable Then
       Get_Var_Value = EachVar(lngCounter).strVarValue
       Exit For
    End If
Next lngCounter

'If the string passed is not in the list, the same value
'is passed back

If Len(Get_Var_Value) = 0 Then
        Get_Var_Value = uVariable
End If
End Property
Public Property Let Set_Var_Value(uVariable As String, uValue As String)
'Having added a runtime variable
'its value is added into the variable structure

Dim lngCounter As Long
For lngCounter = LBound(EachVar) To UBound(EachVar)
    If EachVar(lngCounter).strVarName = uVariable Then
       EachVar(lngCounter).strVarValue = uValue
       Exit For
    End If
Next lngCounter
End Property


Public Sub Add_New_Variable(ByVal uVarName As String, uVarType As String, Optional uVarValue As String)
        EachVar(UBound(EachVar)).strVarName = uVarName
        EachVar(UBound(EachVar)).strVarType = uVarType
        EachVar(UBound(EachVar)).strVarValue = uVarValue

'Redimenison to make space for new one.
'Such redimensioning is possible only with
'an array which already has a Ubound. Hence
'the code in the Class_Intialize event.

        ReDim Preserve EachVar(UBound(EachVar) + 1)
End Sub


'The functions of ADD, SUB, MUL, etc.. are made into
'separate functions, so that one may add other functions, eg.
'Average, so that capabilities of this Class Module may
'be standardized.

Private Function Add(uValOne As Double, uValTwo As Double) As Double
'ADDITION
    Add = uValOne + uValTwo
End Function

Private Function Diff(uValOne As Double, uValTwo As Double) As Double
'SUBTRACTION
    Diff = uValOne - uValTwo
End Function

Private Function Mul(uValOne As Double, uValTwo As Double) As Double
'MULTIPLICATION
    Mul = uValOne * uValTwo
End Function

Private Function Div(uValOne As Double, uValTwo As Double) As Double
'DIVISION
    Div = uValOne / uValTwo
End Function

Private Function Avg(uValue As String) As Double
'AVERAGE. This functions takes a comma separted string
'as the argument. Eg: Avg 1,2,3

    Dim lngLoop As Long, tmpSum As Double
    Dim indVal() As String
    indVal = Split(uValue, ",", -1, vbBinaryCompare)
    For lngLoop = LBound(indVal) To UBound(indVal)
        tmpSum = tmpSum + CDbl(indVal(lngLoop))
    Next lngLoop
        Avg = tmpSum / CDbl(UBound(indVal) + 1)
End Function

Public Function Eval(uExpression As String) As Double
'This function is the exposed function
'this takes the string passed to it, parses out
'the brackets and each statement within a given set of brackets is
'sent to the Calculate function. The returned value is included
'back into the original string and the process is looped until
'no brackets remain.

'An example would make it clearer. The expression to be evaluated is
'12 + ((5 + 6) - (2 * 5)) - 10

'The first closing bracket is located, i.e next to number 6
'the corresponding opening bracket is located next, i.e, next to number 5
'(the 5 that is to the left of 6).
'the expression within these brackets is extracted, i.e "5 + 6"
'and this temporary string is passed to the Calculate function.
'When the function returns, the result, here it is the number 11, is inserted
'back into the string in place of the one extracted earlier. This is done by
'placing a keyword (I have used "@!") as a temporary place holder and
'using the Replace function. The statement now becomes 12 + (11 - (2 * 5)) - 10
'As the above process is in a loop, the first closing bracket now, is next
'to the number 5 and the corresponding opening bracket is next to the number 2
'This extracted string, which is "2 * 5", is passed to the Calculate function
'and the result is inserted into the main expression, which now becomes
'12 + (11 - 10) - 10.
'After the third loop the expression becomes 12 + 1 - 10
'Now there are no brackets, so the whole string is passed to the Calculate
'function. The result is assigned to this function return value, which is
'3


Dim lngPosOpen As Long, lngPosClose As Long
Dim strMarker As String, strPartCalc As String
Dim dblPartCalcResult As Double, ret As Double

strMarker = "@!"

Do
    lngPosClose = InStr(1, uExpression, ")", vbBinaryCompare)
    If lngPosClose = 0 Then Exit Do
    lngPosOpen = InStrRev(uExpression, "(", lngPosClose, vbBinaryCompare)
    strPartCalc = Mid(uExpression, lngPosOpen + 1, lngPosClose - lngPosOpen - 1)
    uExpression = Replace(uExpression, "(" & strPartCalc & ")", strMarker, 1, 1, vbBinaryCompare)
    dblPartCalcResult = Calculate(strPartCalc)
    uExpression = Replace(uExpression, strMarker, CStr(dblPartCalcResult), 1, 1, vbBinaryCompare)
Loop
   Eval = Calculate(uExpression)
End Function