| 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 Function xCreateMenu(imgPic As PictureBox, strCaption As String, nIndex1 As Integer, nIndex2 As Integer) Dim hMenu As Long, hSubMenu As Long, lngID As Long Dim iPic As IPictureDisp Dim LineWidth As Integer Dim lColor As Long On Error GoTo Err_xCreateMenu lColor = vbWhite LineWidth = 2 'Get the handle of the form's menu hMenu = GetMenu(Me.hwnd) 'Get the handle of the form's submenu hSubMenu = GetSubMenu(hMenu, nIndex1) 'Change first item (index=0) imgPic.AutoRedraw = True imgPic.AutoSize = True imgPic.Height = 400 imgPic.Width = 2450 Set iPic = imgPic.Picture Set imgPic.Picture = Nothing imgPic.PaintPicture iPic, 40, 40, 240, 240, 0, 0 imgPic.CurrentX = 420 imgPic.CurrentY = 50 imgPic.Height = 360 imgPic.FontBold = True Set imgPic.Font = Me.Font imgPic.Print strCaption imgPic.CurrentX = 0 imgPic.Line (0, LineWidth)-(imgPic.Width, LineWidth), lColor, BF imgPic.Line (0, 0)-(LineWidth, imgPic.Height), lColor, BF Set imgPic.Picture = imgPic.Image lngID = GetMenuItemID(hSubMenu, nIndex2) Call ModifyMenu(hMenu, lngID, MF_BITMAP, lngID, CLng(imgPic.Picture)) Exit Function Err_xCreateMenu: Resume Next End Function 'Picture1,-2,-3 and 4 are PictureBox located on the menu-form, contents are the picture one 'wish to show in the menu. Private Sub Form_Load() xCreateMenu Picture1, "Test Item 1", 0, 0 xCreateMenu Picture2, "Test Item 2", 0, 1 xCreateMenu Picture3, "Test Item 3", 1, 0 xCreateMenu Picture4, "Test Item 4", 1, 1 End Sub |
Simple Image in Menu |
Express News India | Freelance ecommerce web development India