图片代替菜单

'Download the full source+pictures+.. at http://www.allapi.net/php/dlman/dm.cgi?id=bitmenu.zip&action=download
Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long
Const MF_BITMAP = 4
Const MF_CHECKED = 8
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: http://www.allapi.net/
    'E-Mail: [email protected]
    Dim hMenu As Long, hSubMenu As Long, lngID As Long    'Get the handle of the form's menu
    hMenu = GetMenu(Me.hWnd)
    'Get the handle of the form's submenu
    hSubMenu = GetSubMenu(hMenu, 0)    'Change first item (index=0)
    picBitmaps(0).Picture = picBitmaps(0).Image
    lngID = GetMenuItemID(hSubMenu, 0)
    Call ModifyMenu(hMenu, lngID, MF_BITMAP, lngID, CLng(picBitmaps(0).Picture))    'Change second item (index=1)
    picBitmaps(1).Picture = picBitmaps(1).Image
    lngID = GetMenuItemID(hSubMenu, 1)
    Call ModifyMenu(hMenu, lngID, MF_BITMAP, lngID, CLng(picBitmaps(1).Picture))    'Change third item (index=2)
    picBitmaps(2).Picture = picBitmaps(2).Image
    lngID = GetMenuItemID(hSubMenu, 2)
    Call ModifyMenu(hMenu, lngID, MF_BITMAP, lngID, CLng(picBitmaps(2).Picture))    mnuBitmap1.Checked = True
End Sub
Private Sub mnuBitmap1_Click()
    mnuBitmap1.Checked = Not mnuBitmap1.Checked
End Sub
Private Sub mnuBitmapEnd_Click()
    End
End Sub

