coollist.ctl

这个是属性空间 比较不错 可以和系统的相媲美

Public Property Get BackNormal() As OLE_COLOR

    '-- BackNormal

    BackNormal = m_BackNormal

End Property

Public Property Let BackSelected(ByVal New_BackSelected As OLE_COLOR)

    m_BackSelected = New_BackSelected
    m_ColorBackSel = GetLngColor(m_BackSelected)
    Call iScr_Paint

End Property

Public Property Get BackSelected() As OLE_COLOR

    '-- BackSelected

    BackSelected = m_BackSelected

End Property

Public Property Let BackSelectedG1(ByVal New_BackSelectedG1 As OLE_COLOR)

    m_BackSelectedG1 = New_BackSelectedG1
    m_ColorGradient1 = GetRGBColors(GetLngColor(m_BackSelectedG1))
    Call iScr_Paint

End Property

Public Property Get BackSelectedG1() As OLE_COLOR

    '-- BackSelectedG1

    BackSelectedG1 = m_BackSelectedG1

End Property

Public Property Get BackSelectedG2() As OLE_COLOR

    '-- BackSelectedG2

    BackSelectedG2 = m_BackSelectedG2

End Property

Public Property Let BackSelectedG2(ByVal New_BackSelectedG2 As OLE_COLOR)

    m_BackSelectedG2 = New_BackSelectedG2
    m_ColorGradient2 = GetRGBColors(GetLngColor(m_BackSelectedG2))
    Call iScr_Paint

End Property

Private Sub Bar_Change()

    '-------------------------------------------------------------------------------------------
    '-- ScrollBar
    '-------------------------------------------------------------------------------------------

    If (m_LastBar <> Bar) Then
        m_LastBar = Bar
        m_LastY = -1

        If (txtEdit.Visible = True) Then
            Call txtEdit_LostFocus
        End If

        If (m_ListIndex = m_LastItem) Then
            Call DrawList
        End If

        RaiseEvent Scroll
        RaiseEvent TopIndexChange
    End If

End Sub

Private Sub Bar_Scroll()

    Call Bar_Change
    RaiseEvent Scroll

End Sub

Public Property Let BorderStyle(ByVal New_BorderStyle As BorderStyleCts)

    UserControl.BorderStyle() = New_BorderStyle

End Property

Public Property Get BorderStyle() As BorderStyleCts

    '-- BorderStyle

    BorderStyle = UserControl.BorderStyle

End Property

Public Property Let BoxBorder(ByVal New_BoxBorder As OLE_COLOR)

    m_BoxBorder = New_BoxBorder
    m_ColorBox = GetLngColor(m_BoxBorder)
    Call iScr_Paint

End Property

Public Property Get BoxBorder() As OLE_COLOR

    '-- BoxBorder

    BoxBorder = m_BoxBorder

End Property

Public Property Get BoxOffset() As Integer

    '-- BoxOffset

    BoxOffset = m_BoxOffset

End Property

Public Property Let BoxOffset(ByVal New_BoxOffset As Integer)

    If (New_BoxOffset <= m_tmpItemHeight * 0.5) Then
        m_BoxOffset = New_BoxOffset
    End If

    Call iScr_Paint

End Property

Public Property Let BoxRadius(ByVal New_BoxRadius As Integer)

    m_BoxRadius = New_BoxRadius
    Call iScr_Paint

End Property

Public Property Get BoxRadius() As Integer

    '-- BoxRadius

    BoxRadius = m_BoxRadius

End Property

Private Sub CalculateRects()

  Dim i As Long

    For i = 0 To m_VisibleRows - 1
        Call SetRect(m_ItemRct(i), 0, i * m_tmpItemHeight, ScaleWidth, i * m_tmpItemHeight + _
            m_tmpItemHeight)
        Call SetRect(m_TextRct(i), m_ItemOffset + m_ItemTextLeft, i * m_tmpItemHeight + _
            m_ItemOffset, ScaleWidth - m_ItemOffset, i * m_tmpItemHeight + m_tmpItemHeight - _
            m_ItemOffset)
        m_IconPt(i).X = m_ItemOffset
        m_IconPt(i).Y = m_ItemOffset
    Next

