📄 clsfiltermenu.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 = "clsFilterMenu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Implements GXISubclass
Private Const BM_TRANSPARENT As Long = &H1
Private Const BS_PUSHBUTTON As Long = &H0
Private Const BS_OWNERDRAW As Long = &HB
Private Const DT_CENTER As Long = &H1&
Private Const DT_VCENTER As Long = &H4&
Private Const DT_SINGLELINE As Long = &H20&
Private Const FW_NORMAL As Long = 400
Private Const FW_BOLD As Long = 700
Private Const HWND_TOP As Long = 0
Private Const HWND_BOTTOM As Long = 1
Private Const HWND_TOPMOST As Long = -1
Private Const HWND_NOTOPMOST As Long = -2
Private Const LF_ANTIALIASED_QUALITY As Long = 4
Private Const LOGPIXELSY As Long = 90
Private Const MOUSEEVENTF_MOVE As Long = &H1
Private Const MOUSEEVENTF_LEFTDOWN As Long = &H2
Private Const MOUSEEVENTF_LEFTUP As Long = &H4
Private Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Private Const MOUSEEVENTF_RIGHTUP As Long = &H10
Private Const MOUSEEVENTF_MIDDLEDOWN As Long = &H20
Private Const MOUSEEVENTF_MIDDLEUP As Long = &H40
Private Const MOUSEEVENTF_ABSOLUTE As Long = &H8000
Private Const QS_ALLINPUT As Double = _
(&H1 Or &H2 Or &H4 Or &H8 Or &H10 Or &H20 Or &H40 Or &H80)
Private Const SS_OWNERDRAW As Long = &HD
Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOZORDER As Long = &H4
Private Const SWP_NOREDRAW As Long = &H8
Private Const SWP_NOACTIVATE As Long = &H10
Private Const SWP_FRAMECHANGED As Long = &H20
Private Const SWP_SHOWWINDOW As Long = &H40
Private Const SWP_HIDEWINDOW As Long = &H80
Private Const SWP_NOCOPYBITS As Long = &H100
Private Const SWP_NOOWNERZORDER As Long = &H200
Private Const SWP_NOSENDCHANGING As Long = &H400
Private Const SW_HIDE As Long = &H0
Private Const SW_NORMAL As Long = &H1
Private Const WS_OVERLAPPED As Long = &H0
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const WS_TABSTOP As Long = &H10000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_GROUP As Long = &H20000
Private Const WS_THICKFRAME As Long = &H40000
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_HSCROLL As Long = &H100000
Private Const WS_VSCROLL As Long = &H200000
Private Const WS_DLGFRAME As Long = &H400000
Private Const WS_BORDER As Long = &H800000
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_MAXIMIZE As Long = &H1000000
Private Const WS_CLIPCHILDREN As Long = &H2000000
Private Const WS_CLIPSIBLINGS As Long = &H4000000
Private Const WS_DISABLED As Long = &H8000000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_MINIMIZE As Long = &H20000000
Private Const WS_CHILD As Long = &H40000000
Private Const WS_POPUP As Long = &H80000000
Private Const WS_EX_LTRREADING As Long = &H0
Private Const WS_EX_LEFT As Long = &H0
Private Const WS_EX_RIGHTSCROLLBAR As Long = &H0
Private Const WS_EX_DLGMODALFRAME As Long = &H1
Private Const WS_EX_NOPARENTNOTIFY As Long = &H4
Private Const WS_EX_TOPMOST As Long = &H8
Private Const WS_EX_ACCEPTFILES As Long = &H10
Private Const WS_EX_TRANSPARENT As Long = &H20
Private Const WS_EX_MDICHILD As Long = &H40
Private Const WS_EX_TOOLWINDOW As Long = &H80
Private Const WS_EX_WINDOWEDGE As Long = &H100
Private Const WS_EX_CLIENTEDGE As Long = &H200
Private Const WS_EX_CONTEXTHELP As Long = &H400
Private Const WS_EX_RIGHT As Long = &H1000
Private Const WS_EX_RTLREADING As Long = &H2000
Private Const WS_EX_LEFTSCROLLBAR As Long = &H4000
Private Const WS_EX_CONTROLPARENT As Long = &H10000
Private Const WS_EX_STATICEDGE As Long = &H20000
Private Const WS_EX_APPWINDOW As Long = &H40000
Public Enum EFTTransition
eftNone = 0&
eftSlide = 1&
eftInflate = 2&
End Enum
Public Enum EFSPosition
RightBottom = 0&
RightCenter = 1&
RightTop = 2&
LeftBottom = 3&
LeftCenter = 4&
LeftTop = 5&
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 VERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(32) As Byte
End Type
Private Type DRAWITEMSTRUCT
CtlType As Long
CtlID As Long
itemID As Long
itemAction As Long
itemState As Long
hwndItem As Long
hdc As Long
rcItem As RECT
itemData As Long
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersion As VERSIONINFO) As Long
Private Declare Function CreateWindowExA Lib "USER32" (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 CreateWindowExW Lib "USER32" (ByVal dwExStyle As Long, _
ByVal lpClassName As Long, _
ByVal lpWindowName As Long, _
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 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 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 GetSysColor Lib "USER32" (ByVal nIndex As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function CopyRect Lib "USER32" (lpDestRect As RECT, _
lpSourceRect As RECT) As Long
Private Declare Function DrawTextA Lib "USER32" (ByVal hdc As Long, _
ByVal lpStr As String, _
ByVal nCount As Long, _
lpRect As RECT, _
ByVal wFormat As Long) As Long
Private Declare Function DrawTextW Lib "USER32" (ByVal hdc As Long, _
ByVal lpStr As Long, _
ByVal nCount As Long, _
lpRect As RECT, _
ByVal wFormat As Long) As Long
Private Declare Function FillRect Lib "USER32" (ByVal hdc As Long, _
lpRect As RECT, _
ByVal hBrush As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, _
ByVal nBkMode As Long) As Long
Private Declare Function CreateDc Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, _
lpDeviceName As Any, _
lpOutput As Any, _
lpInitData As Any) As Long
Private Declare Function CreateFontIndirectA Lib "gdi32" (lpLogFont As LOGFONT) As Long
Private Declare Function CreateFontIndirectW Lib "gdi32" (lpLogFont As LOGFONT) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, _
ByVal nNumerator As Long, _
ByVal nDenominator As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex 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 SetTextColor Lib "gdi32" (ByVal hdc As Long, _
ByVal crColor As Long) As Long
Private Declare Function SetFocus Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDst As Any, _
lpSrc As Any, _
ByVal Length As Long)
Private Declare Function InflateRect Lib "USER32" (lpRect As RECT, _
ByVal x As Long, _
ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, _
lpRect As RECT) As Long
Private Declare Function PtInRect Lib "USER32" (lpRect As RECT, _
ByVal ptX As Long, _
ByVal ptY As Long) As Long
Private Declare Function MsgWaitForMultipleObjects Lib "USER32" (ByVal nCount As Long, _
pHandles As Long, _
ByVal fWaitAll As Long, _
ByVal dwMilliseconds As Long, _
ByVal dwWakeMask As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Sub mouse_event Lib "USER32" (ByVal dwFlags As Long, _
ByVal dX As Long, _
ByVal dy As Long, _
ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
Private Declare Function GetMessageExtraInfo Lib "USER32" () As Long
Private Declare Function ScreenToClient Lib "USER32" (ByVal hWnd As Long, _
lpPoint As POINTAPI) As Long
Public Event FilterIndex(ByVal lIndex As Long)
Public Event DestroyMe()
Private m_bIsNt As Boolean
Private m_bIsActive As Boolean
Private m_bGradient As Boolean
Private m_bXPColors As Boolean
Private m_bShadow As Boolean
Private m_bShowing As Boolean
Private m_bDestroy As Boolean
Private m_lTitleColor As Long
Private m_lTransparency As Long
Private m_lSafeTimer As Long
Private m_lTransition As Long
Private m_lFilterMenuHwnd As Long
Private m_lColorOffset As Long
Private m_lhTitleFont As Long
Private m_lhTextFont As Long
Private m_lPosition As Long
Private m_lBackColor As Long
Private m_lForeColor As Long
Private m_lParentHwnd As Long
Private m_lCtrlHwnd As Long
Private m_lWidth As Long
Private m_lHeight As Long
Private m_lControlColor As Long
Private m_lThemeIndex As Long
Private m_sTitle As String
Private m_sListItems() As String
Private m_tRWnd As RECT
Private m_oTextFont As StdFont
Private m_oTitleFont As StdFont
Private m_cList As clsODControl
Private WithEvents m_cFilter As clsODControl
Attribute m_cFilter.VB_VarHelpID = -1
Private WithEvents m_cClose As clsODControl
Attribute m_cClose.VB_VarHelpID = -1
Private WithEvents m_cExact As clsODControl
Attribute m_cExact.VB_VarHelpID = -1
Private m_cFilterMenuDc As clsStoreDc
Private m_cRender As clsRender
Private m_SBSubclass As GXMSubclass
Private Sub Class_Initialize()
m_bIsNt = CompatabilityCheck
Set m_SBSubclass = New GXMSubclass
Set m_cRender = New clsRender
Set m_cFilterMenuDc = New clsStoreDc
m_lWidth = 150
m_lBackColor = GetSysColor(&H80000018 And &H1F)
m_lForeColor = &H343434
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -