VERSION 5.00 Begin VB.Form Formula BackColor = &H00FFFFFF& Caption = "Formula Editor" ClientHeight = 5835 ClientLeft = 60 ClientTop = 450 ClientWidth = 5370 LinkTopic = "Form2" ScaleHeight = 5835 ScaleWidth = 5370 StartUpPosition = 3 'Windows Default Begin VB.CommandButton Command1 BackColor = &H00FFC0C0& Caption = "Space" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 1860 Style = 1 'Graphical TabIndex = 31 Top = 4380 Width = 1545 End Begin VB.TextBox DepthTxt Alignment = 2 'Center Height = 300 Left = 3300 TabIndex = 27 Text = "10" Top = 450 Width = 1080 End Begin VB.TextBox WidthTxt Alignment = 2 'Center Height = 300 Left = 2100 TabIndex = 26 Text = "100" Top = 450 Width = 1080 End Begin VB.TextBox LengthTxt Alignment = 2 'Center Height = 300 Left = 930 TabIndex = 25 Text = "1000" Top = 450 Width = 1080 End Begin VB.CommandButton Command8 BackColor = &H00FFC0C0& Caption = "*" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 3720 Style = 1 'Graphical TabIndex = 24 Top = 2850 Width = 465 End Begin VB.CommandButton Command9 BackColor = &H00FFC0C0& Caption = "/" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 4305 Style = 1 'Graphical TabIndex = 23 Top = 2850 Width = 465 End Begin VB.CommandButton Command22 BackColor = &H00FFC0C0& Caption = "Pi" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 2055 Style = 1 'Graphical TabIndex = 21 Top = 3405 Width = 1545 End Begin VB.CommandButton Command21 BackColor = &H00FFC0C0& Caption = "8" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 4200 Style = 1 'Graphical TabIndex = 20 Top = 3915 Width = 465 End Begin VB.CommandButton Command20 BackColor = &H00FFC0C0& Caption = "9" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 4695 Style = 1 'Graphical TabIndex = 19 Top = 3915 Width = 465 End Begin VB.CommandButton Command19 BackColor = &H00FFC0C0& Caption = "7" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 3705 Style = 1 'Graphical TabIndex = 18 Top = 3915 Width = 465 End Begin VB.CommandButton Command18 BackColor = &H00FFC0C0& Caption = "6" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 3210 Style = 1 'Graphical TabIndex = 17 Top = 3915 Width = 465 End Begin VB.CommandButton Command17 BackColor = &H00FFC0C0& Caption = "4" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 2235 Style = 1 'Graphical TabIndex = 16 Top = 3915 Width = 465 End Begin VB.CommandButton Command16 BackColor = &H00FFC0C0& Caption = "5" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 2730 Style = 1 'Graphical TabIndex = 15 Top = 3915 Width = 465 End Begin VB.CommandButton Command15 BackColor = &H00FFC0C0& Caption = "0" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 210 Style = 1 'Graphical TabIndex = 14 Top = 3915 Width = 465 End Begin VB.CommandButton Command14 BackColor = &H00FFC0C0& Caption = "1" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 705 Style = 1 'Graphical TabIndex = 13 Top = 3915 Width = 465 End Begin VB.CommandButton Command13 BackColor = &H00FFC0C0& Caption = "3" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 1740 Style = 1 'Graphical TabIndex = 12 Top = 3915 Width = 465 End Begin VB.CommandButton Command12 BackColor = &H00FFC0C0& Caption = "2" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 1245 Style = 1 'Graphical TabIndex = 11 Top = 3915 Width = 465 End Begin VB.CommandButton Command11 BackColor = &H00FFC0C0& Caption = ")" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 4305 Style = 1 'Graphical TabIndex = 10 Top = 3375 Width = 465 End Begin VB.CommandButton Command10 BackColor = &H00FFC0C0& Caption = "(" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 3720 Style = 1 'Graphical TabIndex = 9 Top = 3375 Width = 465 End Begin VB.CommandButton Command7 BackColor = &H00FFC0C0& Caption = "-" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 4305 Style = 1 'Graphical TabIndex = 8 Top = 2355 Width = 465 End Begin VB.CommandButton Command6 BackColor = &H00FFC0C0& Caption = "+" BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 405 Left = 3720 Style = 1 'Graphical TabIndex = 7 Top = 2355 Width = 465 End Begin VB.CommandButton Command5 BackColor = &H00FFC0C0& Caption = "Depth" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 270 Style = 1 'Graphical TabIndex = 6 Top = 3360 Width = 1545 End Begin VB.CommandButton Command4 BackColor = &H00FFC0C0& Caption = "Square Yards" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 285 Style = 1 'Graphical TabIndex = 5 Top = 2850 Width = 1545 End Begin VB.CommandButton Command3 BackColor = &H00FFC0C0& Caption = "Square Feet" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 2070 Style = 1 'Graphical TabIndex = 4 Top = 2850 Width = 1545 End Begin VB.CommandButton CubicYards BackColor = &H00FFC0C0& Caption = "Cubic Yards" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 2070 Style = 1 'Graphical TabIndex = 3 Top = 2340 Width = 1545 End Begin VB.CommandButton CubicFeet BackColor = &H00FFC0C0& Caption = "Cubic Feet" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 465 Left = 285 Style = 1 'Graphical TabIndex = 2 Top = 2340 Width = 1545 End Begin VB.TextBox FormulaTxt BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 765 Left = 270 MaxLength = 100 MultiLine = -1 'True TabIndex = 1 Top = 1515 Width = 4815 End Begin VB.CommandButton Command111 BackColor = &H008080FF& Caption = "Test " BeginProperty Font Name = "MS Sans Serif" Size = 18 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 510 Left = 1365 Style = 1 'Graphical TabIndex = 0 Top = 4860 Width = 2595 End Begin VB.Label Label3 BackStyle = 0 'Transparent Caption = "Depth" ForeColor = &H00FFFFFF& Height = 240 Left = 3630 TabIndex = 30 Top = 225 Width = 540 End Begin VB.Label Label2 BackStyle = 0 'Transparent Caption = "Width" ForeColor = &H00FFFFFF& Height = 240 Left = 2430 TabIndex = 29 Top = 225 Width = 540 End Begin VB.Label Label1 BackStyle = 0 'Transparent Caption = "Length" ForeColor = &H00FFFFFF& Height = 240 Left = 1230 TabIndex = 28 Top = 225 Width = 540 End Begin VB.Shape Shape2 FillStyle = 0 'Solid Height = 825 Left = 765 Shape = 4 'Rounded Rectangle Top = 105 Width = 3795 End Begin VB.Label Label5 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Formula Editor" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Left = 375 TabIndex = 22 Top = 1200 Width = 2085 End Begin VB.Shape Shape1 BackColor = &H000000FF& BackStyle = 1 'Opaque BorderWidth = 4 Height = 4425 Left = 90 Shape = 4 'Rounded Rectangle Top = 1095 Width = 5160 End End Attribute VB_Name = "Formula" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Type MyVariables strVarName As String * 10 lngVarValue As Double End Type Dim myVar() As MyVariables 'We use a ByRef argument so that we can return the 'new variable's name as well in addition to the 'result of the Evaluation Private Function Evaluate(strExpression As String, ByRef LeftHandSide As String) As Double Dim tmpString() As String Dim LHS As String, RHS As String Dim RHSBegin As Long Dim lngLoop As Long Dim tmpResult As Double 'Find out where in the Expression the Right Hand Side begins RHSBegin = InStr(1, strExpression, "= ", vbBinaryCompare) 'Sperate the Left Hand Side and Right Hand Side LHS = Trim(Mid(strExpression, 1, RHSBegin - 1)) RHS = Trim(Mid(strExpression, RHSBegin)) 'Split the RHS into blocks separated by 'a space tmpString = Split(RHS, " ", -1, vbBinaryCompare) 'First take the second value (the first value 'is the = sign) in the RHS and 'assign it to the temorary result tmpResult = Assign_Values_for_Variables(tmpString(LBound(tmpString) + 1)) 'Do a loop from the third element to perform the evaluation 'If we encounter a Variable like "SqFt" 'then we take the value from the array 'which we have populated earlier by calling 'the Assign_Values_for_Variables function For lngLoop = LBound(tmpString) + 2 To UBound(tmpString) Select Case tmpString(lngLoop) Case Is = "+" tmpResult = tmpResult + CDbl(Assign_Values_for_Variables(tmpString(lngLoop + 1))) lngLoop = lngLoop + 1 Case Is = "-" tmpResult = tmpResult - CDbl(Assign_Values_for_Variables(tmpString(lngLoop + 1))) lngLoop = lngLoop + 1 Case Is = "*" tmpResult = tmpResult * CDbl(Assign_Values_for_Variables(tmpString(lngLoop + 1))) lngLoop = lngLoop + 1 Case Is = "/" tmpResult = tmpResult / CDbl(Assign_Values_for_Variables(tmpString(lngLoop + 1))) lngLoop = lngLoop + 1 End Select Next lngLoop LeftHandSide = LHS Evaluate = tmpResult tmpResult = 0 LHS = "" End Function Private Function Assign_Values_for_Variables(uVariable As String) As Double Select Case uVariable Case Is = "SqFt" Assign_Values_for_Variables = myVar(3).lngVarValue Case Is = "CubicFt" Assign_Values_for_Variables = myVar(4).lngVarValue Case Is = "SqYd" Assign_Values_for_Variables = myVar(5).lngVarValue Case Is = "CubicYd" Assign_Values_for_Variables = myVar(6).lngVarValue Case Else If IsNumeric(uVariable) Then Assign_Values_for_Variables = CDbl(uVariable) Else If uVariable = "(" Or uVariable = ")" Then MsgBox uVariable Else MsgBox "Handle exceptions here" End If End If End Select End Function Private Sub Assign_And_Calculate_Area(Length As Long, Width As Long, Depth As Long) 'Assign Length, Width & Depth 'and calculate Areas using the following formulae 'SquareFeet = Length * Width 'CubicFeet = Length * Width * Depth 'SquareYards = SquareFeet / 9 'CubicYards = CubicFeet / 27 myVar(0).lngVarValue = Length myVar(1).lngVarValue = Width myVar(2).lngVarValue = Depth 'Calculate and store Sq Feet myVar(3).lngVarValue = myVar(0).lngVarValue * myVar(1).lngVarValue 'Calculate and store Cubic Feet myVar(4).lngVarValue = myVar(0).lngVarValue * myVar(1).lngVarValue * myVar(2).lngVarValue 'Calculate and store Sq Yards myVar(5).lngVarValue = myVar(3).lngVarValue / 9 'Calculate and store Cubic Yards myVar(6).lngVarValue = myVar(4).lngVarValue / 27 End Sub Private Sub Command111_Click() Dim NewVar As String Dim EquationResult As Double Depth = 20 Assign_And_Calculate_Area Val(LengthTxt.Text), Val(WidthTxt.Text), Val(DepthTxt.Text) EquationResult = Evaluate(FormulaTxt.Text, NewVar) MsgBox NewVar & " = " & EquationResult End Sub Private Sub Form_Load() FormulaTxt.Text = "A = " 'load and assign the variable names ReDim myVar(6) As MyVariables myVar(0).strVarName = "Length" myVar(1).strVarName = "Width" myVar(2).strVarName = "Depth" myVar(3).strVarName = "SqFt" myVar(4).strVarName = "CubicFt" myVar(5).strVarName = "SqYd" myVar(6).strVarName = "CubicYd" End Sub Private Sub Command1_Click() Call addspace End Sub Private Sub Command10_Click() FormulaTxt = FormulaTxt + "(" Call addspace End Sub Private Sub Command11_Click() FormulaTxt = FormulaTxt + ")" Call addspace End Sub Private Sub Command12_Click() FormulaTxt = FormulaTxt + "2" Call addspace End Sub Private Sub Command13_Click() FormulaTxt = FormulaTxt + "3" Call addspace End Sub Private Sub Command14_Click() FormulaTxt = FormulaTxt + "1" Call addspace End Sub Private Sub Command15_Click() FormulaTxt = FormulaTxt + "0" End Sub Private Sub Command16_Click() FormulaTxt = FormulaTxt + "5" End Sub Private Sub Command17_Click() FormulaTxt = FormulaTxt + "4" End Sub Private Sub Command18_Click() FormulaTxt = FormulaTxt + "6" End Sub Private Sub Command19_Click() FormulaTxt = FormulaTxt + "7" End Sub Private Sub Command20_Click() FormulaTxt = FormulaTxt + "9" End Sub Private Sub Command21_Click() FormulaTxt = FormulaTxt + "8" End Sub Private Sub Command22_Click() FormulaTxt = FormulaTxt + "3.14159265358979323846264 " Call addspace End Sub Private Sub Command3_Click() FormulaTxt = FormulaTxt + "SqFt" Call addspace End Sub Private Sub Command4_Click() FormulaTxt = FormulaTxt + "SqYd" Call addspace End Sub Private Sub Command5_Click() FormulaTxt = FormulaTxt + "Depth" Call addspace End Sub Private Sub Command6_Click() FormulaTxt = FormulaTxt + "+" Call addspace End Sub Private Sub Command7_Click() FormulaTxt = FormulaTxt + "-" Call addspace End Sub Private Sub Command8_Click() FormulaTxt = FormulaTxt + "*" Call addspace End Sub Private Sub Command9_Click() FormulaTxt = FormulaTxt + "/" Call addspace End Sub Private Sub CubicFeet_Click() FormulaTxt = FormulaTxt + "CubicFt" Call addspace End Sub Private Sub CubicYards_Click() FormulaTxt = FormulaTxt + "CubicYd" Call addspace End Sub Public Sub addspace() FormulaTxt = FormulaTxt + " " End Sub