可用分押宝游戏火热进行中...	专题改版：Java Web 专题

傻傻的问，怎样才能得到正确结果？？

楼主sunmaoyou（不懂大师）2003-08-03 21:23:28 在 VB / 基础类提问

在文本框里输入一个代数式子,比如说 3+2,
在另一个文本框里输入另外一个数,比如说5吧，
用val(text1.text)+val(text2.text)的值应该是10,可是实际上是8,怎样才能得到正确结果呢?
谢谢

问题点数：20、回复次数：10Top

1 楼skystar2001（波塞冬）回复于 2003-08-03 21:48:21 得分 0

如果象你所说的那样text1的功能就要类似与计算器了
要包括+,-,*,/四种运算
太复杂了~~~可简单的方法不知道有没有
关注中~~~~~Top

2 楼penglc（猎者）回复于 2003-08-03 21:48:44 得分 0

自己写个对text的分析过程，　　用split对"+" 和 "-"进行分割～　　然后再合计Top

3 楼skystar2001（波塞冬）回复于 2003-08-03 21:50:01 得分 0

怎样分割~~~那好象也不行啊~~
怎样合计呢~~
要有四种运算呀~~Top

4 楼lnhsgj（黑鹰）回复于 2003-08-03 21:53:08 得分 0

你说的是解析表达式。
好复杂的，在网上找找，有源码的。Top

5 楼sunmaoyou（不懂大师）回复于 2003-08-03 21:57:04 得分 0

大家帮我找找吧，谢了，我急着用的Top

6 楼skystar2001（波塞冬）回复于 2003-08-03 21:58:52 得分 0

xuexi ~~~Top

7 楼deng1107（游戏人间(.net)）回复于 2003-08-03 22:03:03 得分 0

判断有无＋－＊/号的出现，如果有则分离TEXT，进行相应的运算Top

8 楼csdngoodnight（居然比我还快，你真行！）回复于 2003-08-03 22:47:45 得分 20

给你一段代码，自己研究一下吧：
一个窗体，一个类模块，把代码粘上去就行了。

'窗体代码
'TextBox控件:Text1
'CommandButton控件:Command1

Option Explicit

Dim cEval As New Evaluator

Private Sub Command1_Click()
'按钮
cEval.Evaluate Text1.Text
End Sub

'类模块------------------------------------------------------
Option Explicit

Const PLUS_SIGN = "+"
Const MINUS_SIGN = "-"
Const MULTIPLY_SIGN = "*"
Const DIVIDE_SIGN = "/"
Const POWER_SIGN = "^"
Const POINT_SIGN = ","
Const BRACKET_LEFT = "("
Const BRACKET_RIGHT = ")"

Public Enum EvalError
ERR_NONE = 0
ERR_DBL_POINT = 1
ERR_WRONG_SYNTAX = 2
ERR_WRONG_SIGN = 4
ERR_WRONG_BRACKETS = 8
ERR_WRONG_FUNCTION = 16
End Enum

Private m_Assigned As Boolean
Private m_Expression As String
Private m_Result As Double
Private m_Error As EvalError

Public Property Let Expression(ByVal NewExpr As String)
m_Expression = ReplaceText(UCase(RemoveSpaces(NewExpr)), ".", _
POINT_SIGN)
End Property

Public Property Get Expression() As String
Expression = m_Expression
End Property

Public Property Get Error() As EvalError
Error = m_Error
End Property

Public Property Get Result() As Double
m_Error = ERR_NONE
m_Result = Eval(m_Expression)
m_Assigned = (m_Error = ERR_NONE)
Result = m_Result
End Property

Public Property Get Assigned() As Boolean
Assigned = m_Assigned
End Property

Public Function Evaluate(ByVal Expressn As String, _
Optional ByVal Silent As Boolean = False) As Double

Dim Res As Double
Expression = Expressn
Res = Result
If Not Silent Then
If m_Error <> ERR_NONE Then
Select Case m_Error
Case ERR_DBL_POINT: MsgBox "出错: 检查小数!", vbCritical, "出错"
Case ERR_WRONG_BRACKETS: MsgBox "出错: 请检查", vbCritical, "出错"
Case ERR_WRONG_SIGN: MsgBox "出错: 符号或其他", vbCritical, "出错"
Case ERR_WRONG_SYNTAX: MsgBox "出错: 语法!", vbCritical, "出错"
End Select
Else
MsgBox "结果: " & Res, vbExclamation, "输出"
End If
End If
Evaluate = m_Result
End Function

