listview.ctl

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

                    End If
                End If
                
                m_lngSelItemIndex = lngClickedItem

                If Shift = vbCtrlMask Then      ' STRG
                    m_clsItems.Item(m_lngSelItemIndex).Selected = Not m_clsItems.Item(m_lngSelItemIndex).Selected
                    m_blnMultiSelRem = Not m_clsItems.Item(m_lngSelItemIndex).Selected
                ElseIf Shift = vbShiftMask Then ' SHIFT
                    m_clsItems.Item(m_lngSelItemIndex).Selected = Not m_blnMultiSelRem
                Else
                    m_clsItems.Item(m_lngSelItemIndex).Selected = True
                    m_blnMultiSelRem = False
                End If
                
                m_lngMultiSelStart = lngClickedItem
            Else
                ' no item hit
                If Button = vbLeftButton Then
                    For i = 0 To m_clsItems.ItemCount - 1
                        m_clsItems.Item(i).Selected = False
                    Next
                End If
                
                lngClickedItem = -1
            End If
    
            DrawListView
            
            RaiseEvent MouseDown(lngClickedItem, Button, Shift, X - m_clsSB.Value(efsHorizontal), Y)
        End If
    Else
        ' no item hit
        If Button = vbLeftButton Then
            For i = 0 To m_clsItems.ItemCount - 1
                m_clsItems.Item(i).Selected = False
            Next
        End If
        
        DrawListView
        
        RaiseEvent MouseDown(-1, Button, Shift, X - m_clsSB.Value(efsHorizontal), Y)
    End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i               As Long
    Dim lngColumnLeft   As Long
    Dim lngLeftRel      As Long
    Dim lngCursor       As Long
    Dim lngColWidthNew  As Long
    Dim lngItemOver     As Long
    Dim lngMoveDelta    As Long
    Dim lngStep         As Long
    Dim lngColAbsWidth  As Long
    Dim lngFixeds       As Long
    Dim lngDiffNext     As Long
    Dim clsDragItem     As ListItem
    Dim udtCursorPos    As POINTAPI
    Dim udtLV           As POINTAPI

    If Not m_blnEnabled Then Exit Sub

    X = m_clsSB.Value(efsHorizontal) + X

    Select Case m_udeMouseOver
        Case MouseOverFree

            If m_blnColumnsVisible And (Y >= m_udtCLRect.Y1 And Y <= m_udtCLRect.Y2) Then
                ' cursor between 2 columnbuttons?
                For i = 0 To ColumnCount - 1
                    If m_blnColumnsAutoSize Then
                        lngColumnLeft = lngColumnLeft + m_colColumns.Item(i).WidthAutoSized
                    Else
                        lngColumnLeft = lngColumnLeft + m_colColumns.Item(i).Width
                    End If
                    
                    If Abs(X - lngColumnLeft) < 5 Then
                        If ColumnResizable(i) And (Not m_blnColumnsAutoSize) Then
                            lngCursor = vbSizeWE
                            Exit For
                        End If
                    End If
                Next
            ElseIf Y > m_udtITRect.Y1 And Y <= m_udtITRect.Y2 Then
                lngCursor = vbArrow
            End If
            
            If UserControl.MousePointer <> lngCursor Then
                UserControl.MousePointer = lngCursor
            End If
            
        Case MouseOverResizeColumn
            ' resize column to cursor
            If Not m_blnColumnsAutoSize Then
                For i = 0 To m_lngColumnResize - 1
                    lngColumnLeft = lngColumnLeft + m_colColumns.Item(i).Width
                Next
                
                lngColWidthNew = X - lngColumnLeft
                If lngColWidthNew < 5 Then lngColWidthNew = 5
    
                m_colColumns.Item(i).Width = lngColWidthNew
            Else
                ' column resize with autosized columns not implemented
            End If
            
            DoSizing
            UpdateVScroll
            DrawListView
            
        Case MouseOverMultiselect
            ' select all items from start item to mouse cursor
            lngItemOver = CLng((Y - m_udtCLRect.Y2) / ItemHeight - 0.5) + m_clsSB.Value(efsVertical)
            
            GetCursorPos udtCursorPos
            ClientToScreen UserControl.hwnd, udtLV
            
            If lngItemOver > m_clsItems.ItemCount - 1 Then
                lngItemOver = m_clsItems.ItemCount - 1
            ElseIf lngItemOver < 0 Then
                lngItemOver = 0
            End If
            
            ' deselected all items around the selection
            If m_lngMultiSelStart > lngItemOver Then
                lngStep = -1
                For i = 0 To lngItemOver - 1
                    m_clsItems.Item(i).Selected = False
                Next
                For i = m_lngMultiSelStart + 1 To m_clsItems.ItemCount - 1
                    m_clsItems.Item(i).Selected = False
                Next
            Else
                lngStep = 1
                For i = 0 To m_lngMultiSelStart - 1
                    m_clsItems.Item(i).Selected = False
                Next
                For i = lngItemOver + 1 To m_clsItems.ItemCount - 1
                    m_clsItems.Item(i).Selected = False
                Next
            End If

            For i = m_lngMultiSelStart To lngItemOver Step lngStep
                m_clsItems.Item(i).Selected = True
            Next
            
            m_lngSelItemIndex = lngItemOver
            
            ' when the cursor is on top or under the listview, scroll
            If ItemCount - VisibleItems > 0 Then
                If udtCursorPos.Y < udtLV.Y + m_udtCLRect.Y2 Then
                    m_clsSB.Value(efsVertical) = m_clsSB.Value(efsVertical) - 1
                ElseIf udtCursorPos.Y > udtLV.Y + UserControl.ScaleHeight - 3 Then
                    m_clsSB.Value(efsVertical) = m_clsSB.Value(efsVertical) + 1
                End If
            End If
            
            DrawListView
            
        Case MouseOverReorder
            If m_blnReorder Then
                ' move selected items to an other index
                lngItemOver = CLng((Y - m_udtCLRect.Y2) / ItemHeight - 0.5) + m_clsSB.Value(efsVertical)
                lngMoveDelta = lngItemOver - m_lngSelItemIndex
    
                GetCursorPos udtCursorPos
                ClientToScreen UserControl.hwnd, udtLV
    
                ' move items upwards
                If lngMoveDelta < 0 Then
                    For i = 0 To m_clsItems.ItemCount - 1
                        If m_clsItems.Item(i).Selected Then
                            If i + lngMoveDelta < 0 Then
                                Exit For
                            Else
                                m_clsItems.MoveItem i, i + lngMoveDelta
                                
                                If i = m_lngSelItemIndex Then
                                    m_lngSelItemIndex = m_lngSelItemIndex + lngMoveDelta
                                End If
                                
                                m_blnItemDragged = True
                            End If
                        End If
                    Next
                ' move items downwards
                ElseIf lngMoveDelta > 0 Then
                    For i = m_clsItems.ItemCount - 1 To 0 Step -1
                        If m_clsItems.Item(i).Selected Then
                            If i + lngMoveDelta > m_clsItems.ItemCount - 1 Then
                                Exit For
                            Else
                                m_clsItems.MoveItem i, i + lngMoveDelta
                                
                                If i = m_lngSelItemIndex Then
                                    m_lngSelItemIndex = m_lngSelItemIndex + lngMoveDelta
                                End If
                                
                                m_blnItemDragged = True
                            End If
                        End If
                    Next
                End If
            End If
            
            If m_blnItemDragged Then
                RaiseEvent Reorder
                DrawListView
            End If
            
    End Select
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i   As Long
        
    If m_udeMouseOver = MouseOverReorder And Button = vbLeftButton Then
        If Not m_blnItemDragged Then
            For i = 0 To m_clsItems.ItemCount - 1
                m_clsItems.Item(i).Selected = False
            Next
            
            m_clsItems.Item(m_lngSelItemIndex).Selected = True
            DrawListView
        End If
    ElseIf m_udeMouseOver = MouseOverColumnClick Then
        For i = 0 To m_colColumns.Count - 1
            With m_colColumns.Item(i)
                If .Pushed Then
                    If m_blnSortable Then
                        m_clsItems.Sort i, .LastSortOrder
                        
                        If .LastSortOrder = SortAscending Then
                            .LastSortOrder = SortDescending
                        Else
                            .LastSortOrder = SortAscending
                        End If
                    End If
                    
                    RaiseEvent ColumnClick(i)
                End If
                
                .Pushed = False
            End With
        Next
        DrawListView
    End If
    
    m_udeMouseOver = MouseOverFree
    tmrMove.Enabled = False

    RaiseEvent MouseUp(m_lngSelItemIndex, Button, Shift, X, Y)
