clsodcontrol.cls

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

Public Property Get Enabled() As Boolean
    Enabled = m_bEnabled
End Property

Public Property Let Enabled(ByVal PropVal As Boolean)

    If Not (m_lCntlHwnd = 0) Then
        If PropVal Then
            EnableWindow m_lCntlHwnd, 1&
        Else
            EnableWindow m_lCntlHwnd, 0&
        End If
    End If
    m_bEnabled = PropVal

End Property

Public Property Get ForeColor() As Long
    ForeColor = m_lForeColor
End Property

Public Property Let ForeColor(ByVal PropVal As Long)
    m_lForeColor = PropVal
End Property

Public Property Get HiliteColor() As Long
    HiliteColor = m_lHiliteColor
End Property

Public Property Let HiliteColor(ByVal PropVal As Long)
    m_lHiliteColor = PropVal
End Property

Public Property Get HFont() As Long
    HFont = m_lHFont
End Property

Public Property Let HFont(ByVal PropVal As Long)

    If Not (m_lCntlHwnd = 0) Then
        If Not (PropVal = 0) Then
            m_lHFont = PropVal
            If Not (m_eControlStyle = ecsCommandButton) Then
                If m_bIsNt Then
                    SendMessageLongW m_lCntlHwnd, WM_SETFONT, m_lHFont, 1&
                Else
                    SendMessageLongA m_lCntlHwnd, WM_SETFONT, m_lHFont, 1&
                End If
            End If
        End If
    End If

End Property

Public Property Get hWnd() As Long
    hWnd = m_lCntlHwnd
End Property

Public Property Get LabelTransparent() As Boolean
    LabelTransparent = m_bLabelTransparent
End Property

Public Property Let LabelTransparent(ByVal PropVal As Boolean)
    m_bLabelTransparent = PropVal
End Property

Public Property Get Locked() As Boolean
    Locked = m_bLocked
End Property

Public Property Let Locked(ByVal PropVal As Boolean)

    If Not (m_lCntlHwnd = 0) Then
        SendMessageLongA m_lCntlHwnd, EM_SETREADONLY, Abs(PropVal), 0&
        m_bLocked = PropVal
    End If
    
End Property

Public Property Get Name() As String
    Name = m_sName
End Property

Public Property Let Name(ByVal PropVal As String)
    m_sName = PropVal
End Property

Public Property Get Text() As String

Dim lLen    As Long
Dim sText   As String

    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsCheckBox, ecsLabel, ecsOptionButton, ecsCommandButton, ecsPictureBox, ecsTextBox
            If m_bIsNt Then
                lLen = GetWindowTextLengthW(m_lCntlHwnd) + 1
                sText = String(lLen, Chr$(0))
                GetWindowTextW m_lCntlHwnd, StrPtr(sText), lLen
                Text = Left$(sText, (lLen - 1))
            Else
                lLen = GetWindowTextLengthA(m_lCntlHwnd) + 1
                sText = String(lLen, Chr$(0))
                GetWindowTextA m_lCntlHwnd, sText, lLen
                Text = sText
            End If
        End Select
    End If

End Property

Public Property Let Text(ByVal PropVal As String)

    If Not (m_lCntlHwnd = 0) Then
        Select Case m_eControlStyle
        Case ecsCheckBox, ecsLabel, ecsOptionButton, ecsCommandButton, ecsPictureBox, ecsTextBox
            If m_bIsNt Then
                SetWindowTextW m_lCntlHwnd, StrPtr(PropVal)
            Else
                SetWindowTextA m_lCntlHwnd, PropVal
            End If
        End Select
    End If

End Property

Public Property Get ThemeColor() As Long
    ThemeColor = m_lThemeColor
End Property

Public Property Let ThemeColor(ByVal PropVal As Long)
    m_lThemeColor = PropVal
End Property

Public Property Get ThemeStyle() As ECCThemeStyle
    ThemeStyle = m_eThemeStyle
End Property

Public Property Let ThemeStyle(ByVal PropVal As ECCThemeStyle)
    m_eThemeStyle = PropVal
End Property


'> Constructors
'>>>>>>>>>>>>>>>>>>>>>>
Public Sub Create(ByVal lParentHwnd As Long, _
                  ByVal lX As Long, _
                  ByVal lY As Long, _
                  ByVal lWidth As Long, _
                  ByVal lHeight As Long, _
                  ByVal eCtrlStyle As ECSControlStyle, _
                  Optional ByVal lForeColor As Long = -1, _
                  Optional ByVal lBackColor As Long = -1, _
                  Optional ByVal sCaption As String, _
                  Optional ByVal oFont As StdFont)

'/* create control window

    If Not (lParentHwnd = 0) Then
        m_lParentHwnd = lParentHwnd
        m_eControlStyle = eCtrlStyle
        If Not (lForeColor = -1) Then
            m_lForeColor = lForeColor
        End If
        If Not (lBackColor = -1) Then
            m_lBackColor = lBackColor
        End If
        
        If Not (oFont Is Nothing) Then
            Set m_oFont = oFont
        End If
        With m_tRect
            .Left = lX
            .Right = lX + lWidth
            .Top = lY
            .bottom = lY + lHeight
        End With
        Initialize
        If (LenB(Text) = 0) Then
            If (LenB(sCaption) > 0) Then
                Text = sCaption
            End If
        End If
    End If

