Menu-bitmaps

Hello !

I have make this sub work to put bitmaps in my menu but the caption is gone and the bitmap is not in the left margin of the menu. I dont want to call this sub every time i change the caption in a menu. I like it to look like Office 97 menustyle.

How to solve that ???


Sub BmpToMenu()
Dim ctr As Control, hSubMenu&, hMenu&, menuId&, L&, lPic&, LPos&
Const MF_BITMAP = 4, CLR_MENUBAR = &H80000004

    With frmMain
        For Each ctr In .Controls
            If TypeOf ctr Is Menu Then
                Select Case ctr.Name
                    Case "mnuNytt"
                        lPic& = .imlIcons(0).ListImages(2).Picture: LPos& = 2
                    Case Else: GoTo NextMnu
                End Select
                hMenu = GetMenu(.hWnd)
                hSubMenu = GetSubMenu(hMenu, 0)
                menuId& = GetMenuItemID(hSubMenu, LPos&)
                Call ModifyMenu(hMenu, menuId&, MF_BITMAP, menuId&, lPic&)
                L& = SetMenuItemBitmaps(hMenu&, LPos&, 0, 0, lPic&)
            End If
            DoEvents
NextMnu:
        Next
    End With
End Sub
LVL 1
janneaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

SeanHCommented:
jannea,

The problem with the code above is that SetMenuItemBitmap will place a bitmap in a menu item, and will not show the caption (as you said).

In order to create Office97-style menus, you will need to subclass the window, and owner-draw the menu items.

In order to subclass you will need to create a procedure as below :

Public Function WndProc(hWnd As Long, uMsg As Long, wParam As Long, lParam As Long) As Long

  Select Case uMsg
    Case WM_DRAWITEM
    Case WM_MEASUREITEM
    Case WM_COMMAND
    Case Else
      WndProc = CallWindowProc(lOldProc, hWnd, uMsg, wParam,  
        lParam)
  End Select

End Function

In order to hook the window you will have to do the following :

Public Sub Hook(hWnd As Long)

  lOldProc = SetWindowLong(hWnd, GW_WNDPROC, AddressOf WndProc)

End Sub

and to unhook it you must call the following procedure

Public Sub UnHook()

  SetWindowLong(hWnd, GW_WNDPROC, lOldProc)

End Sub

Once you have called Hook with the hWnd of your form, and before you call Unhook, you must NOT enter debugging mode or else VB will crash. Save often.

What you can now do is start owner drawing the menus. You will have to set them to owner draw using SetMenuItemInfo. Once that is done, your WndProc will receive messages for the menu item. You will have to investigate the messages WM_MEASUREITEM (to set the size of the menu item), WM_DRAWITEM (to draw the menu item) and WM_COMMAND (for when the menu item is clicked). I'm afraid that to explain the complexities of this would take me hours to type. A good investment would be to read the MSDN articles on these.

In WM_DRAWITEM you will use the DRAWITEMINFO structure passed to you (in wParam I think) to draw on the menu item itself. Here you will check to see if the item is selected (checking the ODS_SELECTED flag in the DRAWITEMINFO structure) to see if you must draw the raised border or not. Use BitBlt to draw the icon onto the menuitem, and use DrawText or TextOutEx to draw the caption onto the menu item.

If you wan you can also trap for the WM_SELECTED message and use this to show status bar text when the mouse moves over the menu item.

HTH.

Sean Hederman
0
janneaAuthor Commented:
Thanks Sean,

I guess your answer is OK, but I am afraid it´s like latin for me.
I don´t know how to do write the code to make this work.
Can´t you please rewrite my sample code instead.

/Janne
0
janneaAuthor Commented:
Are you still there Sean ???
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

DalinCommented:
jannea,
I have a sample Program. If you like, I can e-mail to you. My E-mail: Dalin_N@MailExcite.Com
0
janneaAuthor Commented:
Dalin,

Have you recived my mail ?

/Janne
0
DalinCommented:
Janne,
I thought I send you the project...
0
DalinCommented:
Jannea,

Try this. If you have any more problems, please let me know
Regards
Dalin

add the code to the general declaration area:
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


