coollist.ctl

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

        If (GetTickCount - t > d) Then
            t = GetTickCount

            If (m_ListIndex > 0) Then
                If (m_SelectMode = [Multiple]) Then
                    m_Selected(m_ListIndex - 1) = m_AnchorItemState
                End If

                ListIndex = ListIndex - 1
            End If

        End If
        DoEvents
    Loop

End Sub

Public Property Let SelectBorderColor(ByVal New_Color As OLE_COLOR)

    m_SelectBorderColor = GetLngColor(New_Color)
    Call PropertyChanged("SelectBorderColor")

End Property

Public Property Get SelectBorderColor() As OLE_COLOR

    SelectBorderColor = m_SelectBorderColor

End Property

Public Property Get SelectedCount() As Integer

    '-- <SelectedCount>

  Dim i As Long

    SelectedCount = 0

    For i = 0 To m_nItems
        If (m_Selected(i)) Then SelectedCount = SelectedCount + 1
    Next

End Property

Public Property Get SelectionPicture() As Picture

    '-- SelectionPicture

    Set SelectionPicture = m_SelectionPicture

End Property

Public Property Set SelectionPicture(ByVal New_SelectionPicture As Picture)

    Set m_SelectionPicture = New_SelectionPicture
    Call iScr_Paint

End Property

Public Property Let SelectListBorderColor(ByVal New_Color As OLE_COLOR)

    m_SelectListBorderColor = GetLngColor(New_Color)
    Call PropertyChanged("SelectListBorderColor")

End Property

Public Property Get SelectListBorderColor() As OLE_COLOR

    SelectListBorderColor = m_SelectListBorderColor

End Property

Public Property Get SelectMode() As SelectModeCts

    '-- SelectMode

    SelectMode = m_SelectMode

End Property

Public Property Let SelectMode(ByVal New_SelectMode As SelectModeCts)

  Dim i As Long

    m_SelectMode = New_SelectMode

    If (Ambient.UserMode = True) Then
        If (New_SelectMode = [Single]) Then
            '-- Unselect all and select actual

            If (m_ListIndex > -1) Then

                For i = LBound(m_List) To m_nItems
                    If (i <> m_ListIndex) Then m_Selected(i) = 0
                Next

                m_Selected(m_ListIndex) = -1
                Call DrawItem(m_ListIndex)
                Call DrawFocus(m_ListIndex)
            End If

        End If
    End If
    Call ReadjustBar
    Call iScr_Paint

End Property

Public Property Get SelectModeStyle() As SelectModeStyleCts

    '-- SelectModeStyle

    SelectModeStyle = m_SelectModeStyle

End Property

Public Property Let SelectModeStyle(ByVal New_SelectModeStyle As SelectModeStyleCts)

    m_SelectModeStyle = New_SelectModeStyle
    Call iScr_Paint

End Property

Private Sub SetColors()

    '-------------------------------------------------------------------------------------------
    ' Colors
    '-------------------------------------------------------------------------------------------
    '-- SetColors

    m_ColorBack = GetLngColor(m_BackNormal)
    m_ColorBackSel = GetLngColor(m_BackSelected)
    m_ColorGradient1 = GetRGBColors(GetLngColor(m_BackSelectedG1))
    m_ColorGradient2 = GetRGBColors(GetLngColor(m_BackSelectedG2))
    m_ColorBox = GetLngColor(m_BoxBorder)
    m_ColorFont = GetLngColor(m_FontNormal)
    m_ColorFontSel = GetLngColor(m_FontSelected)

End Sub

Public Sub SetImageList(ImageListControl)

    '-------------------------------------------------------------------------------------------
    ' Methods
    '-------------------------------------------------------------------------------------------
    '-- SetImageList

    Set m_pImgList = ImageListControl
    On Error Resume Next
    m_ILScale = m_pImgList.Parent.ScaleMode
    On Error GoTo 0
    Call iScr_Paint

End Sub

Public Property Get ShadowColorText() As OLE_COLOR

    ShadowColorText = m_ShadowColorText

End Property

Public Property Let ShadowColorText(ByVal New_Color As OLE_COLOR)

    m_ShadowColorText = GetLngColor(New_Color)
    Call PropertyChanged("ShadowColorText")

End Property

