VERSION 5.00 Begin VB.Form Form1 Caption = "Form1" ClientHeight = 3195 ClientLeft = 60 ClientTop = 345 ClientWidth = 4680 LinkTopic = "Form1" ScaleHeight = 3195 ScaleWidth = 4680 StartUpPosition = 3 '窗口缺省 Begin VB.CommandButton Command1 Caption = "Command1" Height = 495 Left = 1800 TabIndex = 0 Top = 1320 Width = 1215 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Sub Command1_Click() ' Dim cStack As clsStack Dim i As Long Set cStack = New clsStack ' --------------------------------------------------------------------------------------------------- Debug.Print "String Data: " For i = 65 To 90 cStack.Push Chr(i) Next i Debug.Print "Peek:"; cStack.Peek Debug.Print "Stack Data Count"; cStack.StackDataCount For i = 1 To cStack.StackDataCount Debug.Print cStack.Pop Next i Debug.Print ' --------------------------------------------------------------------------------------------------- Debug.Print "Long Data: " cStack.Clear For i = 1 To 20 cStack.PushLong i Next i Debug.Print "Peek:"; cStack.PeekLong Debug.Print "Stack Data Count:"; cStack.StackDataCount For i = 1 To cStack.StackDataCount Debug.Print cStack.PopLong Next i Debug.Print ' --------------------------------------------------------------------------------------------------- Debug.Print "Single Data: " cStack.Clear For i = 1 To 20 cStack.PushSng i / 2 Next i Debug.Print "Peek:"; cStack.PeekSng Debug.Print "Stack Data Count:"; cStack.StackDataCount For i = 1 To cStack.StackDataCount Debug.Print cStack.PopSng Next i Debug.Print ' --------------------------------------------------------------------------------------------------- Debug.Print "Double Data: " cStack.Clear For i = 1 To 20 cStack.PushDbl i / 3 Next i Debug.Print "Peek:"; cStack.PeekDbl Debug.Print "Stack Data Count:"; cStack.StackDataCount For i = 1 To cStack.StackDataCount Debug.Print cStack.PopDbl Next i Debug.Print End Sub
VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "clsStack" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit Private Enum STK_DataType stkUnDefined = 0 stkString = 1 stkLong = 2 stkSingle = 3 stkDouble = 4 End Enum Private lStackData() As String Private lStackDataLong() As Long Private lStackDataSingle() As Single Private lStackDataDouble() As Double Private lStackDataCount As Long Private mStackDataUbound As Long Private mDataType As STK_DataType Private Const mcArrExpandPer As Long = 100 Public Function Pop() As String ' If lStackDataCount < 1 Or mDataType <> stkString Then Exit Function Pop = lStackData(lStackDataCount) lStackDataCount = lStackDataCount - 1 End Function Public Function PopLong() As Long ' If lStackDataCount < 1 Or mDataType <> stkLong Then Exit Function PopLong = lStackDataLong(lStackDataCount) lStackDataCount = lStackDataCount - 1 End Function Public Function PopSng() As Single ' If lStackDataCount < 1 Or mDataType <> stkSingle Then Exit Function PopSng = lStackDataSingle(lStackDataCount) lStackDataCount = lStackDataCount - 1 End Function Public Function PopDbl() As Double ' If lStackDataCount < 1 Or mDataType <> stkDouble Then Exit Function PopDbl = lStackDataDouble(lStackDataCount) lStackDataCount = lStackDataCount - 1 End Function Public Function Push(DataToPush As String) As Long ' If mDataType = stkUnDefined Then mDataType = stkString If mDataType <> stkString Then Exit Function ExpandArr lStackDataCount = lStackDataCount + 1 lStackData(lStackDataCount) = DataToPush Push = lStackDataCount End Function Public Function PushLong(DataToPush As Long) As Long ' If mDataType = stkUnDefined Then mDataType = stkLong If mDataType <> stkLong Then Exit Function ExpandArr lStackDataCount = lStackDataCount + 1 lStackDataLong(lStackDataCount) = DataToPush PushLong = lStackDataCount End Function Public Function PushSng(DataToPush As Single) As Long ' If mDataType = stkUnDefined Then mDataType = stkSingle If mDataType <> stkSingle Then Exit Function ExpandArr lStackDataCount = lStackDataCount + 1 lStackDataSingle(lStackDataCount) = DataToPush PushSng = lStackDataCount End Function Public Function PushDbl(DataToPush As Double) As Long ' If mDataType = stkUnDefined Then mDataType = stkDouble If mDataType <> stkDouble Then Exit Function ExpandArr lStackDataCount = lStackDataCount + 1 lStackDataDouble(lStackDataCount) = DataToPush PushDbl = lStackDataCount End Function Public Function Peek() As String ' If lStackDataCount < 1 Or mDataType <> stkString Then Exit Function Peek = lStackData(lStackDataCount) End Function Public Function PeekLong() As Long ' If lStackDataCount < 1 Or mDataType <> stkLong Then Exit Function PeekLong = lStackDataLong(lStackDataCount) End Function Public Function PeekSng() As Single ' If lStackDataCount < 1 Or mDataType <> stkSingle Then Exit Function PeekSng = lStackDataSingle(lStackDataCount) End Function Public Function PeekDbl() As Double ' If lStackDataCount < 1 Or mDataType <> stkDouble Then Exit Function PeekDbl = lStackDataDouble(lStackDataCount) End Function Public Function IsEmpty() As Boolean ' IsEmpty = (lStackDataCount < 1) End Function Public Sub Clear() ' Erase lStackData() Erase lStackDataLong() Erase lStackDataSingle() Erase lStackDataDouble() lStackDataCount = 0 mStackDataUbound = 0 mDataType = stkUnDefined End Sub Private Sub ExpandArr() ' If lStackDataCount + 1 > mStackDataUbound Then mStackDataUbound = mStackDataUbound + mcArrExpandPer Select Case mDataType Case stkString ReDim Preserve lStackData(1 To mStackDataUbound) Case stkLong ReDim Preserve lStackDataLong(1 To mStackDataUbound) Case stkSingle ReDim Preserve lStackDataSingle(1 To mStackDataUbound) Case stkDouble ReDim Preserve lStackDataDouble(1 To mStackDataUbound) End Select End If End Sub Public Property Get StackDataCount() As Long ' StackDataCount = lStackDataCount End Property Private Sub Class_Initialize() ' lStackDataCount = 0 mStackDataUbound = 0 mDataType = stkUnDefined End Sub Private Sub Class_Terminate() ' Clear End Sub原文链接:https://www.f2er.com/vb/259197.html