' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' Math Expressions Analyzer V.1.1                         '
'                                                         '
' Module to get a string, analyze it mathematically and   '
' issuing a result from the operation. If you are using   '
' QuickBASIC with a project, please ensure to include the '
' FUNCTION declarations at the top of each file on it.    '
' Failing to do so can bring no results in the analysis.  '
'                                                         '
' Originally created in Visual Basic 4.0 and translated   '
' into QBASIC/QB/VB-DOS/QB64 by A. David Garza Marin.     '
' e-mail: adgarza@yahoo.com                               '
' PRO-3, Mexico                                           '
' ******************************************************* '
' You are free to use and modify this code to adapt it    '
' to your own needs. But, please, don't remove my credit. '
' It took many hours for its creation and I think I       '
' deserve such credit.                                    '
'                                                         '
' Please, send to me an email to adgarza@yahoo.com to     '
' report errors or commends about this code.              '
' ******************************************************* '
' MODIFICATIONS:                                          '
'                                                         '
' Date(d/m/y)| Revision                                   '
' --------+---------------------------------------------- '
' 01/01/97| Development started.                          '
' 16/06/97| Added an Error member data that takes control '
'         | of runtime errors in the methods.             '
' 18/06/97| Error code 8, "Cannot divide by zero" added.  '
' 14/12/98| Bugs corrected on operations with signed nums.'
' 15/12/98| CalculaFormula method added. This method gets '
'         | rid of spaces and verifies the sign-law.      '
'         | This addition was done by Alejandro Juarez B. '
' 15/12/98| Function CalculaFormula made private.         '
'         | (adgarza).                                    '
' 21/05/99| Translation into QBASIC and QuickBASIC.       '
'         | (adgarza).                                    '
' 12/08/20| Translation into QB64                         '
' 13/08/20| Fixed calculation problem with long expression'
'         |  starting with a blank space.                 '
' 26/08/20| Fixed a logical error where a long result in  '
'         |  an operation would bring an unexpected       '
'         |  scientific notation that crashed the program.'
'         | Fixed a logical error when multiplying or     '
'         |  dividing two negative numbers the + sign was '
'         |  missing.                                     '
'         | Added * signs when a parentheses is trailed   '
'         |  or followed directly with a number or with a '
'         |  closing parentheses following by an open one '
'         |  and vice-versa                               '
'         | There is an apparent error in QB64 where some '
'         |  floating point numbers assigned to variables '
'         |  of type DOUBLE are forcibly converted to     '
'         |  scientific notation by adding a decimal      '
'         |  number distinct to zero at the end of the    '
'         |  decimals. This was worked around with a      '
'         |  sub-process that removes the scientific      '
'         |  notation through string manipulation, as     '
'         |  there is no way to remove it numerically.    '
'
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

$NOPREFIX
OPTION EXPLICIT
' $DYNAMIC
DEFINT A-Z

' -----Copy these declarations in your modules ----
DECLARE SUB Constructor ()
DECLARE SUB Destructor ()
DECLARE SUB doLimpiaVar ()
DECLARE SUB doRemVar (Variable AS STRING)
DECLARE SUB getObtieneVar ()
DECLARE SUB setExpresion (strCualExpresionEvaluar AS STRING)
DECLARE SUB setNuevaVar (strNombre AS STRING)
DECLARE SUB setNuevoValor (varVariable AS STRING, varValor AS DOUBLE)
DECLARE FUNCTION AnalizaExpr# ()
DECLARE FUNCTION Expresion$ ()
DECLARE FUNCTION CErr% ()
DECLARE FUNCTION CuentaVar% ()
DECLARE FUNCTION DErr$ ()
DECLARE FUNCTION NombreVar$ (iCualVariable AS INTEGER)
DECLARE FUNCTION Valor# (varVariable AS STRING)
' -----Copy should be up to here. It is not necessary to copy the rest of the declarations

' ******** Local Functions *********************
DECLARE FUNCTION SinAcentos% (strCadena AS STRING)
DECLARE FUNCTION BuscaVar% (CualVar AS STRING)
DECLARE FUNCTION LimpiaFormula# (strFormula AS STRING)
DECLARE FUNCTION CalculaFormula# (strFormula AS STRING)
DECLARE FUNCTION NumDer# (strCadena AS STRING, iPos AS INTEGER, iPosD AS INTEGER)
DECLARE FUNCTION NumIzq# (strCadena AS STRING, iPos AS INTEGER, iPosI AS INTEGER)
DECLARE FUNCTION SustituyeVars$ ()
DECLARE FUNCTION VerificaVar% ()
' ************************************************

