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
 

你可能感兴趣的:(算法,VB,数组,vb,算法,堆栈,表达式,函数)