clsskinscrollbars.cls

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

        If m_bUseScrollBarTheme Then
            .ColorizeImage m_lThemeColor, m_sngLuminence
        End If
    End With
    
    Set m_cBtUpDc = New clsStoreDc
    With m_cBtUpDc
        .CreateFromPicture IVBtUp
        If m_bUseScrollBarTheme Then
            .ColorizeImage m_lThemeColor, m_sngLuminence
        End If
    End With
    
End Sub

Private Function LeftKeyState() As Boolean
'/* left button pressed state

    If ((GetKeyState(VK_LBUTTON) And &H80) > 1) Then
        LeftKeyState = True
    End If

End Function

Private Sub MaskShow(ByVal lHwnd As Long, _
                      ByVal bVisible As Boolean)
    
    If Not (lHwnd = 0) Then
        If bVisible Then
            ShowWindow lHwnd, SW_NORMAL
        Else
            ShowWindow lHwnd, SW_HIDE
        End If
    End If
    
End Sub

Private Sub ResetSCPos()

Dim lHscr       As Long
Dim uPt         As POINTAPI
Dim tOnRt       As RECT

    GetWindowRect m_lCtrlHnd, tOnRt
    CopyMemory uPt, tOnRt, Len(uPt)
    ScreenToClient m_hWndParent, uPt
    BarVisible m_lCtrlHnd
    
    With tOnRt
        OffsetRect tOnRt, -.Left, -.Top
    End With

    With tOnRt
        If Not (m_lVScrollHnd = 0) And HasVertical Then
            SetWindowPos m_lVScrollHnd, 0&, uPt.x + (.Right - m_lVXScroll), uPt.y, m_lVXScroll, (.bottom - .Top), SWP_SHOWWINDOW
        End If
        If Not (m_lHScrollHnd = 0) And HasHorizontal Then
            SetWindowPos m_lHScrollHnd, 0&, uPt.x, (uPt.y + .bottom) - m_lHYScroll, (.Right - lHscr), m_lVYScroll, SWP_SHOWWINDOW
        End If
        If Not (m_lSizerHnd = 0) And HasSizer Then
            SetWindowPos m_lSizerHnd, 0&, uPt.x + (.Right - m_lVXScroll), (uPt.y + .bottom) - m_lHYScroll, m_lVXScroll, m_lVYScroll, SWP_SHOWWINDOW
        End If
    End With
    
End Sub

Public Sub ScrollbarAttach()

    If Not (m_lCtrlHnd = 0) Then
        '/* store system sizes
        ScrollbarMetrics
        BuildBars
        BarVisible m_lCtrlHnd
        '/* load image classes
        CreateScrollbar SB_VERT
        InitVertImages
        CreateScrollbar SB_HORZ
        InitHorzImages
        CreateScrollbar SB_SZR
        InitSizerImage
        m_bScrollBarActive = True
        Set m_cRender = New clsRender
    End If
    
End Sub

Private Function ScrollBarHitTest() As eSHitTest

Dim tPnt    As POINTAPI
Dim tRect   As RECT

    ScrollBarHitTest = eshNone
    If LeftKeyState Then
        '/* vertical
        CopyRect tRect, m_tVScrBar.rcScrollBar
        GetCursorPos tPnt
        With tPnt
            If Not (PtInRect(tRect, .x, .y) = 0) Then
                If .y >= (tRect.bottom - m_lHXScroll) Then
                    ScrollBarHitTest = eshBottom
                ElseIf .y <= (tRect.Top + m_lHXScroll) Then
                    ScrollBarHitTest = eshTop
                Else
                    With tRect
                        .Top = .Top + m_tVScrBar.xyThumbTop
                        .bottom = .Top + m_tVScrBar.xyThumbBottom
                    End With
                    If Not (PtInRect(tRect, .x, .y) = 0) Then
                        ScrollBarHitTest = eshVThumb
                    End If
                End If
            Else
                If (m_eScrollDirection = efsVertical) Then
                    If m_eHitTest = eshVThumb Then
                        ScrollBarHitTest = eshVThumb
                    End If
                End If
            End If
        End With
        If (ScrollBarHitTest = eshNone) Then
            '/* horizontal
            CopyRect tRect, m_tHScrBar.rcScrollBar
            With tPnt
                If Not (PtInRect(tRect, .x, .y) = 0) Then
                    If .x >= (tRect.Right - m_lVYScroll) Then
                        ScrollBarHitTest = eshRight
                    ElseIf .x <= (tRect.Left + m_lVYScroll) Then
                        ScrollBarHitTest = eshLeft
                    Else
                        With tRect
                            .Left = .Left + m_tHScrBar.xyThumbTop
                            .Right = .Left + m_tHScrBar.xyThumbBottom
                        End With
                        If Not (PtInRect(tRect, .x, .y) = 0) Then
                            ScrollBarHitTest = eshHThumb
                        End If
                    End If
                Else
                    If (m_eScrollDirection = efsHorizontal) Then
                        If m_eHitTest = eshHThumb Then
                            ScrollBarHitTest = eshHThumb
                        End If
                    End If
                End If
            End With
        End If
    End If

    If Not (ScrollBarHitTest = eshNone) Then
        m_eHitTest = ScrollBarHitTest
    End If
    
