求实现一种特殊的四则计算器

Question

我用弄成二个文本框，一个显示答案，一个做计算
只有一个计算按钮，没有加减乘除按钮，然后在文本框1输入例如：
2389+2+8*10/2-200点击计算，就可以在文本框2输出结果
如何做到呢（效果图如下）麻烦各位大虾了，一定要是这样的计算方式哦

Answer 1

最简单的办法,添加 Microsoft Script Control 部件然后在 计算 的代码里写上    Text2.Text = ScriptControl1.Eval(Trim(Text1.Text))
你要复杂点的话,就自己写个解析过程

Answer 2

N年前写汇编编译程序，当时没有从网上找代码，愣写出来的，缺点就是表达式必须用（）括起来，不过这不影响做简单计算俺的代码支持四则运算，支持（），不支持小数。Option ExplicitDim Decom(1 To 256) As String
Dim theI As Long'[]==========[]
'[]pop
'[]在stack中弹出字符串，stack栈深度固定为4
'[]==========[]
Private Function Pop(ByRef Stack() As String) As String
    Dim i As Long
    For i = 4 To 1 Step -1
        If Stack(i) <> "" Then
            Pop = Stack(i)
            Stack(i) = ""
            Exit For
        End If
    Next i
End Function
'[]==========[]
'[]look
'[]察看stack中栈顶字符串，stack栈深度固定为4
'[]==========[]
Private Function Look(ByRef Stack() As String) As String
    Dim i As Long
    For i = 4 To 1 Step -1
        If Stack(i) <> "" Then
            Look = Stack(i)
            Exit For
        End If
    Next i
End Function
'[]==========[]
'[]push
'[]向stack中压入字符串，stack栈深度固定为4
'[]==========[]
Private Sub Push(ByRef Stack() As String, ByVal strs As String)
    Dim i As Long
    For i = 1 To 4
        If Stack(i) = "" Then
            Stack(i) = strs
            Exit For
        End If
    Next i
End Sub
'[]==========[]
'[]get0
'[]表达式分析，递归调用
'[]先建立两个栈，符号栈和数据栈
'[]向符号栈内先压入一个“#”号
'[]如果遇到数字，压入数字栈
'[]如果遇到“+”、“-”号，用Look函数察看符号栈顶是什么符号
'[]     如果是“#”号，把这个“+”或者“-”压入符号栈，如果是“+”或者“-”
'[]     就把前一步的运算先算了。并且把结果压栈，新的“+”、“-”号也压栈
'[]如果遇到“*”、“/”号，从数字栈中弹出一个数，从表达式中预取一个数，进行
'[]     运算，并且把结果压栈
'[]如果遇到“（”那么就递归调用了
'[]==========[]
Private Function get0() As String
    Dim p0 As String
    Dim p1 As String
    Dim P(1 To 4) As String
    Dim d(1 To 4) As String
    Dim operator As String
    Dim a As String
    Dim b As String
    
    Push P, "#"
    Do
