listview.ctl

很棒的网页音乐播放器,可以嵌入网页。界面很漂亮

VERSION 5.00
Begin VB.UserControl ListView 
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
   Begin VB.Timer tmrMove 
      Enabled         =   0   'False
      Interval        =   15
      Left            =   1200
      Top             =   2325
   End
End
Attribute VB_Name = "ListView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：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

Implements ICustomDraw


Public Event Reorder()

Public Event DblClick(ByVal ItemIndex As Long)
Public Event Click(ByVal ItemIndex As Long)

Public Event ColumnClick(ByVal ColumnIndex As Long)

Public Event MouseDown( _
    ByVal ItemIndex As Long, _
    ByVal MouseButton As Integer, ByVal Shift As Integer, _
    ByVal X As Single, ByVal Y As Single _
)

Public Event MouseUp( _
    ByVal ItemIndex As Long, _
    ByVal MouseButton As Integer, ByVal Shift As Integer, _
    ByVal X As Single, ByVal Y As Single _
)

Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event KeyPress(KeyAscii As Integer)
Public Event ItemCheck(ByVal ItemIndex As Long)

Public Event OLEDragDrop( _
    Data As DataObject, Effect As Long, _
    MouseButton As Integer, Shift As Integer, _
    X As Single, Y As Single _
)

Public Event OLEDragOver( _
    Data As DataObject, Effect As Long, _
    Button As Integer, Shift As Integer, _
    X As Single, Y As Single, state As Integer _
)

Public Event OLECompleteDrag(Effect As Long)
Public Event OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
Public Event OLESetData(Data As DataObject, DataFormat As Integer)
Public Event OLEStartDrag(Data As DataObject, AllowedEffects As Long)


Private WithEvents m_clsSB      As Scrollbars
Attribute m_clsSB.VB_VarHelpID = -1


Public Enum SortOrderConstants
    SortAscending
    SortDescending
End Enum

Public Enum OLEDropModeConstants
    OLEDropNone
    OLEDropManual
End Enum

Public Enum TextAlignConstants
    TextAlignLeft
    TextAlignRight
    TextAlignCenter
End Enum

Public Enum LVBorderStyleConstants
    BorderStyleNone
    BorderStyleThin
    BorderStyleThick
End Enum

Private Enum MouseOverBehaviour
    MouseOverFree
    MouseOverResizeColumn
    MouseOverMultiselect
    MouseOverReorder
    MouseOverColumnClick
End Enum

Private m_lngPaddingTop         As Long
Private m_lngPaddingBottom      As Long
Private m_lngPaddingLeft        As Long
Private m_lngPaddingRight       As Long

Private m_lngPictureHeight      As Long
Private m_lngPictureWidth       As Long
Private m_blnShowPictures       As Boolean

Private WithEvents m_clsFont    As StdFont
Attribute m_clsFont.VB_VarHelpID = -1
Private m_lngFontHeight         As Long
Private m_hFont                 As Long

Private m_udeMouseOver          As MouseOverBehaviour
Private m_lngColumnResize       As Long
Private m_blnMultiSelRem        As Boolean
Private m_blnItemDragged        As Boolean
Private m_lngMultiSelStart      As Long

Private m_clsBackColor          As Color
Private m_clsForeColor          As Color
Private m_clsSelectedBackColor  As Color
Private m_clsSelectedForeColor  As Color
Private m_clsFocusRectColor     As Color
Private m_clsCustBGColor        As Color
Private m_clsCustFGColor        As Color
Private m_clsCheckBoxColor      As Color
Private m_clsCheckBoxSelColor   As Color

Private m_udeBorderStyle        As LVBorderStyleConstants
Private m_blnReorder            As Boolean
Private m_blnMultiSelect        As Boolean
Private m_blnColumnsAutoSize    As Boolean
Private m_blnColumnsVisible     As Boolean
Private m_blnEnabled            As Boolean
Private m_blnSolidFocusRect     As Boolean
Private m_blnGotFocus           As Boolean
Private m_blnCheckBoxes         As Boolean
Private m_blnSortable           As Boolean

Private m_colColumns            As ColumnCollection
Private m_clsItems              As ListItemCollection

Private m_hDCBack               As Long
Private m_hDCBackBmp            As Long
Private m_hDCBackOldBmp         As Long
Private m_hOldFont              As Long
Private m_hOldPen               As Long

Private m_udtUCRect             As RECT     ' User Control Rect
Private m_udtCLRect             As RECT     ' Columns Rect
Private m_udtITRect             As RECT     ' Items Rect

Private m_lngSelItemIndex       As Long
Private m_lngColumnsWidth       As Long

Private m_clsCustDrawCB         As ICustomDraw
Private m_blnRedraw             As Boolean

Private m_clsPictures()         As c32bppDIB
Private m_lngPictureCount       As Long

Private m_blnItemAutoSize       As Boolean

Private Const IMG_LEFT          As Long = 2
Private Const IMG_PAD_RIGHT     As Long = 3

Private Const CHECKBOX_HEIGHT   As Long = 12
Private Const CHECKBOX_WIDTH    As Long = 12
Private Const CHECKBOX_MARGIN   As Long = 3


Public Property Get PictureCount() As Long
    PictureCount = m_lngPictureCount
End Property

Public Function AddPictureFromRes(ByVal ResIndex As Variant, ByVal resSection As Variant) As Boolean
    ReDim Preserve m_clsPictures(m_lngPictureCount) As c32bppDIB
    Set m_clsPictures(m_lngPictureCount) = New c32bppDIB
    
    With m_clsPictures(m_lngPictureCount)
        .Alpha = True
        .HighQualityInterpolation = False   ' true would be extremly slow, but also very beautiful
        AddPictureFromRes = .LoadPicture_Resource(ResIndex, resSection, , m_lngPictureWidth, m_lngPictureHeight)
    End With
    
    m_lngPictureCount = m_lngPictureCount + 1
