clsskinheader.cls

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

                                               lpPoint As POINTAPI) As Long

Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, _
                                             ByVal x As Long, _
                                             ByVal y As Long) As Long

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, _
                                               ByVal x As Long, _
                                               ByVal y As Long) As Long

Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Declare Function StrokeAndFillPath Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function GetSysColor Lib "USER32" (ByVal nIndex As Long) As Long

Private Declare Function InflateRect Lib "USER32" (lpRect As RECT, _
                                                   ByVal x As Long, _
                                                   ByVal y As Long) As Long

Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, _
                                                     lpRect As RECT) As Long

Private Declare Function LoadCursor Lib "USER32" Alias "LoadCursorA" (ByVal hInstance As Long, _
                                                                      ByVal lpCursorId As CURSOR_RESOURCE) As Long

Private Declare Function DestroyCursor Lib "USER32" (ByVal hCursor As Long) As Long

Private Declare Function SetCursor Lib "USER32" (ByVal hCursor As Long) As Long

Private Declare Function GetKeyState Lib "USER32" (ByVal nVirtKey As Long) As Long

Private Declare Function FrameRect Lib "USER32" (ByVal hdc As Long, _
                                                 lpRect As RECT, _
                                                 ByVal hBrush As Long) As Long

Private Declare Function GetClientRect Lib "USER32" (ByVal hWnd As Long, _
                                                     lpRect As RECT) As Long
                                                     

Private m_bPainting                             As Boolean
Private m_bTrackUser32                          As Boolean
Private m_bSkinLoaded                           As Boolean
Private m_bUseHeaderTheme                       As Boolean
Private m_bHeaderActive                         As Boolean
Private m_bUseUnicode                           As Boolean
Private m_bDragState                            As Boolean
Private m_bIsNt                                 As Boolean
Private m_bIsXp                                 As Boolean
Private m_bColumnVerticalText                   As Boolean
Private m_bSortDescending                       As Boolean
Private m_bToolTips                             As Boolean
Private m_bTipGradient                          As Boolean
Private m_bTipXPColors                          As Boolean
Private m_bTipMultiline                         As Boolean
Private m_bHeaderSizeable                       As Boolean
Private m_bFilterLoaded                         As Boolean
Private m_bCustomCursors                        As Boolean
Private m_bHeaderFlat                           As Boolean
Private m_bHeaderFixedWidth                     As Boolean
Private m_bColumnFilters                        As Boolean
Private m_lhDragCursor                          As Long
Private m_lhNSSizeCursor                        As Long
Private m_lhNormalCursor                        As Long
Private m_lhWESizeCursor                        As Long
Private m_lhLockedCursor                        As Long
Private m_lColumnCountChange                    As Long
Private m_lTipVisibleTime                       As Long
Private m_lTipDelayTime                         As Long
Private m_lTipPosition                          As Long
Private m_lTipColor                             As Long
Private m_lTipOffsetColor                       As Long
Private m_lTipTransparency                      As Long
Private m_lSelectedColumn                       As Long
Private m_lHeaderTextEffect                     As Long
Private m_lColumnSpace                          As Long
Private m_lColumnSorted                         As Long
Private m_lvFntDc                               As Long
Private m_lHeaderDc                             As Long
Private m_lHeaderLuminence                      As Long
Private m_lThemeColor                           As Long
Private m_lHeaderSkinStyle                      As Long
Private m_lTextForeColor                        As Long
Private m_lTextHighLite                         As Long
Private m_lTextPressed                          As Long
Private m_lHGHwnd                               As Long
Private m_lHdrHwnd                              As Long
Private m_lHeaderBmpWidth                       As Long
Private m_lHeaderBmpHeight                      As Long
Private m_lHeaderHeight                         As Long
Private m_lImageWidth                           As Long
Private m_lHdc()                                As Long
Private m_lBmp()                                As Long
Private m_lBmpOld()                             As Long
Private m_lCurrState                            As Long
Private m_lhFnt                                 As Long
Private m_lImlHdHndl                            As Long
Private m_sngLuminence                          As Single
Private m_bColumnFiltered()                     As Boolean
Private m_bColumnLocked()                       As Boolean
Private m_sToolTipHint()                        As String
Private m_tR                                    As RECT
Private m_oFont                                 As StdFont
Private m_oVtFont                               As StdFont
Private m_oTipFont                              As StdFont
Private m_pHeader                               As StdPicture
Private m_pArrowCursor                          As StdPicture
Private m_pLockedCursor                         As StdPicture
Private m_pNSSizeCursor                         As StdPicture
Private m_pWESizeCursor                         As StdPicture
Private m_pDragCursor                           As StdPicture
Private m_cRender                               As clsRender
Private m_cHeaderDc                             As clsStoreDc
Private m_cColumnToolTip                        As clsToolTip
Private m_GXHeader                              As GXMSubclass