End Sub

Private Function ScrollWithMouse(ByVal Y As Long) As Boolean
    If ItemCount - VisibleItems >= 0 Then
        If Y > UserControl.ScaleHeight - 3 Then
            m_clsSB.Value(efsVertical) = m_clsSB.Value(efsVertical) + 1
            ScrollWithMouse = True
        ElseIf Y < m_udtCLRect.Y2 - 3 Then
            m_clsSB.Value(efsVertical) = m_clsSB.Value(efsVertical) - 1
            ScrollWithMouse = True
        End If
    End If
End Function

Private Sub m_clsFont_FontChanged(ByVal PropertyName As String)
    CreateFont
End Sub

Private Sub CreateFont()
    Dim udtFontData As LOGFONT
    Dim lngTempFont As Long
    
    m_lngFontHeight = MulDiv(m_clsFont.Size, GetDeviceCaps(UserControl.hDC, LOGPIXELSY), 72)
    
    With udtFontData
        .lfCharSet = m_clsFont.Charset
        CopyMemory .lfFaceName(0), ByVal m_clsFont.Name, Min(Len(m_clsFont.Name), 32)
        .lfItalic = Abs(m_clsFont.Italic)
        .lfStrikeOut = Abs(m_clsFont.Strikethrough)
        .lfUnderline = Abs(m_clsFont.Underline)
        .lfWeight = m_clsFont.Weight
        .lfHeight = -m_lngFontHeight
    End With
    
    lngTempFont = CreateFontIndirect(udtFontData)
    SelectObject m_hDCBack, lngTempFont
    DeleteObject m_hFont
    m_hFont = lngTempFont