' 32-bit value
TYPE RegistroVar
    Nombre AS STRING * 24
    Valor AS STRING * 8
END TYPE

DIM aregVariables(0 TO 0) AS RegistroVar ' Operation variables
DIM strExpresion AS STRING ' String to analyze
DIM iError AS INTEGER ' The error happened

' Constants
CONST FALSE = 0
CONST TRUE = NOT FALSE
CONST Debug = FALSE


' ********* Main program cycle ********
DIM strCadena AS STRING
DIM t AS STRING
DIM i AS INTEGER
DIM x AS INTEGER
DIM c AS INTEGER
DIM tf AS INTEGER
DIM dblValor AS DOUBLE

CLS ' Clean screen

' Run the following procedure before any other
Constructor

IF COMMAND$ <> "" THEN
    strCadena = COMMAND$
    c = TRUE
    ' Sees if it is a test file
    '  THIS ONLY WORKS IN QB64
    IF FILEEXISTS("TESTMEA.TXT") THEN
        tf = TRUE
        OPEN "TESTMEA.TXT" FOR INPUT AS #1
    ELSE
        tf = FALSE
    END IF

END IF

' Repeat until you get an N
PRINT "This program interprets simple mathematical expressions. Write"
PRINT "one at the prompt and press Enter to see the results. Read the"
PRINT "file README.TXT for further details. You can use"
PRINT "variables in the expression."
PRINT
DO
    doLimpiaVar ' Clean variables
    IF tf THEN
        IF NOT EOF(1) THEN
            LINE INPUT #1, strCadena
        ELSE
            strCadena = ""
            tf = FALSE
            CLOSE #1
        END IF
    ELSE
        INPUT "Expression to evaluate"; strCadena ' Gets the string
    END IF

    IF strCadena <> "" THEN
        setExpresion strCadena ' Assigns the string to the module
        getObtieneVar ' Gets variables
        x = CuentaVar ' Count how many variables the expression has
  
        IF x > 0 THEN ' If variables found, ask for their values.
            FOR i = 1 TO x ' Loop for each variable found.
                PRINT "Value of " + NombreVar(i); ' Show the variable name to request its value
                INPUT dblValor ' Capture the value
                setNuevoValor LTRIM$(STR$(i)), dblValor ' Assign the value to the variable
            NEXT i
        END IF
        IF c OR tf THEN
            PRINT "Result of: "; strCadena
        END IF
        PRINT USING "###,###,###,###.####"; AnalizaExpr ' Show the result

        IF CErr > 0 THEN ' Is any error happened?
            PRINT "Error" + STR$(CErr) + ": " + DErr ' Show the error message
            PRINT
        END IF
    END IF

    IF NOT tf THEN
        PRINT "Again? (Y/N)" ' Want to try again?
        PRINT
        DO
            t = INKEY$
        LOOP UNTIL UCASE$(t) = "Y" OR UCASE$(t) = "N" ' Get Y or N
    ELSE
        t = "Y"
    END IF
LOOP UNTIL UCASE$(t) = "N"

' Even though is not strictly necessary, it is advised to
'  free the resources used by the module
Destructor
PRINT "End of program" ' End of the program execution
END

REM $STATIC
DEFSNG A-Z
' Public procedure to set if the formula analysis should be done.
FUNCTION AnalizaExpr# ()
    ' Var
    DIM strFormula AS STRING
    SHARED iError AS INTEGER
    SHARED strExpresion AS STRING

    iError = 0
    IF strExpresion <> "" THEN
        strExpresion = RTRIM$(LTRIM$(strExpresion)) ' Removes spaces
        IF SinAcentos(strExpresion) THEN
            IF CuentaVar% = 0 THEN ' Just if there are no variables
                getObtieneVar ' Verifies if there are variables, just in case
            END IF
            IF VerificaVar THEN
                strFormula = SustituyeVars ' Substitues variables
                AnalizaExpr = LimpiaFormula(strFormula)
            ELSE
                iError = 4
                AnalizaExpr = 0
            END IF
        END IF
    ELSE
        iError = 5
        AnalizaExpr = 0
    END IF
END FUNCTION

FUNCTION BuscaVar% (CualVar AS STRING)
    ' Var
    DIM i AS INTEGER
    DIM x AS INTEGER
    DIM strCualVar AS STRING
    SHARED aregVariables() AS RegistroVar

    strCualVar = UCASE$(CualVar)
    i = 0
    x = UBOUND(aregVariables)
    IF x > 0 THEN
        DO
            i = i + 1
        LOOP UNTIL UCASE$(RTRIM$(aregVariables(i).Nombre)) = strCualVar OR i = x

        IF UCASE$(RTRIM$(aregVariables(i).Nombre)) <> strCualVar THEN
            i = 0
        END IF
    END IF

    BuscaVar = i