Private Sub Class_Initialize()
    
    InitCommonControls
    VersionCheck
    m_bTrackUser32 = FunctionExported("TrackMouseEvent", "User32")
    '/* default font colors
    m_lTextForeColor = &H111111
    m_lTextHighLite = &H676767
    m_lTextPressed = &HDEDEDE
    '/* tool tip defaults
    m_lTipColor = GetSysColor(&H80000018 And &H1F)
    m_lTipDelayTime = 2
    m_bTipMultiline = True
    m_lTipTransparency = 180
    m_lTipVisibleTime = 3
    m_lColumnSorted = -1
    Set m_cRender = New clsRender
    CreateCursors
    ReDim m_bColumnFiltered(0)
    ReDim m_sToolTipHint(0)
    
End Sub

Private Function VersionCheck() As Boolean

Dim tVer    As OSVERSIONINFO

    tVer.dwVersionInfoSize = Len(tVer)
    GetVersionEx tVer
    m_bIsNt = ((tVer.dwPlatformId And VER_PLATFORM_WIN32_NT) = VER_PLATFORM_WIN32_NT)
    If (tVer.dwMajorVersion >= 5) Then
        m_bIsXp = True
    End If
    If Not m_bIsNt Then
        m_bUseUnicode = False
    End If
    VersionCheck = m_bIsNt

End Function


'> Properties
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Private Property Get ColumnAlign(ByVal lColumn As Long) As EHdrTextAlign
'*/ retieve a columns text alignment

Dim tHI     As HDITEMA
Dim tHW     As HDITEMW

    If m_lHdrHwnd = 0 Then Exit Property
    If m_bIsNt Then
        With tHW
            .Mask = HDI_FORMAT
            SendMessageW m_lHdrHwnd, HDM_GETITEMW, lColumn, tHW
            ColumnAlign = (HD_CALGN And .fmt)
        End With
    Else
        With tHI
            .Mask = HDI_FORMAT
            SendMessageA m_lHdrHwnd, HDM_GETITEMA, lColumn, tHI
            ColumnAlign = (HD_CALGN And .fmt)
        End With
    End If

End Property

Friend Property Get ColumnAtIndex(ByVal lIndex As Long) As Long

Dim i As Long

    For i = 0 To ColumnCount - 1
        If ColumnIndex(i) = lIndex Then
            ColumnAtIndex = i
            Exit For
        End If
    Next i

End Property

Private Property Get ColumnCount() As Long
'*/ retieve column count
    If m_lHdrHwnd = 0 Then Exit Property
    ColumnCount = SendMessageLongA(m_lHdrHwnd, HDM_GETITEMCOUNT, 0&, 0&)
End Property

Private Property Get ColumnIcon(ByVal lColumn As Long) As Long
'*/ retieve header icon index

Dim tHI     As HDITEMA
Dim tHW     As HDITEMW

    If Not (m_lImlHdHndl = 0) Then
        ColumnIcon = -1
        If m_bIsNt Then
            With tHW
                .Mask = HDI_FORMAT
                SendMessageW m_lHdrHwnd, HDM_GETITEMW, lColumn, tHW
                If (.fmt And HDF_IMAGE) = HDF_IMAGE Then
                    .Mask = HDI_IMAGE
                    SendMessageW m_lHdrHwnd, HDM_GETITEMW, lColumn, tHW
                    ColumnIcon = .iImage
                End If
            End With
        Else
            With tHI
                .Mask = HDI_FORMAT
                SendMessageA m_lHdrHwnd, HDM_GETITEMA, lColumn, tHI
                If (.fmt And HDF_IMAGE) = HDF_IMAGE Then
                    .Mask = HDI_IMAGE
                    SendMessageA m_lHdrHwnd, HDM_GETITEMA, lColumn, tHI
                    ColumnIcon = .iImage
                End If
            End With
        End If
    End If

End Property

Private Property Let ColumnIcon(ByVal lColumn As Long, _
                                ByVal lIcon As Long)
'*/ change header icon