End Sub

Private Sub UserControl_OLECompleteDrag(Effect As Long)
    If Not m_blnEnabled Then Exit Sub
    RaiseEvent OLECompleteDrag(Effect)
End Sub

Private Sub UserControl_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Not m_blnEnabled Then Exit Sub
    RaiseEvent OLEDragDrop(Data, Effect, Button, Shift, X, Y)
End Sub

Private Sub UserControl_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, state As Integer)
    If Not m_blnEnabled Then Exit Sub
    RaiseEvent OLEDragOver(Data, Effect, Button, Shift, X, Y, state)
End Sub

Private Sub UserControl_OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
    If Not m_blnEnabled Then Exit Sub
    RaiseEvent OLEGiveFeedback(Effect, DefaultCursors)
End Sub

Private Sub UserControl_OLESetData(Data As DataObject, DataFormat As Integer)
    If Not m_blnEnabled Then Exit Sub
    RaiseEvent OLESetData(Data, DataFormat)
End Sub

Private Sub UserControl_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
    If Not m_blnEnabled Then Exit Sub
    RaiseEvent OLEStartDrag(Data, AllowedEffects)
End Sub

Private Sub UserControl_Paint()
    DrawListView
End Sub

Private Sub DoSizing()
    Dim i               As Long
    Dim lngLastHPos     As Long
    Dim lngLastVPos     As Long
    Dim lngColumnLeft   As Long
    Dim lngColAbsWidth  As Long
    Dim lngFixeds       As Long

    GetClientRect UserControl.hwnd, m_udtUCRect

    ' width of the columns
    If m_blnColumnsAutoSize Then
        m_lngColumnsWidth = m_udtUCRect.X2
        
         For i = 0 To m_colColumns.Count - 1
            With m_colColumns.Item(i)
                If .Visible Then
                    If .Resizable Then
                        lngColAbsWidth = lngColAbsWidth + .Width
                    Else
                        lngFixeds = lngFixeds + .Width
                        .WidthAutoSized = .Width
                    End If
                End If
            End With
        Next
        
        For i = 0 To m_colColumns.Count - 1
            With m_colColumns.Item(i)
                If .Visible Then
                    If .Resizable Then
                        .WidthAutoSized = (.Width / lngColAbsWidth) * (m_udtUCRect.X2 - lngFixeds) + 0.5
                    End If
                    
                    If i = m_colColumns.Count - 1 And m_blnColumnsAutoSize Then
                        If .WidthAutoSized + lngColumnLeft > m_udtUCRect.X2 Then
                            .WidthAutoSized = m_udtUCRect.X2 - lngColumnLeft
                        End If
                    End If
                    
                    lngColumnLeft = lngColumnLeft + .W