listview.ctl

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

            DrawColumns
            DrawItems
            
            If m_lngColumnsWidth > m_udtUCRect.X2 Then
                X = m_clsSB.Value(efsHorizontal)
            End If
        
            EndPaint UserControl.hwnd, ps
        
            BitBlt UserControl.hDC, 0, 0, m_udtUCRect.X2, m_udtUCRect.Y2, _
                   m_hDCBack, X, 0, vbSrcCopy
        End If
        
        Redrawing = False
    End If
End Sub

Private Sub DrawItems()
    Dim i               As Long
    Dim j               As Long
    Dim udtItem         As RECT
    Dim udtRest         As RECT
    Dim lngFirstItem    As Long
    Dim lngVisItems     As Long
    Dim lngOldPen       As Long
    Dim lngCustBGColor  As Long
    Dim lngCustFGColor  As Long
    Dim lngLastFGColor  As Long
    Dim strColText      As String

    lngLastFGColor = -1

    If m_clsItems.ItemCount > 0 Then
        udtItem.Y1 = m_udtITRect.Y1
        udtItem.Y2 = m_udtITRect.Y1 + ItemHeight
        
        lngFirstItem = m_clsSB.Value(efsVertical)
        If lngFirstItem > m_clsItems.ItemCount - 1 Then lngFirstItem = m_clsItems.ItemCount - 1
        lngVisItems = VisibleItems
        If lngVisItems > m_clsItems.ItemCount Then lngVisItems = m_clsItems.ItemCount
        
        i = lngFirstItem
        Do
            For j = 0 To m_colColumns.Count - 1
                If m_colColumns.Item(j).Visible Then
                    If m_blnColumnsAutoSize Then
                        udtItem.X2 = udtItem.X2 + m_colColumns.Item(j).WidthAutoSized
                    Else
                        udtItem.X2 = udtItem.X2 + m_colColumns.Item(j).Width
                    End If

                    lngCustBGColor = -1
                    lngCustFGColor = -1

                    If m_clsCustDrawCB.CustomDraw(i, j, lngCustBGColor, lngCustFGColor) Then
                        ' back- and/or forecolor custom for this cell
                        If lngCustFGColor = -1 Then
                            If m_clsForeColor.RGBColor <> lngLastFGColor Then
                                SetTextColor m_hDCBack, m_clsForeColor.RGBColor
                                lngLastFGColor = m_clsForeColor.RGBColor
                            End If
                        Else
                            If lngCustFGColor <> m_clsCustFGColor.OLEColor Then
                                m_clsCustFGColor.SetColor lngCustFGColor
                            End If
                            
                            If m_clsCustFGColor.RGBColor <> lngLastFGColor Then
                                SetTextColor m_hDCBack, m_clsCustFGColor.RGBColor
                                lngLastFGColor = m_clsCustFGColor.RGBColor
                            End If
                        End If
                        
                        If lngCustBGColor = -1 Then
                            FillRect m_hDCBack, udtItem, m_clsBackColor.GDIBrush
                            lngCustBGColor = m_clsBackColor.RGBColor
                        Else
                            If lngCustBGColor <> m_clsCustBGColor.OLEColor Then
                                m_clsCustBGColor.SetColor lngCustBGColor, True
                            End If
                            FillRect m_hDCBack, udtItem, m_clsCustBGColor.GDIBrush
                            lngCustBGColor = m_clsCustBGColor.RGBColor
                        End If
                    Else
                        ' no custom colors for this cell
                        If m_clsItems.Item(i).Selected Then
                            If m_clsSelectedForeColor.RGBColor <> lngLastFGColor Then
                                SetTextColor m_hDCBack, m_clsSelectedForeColor.RGBColor
                                lngLastFGColor = m_clsSelectedForeColor.RGBColor
                            End If
                            
                            FillRect m_hDCBack, udtItem, m_clsSelectedBackColor.GDIBrush
                            lngCustBGColor = m_clsSelectedBackColor.RGBColor
                        Else
                            If m_clsForeColor.RGBColor <> lngLastFGColor Then
                                SetTextColor m_hDCBack, m_clsForeColor.RGBColor
                                lngLastFGColor = m_clsForeColor.RGBColor
                            End If
                            
                            FillRect m_hDCBack, udtItem, m_clsBackColor.GDIBrush
                            lngCustBGColor = m_clsBackColor.RGBColor
                        End If
                    End If
                    
                    With m_clsItems.Item(i)
                        If j = 0 Then
                            ' is this item associated with a picture?
                            If m_lngPictureCount > 0 And m_blnShowPictures Then
                                udtItem.X1 = IMG_LEFT
                                If .PictureIndex > -1 Then
                                    With m_clsPictures(.PictureIndex)
                                        .Render m_hDCBack, _
                                                udtItem.X1, Int((udtItem.Y1 + udtItem.Y2) / 2 - m_lngPictureHeight / 2) + 1, _
                                                m_lngPictureHeight, m_lngPictureWidth
                                    End With
                                End If
                                udtItem.X1 = udtItem.X1 + m_lngPictureWidth + IMG_PAD_RIGHT
                            End If

                            If m_blnCheckBoxes Then
                                DrawCheckbox udtItem, .Selected, .Checked
                                udtItem.X1 = udtItem.X1 + CHECKBOX_WIDTH + CHECKBOX_MARGIN * 2
                            End If
                        End If
                    
                        Select Case ColumnTextAlign(j)
                            Case TextAlignLeft
                                DrawText m_hDCBack, .Text(j), LenB(StrConv(.Text(j), vbFromUnicode)), TempRectLRPadding(udtItem), DT_VCENTER Or DT_SINGLELINE Or DT_END_ELLIPSIS Or DT_LEFT
                            Case TextAlignCenter
                                DrawText m_hDCBack, .Text(j), LenB(StrConv(.Text(j), vbFromUnicode)), TempRectLRPadding(udtItem), DT_VCENTER Or DT_SINGLELINE Or DT_END_ELLIPSIS Or DT_CENTER
                            Case TextAlignRight
                                DrawText m_hDCBack, .Text(j), LenB(StrConv(.Text(j), vbFromUnicode)), TempRectLRPadding(udtItem), DT_VCENTER Or DT_SINGLELINE Or DT_END_ELLIPSIS Or DT_RIGHT
                        End Select
                    End With

                    udtItem.X1 = udtItem.X2
                End If
            Next

            If udtItem.X2 < m_udtITRect.X2 Then
                udtRest = udtItem
                udtRest.X2 = m_udtITRect.X2
                FillRect m_hDCBack, udtRest, m_clsBackColor.GDIBrush
            End If

            If i = m_lngSelItemIndex And m_blnGotFocus And m_blnEnabled Then
                If m_blnSolidFocusRect Then
                    ' draw solid focus rect
                    MoveToEx m_hDCBack, 0, udtItem.Y1, ByVal 0&
                    LineTo m_hDCBack, udtItem.X2 - 1, udtItem.Y1
                    LineTo m_hDCBack, udtItem.X2 - 1, udtItem.Y2 - 1
                    LineTo m_hDCBack, 0, udtItem.Y2 - 1
                    LineTo m_hDCBack, 0, udtItem.Y1
                Else
                    SetTextColor m_hDCBack, 0   ' why necessary???
                    lngLastFGColor = 0
                    
                    udtItem.X1 = 0
                    DrawFocusRect m_hDCBack, udtItem
                End If
            End If
            
            udtItem.X1 = 0
            udtItem.X2 = 0
            udtItem.Y1 = udtItem.Y1 + ItemHeight
            udtItem.Y2 = udtItem.Y2 + ItemHeight

            i = i + 1
        Loop While i <= lngFirstItem + lngVisItems And i <= m_clsItems.ItemCount - 1
        
        If udtItem.X2 < UserControl.ScaleHeight Then
            ' if there is some space left at the bottom, fill it with the
            ' listview's background color
            udtItem.Y2 = UserControl.ScaleHeight
            udtItem.X2 = m_udtITRect.X2
            FillRect m_hDCBack, udtItem, m_clsBackColor.GDIBrush
        End If
    Else
        ' no items, fill the whole listview with its background color
        FillRect m_hDCBack, m_udtITRect, m_clsBackColor.GDIBrush
    End If
