You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

VB6中启用添加至画图程序的灰色自定义菜单问题

问题:向画图程序添加自定义菜单项后无法启用(始终呈灰色)

参考了论坛相关内容,尝试用VB6向外部程序添加弹出菜单,在记事本中测试成功,但在画图程序中添加的菜单项始终呈灰色。尝试通过设置MENUITEMINFO的fState为MFS_ENABLED、多次调用EnableMenuItem函数等方式启用菜单,均未生效。

相关代码

Option Explicit
 
Const MENUID = 56 'our unique identifier
Dim hWndSubMenu As Long
'Forgot these declares in a previous post
Const MF_ENABLED = &H0
Const MF_GRAYED = &H1
Const MF_DISABLED = &H2

Private Declare Function EnableMenuItem Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal wIDEnableItem As Long, _
    ByVal wEnable As Long _
) As Long

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 String
    cch As Long
End Type
 
Private Const MIIM_STATE = &H1
Private Const MIIM_ID = &H2
Private Const MIIM_STRING = &H40
Private Const MIIM_FTYPE = &H100
 
Private Const MFT_SEPARATOR = &H800
Private Const MFT_STRING = &H0
Private Const MFS_ENABLED = &H0
Private Const MFS_CHECKED = &H8
 
Private Const WM_COMMAND = &H111
Private Const MF_BYCOMMAND = &H0&
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String _
) As Long
 
Private Declare Function GetMenu Lib "user32" ( _
    ByVal hwnd As Long _
) As Long
 
Private Declare Function GetSubMenu Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal nPos As Long _
) As Long
 
Private Declare Function RemoveMenu Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal nPosition As Long, _
    ByVal wFlags As Long _
) As Long
 
Private Declare Function GetMenuItemCount Lib "user32.dll" ( _
    ByVal hMenu As Long _
) As Long
 
Private Declare Function InsertMenuItem Lib "user32.dll" Alias "InsertMenuItemA" ( _
    ByVal hMenu As Long, _
    ByVal uItem As Long, _
    ByVal fByPosition As Long, _
    lpmii As MENUITEMINFO _
) As Long
 
Private Declare Function DrawMenuBar Lib "user32" ( _
    ByVal hwnd As Long _
) As Long

Const WM_INITMENUPOPUP = &H117

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 Sub Command1_Click()
Dim hWndNotepad As Long
Dim hWndMenu As Long
Dim count As Long
Dim mii As MENUITEMINFO
Dim appCaption As String
 
'Get a handle to Paint
appCaption = "untitled - Paint"
hWndNotepad = FindWindow(vbNullString, appCaption)
While hWndNotepad = 0
    If MsgBox("Open Paint", vbOKCancel) = vbCancel Then Exit Sub
    hWndNotepad = FindWindow(vbNullString, appCaption)
Wend
 
'Get handle to Paint's main menu
hWndMenu = GetMenu(hWndNotepad)
 
'Get handle to 'File' submenu
hWndSubMenu = GetSubMenu(hWndMenu, 5)
 
'Get number of items in sub menu
count = GetMenuItemCount(hWndSubMenu)
 
'Setup data structure for InsertMenuItem call
    With mii
        .cbSize = Len(mii)
        .fMask = MIIM_STATE Or MIIM_ID Or MIIM_STRING Or MIIM_FTYPE
        .fType = MFT_STRING
        .fState = MFS_ENABLED
        .wID = MENUID 'our unique identifier
        .dwTypeData = "My New Menu"
        .cch = Len(.dwTypeData)
    End With
    
    ' Add this to the menu.
    Call InsertMenuItem(hWndSubMenu, count + 1, 1, mii)
    Call DrawMenuBar(hWndNotepad)
    
    'test attempts
    Call SendMessage(hWndNotepad, WM_INITMENUPOPUP, hWndSubMenu, 3)
    Call EnableMenuItem(hWndSubMenu, MENUID, MF_BYCOMMAND Or MF_ENABLED)
    Call SendMessage(hWndNotepad, WM_INITMENUPOPUP, hWndSubMenu, 3)
    Call EnableMenuItem(hWndSubMenu, MENUID, MF_ENABLED)
    SendMessage hwnd, WM_COMMAND, 56, 0
    Call EnableMenuItem(hWndSubMenu, MENUID, MF_ENABLED)
'Now set up hook, we want to monitor the WM_COMMAND message
 With Hook
    .TargethWnd = hWndNotepad
    .AddMessage WM_COMMAND, "WM_COMMAND"
    .AddMessage WM_INITMENUPOPUP, "WM_INITMENUPOPUP"
    
    .SetHook
 End With
End Sub
 
 
Private Sub Form_Unload(Cancel As Integer)
'remove our hook
 Hook.RemoveAllHooks
'remove our menu item
 Call RemoveMenu(hWndSubMenu, MENUID, MF_BYCOMMAND)
End Sub
 
Private Sub Hook_PostedMessage(uMsg As Long, wParam As Long, lParam As Long)
'here is where our messages will arrive
'look for our special menu ID
If uMsg = WM_COMMAND Then
    If (wParam And &HFFFF) = MENUID Then
        'our menu item has been selected
        MsgBox "Why did you do that?"
    End If
Else
    MsgBox wParam
End If
End Sub

尝试通过fState和EnableMenuItem函数以多种方式启用菜单,但都无效,菜单仍为灰色。


内容的提问来源于stack exchange,提问作者Gaouser

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.06.27 15:45:18