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