END FUNCTION

' Do the formula analysis
FUNCTION CalculaFormula# (strFormula AS STRING)
    ' Var
    DIM dblNum1 AS DOUBLE
    DIM dblNum2 AS DOUBLE
    DIM dblRes AS FLOAT, strRes AS STRING
    DIM iOperacion AS INTEGER
    DIM strOperacion AS STRING * 1
    DIM strSigno AS STRING * 2
    DIM strSubFormula AS STRING
    DIM strCar AS STRING
    DIM iPos AS INTEGER, iPosI AS INTEGER, iPosD AS INTEGER
    DIM iPosParI AS INTEGER, iPosParD AS INTEGER
    DIM iPosParI2 AS INTEGER, iCuantosI AS INTEGER
    DIM iOper1 AS INTEGER, iOper2 AS INTEGER
    DIM iNC AS INTEGER, strNC AS STRING, iNCPD AS INTEGER
    DIM strASuma AS STRING
    SHARED iError AS INTEGER
    CONST strSimbolo = "^^*/+-" ' Recognized symbols (From most important to least important)

    ' Calculates the formula
    iError = 0
    DIM iPosParI2(1 TO 10) AS INTEGER
    DO
        strCar = ""
        IF iCuantosI > 0 THEN
            iPosParI = INSTR(iPosParI2(iCuantosI) + 1, strFormula, "(")
            iPosParD = INSTR(iPosParI2(iCuantosI) + 1, strFormula, ")")
        ELSE
            iPosParI = INSTR(strFormula, "(")
            iPosParD = INSTR(strFormula, ")")
        END IF

        ' Ejecuta el c¢digo de acuerdo a la localizaci¢n o no de par‚ntesis
        IF iPosParI < iPosParD AND iPosParI > 0 THEN
            iCuantosI = iCuantosI + 1
            IF UBOUND(iPosParI2) < iCuantosI THEN
                REDIM PRESERVE iPosParI2(1 TO iCuantosI + 9) AS INTEGER
            END IF

            ' Valida si lo que hay inmediatamente antes del par‚ntesis es
            '  un n£mero, le agregar  un asterisco
            IF iPosParI > 1 THEN
                strCar = MID$(strFormula, iPosParI - 1, 1)
            END IF
            IF strCar <> "" THEN
                IF INSTR("0123456789)", strCar) > 0 THEN
                    strFormula = LEFT$(strFormula, iPosParI - 1) + "*" + MID$(strFormula, iPosParI)
                    iPosParI = iPosParI + 1
                END IF
            END IF
            iPosParI2(iCuantosI) = iPosParI
        ELSEIF iPosParD > 0 THEN
            IF iCuantosI > 0 THEN
                strCar = MID$(strFormula, iPosParD + 1, 1)
                IF strCar <> "" THEN
                    IF INSTR("0123456789(", strCar) > 0 THEN
                        strFormula = LEFT$(strFormula, iPosParD) + "*" + MID$(strFormula, iPosParD + 1)
                    END IF
                END IF

                IF iPosParI2(iCuantosI) > 0 THEN
                    strSubFormula = MID$(strFormula, iPosParI2(iCuantosI) + 1, iPosParD - iPosParI2(iCuantosI) - 1)
                    IF Debug THEN
                        PRINT "strFormula="; strFormula
                        PRINT "strSubFormula="; strSubFormula
                    END IF
                    GOSUB HazLaOperacion
                    strFormula = LEFT$(strFormula, iPosParI2(iCuantosI) - 1) + strSubFormula + MID$(strFormula, iPosParD + 1)
                    iCuantosI = iCuantosI - 1
                ELSE
                    iError = 6 ' Parentheses mismatch
                    EXIT FUNCTION
                END IF
            ELSE
                iError = 6 ' Parentheses mismatch
                EXIT FUNCTION
            END IF
        ELSEIF iPosParI > 0 AND iPosParD = 0 THEN
            iError = 6 ' Parentheses mismatch
            EXIT FUNCTION
        ELSEIF iPosParI = 0 AND iPosParD = 0 THEN
            strSubFormula = strFormula
            IF Debug THEN
                PRINT "strFormula="; strFormula
                PRINT "strSubFormula="; strSubFormula
            END IF
            GOSUB HazLaOperacion
            strFormula = strSubFormula
            iCuantosI = 0
        END IF
    LOOP UNTIL iPosParI = 0 AND iPosParD = 0

    CalculaFormula = VAL(strFormula)

    EXIT FUNCTION

    HazLaOperacion:
    ' Do the operation
    iOperacion = 1
    DO
        strSigno = MID$(strSimbolo, (2 * (iOperacion - 1) + 1), 2)

        ' If one of these operators ( ^^ */ +- ) is inside the operation
        iOper1 = INSTR(strSubFormula, LEFT$(strSigno, 1))
        iOper2 = INSTR(strSubFormula, RIGHT$(strSigno, 1))
        IF iOper1 > 0 OR iOper2 > 0 THEN

            ' If the first operator exists (^*+) and is before the second one (^/-)
            IF iOper1 <= iOper2 AND iOper1 > 0 THEN
                iPos = iOper1
                strOperacion = LEFT$(strSigno, 1)

                ' If the second operator (^/-) exists
            ELSEIF iOper2 = 0 THEN
                iPos = iOper1
                strOperacion = LEFT$(strSigno, 1)

                ' If the second operator (^*+) exists and is after the second (^/-)
            ELSEIF iOper1 > iOper2 AND iOper2 > 0 THEN

                ' If the first character on the formula is a negative sign, do the operation with the operator at the left (^*+)
                IF LEFT$(strSubFormula, 1) = "-" THEN
                    iPos = iOper1
                    strOperacion = LEFT$(strSigno, 1)
                ELSE ' Else, do the operation with the operator at the right (^/-)
                    iPos = iOper2
                    strOperacion = RIGHT$(strSigno, 1)
                END IF
            ELSE
                ' The operation will be done with the right-side operator (^/-)
                strOperacion = RIGHT$(strSigno, 1)

                ' But if the first character is a negative sign, do the operation with the operator at the right-side (^/-)
                IF iOper2 = 1 THEN
                    iPos = INSTR(iOper2 + 1, strSubFormula, strOperacion)
                ELSE
                    iPos = iOper2
                END IF
            END IF

            ' If it is 1 is very likely that is a number with negative sign
            strASuma = ""
            IF iPos > 1 THEN
                dblNum1 = NumIzq(strSubFormula, iPos, iPosI)
                dblNum2 = NumDer(strSubFormula, iPos, iPosD)
                IF Debug THEN
                    PRINT "dblNum1: "; dblNum1; "dblNum2: "; dblNum2
                END IF
                SELECT CASE strOperacion
                    CASE "^": dblRes = dblNum1 ^ dblNum2
                    CASE "*"
                        dblRes = dblNum1 * dblNum2
                        IF SGN(dblNum1) = -1 AND SGN(dblNum2) = -1 THEN
                            strASuma = "+"
                        END IF
                    CASE "/"
                        IF dblNum2 = 0 THEN
                            iError = 8
                            dblRes = 0
                        ELSE
                            dblRes = dblNum1 / dblNum2
                        END IF
                        IF SGN(dblNum1) = -1 AND SGN(dblNum2) = -1 THEN
                            strASuma = "+"
                        END IF
                    CASE "+": dblRes = dblNum1 + dblNum2
                    CASE "-": dblRes = dblNum1 - dblNum2
                END SELECT

                ' Removes scientific notation if any
                dblRes = CDBL(CLNG(dblRes * 1000000) / 1000000)
                strRes = LTRIM$(STR$(dblRes))
                iNC = INSTR(strRes, "D")
                IF iNC > 0 THEN
                    GOSUB RemoverNotacionCientifica
                    IF Debug THEN PRINT "Removi la notacion cientifica."
                END IF

                IF Debug THEN
                    PRINT "dblRes:"; dblRes; "strRes: "; strRes
                    IF INSTR(strRes, "D") THEN
                        WHILE INKEY$ = "": WEND
                    END IF
                END IF

                ' If the first character is a negative sign and the operation is an addition
                IF LEFT$(strSubFormula, 1) = "-" AND strOperacion = "+" THEN
                    ' If the operator position is greater than 1
                    IF iPosI > 1 THEN ' There is a negative number at left-side, so it is needed to force the addition adding the opperator
                        strSubFormula = LEFT$(strSubFormula, iPosI - 1) + strOperacion + strRes + MID$(strSubFormula, iPosD + 1)
                    ELSE
                        strSubFormula = LEFT$(strSubFormula, iPosI - 1) + strRes + MID$(strSubFormula, iPosD + 1)
                    END IF
                ELSE
                    strSubFormula = LEFT$(strSubFormula, iPosI - 1) + strASuma + strRes + MID$(strSubFormula, iPosD + 1)
                END IF

                IF Debug THEN
                    PRINT "strSubFormula="; strSubFormula
                    IF INSTR(strSubFormula, "D") > 0 THEN
                        PRINT "strFormula="; strFormula
                        WHILE INKEY$ = "": WEND
                    END IF
                END IF

            ELSE
                iOperacion = iOperacion + 1
            END IF
        ELSE
            iOperacion = iOperacion + 1
        END IF
    LOOP UNTIL iOperacion > 3
    RETURN

    RemoverNotacionCientifica:
    iNC = INSTR(strRes, "D")
    IF iNC = 0 THEN
        iNC = INSTR(strRes, "E")
    END IF
    IF iNC > 0 THEN
        strNC = LEFT$(strRes, iNC - 1)
        iNC = VAL(MID$(strRes, iNC + 1))
        ' strNC = LEFT$(strNC, LEN(strNC) - iNC)
        iNCPD = INSTR(strNC, ".")
        strNC = LEFT$(strNC, iNCPD - 1) + MID$(strNC, iNCPD + 1)
        iNCPD = iNCPD + iNC
        IF iNCPD < 0 THEN
            strNC = "." + STRING$(iNCPD, "0") + strNC
        ELSEIF iNCPD > LEN(strNC) THEN
            strNC = strNC + STRING$(iNCPD - LEN(strNC), "0") + "."
        ELSE
            strNC = LEFT$(strNC, iNCPD) + "." + MID$(strNC, iNCPD)
        END IF
        strRes = strNC
    END IF
    RETURN
