Buscamos urgentemente un programa VB para diseñar un programa de cálculo simple de cuatro expresiones. ¡Urgente, urgente, urgente! ! ! ! ! ! ! !
Puede que te resulte útil, échale un vistazo
VERSIÓN 5.00
Comenzar VB.Form ExpressionForm
Caption="Expresión"
ClientHeight = 2310
ClientLeft = 1380
ClientTop = 2100
ClientWidth = 6615
LinkTopic = " Form1"
PaletteMode = 1 'UseZOrder
ScaleHeight = 2310
ScaleWidth = 6615
Comenzar VB.TextBox ExprText
Alto = 285
Izquierda = 0
TabIndex = 0
Superior = 360
Ancho = 3615
p>Fin
Comenzar VB.CommandButton CmdEvaluate
Apariencia = 0 'Plano
Color de fondo = &H80000005&
Título = " Evaluar"
Predeterminado = -1 'Verdadero
Alto = 495
Izquierda = 1200
TabIndex = 11
Arriba = 960
Ancho = 1215
Fin
Comenzar VB.Frame Marco1
Apariencia = 0 'Plano
Caption = "Primitivos"
ForeColor = &H80000008&
Alto = 2295
Izquierda = 3720
TabIndex = 12
Arriba = 0
Ancho = 2895
Comenzar VB.TextBox NombreTexto
Alto = 285
Índice = 0
Izquierda = 240
TabIndex = 1
Superior = 480
Ancho = 1215
Fin
Comenzar VB.TextBox ValueText
Alto = 285
Índice = 0
Izquierda = 1560
TabIndex = 2
Superior = 480
Ancho = 1215
Fin
Comenzar VB.TextBox NameText
Alto = 285
Índice = 1
Izquierda = 240
TabIndex = 3
Superior = 840
Ancho = 1215
Fin
Comenzar VB.TextBox ValueText
Altura = 285
Índice = 1
Izquierda = 1560
Pestaña
dex = 4
Superior = 840
Ancho = 1215
Fin
Comenzar VB.TextBox NombreTexto
Alto = 285
Índice = 2
Izquierda = 240
TabIndex = 5
Arriba = 1200
Ancho = 1215
Fin
Comenzar VB.TextBox ValueText
Alto = 285
Índice = 2
Izquierda = 1560
TabIndex = 6
Arriba = 1200
Ancho = 1215
Fin
Comenzar VB .TextBox NombreText
Alto = 285
Índice = 3
Izquierda = 240
TabIndex = 7
Superior = 1560
Ancho = 1215
Fin
Inicio VB.TextBox ValueText
Alto = 285
Índice = 3
Izquierda = 1560
TabIndex = 8
Superior = 1560
Ancho = 1215
Fin
Comenzar VB.TextBox NameText
Alto = 285
Índice = 4
Izquierda = 240
TabIndex = 9
Arriba = 1920
Ancho = 1215
Fin
Comenzar VB.TextBox ValueText
Alto = 285
Índice = 4
Izquierda = 1560
TabIndex = 10
Arriba = 1920
Ancho = 1215
Fin
Comenzar VB.Label Etiqueta1
Apariencia = 0 'Plano
Título = "Nombre"
ForeColor = &H80000008&
Alto = 255
Índice = 0
Izquierdo = 240
TabIndex = 14
Superior = 240
Ancho = 615
Fin
Comienzo VB.Label Etiqueta1
Apariencia = 0 'Plano
Título = "Valor"
ForeColor = &H80000008&
Alto = 255
Índice = 1
Izquierda = 1560
TabIndex = 13
Superior = 240
Ancho = 615
Fin
Fin
Comenzar VB.Label Label2
Apariencia = 0 'Plano
Título =
"Expresión"
ForeColor = &H80000008&
Alto = 255
Izquierda = 0
TabIndex = 17
Superior = 0
Ancho = 975
Fin
Comienzo VB.Label Label3
Apariencia = 0 'Plano
Caption = "Resultado"
ForeColor = &H80000008&
Alto = 255
Izquierda = 480
TabIndex = 16
Superior = 1800
Ancho = 615
Fin
Comenzar VB.Label ResultLabel
BorderStyle = 1 'Fijo Único
Alto = 255
Izquierda = 1200
TabIndex = 15
Superior = 1800
Ancho = 1215
Fin
Fin
Atributo VB_Name = "ExpressionForm"
Atributo VB_GlobalNameSpace = False
Atributo VB_Creatable = False
Atributo VB_PredeclaredId = True
Atributo VB_Exposed = False
Opción explícita
Atenuar primitivas como colección
'************************************************
' Evalúa la expresión.
' ******************************* *******************
Función privada EvaluateExpr(ByVal expr As String) como única
Const PREC_NONE = 11
Const PREC_UNARY = 10 ' En realidad no se utiliza.
Const PREC_POWER = 9
Const PREC_TIMES = 8
Const PREC_DIV = 7
Const PREC_INT_DIV = 6
Const PREC_MOD = 5
Const PREC_PLUS = 4
Atenuar is_unary como booleano
Atenuar next_unary Como booleano
Dim parens como entero
Dim pos como entero
Dim expr_len como entero
Dim ch como cadena
Atenuar lexpr como cadena
Atenuar rexpr como cadena
Atenuar valor como cadena<
/p>
Atenuar estado siempre
Atenuar best_pos como entero
Atenuar best_prec como entero
' Elimina los espacios en blanco iniciales y finales.
expr = Trim$(expr)
expr_len = Len(expr)
Si expr_len = 0 entonces salimos de la función
' Si encontramos + o - ahora, es un operador unario.
is_unary = True
' Hasta ahora no tenemos nada.
best_prec = PREC_NONE
' Encuentra el operador con menor precedencia.
' Busca lugares donde no hay paréntesis abiertos
'.
For pos = 1 To expr_len p>
' Examina el siguiente carácter.
ch = Mid$(expr, pos, 1)
' Supongamos que no encontraremos un operador en
' en ese caso el siguiente operador no
' será unario.
next_unary = False
Si ch = " " Entonces
' Simplemente omita espacios.
next_unary = is_unary
ElseIf ch = "(" Then
' Incrementa el número de paréntesis abiertos.
parens = parens + 1
' Un operador después de "(" es unario.
next_unary = True
ElseIf ch = ")" Entonces
' Disminuye el recuento de paréntesis abiertos.
parens = parens - 1
' Un operador después de ")" es unario.
next_unary = True
' Si los pares < 0, demasiados ')'s.
Si los pares < 0 Entonces
Err.Raise vbObjectError + 1001, _
p>"EvaluateExpr", _
"Demasiados )s en '" & _
expr & "'"
End If
ElseIf parens = 0 Then
' Vea si se trata de un operador.
If ch = "^" Or ch = "*" Or _
ch = "/" O ch = "\" O _
ch = "%" O ch = "+" O _
ch = " -" _
Entonces
' Un operador después de un operador
' es unario.
next_unary = True
Seleccione caso ch
Caso "^"
Si best_prec >= PREC_POWER Entonces
best_prec = PREC_POWER
best_pos = pos
Fin Si
Caso "*", "/"
Si best_prec >= PREC_TIMES Entonces
best_prec = PREC_TIMES
best_pos = pos
Finalizar si
Caso "\"
Si best_prec >= PREC_INT_DIV Entonces
best_prec = PREC_INT_DIV
best_pos = pos
Finalizar si
Caso "%"
Si best_prec >= PREC_MOD Entonces
best_prec = PREC_MOD
best_pos = pos
End If
Caso "+", "-"
' Ignorar operadores unarios
' por ahora .
Si (No es_unario) Y _
best_prec >= PREC_PLUS _
Entonces
best_prec = PREC_PLUS
best_pos = pos
Finalizar si
Finalizar selección
Finalizar si
Finalizar si
is_unary = next_unary
Siguiente pos
' Si el recuento de paréntesis no es cero,
' falta un ')'.
Si los paréntesis <> 0 Entonces
Err.Raise vbObjectError + 1002, _
"EvaluateExpr", "Missing ) in '" & _
expr & "'"
End If
' Ojalá tengamos el operador.
Si best_prec < PREC_NONE Entonces
lexpr = Left$(expr, best_pos - 1)
reexpr = Correcto$(expr, expr_len - best_pos)
Seleccione Caso Medio$(expr, best_pos, 1)
Caso "^"
EvaluarExpr = _
EvaluarExpr(lexpr) ^ _
EvaluarExpr(reexpr)
Caso "*"
EvaluarExpr = _
EvaluarExpr(lexpr) * _
EvaluarExpr
(reexpr)
Caso "/"
EvaluarExpr = _
EvaluarExpr(lexpr) / _
EvaluarExpr(reexpr)
Caso "\"
EvaluarExpr = _
EvaluarExpr(lexpr) \ _
EvaluarExpr(reexpr)
Caso "%"
EvaluateExpr = _
EvaluateExpr(lexpr) Mod _
EvaluateExpr(reexpr)
Caso "+"
EvaluarExpr = _
EvaluarExpr(lexpr) + _
EvaluarExpr(reexpr)
Caso "-"
EvaluarExpr = _
EvaluarExpr(lexpr) - _
EvaluarExpr(reexpr)
Finalizar selección
Salir de función
End If
' Si aún no tenemos un operador,
' hay varias posibilidades:
'
' 1. expr es (expr2) para algunos expr2.
' 2. expr es -expr2 o +expr2 para algunos expr2.
' 3. expr es Fun(expr2) para una función divertida.
' 4. expr es una primitiva.
' 5. Es un literal como "3.14159".
' Busque (expr2) .
Si Izquierda$(expr, 1) = "(" Y Derecha$(expr, 1) = ")" Entonces
' Elimina los paréntesis.
EvaluarExpr = EvaluarExpr(Mid$(expr, 2, expr_len - 2))
Función de salida
Finalizar si
' Busque -expr2.
Si Izquierda$(expr, 1) = "-" Entonces
EvaluarExpr = -EvaluarExpr( _
Derecha$(expr, expr_len - 1))
Salir de la función
Finalizar si
' Busque +expr2.
Si queda$(expr, 1) = "+" Entonces
EvaluarExpr = EvaluarExpr( _
Derecha$(expr, expr_len - 1))
Salir de la función
Finalizar si
' Busque Diversión(expr2).
Si expr_len > 5 Y Derecha$(expr, 1) = ")" Entonces
lexpr = LCase$(Izquierda$ (exp.
r, 4))
reexpr = Mid$(expr, 5, expr_len - 5)
Seleccione caso lexp
Caso "sin("
EvaluarExpr = Sin(EvaluarExpr(reexpr))
Salir de la función
Caso "cos("
EvaluarExpr = Cos(EvaluarExpr(reexpr))
Salir de la función
Caso "tan("
EvaluarExpr = Tan(EvaluarExpr(reexpr))
Salir de la función
Caso "sqr("
EvaluarExpr = Sqr(EvaluarExpr(reexpr))
Salir de la función
Finalizar selección
Fin If
' Vea si es una primitiva.
En caso de error, reanudar siguiente
valor = Primitives.Item(expr)
status = Err.Number
En caso de error, Ir a 0
Si estado = 0, entonces
EvaluateExpr = CSng(valor)
Salir de la función
End If
' Debe ser un literal como "2.71828".
En caso de error, reanudar siguiente
EvaluarExpr = CSng(expr)
status = Err.Number
En caso de error, Ir a 0
Si el estado <> 0, entonces
Estado de Err.Raise, _
"EvaluateExpr", _
"Error al evaluar '" & expr & _
"' como constante."
End If
Función final
' ********************************** ******************
' Evalúa la expresión ingresada por el usuario.
' ******** ****************************************
Sub CmdEvaluate_Click privado ()
Atenuar i como entero
Nombre atenuado como cadena
Valor atenuado como cadena
Expr atenuado como cadena
Dim rslt As Single
Dim pos As Integer
' Almacena las primitivas.
Establecer primitivas = Nueva colección
Para i = 0 a 4
nombre = Trim$(NameText(i).Text)
val
ue = Trim$(ValueText(i).Text)
Si nombre <> "" Y valor <> "" Entonces
Primitivas.Agregar valor, nombre
End If
Next i
' Obtiene la expresión.
expr = ExprText.Text
' Evalúa la expresión.
ResultLabel.Caption = ""
En caso de error, Ir a EvaluateError
rslt = EvaluateExpr(expr)
ResultLabel.Caption = Formato$( rslt)
Salir de Sub
EvaluarError:
Bip
MsgBox Err.Description
Fin de Sub