clsskinscrollbars.cls

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

End Property

Private Property Set IHBtRgt(PropVal As StdPicture)
    Set m_pHBtRgt = PropVal
End Property

Private Property Get IHThumb() As StdPicture
'/* scrollbar horizontal thumb
    Set IHThumb = m_pHThumb
End Property

Private Property Set IHThumb(PropVal As StdPicture)
    Set m_pHThumb = PropVal
End Property

Private Property Get IHTrack() As StdPicture
'/* scrollbar horizontal track
    Set IHTrack = m_pHTrack
End Property

Private Property Set IHTrack(PropVal As StdPicture)
    Set m_pHTrack = PropVal
End Property

Private Property Get ISizer() As StdPicture
'/* scrollbar sizer
    Set ISizer = m_pSizer
End Property

Private Property Set ISizer(PropVal As StdPicture)
    Set m_pSizer = PropVal
End Property

Private Property Get IVBtDwn() As StdPicture
'/* scrollbar vertical button down
    Set IVBtDwn = m_pVBtDwn
End Property

Private Property Set IVBtDwn(PropVal As StdPicture)
    Set m_pVBtDwn = PropVal
End Property

Private Property Get IVBtUp() As StdPicture
'/* scrollbar vertical button up
    Set IVBtUp = m_pVBtUp
End Property

Private Property Set IVBtUp(PropVal As StdPicture)
    Set m_pVBtUp = PropVal
End Property

Private Property Get IVThumb() As StdPicture
'/* scrollbar vertical thumb
    Set IVThumb = m_pVThumb
End Property

Private Property Set IVThumb(PropVal As StdPicture)
    Set m_pVThumb = PropVal
End Property

Private Property Get IVTrack() As StdPicture
'/* scrollbar vertical track
    Set IVTrack = m_pVTrack
End Property

Private Property Set IVTrack(PropVal As StdPicture)
    Set m_pVTrack = PropVal
End Property

Friend Property Get ScrollBarSkinStyle() As Long
    ScrollBarSkinStyle = m_lScrollSkinStyle
End Property

Friend Property Let ScrollBarSkinStyle(ByVal PropVal As Long)
    m_lScrollSkinStyle = PropVal
End Property

Friend Property Get ScrollLuminence() As Long
    ScrollLuminence = m_lScrollLuminence
End Property

Friend Property Let ScrollLuminence(PropVal As Long)
    m_lScrollLuminence = PropVal
End Property

Friend Property Get ScrollThemeColor() As Long
    ScrollThemeColor = m_lThemeColor
End Property

Friend Property Let ScrollThemeColor(ByVal PropVal As Long)
    m_lThemeColor = PropVal
End Property

Friend Property Get SkinScrollBar() As Boolean
    SkinScrollBar = m_bSkinScrollBar
End Property

Friend Property Let SkinScrollBar(ByVal PropVal As Boolean)
    m_bSkinScrollBar = PropVal
End Property

Friend Property Get UseScrollBarTheme() As Boolean
    UseScrollBarTheme = m_bUseScrollBarTheme
End Property

Friend Property Let UseScrollBarTheme(ByVal PropVal As Boolean)
    m_bUseScrollBarTheme = PropVal
End Property


'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'> Functions
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Friend Function ResetScrollBarSkin()

    m_bScrollBarActive = False
    CleanupSkin
    
End Function

Private Sub BuildBars()

    StoreHorizontal m_lCtrlHnd
    CreateScrollbar SB_HORZ
    InitHorzImages

    StoreVertical m_lCtrlHnd
    CreateScrollbar SB_VERT
    InitVertImages

    CreateScrollbar SB_SZR
    InitSizerImage

End Sub

Private Function BuildImageList() As Boolean

