(09/Feb/99) Pulsa aquí si quieres ver la nueva versión de este código...
Pulsa este link si quieres ver las revisiones del 11 y 22/Ene/2001
Nota del
02/Nov/2002:
Te recomiendo que veas el contenido de esta página que te
mantendrá al día
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 325O 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 valorComo 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 SubEste 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