columncollection.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 = "ColumnCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/03/15
'描    述：网页搜索音乐播放器  Ver 1.1.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit

Private m_clsItems()    As Column
Private m_lngColCount   As Long

Public Property Get Count() As Long
    Count = m_lngColCount
End Property

Public Property Get Item(Index) As Column
    Dim i       As Long
    Dim strKey  As String
    
    If IsNumeric(Index) Then
        Set Item = m_clsItems(CLng(Index))
    Else
        strKey = Index
        For i = 0 To m_lngColCount - 1
            If StrComp(m_clsItems(i).key, strKey, vbTextCompare) = 0 Then
                Set Item = m_clsItems(i)
                Exit Property
            End If
        Next
        
        Err.Raise 9
    End If
End Property

Public Sub Remove(Index)
    Dim i       As Long
    Dim strKey  As String
    
    If IsNumeric(Index) Then
        i = CLng(Index)
    Else
        strKey = Index
        For i = 0 To m_lngColCount - 1
            If StrComp(m_clsItems(i).key, strKey, vbTextCompare) = 0 Then
                Exit For
            End If
        Next
    End If
    
    If i > m_lngColCount - 1 Then
        Err.Raise 9
    End If

    Set m_clsItems(i) = Nothing
    CopyMemory m_clsItems(i), m_clsItems(i + 1), 4 * (m_lngColCount - (i + 1))
    ZeroMemory m_clsItems(m_lngColCount - 1), 4
    m_lngColCount = m_lngColCount - 1
End Sub

Public Function Add(Optional ByVal key As String = "") As Column
    Dim i       As Long
    
    For i = 0 To m_lngColCount - 1
        If StrComp(m_clsItems(i).key, key, vbTextCompare) = 0 Then
            Err.Raise 300, , "Objekt nicht eindeutig in Aufz鋒lung!"
        End If
    Next
    
    ReDim Preserve m_clsItems(m_lngColCount) As Column
    Set m_clsItems(m_lngColCount) = New Column
    m_clsItems(m_lngColCount).key = key
    Set Add = m_clsItems(m_lngColCount)
    m_lngColCount = m_lngColCount + 1
End Function