clsodcontrol.cls

一款Grid表格控件源代码,非常棒.不下你一定会后悔

    DefaultFont
    Select Case m_eControlStyle
    Case ecsCheckBox, ecsOptionButton
        CheckBoxLoadImages m_eThemeStyle

    Case ecsComboDropDown, ecsImageCombo, ecsComboDropList
        ComboLoadImage m_eThemeStyle
        
    Case ecsCommandButton
        ButtonLoadImage m_eThemeStyle
        CreateBackbuffer
    End Select
    
Handler:

End Sub

'> Global
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Sub DefineTabStop()

Dim lTab() As Long

    ReDim lTab(0)
    lTab(0) = 10
    If Not (m_lCntlHwnd = 0) Then
        SendMessageA m_lCntlHwnd, LB_SETTABSTOPS, 1&, lTab(0)
    End If

End Sub

Public Sub AddItem(ByVal sItem As String, _
                   Optional ByVal lImageIdx As Long = -1, _
                   Optional ByVal lBoxColor As Long = -1)

    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsComboDropDown, ecsComboDropList, ecsComboSimple
            If m_bIsNt Then
                SendMessageLongW m_lCntlHwnd, CB_ADDSTRING, 0&, StrPtr(sItem)
            Else
                SendMessageA m_lCntlHwnd, CB_ADDSTRING, 0&, sItem
            End If
        Case ecsImageCombo
            ReDim Preserve m_lBoxColor(0 To m_lItemIndex)
            m_lBoxColor(m_lItemIndex) = lBoxColor
            ReDim Preserve m_lItemImage(0 To m_lItemIndex)
            m_lItemImage(m_lItemIndex) = lImageIdx
            m_lItemIndex = m_lItemIndex + 1
            If m_bIsNt Then
                SendMessageLongW m_lCntlHwnd, CB_ADDSTRING, 0&, StrPtr(sItem)
            Else
                SendMessageA m_lCntlHwnd, CB_ADDSTRING, 0&, sItem
            End If
        Case ecsListBox, ecsListBoxExtended, ecsListBoxMultiSelect
            If m_bIsNt Then
                SendMessageLongW m_lCntlHwnd, LB_ADDSTRING, 0&, StrPtr(sItem)
            Else
                SendMessageA m_lCntlHwnd, LB_ADDSTRING, 0&, sItem
            End If
        Case ecsImageListBox
            ReDim Preserve m_lItemImage(0 To m_lItemIndex)
            m_lItemImage(m_lItemIndex) = lImageIdx
            m_lItemIndex = m_lItemIndex + 1
            If m_bIsNt Then
                SendMessageLongW m_lCntlHwnd, LB_ADDSTRING, 0&, StrPtr(sItem)
            Else
                SendMessageA m_lCntlHwnd, LB_ADDSTRING, 0&, sItem
            End If
        End Select
    End If

End Sub

Public Sub Clear()

    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsListBox, ecsListBoxExtended, ecsListBoxMultiSelect, ecsImageListBox
            SendMessageLongA m_lCntlHwnd, LB_RESETCONTENT, 0&, 0&
        Case ecsComboDropDown, ecsComboSimple, ecsImageCombo, ecsComboDropList
            SendMessageLongA m_lCntlHwnd, CB_RESETCONTENT, 0&, 0&
        End Select
    End If

End Sub

Public Sub AddToGroup(ByVal bAddItem As Boolean)

    If Not (m_lCntlHwnd = 0) Then
        If bAddItem Then
            SetStyle WS_GROUP Or WS_TABSTOP, 0
        Else
            SetStyle 0, WS_GROUP Or WS_TABSTOP
        End If
    End If

End Sub

Public Sub InsertItem(ByVal sItem As String, _
                      ByVal lIndex As Long)

    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsListBox, ecsListBoxExtended, ecsListBoxMultiSelect, ecsImageListBox
            If m_bIsNt Then
                SendMessageLongW m_lCntlHwnd, LB_INSERTSTRING, lIndex, StrPtr(sItem)
            Else
                SendMessageA m_lCntlHwnd, LB_INSERTSTRING, lIndex, sItem
            End If
        Case ecsComboDropDown, ecsComboSimple, ecsImageCombo, ecsComboDropList
            If m_bIsNt Then
                SendMessageLongW m_lCntlHwnd, CB_INSERTSTRING, lIndex, StrPtr(sItem)
            Else
                SendMessageA m_lCntlHwnd, CB_INSERTSTRING, lIndex, sItem
            End If
        End Select
    End If

End Sub

Public Sub ItemHeight(ByVal lIndex As Long, _
                      ByVal lHeight As Long)

    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsListBox, ecsListBoxExtended, ecsListBoxMultiSelect, ecsImageListBox
            SendMessageLongA m_lCntlHwnd, LB_SETITEMHEIGHT, lIndex, lHeight
        Case ecsComboDropDown, ecsComboSimple, ecsImageCombo, ecsComboDropList
            SendMessageLongA m_lCntlHwnd, CB_SETITEMHEIGHT, lIndex, lHeight
        End Select
    End If

End Sub

Public Property Get ListCount() As Long

    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsListBox, ecsListBoxExtended, ecsListBoxMultiSelect, ecsImageListBox
            ListCount = SendMessageLongA(m_lCntlHwnd, LB_GETCOUNT, 0&, 0&)
        Case ecsComboDropDown, ecsComboSimple, ecsImageCombo, ecsComboDropList
            ListCount = SendMessageLongA(m_lCntlHwnd, CB_GETCOUNT, 0&, 0&)
        End Select
    End If

End Property

