coollist.ctl

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

    Else

        If (m_List(Index).TextShadow = True) Then
            Call SetTextColor(iScr.hDC, m_ShadowColorText)
            m_TextRct(nRctIndex).x1 = m_TextRct(nRctIndex).x1 + 1: 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 - 1: 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

    End If

End Sub

Private Sub DrawList()

    '-------------------------------------------------------------------------------------------
    '-- Draw List / Item / Focus
    '-------------------------------------------------------------------------------------------
    '-- DrawList

  Dim i As Long

    iScr.Cls

    If (UBound(m_List) > 0) Then
        '-- Draw visible rows
        Call DrawGrad

        For i = Bar To Bar + m_VisibleRows - 1
            Call DrawItem(i)
        Next

        '-- Draw focus
        Call DrawFocus(m_ListIndex)
    End If

    Call APIRectangle(iScr.hDC, 0, 0, iScr.ScaleWidth - 1, iScr.ScaleHeight - 1, _
        m_SelectBorderColor)

End Sub

Public Property Get Enabled() As Boolean

    '-- Enabled

    Enabled = UserControl.Enabled

End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)

    UserControl.Enabled() = New_Enabled
    Bar.Enabled = New_Enabled
    iScr.Enabled = New_Enabled

End Property

Public Sub EndEdit(Optional ByVal Modify As Boolean = 0)

    If (Modify = True) Then Call txtEdit_KeyPress(13) Else Call txtEdit_LostFocus

End Sub

Public Function FindFirst(ByVal FindString As String, _
                          Optional ByVal StartIndex As Integer = 0, _
                          Optional ByVal StartWith As Boolean = False) As Integer

    '-- FindFirst

  Dim i As Long

    If (m_nItems = 0) Then
        FindFirst = -2
        Exit Function
    End If

    For i = StartIndex To m_nItems

        If (StartWith = True) Then
            If (m_List(i).Text = FindString) Then FindFirst = i: Exit Function
        Else
            If (InStr(1, LCase$(m_List(i).Text), LCase$(FindString)) > 1) Then FindFirst = i: Exit _
                Function
        End If

    Next
    '-- FindString not found
    FindFirst = -1

End Function

Public Property Let Focus(ByVal New_Focus As Boolean)

    m_Focus = New_Focus

    If (New_Focus) Then
        Call DrawFocus(m_ListIndex)
    Else
        Call DrawItem(m_ListIndex)
    End If

End Property

Public Property Get Focus() As Boolean

    '-- Focus

    Focus = m_Focus

End Property

Public Property Set Font(ByVal New_Font As Font)

    With m_Font
        .Name = New_Font.Name
        .Size = New_Font.Size
        .Bold = New_Font.Bold
        .Italic = New_Font.Italic
        .Underline = New_Font.Underline
        .Strikethrough = New_Font.Strikethrough
    End With

    Call iScr_Paint

End Property

Public Property Get Font() As Font

    '-- Font

    Set Font = m_Font

End Property

Public Property Get FontNormal() As OLE_COLOR

    '-- FontNormal

    FontNormal = m_FontNormal

End Property

Public Property Let FontNormal(ByVal New_FontNormal As OLE_COLOR)

    m_FontNormal = New_FontNormal
    m_ColorFont = GetLngColor(m_FontNormal)
    Call SetTextColor(iScr.hDC, m_ColorFont)
    Call iScr_Paint

End Property

Public Property Get FontSelected() As OLE_COLOR

    '-- FontSelected

    FontSelected = m_FontSelected

End Property

Public Property Let FontSelected(ByVal New_FontSelected As OLE_COLOR)

    m_FontSelected = New_FontSelected
    m_ColorFontSel = GetLngColor(m_FontSelected)
    Call iScr_Paint

End Property

Private Function GetLngColor(ByVal Color As Long) As Long

    If (Color And &H80000000) Then
        GetLngColor = GetSysColor(Color And &H7FFFFFFF)
    Else
        GetLngColor = Color
    End If

