VB利用堆栈实现表达式计算

VB利用堆栈实现表达式计算

    前几天对上学期老师的课件进行了深入学习后，我觉得有必要写个程序实践下，验证表达式计算设计十分正确。于是诞生了如下的程序。
    需要说明一点，这里的代码都是自主设计的，未参考网上的任何代码，所以，此代码拥有完全自主知识产权。
    版权所有，转载请注明出处：SunSoft
Form1.frm文件内容：

VERSION 5.00

Begin VB.Form Form1 

   Caption         =   "表达式计算"

   ClientHeight    =   3195

   ClientLeft      =   60

   ClientTop       =   345

   ClientWidth     =   4680

   LinkTopic       =   "Form1"

   ScaleHeight     =   3195

   ScaleWidth      =   4680

   StartUpPosition =   3  '窗口缺省

   Begin VB.TextBox Text2 

      Height          =   2415

      Left            =   2760

      MultiLine       =   -1  'True

      ScrollBars      =   2  'Vertical

      TabIndex        =   4

      Top             =   720

      Width           =   975

   End

   Begin VB.TextBox Text1 

      Height          =   2415

      Left            =   720

      MultiLine       =   -1  'True

      ScrollBars      =   2  'Vertical

      TabIndex        =   3

      Top             =   720

      Width           =   1215

   End

   Begin VB.CommandButton Command2 

      Caption         =   "Command2"

      Height          =   615

      Left            =   3840

      TabIndex        =   2

      Top             =   480

      Width           =   735

   End

   Begin VB.TextBox SourceText 

      Height          =   270

      Left            =   120

      TabIndex        =   1

      Top             =   120

      Width           =   3615

   End

   Begin VB.CommandButton Command1 

      Caption         =   "Calc"

      Height          =   300

      Left            =   3840

      TabIndex        =   0

      Top             =   120

      Width           =   735

   End

   Begin VB.Label Label2 

      Caption         =   "数字栈"

      Height          =   255

      Left            =   2040

      TabIndex        =   6

      Top             =   720

      Width           =   615

   End

   Begin VB.Label Label1 

      Caption         =   "操作符"

      Height          =   255

      Left            =   0

      TabIndex        =   5

      Top             =   720

      Width           =   615

   End

End

Attribute VB_Name = "Form1"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)  '声明

Dim opNum As New StackClass

Dim opChar As New StackClass

Private Sub Command1_Click()

    Dim sTxt As String

    Dim strNumFix As String

    Dim curChar As String

    Dim i As Long

    Dim ops1 As String, ops2 As String, opC As String

    '初始化堆栈

        opNum.Clear

        opChar.Clear

        Call UpdateShow

    '堆栈初始化结束

    sTxt = SourceText.Text

    For i = 1 To Len(sTxt)

        curChar = Mid(sTxt, i, 1)

        If IsSymbol(curChar) = True Then

            '看看数字预备区有没有

            If strNumFix <> "" Then

                opNum.Push strNumFix

                Call UpdateShow

                strNumFix = ""

            End If

redo:

            If IsHigh(curChar, opChar.Peek) = 1 Then 'if new come char is higher then push it to stack

                opChar.Push curChar '如果等级高的控制符，则进入

                Call UpdateShow

            ElseIf IsHigh(curChar, opChar.Peek) = 0 Then

                'Debug.Print "结果是：" & opNum.Pop

                'Exit Sub

                If curChar = "#" And opChar.Peek = "#" Then

                    opChar.Pop

                    Call UpdateShow

                    Debug.Print "输出结果是：" & opNum.Pop

                    Exit Sub

                End If

            ElseIf IsHigh(curChar, opChar.Peek) = -1 Then 'if low then ready to calculate

                ops2 = opNum.Pop

                Call UpdateShow

                ops1 = opNum.Pop

                Call UpdateShow

                opC = opChar.Pop

                Call UpdateShow

                opNum.Push CStr(Calc(ops1, ops2, opC))

                Call UpdateShow

                If curChar = ")" And opChar.Peek = "(" Then

                    opChar.Pop  '如果操作数是），就把（弹出来

                    Call UpdateShow

                    GoTo moveon

                End If

                GoTo redo

moveon:

            End If

        Else '非符号

            strNumFix = strNumFix & curChar

        End If

    Next i

    

End Sub

Private Sub Command2_Click()

MsgBox IsHigh("+", "+")

End Sub

Private Sub Form_Load()

Me.Show

opNum.Clear

opChar.Clear

End Sub

Function IsSymbol(ByVal strS As String) As Boolean

    IsSymbol = True

    Select Case strS

        Case "+"

        Case "-"

        Case "*"

        Case "/"

        Case "("

        Case ")"

        Case "#"

        Case Else

            IsSymbol = False

    End Select

End Function