Public Property Get ListIndex() As Long

    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsListBox, ecsListBoxExtended, ecsListBoxMultiSelect, ecsImageListBox
            ListIndex = SendMessageLongA(m_lCntlHwnd, LB_GETCURSEL, 0&, 0&)
        Case ecsComboDropDown, ecsComboSimple, ecsImageCombo, ecsComboDropList
            ListIndex = SendMessageLongA(m_lCntlHwnd, CB_GETCURSEL, 0&, 0&)
        End Select
    End If

End Property

Public Property Let ListIndex(ByVal lIndex As Long)

    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsListBox, ecsListBoxExtended, ecsListBoxMultiSelect, ecsImageListBox
            ListIndex = SendMessageLongA(m_lCntlHwnd, LB_SETCURSEL, lIndex, 0&)
        Case ecsComboDropDown, ecsComboSimple, ecsImageCombo, ecsComboDropList
            ListIndex = SendMessageLongA(m_lCntlHwnd, CB_SETCURSEL, lIndex, 0&)
        End Select
    End If

End Property

Public Function ListItem(ByVal lItem As Long) As Long

Dim lPtr As Long

    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsListBox, ecsListBoxExtended, ecsListBoxMultiSelect, ecsImageListBox
            lPtr = SendMessageLongA(m_lCntlHwnd, LB_GETITEMDATA, lItem, 0&)
        Case ecsComboDropDown, ecsComboSimple, ecsImageCombo, ecsComboDropList
            lPtr = SendMessageLongA(m_lCntlHwnd, CB_GETITEMDATA, lItem, 0&)
        End Select
    End If
    
    ListItem = lPtr
    
End Function

Public Sub RemoveItem(ByVal lIndex As Long)

    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsListBox, ecsListBoxExtended, ecsListBoxMultiSelect, ecsImageListBox
            SendMessageLongA m_lCntlHwnd, LB_DELETESTRING, lIndex, 0&
        Case ecsComboDropDown, ecsComboSimple, ecsImageCombo, ecsComboDropList
            SendMessageLongA m_lCntlHwnd, CB_DELETESTRING, lIndex, 0&
        End Select
    End If

End Sub

Public Sub Sorted(ByVal bSorted As Boolean)

    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsListBox, ecsListBoxExtended, ecsListBoxMultiSelect, ecsImageListBox
            If bSorted Then
                SetStyle LBS_SORT, 0
            Else
                SetStyle 0, LBS_SORT
            End If
        Case ecsComboDropDown, ecsComboSimple, ecsImageCombo, ecsComboDropList
            If bSorted Then
                SetStyle CBS_SORT, 0
            Else
                SetStyle 0, CBS_SORT
            End If
        End Select
    End If

End Sub

Public Property Get SelectedItem(ByVal lIndex As Long) As Boolean
    
    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsListBox, ecsListBoxExtended, ecsListBoxMultiSelect, ecsImageListBox
            SelectedItem = SendMessageLongA(m_lCntlHwnd, LB_GETSEL, lIndex, 0&)
        Case ecsComboDropList
            Dim tCBInfo     As COMBOBOXINFO
            ComboInfo m_lCntlHwnd, tCBInfo
            If tCBInfo.hwndList > 0 Then
                SelectedItem = SendMessageLongA(tCBInfo.hwndList, LB_GETSEL, lIndex, 0&)
            End If
        Case ecsComboDropDown, ecsComboSimple, ecsImageCombo
            SelectedItem = SendMessageLongA(m_lCntlHwnd, CB_GETCURSEL, 0&, 0&)
        End Select
    End If

End Property

Public Property Let SelectedItem(ByVal lIndex As Long, _
                                 ByVal bSelected As Boolean)

Dim lSelect As Long

    If Not (m_lCntlHwnd = 0) Then
        lSelect = (bSelected * -1)
        Select Case m_eControlStyle
        Case ecsListBox, ecsListBoxExtended, ecsListBoxMultiSelect, ecsImageListBox
            SendMessageLongA m_lCntlHwnd, LB_SETSEL, lSelect, lIndex
        Case ecsComboDropList
            Dim tCBInfo     As COMBOBOXINFO
            ComboInfo m_lCntlHwnd, tCBInfo
            If (tCBInfo.hwndList > 0) Then
                SendMessageLongA tCBInfo.hwndList, LB_SETSEL, lSelect, lIndex
            End If
        Case ecsComboDropDown, ecsComboSimple, ecsImageCombo
            SendMessageLongA m_lCntlHwnd, CB_SETCURSEL, lSelect, 0&
        End Select
    End If

End Property


'> Command Button
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Private Sub ButtonLoadImage(ByVal lIndex As Long)

Dim tBmp As BITMAP

    Select Case lIndex
    Case 0
        Set m_pControlImg = LoadResPicture("AZURE-COMMAND", vbResBitmap)
    Case 1
        Set m_pControlImg = LoadResPicture("CLASSIC-COMMAND", vbResBitmap)
    Case 2
        Set m_pControlImg = LoadResPicture("GLOSS-COMMAND", vbResBitmap)
    Case 3
        Set m_pControlImg = LoadResPicture("METAL-COMMAND", vbResBitmap)
    Case 4
        Set m_pControlImg = LoadResPicture("XP-COMMAND", vbResBitmap)
    End Select

    GetObjectA m_pControlImg.Handle, Len(tBmp), tBmp
    With tBmp
        m_lCmdWidth = (.bmWidth / 5)
        m_lCmdHeight = .bmHeight
    End With
    
    Set m_cRender = New clsRender
    Set m_cCntrlDc = New clsStoreDc
    m_cCntrlDc.CreateFromPicture m_pControlImg
    If (m_lThemeColor > -1