Use SysIcon In Menu

Use SysIcon In Menu

Post by Benn » Tue, 04 Apr 2000 04:00:00



Hi Big brother,

In fact I have try many time but not as good as I expected,
I have got a Icon's system handle (hIcon), and try to use in menu, But the
SetMenuItemBitmaps just support BMP type grapghic , it made me mad.
I also tried used  IconToPicture Function, but still not work, only a black
picture appeared on the menu.
Can you help?

below is my code :

Private Function IconToPicture(ByVal Hicon As Long) As IPictureDisp '
IPicture

    If Hicon = 0 Then Exit Function

    Dim oNewPic As Picture
    Dim tPicConv As PictDesc
    Dim IGuid As Guid

    With tPicConv
    .cbSizeofStruct = Len(tPicConv)
    .picType = vbPicTypeIcon
    .hImage = Hicon
    End With

    ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    With IGuid
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(2) = &H0
        .Data4(3) = &HAA
        .Data4(4) = &H0
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With
    OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic

    Set IconToPicture = oNewPic

End Function

Private Sub Form_Load()
Dim Hicon As Long
  Dim i%
  Dim hMenu, hSubMenu, menuID, x
  Dim info As MENUITEMINFO

      Hicon = LoadImage(App.hInstance, "C:\my
documents\icons\256\globe.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE Or
LR_LOADMAP3DCOLORS)
    ' Set the picture to this icon:
'    Set Picture1.Picture = IconToPicture(hIcon)

  hMenu = GetMenu(hwnd)
  hSubMenu = GetSubMenu(hMenu, 0) '1 for "Other" menu etcetera
  For i = 1 To 4
    menuID = GetMenuItemID(hSubMenu, i - 1)
    x = SetMenuItemInfo(hMenu, 0, False, info)
    x = SetMenuItemBitmaps(hMenu, menuID, &H4, _
        IconToPicture(Hicon), IconToPicture(Hicon))
'img.ListImages(i).Picture, img.ListImages(i).Picture)
  Next
  menuID = GetMenuItemID(hSubMenu, 5)
  x = SetMenuItemBitmaps(hMenu, menuID, 0, img.ListImages(5).Picture, 0&)

    ' Load an icon called Test.Ico from the directory:

    ' If the icon contains more than one size of image,
    ' set cx and cy to the width and height to load
    ' the appropriate image in:

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y
As Single)
  If Button = 2 Then
    PopupMenu mnuMCR, 2, x
  End If
End Sub

Function GetBitMapHandle(ByVal Hicon As Long)
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim pic As New StdPicture
Dim hDc5 As Long, i As Long
Dim hBitmap As Long
Dim hDstDc As Long

Set pic = IconToPicture(Hicon)
hDc5 = CreateCompatibleDC(0)
i = SelectObject(hDc5, pic.Handle)

i = GetMenuCheckMarkDimensions
dstWidth = i Mod 2 ^ 16
dstHeight = i / 2 ^ 16

hBitmap = CreateCompatibleBitmap(TheForm.hdc, dstWidth, dstHeight)
hDstDc = CreateCompatibleDC(TheForm.hdc)
SelectObject hDstDc, hBitmap

srcHeight = TheForm.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = TheForm.ScaleX(pic.Width, vbHimetric, vbPixels)

Call StretchBlt(hDstDc, 0, 0, dstWidth, dstHeight, hDc5, 0, 0, srcWidth,
srcHeight, SRCCOPY)
GetBitMapHandle = hBitmap
Call DeleteDC(hDc5)
Call DeleteDC(hDstDc)

End Function

Thanks!

 
 
 

Use SysIcon In Menu

Post by Pieter Philippaert » Tue, 04 Apr 2000 04:00:00


Try to create a Memory Device Context (with CreateCompatibleDC) and Memory
Bitmap (with CreateCompatibleBitmap) and draw the icon on it (with DrawIcon
or DrawIconEx).
Then, use that bitmap andle with the SetMenuItemBitmaps-bitmap.

Here's more information about the mentioned functions:
http://kpdteam.tripod.com/api/CreateCompatibleDC.htm
http://kpdteam.tripod.com/api/CreateCompatibleBitmap.htm
http://kpdteam.tripod.com/api/DrawIcon.htm
http://kpdteam.tripod.com/api/DrawIconEx.htm
http://kpdteam.tripod.com/api/SetMenuItemBitmaps.htm

Regards,
Pieter Philippaerts
http://www.allapi.net/


Quote:> Hi Big brother,

> In fact I have try many time but not as good as I expected,
> I have got a Icon's system handle (hIcon), and try to use in menu, But the
> SetMenuItemBitmaps just support BMP type grapghic , it made me mad.
> I also tried used  IconToPicture Function, but still not work, only a
black
> picture appeared on the menu.
> Can you help?