Private Function RemoveSpaces(S$) As String
RemoveSpaces = ReplaceText(S$)
End Function

Public Function ReplaceText(ByVal SourceText$, _
Optional ByVal StrToReplace$ = " ", _
Optional ByVal StrToInsert$ = "") As String

Dim RetS$, I%
If StrToReplace = StrToInsert Or StrToReplace = "" Then Exit Function
RetS = SourceText$
I = InStr(RetS, StrToReplace)
Do While I <> 0
RetS = IIf(I = 1, "", Left(RetS, I - 1)) & StrToInsert$ & IIf(I = Len(RetS) - Len(StrToReplace) + 1, "", Right(RetS, Len(RetS) - I - Len(StrToReplace) + 1))
I = InStr(RetS, StrToReplace)
Loop
ReplaceText = RetS
End Function

'***********************************************************

Private Function Eval(ByVal Expr As String) As Double
Dim sEval$, I&, MonomArray As Variant, dResult As Double
sEval = Expr
MonomArray = SplitToMonomials(sEval)
For I = LBound(MonomArray) To UBound(MonomArray)
dResult = dResult + CalcMonomial(MonomArray(I))
Next
Eval = dResult
End Function

Private Function SplitToMonomials(ByVal EvalStr As String, _
Optional ByVal Sign1 As String = PLUS_SIGN, _
Optional ByVal Sign2 As String = MINUS_SIGN) As Variant

Dim MonomArray As Variant, I&, Count&
Dim CurMonom As String, sEval As String
ReDim MonomArray(0)
sEval = EvalStr
I = GetSplitPos(EvalStr, Sign1, Sign2)
Do While I > 0
CurMonom = Left(sEval, I - 1)
ReDim Preserve MonomArray(Count)
MonomArray(Count) = CurMonom
Count = Count + 1
sEval = Mid(sEval, I)
I = GetSplitPos(sEval, Sign1, Sign2)
Loop

CurMonom = sEval
ReDim Preserve MonomArray(Count)
MonomArray(Count) = CurMonom
SplitToMonomials = MonomArray
End Function

Private Function CalcMonomial(ByVal Monomial As String) As Double
On Error GoTo ErrCalcMember
If m_Error <> ERR_NONE Then Exit Function
Dim MemberArray As Variant, Sign As String
Dim I&, dResult As Double, TempRes As Double
MemberArray = SplitToMonomials(Monomial, MULTIPLY_SIGN, DIVIDE_SIGN)
For I = LBound(MemberArray) To UBound(MemberArray)
TempRes = CalcMember(MemberArray(I), Sign)
Select Case Sign
Case PLUS_SIGN: dResult = dResult + TempRes
Case MULTIPLY_SIGN: dResult = dResult * TempRes
Case DIVIDE_SIGN: dResult = dResult / TempRes
End Select
Next
CalcMonomial = dResult
Exit Function
ErrCalcMember:
m_Error = ERR_WRONG_FUNCTION
End Function

Private Function CalcMember(ByVal Member As String, ByRef Sign As String) As Double
Dim sSign As String, sEval As String, HaveMinus As Boolean, GotNum1 As Boolean
Dim Num1 As Double, Num2 As Double, Op As String, dResult As Double
Dim Func As String, FuncExpr As String
If m_Error <> ERR_NONE Then Exit Function

