api code problem...

[softwareguy74]

Hi,

I'm trying to learn the Win API and I came across this article at:

http://vb-world.net/php-bin/printfri...iclepageid=486

And I implimented the code exactly but it does not seem to work.. The code should put a picture next to a menu item but it keeps returning 0 and not putting in a picture.

Here's the code:

'in form module
Private Sub Command1_Click()
On Error Resume Next

    Dim lngMenu As Long
    Dim lngSubMenu As Long
    Dim lngMenuItemID As Long
    Dim lngRet As Long
    
    lngMenu = GetMenu(Form1.hwnd)
    lngSubMenu = GetSubMenu(lngMenu, 0)
    lngMenuItemID = GetMenuItemID(lngSubMenu, 1)
    lngRet = SetMenuItemBitmaps(lngMenu, lngMenuItemID, 0, _
        Picture1.Picture, Picture1.Picture)

End Sub

'in module
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public 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

any ideas why this is not working? I'm really curious to find out what the problem and solution is..

Thanks,

Dan

[Vlatko]

Try this code:

'This project needs a form with a menu with at least one submenu
'It also needs a picturebox, Picture1, that contains a small b/w bitmap
Const MF_BYPOSITION = &H400&
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 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 Sub Form_Load()
    'KPD-Team 2000
    'URL: [email protected]
    'E-Mail: [email protected]
    Dim hMenu As Long, hSubMenu As Long
    'get the handle of the menu
    hMenu = GetMenu(Me.hwnd)
    'check if there's a menu
    If hMenu = 0 Then
        MsgBox "This form doesn't have a menu!"
        Exit Sub
    End If
    'get the first submenu
    hSubMenu = GetSubMenu(hMenu, 0)
    'check if there's a submenu
    If hSubMenu = 0 Then
        MsgBox "This form doesn't have a submenu!"
        Exit Sub
    End If
    'set the menu bitmap
    SetMenuItemBitmaps hSubMenu, 0, MF_BYPOSITION, Picture1.Picture, Picture1.Picture
End Sub

[softwareguy74]

Oh, I forgot to mention that I did in fact place a menu bar with 4 submenus and a picturebox.. But I will try your code as well and let you know..

Dan

[softwareguy74]

Okay, it worked but there seems to be a small problem...

The bitmap appears to get chopped off a little on the right side, seems to have shrunk a little from it's original size and also the color got a little dimmer..

Any ideas why?

I have posted a screen shot for you to look at to see what I'm talking about:

http://www.geocities.com/dbassett74/menushot.jpg

You will see that the bitmap in the menu differs from the bitmap in the picture box.. Shouldn't they look the same?

any help would be appreciated..

Dan

I believe that happens because some colour is taken away (it think it's either balck or white).

The reason it shrinks is because the bitmap must be approx. 13x13.

[softwareguy74]

How do other programs accomplish this then? For example, take a look at any menu item in Micrsoft Office or Visual Basic and you will see that the icon is 16X16 and loses no color..

Any ideas?

Thanks,

Dan