END FUNCTION

FUNCTION CErr% ()
    ' Var
    SHARED iError AS INTEGER

    CErr = iError
END FUNCTION

SUB Constructor ()
    ' Var
    SHARED iError AS INTEGER
    SHARED strExpresion AS STRING
    SHARED aregVariables() AS RegistroVar

    ' Initializes the string value
    strExpresion = ""
    iError = 0
    REDIM aregVariables(0 TO 0) AS RegistroVar
END SUB

' Returns how many variables are in memory
FUNCTION CuentaVar% ()
    ' Var
    SHARED aregVariables() AS RegistroVar

    CuentaVar = UBOUND(aregVariables)
END FUNCTION

FUNCTION DErr$ ()
    ' Var
    DIM strError AS STRING ' The string with the description of the error
    SHARED iError AS INTEGER

    ' Returns the text with the error description
    SELECT CASE iError
        CASE 0: strError = "Operation succeed"
        CASE 1: strError = "Special characters not allowed"
        CASE 2: strError = "Variable name doesn't exist"
        CASE 3: strError = "Only numeric values accepted"
        CASE 4: strError = "There are uninitialized variables"
        CASE 5: strError = "No expression to evaluate"
        CASE 6: strError = "Parentheses pairs don't match"
        CASE 7: strError = "Variable name aleady exists"
        CASE 8: strError = "Cannot divide by zero"
        CASE 9: strError = "Haven't executed the constructor"
    END SELECT
  
    DErr = strError