Sign = PLUS_SIGN
sEval = Member
sSign = Left(sEval, 1)
If Not IsNumeric(sSign) Then
Select Case sSign
Case MINUS_SIGN
HaveMinus = True
sEval = Mid(sEval, 2)
If Left(sEval, 1) = BRACKET_LEFT Then GoTo LBrack
If IsNumeric(Left(sEval, 1)) = False Then GoTo HaveFunc
Case PLUS_SIGN, MULTIPLY_SIGN, DIVIDE_SIGN
Sign = sSign
sEval = Mid(sEval, 2)
If Left(sEval, 1) = BRACKET_LEFT Then GoTo LBrack
If IsNumeric(Left(sEval, 1)) = False Then GoTo HaveFunc
Case BRACKET_LEFT
LBrack:
Num1 = Eval(ExtractBrackets(sEval))
GotNum1 = True
Case Else
HaveFunc:
Func = ExtractFunction(sEval, FuncExpr)
Num1 = CalcFunction(Func, FuncExpr)
GotNum1 = True
End Select
End If
If Not GotNum1 Then Num1 = ExtractNumber(sEval)
If Len(sEval) <> 0 Then
Op = Left(sEval, 1)
sEval = Mid(sEval, 2)
If Left(sEval, 1) = BRACKET_LEFT Then
Num2 = Eval(ExtractBrackets(sEval))
Else
If IsNumeric(Left(sEval, 1)) = False Then
Func = ExtractFunction(sEval, FuncExpr)
Num2 = CalcFunction(Func, FuncExpr)
Else
Num2 = ExtractNumber(sEval)
End If
End If
Select Case Op
Case POWER_SIGN
On Error GoTo ErrCalcMember
dResult = Num1 ^ Num2
Case Else
m_Error = ERR_WRONG_SIGN
End Select
Else
dResult = Num1
End If
If Len(sEval) <> 0 Then m_Error = ERR_WRONG_SYNTAX
CalcMember = IIf(HaveMinus, -dResult, dResult)
Exit Function
ErrCalcMember:
m_Error = ERR_WRONG_FUNCTION
End Function
Top

9 楼csdngoodnight（居然比我还快，你真行！）回复于 2003-08-03 22:48:11 得分 0

'***********************************************************
Private Function ExtractNumber(ByRef EvalExpr$) As Double
Dim HavePoint As Boolean, I As Integer, NewNum As String
Dim TempChar As String, TempSign As String, HaveMinus As Boolean
Dim sEval As String
TempSign = Left(EvalExpr, 1)
If TempSign = POINT_SIGN Then
sEval = "0" & EvalExpr
Else
If Not IsNumeric(TempSign) Then
sEval = Mid(EvalExpr, 2)
HaveMinus = (TempSign = MINUS_SIGN)
Else: sEval = EvalExpr
End If
End If

For I = 1 To Len(sEval)
TempChar = Mid(sEval, I, 1)
If IsNumeric(TempChar) Then
NewNum = NewNum & TempChar
Else
If TempChar = POINT_SIGN Then
If HavePoint Then
m_Error = ERR_DBL_POINT
Exit For
Else
HavePoint = True
NewNum = NewNum + "."
End If
Else
Exit For
End If
End If
Next
If NewNum = "" Then
m_Error = ERR_WRONG_SYNTAX
Else
EvalExpr = Mid(sEval, Len(NewNum) + 1)
End If
ExtractNumber = IIf(HaveMinus, -Val(NewNum), Val(NewNum))
End Function

'***********************************************************
Private Function GetSplitPos(ByVal EvalStr$, ByVal Sign1$, ByVal Sign2$, _
Optional StartPos As Integer = 1)

Dim I%, InBracket%, TempChar$

For I = StartPos To Len(EvalStr$)
TempChar = Mid(EvalStr, I, 1)
Select Case TempChar
Case Sign1, Sign2
If InBracket = 0 And I > 1 Then
GetSplitPos = I
Exit Function
End If
Case BRACKET_LEFT
InBracket = InBracket + 1
Case BRACKET_RIGHT
InBracket = InBracket - 1
If InBracket < 0 Then
m_Error = ERR_WRONG_BRACKETS
Exit Function
End If
End Select
Next
End Function

Private Function ExtractBrackets(ByRef EvalExpr As String) As String
Dim InBracket%, I&, TempChar$, RetStr$
InBracket = 1
For I = 2 To Len(EvalExpr)
TempChar = Mid(EvalExpr, I, 1)
Select Case TempChar
Case BRACKET_LEFT
InBracket = InBracket + 1
Case BRACKET_RIGHT
InBracket = InBracket - 1
End Select
If InBracket = 0 Then
RetStr = Mid(EvalExpr, 2, I - 2)
EvalExpr = Mid(EvalExpr, I + 1)
ExtractBrackets = RetStr
Exit Function
End If
Next
m_Error = ERR_WRONG_BRACKETS
End Function

Private Function ExtractFunction(ByRef EvalExpr As String, ByRef FuncExpr As String)
Dim FuncID As String, I&
I = InStr(EvalExpr, BRACKET_LEFT)
If I = 0 Then
m_Error = ERR_WRONG_SYNTAX
Exit Function
Else
ExtractFunction = Left(EvalExpr, I - 1)
EvalExpr = Mid(EvalExpr, I)
FuncExpr = ExtractBrackets(EvalExpr)
End If
End Function