End Sub

Public Sub Clear()

    '-- Clear

    '-- Hide scroll bar
    Bar.Visible = 0
    Bar.Max = 0
    '-- Clear and resize drawing area
    Call iScr.Cls
    Call iScr.Move(0, 0, ScaleWidth, ScaleHeight)
    '-- Reset Item arrays
    ReDim m_List(0)
    ReDim m_Selected(0)
    m_nItems = 0
    m_LastItem = -1
    m_ListIndex = -1
    m_TopIndex = -1

End Sub

Private Sub DrawBack(ByVal hDC As Long, _
                     pRect As RECT2, _
                     ByVal Color As Long, _
                     Optional ByVal Selected As Boolean = False)

  Dim hBrush As Long

    On Error Resume Next
    hBrush = CreateSolidBrush(Color)
    Call FillRect(hDC, pRect, hBrush)
    Call DeleteObject(hBrush)

    If (Selected = True) Then
        hBrush = CreateSolidBrush(m_SelectListBorderColor)
        Call FrameRect(hDC, pRect, hBrush)
        Call DeleteObject(hBrush)
    End If

End Sub

Private Sub DrawBackGrad(ByVal hDC As Long, _
                         pRect As RECT2, _
                         Color1 As RGB, _
                         Color2 As RGB, _
                         ByVal Direction As Long)

  Dim v(1) As TRIVERTEX
  Dim GRct As GRADIENT_RECT

    '-- from

    With v(0)
        .X = pRect.x1
        .Y = pRect.y1
        .R = Color1.R
        .G = Color1.G
        .B = Color1.B
        .Alpha = 0
    End With

    '-- to

    With v(1)
        .X = pRect.x2
        .Y = pRect.y2
        .R = Color2.R
        .G = Color2.G
        .B = Color2.B
        .Alpha = 0
    End With

    GRct.UpperLeft = 0
    GRct.LowerRight = 1
    Call GradientFillRect(hDC, v(0), 2, GRct, 1, Direction)

End Sub

Private Sub DrawBox(ByVal hDC As Long, _
                    pRect As RECT2, _
                    ByVal Offset As Long, _
                    ByVal Radius As Long, _
                    ByVal ColorFill As Long, _
                    ByVal ColorBorder As Long)

  Dim hPen As Long
  Dim hBrush As Long

    hPen = SelectObject(hDC, CreatePen(PS_SOLID, 1, ColorBorder))
    hBrush = SelectObject(hDC, CreateSolidBrush(ColorFill))
    Call InflateRect(pRect, -Offset, -Offset)
    Call RoundRect(hDC, pRect.x1, pRect.y1, pRect.x2, pRect.y2, Radius, Radius)
    Call InflateRect(pRect, Offset, Offset)
    Call DeleteObject(SelectObject(hDC, hPen))
    Call DeleteObject(SelectObject(hDC, hBrush))

End Sub

Private Sub DrawDither(ByVal hDC As Long, pRect As RECT2, ByVal Color As Long)

  Dim hBrush As Long

    hBrush = SelectObject(hDC, CreateSolidBrush(Color))
    Call PatBlt(hDC, pRect.x1, pRect.y1, pRect.x2 - pRect.x1, pRect.y2 - pRect.y1, &HA000C9)
    Call DeleteObject(SelectObject(hDC, hBrush))

End Sub

Private Sub DrawFocus(ByVal Index As Integer)

    '-- DrawFocus

    If Not (m_Focus = True) Or Not (m_HasFocus = True) Then Exit Sub
    '-- Item out of area ?
    If (Index < Bar) Or (Index > Bar + m_VisibleRows - 1) Then Exit Sub
    '-- Draw it
    Call SetTextColor(iScr.hDC, m_ColorFont)
    Call DrawFocusRect(iScr.hDC, m_ItemRct(Index - Bar))

End Sub