start:
        theI = theI + 1
        If IsNumeric(Decom(theI)) Then
            Push d, Decom(theI)
        Else
            p0 = Look(P)
            p1 = Decom(theI)
            Select Case p1
                Case "+"
                    Select Case p0
                        Case "#"
                            Push P, p1
                        Case "+"
                            operator = Pop(P)
                            b = Pop(d)
                            a = Pop(d)
                            Push d, Str(Val(a) + Val(b))
                            Push P, "+"
                        Case "-"
                            operator = Pop(P)
                            b = Pop(d)
                            a = Pop(d)
                            Push d, Str(Val(a) - Val(b))
                            Push P, "+"
                        Case Else
                    End Select
                Case "-"
                    Select Case p0
                        Case "#"
                            Push P, p1
                        Case "+"
                            operator = Pop(P)
                            b = Pop(d)
                            a = Pop(d)
                            Push d, Str(Val(a) + Val(b))
                            Push P, "-"
                        Case "-"
                            operator = Pop(P)
                            b = Pop(d)
                            a = Pop(d)
                            Push d, Str(Val(a) - Val(b))
                            Push P, "-"
                        Case Else
                    End Select
                Case "("
                    Select Case p0
                        Case "+"
                            Push d, get0()
                            GoTo start
                        Case "-"
                            Push d, get0()
                            GoTo start
                        Case "#"
                            Push d, get0()
                            GoTo start
                        Case Else
                    End Select
                Case ")"
                    operator = Pop(P)
                    b = Pop(d)
                    a = Pop(d)
                    If operator = "#" Or a = "" Or b = "" Then
                        Push P, "#"
                        Push d, a
                        Push d, b
                    Else
                        Select Case operator
                            Case "+"
                                Push d, Str(Val(a) + Val(b))
                            Case "-"
                                Push d, Str(Val(a) - Val(b))
                            Case "*"
                                Push d, Str(Val(a) * Val(b))
                            Case "/"
                                Push d, Str(Val(a) / Val(b))
                            Case Else
                        End Select
                    End If
                Case ""
                    operator = Pop(P)
                    b = Pop(d)
                    a = Pop(d)
                    If operator = "#" Or a = "" Or b = "" Then
                        Push P, "#"
                        Push d, a
                        Push d, b
                    Else
                        Select Case operator
                            Case "+"
                                Push d, Str(Val(a) + Val(b))
                            Case "-"
                                Push d, Str(Val(a) - Val(b))
                            Case "*"
                                Push d, Str(Val(a) * Val(b))
                            Case "/"
                                Push d, Str(Val(a) / Val(b))
                            Case Else
                        End Select
                    End If
                Case "*"
                    If IsNumeric(Decom(theI + 1)) Then
                        theI = theI + 1
                        b = Decom(theI)
                        a = Pop(d)
                        Push d, Str(Val(a) * Val(b))
                    End If
                    If Decom(theI + 1) = "(" Then
                        a = Pop(d)
                        theI = theI + 1
                        Push d, Str(Val(a) * Val(get0()))
                        GoTo start
                    End If
                Case "/"
                    If IsNumeric(Decom(theI + 1)) Then
                        theI = theI + 1
                        b = Decom(theI)
                        a = Pop(d)
                        Push d, Str(Val(a) / Val(b))
                    End If
                    If Decom(theI + 1) = "(" Then
                        a = Pop(d)
                        theI = theI + 1
                        Push d, Str(Val(a) / Val(get0()))
                        GoTo start
                    End If
                Case ","
                    operator = Pop(P)
                    b = Pop(d)
                    a = Pop(d)
                    If operator = "#" Or a = "" Or b = "" Then
                        Push P, "#"
                        Push d, a
                        Push d, b
                    Else
                        Select Case operator
                            Case "+"
                                Push d, Str(Val(a) + Val(b))
                            Case "-"
                                Push d, Str(Val(a) - Val(b))
                            Case "*"
                                Push d, Str(Val(a) * Val(b))
                            Case "/"
                                Push d, Str(Val(a) / Val(b))
                            Case Else
                        End Select
                    End If
                    Exit Do
                Case Else
            End Select
        End If
    Loop Until Decom(theI) = ")" Or Decom(theI) = ""
    get0 = Pop(d)
End Function

Answer 3

'[]==========[]
'[]getexp
'[]表达式求值
'[]==========[]
Private Function GetExp(ByVal strCodeLine As String) As String
    Dim s As String
    Dim i As Long
    Seperate strCodeLine
    i = 0
    Do
        i = i + 1
        If Decom(i) = "(" Then
            theI = i - 1
            Decom(i) = get0
            Exit Do
        End If
    Loop While Decom(i) <> ""
    i = i + 1
    Do
        Decom(i) = ""
        i = i + 1
    Loop While Decom(i) <> ""
    i = 0
    Do
        i = i + 1
        s = s & Decom(i) & " "
    Loop While Decom(i) <> ""
    GetExp = s
End Function'[]==========[]
'[]seperate
'[]分离一个字符串，存入数组decom中
'[]==========[]
Public Sub Seperate(ByVal strCodeLine As String)
    Dim i As Long
    Dim leng As Long
    Dim c As String
    Dim j As Long
    Dim n As Long
    leng = Len(strCodeLine)
    n = 0
    For i = 1 To 256
        Decom(i) = ""
    Next i
    i = 0
    Do
        i = i + 1
        c = Mid(strCodeLine, i, 1)
        If c = " " Then
            Do
                i = i + 1
                c = Mid(strCodeLine, i, 1)
            Loop While c = " " And i <= leng
            i = i - 1
        ElseIf c = Chr(vbKeyTab) Then
            Do
                i = i + 1
                c = Mid(strCodeLine, i, 1)
            Loop While c = Chr(vbKeyTab) And i <= leng
            i = i - 1
        ElseIf c = "'" Then
            j = i
            Do
                i = i + 1
                c = Mid(strCodeLine, i, 1)
            Loop While c <> "'" And i <= leng
            n = n + 1
            Decom(n) = Trim(Mid(strCodeLine, j, i - j + 1))
        ElseIf c = "<" Then
            n = n + 1
            Decom(n) = "<"
        ElseIf c = ">" Then
            n = n + 1
            Decom(n) = ">"
        ElseIf c = "[" Then
            n = n + 1
            Decom(n) = "["
        ElseIf c = "]" Then
            n = n + 1
            Decom(n) = "]"
        ElseIf c = "{" Then
            n = n + 1
            Decom(n) = "{"
        ElseIf c = "}" Then
            n = n + 1
            Decom(n) = "}"
        ElseIf c = "(" Then
            n = n + 1
            Decom(n) = "("
        ElseIf c = ")" Then
            n = n + 1
            Decom(n) = ")"
        ElseIf c = "+" Then
            n = n + 1
            Decom(n) = "+"
        ElseIf c = "-" Then
            n = n + 1
            Decom(n) = "-"
        ElseIf c = "*" Then
            n = n + 1
            Decom(n) = "*"
        ElseIf c = "/" Then
            n = n + 1
            Decom(n) = "/"
        ElseIf c = "=" Then
            n = n + 1
            Decom(n) = "="
        ElseIf c = "," Then
            n = n + 1
            Decom(n) = ","
        ElseIf c = ":" Then
            n = n + 1
            Decom(n) = ":"
        Else
            j = i
            Do
                i = i + 1
                c = Mid(strCodeLine, i, 1)
            Loop While c <> " " And c <> Chr(vbKeyTab) And c <> "'" And c <> "{" And c <> "}" _
                                And c <> "[" And c <> "]" And c <> "<" And c <> ">" _
                                And c <> "(" And c <> ")" And c <> "+" And c <> "-" _
                                And c <> "*" And c <> "/" And c <> "=" And c <> "," _
                                And c <> ":" And i <= leng
            n = n + 1
            Decom(n) = Trim(Mid(strCodeLine, j, i - j))
            i = i - 1
        End If
    Loop While i <= leng
