listview.ctl

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

    Dim dX As Long
    
    If m_hDCBack = 0 Then
        m_hDCBack = CreateCompatibleDC(UserControl.hDC)
        m_hOldFont = GetCurrentObject(m_hDCBack, OBJ_FONT)
        m_hOldPen = GetCurrentObject(m_hDCBack, OBJ_PEN)
    End If
    
    If m_hDCBackBmp <> 0 Then
        SelectObject m_hDCBack, m_hDCBackOldBmp
        DeleteObject m_hDCBackBmp
        m_hDCBackBmp = 0
        m_hDCBackOldBmp = 0
    End If
    
    If m_lngColumnsWidth > UserControl.ScaleWidth Then
        dX = m_lngColumnsWidth
    Else
        dX = UserControl.ScaleWidth
    End If
    
    m_hDCBackBmp = CreateCompatibleBitmap(UserControl.hDC, dX, UserControl.ScaleHeight)
    If m_hDCBackBmp <> 0 Then
        m_hDCBackOldBmp = SelectObject(m_hDCBack, m_hDCBackBmp)
        SetBkMode m_hDCBack, 1
    End If
End Sub

Private Function Max(ByVal val1 As Long, ByVal val2 As Long) As Long
    If val1 > val2 Then Max = val1 Else Max = val2
End Function

Private Function Min(ByVal val1 As Long, ByVal val2 As Long) As Long
    If val1 < val2 Then Min = val1 Else Min = val2
End Function


Public Sub Sort(Index, ByVal SortOrder As SortOrderConstants)
    m_clsItems.Sort ColumnIndex(Index), SortOrder
End Sub

Public Function ColumnFromPoint(ByVal X As Long, ByVal Y As Long) As Long
    Dim i           As Long
    Dim lngWidth    As Long
    
    ' get the index of a column relative to the listview's (x,y)
    
    X = X + m_clsSB.Value(efsHorizontal)
    
    If X > m_lngColumnsWidth - 1 Then
        ColumnFromPoint = -1
    Else
        For i = 0 To m_colColumns.Count - 1
            lngWidth = lngWidth + m_colColumns.Item(i).Width
            If lngWidth > X Then
                ColumnFromPoint = i
                Exit For
            End If
        Next
    End If
End Function

Public Function RowFromPoint(ByVal X As Long, ByVal Y As Long, Optional ByVal HitTest As Boolean = False) As Long
    Dim lngItem As Long
    
    ' get the index of a row relative to the listview's (x,y) and the first visible item
    
    lngItem = CLng((Y - m_udtCLRect.Y2) / ItemHeight - 0.5) + m_clsSB.Value(efsVertical)
    
    If HitTest Then
        If X > m_lngColumnsWidth - 1 Then
            lngItem = -1
        Else
            If lngItem > ItemCount - 1 Or lngItem < 0 Then
                RowFromPoint = -1
            Else
                RowFromPoint = lngItem
            End If
        End If
    Else
        RowFromPoint = lngItem
    End If
End Function

Private Sub UpdateVScroll()
    Dim rc          As RECT

    If m_blnEnabled Then
        If ItemCount - VisibleItems >= 0 Then
            If Not m_clsSB.Enabled(efsVertical) Then m_clsSB.Enabled(efsVertical) = True
            m_clsSB.Max(efsVertical) = ItemCount - VisibleItems
        Else
            If m_clsSB.Enabled(efsVertical) Then
                m_clsSB.Enabled(efsVertical) = False
                m_clsSB.Max(efsVertical) = 0
                m_clsSB.Value(efsVertical) = 0
            End If
        End If
    Else
        m_clsSB.Enabled(efsVertical) = False
    End If
End Sub

Private Sub m_clsSB_Change(eBar As EFSScrollBarConstants)
    DrawListView
End Sub

Private Sub m_clsSB_Scroll(eBar As EFSScrollBarConstants)
    DrawListView
End Sub

Private Sub m_clsSB_ScrollClick(eBar As EFSScrollBarConstants, eButton As MouseButtonConstants)
    DrawListView
End Sub

Public Sub Refresh()
    DoSizing
    UpdateVScroll
    DrawListView
End Sub

Private Sub tmrMove_Timer()
    Dim udtCursor   As POINTAPI
    Dim udtRC       As POINTAPI
    
    GetCursorPos udtCursor
    ClientToScreen UserControl.hwnd, udtRC

    If ScrollWithMouse(udtCursor.Y - udtRC.Y) Then
        UserControl_MouseMove vbLeftButton, 0, udtCursor.X - udtRC.X, udtCursor.Y - udtRC.Y
    End If
End Sub

Private Sub UserControl_Click()
    If m_lngSelItemIndex >= 0 And m_lngSelItemIndex <= m_clsItems.ItemCount - 1 Then
        RaiseEvent Click(m_lngSelItemIndex)
    End If
