Solved

Adding Icons to Toolbar Button Menus

Posted on 2002-07-15
16
1,274 Views
Last Modified: 2008-03-17
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!
0
Comment
Question by:mdougan
  • 7
  • 6
  • 3
16 Comments
 
LVL 20

Expert Comment

by:hes
ID: 7155144
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
 
LVL 18

Author Comment

by:mdougan
ID: 7155328
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
 
LVL 20

Accepted Solution

by:
hes earned 200 total points
ID: 7155424
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
 
LVL 18

Author Comment

by:mdougan
ID: 7155550
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
 
LVL 15

Expert Comment

by:ameba
ID: 7155962
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
 
LVL 18

Author Comment

by:mdougan
ID: 7156910
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
 
LVL 15

Expert Comment

by:ameba
ID: 7156975
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
 
LVL 18

Author Comment

by:mdougan
ID: 7157030
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
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 15

Expert Comment

by:ameba
ID: 7157175
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
 
LVL 15

Expert Comment

by:ameba
ID: 7157353
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
 
LVL 15

Expert Comment

by:ameba
ID: 7157424
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
 
LVL 15

Expert Comment

by:ameba
ID: 7157470
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
 
LVL 18

Author Comment

by:mdougan
ID: 7157892
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
 
LVL 18

Author Comment

by:mdougan
ID: 7157899
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
 
LVL 15

Expert Comment

by:ameba
ID: 7158090
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
 
LVL 20

Expert Comment

by:hes
ID: 7158212
Thanks,
Glad I could have helped a little at least :)
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now