END FUNCTION

SUB Destructor ()
    ' Var
    SHARED iError AS INTEGER

    ' Cleans the variables of the list and others. This is not strictly
    '  needed, but is a good programming practice to free the resources.
    setExpresion ""
    iError = 0
    doLimpiaVar
END SUB

' Gets rid of all variables in the buffer
SUB doLimpiaVar ()
    ' Var
    SHARED aregVariables() AS RegistroVar

    ERASE aregVariables
    REDIM aregVariables(0 TO 0) AS RegistroVar
END SUB

' Gets rid of the indicated variable in the varVariable parameter
SUB doRemVar (varVariable AS STRING)
    ' Var
    DIM i AS INTEGER
    DIM j AS INTEGER
    DIM x AS INTEGER
    DIM l AS INTEGER
    REDIM aregX(0 TO 0) AS RegistroVar
    SHARED iError AS INTEGER
    SHARED aregVariables() AS RegistroVar

    iError = 0
    i = VAL(varVariable)
    IF i = 0 THEN
        i = BuscaVar(varVariable)
    END IF

    IF i > 0 THEN
        x = UBOUND(aregVariables)
        REDIM aregX(0 TO x - 1) AS RegistroVar
        l = 0
        FOR j = 1 TO x
            IF j <> i THEN
                l = l + 1
                aregX(l) = aregVariables(j)
            END IF
        NEXT j
        x = x - 1
        REDIM aregVariables(0 TO x) AS RegistroVar
        FOR j = 1 TO x
            aregVariables(j) = aregX(j)
        NEXT j
        ERASE aregX
    ELSE
        iError = 2
    END IF
END SUB

