Option Explicit
Private oIconUp As IPictureDisp, oIconDown As IPictureDisp
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 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 DrawMenuBar Lib ``user32`` (ByVal hwnd As Long) As Long
Function FormMenuSetIcon(frmMenu As Form, lSubItem As Long, lMenuItem As Long, oPicChecked As IPictureDisp, oPicUnchecked As IPictureDisp) As Boolean
Const MF_BYCOMMAND = &H0&
Dim lhwndMenu As Long, lhwndSubMenu As Long, lhwndMenuItem As Long
'Lấy handle của menu
lhwndMenu = GetMenu(frmMenu.hwnd)
'Lấy handle của sub menu
lhwndSubMenu = GetSubMenu(lhwndMenu, lSubItem)
'Lấy handle của mục menu
lhwndMenuItem = GetMenuItemID(lhwndSubMenu, lMenuItem)
If lhwndMenuItem Then
'Nếu form có một sub menu
FormMenuSetIcon = CBool(SetMenuItemBitmaps(lhwndMenu, lhwndMenuItem, MF_BYCOMMAND, oPicChecked.Handle, oPicUnchecked.Handle))
If FormMenuSetIcon Then
'Nếu thêm thành công, vẽ lại menu
Call DrawMenuBar(lhwndMenu)
End If
End If
End Function
'Hàm để thử nghiệm
Sub Test()
'Nạp 2 hình để hiển thị mục menu được check và uncheck
Set oIconUp = LoadPicture(``C:\Calendar.bmp``)' Bạn chọn 2 hình bitmap hoặc icon (13x13)
Set oIconDown = LoadPicture(``C:\Camcord.bmp``)
'Thêm hình vào mục đầu tiên trên mục con menu đầu tiên
Add the bitmap to the first item on the first sub menu
Debug.Print FormMenuSetIcon(Me, 0&, 0&, oIconUp, oIconDown)
'Thêm hình vào mục thứ hai trên mục con menu đầu tiên
Debug.Print FormMenuSetIcon(Me, 0&, 1&, oIconUp, oIconDown)
End Sub