建一个Form,放一个ImageList,里面放2两个BMP文件(从ICO文件转换过来16×16或者32×32,不能用ICO),建主菜单,三个子菜单,每个子菜单含有三个菜单项目。 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 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 DeleteDC Lib "gdi32" (ByVal hdc 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 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 SRCCOPY = &HCC0020 Const MF_BYPOSITION = &H400& Const MF_BITMAP = &H4& Const MF_BYCOMMAND = &H0& Public Function CreateMenuIcon(ByVal hMenuID As Long, ByVal hNormalPictureHandle As Long, ByVal hCheckPictureHandle, ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPosition As Integer) As Long 'hMenuID 子菜单句柄 'hNormalPictureHandle正常状态下位图句柄 'hCheckPictureHandle复选状态下位图句柄 'nWidth图象宽度 'nHeight图象高度 'nPosition显示位图的菜单项的位置,第一个子菜单的第一项为2 Dim lResult As Long lResult = SetMenuItemBitmaps(hMenuID, nPosition, MF_BYPOSITION Or MF_BITMAP Or MF_BYCOMMAND, hNormalPictureHandle, hCheckPictureHandle) End Function Private Sub Form_Load() Dim w As Integer Dim h As Integer Dim r As Long w = ImageList1.ListImages(1).Picture.Width \ Screen.TwipsPerPixelX h = ImageList1.ListImages(1).Picture.Height \ Screen.TwipsPerPixelY r = CreateMenuIcon(GetSubMenu(GetMenu(Me.hwnd), 0), ImageList1.ListImages(1).Picture.Handle, 0, w, h, 0) r = CreateMenuIcon(GetSubMenu(GetMenu(Me.hwnd), 0), ImageList1.ListImages(2).Picture.Handle, 0, w, h, 1) r = CreateMenuIcon(GetSubMenu(GetMenu(Me.hwnd), 1), ImageList1.ListImages(1).Picture.Handle, 0, w, h, 0) End Sub有意思的是,如果你把函数的定义放在模块里的话,原来的 r = CreateMenuIcon(GetSubMenu(GetMenu(Me.hwnd), 0), ImageList1.ListImages(1).Picture.Handle, 0, w, h, 0) 要变成 r = CreateMenuIcon(GetSubMenu(GetMenu(Me.hwnd), 0), ImageList1.ListImages(1).Picture.Handle, 0, w, h, 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 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 DeleteDC Lib "gdi32" (ByVal hdc 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 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 SRCCOPY = &HCC0020
Const MF_BYPOSITION = &H400&
Const MF_BITMAP = &H4&
Const MF_BYCOMMAND = &H0&
Public Function CreateMenuIcon(ByVal hMenuID As Long, ByVal hNormalPictureHandle As Long, ByVal hCheckPictureHandle, ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPosition As Integer) As Long
'hMenuID 子菜单句柄
'hNormalPictureHandle正常状态下位图句柄
'hCheckPictureHandle复选状态下位图句柄
'nWidth图象宽度
'nHeight图象高度
'nPosition显示位图的菜单项的位置,第一个子菜单的第一项为2
Dim lResult As Long
lResult = SetMenuItemBitmaps(hMenuID, nPosition, MF_BYPOSITION Or MF_BITMAP Or MF_BYCOMMAND, hNormalPictureHandle, hCheckPictureHandle)
End Function
Private Sub Form_Load()
Dim w As Integer
Dim h As Integer
Dim r As Long
w = ImageList1.ListImages(1).Picture.Width \ Screen.TwipsPerPixelX
h = ImageList1.ListImages(1).Picture.Height \ Screen.TwipsPerPixelY
r = CreateMenuIcon(GetSubMenu(GetMenu(Me.hwnd), 0), ImageList1.ListImages(1).Picture.Handle, 0, w, h, 0)
r = CreateMenuIcon(GetSubMenu(GetMenu(Me.hwnd), 0), ImageList1.ListImages(2).Picture.Handle, 0, w, h, 1)
r = CreateMenuIcon(GetSubMenu(GetMenu(Me.hwnd), 1), ImageList1.ListImages(1).Picture.Handle, 0, w, h, 0)
End Sub有意思的是,如果你把函数的定义放在模块里的话,原来的
r = CreateMenuIcon(GetSubMenu(GetMenu(Me.hwnd), 0), ImageList1.ListImages(1).Picture.Handle, 0, w, h, 0)
要变成
r = CreateMenuIcon(GetSubMenu(GetMenu(Me.hwnd), 0), ImageList1.ListImages(1).Picture.Handle, 0, w, h, 2)
才是正确位置