End Sub

Private Sub Initialize()
'/* initialize api window control

Dim lWStyle As Long
Dim sStyle  As String

    '/* window styles
    Select Case m_eControlStyle
    Case ecsCheckBox
        lWStyle = WS_CHILD Or BS_OWNERDRAW
        sStyle = "BUTTON"
    Case ecsComboDropDown
        sStyle = "COMBOBOX"
        lWStyle = WS_CHILD Or WS_VSCROLL Or CBS_HASSTRINGS Or CBS_DROPDOWN
    Case ecsComboDropList
        sStyle = "COMBOBOX"
        lWStyle = WS_CHILD Or WS_VSCROLL Or CBS_HASSTRINGS Or CBS_DROPDOWNLIST
    Case ecsComboSimple
        sStyle = "COMBOBOX"
        lWStyle = WS_CHILD Or WS_VSCROLL Or CBS_HASSTRINGS Or CBS_SIMPLE
    Case ecsCommandButton
        lWStyle = WS_CHILD Or BS_PUSHBUTTON Or BS_OWNERDRAW
        sStyle = "BUTTON"
    Case ecsImageCombo
        sStyle = "COMBOBOX"
        lWStyle = WS_CHILD Or WS_VSCROLL Or CBS_HASSTRINGS Or CBS_DROPDOWN Or CBS_OWNERDRAWVARIABLE
    Case ecsImageListBox
        lWStyle = WS_CHILD Or WS_VSCROLL Or LBS_NOINTEGRALHEIGHT Or LBS_HASSTRINGS Or LBS_USETABSTOPS Or LBS_OWNERDRAWFIXED
        sStyle = "LISTBOX"
    Case ecsLabel
        sStyle = "STATIC"
        lWStyle = WS_CHILD Or SS_LEFTNOWORDWRAP Or SS_NOTIFY Or SS_OWNERDRAW
    Case ecsListBox
        lWStyle = WS_CHILD Or WS_VSCROLL Or LBS_HASSTRINGS Or LBS_NOINTEGRALHEIGHT
        sStyle = "LISTBOX"
    Case ecsListBoxExtended
        lWStyle = WS_CHILD Or WS_VSCROLL Or LBS_HASSTRINGS Or LBS_NOINTEGRALHEIGHT Or LBS_EXTENDEDSEL
        sStyle = "LISTBOX"
    Case ecsListBoxMultiSelect
        lWStyle = WS_CHILD Or WS_VSCROLL Or LBS_HASSTRINGS Or LBS_NOINTEGRALHEIGHT Or LBS_MULTIPLESEL
        sStyle = "LISTBOX"
    Case ecsOptionButton
        lWStyle = WS_CHILD Or BS_OWNERDRAW
        sStyle = "BUTTON"
    Case ecsPictureBox
        sStyle = "STATIC"
        lWStyle = WS_CHILD Or SS_NOTIFY Or SS_CENTERIMAGE Or SS_WHITEFRAME
    Case ecsTextBox
        sStyle = "EDIT"
        lWStyle = WS_CHILD Or WS_VSCROLL Or ES_MULTILINE Or ES_AUTOVSCROLL Or ES_LEFT
    End Select
    
    Select Case m_eBorderStyle
    Case ecbs3D, ecbsLine
        lWStyle = lWStyle Or WS_BORDER
    Case Else
        lWStyle = lWStyle And Not WS_BORDER
    End Select
    
    '/* create the window
    With m_tRect
        If m_bIsNt Then
            m_lCntlHwnd = CreateWindowExW(m_lBorderStyle, StrPtr(sStyle), StrPtr(m_sName), lWStyle, .Left, .Top, (.Right - .Left), (.bottom - .Top), m_lParentHwnd, 0&, App.hInstance, ByVal 0&)
        Else
            m_lCntlHwnd = CreateWindowExA(m_lBorderStyle, sStyle, m_sName, lWStyle, .Left, .Top, (.Right - .Left), (.bottom - .Top), m_lParentHwnd, 0&, App.hInstance, ByVal 0&)
        End If
    End With
    
    Select Case m_eControlStyle
        Case ecsComboDropDown, ecsImageCombo
        m_lEditHwnd = GetWindow(m_lCntlHwnd, GW_CHILD)
    End Select

    Select Case m_eControlStyle
    Case ecsImageListBox
        InitListBoxIml
        DefineTabStop
    Case ecsImageCombo
        InitListBoxIml
    Case ecsLabel
        If m_bAutoSize Then
            LabelSize Text
        End If
    End Select

    InitSkin
    AttachMessages
    Show
    
    Select Case m_eControlStyle
    Case ecsComboDropDown, ecsImageCombo
        MoveEditBox
        Dim tCBInfo As COMBOBOXINFO
        ComboInfo m_lCntlHwnd, tCBInfo
        m_lListHwnd = tCBInfo.hwndList
        AttachList
    End Select
    
End Sub

Private Sub AttachList()

    With m_cCntlSubclass
        If Not (m_lListHwnd = 0) Then
            .Subclass m_lListHwnd, Me
            .AddMessage m_lListHwnd, WM_LBUTTONUP, MSG_BEFORE
        End If
    End With
                
End Sub

Private Sub InitSkin()

On Error GoTo Handler