Public Sub StartEdit()

    '-- Item is selected...

    If (m_ListIndex > -1) Then
        '-- Let TextBox keyboard control
        KeyPreview = 0

        With txtEdit
            '-- Get TextBox item font properties
            Set .Font = m_Font

            If (m_Selected(m_ListIndex)) And (m_SelectModeStyle <> [Underline]) Then
                .BackColor = m_ColorBackSel
                .ForeColor = m_ColorFontSel
            Else
                .BackColor = m_ColorBack
                .ForeColor = m_ColorFont
            End If

            '-- Set alignment. Locate and resize TextBox

            If (m_WordWrap = True) Then
                .Alignment = Choose(m_Alignment + 1, 0, 2, 1)
                Call .Move(m_ItemTextLeft + m_ItemOffset, (m_ListIndex - Bar) * m_tmpItemHeight + _
                    m_ItemOffset, m_ItemRct(m_ListIndex - Bar).x2 - m_ItemTextLeft - 2 * _
                    m_ItemOffset, m_tmpItemHeight - 2 * m_ItemOffset)
            Else
                .Alignment = 0
                Call .Move(m_ItemTextLeft + m_ItemOffset, (m_ListIndex - Bar) * m_tmpItemHeight + _
                    0.5 * (m_tmpItemHeight - iScr.TextHeight("")), m_ItemRct(m_ListIndex - Bar).x2 _
                    - m_ItemTextLeft - 2 * m_ItemOffset, 1)
            End If

            '-- Get item text and turn TextBox to visible
            .Text = m_List(m_ListIndex).Text
            .SelStart = 0
            .SelLength = Len(txtEdit)
            .Visible = -1
            .SetFocus
        End With

    End If

End Sub

Public Property Let TopIndex(ByVal New_TopIndex As Integer)

    If (New_TopIndex < 0) Or (New_TopIndex > m_nItems - m_VisibleRows) Then
        Exit Property
        'Call Err.Raise(380)
    End If

    m_TopIndex = New_TopIndex
    Bar = New_TopIndex
    RaiseEvent TopIndexChange

End Property

Public Property Get TopIndex() As Integer

    '-- TopIndex

    TopIndex = Bar

End Property

Private Sub txtEdit_KeyPress(KeyAscii As Integer)

    'Editing item...
    '-------------------------------------------------------------------------------------------

    ' WordWrap mode enabled:
    ' [Control]+[Return] = new line
    ' [Return]           = update text
    ' WordWrap mode disabled:
    ' [Return]           = update text

    '-- Enabled new line in WordWrap mode

    If (m_WordWrap = True) Then
        If (KeyAscii = 13) Then
            m_List(m_ListIndex).Text = txtEdit
            Call txtEdit_LostFocus
        End If

        '-- Don't allow new line in disabled WordWrap mode
    Else

        If (KeyAscii = 13) Or (KeyAscii = 10) Then
            m_List(m_ListIndex).Text = txtEdit
            Call txtEdit_LostFocus
        End If

    End If
    '-- Cancel edition
    If (KeyAscii = 27) Then Call txtEdit_LostFocus

End Sub

Private Sub txtEdit_LostFocus()

    '-- Hide edit TextBox and let ListBox keyboard control
    txtEdit.Visible = 0
    KeyPreview = -1

End Sub

Private Sub UserControl_EnterFocus()

    m_HasFocus = -1
    Call DrawFocus(m_ListIndex)

End Sub

Private Sub UserControl_ExitFocus()

    m_HasFocus = 0
    Call DrawItem(m_ListIndex)

End Sub

Private Sub UserControl_Initialize()

    '-------------------------------------------------------------------------------------------
    '-- UserControl initialitation, focus, size, refresh, termination
    '-------------------------------------------------------------------------------------------

  Dim OS As OSVERSIONINFO

    '-- Initialize arrays
    ReDim m_List(0)
    ReDim m_Selected(0)
    '-- Initialize position flags
    m_EnsureVisible = -1 ' Ensure visible last selected
    m_LastItem = -1      ' Last selected
    m_LastY = -1         ' Last Y coordinate
    '-- Initialize font object
    Set m_Font = New StdFont
    '* Get the operating system version for text drawing purposes.
    OS.dwOSVersionInfoSize = Len(OS)
    Call GetVersionEx(OS)
    mWindowsNT = ((OS.dwPlatformId And VER_PLATFORM_WIN32_NT) = VER_PLATFORM_WIN32_NT)
    ' Hack for XP Crash under VB6
    m_hMod = LoadLibraryA("shell32.dll")
    InitCommonControls

End Sub

Private Sub UserControl_InitProperties()

    m_Appearance = m_def_Appearance
    UserControl.BorderStyle = m_def_BorderStyle
    m_ScrollBarWidth = m_def_ScrollBarWidth
    Set iScr.Font = Ambient.Font
    Set m_Font = Ambient.Font
    m_FontNormal = m_def_FontNormal
    m_FontSelected = m_def_FontSelected
    m_BackNormal = m_def_BackNormal
    m_BackSelected = m_def_BackSelected
    m_BackSelectedG1 = m_def_BackSelectedG1
    m_BackSelectedG2 = m_def_BackSelectedG2
    m_BoxBorder = m_def_BoxBorder
    m_BoxOffset = m_def_BoxOffset
    m_BoxRadius = m_def_BoxRadius
    m_Alignment = m_def_Alignment
    m_Focus = m_def_Focus
    m_HoverSelection = m_def_HoverSelection
    m_WordWrap = m_def_WordWrap
    m_ItemHeight = iScr.TextHeight("TextHeight")
    m_ItemHeightAuto = m_def_ItemHeightAuto
    m_ItemOffset = m_def_ItemOffset
    m_ItemTextLeft = m_def_ItemTextLeft
    m_OrderType = m_def_OrderType
    Set m_SelectionPicture = Nothing
    m_SelectMode = m_def_SelectMode
    m_SelectModeStyle = m_def_SelectModeStyle
    m_ListIndex = -1
    m_TopIndex = -1
    m_SelectBorderColor = defSelectBorderColor
    m_SelectListBorderColor = defSelectListBorderColor
    m_ShadowColorText = defShadowColorText
    m_ListGradient = False
    m_VisibleRows = 3
    Call SetColors