Private Sub DrawGrad()

  Dim tmpRect As RECT2

    If (m_ListGradient = True) Then
        tmpRect.x1 = 0
        tmpRect.y1 = 0
        tmpRect.x2 = iScr.ScaleWidth
        tmpRect.y2 = iScr.ScaleHeight
        Call DrawBackGrad(iScr.hDC, tmpRect, m_ColorGradient1, m_ColorGradient2, _
            GRADIENT_FILL_RECT_V)
    End If

End Sub

Private Sub DrawItem(ByVal Index As Integer)

    '-- DrawItem

  Dim nRctIndex As Integer
  Dim FontC As Long

    '-- Item out of area?
    If (Index < Bar) Or (Index > Bar + m_VisibleRows - 1) Then Exit Sub
    If (Index > UBound(m_List) - 1) Then Exit Sub
    iScr.FontUnderline = 0
    nRctIndex = Index - Bar
    On Error Resume Next

    If Not (m_Selected(Index - 1) = True) And (m_Selected(Index) = False) And _
        (m_List(Index).SeparatorLine = True) Then
        Call APIRectangle(iScr.hDC, 5, m_ItemRct(nRctIndex).y1, iScr.ScaleWidth, 0, _
            m_ShadowColorText)
    ElseIf (m_List(Index).SeparatorLine = True) And (m_List(Index - 1).Enabled = False) Then
        Call APIRectangle(iScr.hDC, 5, m_ItemRct(nRctIndex).y1, iScr.ScaleWidth, 0, _
            m_ShadowColorText)
    End If

    '-- Draw m_Selected Item

    If (m_Selected(Index) = True) And (m_List(Index).Enabled = True) Then
        '-- Draw back area

        Select Case m_SelectModeStyle
        Case 0 '[Standard]
            Call DrawBack(iScr.hDC, m_ItemRct(nRctIndex), m_ColorBackSel, True)
            Call SetTextColor(iScr.hDC, m_ColorFontSel)

        Case 1 '[Dither] *(Effect will be applied after drawing icon)
            Call DrawBack(iScr.hDC, m_ItemRct(nRctIndex), m_ColorBack, True)
            Call SetTextColor(iScr.hDC, m_ColorFontSel)

        Case 2 '[Gradient_V]
            Call DrawBackGrad(iScr.hDC, m_ItemRct(nRctIndex), m_ColorGradient1, m_ColorGradient2, _
                GRADIENT_FILL_RECT_V)
            Call SetTextColor(iScr.hDC, m_ColorFontSel)

        Case 3 '[Gradient_H]
            Call DrawBackGrad(iScr.hDC, m_ItemRct(nRctIndex), m_ColorGradient1, m_ColorGradient2, _
                GRADIENT_FILL_RECT_H)
            Call SetTextColor(iScr.hDC, m_ColorFontSel)

        Case 4 '[Box]
            Call DrawBack(iScr.hDC, m_ItemRct(nRctIndex), m_ColorBack, True)
            Call DrawBox(iScr.hDC, m_ItemRct(nRctIndex), m_BoxOffset, m_BoxRadius, m_ColorBackSel, _
                m_ColorBox)
            Call SetTextColor(iScr.hDC, m_ColorFontSel)

        Case 5 '[Underline]
            Call DrawBack(iScr.hDC, m_ItemRct(nRctIndex), m_ColorBack)
            Call SetTextColor(iScr.hDC, m_ColorFontSel)
            iScr.FontUnderline = -1

        Case 6 '[byPicture]

            If Not (SelectionPicture Is Nothing) Then
                Call iScr.PaintPicture(SelectionPicture, 0, m_ItemRct(nRctIndex).y1, _
                    m_ItemRct(nRctIndex).x2, m_tmpItemHeight)
            Else
                Call DrawBack(iScr.hDC, m_ItemRct(nRctIndex), m_ColorBackSel, True)
            End If

            Call SetTextColor(iScr.hDC, m_ColorFontSel)
        End Select

        '-- Draw icon

        If (Not m_pImgList Is Nothing) Then
            On Error Resume Next

            If (m_WordWrap = True) Then
                Call m_pImgList.ListImages(m_List(Index).IconSelected).Draw(iScr.hDC, _
                    ScaleX(m_ItemOffset + 1, vbPixels, m_ILScale), ScaleY(m_ItemRct(nRctIndex).y1 _
                    + m_ItemOffset, vbPixels, m_ILScale), 1)
            Else
                Call m_pImgList.ListImages(m_List(Index).IconSelected).Draw(iScr.hDC, _
                    ScaleX(m_ItemOffset + 1, vbPixels, m_ILScale), ScaleY(m_ItemRct(nRctIndex).y1 _
                    + (m_tmpItemHeight - m_pImgList.ImageHeight) * 0.5, vbPixels, m_ILScale), 1)
            End If

            On Error GoTo 0
        End If

        '-- Apply dither effect (*)
        If (m_SelectModeStyle = 1) Then Call DrawDither(iScr.hDC, m_ItemRct(nRctIndex), _
            m_ColorBackSel)
    Else
        '-- Draw back area
        Call SetTextColor(iScr.hDC, m_List(Index).Color)
        '-- Draw icon

        If (Not m_pImgList Is Nothing) Then
            On Error Resume Next

            If (m_List(Index).Enabled = True) Then
                If (m_WordWrap = True) Then
                    Call m_pImgList.ListImages(m_List(Index).IconSelected).Draw(iScr.hDC, _
                        ScaleX(m_ItemOffset + 1, vbPixels, m_ILScale), _
                        ScaleY(m_ItemRct(nRctIndex).y1 + m_ItemOffset, vbPixels, m_ILScale), 1)
                Else
                    Call m_pImgList.ListImages(m_List(Index).IconSelected).Draw(iScr.hDC, _
                        ScaleX(m_ItemOffset + 1, vbPixels, m_ILScale), _
                        ScaleY(m_ItemRct(nRctIndex).y1 + (m_tmpItemHeight - _
                        m_pImgList.ImageHeight) * 0.5, vbPixels, m_ILScale), 1)
                End If

            Else
                'Call RenderIconGrayscale(iScr.hDC, m_pImgList.ListImages(Index +
                '   1).ExtractIcon.Handle, m_ItemOffset + 1, m_ItemRct(nRctIndex).y1 + m_ItemOffset)
            End If

            On Error GoTo 0
        End If

    End If

    If (m_Selected(Index) = True) And (m_List(Index).Enabled = True) Then
        FontC = m_ColorFontSel
    Else
        FontC = m_List(Index).Color
    End If

    '-- Draw text...

    If (m_WordWrap = True) Then
        If (m_List(Index).TextShadow = True) Then
            Call SetTextColor(iScr.hDC, m_ShadowColorText)
            m_TextRct(nRctIndex).x1 = m_TextRct(nRctIndex).x1 + 2: m_TextRct(nRctIndex).x2 = _
                m_TextRct(nRctIndex).x2 + 1

            If (mWindowsNT = True) Then
                Call DrawTextW(iScr.hDC, StrPtr(m_List(Index).Text), Len(m_List(Index).Text), _
                    m_TextRct(nRctIndex), m_Alignment Or DT_WORDBREAK)
            Else
                Call DrawTextA(iScr.hDC, m_List(Index).Text, Len(m_List(Index).Text), _
                    m_TextRct(nRctIndex), m_Alignment Or DT_WORDBREAK)
            End If

            m_TextRct(nRctIndex).x1 = m_TextRct(nRctIndex).x1 - 2: m_TextRct(nRctIndex).x2 = _
                m_TextRct(nRctIndex).x2 - 1
        End If

        Call SetTextColor(iScr.hDC, FontC)

        If (mWindowsNT = True) Then
            Call DrawTextW(iScr.hDC, StrPtr(m_List(Index).Text), Len(m_List(Index).Text), _
                m_TextRct(nRctIndex), m_Alignment Or DT_WORDBREAK)
        Else
            Call DrawTextA(iScr.hDC, m_List(Index).Text, Len(m_List(Index).Text), _
                m_TextRct(nRctIndex), m_Alignment Or DT_WORDBREAK)
        End If