📄 clsskinscrollbars.cls
字号:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsSkinScrollbars"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' what a pain in the ass this was ;o(
Implements GXISubclass
Private Const GWL_STYLE As Long = -16
Private Const GWL_EXSTYLE As Long = -20
Private Const FSB_FLAT_MODE As Long = 2
Private Const FSB_ENCARTA_MODE As Long = 1
Private Const FSB_REGULAR_MODE As Long = 0
Private Const OBJID_HSCROLL As Long = &HFFFFFFFA
Private Const OBJID_VSCROLL As Long = &HFFFFFFFB
Private Const SB_LINEDOWN As Long = 1
Private Const SB_LINELEFT As Long = 0
Private Const SB_LINERIGHT As Long = 1
Private Const SB_LINEUP As Long = 0
Private Const SBN_ENDSCROLL As Long = &H8
Private Const SIF_RANGE As Long = &H1
Private Const SIF_PAGE As Long = &H2
Private Const SIF_POS As Long = &H4
Private Const SIF_ALL As Double = (SIF_RANGE Or SIF_PAGE Or SIF_POS)
Private Const SPI_GETWHEELSCROLLLINES As Long = &H68
Private Const STATE_SYSTEM_PRESSED As Long = &H8
Private Const SS_OWNERDRAW As Long = &HD
Private Const SW_HIDE As Long = &H0
Private Const SW_NORMAL As Long = &H1
Private Const SWP_SHOWWINDOW As Long = &H40
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_FRAMECHANGED As Long = &H20
Private Const SWP_NOACTIVATE As Long = &H10
Private Const SWP_NOZORDER As Long = &H4
Private Const VK_LBUTTON As Long = &H1
Private Const WS_EX_TOOLWINDOW As Long = &H80&
Private Const WS_EX_CLIENTEDGE As Long = &H200
Private Const WS_BORDER As Long = &H800000
Private Const WS_CHILD As Long = &H40000000
Private Const WS_HSCROLL As Long = &H100000
Private Const WS_VSCROLL As Long = &H200000
Private Const WM_VSCROLL As Long = &H115
Private Const WM_HSCROLL As Long = &H114
Private Enum SCR_STYLE
SB_HORZ = 0&
SB_VERT = 1&
SB_BOTH = 3&
SB_SZR = 4&
End Enum
'/* system metrics
Private Enum SYSTEM_METRICS
SM_CXSCREEN = 0
SM_CYSCREEN = 1
SM_CXVSCROLL = 2
SM_CYHSCROLL = 3
SM_CYCAPTION = 4
SM_CXBORDER = 5
SM_CYBORDER = 6
SM_CYVTHUMB = 9
SM_CXHTHUMB = 10
SM_CXICON = 11
SM_CYICON = 12
SM_CXCURSOR = 13
SM_CYCURSOR = 14
SM_CYMENU = 15
SM_CXFULLSCREEN = 16
SM_CYFULLSCREEN = 17
SM_CYKANJIWINDOW = 18
SM_MOUSEPRESENT = 19
SM_CYVSCROLL = 20
SM_CXHSCROLL = 21
SM_CXMIN = 28
SM_CYMIN = 29
SM_CXSIZE = 30
SM_CYSIZE = 31
SM_CXFRAME = 32
SM_CYFRAME = 33
SM_CXMINTRACK = 34
SM_CYMINTRACK = 35
SM_CYSMCAPTION = 51
SM_CXMINIMIZED = 57
SM_CYMINIMIZED = 58
SM_CXMAXTRACK = 59
SM_CYMAXTRACK = 60
SM_CXMAXIMIZED = 61
SM_CYMAXIMIZED = 62
End Enum
Private Enum eSHitTest
eshNone = 0&
eshTop = 1&
eshVThumb = 2&
eshBottom = 3&
eshLeft = 4&
eshHThumb = 5&
eshRight = 6&
End Enum
Public Enum EFSScrollDirection
efsNone = 0&
efsHorizontal = 1&
efsVertical = 2&
End Enum
Public Enum EFSOrientationConstants
efsoHorizontal
efsoVertical
efsoBoth
End Enum
Private Type RECT
Left As Long
Top As Long
Right As Long
bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Type SCROLLINFO
cbSize As Long
fMask As Long
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type
Private Type SCROLLBARINFO
cbSize As Long
rcScrollBar As RECT
dxyLineButton As Long
xyThumbTop As Long
xyThumbBottom As Long
reserved As Long
rgstate(0 To 5) As Long
End Type
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function CreateWindowEx Lib "USER32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, _
ByVal lpClassName As String, _
ByVal lpWindowName As String, _
ByVal dwStyle As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hWndParent As Long, _
ByVal hMenu As Long, _
ByVal hInstance As Long, _
lpParam As Any) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, _
ByVal nCount As Long, _
lpObject As Any) As Long
Private Declare Function GetSystemMetrics Lib "USER32" (ByVal nIndex As Long) As Long
Private Declare Function SendMessageLong Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function CopyRect Lib "USER32" (lpDestRect As RECT, _
lpSourceRect As RECT) As Long
Private Declare Function OffsetRect 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 GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, _
ByVal hdc As Long) As Long
Private Declare Function GetScrollBarInfo Lib "USER32" (ByVal hWnd As Long, _
ByVal idObject As Long, _
psbi As SCROLLBARINFO) As Long
Private Declare Function GetScrollInfo Lib "USER32" (ByVal hWnd As Long, _
ByVal n As Long, _
lpScrollInfo As SCROLLINFO) As Long
Private Declare Function DestroyWindow Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Sub SetWindowPos Lib "USER32" (ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long)
Private Declare Function GetParent Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "USER32" () As Long
Private Declare Function ScreenToClient Lib "USER32" (ByVal hWnd As Long, _
lpPoint As POINTAPI) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, _
pSource As Any, _
ByVal Length As Long)
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ShowWindow Lib "USER32" (ByVal hWnd As Long, _
ByVal nCmdShow As Long) As Long
Private Declare Function IsWindowVisible Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, _
ByVal nWidth As Long, _
ByVal crColor As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long, _
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 GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
Private Declare Function PtInRect Lib "USER32" (lpRect As RECT, _
ByVal ptX As Long, _
ByVal ptY As Long) As Long
Private Declare Function GetKeyState Lib "USER32" (ByVal nVirtKey As Long) As Long
Private m_bInitialised As Boolean
Private m_bHasVertical As Boolean
Private m_bHasHorizontal As Boolean
Private m_bHasSizer As Boolean
Private m_bSkinScrollBar As Boolean
Private m_bUseScrollBarTheme As Boolean
Private m_bScrollBarActive As Boolean
Private m_bVisible As Boolean
Private m_bSelect As Boolean
Private m_lParentHnd As Long
Private m_lScrollLuminence As Long
Private m_lThemeColor As Long
Private m_lSmallChangeHorz As Long
Private m_lSmallChangeVert As Long
Private m_lScrollSkinStyle As Long
Private m_lHBtnWidth As Long
Private m_lVBtnWidth As Long
Private m_hWndParent As Long
Private m_lVXScroll As Long
Private m_lVYScroll As Long
Private m_lHXScroll As Long
Private m_lHYScroll As Long
Private m_lVYThumb As Long
Private m_lHXThumb As Long
Private m_lCtrlHnd As Long
Private m_lVScrollHnd As Long
Private m_lHScrollHnd As Long
Private m_lSizerHnd As Long
Private m_sngLuminence As Single
Private m_eScrollDirection As EFSScrollDirection
Private m_eOrientation As EFSOrientationConstants
Private m_eHitTest As eSHitTest
Private m_tVertRect As RECT
Private m_tVScrInfo As SCROLLINFO
Private m_tVScrBar As SCROLLBARINFO
Private m_pVTrack As StdPicture
Private m_pVThumb As StdPicture
Private m_pVBtDwn As StdPicture
Private m_pVBtUp As StdPicture
Private m_cVTrackDc As clsStoreDc
Private m_cVThumbDc As clsStoreDc
Private m_cBtDwnDc As clsStoreDc
Private m_cBtUpDc As clsStoreDc
Private m_tHorzRect As RECT
Private m_tHScrInfo As SCROLLINFO
Private m_tHScrBar As SCROLLBARINFO
Private m_pHTrack As StdPicture
Private m_pHThumb As StdPicture
Private m_pHBtLft As StdPicture
Private m_pHBtRgt As StdPicture
Private m_pSizer As StdPicture
Private m_cHTrackDc As clsStoreDc
Private m_cHThumbDc As clsStoreDc
Private m_cHBtLftDc As clsStoreDc
Private m_cHBtRgtDc As clsStoreDc
Private m_cSzrDc As clsStoreDc
Private m_cRender As clsRender
Private m_GXScrollbar As GXMSubclass
Private Sub Class_Initialize()
m_lSmallChangeHorz = 1
m_lSmallChangeVert = 1
m_eOrientation = efsoBoth
End Sub
Friend Property Get ScrollBarActive() As Boolean
ScrollBarActive = m_bScrollBarActive
End Property
Friend Property Let ScrollBarActive(ByVal PropVal As Boolean)
m_bScrollBarActive = PropVal
End Property
Friend Property Get ScrollDirection() As EFSScrollDirection
ScrollDirection = m_eScrollDirection
End Property
Private Property Get IHBtLft() As StdPicture
'/* scrollbar horizontal button left
Set IHBtLft = m_pHBtLft
End Property
Private Property Set IHBtLft(PropVal As StdPicture)
Set m_pHBtLft = PropVal
End Property
Private Property Get IHBtRgt() As StdPicture
'/* scrollbar horizontal button right
Set IHBtRgt = m_pHBtRgt
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -