[RESOLVED] VB6 - can i use SetMenuItemInfo for transparent bitmap?

[joaquim]

Option Explicit

' ==================================================
' API DECLARATIONS
' ==================================================
Private Type RECT
    Left As Long: Top As Long: Right As Long: Bottom As Long
End Type

Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As Long
    cch As Long
    hbmpItem As Long
End Type

' User32
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 SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAni As Long, ByVal hbrFlickerFree As Long, ByVal diFlags As Long) As Long

' Gdi32
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
' API para extrair o ícone da ImageList
Private Declare Function ImageList_GetIcon Lib "comctl32.dll" ( _
    ByVal himl As Long, _
    ByVal i As Long, _
    ByVal flags As Long) As Long
' Adiciona esta declaração importante
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Const IMAGE_BITMAP As Long = 0
Private Const LR_COPYRETURNORG As Long = &H4

' Constants
Private Const MIIM_BITMAP As Long = &H80
Private Const COLOR_MENU As Long = 4
Private Const DI_NORMAL As Long = &H3
Private Const ILD_TRANSPARENT As Long = &H1

' ==================================================
' MAIN FUNCTION
' ==================================================
Public Sub DrawMenuImage(ByVal hwndWindow As Long, ByVal MenuHeaderPos As Long, ByVal SubMenuPos As Long, ByVal pic As StdPicture)
    Dim hMenu As Long, hSubMenu As Long, hBmp As Long
    Dim mii As MENUITEMINFO

    hMenu = GetMenu(hwndWindow)
    If hMenu = 0 Then Exit Sub

    hSubMenu = GetSubMenu(hMenu, MenuHeaderPos)
    If hSubMenu = 0 Then Exit Sub

    If pic Is Nothing Then Exit Sub

    hBmp = PictureToBitmap32(pic)
    If hBmp = 0 Then Exit Sub

    ' Configurar a estrutura para o SetMenuItemInfo
    mii.cbSize = Len(mii)
    mii.fMask = MIIM_BITMAP
    mii.hbmpItem = hBmp

    ' Aplicar ao item do menu usando o novo método
    If SetMenuItemInfo(hSubMenu, SubMenuPos, True, mii) = 0 Then
        MsgBox "SetMenuItemInfo falhou", vbExclamation
    End If
End Sub

' ==================================================
' CONVERT StdPicture -> 32x32 HBITMAP
' ==================================================
' Altera apenas a função PictureToBitmap32 para incluir a máscara
Private Function PictureToBitmap32(ByVal pic As StdPicture, _
    Optional imgWidth As Long = 16, _
    Optional imgHeight As Long = 16) As Long
    
    Dim hdcScreen As Long, hdcMem As Long
    Dim hOld As Long, hBmp As Long
    Dim r As RECT

    hdcScreen = GetDC(0)
    hdcMem = CreateCompatibleDC(hdcScreen)
    hBmp = CreateCompatibleBitmap(hdcScreen, imgWidth, imgHeight)
    hOld = SelectObject(hdcMem, hBmp)

    ' Fundo COLOR_MENU — única "transparência" possível sem owner draw
    r.Right = imgWidth: r.Bottom = imgHeight
    FillRect hdcMem, r, GetSysColorBrush(COLOR_MENU)

    If pic.Type = vbPicTypeIcon Then
        ' DI_NORMAL sobre COLOR_MENU compõe o alpha do ícone 32bpp
        ' É o máximo possível sem owner draw
        DrawIconEx hdcMem, 0, 0, pic.handle, _
                   imgWidth, imgHeight, 0, 0, DI_NORMAL
    End If

    SelectObject hdcMem, hOld
    DeleteDC hdcMem
    ReleaseDC 0, hdcScreen

    PictureToBitmap32 = hBmp
End Function

Private Function CreateCompatibleBitmapForMenu(ByVal hIcon As Long) As Long
    Dim hdcScreen As Long, hdcMem As Long, hBmp As Long, hOld As Long
    
    hdcScreen = GetDC(0)
    hdcMem = CreateCompatibleDC(hdcScreen)
    
    hBmp = CreateCompatibleBitmap(hdcScreen, 16, 16)
    hOld = SelectObject(hdcMem, hBmp)
    
    ' ALTERAÇÃO: Pintar com MAGENTA (A cor mágica da transparência clássica)
    ' Muitos componentes de menu interpretam o Magenta como "transparente"
    Dim hBrush As Long
    hBrush = CreateSolidBrush(&HFF00FF)
    Dim r As RECT
    r.Right = 16: r.Bottom = 16
    FillRect hdcMem, r, hBrush
    DeleteObject hBrush
    
    ' Desenha o ícone
    DrawIconEx hdcMem, 0, 0, hIcon, 16, 16, 0, 0, DI_NORMAL
    
    SelectObject hdcMem, hOld
    DeleteDC hdcMem
    ReleaseDC 0, hdcScreen
    
    CreateCompatibleBitmapForMenu = hBmp
End Function

' Adiciona esta API para libertar o ícone da memória depois de usado
Public Sub DrawMenuImageFromList(ByVal hwndWindow As Long, ByVal MenuHeaderPos As Long, ByVal SubMenuPos As Long, ByVal imgList As Object, ByVal imgIndex As Long)
    Dim hMenu As Long, hSubMenu As Long, hIcon As Long, hBmp As Long
    Dim mii As MENUITEMINFO

    hMenu = GetMenu(hwndWindow)
    hSubMenu = GetSubMenu(hMenu, MenuHeaderPos)
    
    ' 1. Extrair o ícone
    hIcon = ImageList_GetIcon(imgList.hImageList, imgIndex, ILD_TRANSPARENT)
    
    If hIcon <> 0 Then
        ' 2. Criar o bitmap compatível (DIB)
        hBmp = CreateCompatibleBitmapForMenu(hIcon)
        
        ' 3. Configurar o Menu
        mii.cbSize = Len(mii)
        mii.fMask = MIIM_BITMAP
        mii.hbmpItem = hBmp
        
        SetMenuItemInfo hSubMenu, SubMenuPos, True, mii
        
        ' 4. Limpeza
        DestroyIcon hIcon
    End If
End Sub

can i show the bitmap menu transparent?

[Krool]

Yes, you can. But the bitmap must have a 32-bit pre-multiplied alpha channel.

[joaquim]

honestly i don't know do it
the mask(combine bitblt flags... i mean on HDC and then SetMenuItemInfo()(not owner draw)) way works?

[joaquim]

i did it:

 Option Explicit

' ==================================================
' API DECLARATIONS
' ==================================================
Private Type RECT
    Left As Long: Top As Long: Right As Long: Bottom As Long
End Type

Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As Long
    cch As Long
    hbmpItem As Long
End Type

Private Type BITMAP '14 bytes
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type


' DIB Section Structures
Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
End Type

Private Type ICONINFO
    fIcon As Long
    xHotspot As Long
    yHotspot As Long
    hbmMask As Long
    hbmColor As Long
End Type

' APIs
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 SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAni As Long, ByVal hbrFlickerFree As Long, ByVal diFlags As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Declare Function CreateIconIndirect Lib "user32" (piconinfo As ICONINFO) 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

' Gdi32
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pbmi As BITMAPINFO, ByVal iUsage As Long, ppvBits As Long, ByVal hSection As Long, ByVal dwOffset As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetCurrentObject Lib "gdi32" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long


' Comctl32
Private Declare Function ImageList_GetIcon Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal flags As Long) As Long



' Constants
Private Const MIIM_BITMAP As Long = &H80
Private Const DI_NORMAL As Long = &H3
Private Const ILD_TRANSPARENT As Long = &H1
Private Const BI_RGB As Long = 0
Private Const DIB_RGB_COLORS As Long = 0
Private Const MF_BYPOSITION = &H400&

Private Function HdcToHIcon(ByVal HDCSource As Long, ByVal W As Long, ByVal H As Long) As Long
    Dim ii As ICONINFO
    Dim hbmColor As Long, hbmMask As Long
    Dim hdcMem As Long, hOld As Long

    ' 1. Criar o bitmap de cor (baseado no seu HDC)
    hbmColor = CreateCompatibleBitmap(HDCSource, W, H)
    
    ' 2. Criar a máscara (tem que ser monocromática)
    ' Se você quiser transparência total, a máscara precisa ter 1s onde quer transparência
    hbmMask = CreateBitmap(W, H, 1, 1, ByVal 0&)
    
    ' 3. Copiar o seu desenho para o bitmap de cor
    hdcMem = CreateCompatibleDC(HDCSource)
    hOld = SelectObject(hdcMem, hbmColor)
    BitBlt hdcMem, 0, 0, W, H, HDCSource, 0, 0, vbSrcCopy
    SelectObject hdcMem, hOld
    DeleteDC hdcMem

    ' 4. Montar a estrutura do ícone
    ii.fIcon = 1 ' Diz que é um ícone
    ii.hbmColor = hbmColor
    ii.hbmMask = hbmMask

    ' 5. Criar o ícone
    HdcToHIcon = CreateIconIndirect(ii)
    
    ' Limpeza (pode deletar os bitmaps, o CreateIconIndirect faz uma cópia)
    DeleteObject hbmColor
    DeleteObject hbmMask
