Adding Icons to Toolbar Button Menus

My application uses a standard VB toolbar.  I've defined a button menu for the "New" toolbar item, so that when you click on the down-arrow you get a menu with names for the different objects you can create.  However, in the Button Menu section of the toolbar, you cannot set an icon for the menu items.  Does anybody know how to add icons for the menu items under a button menu?

I'd like it to work like the toolbar in Outlook.

Thanks!
LVL 18
mdouganAsked:
Who is Participating?
 
hesConnect With a Mentor Commented:
See this discussion about that, If you can't get to the link I will post what was discussed

http://www.codehound.com/groups/default.asp?t=1,23,1,1_6bb87.137822$Do6.6391446@nnrp4.clara.net_23
0
 
hesCommented:
Add an imagelist control to your project.
In your toolbar set the(General Tab) ImageList to the name of that control.
In the ImageList properties add the images you want to use
then (using name ToolBar1)
Toolbar1.Buttons(1).Image = 1
This sets Button(1) to the first image in the ImageList.
0
 
mdouganAuthor Commented:
Thanks hes, but I know how to add images to the Buttons.  But my problem is that one of my buttons has a property of Drop-Down List, and so at the bottom of the button dialog, I've added 3 ButtonMenu items.  The only properties you can set for the ButtonMenu items is the Text, Key, Tag, Visible and Enabled properties.  There is no Image Index property for a ButtonMenu item.

I know that I've seen examples for getting an icon to display, even in a regular menu, using some windows API calls, So, I was hoping someone had worked out a solution using the standard toolbar.
0
The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

 
mdouganAuthor Commented:
This is very close to what I need.  All I need now is the code to display the bitmap in the menu item.

I tried to get the SetMenuItemBitmaps, without too much luck yet.  The things that are still fuzzy, are:

If hWnd is a handle to the "New" button on my toolbar, am I supposed to be able to get the menu handles of the ButtonMenu items using GetSubMenu?

Assuming that my ButtonMenu Items are New Customer, New Instruction, New Contact, would the index in the SetMenuItemBitmaps be 1,2,3 (or 0,1,2)

And, can I reference the icons in my imagelist?  Or do I have to load them in from a picturebox?

If you can help get this last bit to work, I'll double the points

' New toolbar child window procedure
Private Function TlbProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim hSubMenu As Long
    Select Case Msg
        Case WM_INITMENUPOPUP
            hSubMenu = GetSubMenu(hWnd, 0)
            Call SetMenuItemBitmaps(hSubMenu, 1, MF_BYPOSITION, frmMain.imlToolbarIcons.ListImages(3).Picture, 0)
           
    End Select
   
    TlbProc = CallWindowProc(hOldTlbProc, hWnd, Msg, wParam, lParam)
   
End Function
0
 
amebaCommented:
Hi,
I don't show pictures in menus.  The required work is not proportional to gains in usability.  Such cool little things only make maintenance problems.  I had to say this  :-)

Instead of using toolbar's ButtonMenus, show your own popup menu.
The advantage is: - you can get menu handles of your menu, and - you can set default menu (bold)

To show a bitmap, there are different methods, e.g. http://www.vbaccelerator.com/codelib/cpopmenu/article.htm is nice, but SetMenuItemBitmaps is easier.

Notes on SetMenuItemBitmaps:

For SetMenuItemBitmaps to work, menu must be visible.

If either the hBitmapUnchecked or hBitmapChecked parameter is NULL, the system displays nothing next to the menu item for the corresponding check state. If both parameters are NULL, the system displays the default check-mark bitmap when the item is checked, and removes the bitmap when the item is not checked.

When the menu is destroyed, these bitmaps are not destroyed; it is up to the application to destroy them.

The checked and unchecked bitmaps should be monochrome. The system uses the Boolean AND operator to combine bitmaps with the menu so that the white part becomes transparent and the black part becomes the menu-item color. If you use color bitmaps, the results may be undesirable.

