Solved

Menu-bitmaps

Posted on 1998-03-30
14
454 Views
Last Modified: 2013-12-02
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
0
Comment
Question by:jannea
  • 7
  • 6
14 Comments
 

Expert Comment

by:SeanH
Comment Utility
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
 
LVL 1

Author Comment

by:jannea
Comment Utility
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
 
LVL 1

Author Comment

by:jannea
Comment Utility
Are you still there Sean ???
0
 
LVL 9

Expert Comment

by:Dalin
Comment Utility
jannea,
I have a sample Program. If you like, I can e-mail to you. My E-mail: Dalin_N@MailExcite.Com
0
 
LVL 1

Author Comment

by:jannea
Comment Utility
Dalin,

Have you recived my mail ?

/Janne
0
 
LVL 9

Expert Comment

by:Dalin
Comment Utility
Janne,
I thought I send you the project...
0
 
LVL 9

Expert Comment

by:Dalin
Comment Utility
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
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 1

Author Comment

by:jannea
Comment Utility
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
 
LVL 9

Expert Comment

by:Dalin
Comment Utility
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
 
LVL 1

Author Comment

by:jannea
Comment Utility
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
 
LVL 9

Expert Comment

by:Dalin
Comment Utility
jannea,
I may have send you the old version.
Let me try something and report back to you
Regards
Dalin
0
 
LVL 1

Author Comment

by:jannea
Comment Utility
Dalin,

Thanks for trying
0
 
LVL 9

Accepted Solution

by:
Dalin earned 100 total points
Comment Utility
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
 
LVL 1

Author Comment

by:jannea
Comment Utility
Dalin,

Thanks I don´t have time to check your code by now, I´ll be back as soon as I can...
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
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…

772 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

11 Experts available now in Live!

Get 1:1 Help Now