End Sub

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

    '-- KeyDown(KeyCode, Shift)

    If (m_nItems = 0) Or (m_ListIndex = -1) Then
        RaiseEvent KeyDown(KeyCode, Shift)
        Exit Sub
    End If

    Select Case KeyCode
    Case 38 '{Up arrow}
        If (m_ListIndex > 0) Then ListIndex = ListIndex - 1

    Case 40 '{Down arrow}
        If (m_ListIndex < m_nItems - 1) Then ListIndex = ListIndex + 1

    Case 33 '{PageDown}

        If (m_ListIndex > m_VisibleRows) Then
            ListIndex = ListIndex - m_VisibleRows
        Else
            ListIndex = 0
        End If

    Case 34 '{PageUp}

        If (m_ListIndex < m_nItems - m_VisibleRows - 1) Then
            ListIndex = ListIndex + m_VisibleRows
        Else
            ListIndex = m_nItems - 1
        End If

    Case 36 '{Start}
        ListIndex = 0

    Case 35 '{End}
        ListIndex = m_nItems - 1

    Case 32 '{Space} Select/Unselect

        If (m_SelectMode <> 0) And (m_ListIndex > -1) Then
            m_Selected(m_ListIndex) = Not m_Selected(m_ListIndex)
            Call DrawItem(m_ListIndex)
            Call DrawFocus(m_ListIndex)
        End If

        RaiseEvent Click
    End Select

    RaiseEvent KeyDown(KeyCode, Shift)

End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)

    '-- KeyPress(KeyAscii)

    RaiseEvent KeyPress(KeyAscii)

End Sub

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

    '-- KeyPress(KeyCode, Shift)

    RaiseEvent KeyUp(KeyCode, Shift)

End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

  Dim sTmp As String

    m_Appearance = PropBag.ReadProperty("Appearance", m_def_Appearance)
    UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", -1)
    m_ScrollBarWidth = PropBag.ReadProperty("ScrollBarWidth", m_def_ScrollBarWidth)
    Bar.Width = PropBag.ReadProperty("ScrollBarWidth", m_def_ScrollBarWidth)
    Set iScr.Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set m_Font = PropBag.ReadProperty("Font", Ambient.Font)
    m_FontNormal = PropBag.ReadProperty("FontNormal", m_def_FontNormal)
    m_FontSelected = PropBag.ReadProperty("FontSelected", m_def_FontSelected)
    m_BackNormal = PropBag.ReadProperty("BackNormal", m_def_BackNormal)
    iScr.BackColor = PropBag.ReadProperty("BackNormal", m_def_BackNormal)
    m_BackSelected = PropBag.ReadProperty("BackSelected", m_def_BackSelected)
    m_BackSelectedG1 = PropBag.ReadProperty("BackSelectedG1", m_def_BackSelectedG1)
    m_BackSelectedG2 = PropBag.ReadProperty("BackSelectedG2", m_def_BackSelectedG2)
    m_BoxBorder = PropBag.ReadProperty("BoxBorder", m_def_BoxBorder)
    m_BoxOffset = PropBag.ReadProperty("BoxOffset", m_def_BoxOffset)
    m_BoxRadius = PropBag.ReadProperty("BoxRadius", m_def_BoxRadius)
    m_Alignment = PropBag.ReadProperty("Alignment", m_def_Alignment)
    m_Focus = PropBag.ReadProperty("Focus", m_def_Focus)
    m_HoverSelection = PropBag.ReadProperty("HoverSelection", m_def_HoverSelection)
    m_WordWrap = PropBag.ReadProperty("WordWrap", m_def_WordWrap)
    m_ItemOffset = PropBag.ReadProperty("ItemOffset", m_def_ItemOffset)
    m_ItemHeightAuto = PropBag.ReadProperty("ItemHeightAuto", m_def_ItemHeightAuto)
    m_ItemTextLeft = PropBag.ReadProperty("ItemTextLeft", m_def_ItemTextLeft)
    m_OrderType = PropBag.ReadProperty("OrderType", m_def_OrderType)
    Set m_SelectionPicture = PropBag.ReadProperty("SelectionPicture", Nothing)
    m_SelectMode = PropBag.ReadProperty("SelectMode", m_def_SelectMode)
    m_SelectModeStyle = PropBag.ReadProperty("SelectModeStyle", m_def_SelectModeSty