End SubPrivate Sub Command1_Click()
    Dim s As String
    s = "(" & Text1.Text & ")"
    Text2.Text = GetExp(s)
End Sub测试通过。

Answer 4

jennyvenus兄的方法同时用加减乘除会出现错误结果

Answer 5

直接在text1输入 1+2+3按回车或点击 Command1得到 6'************* 自定义 Script Control'添加 Text1 Text2  Command1Private Sub Text1_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then Command1_Click
End SubPrivate Sub Command1_Click()
   Set sc = CreateObject("ScriptControl")
   sc.Language = "VBScript"
   Text2.Text = sc.Eval(Text1.Text)
   Set sc = Nothing
End Sub

Answer 6

cbm666兄的办法也不好用，213+123-30+30/2＝321

Answer 7

Private Sub Form_Load()
   Text1.Text = "2389+2+8*10/2-200"
End SubPrivate Sub Text1_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then Command1_Click
End SubPrivate Sub Command1_Click()
   Set sc = CreateObject("ScriptControl")
   sc.Language = "VBScript"
   Text2.Text = "结果为:" & sc.Eval(Text1.Text)
   Set sc = Nothing
End Sub

Answer 8

jennyvenus 兄，你的200-10+10应该还是200，/2后是100，结果却是195  

Answer 9

一个人说了不算，我试了cbm666的代码，也算出来结果为195.

Answer 10

Attn: 20F哈哈, 那我就来个有点点点........技术含量的代码Option Explicit
Private Declare Function EbExecuteLine Lib "vba6.dll" (ByVal pStringToExec As Long, ByVal Unknownn1 As Long, ByVal Unknownn2 As Long, ByVal fCheckOnly As Long) As Long
Dim result
Private Sub Text1_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then Command1_Click
End SubPrivate Sub Command1_Click()
   Call calc(Text1)
End SubSub calc(ByVal textstr As String)
   ExecuteLine "Dim X As Long, Y As Long"
   ExecuteLine "textstr= " & textstr
   ExecuteLine "clipboard.settext textstr"
   result = Clipboard.GetText
   Text2.Text = "结果为:" & result
   Set result = Nothing
End SubPublic Function ExecuteLine(sCode As String, Optional fCheckOnly As Boolean) As Boolean
   ExecuteLine = EbExecuteLine(StrPtr(sCode), 0&, 0&, Abs(fCheckOnly)) = 0
End Function
 

Answer 11

呵呵...可能你分不够吧.jennyvenus 同志代码很不错,你就把分给他吧,给我1分即可.

Answer 12

刚好写过一个模仿windows计算器的咚咚，讨论贴在这里：
http://topic.csdn.net/u/20070828/02/48a980b0-2a22-4eb5-b34a-f0ba55bb2250.html我没有调用任何部件，用栈的数据结构即可完成。写成的成品在这里，vb绿色软件，有兴趣可以去下个，没毒的，在华军和硅谷动力都有：
http://download.enet.com.cn/html/033432007101201.html

Answer 13

24 楼的只能在 VB-IDE 中运行的，这种鸡肋就不要拿出来现了。To 6楼：用 Script Control 可以添加自定义函数的，如下方式就可以在表达式中使用函数 Max
Option ExplicitPrivate Sub Command1_Click()
    Text2.Text = ScriptControl1.Eval(Trim(Text1.Text))
End SubPrivate Sub Form_Load()
    ScriptControl1.AddCode _
            "Function Max(v1, v2)" & vbCrLf & _
            "  If v1>=v2 Then" & vbCrLf & _
            "    Max = V1" & vbCrLf & _
            "  Else" & vbCrLf & _
            "    Max = V2" & vbCrLf & _
            "  End If" & vbCrLf & _
            "End Function"
End Sub