FUNCTION Expresion$ ()
    ' Var
    SHARED strExpresion AS STRING

    ' Gets the string to evaluate
    Expresion = strExpresion
END FUNCTION

' In this procedure are gathered the strings with the variable names
'  included in the provided formula.
'  This procedure will find those variables that
'  fulfill the requirements of a variable name, although it will
'  limit the names to 24 characters:
'  MyData, Data1, Numeric_Value.
' It will reject special characters, like accented letters and ñ. If any, this procedure
'  will issue an error.
SUB getObtieneVar ()
    ' Var
    DIM strVariable AS STRING
    DIM strCaracter AS STRING * 1
    DIM iIniVar AS INTEGER
    DIM iInicio AS INTEGER
    DIM iFinal AS INTEGER
    DIM bFinVar AS INTEGER
    SHARED iError AS INTEGER
    SHARED strExpresion AS STRING
    SHARED aregVariables() AS RegistroVar
  
    iError = 0
    IF SinAcentos(strExpresion) THEN
        ' Check the string to find variable names
        iInicio = 1
        iIniVar = 0
        iFinal = 1
        DO WHILE iInicio <= LEN(strExpresion)
            strCaracter = UCASE$(MID$(strExpresion, iInicio, 1))
            IF strCaracter >= "A" AND strCaracter <= "Z" AND iIniVar = 0 THEN
                ' It found a letter... Now, find where it ends for the variable name.
                iFinal = iInicio + 1
                bFinVar = FALSE
                DO
                    IF iFinal <= LEN(strExpresion) THEN
                        strCaracter = UCASE$(MID$(strExpresion, iFinal, 1))
                        IF (strCaracter >= "A" AND strCaracter <= "Z") OR (strCaracter >= "0" AND strCaracter <= "9") OR strCaracter = "_" THEN
                            iFinal = iFinal + 1
                        ELSE
                            bFinVar = TRUE
                        END IF
                    ELSE
                        bFinVar = TRUE
                    END IF
                LOOP UNTIL bFinVar
        
                ' Get the variable name
                strVariable = MID$(strExpresion, iInicio, iFinal - iInicio)
        
                ' Add the variable to the variable list
                setNuevaVar strVariable
                iError = 0
                iInicio = iFinal
                iIniVar = 0
            ELSE
                IF (strCaracter >= "0" AND strCaracter <= "9") OR strCaracter = "." THEN
                    IF iIniVar = 0 THEN
                        iIniVar = iInicio
                    END IF
                ELSE
                    iIniVar = 0
                END IF
                iInicio = iInicio + 1
            END IF
        LOOP
    END IF
END SUB

' Private procedure to calculate the formula,
'  includes the verification of the law of the signs (Alejandro Juarez).
FUNCTION LimpiaFormula# (strFormula AS STRING)
    DIM iPos AS INTEGER
    DIM i AS INTEGER
    DIM strSignos AS STRING
    DIM strLey AS STRING
   
    ' Gets rid of blank spaces to test the law of signs
    DO
        iPos = INSTR(strFormula, SPACE$(1))
        IF iPos > 0 THEN
            strFormula = MID$(strFormula, 1, iPos - 1) + MID$(strFormula, iPos + 1)
        END IF
    LOOP UNTIL iPos = 0
   
    ' Do the modifications according the law of signs ( - by + equals - ), etcetera.
    strSignos = "+++--+--"
    FOR i = 1 TO 4
        strLey = MID$(strSignos, 1, 2)
        DO
            iPos = INSTR(strFormula, strLey)
            IF iPos > 0 THEN
                SELECT CASE strLey
                    CASE "++", "--"
                        strFormula = MID$(strFormula, 1, iPos - 1) + "+" + MID$(strFormula, iPos + 2)
                    CASE "+-", "-+"
                        strFormula = MID$(strFormula, 1, iPos - 1) + "-" + MID$(strFormula, iPos + 2)
                END SELECT
            END IF
        LOOP UNTIL iPos = 0
        strSignos = MID$(strSignos, 3)
    NEXT
    LimpiaFormula = CalculaFormula(strFormula)
END FUNCTION

' Returns the name of the variable in the indicated possition
FUNCTION NombreVar$ (iCualVariable AS INTEGER)
    ' Var
    SHARED iError AS INTEGER
    SHARED aregVariables() AS RegistroVar
  
    iError = 0
    IF iCualVariable > 0 AND iCualVariable <= UBOUND(aregVariables) THEN
        NombreVar = RTRIM$(aregVariables(iCualVariable).Nombre)
    ELSE
        iError = 2
        NombreVar = ""
    END IF
  
END FUNCTION