End Sub

Private Sub UserControl_DblClick()
    If m_lngSelItemIndex >= 0 And m_lngSelItemIndex <= m_clsItems.ItemCount - 1 Then
        If m_clsItems.Item(m_lngSelItemIndex).Selected Then
            RaiseEvent DblClick(m_lngSelItemIndex)
        End If
    End If
End Sub

Public Sub MakeSureVisible(ByVal lngItem As Long, Optional ByVal lngColumn As Long = -1)
    Dim i           As Long
    Dim lngColLeft  As Long
    
    ' Item
    m_clsSB.Value(efsVertical) = lngItem
    
    ' Column
    If lngColumn > -1 And (Not m_blnColumnsAutoSize) Then
        If m_lngColumnsWidth > UserControl.ScaleWidth Then
            For i = 0 To lngColumn - 1
                With m_colColumns.Item(i)
                    If .Visible Then lngColLeft = lngColLeft + .Width
                End With
            Next
            
            m_clsSB.Value(efsHorizontal) = lngColLeft
        End If
    End If
    
    DrawListView
End Sub

Public Sub SelectAll()
    Dim i   As Long
    
    If m_blnMultiSelect Then
        For i = 0 To m_clsItems.ItemCount - 1
            m_clsItems.Item(i).Selected = True
        Next
    End If
End Sub

Public Sub UnSelectAll()
    Dim i   As Long
    
    For i = 0 To m_clsItems.ItemCount - 1
        m_clsItems.Item(i).Selected = False
    Next
End Sub

Private Sub UserControl_GotFocus()
    m_blnGotFocus = True
    DrawListView
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    If Not m_blnEnabled Then Exit Sub
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    If Not m_blnEnabled Then Exit Sub
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_LostFocus()
    m_blnGotFocus = False
    DrawListView
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    If Not m_blnEnabled Then Exit Sub
    
    RaiseEvent KeyDown(KeyCode, Shift)

    Select Case KeyCode
        Case vbKeyUp, vbKeyDown, vbKeyPageDown, vbKeyPageUp
            If Shift = 0 Or Not m_blnMultiSelect Then
                UnSelectAll
                m_blnMultiSelRem = False
            End If
            
            Select Case KeyCode
                Case vbKeyUp
                    m_lngSelItemIndex = m_lngSelItemIndex - 1
                    If m_lngSelItemIndex < 0 Then m_lngSelItemIndex = 0
                    If m_lngSelItemIndex < m_clsSB.Value(efsVertical) Then m_clsSB.Value(efsVertical) = m_clsSB.Value(efsVertical) - 1
                    RaiseEvent Click(m_lngSelItemIndex)
                Case vbKeyDown
                    m_lngSelItemIndex = m_lngSelItemIndex + 1
                    If m_lngSelItemIndex > m_clsItems.ItemCount - 1 Then m_lngSelItemIndex = m_clsItems.ItemCount - 1
                    If m_lngSelItemIndex > m_clsSB.Value(efsVertical) + VisibleItems - 2 Then m_clsSB.Value(efsVertical) = m_clsSB.Value(efsVertical) + 1
                    RaiseEvent Click(m_lngSelItemIndex)
                Case vbKeyPageUp
                    m_lngSelItemIndex = m_lngSelItemIndex - VisibleItems + 1
                    If m_lngSelItemIndex < 0 Then m_lngSelItemIndex = 0
                    If m_lngSelItemIndex < m_clsSB.Value(efsVertical) Then m_clsSB.Value(efsVertical) = m_clsSB.Value(efsVertical) - VisibleItems + 1
                    RaiseEvent Click(m_lngSelItemIndex)
                Case vbKeyPageDown
                    m_lngSelItemIndex = m_lngSelItemIndex + VisibleItems - 1
                    If m_lngSelItemIndex > m_clsItems.ItemCount - 1 Then m_lngSelItemIndex = m_clsItems.ItemCount - 1
                    If m_lngSelItemIndex > m_clsSB.Value(efsVertical) + VisibleItems - 2 Then m_clsSB.Value(efsVertical) = m_clsSB.Value(efsVertical) + VisibleItems - 1
                    RaiseEvent Click(m_lngSelItemIndex)
            End Select
            
            If Shift <> 2 Or Not m_blnMultiSelect Then
                m_clsItems.Item(m_lngSelItemIndex).Selected = Not m_blnMultiSelRem
            End If

        Case vbKeySpace
            If Shift = 2 And m_blnMultiSelect Then
                m_clsItems.Item(m_lngSelItemIndex).Selected = Not m_clsItems.Item(m_lngSelItemIndex).Selected
                m_blnMultiSelRem = Not m_clsItems.Item(m_lngSelItemIndex).Selected
            End If
            
            If m_blnCheckBoxes Then
                ItemChecked(m_lngSelItemIndex) = Not ItemChecked(m_lngSelItemIndex)
            End If
            