On Error GoTo Handler

    Select Case m_lScrollSkinStyle
    '*/ azure
    Case 0
        '* / horz
        Set IHBtLft = LoadResPicture("AZURE-SCROLLBUTTONLEFT", vbResBitmap)
        Set IHBtRgt = LoadResPicture("AZURE-SCROLLBUTTONRIGHT", vbResBitmap)
        Set IHThumb = LoadResPicture("AZURE-SCROLLHORZTHUMB", vbResBitmap)
        Set IHTrack = LoadResPicture("AZURE-SCROLLHORZSHAFT", vbResBitmap)
        '/* vert
        Set IVBtDwn = LoadResPicture("AZURE-SCROLLBUTTONBOTTOM", vbResBitmap)
        Set IVBtUp = LoadResPicture("AZURE-SCROLLBUTTONTOP", vbResBitmap)
        Set IVThumb = LoadResPicture("AZURE-SCROLLVERTTHUMB", vbResBitmap)
        Set IVTrack = LoadResPicture("AZURE-SCROLLVERTSHAFT", vbResBitmap)
        '/* sizer
        Set ISizer = LoadResPicture("AZURE-SCROLLSIZER", vbResBitmap)
    '/* classic
    Case 1
        Set IHBtLft = LoadResPicture("CLASSIC-SCROLLBUTTONLEFT", vbResBitmap)
        Set IHBtRgt = LoadResPicture("CLASSIC-SCROLLBUTTONRIGHT", vbResBitmap)
        Set IHThumb = LoadResPicture("CLASSIC-SCROLLHORZTHUMB", vbResBitmap)
        Set IHTrack = LoadResPicture("CLASSIC-SCROLLHORZSHAFT", vbResBitmap)
        Set IVBtDwn = LoadResPicture("CLASSIC-SCROLLBUTTONBOTTOM", vbResBitmap)
        Set IVBtUp = LoadResPicture("CLASSIC-SCROLLBUTTONTOP", vbResBitmap)
        Set IVThumb = LoadResPicture("CLASSIC-SCROLLVERTTHUMB", vbResBitmap)
        Set IVTrack = LoadResPicture("CLASSIC-SCROLLVERTSHAFT", vbResBitmap)
        Set ISizer = LoadResPicture("CLASSIC-SCROLLSIZER", vbResBitmap)
    
    '/* gloss
    Case 2
        Set IHBtLft = LoadResPicture("GLOSS-SCROLLBUTTONLEFT", vbResBitmap)
        Set IHBtRgt = LoadResPicture("GLOSS-SCROLLBUTTONRIGHT", vbResBitmap)
        Set IHThumb = LoadResPicture("GLOSS-SCROLLHORZTHUMB", vbResBitmap)
        Set IHTrack = LoadResPicture("GLOSS-SCROLLHORZSHAFT", vbResBitmap)
        Set IVBtDwn = LoadResPicture("GLOSS-SCROLLBUTTONBOTTOM", vbResBitmap)
        Set IVBtUp = LoadResPicture("GLOSS-SCROLLBUTTONTOP", vbResBitmap)
        Set IVThumb = LoadResPicture("GLOSS-SCROLLVERTTHUMB", vbResBitmap)
        Set IVTrack = LoadResPicture("GLOSS-SCROLLVERTSHAFT", vbResBitmap)
        Set ISizer = LoadResPicture("GLOSS-SCROLLSIZER", vbResBitmap)
        
    '/* metal
    Case 3
        Set IHBtLft = LoadResPicture("METAL-SCROLLBUTTONLEFT", vbResBitmap)
        Set IHBtRgt = LoadResPicture("METAL-SCROLLBUTTONRIGHT", vbResBitmap)
        Set IHThumb = LoadResPicture("METAL-SCROLLHORZTHUMB", vbResBitmap)
        Set IHTrack = LoadResPicture("METAL-SCROLLHORZSHAFT", vbResBitmap)
        Set IVBtDwn = LoadResPicture("METAL-SCROLLBUTTONBOTTOM", vbResBitmap)
        Set IVBtUp = LoadResPicture("METAL-SCROLLBUTTONTOP", vbResBitmap)
        Set IVThumb = LoadResPicture("METAL-SCROLLVERTTHUMB", vbResBitmap)
        Set IVTrack = LoadResPicture("METAL-SCROLLVERTSHAFT", vbResBitmap)
        Set ISizer = LoadResPicture("METAL-SCROLLSIZER", vbResBitmap)
        
    '/* xp
    Case 4
        Set IHBtLft = LoadResPicture("XP-SCROLLBUTTONLEFT", vbResBitmap)
        Set IHBtRgt = LoadResPicture("XP-SCROLLBUTTONRIGHT", vbResBitmap)
        Set IHThumb = LoadResPicture("XP-SCROLLHORZTHUMB", vbResBitmap)
        Set IHTrack = LoadResPicture("XP-SCROLLHORZSHAFT", vbResBitmap)
        Set IVBtDwn = LoadResPicture("XP-SCROLLBUTTONBOTTOM", vbResBitmap)
        Set IVBtUp = LoadResPicture("XP-SCROLLBUTTONTOP", vbResBitmap)
        Set IVThumb = LoadResPicture("XP-SCROLLVERTTHUMB", vbResBitmap)
        Set IVTrack = LoadResPicture("XP-SCROLLVERTSHAFT", vbResBitmap)
        Set ISizer = LoadResPicture("XP-SCROLLSIZER", vbResBitmap)
    End Select
    
    If m_bUseScrollBarTheme Then
        ScrollThemeSettings
    End If
    BuildImageList = True

Handler:
    On Error GoTo 0
    
End Function

Private Sub ScrollThemeSettings()

    Select Case m_lScrollLuminence
    Case 0
        m_sngLuminence = 0.2
    Case 1
        m_sngLuminence = 0.5
    Case 2
        m_sngLuminence = 1
    End Select
    
End Sub

Friend Sub LoadSkin(ByVal lCtrlHnd As Long, ByVal lParHnd As Long)

    m_lCtrlHnd = lCtrlHnd
    m_lParentHnd = lParHnd
    If m_bSkinScrollBar Then
        If BuildImageList Then
            SkinAttach
            ScrollbarAttach
        End If
    End If
    
End Sub

Private Function CreateScrollbar(ByVal eStyle As SCR_STYLE) As Long