' Gets the number at the right of the sign
FUNCTION NumDer# (strCadena AS STRING, iPos AS INTEGER, iPosD AS INTEGER)
    ' Var
    DIM strCar AS STRING * 1
    DIM bNumero AS INTEGER
    DIM strNumDer AS STRING
  
    iPosD = iPos + 1
    bNumero = FALSE
    strNumDer = ""
    IF iPosD <= LEN(strCadena) THEN
        DO
            strCar = MID$(strCadena, iPosD, 1)
            IF (strCar >= "0" AND strCar <= "9") OR strCar = "." OR strCar = " " OR strCar = "-" OR strCar = "+" THEN
                'IF (strCar >= "0" AND strCar <= "9") OR strCar = "." OR strCar = " " OR strCar = "-" THEN
                IF (strCar >= "0" AND strCar <= "9") OR strCar = "." THEN
                    bNumero = TRUE
                END IF
        
                IF iPosD < LEN(strCadena) THEN
                    IF (strCar = "-" OR strCar = "+") AND NOT bNumero THEN
                        ' IF strCar = "-" AND NOT bNumero THEN
                        iPosD = iPosD + 1
                        bNumero = TRUE
                        strNumDer = strNumDer + strCar
                    ELSEIF strCar <> "-" AND strCar <> "+" THEN
                        iPosD = iPosD + 1
                        strNumDer = strNumDer + strCar
                    ELSEIF strCar = "-" OR strCar = "+" THEN
                        iPosD = iPosD - 1
                        EXIT DO
                    END IF
                ELSE
                    strNumDer = strNumDer + strCar
                    EXIT DO
                END IF
            ELSE
                iPosD = iPosD - 1
                EXIT DO
            END IF
        LOOP

        NumDer = CDBL(VAL(strNumDer))
        ' NumDer = VAL(LTRIM$(RTRIM$(MID$(strCadena, iPos + 1, iPosD - iPos))))
    ELSE
        NumDer = 0
    END IF

END FUNCTION

' Gets the number at the left of the sign
FUNCTION NumIzq# (strCadena AS STRING, iPos AS INTEGER, iPosI AS INTEGER)
    ' Var
    DIM strCar AS STRING * 1

    iPosI = iPos - 1

    IF iPosI > 0 THEN
        DO
            strCar = MID$(strCadena, iPosI, 1)
            IF (strCar >= "0" AND strCar <= "9") OR strCar = "." OR strCar = " " OR strCar = "-" THEN
                IF iPosI > 1 THEN
                    IF (INSTR(strCadena, "^") > 0 OR INSTR(strCadena, "*") > 0 OR INSTR(strCadena, "/") > 0 OR INSTR(strCadena, "+") > 0) AND strCar = "-" THEN
                        '***** CODIGO CORREGIDO ******'
                        IF strCar = "-" THEN
                            EXIT DO
                        END IF
                        iPosI = iPosI - 1
                    ELSEIF strCar <> "-" THEN
                        iPosI = iPosI - 1
                    ELSE
                        EXIT DO
                    END IF
                ELSE
                    EXIT DO
                END IF
            ELSE
                iPosI = iPosI + 1
                EXIT DO
            END IF
        LOOP

        NumIzq = VAL(LTRIM$(MID$(strCadena, iPosI, iPos - iPosI)))
    ELSE
        NumIzq = 0
    END IF
END FUNCTION

' Set the string to evaluate
SUB setExpresion (strCualExpresionEvaluar AS STRING)
    ' Var
    SHARED strExpresion AS STRING

    strExpresion = strCualExpresionEvaluar
END SUB

' Ads a variable to the context.
' If the variable already exists, it will not add it
'  and returns an error.
SUB setNuevaVar (strNombre AS STRING)
    ' Var
    DIM i AS INTEGER
    DIM j AS INTEGER
    REDIM aregX(0 TO 0) AS RegistroVar
    SHARED iError AS INTEGER
    SHARED aregVariables() AS RegistroVar
          
    ' Check if this variable name already exists
    iError = 0
    IF SinAcentos(strNombre) THEN
        i = BuscaVar(strNombre)

        IF i = 0 THEN
            i = UBOUND(aregVariables) + 1
            REDIM aregX(0 TO i) AS RegistroVar
            FOR j = 1 TO i - 1
                aregX(j) = aregVariables(j)
            NEXT j
            REDIM aregVariables(0 TO i) AS RegistroVar
            FOR j = 1 TO i - 1
                aregVariables(j) = aregX(j)
            NEXT j
            aregVariables(i).Nombre = strNombre
            aregVariables(i).Valor = ""
            ERASE aregX
        ELSE
            iError = 7
        END IF
    END IF