解决方案 »

  1.   

    dsclub你好!http://www.allapi.net/php/dlman/dm.cgi?id=bitmenu.zip&action=download的地址不能用.
      

  2.   

    在模组中加入以下程序码：Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As LongDeclare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongDeclare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongDeclare 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 LongPublic 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 TypeDeclare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As LongDeclare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _
    ByVal b As Boolean, lpMenuItemInfo As MENUITEMINFO) As BooleanPublic Const MIIM_ID = &H2
    Public Const MIIM_TYPE = &H10
    Public Const MFT_STRING = &H0&在 Form 中加入一个 PictureBox，属性设定为：
    AutoSize = True
    Picture = .bmp (尺寸大小为 13x13，不可设定为 .ico)在 Form_Load 中的程序码如下：Private Sub Form_Load()
    '取得程序中 Mennu 的 handle
    hMenu& = GetMenu(Form1.hWnd)
    '取得第一个 submenu 的 handle
    hSubMenu& = GetSubMenu(hMenu&, 0)
    '取得 Submenu 第一个选项的 menuId
    hID& = GetMenuItemID(hSubMenu&, 0)
    '加入图片
    SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP, Picture1.Picture, Picture1.Picture
    '在一个 Menu 选项中您一共可以加入二张图片
    '一张是 checked 状态用，一张是 unchecked 状态用
    End Sub
      

  3.   

    Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetMenutiemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
    Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
    Private Declare Function ModifyMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewITen As Long, ByVal IpString As Any) As Long
    Private Const MF_BITMAP = &H4&
    Private Const MF_BYPOSITION = &H400&
    Private Const STRCCOPY = &HCC0020Private Sub Form_Load()
    Dim lResult As Long
    Dim hMenuID As Long
    Dim hBitmap As Long
    hMenuID = GetSubMenu(GetMenu(Me.hwnd), 1)
    hBitmap = ImageList1.ListImages(1).Picture
    lResult = ModifyMenu(hMenuID, 0, MF_BYPOSITION Or MF_BITMAP, GetMenutiemID(hMenuID, 0), hBitmap)
    hBitmap = ImageList1.ListImages(2).Picture
    lResult = ModifyMenu(hMenuID, 1, MF_BYPOSITION Or MF_BITMAP, GetMenutiemID(hMenuID, 1), hBitmap)
    hBitmap = ImageList1.ListImages(3).Picture
    lResult = ModifyMenu(hMenuID, 2, MF_BYPOSITION Or MF_BITMAP, GetMenutiemID(hMenuID, 2), hBitmap)
    hBitmap = ImageList1.ListImages(4).Picture
    lResult = ModifyMenu(hMenuID, 4, MF_BYPOSITION Or MF_BITMAP, GetMenutiemID(hMenuID, 4), hBitmap)End Sub
      

  4.   

    VB创建位图菜单
     
    在通常的程序中,菜单总是以文本方式存在,显得非常单调乏味。如果能够在菜单中加入位图图形,将会极大地增加用户的使用兴趣。本文介绍如何使用位图制作菜单选项。 创建位图菜单 创建位图菜单其实非常简单,需要用到Windows应用程序编程接口(API)的一些菜单函数和位图函数,将这些函数的声明包含在应用程序的标准模块中,具体的内容请参见样例程序。步骤如下: 1.使用函数GetSubMenu来提取子菜单项的句柄,并通过使用函数CreateCompati bleDC来创建一个兼容的设备环境描述表; 2.在一个循环过程中通过使用CreateCompatibleBitmap函数、SelectObject函数以及 BitBlt函数来分别将各个菜单项所载入的位图选入到兼容设备环境中; 3.通过ModifyMenu函数绘制真正的位图菜单选项; 4.使用DeleteDC函数来释放设备环境,以便其他的程序可以使用它们。 提取位图可以有多种方法,在本样例程序中在窗体上设置了四个图形框控件,使用它们载入4个预设的图标来作为菜单选项位图的源文件。当然也可以使用其他的方法,例如使用 LoadPicture函数来从磁盘装载位图。 样例程序 1. 在Visual Basic中开始一个新项目工程(project),用缺省的方法建立Form1。 2. 创建一个新的模块,采用缺省的方法建立Module1.Bas。 3. 将如下声明语句和常量添加到Module1.Bas模块中: Option Explicit 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, ByValnP os As Long) As Long Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItemAs L ong, ByVal lpString As Any) As Long Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) AsLon g Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, B yVal nWidth As Long, ByVal nHeight As Long) As Long Declare Function SelectObject Lib "gdi32"(ByVal hdc As Long, ByVal hObjec t As Long) As Long Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x AsLon g, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) AsLong Public Const SRCCOPY = &HCC0020 Public Const MF_BYPOSITION = &H400& Public Const MF_BITMAP = &H4& 注意:上面的声明语句需要书写在一行内。 4. 在Form1上添加4个图形框控件,Name属性设置为Picture1,Index属性依次设 置为0、1、2、 3,AutoRedrew属性设置为True,AutoResize属性设置为Ture,Visable 属性设置为False。 5. 将上面的4个图形框控件的Picture属性依次设置为Face1.ico、Face2.ico、 Face3.ico、Face4.ico。 6. 在Form1上添加第一个菜单项,将它的标题设置为"[&F]文件",名称设置 为mnuFile。在其下添加一个子菜单项,将它的标题设置为"[&E]退出",名称设置为mn uExit。 7. 在Form1上添加第二个菜单项,将它的标题设置为"[&A]脸谱",名称设置 为mnuFace。在其下添加4个子菜单项,分别将改4个子菜单项的名称设置为"[N]正常" 、"[&S]微笑"、" [&L]大笑"、以及"[&O]悲伤"。将它们的名称设置为"mnuFaceSel",并相应将这4个子菜单项的索引设置为0、1、2、3。 8.将如下代码添加到Form1的Form_Load事件中: Private Sub Form_Load() Dim nLoopCtr As Integer Dim lResult As Long Dim hTempDC As Long Dim nWidth As Integer Dim nHeight As Integer Dim lTempID As Long Dim hMenuID As Long Dim lItemCount As Long Dim hBitmap As Long nWidth = Picture1(nLoopCtr).Width\Screen.TwipsPerPixelX nHeight = Picture1(nLoopCtr).Height\Screen.TwipsPerPixelY hMenuID = GetSubMenu(GetMenu((Me.hwnd)), 1) hTempDC = CreateCompatibleDC(Picture1(nLoopCtr).hdc) For nLoopCtr = 0 To 3 hBitmap = CreateCompatibleBitmap(Picture1(nLoopCtr).hdc, nWidth, nHeight) lTempID = SelectObject(hTempDC, hBitmap) lResult = BitBlt(hTempDC, 0, 0, nWidth, nHeight, (Picture1(nLoopCtr).hdc) , 0, 0, SRCCOPY) lTempID = SelectObject(hTempDC, lTempID) mnuFaceSel(nLoopCtr).Caption = "" lResult = ModifyMenu(hMenuID, nLoopCtr, MF_BYPOSITION Or MF_BITMAP, GetMe nuItemID(hMenuID, nLoopCtr), hBitmap) Next nLoopCtr lResult = DeleteDC(hTempDC) End Sub 9.将如下的代码添加到"退出"子菜单的单击事件中: Private Sub mnuExit_Click(Index As Integer) Select Case Index Case 0 Unload Me End Select End Sub 运行该样例程序,单击"脸谱"菜单,则会看到由4个脸谱图标所形成的位图子菜单项,如下图所示;单击"文件"\"退出"菜单可退出应用程序。   
      

  5.   

    这个问题没什么好关注的·
    位图菜单其实看久了就会发现它更加不好看！
    要好看的只要在菜单前面加一个图标！
    就象WIN98的“文档‘菜单那样！
      

  6.   

    Option Explicit 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, ByValnP os As Long) As Long Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItemAs L ong, ByVal lpString As Any) As Long Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) AsLon g Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, B yVal nWidth As Long, ByVal nHeight As Long) As Long Declare Function SelectObject Lib "gdi32"(ByVal hdc As Long, ByVal hObjec t As Long) As Long Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x AsLon g, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) AsLong Public Const SRCCOPY = &HCC0020 Public Const MF_BYPOSITION = &H400& Public Const MF_BITMAP = &H4& 注意:上面的声明语句需要书写在一行内。 4. 在Form1上添加4个图形框控件,Name属性设置为Picture1,Index属性依次设 置为0、1、2、 3,AutoRedrew属性设置为True,AutoResize属性设置为Ture,Visable 属性设置为False。 5. 将上面的4个图形框控件的Picture属性依次设置为Face1.ico、Face2.ico、 Face3.ico、Face4.ico。 6. 在Form1上添加第一个菜单项,将它的标题设置为"[&F]文件",名称设置 为mnuFile。在其下添加一个子菜单项,将它的标题设置为"[&E]退出",名称设置为mn uExit。 7. 在Form1上添加第二个菜单项,将它的标题设置为"[&A]脸谱",名称设置 为mnuFace。在其下添加4个子菜单项,分别将改4个子菜单项的名称设置为"[N]正常" 、"[&S]微笑"、" [&L]大笑"、以及"[&O]悲伤"。将它们的名称设置为"mnuFaceSel",并相应将这4个子菜单项的索引设置为0、1、2、3。 8.将如下代码添加到Form1的Form_Load事件中: Private Sub Form_Load() Dim nLoopCtr As Integer Dim lResult As Long Dim hTempDC As Long Dim nWidth As Integer Dim nHeight As Integer Dim lTempID As Long Dim hMenuID As Long Dim lItemCount As Long Dim hBitmap As Long nWidth = Picture1(nLoopCtr).Width\Screen.TwipsPerPixelX nHeight = Picture1(nLoopCtr).Height\Screen.TwipsPerPixelY hMenuID = GetSubMenu(GetMenu((Me.hwnd)), 1) hTempDC = CreateCompatibleDC(Picture1(nLoopCtr).hdc) For nLoopCtr = 0 To 3 hBitmap = CreateCompatibleBitmap(Picture1(nLoopCtr).hdc, nWidth, nHeight) lTempID = SelectObject(hTempDC, hBitmap) lResult = BitBlt(hTempDC, 0, 0, nWidth, nHeight, (Picture1(nLoopCtr).hdc) , 0, 0, SRCCOPY) lTempID = SelectObject(hTempDC, lTempID) mnuFaceSel(nLoopCtr).Caption = "" lResult = ModifyMenu(hMenuID, nLoopCtr, MF_BYPOSITION Or MF_BITMAP, GetMe nuItemID(hMenuID, nLoopCtr), hBitmap) Next nLoopCtr lResult = DeleteDC(hTempDC) End Sub 9.将如下的代码添加到"退出"子菜单的单击事件中: Private Sub mnuExit_Click(Index As Integer) Select Case Index Case 0 Unload Me End Select End Sub