Function IsHigh(ByVal sNew As String, ByVal sOld As String) As Integer

'1大于，-1小于，0等于

Select Case sNew

Case "+"

    Select Case sOld

        Case "("

            IsHigh = 1

            Exit Function

        Case "#"

            IsHigh = 1

            Exit Function

        Case Else

            IsHigh = -1

            Exit Function

    End Select

Case "-"

    Select Case sOld

        Case "("

            IsHigh = 1

            Exit Function

        Case "#"

            IsHigh = 1

            Exit Function

        Case Else

            IsHigh = -1

            Exit Function

    End Select

Case "*"

    Select Case sOld

        Case "("

            IsHigh = 1

            Exit Function

        Case "#"

            IsHigh = 1

            Exit Function

        Case "+"

            IsHigh = 1

            Exit Function

        Case "-"

            IsHigh = 1

            Exit Function

        Case Else

            IsHigh = -1

            Exit Function

    End Select

Case "/"

    Select Case sOld

        Case "("

            IsHigh = 1

            Exit Function

        Case "#"

            IsHigh = 1

            Exit Function

        Case "+"

            IsHigh = 1

            Exit Function

        Case "-"

            IsHigh = 1

            Exit Function

        Case Else

            IsHigh = -1

            Exit Function

    End Select

Case "("

    Select Case sOld

        Case "+"

            IsHigh = 1

            Exit Function

        Case "-"

            IsHigh = 1

            Exit Function

        Case "*"

            IsHigh = 1

            Exit Function

        Case "/"

            IsHigh = 1

            Exit Function

        Case "("

            IsHigh = 1

            Exit Function

        Case Else

            IsHigh = -1

            Exit Function

    End Select

Case ")"

    IsHigh = -1

    Exit Function

Case ""

    IsHigh = -1

    Exit Function

Case "#"

    Select Case sOld

        Case "#"

            IsHigh = 0

            Exit Function

        Case ""

            IsHigh = 1

            Exit Function

        Case "+"

            IsHigh = -1

            Exit Function

        Case "-"

            IsHigh = -1

            Exit Function

        Case "*"

            IsHigh = -1

            Exit Function

        Case "/"

            IsHigh = -1

            Exit Function

        Case ")"

            IsHigh = -1

            Exit Function

    End Select

End Select

End Function

Function Calc(ByVal op1 As String, ByVal op2 As String, ByVal options As String) As Double

On Error Resume Next

Calc = 0

Select Case options

    Case "+"

        Calc = CDbl(op1) + CDbl(op2)

    Case "-"

        Calc = CDbl(op1) - CDbl(op2)

    Case "*"

        Calc = CDbl(op1) * CDbl(op2)

    Case "/"

        Calc = CDbl(op1) / CDbl(op2)

End Select

End Function

Sub Delay(ByVal msec As Long) '函数：msec为毫秒数

DoEvents

Sleep msec

End Sub

Sub UpdateShow()

    DoEvents

    Text1.Text = opChar.ViewStack

    DoEvents

    Text2.Text = opNum.ViewStack

    DoEvents

    Call Delay(500)

End Sub

-----------------------------StackClass.cls文件内容----------------------------

VERSION 1.0 CLASS

BEGIN

  MultiUse = -1  'True

  Persistable = 0  'NotPersistable

  DataBindingBehavior = 0  'vbNone

  DataSourceBehavior  = 0  'vbNone

  MTSTransactionMode  = 0  'NotAnMTSObject

END

Attribute VB_Name = "StackClass"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = True

Attribute VB_PredeclaredId = False

Attribute VB_Exposed = False

Private Stack() As String

Private itemCount As Long

Private Sub Class_Initialize()

    ReDim Stack(0)

    Stack(0) = "#"

End Sub

Public Sub Push(ByVal inString As String)

    ReDim Preserve Stack(itemCount + 1)

    Stack(itemCount + 1) = inString

    itemCount = itemCount + 1

End Sub

Public Function Pop() As String

    If itemCount >= 1 Then

        Pop = Stack(itemCount)

        ReDim Preserve Stack(itemCount - 1)

        itemCount = itemCount - 1

    Else

        Pop = ""

    End If

End Function

Public Function Peek() As String

    If itemCount = 0 Then

        Peek = ""

        Exit Function

    End If

    Peek = Stack(itemCount)

End Function

Sub Clear()

    itemCount = 0

    ReDim Stack(itemCount)

    Stack(itemCount) = "#"

End Sub

Public Function Count()

    Count = itemCount

End Function

Public Function ViewStack() As String

    Dim kOut As String

    Dim i As Long

    If itemCount = 0 Then ViewStack = "": Exit Function

    For i = 1 To itemCount

        kOut = kOut & Format(i, "00") & " " & Stack(i) & vbCrLf

    Next i

    ViewStack = kOut

End Function