End Sub

Private Sub DrawColumns()
    Dim i               As Long
    Dim udtColumn       As RECT
    Dim udtText         As RECT
    Dim lngLastColWidth As Long
    Dim hBrBg           As Long
    
    If m_blnColumnsVisible Then
        hBrBg = CreateSolidBrush(TranslateColor(vbButtonFace))
        SetTextColor m_hDCBack, TranslateColor(vbButtonText)
        
        udtColumn.Y2 = m_udtCLRect.Y2
        
        For i = 0 To m_colColumns.Count - 1
            If m_colColumns.Item(i).Visible Then
                If i > 0 Then
                    If m_blnColumnsAutoSize Then
                        udtColumn.X1 = udtColumn.X1 + m_colColumns.Item(i - 1).WidthAutoSized
                    Else
                        udtColumn.X1 = udtColumn.X1 + m_colColumns.Item(i - 1).Width
                    End If
                End If
                
                If m_blnColumnsAutoSize Then
                    udtColumn.X2 = udtColumn.X1 + m_colColumns.Item(i).WidthAutoSized
                Else
                    udtColumn.X2 = udtColumn.X1 + m_colColumns.Item(i).Width
                End If
                
                FillRect m_hDCBack, udtColumn, hBrBg
                
                If m_colColumns.Item(i).Pushed Then
                    DrawEdge m_hDCBack, udtColumn, EDGE_ETCHED, BF_RECT
                Else
                    DrawEdge m_hDCBack, udtColumn, EDGE_RAISED, BF_RECT
                End If
                
                udtText = udtColumn
                
                udtText.X1 = udtText.X1 + m_lngPaddingLeft
                udtText.X2 = udtText.X2 - m_lngPaddingRight
                
                If (udtText.X2 - udtText.X1) > 0 Then
                    With m_colColumns.Item(i)
                        Select Case .TextAlign
                            Case TextAlignLeft
                                DrawText m_hDCBack, .Caption, LenB(StrConv(.Caption, vbFromUnicode)), udtText, DT_VCENTER Or DT_SINGLELINE Or DT_END_ELLIPSIS
                            Case TextAlignRight
                                DrawText m_hDCBack, .Caption, LenB(StrConv(.Caption, vbFromUnicode)), udtText, DT_VCENTER Or DT_SINGLELINE Or DT_END_ELLIPSIS Or DT_RIGHT
                            Case TextAlignCenter
                                DrawText m_hDCBack, .Caption, LenB(StrConv(.Caption, vbFromUnicode)), udtText, DT_VCENTER Or DT_SINGLELINE Or DT_END_ELLIPSIS Or DT_CENTER
                        End Select
                    End With
                End If
                
                If m_blnColumnsAutoSize Then
                    lngLastColWidth = m_colColumns.Item(i).WidthAutoSized
                Else
                    lngLastColWidth = m_colColumns.Item(i).Width
                End If
            End If
        Next
        
        If udtColumn.X2 < m_udtCLRect.X2 Then
            udtColumn.X1 = udtColumn.X1 + lngLastColWidth
            udtColumn.X2 = m_udtCLRect.X2
            FillRect m_hDCBack, udtColumn, hBrBg
            DrawEdge m_hDCBack, udtColumn, EDGE_RAISED, BF_LEFT Or BF_BOTTOM Or BF_TOP
        End If
        
        DeleteObject hBrBg
    End If