Dim bOnDesktop As Boolean

    m_hWndParent = GetParent(m_lParentHnd)
    bOnDesktop = (m_hWndParent = GetDesktopWindow())

    Select Case eStyle
    Case SB_HORZ
        If (m_lHScrollHnd = 0) Then
            m_lHScrollHnd = CreateWindowEx(-bOnDesktop * WS_EX_TOOLWINDOW, "Static", vbNullString, WS_CHILD Or SS_OWNERDRAW, 0&, 0&, 0&, 0&, m_hWndParent, 0&, App.hInstance, ByVal 0&)
            MaskShow m_lHScrollHnd, False
        End If
    Case SB_VERT
        If (m_lVScrollHnd = 0) Then
            m_lVScrollHnd = CreateWindowEx(-bOnDesktop * WS_EX_TOOLWINDOW, "Static", vbNullString, WS_CHILD Or SS_OWNERDRAW, 0&, 0&, 0&, 0&, m_hWndParent, 0&, App.hInstance, ByVal 0&)
            MaskShow m_lVScrollHnd, False
        End If
    Case SB_SZR
        If (m_lSizerHnd = 0) Then
            m_lSizerHnd = CreateWindowEx(-bOnDesktop * WS_EX_TOOLWINDOW, "Static", vbNullString, WS_CHILD Or SS_OWNERDRAW, 0&, 0&, 0&, 0&, m_hWndParent, 0&, App.hInstance, ByVal 0&)
            MaskShow m_lSizerHnd, False
        End If
    End Select

End Function

Private Function DestroyScrollbar(ByVal eStyle As SCR_STYLE) As Long

    Select Case eStyle
    Case SB_HORZ
        If Not (m_lHScrollHnd = 0) Then
            DestroyWindow m_lHScrollHnd
            m_lHScrollHnd = 0
        End If
    Case SB_VERT
        If Not (m_lVScrollHnd = 0) Then
            DestroyWindow m_lVScrollHnd
            m_lVScrollHnd = 0
        End If
    Case SB_BOTH
        If Not (m_lHScrollHnd = 0) Then
            DestroyWindow m_lHScrollHnd
            m_lHScrollHnd = 0
        End If
        If Not (m_lVScrollHnd = 0) Then
            DestroyWindow m_lVScrollHnd
            m_lHScrollHnd = 0
        End If
        If Not (m_lSizerHnd = 0) Then
            DestroyWindow m_lSizerHnd
            m_lSizerHnd = 0
        End If
    Case SB_SZR
        If Not (m_lSizerHnd = 0) Then
            DestroyWindow m_lSizerHnd
            m_lSizerHnd = 0
        End If
    End Select
    
End Function

Private Sub InitHorzImages()
'/* init hz image classes

Dim tBmp            As BITMAP

    '/* image size
    GetObject IHBtLft.Handle, Len(tBmp), tBmp
    With tBmp
        m_lHBtnWidth = (.bmWidth / 2)
    End With

    '/* create the image classes
    Set m_cHTrackDc = New clsStoreDc
    With m_cHTrackDc
        .CreateFromPicture IHTrack
        If m_bUseScrollBarTheme Then
            .ColorizeImage m_lThemeColor, m_sngLuminence
        End If
    End With
    
    Set m_cHThumbDc = New clsStoreDc
    With m_cHThumbDc
        .CreateFromPicture IHThumb
        If m_bUseScrollBarTheme Then
            .ColorizeImage m_lThemeColor, m_sngLuminence
        End If
    End With
    
    Set m_cHBtLftDc = New clsStoreDc
    With m_cHBtLftDc
        .CreateFromPicture IHBtLft
        If m_bUseScrollBarTheme Then
            .ColorizeImage m_lThemeColor, m_sngLuminence
        End If
    End With
    
    Set m_cHBtRgtDc = New clsStoreDc
    With m_cHBtRgtDc
        .CreateFromPicture IHBtRgt
        If m_bUseScrollBarTheme Then
            .ColorizeImage m_lThemeColor, m_sngLuminence
        End If
    End With
    
End Sub

Private Sub InitSizerImage()
'/* sizer
    
    Set m_cSzrDc = New clsStoreDc
    With m_cSzrDc
        .CreateFromPicture ISizer
        If m_bUseScrollBarTheme Then
            .ColorizeImage m_lThemeColor, m_sngLuminence
        End If
    End With
    
End Sub

Private Sub InitVertImages()
'/* init vt image classes

Dim tBmp            As BITMAP

    GetObject IVBtDwn.Handle, Len(tBmp), tBmp
    With tBmp
        m_lVBtnWidth = (.bmWidth / 2)
    End With

    '/* create the image classes
    Set m_cVTrackDc = New clsStoreDc
    With m_cVTrackDc
        .CreateFromPicture IVTrack
        If m_bUseScrollBarTheme Then
            .ColorizeImage m_lThemeColor, m_sngLuminence
        End If
    End With
    
    Set m_cVThumbDc = New clsStoreDc
    With m_cVThumbDc
        .CreateFromPicture IVThumb
        If m_bUseScrollBarTheme Then
            .ColorizeImage m_lThemeColor, m_sngLuminence
        End If
    End With
    
    Set m_cBtDwnDc = New clsStoreDc
    With m_cBtDwnDc
        .CreateFromPicture IVBtDwn