Use the GetSystemMetrics function with the CXMENUCHECK and CYMENUCHECK values to retrieve the bitmap dimensions.
(sample creates 13*13 pixels bitmap)

' Form1, add toolbar ----------------------------------------------
Option Explicit

Private Sub Form_Load()
    Call Me.Toolbar1.Buttons.Add(, "pop", "New", tbrDropdown) ' or, add button at design time
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    If Button.Key = "pop" Then
        MsgBox "NewCustomer"
    End If
End Sub

Private Sub Toolbar1_ButtonDropDown(ByVal Button As MSComctlLib.Button)
    Dim strSelection As String
   
    If Button.Key = "pop" Then
        Load frmPopupMenus
        With frmPopupMenus
            PopupMenu .mnuPop, , Button.Left, _
                Button.Top + Button.Height + 1 * Screen.TwipsPerPixelY, _
                .mnuP1
            strSelection = .Selection
        End With
        Unload frmPopupMenus

        Select Case strSelection
        Case "NewCustomer"
            MsgBox "NewCustomer"
        Case "NewProduct"
            Beep
        End Select
    End If
End Sub


' frmPopupMenus -------------------------------------------------------
' add 2 pictureboxes, and menu:
'      mnuPop "mnuPop"
'          mnuP1 "New &Customer"
'          mnuP2 "New &Product"
Option Explicit
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 Const MF_BITMAP = &H4&
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private m_Selection As String
Private hBitmaps(0 To 1) As Long

Private Sub Form_Unload(Cancel As Integer)
    ' delete used bitmap handles
    DeleteObject hBitmaps(0)
    DeleteObject hBitmaps(1)
End Sub

Private Sub Form_Load()
    'set 13*13 pixels bitmaps at design time (white areas will be transparent)
    Picture1.AutoRedraw = True
    Picture1.PaintPicture Icon, 0, 0, 13 * 15, 13 * 15, 60, 90, 13 * 15, 13 * 15
    Set Picture1.Picture = Picture1.Image
    Set Picture2.Picture = Picture1.Picture
   
    Dim HndMenu As Long, HndSubMenu As Long, HndSubMenuID1 As Long
   
    HndMenu = GetMenu(Me.hwnd)          ' Get the menu handle for the current form
    HndSubMenu = GetSubMenu(HndMenu, 0) ' handle for our mnuPop submenu
   
    ' "New Customer"
    HndSubMenuID1 = GetMenuItemID(HndSubMenu, 0)
    hBitmaps(0) = SetMenuItemBitmaps(HndMenu, HndSubMenuID1, MF_BITMAP, Me.Picture1.Picture, Me.Picture1.Picture)
   
    ' "New Product"
    HndSubMenuID1 = GetMenuItemID(HndSubMenu, 1)
    hBitmaps(1) = SetMenuItemBitmaps(HndMenu, HndSubMenuID1, MF_BITMAP, Me.Picture2.Picture, Me.Picture2.Picture)

    m_Selection = ""
End Sub

Public Property Get Selection() As String
    Selection = m_Selection
End Property

Private Sub mnuP1_Click()
    m_Selection = "NewCustomer"
End Sub
Private Sub mnuP2_Click()
    m_Selection = "NewProduct"
End Sub
0
 
mdouganAuthor Commented:
Ameba, I have to admit, displaying the menu of another form, and then adding the bitmaps to it is way too complicated for the value added.

I see some differences that you are doing with the SetMenuItemBitmaps, so, I'll try those changes to my code and let you know.

Overall, I would agree, it's better to leave out the "fluff", but since Outlook has these icons in it's dropdown tool bar menus, it might be nice to stay consistent.
0
 
amebaCommented:
That is how I do the popups - all popups are on one separate form, it is standard way for me, since I normally reuse popups.  I agree it's too much for one usage.

I tried getting menu handle of ButtonMenus, but it didn't work.

If popup menu is on the same form as a menu with Visible property set to False, SetMenuItemBitmaps won't work.