End Function

Public Function AddPicture(ByVal strFilename As String) As Boolean
    ReDim Preserve m_clsPictures(m_lngPictureCount) As c32bppDIB
    Set m_clsPictures(m_lngPictureCount) = New c32bppDIB
    
    With m_clsPictures(m_lngPictureCount)
        .Alpha = True
        .HighQualityInterpolation = False   ' true would be extremly slow, but also very beautiful
        AddPicture = .LoadPicture_File(strFilename, m_lngPictureWidth, m_lngPictureHeight)
    End With
        
    m_lngPictureCount = m_lngPictureCount + 1
End Function


Public Property Get SelectedItem() As Long
Attribute SelectedItem.VB_MemberFlags = "400"
    SelectedItem = m_lngSelItemIndex
End Property

Public Property Let SelectedItem(ByVal lngVal As Long)
    m_lngSelItemIndex = lngVal
    DrawListView
End Property

Public Property Get ItemCount() As Long
    ItemCount = m_clsItems.ItemCount
End Property

Public Property Get ItemTag(ByVal Index As Long) As Long
    ItemTag = m_clsItems.Item(Index).Tag
End Property

Public Property Let ItemTag(ByVal Index As Long, ByVal lngTag As Long)
    m_clsItems.Item(Index).Tag = lngTag
    DrawListView
End Property

Public Property Get ItemSelected(ByVal Index As Long) As Boolean
    ItemSelected = m_clsItems.Item(Index).Selected
End Property

Public Property Let ItemSelected(ByVal Index As Long, ByVal blnVal As Boolean)
    m_clsItems.Item(Index).Selected = blnVal
    DrawListView
End Property

Public Property Get ItemText(ByVal Index As Long, ByVal Column As Long) As String
    ItemText = m_clsItems.Item(Index).Text(Column)
End Property

Public Property Let ItemText(ByVal Index As Long, ByVal Column As Long, ByVal strText As String)
    m_clsItems.Item(Index).Text(Column) = strText
    DrawListView
End Property

Public Property Get ItemChecked(ByVal Index As Long) As Boolean
    ItemChecked = m_clsItems.Item(Index).Checked
End Property

Public Property Let ItemChecked(ByVal Index As Long, ByVal blnVal As Boolean)
    m_clsItems.Item(Index).Checked = blnVal
    DrawListView
End Property

Public Function AddItem(Optional InsertAt As Long = -1, Optional ByVal strText As String, Optional ByVal lngPictureIndex As Long = -1) As Long
    If m_colColumns.Count = 0 Then
        Err.Raise 31, , "can not add items when there are no columns"
    End If
    
    With m_clsItems.AddItem(InsertAt)
        .Text(0) = strText
        .PictureIndex = lngPictureIndex
    End With
    
    If InsertAt <= m_lngSelItemIndex And InsertAt > -1 Then
        m_lngSelItemIndex = m_lngSelItemIndex + 1
    End If
    
    If InsertAt > -1 Then
        AddItem = InsertAt
    Else
        AddItem = m_clsItems.ItemCount - 1
    End If
    
    UpdateVScroll
    DrawListView
End Function

Public Sub RemoveItem(ByVal Index As Long)
    m_clsItems.RemoveItem Index
    
    If m_lngSelItemIndex > Index Then
        m_lngSelItemIndex = m_lngSelItemIndex - 1
        If m_lngSelItemIndex < 0 Then
            If m_clsItems.ItemCount > 0 Then
                m_lngSelItemIndex = 0
            End If
        End If
    End If
    
    If m_lngSelItemIndex > m_clsItems.ItemCount - 1 Then
        m_lngSelItemIndex = m_clsItems.ItemCount - 1
    End If
    
    UpdateVScroll
    DrawListView
End Sub

Public Sub MoveItem(ByVal IndexFrom As Long, ByVal IndexTo As Long)
    m_clsItems.MoveItem IndexFrom, IndexTo
    DrawListView
End Sub

Public Sub Clear()
    m_clsItems.Clear
    m_lngSelItemIndex = -1
    DrawListView
End Sub


Public Property Get ColumnIndex(Index) As Long
    Dim i   As Long
    
    For i = 0 To ColumnCount - 1
        If Index = ColumnKey(i) Then
            ColumnIndex = i
        End If
    Next
End Property

Public Sub RemoveColumn(Index)
    If m_clsItems.ItemCount > 0 Then
        Err.Raise 33, , "can not add or remove columns when there are items"
    End If
    
    m_colColumns.Remove Index
    Refresh
End Sub

Public Sub AddColumn( _
    Optional ByVal key As String = vbNullString, _
    Optional ByVal Caption As String = vbNullString, _
    Optional ByVal TextAlign As TextAlignConstants = TextAlignLeft, _
    Optional ByVal Width As Long = 300, _
    Optional ByVal Resizable As Boolean = True, _
    Optional ByVal Visible As Boolean = True _
)

    Dim clsColumn   As Column
    Set clsColumn = New Column
    
    If m_clsItems.ItemCount > 0 Then
        Err.Raise 33, , "can not add or remove columns when there are items"
    End If
    
    With m_colColumns.Add(key)
        .Caption = Caption
        .TextAlign = TextAlign
        .Width = Width
        .Resizable = Resizable
        .Visible = Visible
    End With
    
    m_clsItems.ColumnCount = m_colColumns.Count