Dim lAlign      As Long
Dim uHDI        As HDITEMA

    If (m_lImlHdHndl = 0) Then Exit Property
    With uHDI
        .Mask = HDI_FORMAT
        If m_bIsNt Then
            SendMessageW m_lHdrHwnd, HDM_GETITEMW, lColumn, uHDI
        Else
            SendMessageA m_lHdrHwnd, HDM_GETITEMA, lColumn, uHDI
        End If
        lAlign = HD_CALGN And .fmt
        .iImage = lIcon
        .fmt = HDF_STRING Or lAlign Or HDF_IMAGE * -(lIcon > -1 And m_lImlHdHndl <> 0) Or HDF_BITMAP_ON_RIGHT
        .Mask = HDI_IMAGE * -(lIcon > -1) Or HDI_FORMAT
    End With
    
    If m_bIsNt Then
        SendMessageW m_lHdrHwnd, HDM_SETITEMW, lColumn, uHDI
    Else
        SendMessageA m_lHdrHwnd, HDM_SETITEMA, lColumn, uHDI
    End If

End Property

Friend Property Get ColumnIndex(ByVal lColumn As Long) As Long

Dim tHI     As HDITEMA
Dim tHW     As HDITEMW

    If m_bIsNt Then
        With tHW
            .Mask = HDI_ORDER
            If Not (SendMessageW(m_lHdrHwnd, HDM_GETITEMW, lColumn, tHW) = 0) Then
                ColumnIndex = .iOrder
            End If
        End With
    Else
        With tHI
            .Mask = HDI_ORDER
            If Not (SendMessageA(m_lHdrHwnd, HDM_GETITEMA, lColumn, tHI) = 0) Then
                ColumnIndex = .iOrder
            End If
        End With
    End If

End Property

Friend Property Get ColumnCountChange() As Long
    ColumnCountChange = m_lColumnCountChange
End Property

Friend Property Let ColumnCountChange(ByVal PropVal As Long)
    
    ReDim Preserve m_bColumnLocked(0 To PropVal)
    ReDim Preserve m_sToolTipHint(0 To PropVal)
    ReDim Preserve m_bColumnFiltered(0 To PropVal)
    m_lColumnCountChange = PropVal

End Property

Friend Property Get ColumnFilters() As Boolean
    ColumnFilters = m_bColumnFilters
End Property

Friend Property Let ColumnFilters(ByVal PropVal As Boolean)
    m_bColumnFilters = PropVal
End Property

Friend Property Get ColumnLocked(ByVal lColumn As Long) As Boolean

On Error GoTo Handler

    If Not (lColumn = -1) Then
        ColumnLocked = m_bColumnLocked(lColumn)
    End If

Handler:
    On Error GoTo 0

End Property

Friend Property Let ColumnLocked(ByVal lColumn As Long, _
                                 ByVal PropVal As Boolean)
    m_bColumnLocked(lColumn) = PropVal
End Property

Friend Property Get ColumnSortDescending() As Boolean
    ColumnSortDescending = m_bSortDescending
End Property

Friend Property Let ColumnSortDescending(ByVal PropVal As Boolean)
    m_bSortDescending = PropVal
End Property

Friend Property Get ColumnSorted() As Long
    ColumnSorted = m_lColumnSorted
End Property

Friend Property Let ColumnSorted(ByVal PropVal As Long)
    m_lColumnSorted = PropVal
End Property

Private Property Get ColumnText(ByVal lColumn As Long) As String
'*/ get a columns heading

Dim aText(261)  As Byte
Dim lLen        As Long
Dim sTemp       As String
Dim tHI         As HDITEMA
Dim tHW         As HDITEMW

    If Not (m_lHdrHwnd = 0) Then
        If m_bIsNt Then
            With tHW
                .pszText = VarPtr(aText(0))
                .cchTextMax = UBound(aText) + 1
                .Mask = HDI_TEXT
            End With
            SendMessageW m_lHdrHwnd, HDM_GETITEMW, lColumn, tHW
            ColumnText = PointerToString(tHW.pszText)
        Else
            With tHI
                sTemp = String(260, Chr$(0))
                .pszText = sTemp
                .cchTextMax = 261
                .Mask = HDI_TEXT
            End With
            SendMessageA m_lHdrHwnd, HDM_GETITEMA, lColumn, tHI
            ColumnText = tHI.pszText
            lLen = InStr(ColumnText, vbNullChar)
            If lLen Then
                ColumnText = Left$(ColumnText, lLen - 1)
            End If
        End If
    End If

End Property

Friend Property Get ColumnVerticalText() As Boolean
    ColumnVerticalText = m_bColumnVerticalText
End Property

Friend Property Let ColumnVerticalText(ByVal PropVal As Boolean)

    If m_bHeaderActive Then
        If PropVal Then
            SetVerticalFont
        Else
            DestroyVericalFont
        End If
    End If
    m_bColumnVerticalText = PropVal