What you can try, is put it in normal menu and make it visible:

  mnuFile
      "&Open"  <mnuFOpen>
      -        <mnuFSeparator>
      "&New"   <mnuPop>         ' - your popup menu
              "New &Custormer"
              "New &This"
              "New &That"
      -  <mnuFSeparator2>
      "E&xit"  <mnuFExit>
0
 
mdouganAuthor Commented:
Thanks, I'd like to not create a menu for the form if there is any other way around it.  The link to the codehound article made it sound like there is a way to get the image in the ButtonMenu items, but they didn't show the code for that.  I'll hold out a little longer, and then I may abandon the idea :)
0
 
amebaCommented:
I'll check their GetTlbMenuHookHandle() function, and try it, but, when I see Hook, UnHook, and subclassing (=problematic debugging), that's enough to discourage me.  :-)
0
 
amebaCommented:
That code seems to work... but if you use it, don't blame hes or me for GPFs  :)

' Form1, add toolbar  -----------------------------------------------
'   add 2 pictureboxes, set their pictures to 13*13 bitmap
'   - in TlbProc, we use Form1.Picture1.Picture and Form1.Picture2.Picture
Option Explicit

Private Sub Form_Load()
    ' do this at design time
    Call Toolbar1.Buttons.Add(, "pop", "New", tbrDropdown)
    With Toolbar1.Buttons("pop").ButtonMenus
        .Clear
        .Add , , "New Customer"
        .Add , , "New Contact"
    End With
    '----------------------------------
    HookToolbarDropMenus Toolbar1
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHookToolbarDropMenus Toolbar1
End Sub

Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
    Beep
End Sub


' module1 -----------------------------------------------------------------
Option Explicit
Private hOldTlbProc As Long 'Old toolbar child window procedure
Private Const WM_INITMENUPOPUP = &H117
Private Const GWL_WNDPROC = (-4)
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam 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 Const MF_BITMAP = &H4&
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Dim hBitmaps(0 To 1) As Long ' bitmap handles

'Finds a child window which handles dropdown menus
Public Function GetTlbMenuHookHandle(tb As Toolbar) As Long
    GetTlbMenuHookHandle = FindWindowEx(tb.hWnd, 0&, "msvb_lib_toolbar", vbNullString)
End Function

' Hook toolbar
Public Sub HookToolbarDropMenus(tb As Toolbar)
    Dim hWndChild As Long
    hWndChild = GetTlbMenuHookHandle(tb)
    hOldTlbProc = SetWindowLong(hWndChild, GWL_WNDPROC, AddressOf TlbProc)
End Sub

Public Sub UnHookToolbarDropMenus(tb As Toolbar)
    Dim hWndChild As Long
    If hOldTlbProc > 0 Then
        hWndChild = GetTlbMenuHookHandle(tb)    ' Obtain child window Handle
        Call SetWindowLong(hWndChild, GWL_WNDPROC, hOldTlbProc)
       
        ' delete bitmap handles
        DeleteObject hBitmaps(0)
        DeleteObject hBitmaps(1)
    End If
End Sub

' New toolbar child window procedure
Private Function TlbProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim i As Long, HndSubMenu As Long, HndSubMenuID1 As Long
   
    Select Case Msg
    Case WM_INITMENUPOPUP
        ' delete bitmap handles
        DeleteObject hBitmaps(0)
        DeleteObject hBitmaps(1)
       
        HndSubMenu = wParam ' menu handle
       
        ' "New Customer"
        HndSubMenuID1 = GetMenuItemID(HndSubMenu, 0)
        hBitmaps(0) = SetMenuItemBitmaps(HndSubMenu, HndSubMenuID1, MF_BITMAP, Form1.Picture1.Picture, Form1.Picture1.Picture)
       
        ' "New Product"
        HndSubMenuID1 = GetMenuItemID(HndSubMenu, 1)
        hBitmaps(1) = SetMenuItemBitmaps(HndSubMenu, HndSubMenuID1, MF_BITMAP, Form1.Picture2.Picture, Form1.Picture2.Picture)

    End Select

    TlbProc = CallWindowProc(hOldTlbProc, hWnd, Msg, wParam, lParam)