Add these code to where you want to add the bitmap (within the form).

 Dim hMenu As Long, hSubMenu As Long, lngID As Long

   
    hMenu = GetMenu(Me.hWnd)
    hSubMenu = GetSubMenu(hMenu, 0)
 
    picBitmaps(1).Picture = picBitmaps(1).Image
    lngID = GetMenuItemID(hSubMenu, 1)
    Call ModifyMenu(hMenu, lngID, MF_BITMAP, lngID, CLng(picBitmaps(1).Picture))
   
   
    picBitmaps(2).Picture = picBitmaps(2).Image
    lngID = GetMenuItemID(hSubMenu, 2)
    Call ModifyMenu(hMenu, lngID, MF_BITMAP, lngID, CLng(picBitmaps(2).Picture))

   
    picBitmaps(0).Picture = picBitmaps(0).Image
    lngID = GetMenuItemID(hSubMenu, 0)
    Call ModifyMenu(hMenu, lngID, MF_BITMAP, lngID, CLng(picBitmaps(0).Picture))

0
janneaAuthor Commented:
Yes! you did, but after that I did send you a mail with some questions. I guess you have recive it from me but you havent respond it, that is what I waiting for by now.

/Janne
0
DalinCommented:
Janne,
Sorry, I did not get the questions. could you send it again?
You can also try the answer I give above.
Regards
Dalin
0
janneaAuthor Commented:
Dahlin, I have sent you the mail again with my 3 Q's as follows:

Thanks, I´ll get bitmaps in the menu but:
 
1.) If I use a icon in my imagelist I can´t see it in the menu.

2.) If image larger than your (13*13) I can´t see the whole bitmap.

3.) How to get the buttonstyle same as In VB5-menu instead of the style in your sample app.
0
DalinCommented:
jannea,
I may have send you the old version.
Let me try something and report back to you
Regards
Dalin
0
janneaAuthor Commented:
Dalin,

Thanks for trying
0
DalinCommented:
jannea,
See if this works for you.
Regards
DAlin


'This code sample will change the actual menu bitmaps size,
'     'font size, color, and caption. Run the application and 'sel
'     ect the BitMenu and view the selections. Then click 'the for
'     m and revisit the BitMenu. '--------------------------------
'     ------------------------- Sub Command2_Click ()
'     '* Example to create a dynamic menu system
hMenu% = GetMenu(hWnd)
hSubMenu% = GetSubMenu(hMenu%, 0)

For i% = 0 To Number_of_Menu_Selections - 1
       '     '* Place some text into the menu.
        SubMenu(i%).Caption = Picture3(i%).FontName +
       Str$(Picture3(i%).FontSize) + " Pnt"
       '     '* 1. Must be AutoRedraw for Image().
       '     '* 2. Set Backcolor of Picture control to that of the
       '     '*current system Menu Bar color, so Dynamic bitmaps
       '     '*will appear as normal menu items when menu bar
       '     '*color is changed via the control panel
       '     '* 3. See the bitmaps on screen, this could all be done
       '     '*at design time.
        Picture3(i%).AutoRedraw = TRUE
        Picture3(i%).BackColor = CLR_MENUBAR
       '     '* You can uncomment this
       '     '* Picture3(i%).Visible = FALSE
       '     '* Set the width and height of the Picture controls
       '     '* based on their corresponding Menu items caption,
       '     '* and the Picture controls Font and FontSize.
       '     '* DoEvents() is necessary to make new dimension
       '     '* values to take affect prior to exiting this Sub.
       Picture3(i%).Width = Picture3(i%).TextWidth(SubMenu(i%).Caption)
       Picture3(i%).Height = Picture3(i%).TextHeight(SubMenu(i%).Caption)
       Picture3(i%).Print SubMenu(i%).Caption
       '     '* - Set picture controls backgroup picture (Bitmap) to
       '     '*its Image.
        Picture3(i%).Picture = Picture3(i%).Image
        x% = DoEvents()
Next i%

'     '* Get handle to forms menu.
hMenu% = GetMenu(Form1.hWnd)
'     '* Get handle to the specific menu in top level menu.
hSubMenu% = GetSubMenu(hMenu%, 0)

For i% = 0 To Number_of_Menu_Selections - 1
       '     '* Get ID of sub menu
        menuId% = GetMenuItemID(hSubMenu%, i%)
       '     '* Replace menu text w/bitmap from corresponding picture
       '     '* control
        x% = ModifyMenu(hMenu%, menuId%, MF_BITMAP, menuId%,
        CLng(Picture3(i%).Picture)) 'append this to previous line
       '     '* Replace bitmap for menu check mark with custom check
       '     '* bitmap
        x% = SetMenuItemBitmaps(hMenu%, menuId%, 0, 0, CLng(picture2.Picture))
Next i%

End Sub

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
janneaAuthor Commented:
Dalin,

Thanks I don´t have time to check your code by now, I´ll be back as soon as I can...
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Fonts Typography

From novice to tech pro — start learning today.