End Sub

' http://pscode.com/vb/scripts/ShowCode.asp?txtCodeId=40157&lngWId=1
Private Sub DrawCheckbox(udtItem As RECT, ByVal Selected As Boolean, ByVal Checked As Boolean)
    Dim X       As Long, Y As Long
    Dim hPenOld As Long

    If Selected Then
        hPenOld = SelectObject(m_hDCBack, m_clsCheckBoxSelColor.GDIPen)
    Else
        hPenOld = SelectObject(m_hDCBack, m_clsCheckBoxColor.GDIPen)
    End If

    X = udtItem.X1 + CHECKBOX_MARGIN
    Y = (udtItem.Y1 + udtItem.Y2) / 2 - CHECKBOX_HEIGHT / 2 - 0.5
    
    ' Rand (2px dick)
    MoveToEx m_hDCBack, X, Y, ByVal 0&
    LineTo m_hDCBack, X + CHECKBOX_WIDTH, Y
    LineTo m_hDCBack, X + CHECKBOX_WIDTH, Y + CHECKBOX_HEIGHT
    LineTo m_hDCBack, X, Y + CHECKBOX_HEIGHT
    LineTo m_hDCBack, X, Y
    MoveToEx m_hDCBack, X - 1, Y - 1, ByVal 0&
    LineTo m_hDCBack, X + CHECKBOX_WIDTH + 1, Y - 1
    LineTo m_hDCBack, X + CHECKBOX_WIDTH + 1, Y + CHECKBOX_HEIGHT + 1
    LineTo m_hDCBack, X - 1, Y + CHECKBOX_HEIGHT + 1
    LineTo m_hDCBack, X - 1, Y - 1
    
    If Checked Then
        ' Haken
        MoveToEx m_hDCBack, X + 9, Y + 5, ByVal 0&
        LineTo m_hDCBack, X + 5, Y + 9
        MoveToEx m_hDCBack, X + 9, Y + 4, ByVal 0&
        LineTo m_hDCBack, X + 4, Y + 9
        MoveToEx m_hDCBack, X + 9, Y + 3, ByVal 0&
        LineTo m_hDCBack, X + 3, Y + 9
        MoveToEx m_hDCBack, X + 3, Y + 5, ByVal 0&
        LineTo m_hDCBack, X + 5, Y + 8
        MoveToEx m_hDCBack, X + 3, Y + 6, ByVal 0&
        LineTo m_hDCBack, X + 6, Y + 9
        MoveToEx m_hDCBack, X + 3, Y + 7, ByVal 0&
        LineTo m_hDCBack, X + 6, Y + 10
        MoveToEx m_hDCBack, X + 3, Y + 7, ByVal 0&
        LineTo m_hDCBack, X + 7, Y + 9
    End If
    
    SelectObject m_hDCBack, hPenOld
