'-------------------------------------------------
'               让菜单中出现图标一法
'-------------------------------------------------
'               洪恩在线  求知无限
'-------------------------------------------------
'程序应用三个API函数实现了在菜单项中加入小图标
'GetMenu、GetSubMenu、SetMenuItemBitmaps
'-------------------------------------------------
Option Explicit
'【VB声明】
'  Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long'【说明】
'  取得窗口中一个菜单的句柄'【返回值】
'  Long,依附于指定窗口的一个菜单的句柄(如果有菜单);否则返回零'【参数表】
'  hwnd -----------  Long,窗口句柄。对于vb,这应该是一个窗体句柄。注意可能不是子窗口的句柄
Private Declare Function GetMenu Lib "user32" _
   (ByVal hwnd As Long) As Long
'-------------------------------------------------
'【VB声明】
'  Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long'【说明】
'  取得一个弹出式菜单的句柄,它位于菜单中指定的位置'【返回值】
'  Long,位于指定位置的弹出式菜单的句柄(如果有的话);否则返回零'【参数表】
'  hMenu ----------  Long,菜单的句柄'  nPos -----------  Long,条目在菜单中的位置。第一个条目的编号为0
Private Declare Function GetSubMenu Lib "user32" _
   (ByVal hMenu As Long, ByVal nPos As Long) As Long
'-------------------------------------------------
'【VB声明】
'  Private 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'【说明】
'  设置一幅特定位图,令其在指定的菜单条目中使用,代替标准的复选符号(√)。位图的大小必须与菜单复选符号的正确大小相符,这个正确大小可以由GetMenuCheckMarkDimensions函数获得'【返回值】
'  Long,非零表示成功,零表示失败。会设置GetLastError'【备注】
'  使用的位图可能由多个条目共享。一旦不再需要,位图必须由应用程序清除,因为windows不能自动对它进行清除'【参数表】
'  hMenu ----------  Long,菜单句柄'  nPosition ------  Long,欲设置位图的一个菜单条目的标识符。如在wFlags参数中指定了MF_BYCOMMAND,这个参数就代表欲改变的菜单条目的命令ID。如设置的是MF_BYPOSITION,这个参数就代表菜单条目在菜单中的位置(第一个条目的位置为零)'  wFlags ---------  Long,常数MF_BYCOMMAND或MF_BYPOSITION,取决于nPosition参数'  hBitmapUnchecked -  Long,撤消复选时为菜单条目显示的一幅位图的句柄。如果为零,表示不在未复选状态下显示任何标志'  hBitmapChecked -  Long,复选时为菜单条目显示的一幅位图的句柄。可设为零,表示复选时不显示任何标志。如两个位图句柄的值都是零,则为这个条目恢复使用默认复选位图
Private 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
'-------------------------------------------------Const MF_BYPOSITION = &H400&Private Sub Form_Load()
    Dim mHandle As Long, lRet As Long, sHandle As Long, sHandle2 As Long
    '取得菜单的句柄并赋值给mHandle
    mHandle = GetMenu(hwnd)
    '取得mHandle句柄所指菜单的第一个弹出式菜单(文件&F)的句柄并赋值给sHandle
    sHandle = GetSubMenu(mHandle, 0)
    '将弹出式菜单的第0-4项加上图片,为什么跳过2呢?因为2是分割线
    lRet = SetMenuItemBitmaps(sHandle, 0, MF_BYPOSITION, imOpen.Picture, imSave.Picture)
    lRet = SetMenuItemBitmaps(sHandle, 1, MF_BYPOSITION, imSave.Picture, imSave.Picture)
    lRet = SetMenuItemBitmaps(sHandle, 3, MF_BYPOSITION, imPrint.Picture, imPrint.Picture)
    lRet = SetMenuItemBitmaps(sHandle, 4, MF_BYPOSITION, imPrintSetup.Picture, imPrintSetup.Picture)
    '取得mHandle句柄所指菜单的第二个弹出式菜单(编辑&E)的句柄并赋值给sHandle
    sHandle = GetSubMenu(mHandle, 1)
    '取得sHandle句柄所指菜单的第一个次级菜单(次级菜单&S)的句柄并赋值给sHandle2
    sHandle2 = GetSubMenu(sHandle, 0)
    '将次级菜单中的第1项加上图片
    lRet = SetMenuItemBitmaps(sHandle2, 0, MF_BYPOSITION, imCopy.Picture, imCopy.Picture)
'提示:在SetMenuItemBitmaps()我们把后两项设为相同的图片,如果设为不同的两张图片会有什么效果呢?
'      原来这两张图片分别表示复选和撤消复选时的状态,你只须在菜单项被点击的函数中加入以下语句:
'      Private Sub mnuOpen_Click()
'       If mnuOpen.Checked = True Then
'       mnuOpen.Checked = False
'       Else: mnuOpen.Checked = True
'       End If
'      End Sub
'      然后在SetMenuItemBitmaps()我们把后两项设为不同的图片即可,有兴趣的话试一试。
End Subhttp://www.hongen.com.cn/pc/program/apitutor/zip/api0010.zip

解决方案 »

  1.   

    在菜单上增加图标
     
     
     
    声明:
    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()'Get the menuhandle of your app
    hMenu& = GetMenu(Form1.hwnd)'Get the handle of the first submenu (Hello)
    hSubMenu& = GetSubMenu(hMenu&, 0)'Get the menuId of the first entry (Bitmap)
    hID& = GetMenuItemID(hSubMenu&, 0)'Add the bitmap
    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 
     
      

  2.   

    虽然说起来是图标
    但不能用图标
    必须用位图(BMP、JPG……)而且最好是 13*13*16色(不是16位!) 的,白色为透明色
    使用 自绘菜单 技术才可以做出漂亮的图标效果我编的自绘菜单:http://zyl910vb.51.net/vb/gui/DrawMenu-S.htm(有注释!特地为想学自绘菜单的人写的)
    http://zyl910vb.51.net/vb/gui/CoolGUI.htm(效果比较好,但没有注释)
    http://zyl910vb.51.net/vb/gui/ZXPMenu.htm(XP风格的菜单)(注意把下载后的*.zip.jpg改名成*.zip)
      

  3.   

    是不是不能用图标。必须用位图?
    我的e_mail:[email protected]
    谢谢!
      

  4.   

    ch21st(风尘鸟) :
    我把我的图标换成你的位图,我的程序就OK了。但有没有办法使程序如VB的界面那样,当鼠标放在菜单上面的时候,只加亮文本,而不使图标也反色,因为这样看起来感觉怪怪的。
      

  5.   

    http://zyl910vb.51.net/vb/gui/DrawMenu-S.htm(有注释!特地为想学自绘菜单的人写的)
    效果不错,可惜太复杂!