End Function

Private Sub ScrollbarMetrics()
'/* store scrollbar metrics

    m_lVXScroll = GetSystemMetrics(SM_CXVSCROLL)
    m_lVYScroll = GetSystemMetrics(SM_CYVSCROLL)
    m_lHXScroll = GetSystemMetrics(SM_CXHSCROLL)
    m_lHYScroll = GetSystemMetrics(SM_CYHSCROLL)
    m_lVYThumb = GetSystemMetrics(SM_CYVTHUMB)
    m_lHXThumb = GetSystemMetrics(SM_CXHTHUMB)
    
End Sub

Private Function StoreHorizontal(ByVal lHwnd As Long) As Boolean

Dim lState As Long

On Error GoTo Handler

    With m_tHScrInfo
        .cbSize = Len(m_tHScrInfo)
        .fMask = SIF_ALL
    End With
    '/* copy vertical scrollbar structure
    lState = GetScrollInfo(lHwnd, SB_HORZ, m_tHScrInfo)

    '/* no scrollbar
    If lState = 0 Then
        Exit Function
    End If
    '/* get bar params
    m_tHScrBar.cbSize = Len(m_tHScrBar)
    GetScrollBarInfo lHwnd, OBJID_HSCROLL, m_tHScrBar
    '/* copy size to working rect
    CopyRect m_tHorzRect, m_tHScrBar.rcScrollBar
    StoreHorizontal = True
    
Handler:
    On Error GoTo 0

End Function

Private Function StoreVertical(ByVal lHwnd As Long) As Boolean

Dim lState As Long

On Error GoTo Handler

    With m_tVScrInfo
        .cbSize = Len(m_tVScrInfo)
        .fMask = SIF_ALL
    End With
    '/* copy vertical scrollbar structure
    lState = GetScrollInfo(lHwnd, SB_VERT, m_tVScrInfo)
    '/* no scrollbar
    If lState = 0 Then
        Exit Function
    End If
    '/* get bar params
    m_tVScrBar.cbSize = Len(m_tVScrBar)
    GetScrollBarInfo lHwnd, OBJID_VSCROLL, m_tVScrBar
    '/* copy size to working rect
    CopyRect m_tVertRect, m_tVScrBar.rcScrollBar
    '/* apply client offsets
    StoreVertical = True

Handler:
    On Error GoTo 0
    
End Function

Private Sub HorzBarPaint()

'/* paint horz scrollbar
Dim lHdc        As Long
Dim lDiff       As Long
Dim lHOffset    As Long
Dim lLOffset    As Long
Dim lXOffset    As Long
Dim lSclHdc     As Long
Dim lSzrDc      As Long
Dim lBmp        As Long
Dim lBmpOld     As Long
Dim lTmpDc      As Long
Dim tRect       As RECT
Dim tSzr        As RECT
Dim tPar        As RECT

On Error GoTo Handler

    '/* validate position
    GetWindowRect m_lHScrollHnd, tRect
    GetWindowRect m_lCtrlHnd, tPar
    If tRect.Top < tPar.Top Then
        Exit Sub
    End If
    
    '/* thumb size
    With m_tHScrBar
        lDiff = .xyThumbBottom - .xyThumbTop
    End With
    
    '/* backbuffer the image
    lTmpDc = m_cHTrackDc.hdc
    lHdc = CreateCompatibleDC(lTmpDc)
    With m_tHorzRect
        OffsetRect m_tHorzRect, -.Left, -.Top
        lBmp = CreateCompatibleBitmap(lTmpDc, .Right, .bottom)
    End With
    lBmpOld = SelectObject(lHdc, lBmp)
    lSclHdc = GetDC(m_lHScrollHnd)
    
    Select Case ScrollBarHitTest
    Case eshLeft
        lLOffset = 1
    Case eshRight
        lHOffset = 1
    Case eshHThumb
        lXOffset = 1
    End Select
    
    With m_tHorzRect
        '/* build to temp dc
        With m_cHTrackDc
            m_cRender.Stretch lHdc, 0, 0, m_tHorzRect.Right, m_lHXScroll, .hdc, 0, 0, .Width, .Height, SRCCOPY
        End With
        With m_cHBtLftDc
            m_cRender.Stretch lHdc, 0, 0, m_lHXScroll, m_lHYScroll, .hdc, m_lHBtnWidth * lLOffset, 0, .Width / 2, .Height, SRCCOPY
        End With
        With m_cHBtRgtDc
            m_cRender.Stretch lHdc, (m_tHorzRect.Right - m_lHYScroll), m_tHorzRect.Top, m_lHXScroll, m_lHYScroll, .hdc, (m_lHBtnWidth * lHOffset), 0, (.Width / 2), .Height, SRCCOPY
        End With
        With m_cHThumbDc
            If (lDiff > .Width) Then
                m_cRender.Stretch lHdc, m_tHScrBar.xyThumbTop, 0, 6, m_lHYScroll, .hdc, ((.Width / 2) * lXOffset), 0, 6, .Height, SRCCOPY
                m_cRender.Stretch lHdc, (m_tHScrBar.xyThumbTop + 6), 0, lDiff - 8, m_lHYScroll, .hdc, (((.Width / 2) * lXOffset) + 6), 0, ((.Width / 2) - 12), .Height, SRCCOPY
                m_cRender.Stretch lHdc, (m_tHScrBar.xyThumbBottom - 6), 0, 6, m_lHYScroll, .hdc, (((.Width / 2) * (lXOffset + 1)) - 6), 0, 6, .Height, SRCCOPY
                If (lDiff > 20) Then
                    DrawGlyph False, lHdc, lXOffset
                End If
            Else
                m_cRender.Stretch lHdc, m_tHScrBar.xyThumbTop, 0, lDiff, m_lHYScroll, .hdc, (.Width * lXOffset), 0, (.Width / 2), .Height, SRCCOPY
            End If
        End With
        '/* copy to dest
        m_cRender.Blit lSclHdc, 0, 0, .Right, .bottom, lHdc, 0, 0, SRCCOPY
    End With
    
    '/* sizer
    If m_bHasSizer Then
        GetWindowRect m_lSizerHnd, tRect
        GetWindowRect m_lParentHnd, tSzr
        If tRect.Left > tSzr.Left Then
            lSzrDc = GetDC(m_lSizerHnd)
            m_cRender.Stretch lSzrDc, 0, 0, m_lHYScroll, m_lVXScroll, m_cSzrDc.hdc, 0, 0, m_cSzrDc.Width, m_cSzrDc.Height, SRCCOPY
            ReleaseDC m_lSizerHnd, lSzrDc
        End If
    End If
    
    '/* cleanup
    SelectObject lHdc, lBmpOld
    DeleteObject lBmp
    DeleteDC lHdc
    ReleaseDC m_lVScrollHnd, lSclHdc
    