END SUB

' Sets a new value (varValor) to the indicated variable name (varVariable)
SUB setNuevoValor (varVariable AS STRING, varValor AS DOUBLE)
    ' Var
    DIM i AS INTEGER
    SHARED iError AS INTEGER
    SHARED aregVariables() AS RegistroVar

    iError = 0
    i = VAL(varVariable)
    IF i = 0 THEN
        i = BuscaVar(varVariable)
    END IF

    IF i > 0 AND i <= UBOUND(aregVariables) THEN
        LSET aregVariables(i).Valor = MKD$(varValor)
    END IF
END SUB

' This function determines if the string has accents or strange characters
FUNCTION SinAcentos% (strCadena AS STRING)
    DIM i AS INTEGER
    DIM strCaracter AS STRING * 1
    DIM bCorrecto AS INTEGER
    SHARED iError AS INTEGER
  
    ' Evaluate if there are characters beyond 127 in the string
    iError = 0
    bCorrecto = TRUE
    i = 127
    DO WHILE bCorrecto AND i < 256
        strCaracter = CHR$(i)
        IF INSTR(strCadena, strCaracter) > 0 THEN
            iError = 1
            bCorrecto = FALSE
        END IF
        i = i + 1
    LOOP
    SinAcentos = bCorrecto
END FUNCTION

' Substitues variable names with values in the string
FUNCTION SustituyeVars$ ()
    ' Var
    DIM strMalos AS STRING
    DIM iEncontrado AS INTEGER
    DIM strVariable AS STRING
    DIM strCaracter AS STRING * 1
    DIM bCorrecto AS INTEGER
    DIM j AS INTEGER
    DIM x AS INTEGER
    DIM strCadena AS STRING
    SHARED strExpresion AS STRING
    SHARED aregVariables() AS RegistroVar

    strCadena = UCASE$(strExpresion)
    strMalos = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"
    x = UBOUND(aregVariables)
    FOR j = 1 TO x
        strVariable = UCASE$(RTRIM$(aregVariables(j).Nombre))
        iEncontrado = 1
        DO
            iEncontrado = INSTR(iEncontrado, strCadena, strVariable)
            IF iEncontrado > 0 THEN
                bCorrecto = TRUE
                IF iEncontrado > 1 THEN
                    strCaracter = MID$(strCadena, iEncontrado - 1, 1)
                    bCorrecto = (INSTR(strMalos, strCaracter) = 0)
                END IF

                IF bCorrecto THEN
                    strCaracter = MID$(strCadena, iEncontrado + LEN(strVariable), 1)
                    bCorrecto = (INSTR(strMalos, strCaracter) = 0)
                END IF

                IF bCorrecto THEN
                    strCadena = LEFT$(strCadena, iEncontrado - 1) + LTRIM$(STR$(Valor(strVariable))) + MID$(strCadena, iEncontrado + LEN(strVariable))
                    iEncontrado = 1
                ELSE
                    iEncontrado = iEncontrado + 1
                END IF
            ELSE
                iEncontrado = 1
            END IF
        LOOP UNTIL INSTR(iEncontrado, strCadena, strVariable) = 0
    NEXT j

    SustituyeVars = strCadena
END FUNCTION

' Gets the value of the variable indicated in varVariable
FUNCTION Valor# (varVariable AS STRING)
    ' Var
    DIM i AS INTEGER
    SHARED aregVariables() AS RegistroVar
    SHARED iError AS INTEGER

    iError = 0
    i = VAL(varVariable)
    IF i = 0 THEN
        i = BuscaVar(varVariable)
    END IF

    IF i > 0 AND i <= UBOUND(aregVariables) THEN
        IF RTRIM$(aregVariables(i).Valor) <> "" THEN
            Valor = CVD(aregVariables(i).Valor)
        ELSE
            Valor = 0
            iError = 4
        END IF
    ELSE
        Valor = 0
        iError = 2
    END IF

END FUNCTION

' Verifies if all assigned variables have values
FUNCTION VerificaVar% ()
    ' Var
    DIM bCorrecto AS INTEGER
    DIM x AS INTEGER
    DIM i AS INTEGER
    SHARED iError AS INTEGER
    SHARED aregVariables() AS RegistroVar

    iError = 0
    bCorrecto = TRUE
    x = UBOUND(aregVariables)
    IF x > 0 THEN
        FOR i = 1 TO x
            IF RTRIM$(aregVariables(i).Valor) = "" THEN
                iError = 4
                bCorrecto = FALSE
                EXIT FOR
            END IF
        NEXT i
    END IF
    VerificaVar = bCorrecto
END FUNCTION