'        Case vbKeyReturn
'            UnSelectAll
'            If m_lngSelItemIndex >= 0 And m_lngSelItemIndex <= m_clsItems.ItemCount - 1 Then
'                m_clsItems.Item(m_lngSelItemIndex).Selected = True
'                RaiseEvent DblClick(m_lngSelItemIndex)
'            End If
            
    End Select
    
    DrawListView
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lngColumnLeft   As Long
    Dim lngClickedItem  As Long
    Dim lngLastWidth    As Long
    Dim lngStep         As Long
    Dim i               As Long
    
    If Not m_blnEnabled Then Exit Sub
    
    X = X + m_clsSB.Value(efsHorizontal)

    If X <= m_lngColumnsWidth Then
    
        If m_blnColumnsVisible And (Y >= m_udtCLRect.Y1 And Y <= m_udtCLRect.Y2) Then
            ' resize column?
            For i = 0 To m_colColumns.Count - 1
                If m_blnColumnsAutoSize Then
                    lngColumnLeft = lngColumnLeft + m_colColumns.Item(i).WidthAutoSized
                Else
                    lngColumnLeft = lngColumnLeft + ColumnWidth(i)
                End If
                
                If Abs(X - lngColumnLeft) < 5 Then
                    ' resize column!
                    If m_colColumns.Item(i).Resizable Then
                        m_udeMouseOver = MouseOverResizeColumn
                        m_lngColumnResize = i
                    End If
                    Exit Sub
                    
                ElseIf X > lngLastWidth + 5 And X < lngColumnLeft - 5 Then
                    ' clicked on a column button
                    m_colColumns.Item(i).Pushed = True
                    m_udeMouseOver = MouseOverColumnClick
                    DrawListView
                    Exit Sub
                End If

                lngLastWidth = lngColumnLeft
            Next
            
        ElseIf Y >= m_udtITRect.Y1 And Y <= m_udtITRect.Y2 Then
            lngClickedItem = CLng((Y - m_udtCLRect.Y2) / ItemHeight - 0.5) + m_clsSB.Value(efsVertical)
            
            If lngClickedItem <= m_clsItems.ItemCount - 1 And lngClickedItem >= 0 Then
                
                ' Checkbox click?
                If m_blnCheckBoxes Then
                    If ColumnFromPoint(X, Y) = 0 Then
                        If m_blnShowPictures And m_lngPictureCount > 0 Then
                            If X > CHECKBOX_MARGIN + IMG_LEFT + IMG_PAD_RIGHT + m_lngPictureWidth And X < m_lngPictureWidth + IMG_LEFT + IMG_PAD_RIGHT + CHECKBOX_MARGIN + CHECKBOX_WIDTH Then
                                ItemChecked(lngClickedItem) = Not ItemChecked(lngClickedItem)
                                RaiseEvent ItemCheck(lngClickedItem)
                                DrawListView
                                Exit Sub
                            End If
                        Else
                            If X > CHECKBOX_MARGIN And X < CHECKBOX_MARGIN + CHECKBOX_WIDTH Then
                                ItemChecked(lngClickedItem) = Not ItemChecked(lngClickedItem)
                                RaiseEvent ItemCheck(lngClickedItem)
                                DrawListView
                                Exit Sub
                            End If
                        End If
                    End If
                End If
                
                ' Item click?
                If Not m_clsItems.Item(lngClickedItem).Selected Or Shift = 1 Then
                    If Shift = 0 Or Not m_blnMultiSelect Then
                        For i = 0 To m_clsItems.ItemCount - 1
                            m_clsItems.Item(i).Selected = False
                        Next
                        If m_blnMultiSelect Then
                            m_udeMouseOver = MouseOverMultiselect
                            tmrMove.Enabled = True
                        End If
                    ElseIf Shift = 1 And m_blnMultiSelect Then
                        If m_lngSelItemIndex > lngClickedItem Then
                            lngStep = -1
                        Else
                            lngStep = 1
                        End If
                        
                        For i = m_lngSelItemIndex To lngClickedItem Step lngStep
                            m_clsItems.Item(i).Selected = Not m_blnMultiSelRem
                        Next
                    End If
                End If
                
                ' "Not m_blnMultiselect" for one-click-reorder
                If m_clsItems.Item(lngClickedItem).Selected Or Not m_blnMultiSelect Then
                    ' Items umsiedeln wenn kein Shift oder Strg
                    If Shift = 0 Then
                        ' no m_blnReorder condition here so that
                        ' for a single click the selection gets removed in
                        ' UserControl_MouseUp
                        m_udeMouseOver = MouseOverReorder
                        tmrMove.Enabled = m_blnReorder
                        m_blnItemDragged = False