Handler:
    On Error GoTo 0

End Sub

Private Sub VertBarPaint()

'/* paint vert scrollbar
Dim lHdc        As Long
Dim lDiff       As Long
Dim lHOffset    As Long
Dim lLOffset    As Long
Dim lXOffset    As Long
Dim lSclHdc     As Long
Dim lBmp        As Long
Dim lBmpOld     As Long
Dim lTmpDc      As Long
Dim tRect       As RECT
Dim tPar        As RECT

On Error GoTo Handler

    '/* validate position
    GetWindowRect m_lVScrollHnd, tRect
    GetWindowRect m_lCtrlHnd, tPar
    If tRect.Left < tPar.Left Then
        Exit Sub
    End If
    
    '/* thumb size
    With m_tVScrBar
        lDiff = .xyThumbBottom - .xyThumbTop
    End With
    
    '/* backbuffer the image
    lTmpDc = m_cVTrackDc.hdc
    lHdc = CreateCompatibleDC(lTmpDc)
    
    With m_tVertRect
        OffsetRect m_tVertRect, -.Left, -.Top
        lBmp = CreateCompatibleBitmap(lTmpDc, .Right, .bottom)
    End With
    lBmpOld = SelectObject(lHdc, lBmp)
    lSclHdc = GetDC(m_lVScrollHnd)
    
    Select Case ScrollBarHitTest
    Case eshTop
        lLOffset = 1
    Case eshBottom
        lHOffset = 1
    Case eshVThumb
        lXOffset = 1
    End Select
    
    With m_tVertRect
        '/* build to temp dc
        With m_cVTrackDc
            m_cRender.Stretch lHdc, 0, 0, m_lVXScroll, m_tVertRect.bottom, .hdc, 0, 0, .Width, .Height, SRCCOPY
        End With
        With m_cBtUpDc
            m_cRender.Stretch lHdc, 0, 0, m_lVXScroll, m_lVYScroll, .hdc, (m_lVBtnWidth * lLOffset), 0, (.Width / 2), .Height, SRCCOPY
        End With
        With m_cBtDwnDc
            m_cRender.Stretch lHdc, 0, (m_tVertRect.bottom - m_lVYScroll), m_lVXScroll, m_lVYScroll, .hdc, (m_lVBtnWidth * lHOffset), 0, (.Width / 2), .Height, SRCCOPY
        End With
        With m_cVThumbDc
            If (lDiff > .Height) Then
                '/* thumb: top
                m_cRender.Stretch lHdc, 0, (m_tVScrBar.xyThumbBottom - lDiff), m_lVXScroll, 6, .hdc, ((.Width / 2) * lXOffset), 0, (.Width / 2), 6, SRCCOPY
                '/* center
                m_cRender.Stretch lHdc, 0, (m_tVScrBar.xyThumbBottom - (lDiff - 6)), m_lVXScroll, (lDiff - 12), .hdc, ((.Width / 2) * lXOffset), 6, (.Width / 2), (.Height - 12), SRCCOPY
                '/* bottom
                m_cRender.Stretch lHdc, 0, (m_tVScrBar.xyThumbBottom - 6), m_lVXScroll, 6, .hdc, ((.Width / 2) * lXOffset), (.Height - 6), (.Width / 2), 6, SRCCOPY