End Function

Private Function GetRGBColors(ByVal Color As Long) As RGB

  Dim HexColor As String

    HexColor = String$(6 - Len(Hex(Color)), "0") & Hex$(Color)
    GetRGBColors.R = "&H" & Mid$(HexColor, 5, 2) & "00"
    GetRGBColors.G = "&H" & Mid$(HexColor, 3, 2) & "00"
    GetRGBColors.B = "&H" & Mid$(HexColor, 1, 2) & "00"

End Function

Public Property Let HoverSelection(ByVal New_HoverSelection As Boolean)

    m_HoverSelection = New_HoverSelection
    Call DrawItem(m_ListIndex)
    Call DrawFocus(m_ListIndex)

End Property

Public Property Get HoverSelection() As Boolean

    '-- HoverSelection

    HoverSelection = m_HoverSelection

End Property

Public Property Get hWnd() As Long

    '-- hWnd

    hWnd = UserControl.hWnd

End Property

Public Sub InsertItem(ByVal Index As Integer, _
                      ByVal Text As Variant, _
                      Optional ByVal Icon As Integer, _
                      Optional ByVal IconSelected As Integer)

    '-- InsertItem

  Dim i As Long

    If (m_nItems = 0 Or Index > m_nItems) Then Call Err.Raise(381)
    m_nItems = m_nItems + 1
    ReDim Preserve m_List(m_nItems)
    ReDim Preserve m_Selected(m_nItems)

    For i = m_nItems - 1 To Index Step -1
        m_List(i + 1) = m_List(i)
        m_Selected(i + 1) = m_Selected(i)
    Next

    m_List(Index).Text = CStr(Text)
    m_List(Index).Icon = Icon
    m_List(Index).IconSelected = IconSelected
    m_Selected(Index) = 0
    Call ReadjustBar
    m_EnsureVisible = 0
    If (m_ListIndex > -1) And (Index <= m_ListIndex) Then ListIndex = ListIndex + 1
    Call iScr_Paint

End Sub

Private Sub iScr_Click()

    '-------------------------------------------------------------------------------------------
    ' Scrolling / Events
    '-------------------------------------------------------------------------------------------
    '-- Click()

    If (m_ListIndex > -1) Then RaiseEvent Click

End Sub

Private Sub iScr_DblClick()

    '-- DblClick()

    If (m_ListIndex > -1) Then RaiseEvent DblClick

End Sub

Private Sub iScr_KeyDown(KeyCode As Integer, Shift As Integer)

    UserControl_KeyDown KeyCode, Shift

End Sub

Private Sub iScr_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    '-- MouseDown(Button, Shift, x, y)

  Dim SelectedListIndex As Integer

    If (Button = vbRightButton) Then
        RaiseEvent MouseDown(Button, Shift, X, Y)
        Exit Sub
    End If

    SelectedListIndex = Bar + Int(Y / m_tmpItemHeight)

    If (m_List(SelectedListIndex).Enabled = True) And (SelectedListIndex >= 0) And _
        (SelectedListIndex < m_nItems) Then

        Select Case m_SelectMode
        Case 0 ' [Single]
            m_Selected(SelectedListIndex) = -1

        Case 1 ' [Multiple]
            m_Selected(SelectedListIndex) = Not m_Selected(SelectedListIndex)
            m_AnchorItemState = m_Selected(SelectedListIndex)
        End Select

        m_LastY = Y
        ListIndex = SelectedListIndex
    End If

    m_Scrolling = -1
    RaiseEvent MouseDown(Button, Shift, X, Y)

End Sub