End Function
0
 
amebaCommented:
Two small changes:
1. to avoid reference to Form1, use array:  Public pPics(0 To 1) As StdPicture
2. delete bitmap handles in one place (on WM_EXITMENULOOP), instead of two places


In Form_Load, add:  --------------------------------
    Set pPics(0) = Me.Picture1.Picture
    Set pPics(1) = Me.Picture2.Picture


in module1, add:

' in declarations -----------------------------------
Public pPics(0 To 1) As StdPicture
Private Const WM_EXITMENULOOP = &H212


' new version of TlbProc ----------------------------

' New toolbar child window procedure
Private Function TlbProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim i As Long, HndSubMenu As Long, HndSubMenuID1 As Long
   
    Select Case Msg
    Case WM_INITMENUPOPUP
        HndSubMenu = wParam ' menu handle
       
        ' "New Customer"
        HndSubMenuID1 = GetMenuItemID(HndSubMenu, 0)
        hBitmaps(0) = SetMenuItemBitmaps(HndSubMenu, HndSubMenuID1, MF_BITMAP, pPics(0), pPics(0))
       
        ' "New Product"
        HndSubMenuID1 = GetMenuItemID(HndSubMenu, 1)
        hBitmaps(1) = SetMenuItemBitmaps(HndSubMenu, HndSubMenuID1, MF_BITMAP, pPics(1), pPics(1))

    Case WM_EXITMENULOOP
        ' delete bitmap handles
        DeleteObject hBitmaps(0)
        DeleteObject hBitmaps(1)
   
    End Select

    TlbProc = CallWindowProc(hOldTlbProc, hWnd, Msg, wParam, lParam)
End Function
0
 
amebaCommented:
Maybe you could also handle WM_MENUSELECT msg, and show help text in statusbar:
http://www.vb2themax.com/Item.asp?PageID=TipBank&ID=179
0
 
mdouganAuthor Commented:
Sweet!  I'll Accept one of you (probably hes for the initial link to the hooking code), and then post a 200 point question for ameba in the same topic area.

Couple of questions though, I tried referencing images (loaded from icons) from an Imagelist on the main form, and they didn't display.  Only when I loaded picture boxes with the original .bmp version of the icons did they appear.  Also, the pics are only 13/13 or smaller, while the icons are 16X16.  I'd like to keep the original 16X16 size if possible.  Is the size fixed at 13X13?  Also, do they have to be BW images or can it support color?  I'm looking at the VB IDE and Outlook and they both seem to have 16X16 color.

I agree, that the hooking is pretty nasty, and this may not be worth the GPFs, but since I've been putting the DeleteObjects in the correct places, I haven't had a problem.  So, I won't blame anyone :)
0
 
mdouganAuthor Commented:
Thanks to both.  You proved it could be done, now, SHOULD it be done is another question.... :)

ameba, your points are here:

http://www.experts-exchange.com/jsp/qManageQuestion.jsp?ta=visualbasic&qid=20324064
0
 
amebaCommented:
They do not have to be BW pictures.  Pictures will be inverted when highlighted, and inverted color pictures don't look too good.  That is the only problem with colors.
Gray looks OK when inverted.

It's 13*13 pixels because we are just changing checkmark bitmap.
'Real' menus are measuring and drawing *everything* (OWNER_DRAW style), and can set bigger pictures, but it is too complex and samples I have seen, do not draw everything 100% correctly.

I'm not sure why it doesn't work for icons, maybe MF_BITMAP can be replaced with some other constant, but I don't see MF_ICON in APIviewer.  I'll check.

Thanks for the points!
0
 
hesCommented:
Thanks,
Glad I could have helped a little at least :)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.