Private Function CalcFunction(ByVal FunctionID As String, ByVal FuncExpr As String) As Double
On Error GoTo ErrCalc
If m_Error <> ERR_NONE Then Exit Function
Dim Arg As Double
Arg = Eval(FuncExpr)
Select Case FunctionID
Case "ABS"
CalcFunction = Abs(Arg)
Case "ATN"
CalcFunction = Atn(Arg)
Case "COS"
CalcFunction = Cos(Arg)
Case "EXP"
CalcFunction = Exp(Arg)
Case "FIX"
CalcFunction = Fix(Arg)
Case "INT"
CalcFunction = Int(Arg)
Case "LOG"
CalcFunction = Log(Arg)
Case "RND"
CalcFunction = Rnd(Arg)
Case "SGN"
CalcFunction = Sgn(Arg)
Case "SIN"
CalcFunction = Sin(Arg)
Case "SQR"
CalcFunction = Sqr(Arg)
Case "TAN"
CalcFunction = Tan(Arg)
'Derived
Case "SEC"
CalcFunction = 1 / Cos(Arg)
Case "COSEC"
CalcFunction = 1 / Sin(Arg)
Case "COTAN"
CalcFunction = 1 / Tan(Arg)
Case "ARCSIN"
CalcFunction = Atn(Arg / Sqr(-Arg * Arg + 1))
Case "ARCCOS"
CalcFunction = Atn(-Arg / Sqr(-Arg * Arg + 1)) + 2 * Atn(1)
Case "ARCSEC"
CalcFunction = Atn(Arg / Sqr(Arg * Arg - 1)) + Sgn(Arg - 1) * (2 * Atn(1))
Case "ARCCOSEC"
CalcFunction = Atn(Arg / Sqr(Arg * Arg - 1)) + (Sgn(Arg) - 1) * (2 * Atn(1))
Case "ARCCOTAN"
CalcFunction = Atn(Arg) + 2 * Atn(1)
Case "HSIN"
CalcFunction = (Exp(Arg) - Exp(-Arg)) / 2
Case "HCOS"
CalcFunction = (Exp(Arg) + Exp(-Arg)) / 2
Case "HTAN"
CalcFunction = (Exp(Arg) - Exp(-Arg)) / (Exp(Arg) + Exp(-Arg))
Case "HSEC"
CalcFunction = 2 / (Exp(Arg) + Exp(-Arg))
Case "HCOSEC"
CalcFunction = 2 / (Exp(Arg) - Exp(-Arg))
Case "HCOTAN"
CalcFunction = (Exp(Arg) + Exp(-Arg)) / (Exp(Arg) - Exp(-Arg))
Case "HARCSIN"
CalcFunction = Log(Arg + Sqr(Arg * Arg + 1))
Case "HARCCOS"
CalcFunction = Log(Arg + Sqr(Arg * Arg - 1))
Case "HARCTAN"
CalcFunction = Log((1 + Arg) / (1 - Arg)) / 2
Case "HARCSEC"
CalcFunction = Log((Sqr(-Arg * Arg + 1) + 1) / Arg)
Case "HARCCOSEC"
CalcFunction = Log((Sgn(Arg) * Sqr(Arg * Arg + 1) + 1) / Arg)
Case "HARCCOTAN"
CalcFunction = Log((Arg + 1) / (Arg - 1)) / 2
Case "TIMER"
CalcFunction = Timer
Case "YEAR"
CalcFunction = Year(Now)
Case "MONTH"
CalcFunction = Month(Now)
Case "DAY"
CalcFunction = Day(Now)
Case "WEEKDAY"
CalcFunction = Weekday(Now)
Case "HOUR"
CalcFunction = Hour(Time)
Case "MINUTE"
CalcFunction = Minute(Time)
Case "SECOND"
CalcFunction = Second(Time)
Case "PI"
CalcFunction = 3.14159265358979
Case "E"
CalcFunction = 2.71828182845905
Case "ZERO"
CalcFunction = 0
Case Else
m_Error = ERR_WRONG_SYNTAX
End Select
Exit Function
ErrCalc:
m_Error = ERR_WRONG_FUNCTION
End Function

Top

10 楼skystar2001（波塞冬）回复于 2003-08-03 23:30:57 得分 0

我晕了,一看这么多就不想看了~~Top