Private Sub iScr_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    '-- MouseMove(Button, Shift, x, y)

  Dim SelectedListIndex As Integer

    m_ScrollingY = Y

    If (Y < 0) Then
        Call ScrollUp
        RaiseEvent MouseMove(Button, Shift, X, Y)
        Exit Sub
    End If

    If (Y > ScaleHeight) Then
        Call ScrollDown
        RaiseEvent MouseMove(Button, Shift, X, Y)
        Exit Sub
    End If

    If (m_HoverSelection = True) Or (Button) And (Y \ m_tmpItemHeight <> m_LastY \ m_tmpItemHeight) _
        Then
        If (Bar.Visible = True) And (X < (ScaleWidth - Bar.Width)) Then
            SelectedListIndex = Bar + (Y \ m_tmpItemHeight)

            If (SelectedListIndex >= 0) And (SelectedListIndex < m_nItems) Then
                m_Selected(SelectedListIndex) = m_AnchorItemState
                ListIndex = SelectedListIndex
                m_LastY = Y
            End If

        ElseIf (Bar.Visible = False) Then
            SelectedListIndex = Bar + (Y \ m_tmpItemHeight)

            If (SelectedListIndex >= 0) And (SelectedListIndex < m_nItems) Then
                m_Selected(SelectedListIndex) = m_AnchorItemState
                ListIndex = SelectedListIndex
                m_LastY = Y
            End If

        End If
    End If
    RaiseEvent MouseMove(Button, Shift, X, Y)

End Sub

Private Sub iScr_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    '-- MouseUp(Button, Shift, x, y)

    m_Scrolling = 0
    m_AnchorItemState = -1
    RaiseEvent MouseUp(Button, Shift, X, Y)

End Sub

Private Sub iScr_Paint()

  Dim FocusRect As RECT2

    If Not (Ambient.UserMode = True) Then
        Call iScr.Cls

        Select Case m_Alignment
        Case 0: iScr.CurrentX = m_ItemTextLeft + m_ItemOffset
        Case 1: iScr.CurrentX = (ScaleWidth - iScr.TextWidth(Ambient.DisplayName)) - m_ItemOffset
        Case 2: iScr.CurrentX = (ScaleWidth - iScr.TextWidth(Ambient.DisplayName)) * 0.5
        End Select

        iScr.CurrentY = m_ItemOffset
        Call SetTextColor(iScr.hDC, m_ColorFont)
        iScr.Print (Ambient.DisplayName)
        Call SetRect(FocusRect, 0, 0, ScaleWidth, m_tmpItemHeight)
        Call DrawFocusRect(iScr.hDC, FocusRect)
    ElseIf Not (m_Resizing = True) Then
        Call DrawList
    End If

End Sub

Public Property Let ItemHeight(ByVal New_ItemHeight As Integer)

    m_ItemHeight = New_ItemHeight
    Call UserControl_Resize
    Call iScr_Paint

End Property

Public Property Get ItemHeight() As Integer

    '-- ItemHeight

    ItemHeight = m_ItemHeight

End Property

Public Property Let ItemHeightAuto(ByVal New_ItemHeightAuto As Boolean)

    m_ItemHeightAuto = New_ItemHeightAuto
    Call UserControl_Resize
    Call iScr_Paint

End Property

Public Property Get ItemHeightAuto() As Boolean

    '-- ItemHeightAuto

    ItemHeightAuto = m_ItemHeightAuto

End Property

Public Property Let ItemIcon(ByVal Index As Integer, ByVal Data As Integer)

    If (m_nItems = 0) Or (Index > m_nItems) Then Call Err.Raise(381)
    m_List(Index).Icon = Data
    Call DrawItem(Index)
    Call DrawFocus(m_ListIndex)

End Property

Public Property Get ItemIcon(ByVal Index As Integer) As Integer

    '-- ItemIcon

    If (m_nItems = 0) Or (Index > m_nItems) Then Call Err.Raise(381)
    ItemIcon = m_List(Index).Icon

End Property

Public Property Get ItemIconSelected(ByVal Index As Integer) As Integer

    '-- ItemIconSelected

    If (m_nItems = 0 Or Index > m_nItems) Then Call Err.Raise(381)
    ItemIconSelected = m_List(Index).IconSelected