> below is my code :

> Private Function IconToPicture(ByVal Hicon As Long) As IPictureDisp '
> IPicture

>     If Hicon = 0 Then Exit Function

>     Dim oNewPic As Picture
>     Dim tPicConv As PictDesc
>     Dim IGuid As Guid

>     With tPicConv
>     .cbSizeofStruct = Len(tPicConv)
>     .picType = vbPicTypeIcon
>     .hImage = Hicon
>     End With

>     ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
>     With IGuid
>         .Data1 = &H7BF80980
>         .Data2 = &HBF32
>         .Data3 = &H101A
>         .Data4(0) = &H8B
>         .Data4(1) = &HBB
>         .Data4(2) = &H0
>         .Data4(3) = &HAA
>         .Data4(4) = &H0
>         .Data4(5) = &H30
>         .Data4(6) = &HC
>         .Data4(7) = &HAB
>     End With
>     OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic

>     Set IconToPicture = oNewPic

> End Function

> Private Sub Form_Load()
> Dim Hicon As Long
>   Dim i%
>   Dim hMenu, hSubMenu, menuID, x
>   Dim info As MENUITEMINFO

>       Hicon = LoadImage(App.hInstance, "C:\my
> documents\icons\256\globe.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE Or
> LR_LOADMAP3DCOLORS)
>     ' Set the picture to this icon:
> '    Set Picture1.Picture = IconToPicture(hIcon)

>   hMenu = GetMenu(hwnd)
>   hSubMenu = GetSubMenu(hMenu, 0) '1 for "Other" menu etcetera
>   For i = 1 To 4
>     menuID = GetMenuItemID(hSubMenu, i - 1)
>     x = SetMenuItemInfo(hMenu, 0, False, info)
>     x = SetMenuItemBitmaps(hMenu, menuID, &H4, _
>         IconToPicture(Hicon), IconToPicture(Hicon))
> 'img.ListImages(i).Picture, img.ListImages(i).Picture)
>   Next
>   menuID = GetMenuItemID(hSubMenu, 5)
>   x = SetMenuItemBitmaps(hMenu, menuID, 0, img.ListImages(5).Picture, 0&)

>     ' Load an icon called Test.Ico from the directory:

>     ' If the icon contains more than one size of image,
>     ' set cx and cy to the width and height to load
>     ' the appropriate image in:

> End Sub

> Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single,
y
> As Single)
>   If Button = 2 Then
>     PopupMenu mnuMCR, 2, x
>   End If
> End Sub

> Function GetBitMapHandle(ByVal Hicon As Long)
> Dim dstWidth As Long, dstHeight As Long
> Dim srcWidth As Long, srcHeight As Long
> Dim x As Long, y As Long
> Dim pic As New StdPicture
> Dim hDc5 As Long, i As Long
> Dim hBitmap As Long
> Dim hDstDc As Long

> Set pic = IconToPicture(Hicon)
> hDc5 = CreateCompatibleDC(0)
> i = SelectObject(hDc5, pic.Handle)

> i = GetMenuCheckMarkDimensions
> dstWidth = i Mod 2 ^ 16
> dstHeight = i / 2 ^ 16

> hBitmap = CreateCompatibleBitmap(TheForm.hdc, dstWidth, dstHeight)
> hDstDc = CreateCompatibleDC(TheForm.hdc)
> SelectObject hDstDc, hBitmap

> srcHeight = TheForm.ScaleY(pic.Height, vbHimetric, vbPixels)
> srcWidth = TheForm.ScaleX(pic.Width, vbHimetric, vbPixels)

> Call StretchBlt(hDstDc, 0, 0, dstWidth, dstHeight, hDc5, 0, 0, srcWidth,
> srcHeight, SRCCOPY)
> GetBitMapHandle = hBitmap
> Call DeleteDC(hDc5)
> Call DeleteDC(hDstDc)

> End Function

> Thanks!


 
 
 

1. Menus: Using Bitmaps and Text, Scrolling Menus, etc...

I downloaded VB5CCE and found several interesting features, one being that
the menus had a little icon along with their text, and that the longer
menus scrolled. I was wondering which API calls to use, how to declare
them, how to use them to do what I want to do, etc...
Thanks.
-Jake1024
-----------------------------
http://members.aol.com/jake1024

2. Is Lightwave Worth It

3. Problem in using popup menus in GLX

4. HOW: Two of the same objects, but different surfaces

5. Using '\' as a menu accelerator

6. 24 bit SoXtComponent

7. Pulldown Menus In The Popup Planes Using ViewKit

8. Adobe Dimensions? Any Good?

9. LW 6.0 menus using LW6.5...

10. How to design static menus using GLUT???????

11. HELP: Problem with pulldown menu using glwMDrawingAreaWidget

12. Adding icons to menu using SetMenuItemBitmaps