怎样设置菜单图标

Question

Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long 
Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long 
Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Public Const MF_BITMAP = &H4& 
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 
Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long 
Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As Boolean 
Public Const MIIM_ID = &H2 
Public Const MIIM_TYPE = &H10 
Public Const MFT_STRING = &H0&
使用： 在 Form1 中增加一个 PictureBox1， AutoSize 为 True， 放一个小 Bmp (不是 Icon！推荐 13*13)。
Private Sub Command1_Click()'获得菜单句柄
hMenu& = GetMenu(Form1.hwnd)
hSubMenu& = GetSubMenu(hMenu&, 0)
'Get the menuId of the first entry (Bitmap)
hID& = GetMenuItemID(hSubMenu&, 0)’添加位图
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture
'You can add two bitmaps to a menuentry
'One for the checked and one for the unchecked state.End Sub 

Answer 1

'将上面的程序改为函数岂不快哉？MenuLine是窗口菜主菜单条，第一个为0，SUBMenuID是子菜单，第一个为1,Line不算。
'设置图形菜单
Public Function SetPicMenu(FormHwnd As Long, MenuLine As Long, SubMenuId As Long, Bitmaps As Long, Optional NoCheckBitmaps As Long) As Boolean
  Dim Hmenu As Long
  Dim HSubMenu As Long
  Dim MenuID As Long
  Dim x As Long
  
  Hmenu = GetMenu(FormHwnd)
  If Hmenu = 0 Then Exit Function
  HSubMenu = GetSubMenu(Hmenu, MenuLine)
  If HSubMenu = 0 Then Exit Function
  MenuID = GetMenuItemID(HSubMenu, SubMenuId - 1)
  If MenuID <= 0 Then Exit Function
  x = SetMenuItemBitmaps(Hmenu, MenuID, &H4, Bitmaps, NoCheckBitmaps)
  If x = 0 Then Exit Function
  SetPicMenu = True
End Function