Este es un módulo que tenía para procesar expresiones
en BASIC, con sus variables y todo ese rollo.
Lo he retomado por una consulta que me hicieron, que al final resultaron dos del mismo
tema.
Así que aquí la pongo para el que la quiera usar, se admiten sugerencias, mejoras y si
la amplias,
me lo
cuentas.
Si quieres bajar los listados, pincha aquí.
El procedimiento Formula recibe dos
parámetros, el primero es la expresión a procesar y el segundo son las variables a usar,
el resultado se devuelve en el segundo parámetro, por tanto el segundo debe ser
una variable.
Por ejemplo:
sVar$ = "A=10, B=25, C=(B-A)/2"
sForm$ = "A * B + INT(10*C)"
Formula sForm, sVar
Devolvería 325
O sea, que una variable puede estar formada por una
expresión y usando los valores de otras varibales.
Los únicos "operadores" que reconoce son, además de los clásicos +, -, /, *.
^ también entiende el INT y se puede usar un IF/ELSE un tanto particular, por ejemplo:
IF B>10;A*2 ;ELSE A/2
Se debe usar un punto y coma (;) después de la expresión a evaluar y otro delante del
ELSE, sé que es rudimentario, pero algo es algo.
De todas formas a ver si encuentro un "intérprete" de BASIC que me fabriqué y que lo tengo que tener por ahí, ya que creo que en él tenía mejorado el tema del cálculo de las expresiones además de permitir más "instrucciones"
Bien, vamos a ver el listado y además acompaño un form
de prueba, para que veas que funciona.
Tal como está el programa ahora mismo, sólo acepta variables de una sola letra, pero eso
será fácil de modificar, espero, también hay que aclarar que sólo procesa de izquierda
a derecha, salvo que se usen paréntesis, es decir que en basic la multiplicación y
división se procesan antes que la suma o la resta, en esta versión no se hace así, por
tanto:
10 + 2 * 3 dará como resultado 36 (12 * 3)
Sin embargo esta expresión producirá el resultado esperado:
10 + (2 * 3) dará 16 (10+ 6)
Si en la expresión pasada como fórmula se incluye una
variable que no existe, simplemente se ignora y si se hace una asignación, se tomará el
valor que hay después del signo igual, eliminándose la asignación, osea que cualquier
carácter no "esperado", simplemente se ignora.
Por ejemplo: X=10+25*A será lo mismo que 10+25*A y lo mismo que X=10+25*A+X
Es decir como X no se ha declarado, se ignora totalmente, se supone que A tiene asignado
un valor
Como verás es un poco "añejo", pero a mi me ha servido para un programa de "caja-diaria"
'----------------------------------------------------------------------------
' Formula.bas (25/Sep/91)
'
'Adaptado a Visual Basic (10/Jun/97)
'
'(c)Guillermo Som, 1991-97
'
' Módulo con SUBprograma de proceso de fórmulas.
' Inicio : 25/Sep/91
' Término: 22/Oct/91
' 25/Oct/91 Añado condiciones IF ...
' 5/May/93 Añado condiciones ELSE ...
' 10/May/93 Corrección para números negativos,
' Nueva proceso para Calcular...
'
' Queda por mejorar el cálculo de variables, para meter entre paréntesis
' cuando sea una expresión en lugar de un valor constante.
' (El 5/May/93, ya estaba mejorado de antes, además de más condiciones en IF)
'----------------------------------------------------------------------------
Option Explicit
Private Sub BuscarCifra(Expresion$, Cifra$)
'-------------------------------------------------------------------------
'Buscar en f$ una cifra ( 5 / 10/May/93)
'-------------------------------------------------------------------------
Const OPERADORES = "+-*/^%"
Const CIFRAS = "0123456789. "
Const POSITIVO = 1, NEGATIVO = -1
Dim Signo%, ultima%, i%, n$
Expresion$ = LTrim$(Expresion$)
Signo = POSITIVO 'Comprobar si es un número negativo
If Left$(Expresion$, 1) = "-" Then
Signo = NEGATIVO
Expresion$ = Mid$(Expresion$, 2)
End If
ultima = 0
n$ = ""
For i = 1 To Len(Expresion$)
If InStr(CIFRAS, Mid$(Expresion$, i, 1)) Then
n$ = n$ + Mid$(Expresion$, i, 1)
ultima = i
Else
Exit For
End If
Next i
Cifra$ = Str$(Val(n$) * Signo)
Expresion$ = LTrim$(Mid$(Expresion$, ultima + 1))
End Sub
Private Sub Calcular(f$)
'--------------------------------------------------------------------------
' Calcula el resultado de la expresión que entra en f$ (22/Oct/91)
' Modificado por la cuenta de la vieja... (01.12 7/May/93)
'--------------------------------------------------------------------------
Dim Operador$, Cifra1$, Cifra2$
Dim n1#, n2#, n3#
Operador$ = ""
Cifra1$ = ""
Cifra2$ = ""
Do
'---Buscar la primera cifra
If Cifra1$ = "" Then
BuscarCifra f$, Cifra1$
End If
Operador$ = Left$(f$, 1)
f$ = Mid$(f$, 2)
'---Buscar la segunda cifra
BuscarCifra f$, Cifra2$
n1# = Val(Cifra1$)
n2# = Val(Cifra2$)
Select Case Operador$
Case "+"
n3# = n1# + n2#
Case "-"
n3# = n1# - n2#
Case "*"
n3# = n1# * n2#
Case "/"
If n2# <> 0# Then
n3# = n1# / n2#
Else
n3# = 0#
End If
Case "^"
n3# = n1# ^ n2#
Case "%"
n3# = n1# * (n2# / 100#)
Case Else
n3# = CDbl(Val(Cifra1$) + Val(Cifra2$))
End Select
Cifra1$ = Str$(n3#)
Loop While Operador$ <> ""
f$ = Str$(n3#)
End Sub
Public Sub Formula(Form$, Variable$)
'--------------------------------------------------------------(25/Sep/91)-
' Calcula la Formula$, usando los valores de Variable$
' devuelve el resultado al principio de Variable$, R=resultado
' Las variables deben ser una sola letra y deben estar separadas por comas
'--------------------------------------------------------------------------
Const DIGITOS = "0123456789."
Const SIGNOS = "+-*/%() "
Dim f$, Entero%, NumVar%, NombreVar$
Dim v$, i%, j%, k%, a$, Condicion%
Dim Cond$, Operador$, VarAct$, valor$
Dim p%, haymas%, pn%, strP$
f$ = Form$
v$ = Variable$
Entero = 0
'--------------------------------------------------------------------------
' Sustituir las variables dentro de la formula por el valor
'--------------------------------------------------------------------------
f$ = LTrim$(RTrim$(UCase$(f$)))
v$ = LTrim$(RTrim$(UCase$(v$)))
'--------------------------------------------------------------------------
'Quitar los espacios entre el nombre de la variable y el signo = (10/Jun/97)
'--------------------------------------------------------------------------
QuitarEspacios v$
'--------------------------------------------------------------------------
' Para comprobar si hay más variables (21/Oct/91)
'--------------------------------------------------------------------------
NumVar = 0
NombreVar$ = ""
For i = 1 To Len(v$)
If Mid$(v$, i, 1) = "=" Then
NombreVar$ = NombreVar$ + Mid$(v$, i - 1, 1)
NumVar = NumVar + 1
End If
Next
'--------------------------------------------------------------------------
' Guardar los valores de las variables (25/Oct/91)
'--------------------------------------------------------------------------
ReDim NomVar$(1 To NumVar)
NumVar = 0
For j = 1 To Len(v$)
If Mid$(v$, j, 1) = "=" Then
NumVar = NumVar + 1
For k = j + 1 To Len(v$)
a$ = Mid$(v$, k, 1)
If a$ = "," Then
Exit For
Else
NomVar$(NumVar) = NomVar$(NumVar) + a$
End If
Next
End If
Next
'--------------------------------------------------------------------------
' Se permiten condiciones en las fórmulas. (25/Oct/91)
' El formato será: IF <variable> OPERADOR <condición>;<fórmula>
' Si la <condición> es númerica, la comparación se hace como números.
' Ejemplo: IF A=10;INT(A+B*.05)
'--------------------------------------------------------------------------
If Left$(f$, 2) = "IF" Then
i = InStr(f$, ";")
Condicion = True
If i Then
Cond$ = LTrim$(RTrim$(Mid$(f$, 3, i - 3)))
f$ = Mid$(f$, i + 1)
'----------------------------------------------------------------------
' Comprobar la condición.
' Condiciones permitidas: igual (=), distinta (!=), menor (<), mayor (>)
' menor o igual (<=, =<), mayor o igual (>=, =>)
' El primer operando debe ser una variable.
'----------------------------------------------------------------------
Operador$ = Mid$(Cond$, 2, 2)
VarAct$ = Left$(Cond$, 1)
If InStr("=< => >= <=", Operador$) Then
j = InStr(NombreVar$, VarAct$)
valor$ = Mid$(Cond$, 4)
k = Val(valor$)
Condicion = False
If InStr("=< <=", Operador$) Then 'Menor o igual
If k Then
If Val(NomVar$(j)) <= Val(valor$) Then Condicion = True
Else
If NomVar$(j) <= valor$ Then Condicion = True
End If
ElseIf InStr("=> >=", Operador$) Then 'Mayor o igual
If k Then
If Val(NomVar$(j)) >= Val(valor$) Then Condicion = True
Else
If NomVar$(j) >= valor$ Then Condicion = True
End If
End If
ElseIf InStr("< >", Mid$(Cond$, 2, 1)) Then
j = InStr(NombreVar$, VarAct$)
valor$ = Mid$(Cond$, 3)
k = Val(valor$)
Condicion = False
If Mid$(Cond$, 2, 1) = "<" Then 'Menor
If k Then
If Val(NomVar$(j)) < Val(valor$) Then Condicion = True
Else
If NomVar$(j) < valor$ Then Condicion = True
End If
ElseIf Mid$(Cond$, 2, 1) = ">" Then 'Mayor
If k Then
If Val(NomVar$(j)) > Val(valor$) Then Condicion = True
Else
If NomVar$(j) > valor$ Then Condicion = True
End If
End If
ElseIf Mid$(Cond$, 2, 1) = "=" Then '= Igual
If InStr(v$, Cond$) = 0 Then
Condicion = False
End If
ElseIf Operador$ = "!=" Then '!= Distinta
Cond$ = Left$(Cond$, 1) + Mid$(Cond$, 3)
If InStr(v$, Cond$) Then
Condicion = False
End If
End If
Else
Condicion = False
End If
If Not Condicion Then
'----------------------------------------------------------------------
' Evaluar ELSE (;E/;ELSE) (16.37 5/May/93)
'----------------------------------------------------------------------
If InStr(f$, ";E") Then
i = InStr(f$, ";ELSE")
If i Then
i = i + 5
Else
i = InStr(f$, ";E") + 2
End If
f$ = Mid$(f$, i)
Condicion = True
End If
If Not Condicion Then
Variable$ = ""
Exit Sub
End If
Else
If InStr(f$, ";") Then
i = InStr(f$, ";")
f$ = Left$(f$, i - 1)
End If
End If
End If
'----------------------------------------------
'Admite que se convierta en entero (22/Oct/91)
'----------------------------------------------
If Left$(f$, 3) = "INT" Then
Entero = 1
f$ = Mid$(f$, 4)
End If
Do
i = 1
Do
a$ = Mid$(f$, i, 1)
If InStr(DIGITOS + SIGNOS, a$) = 0 Then
p = InStr(NombreVar$, a$) 'debe ser una variable
If p Then
f$ = Left$(f$, i - 1) + NomVar$(p) + Mid$(f$, i + 1)
End If
End If
i = i + 1
Loop Until i > Len(f$)
haymas = 0 'Comprobar si hay más variables
For i = 1 To NumVar
If InStr(f$, Mid$(NombreVar$, i, 1)) Then
haymas = 1
Exit For
End If
Next
Loop While haymas
'--------------------------------------------------------------------------
' Procesar la fórmula con los valores de las variables
'--------------------------------------------------------------------------
'
'Buscar paréntesis e ir procesando las expresiones.
Do While InStr(f$, "(")
pn = InStr(f$, ")")
If pn = 0 Then
Variable$ = "R= 0, " + Variable$
Exit Sub
End If
For i = pn To 1 Step -1
If Mid$(f$, i, 1) = "(" Then
strP = Mid$(f$, i + 1, pn - i - 1)
Calcular strP
f$ = Left$(f$, i - 1) + strP + Mid$(f$, pn + 1)
Exit For
End If
Next
Loop
Calcular f$
'Variable$ = "R=" + f$ + ", " + Variable$
If Entero Then
f$ = Str$((Int(Val(f$) + 0.5)))
End If
Variable$ = f$
End Sub
Private Sub QuitarEspacios(sVar As String)
'Quitar los espacios de sVar
Dim i As Integer
Dim sTmp As String
sTmp = sVar
sVar = ""
For i = 1 To Len(sTmp)
If Mid$(sTmp, i, 1) <> " " Then
sVar = sVar & Mid$(sTmp, i, 1)
End If
Next
End Sub
Este es el formulario de prueba, una "foto" y el listado:
'--------------------------------------------------------------
'Form para probar las rutinas de fórmulas (10/Jun/97)
'
'(c)Guillermo Som, 1997
'--------------------------------------------------------------
Option Explicit
'Constantes para los TextBox
Const cTxtNombreVar = 0
Const cTxtValorVar = 1
Const cTxtFormula = 2
'constantes para los labels
Const cLblResultado = 4
Private Sub cmdAddVar_Click()
'Añadir el contenido de a la lista de variables
Dim sTmp As String
sTmp = Text1(cTxtNombreVar) & " = " & Text1(cTxtValorVar)
List1.AddItem sTmp
End Sub
Private Sub cmdBorrarVar_Click()
'Borrar la variable que está seleccionada del ListBox
Dim i%
With List1
For i = .ListCount - 1 To 0 Step -1
If .Selected(i) Then
.RemoveItem i
End If
Next
End With
End Sub
Private Sub cmdCalcular_Click()
Dim sVar$, sFormula$
Dim i%
If List1.ListCount < 1 Then
MsgBox "No hay variables asignadas..." & vbCrLf & "Si se especifica alguna en la fórmula, se ignorará."
End If
For i = 0 To List1.ListCount - 1
sVar$ = sVar$ & List1.List(i) & ","
Next
'quitar la última coma
If Right$(sVar, 1) = "," Then
sVar = Left$(sVar, Len(sVar) - 1)
End If
'Procesar la fórmula
sFormula = Text1(cTxtFormula)
cmdCalcular.Caption = "Calculando..."
Formula sFormula, sVar
Label1(cLblResultado) = sVar
cmdCalcular.Caption = "Probar Fórmula"
End Sub
Private Sub Form_Load()
'inicio
'Variables a probar
'"A=10,B=2,C=(A+B),D=(C+B)"
'"A=2000, B=-500"
'Fórmulas a probar
'"(10 +(A*3) -5 +B +C +D)"
'"D*(100-3*C)+B*(3*(A-2))"
'"INT(" + Form$ + "*(99990000+(10%)))"
'"IF B>10;(1) ;ELSE (2)"
'"(1000 + B - A)"
'"INT(((1000 + B - A)*2)*(-1) + B*2 + A*2.5+.6)-1"
Dim i%
For i = 0 To 2
Text1(i) = ""
Next
Label1(cLblResultado) = ""
With List1
.AddItem "A = 2000"
.AddItem "B = -500"
.AddItem "C=(A+B)"
.AddItem "D=(C+B)"
End With
Text1(cTxtFormula) = "(1000 + B - A) - C * 2 + D"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set Form1 = Nothing
End Sub
Private Sub List1_Click()
'Recuperar la variable
Dim sTmp As String
Dim i As Integer
With List1
If .ListIndex > -1 Then
sTmp = .List(.ListIndex)
i = InStr(sTmp, "=")
If i Then
Text1(cTxtNombreVar) = Trim$(Left$(sTmp, i - 1))
Text1(cTxtValorVar) = Trim$(Mid$(sTmp, i + 1))
End If
End If
End With
End Sub
