📄 ctxhookmenu.ctl
字号:
VERSION 5.00
Begin VB.UserControl ctxHookMenu
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
ClientHeight = 570
ClientLeft = 0
ClientTop = 0
ClientWidth = 585
ClipBehavior = 0 'None
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
InvisibleAtRuntime= -1 'True
ScaleHeight = 570
ScaleWidth = 585
End
Attribute VB_Name = "ctxHookMenu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
Option Explicit
'-- Added By Gary Noble
'-- Highlight Event - Fires When The User Selects
'-- A Menu Item
Public Event Highlight(strMenuCaption As String)
'-- CustomDraw Event - Fires When The User Selects
'-- A Menu Item - Only Works When useSystem Font Is False
'-- And Custom Draw Is Enabled
Public Event CustomDrawItemFont(Font As StdFont, Caption As String, ForeColour As OLE_COLOR)
Public Event CustomDrawItemHoverFont(SelectedFont As StdFont, Caption As String, SelectedForeColour As OLE_COLOR, SelectedBackColour As OLE_COLOR, SelectedBorderColour As OLE_COLOR)
Implements ISubclassingSink
Private Const MODULE_NAME As String = "ctxHookMenu"
#Const WEAK_REF_CURRENTMENU = 1
#Const WEAK_REF_ME = 0 '--- don't turn it on - its GPF-ing!!!
'==============================================================================
' API
'==============================================================================
Private lSpecialLineOffset As Long
'--- window messages
Private Const WM_DESTROY As Long = &H2
Private Const WM_ERASEBKGND As Long = &H14
Private Const WM_SYSCOLORCHANGE As Long = &H15
Private Const WM_SHOWWINDOW As Long = &H18
Private Const WM_DRAWITEM As Long = &H2B
Private Const WM_MEASUREITEM As Long = &H2C
Private Const WM_WINDOWPOSCHANGING As Long = &H46
Private Const WM_NCDESTROY As Long = &H82
Private Const WM_NCCALCSIZE As Long = &H83
Private Const WM_NCPAINT As Long = &H85
Private Const WM_INITMENUPOPUP As Long = &H117
Private Const WM_MENUSELECT As Long = &H11F
Private Const WM_ENTERMENULOOP As Long = &H211
Private Const WM_EXITMENULOOP As Long = &H212
Private Const WM_MDISETMENU As Long = &H230
Private Const WM_MDIGETACTIVE As Long = &H229
Private Const WM_PRINT As Long = &H317
Private Const WM_PRINTCLIENT As Long = &H318
Private Const WM_MENUCHAR As Long = &H120
'--- menu flag
Private Const MF_GRAYED As Long = &H1
Private Const MF_DISABLED As Long = &H2
Private Const MF_CHECKED As Long = &H8
Private Const MF_POPUP As Long = &H10
Private Const MF_HILITE As Long = &H80&
Private Const MF_SYSMENU As Long = &H2000
Private Const MF_BYCOMMAND As Long = &H0&
Private Const MF_BYPOSITION As Long = &H400&
'--- menu item info mask
Private Const MIIM_ID As Long = &H2
Private Const MIIM_SUBMENU As Long = &H4
Private Const MIIM_TYPE As Long = &H10
Private Const MIIM_DATA As Long = &H20
'#if(WINVER >= 0x0500)
Private Const MIIM_STRING As Long = &H40
Private Const MIIM_BITMAP As Long = &H80
Private Const MIIM_FTYPE As Long = &H100
'#endif /* WINVER >= 0x0500 */
'--- menu item info type
Private Const MFT_STRING As Long = 0
Private Const MFT_OWNERDRAW As Long = &H100
Private Const MFT_SEPARATOR As Long = &H800
Private Const MFT_RIGHTJUSTIFY As Long = &H4000
'--- for ownerdrawn items
Private Const ODT_MENU As Long = 1
Private Const ODS_SELECTED As Long = &H1
Private Const ODS_HOTLIGHT As Long = &H40
Private Const ODA_SELECT As Long = &H2
'--- for GetSystemMetrics
Private Const SM_CYSCREEN As Long = 1
Private Const SM_CXDLGFRAME As Long = 7
Private Const SM_CXFRAME As Long = 32
Private Const SM_CXEDGE As Long = 45
'--- for SetWindowLong (window styles)
Private Const WS_BORDER As Long = &H800000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_EX_DLGMODALFRAME As Long = &H1&
Private Const WS_EX_WINDOWEDGE As Long = &H100
'--- for GetClassLong
Private Const GCL_STYLE As Long = (-26)
Private Const CS_DROPSHADOW As Long = &H20000
'--- for SetWindowPos
Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOZORDER As Long = &H4
Private Const SWP_NOACTIVATE As Long = &H10
Private Const SWP_DRAWFRAME As Long = &H20
Private Const SWP_FLAGS As Long = SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_DRAWFRAME
'--- for SystemParametersInfo
Private Const SPI_GETHIGHCONTRAST As Long = 66
Private Const SPI_GETFLATMENU As Long = &H1022
'--- for HIGHCONTRAST struct
Private Const HCF_HIGHCONTRASTON As Long = &H1
Private Const HCF_AVAILABLE As Long = &H2
'--- for GetDeviceCaps
Private Const BITSPIXEL As Long = 12
Private Const PLANES As Long = 14
'--- for registry
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const KEY_QUERY_VALUE As Long = &H1
'--- for GetSysColor
Private Const COLOR_MENUBAR As Long = 30
'--- for GetVersionEx
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Private Const VER_PLATFORM_WIN2000 As Long = 1280
Private Const VER_PLATFORM_WINXP As Long = 1281
'--- for menu columns
Private Const MF_MENUBREAK As Long = &H40
Private Const MNC_EXECUTE As Long = 2
'-- for Custom Colours
Private Const m_def_UserSideBarColour As Long = 0
Private Const m_def_UserTopMenuBackColour As Long = 0
Private Const m_def_UserTopMenuSelectedColour As Long = 0
Private Const m_def_UserTopMenuHotColour As Long = 0
Private Const m_def_UserTopMenuHotBorderColour As Long = 0
Private Const m_def_UserMenuBorderColour As Long = 0
Private Const m_def_UserCheckBackColour As Long = 0
Private Const m_def_UserCheckBorderColour As Long = 0
Private Const m_def_UserGradientOne As Long = 0
Private Const m_def_UserGradientTwo As Long = 0
Private Const m_def_UserSelectedMenuBackColour As Long = 0
Private Const m_def_UserSelectedMenuBorderColour As Long = 0
Private Const m_def_UserSelectedItemForeColour As Long = 0
Private Const m_def_UserUseGradient As Boolean = False
Private Const m_def_UserUseTopMenuGradient As Boolean = False
Private m_blnAutoColumnTop As Boolean
Private m_blnPopupLeftMost As Boolean
Private m_blnPopupAbove As Boolean
Private Declare Function InvalidateRectAsAny Lib "user32" Alias _
"InvalidateRect" (ByVal hwnd As Long, lpRect As Any, _
ByVal bErase As Long) As Long
Private Declare Function IsZoomed Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowDC Lib "user32" (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 GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal B As Long, lpMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function GetMenuState Lib "user32" (ByVal hMenu As Long, ByVal wID As Long, ByVal wFlags As Long) As Long
Private Declare Function GetMenuItemRect Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long, ByVal uItem As Long, lprcItem As RECT) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long
Private Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Private Declare Function CreateIconIndirect Lib "user32" (piconinfo As ICONINFO) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetViewportOrgEx Lib "gdi32" (ByVal hDC As Long, ByVal lpPoint As Long) As Long
Private Declare Function SetViewportOrgEx Lib "gdi32" (ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, ByVal lpPoint As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare Function ExcludeClipRect Lib "gdi32" (ByVal hDC As Long, ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SendMessage 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 RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function 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) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SelectClipRgn Lib "gdi32" (ByVal hDC As Long, ByVal hrgn As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Enum UcsDrawStyle
DS_普通 = 1 ' Draws Normal Icon
DS_XP = 2 ' Draws Faded Icon
End Enum
Public Enum UcsMenuStyle
MS_默认 = 1
MS_自定义 = 2
End Enum
Private Type ICONINFO
fIcon As Long
xHotspot As Long
yHotspot As Long
hbmMask As Long
hbmColor As Long
End Type
Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As Long
cch As Long
hbmpItem As Long
End Type
Private Type MEASUREITEMSTRUCT
CtlType As Long
CtlID As Long
itemID As Long
itemWidth As Long
ItemHeight As Long
ItemData As Long
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 Type WINDOWPOS
hwnd As Long
hWndInsertAfter As Long
x As Long
y As Long
cx As Long
cy As Long
Flags As Long
End Type
Private Type UcsRgbQuad
R As Byte
G As Byte
B As Byte
a As Byte
End Type
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Private Type HIGHCONTRAST
cbSize As Long
dwFlags As Long
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -