VB菜单的问题

Question

1.用ActiveBar等控件.
2.用API.

Answer 1

 用API函数   getmenu() ,getsubmenu() ,setmenuitembitmaps() 可以搞定

Answer 2

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 GetMenuItemID 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
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, 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) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongConst SRCCOPY = &HCC0020
Const MF_BITMAP = &H4&
Const MF_BYPOSITION = &H400&Private Sub Form_Load()
    Dim nLoopCtr As Integer
    Dim lResult As Long
    Dim hTempDC As Long
    Dim nWidth As Long
    Dim nHeight As Long
    Dim lTempID As Long
    Dim hMenuID As Long
    Dim lItemCount As Long
    Dim hBitmap As Long
    
    
    nWidth = Pic.Width \ Screen.TwipsPerPixelX
    nHeight = Pic.Height \ Screen.TwipsPerPixelY
    hMenuID = GetSubMenu(GetMenu(Me.hwnd), 0)
    hTempDC = CreateCompatibleDC(Pic.hdc)
    For i = 0 To 1
        hBitmap = CreateCompatibleBitmap(Pic.hdc, nWidth, nHeight)
        lTempID = SelectObject(hTempDC, hBitmap)
        lResult = BitBlt(hTempDC, 0, 0, nWidth, nHeight, Pic.hdc, 0, 0, SRCCOPY)
        lTempID = SelectObject(hTempDC, lTempID)
        M_Item1(i).Caption = ""
        lResult = ModifyMenu(hMenuID, i, MF_BYPOSITION Or MF_BITMAP, GetMenuItemID(hMenuID, i), hBitmap)
    Next i
    lResult = DeleteDC(hTempDC)
End Sub

Answer 3

'menu bitmap 给菜单加位图
    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
    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 Const MF_BYCOMMAND = &H0&
    Private Const MF_BYPOSITION = &H400&Private Sub Form_Load()    Dim lngMenuHwnd As Long
    
    lngMenuHwnd = GetMenu(Me.hWnd)
    Dim lngSubMenuHwnd As Long
    lngSubMenuHwnd = GetSubMenu(lngMenuHwnd, 0)
    
    SetMenuItemBitmaps lngSubMenuHwnd, 0, MF_BYPOSITION, ImageList1.ListImages(1).Picture.Handle, 0
    SetMenuItemBitmaps lngSubMenuHwnd, 1, MF_BYPOSITION, ImageList1.ListImages(2).Picture.Handle, 0
   ' SetMenuItemBitmapsEnd Sub

Answer 4

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 

Answer 5

声明：
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