End Function

Public Sub DrawMenuImageFromHDC(ByVal hwndWindow As Long, ByVal MenuHeaderPos As Long, ByVal SubMenuPos As Long, HDCSource As Long, W As Long, H As Long)
    Dim hMenu As Long, hSubMenu As Long, hIcon As Long, hBmp As Long
    Dim mii As MENUITEMINFO

    hMenu = GetMenu(hwndWindow)
    hSubMenu = GetSubMenu(hMenu, MenuHeaderPos)
    
    ' 1. Extrair o ícone (transparente)
    hIcon = HdcToHIcon(HDCSource, W, H)
    
    If hIcon <> 0 Then
        ' 2. Criar bitmap de 32 bits (DIB) com suporte a Alpha
        hBmp = Create32BitDIB(hIcon, 16, 16)
        
        ' 3. Configurar o Menu
        mii.cbSize = Len(mii)
        mii.fMask = MIIM_BITMAP
        mii.hbmpItem = hBmp
        
        SetMenuItemInfo hSubMenu, SubMenuPos, True, mii
        
        ' 4. Limpeza
        DestroyIcon hIcon
    End If
End Sub


' ==================================================
' MÉTODOS PÚBLICOS
' ==================================================

' Desenha a partir de uma ImageList
Public Sub DrawMenuImageFromList(ByVal hwndWindow As Long, ByVal MenuHeaderPos As Long, ByVal SubMenuPos As Long, ByVal imgList As Object, ByVal imgIndex As Long)
    Dim hMenu As Long, hSubMenu As Long, hIcon As Long, hBmp As Long
    Dim mii As MENUITEMINFO

    hMenu = GetMenu(hwndWindow)
    hSubMenu = GetSubMenu(hMenu, MenuHeaderPos)
    
    ' 1. Extrair o ícone (transparente)
    hIcon = ImageList_GetIcon(imgList.hImageList, imgIndex, ILD_TRANSPARENT)
    
    If hIcon <> 0 Then
        ' 2. Criar bitmap de 32 bits (DIB) com suporte a Alpha
        hBmp = Create32BitDIB(hIcon, 16, 16)
        
        ' 3. Configurar o Menu
        mii.cbSize = Len(mii)
        mii.fMask = MIIM_BITMAP
        mii.hbmpItem = hBmp
        
        SetMenuItemInfo hSubMenu, SubMenuPos, True, mii
        
        ' 4. Limpeza
        DestroyIcon hIcon
    End If
End Sub

' ==================================================
' FUNÇÕES AUXILIARES DE MEMÓRIA (DIB SECTION)
' ==================================================

Private Function Create32BitDIB(ByVal hIcon As Long, ByVal W As Long, ByVal H As Long) As Long
    Dim hdcScreen As Long, hdcMem As Long
    Dim hOld As Long, hBmp As Long
    Dim bi As BITMAPINFO
    
    ' Configuração do cabeçalho para 32-bit (suporta canal Alpha)
    With bi.bmiHeader
        .biSize = Len(bi.bmiHeader)
        .biWidth = W
        .biHeight = H
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = BI_RGB
    End With

    hdcScreen = GetDC(0)
    hdcMem = CreateCompatibleDC(hdcScreen)
    
    ' Cria DIBSection: o Windows inicializa este buffer com Alpha = 0 (transparente)
    hBmp = CreateDIBSection(hdcMem, bi, DIB_RGB_COLORS, 0, 0, 0)
    hOld = SelectObject(hdcMem, hBmp)

    ' Desenha o ícone no DC de memória
    ' Como o bitmap é 32-bit, o DrawIconEx preservará a transparência real
    DrawIconEx hdcMem, 0, 0, hIcon, W, H, 0, 0, DI_NORMAL

    ' Cleanup
    SelectObject hdcMem, hOld
    DeleteDC hdcMem
    ReleaseDC 0, hdcScreen

    Create32BitDIB = hBmp
End Function

SetMenuItemInfo() needs a HBitmap, but we have HICON(even from HDC).... so we Create32BitDIB() and then we draw the icon DrawIconEx() on HDC memory with hbitmap... now we add it on menu