End Sub

Private Function TempRectLRPadding(rc As RECT) As RECT
    Dim rcTemp As RECT
    
    rcTemp = rc
    rcTemp.X1 = rcTemp.X1 + m_lngPaddingLeft
    rcTemp.X2 = rcTemp.X2 - m_lngPaddingRight
    
    TempRectLRPadding = rcTemp
End Function

Private Sub pvSetBorderStyle(ByVal lHWnd As Long, ByVal eStyle As LVBorderStyleConstants)
    Select Case eStyle
        Case BorderStyleNone
            Call pvSetWinExStyle(lHWnd, GWL_STYLE, 0, WS_BORDER Or WS_THICKFRAME)
            Call pvSetWinExStyle(lHWnd, GWL_EXSTYLE, 0, WS_EX_STATICEDGE Or WS_EX_CLIENTEDGE Or WS_EX_WINDOWEDGE)
        Case BorderStyleThin
            Call pvSetWinExStyle(lHWnd, GWL_STYLE, 0, WS_BORDER Or WS_THICKFRAME)
            Call pvSetWinExStyle(lHWnd, GWL_EXSTYLE, WS_EX_STATICEDGE, WS_EX_CLIENTEDGE Or WS_EX_WINDOWEDGE)
        Case BorderStyleThick
            Call pvSetWinExStyle(lHWnd, GWL_STYLE, 0, WS_BORDER Or WS_THICKFRAME)
            Call pvSetWinExStyle(lHWnd, GWL_EXSTYLE, WS_EX_CLIENTEDGE, WS_EX_STATICEDGE Or WS_EX_WINDOWEDGE)
    End Select
End Sub

Private Sub pvSetWinExStyle(ByVal lHWnd As Long, ByVal lType As Long, ByVal lStyle As Long, ByVal lStyleNot As Long)
    Dim lS As Long
    
    lS = GetWindowLong(lHWnd, lType)
    lS = (lS And Not lStyleNot) Or lStyle
    SetWindowLong lHWnd, lType, lS
    SetWindowPos lHWnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
End Sub

Private Property Get VisibleItems() As Long
    VisibleItems = (m_udtITRect.Y2 - m_udtITRect.Y1 + 1) / ItemHeight + 0.5
End Property

Public Property Get ItemHeight() As Long
    Dim lngHeight As Long
    
    If Not m_blnItemAutoSize Then
        ItemHeight = m_lngFontHeight + m_lngPaddingTop + m_lngPaddingBottom
    Else
        lngHeight = m_lngFontHeight + 4
        
        If m_blnCheckBoxes Then
            lngHeight = Max(lngHeight, CHECKBOX_HEIGHT + 7)
        End If
        
        If m_blnShowPictures And m_lngPictureCount > 0 Then
            lngHeight = Max(lngHeight, m_lngPictureHeight + 3)
        End If
        
        If lngHeight = 0 Then ItemHeight = 1 Else ItemHeight = lngHeight
    End If
End Property

Private Function TranslateColor(ByVal oClr As ole_color, Optional hPal As Long = 0) As Long
    If OleTranslateColor(oClr, hPal, TranslateColor) Then TranslateColor = CLR_INVALID
End Function

Private Function ICustomDraw_CustomDraw(ByVal ItemIndex As Long, ByVal ColumnIndex As Long, BackColor As Long, ForeColor As Long) As Boolean
    '
End Function

Private Sub CreateDrawPlane()