'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Código siempre y cuando         //
' // no se eliminen los créditos originales de este código      //
' // No importando que sea modificado/editado o engrandecido    //
' // o achicado, si es en base a este código                    //
' ////////////////////////////////////////////////////////////////
' //
' ////////////////////////////////////////////////////////////////
 
' 50x-9+114-32x
' (50-32)x = 9-114
' x = (9-114) / (50-32)
 
Option Explicit
 
Enum eOperandos
    eParentesisI = 0
    eParentesisF = 1
    ePotencia = 2
    eRaiz = 3
    eMultiplicacion = 4
    eDivicion = 5
    eSuma = 6
    eResta = 7
End Enum
 
Private Operandos(0 To 7) As String
 
'   //  Ecuación de 1er grado.
'Public Function EcuacionLineal(ByVal vExpresion$) As String'
'Dim str_Exp$()
'    str_expr$() = Split(vExpresion$, "=", 2)'
'    If UBound(str_expr$) = 1 Then
'        ReDim Preserve str_expr$(0 To 1)
'    End If
    '   //  Hubicamos los terminos (Incognitas en el lado izquierdo y las constantes en el derecho)
 
'End Function
 
Public Function GetParentesis(ByVal vExpresion$) As String
Dim lng_op&(0 To 1)             '   //  Posicion Inicial/Final
Dim str_bloq$
Dim boo_res         As Boolean
 
    lng_op&(1) = InStr(1, vExpresion$, Operandos(eOperandos.eParentesisF))
    If (lng_op&(1) <> 0) Then
        lng_op&(0) = InStrRev(vExpresion$, Operandos(eOperandos.eParentesisI), lng_op&(1))
        If (lng_op&(0) = 0) Then
            lng_op&(0) = 1
        Else
            lng_op&(0) = lng_op&(0) + 1
        End If
        GetParentesis = Mid$(vExpresion$, lng_op&(0), lng_op&(1) - lng_op&(0))
    Else
        GetParentesis = vExpresion$
    End If
 
End Function
 
 
' // Terminos Semejantes ( Con incognita ).
Public Function ReduccionDeOperandos(ByVal vExpresion$, Optional ByVal Incognita As String = "x") As String
Dim str_spl$()
Dim lng_val#(0 To 1)
Dim lng_ing&(0 To 1)
Dim str_coll$()
Dim lng_c&
Dim str_res$
Dim lng_Opd&
 
    vExpresion$ = Replace$(vExpresion$, " ", "")
    vExpresion$ = Replace$(vExpresion$, ",", ".")
 
    If (Len(vExpresion$)) Then
        Do
 
            lng_Opd& = BuscarOperando(vExpresion$)
            If (lng_Opd& > -1) Then
                str_spl$ = Split(vExpresion$, Operandos(lng_Opd&), 2)
 
                If (lng_Opd& = eOperandos.eRaiz) Then
                    lng_val#(0) = GetVal(str_spl$(UBound(str_spl$)), &H0, False)
                    str_res$ = Sqr(lng_val#(0))
                    vExpresion$ = Replace$(vExpresion$, Operandos(lng_Opd&) & lng_val#(0), str_res$)
 
                ElseIf (lng_Opd& <= eOperandos.eResta) Then
 
                    lng_val#(0) = GetVal(str_spl$(0), &H0, True)
                    lng_val#(1) = GetVal(str_spl$(1), &H0, False)
 
                    lng_ing&(0) = InStr(1, str_spl$(0), Incognita, vbTextCompare)
                    lng_ing&(1) = InStr(1, str_spl$(1), Incognita, vbTextCompare)
 
 
                    Select Case lng_Opd&
                        Case eOperandos.ePotencia
                            str_res$ = lng_val#(0) ^ lng_val#(1)
 
                        Case eOperandos.eMultiplicacion
                            str_res$ = lng_val#(0) * lng_val#(1)
 
                        Case eOperandos.eDivicion
                            str_res$ = FormatNumber(lng_val#(0) / lng_val#(1), 9)
 
                        Case eOperandos.eSuma
                            str_res$ = lng_val#(0) + lng_val#(1)
 
                        Case eOperandos.eResta
                            str_res$ = lng_val#(0) - lng_val#(1)
 
                    End Select
                    vExpresion$ = Replace$(vExpresion$, lng_val#(0) & Operandos(lng_Opd&) & lng_val#(1), str_res$)
 
                Else
                    ReduccionDeOperandos = vExpresion$
                    Exit Function
 
                End If
 
            End If
 
        Loop Until lng_Opd& = -1
 
    End If
 
    ReduccionDeOperandos = vExpresion$
 
End Function
 
Public Function BuscarOperando(ByVal vExpresion$, Optional ByVal Reverse As Boolean = False, Optional ByRef Inpos&) As Long
Dim lng_Opd&
    lng_Opd& = -1
    If (Len(vExpresion$)) Then
        For lng_Opd& = 2 To UBound(Operandos)
            If (Reverse) Then
                Inpos& = InStrRev(vExpresion$, Operandos(lng_Opd&), Len(vExpresion$))
            Else
                Inpos& = InStr(1, vExpresion$, Operandos(lng_Opd&))
            End If
            If (Inpos&) Then
                Exit For
            End If
        Next lng_Opd&
        If (lng_Opd& = UBound(Operandos) + 1) Then
            BuscarOperando = -1
        Else
            BuscarOperando = lng_Opd&
        End If
    End If
End Function
 
Public Function GetVal(ByVal vExpresion$, ByRef OutPos As Long, Optional ByVal Reverse As Boolean = False) As Double
Dim str_res$
    If (Len(vExpresion$)) Then
        str_res$ = BuscarOperando(vExpresion$, Reverse, OutPos)
        If (Reverse) Then
            If (str_res$ = -1) Then
                OutPos = 1
            End If
            GetVal = Val(Mid$(vExpresion$, OutPos))
        Else
            If (str_res$ = -1) Then
                GetVal = Val(Mid$(vExpresion$, 1))
                OutPos = Len(vExpresion$)
            Else
                GetVal = Val(Mid$(vExpresion$, 1, OutPos))
            End If
        End If
    End If
End Function
 
Private Sub Class_Initialize()
    Operandos(eOperandos.eParentesisI) = "("
    Operandos(eOperandos.eParentesisF) = ")"
    Operandos(eOperandos.ePotencia) = "^"
    Operandos(eOperandos.eRaiz) = "sqrt"
    Operandos(eOperandos.eMultiplicacion) = "*"
    Operandos(eOperandos.eDivicion) = "/"
    Operandos(eOperandos.eSuma) = "+"
    Operandos(eOperandos.eResta) = "-"
End Sub
 
 

 
Private Sub Form_Load()
Dim cls_ecuLineal As New cls_ecuLineal
    With cls_ecuLineal
        Dim str$, str2$
        str2$ = "((7 + 4 * 5 + 4)) + 54 + (42) * (4 * (8 / (45 * 10)))*sqrt(9)"
        Do
            DoEvents
            str$ = .GetParentesis(str2$)
            If Len(str2$) <> Len(str$) Then
                str2$ = Replace(str2, "(" & str$ & ")", .ReduccionDeOperandos(str$))
            Else
                MsgBox .ReduccionDeOperandos(str$) & vbNewLine & ((7 + 4 * 5 + 4)) + 54 + (42) * (4 * (8 / (45 * 10))) * Sqr(9)
                Exit Do
            End If
        Loop
    End With
End Sub