Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Creating Menu Bitmaps with alpha channel for Windows Vista in VB6

97 views
Skip to first unread message

Mark

unread,
Jan 28, 2009, 11:22:01 PM1/28/09
to
I am trying to create a simple icon at runtime with an alpha channel that I
can apply to the menu. I have been somewhat successful at this using
CreateIcon and DrawIconEx as well as one or two other ways, but my problems
is that if the user's machine is not set to 32 bit colors in display
settings, then it doesn't work. The following is the code that I used to do
this. Please help me fix this problem.
As you can see I have tried setting the menu image several ways all with the
same result. As long it is 32 bit in display settings, everything works,
otherwise it fails to draw anything.

Private Sub cmdTestBmp_Click()
SetMenuImage Array(0, 1), CreateOverrideBitmap
End Sub

Private Sub SetMenuImage(ByVal MenuTree As Variant, ByVal Bmp As Long)
'MenuTree is an array that holds a zero based menu index path to the desired
menu
Dim MainMenuHandle As Long
Dim MenuHandle As Long
Dim i As Integer
Dim mii As MENUITEMINFO
Dim mi As MENUINFO

' Get the menu handle.
MainMenuHandle = GetMenu(Me.hwnd)
MenuHandle = MainMenuHandle

For i = LBound(MenuTree) To UBound(MenuTree) - 1
MenuHandle = GetSubMenu(MenuHandle, MenuTree(i))
Next i

With mi
.cbSize = Len(mi)
.fMask = MIM_STYLE
.dwStyle = MNS_NOCHECK
End With

SetMenuInfo GetSubMenu(MenuHandle, MenuTree(UBound(MenuTree))), mi

With mii
.cbSize = Len(mii)
'.fMask = MIIM_CHECKMARKS
'.fMask = MIIM_CHECKMARKS Or MIIM_BITMAP
.fMask = MIIM_BITMAP
.hbmpItem = Bmp
'.hbmpChecked = Bmp
'.hbmpUnchecked = Bmp
End With

' Assign the picture.
SetMenuItemInfo MainMenuHandle, GetMenuItemID(MenuHandle,
MenuTree(UBound(MenuTree))), 0, mii
'SetMenuItemBitmaps MainMenuHandle, GetMenuItemID(MenuHandle,
MenuTree(UBound(MenuTree))), 0, Bmp, Bmp
End Sub

Public Function CreateOverrideBitmap() As Long
Dim pixels(15, 15) As Long
Dim maskArray(255) As Long
Dim hIcon As Long
Dim nWidth As Long
Dim nHeight As Long
Dim hBmp As Long
Dim hOrigBmp As Long
Dim m_hDC As Long
Dim m_hDIb As Long
Dim m_hBmpOld As Long
Dim m_lPtr As Long
Dim m_tBI As BITMAPINFO
Dim bCreated As Boolean

m_hDC = CreateCompatibleDC(0)

If (m_hDC <> 0) Then
With m_tBI.bmiHeader
.biSize = Len(m_tBI.bmiHeader)
.biWidth = nWidth
.biHeight = nHeight
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
.biSizeImage = .biWidth * 4 * .biHeight
End With

m_hDIb = CreateDIBSection(m_hDC, m_tBI, DIB_RGB_COLORS, m_lPtr, 0, 0)

If m_hDIb <> 0 Then
m_hBmpOld = SelectObject(m_hDC, m_hDIb)
bCreated = True
Else
DeleteObject m_hDC
m_hDC = 0
End If
End If

hBmp = CreateCompatibleBitmap(m_hDC, nWidth, nHeight)
'hBmp = CreateCompatibleBitmap(m_hDC, 16, 16)

hOrigBmp = SelectObject(m_hDC, hBmp)

hIcon = CreateIcon(0, nWidth, nHeight, 1, 32, VarPtr(maskArray(0)),
VarPtr(pixels(0, 0)))

DrawIconEx m_hDC, 0, 0, hIcon, nWidth, nHeight, 0, 0, DI_NORMAL 'DI_MASK

DestroyIcon hIcon
hBmp = SelectObject(m_hDC, hOrigBmp)

If (m_hDC <> 0) Then
If (m_hDIb <> 0) Then
SelectObject m_hDC, m_hBmpOld
DeleteObject m_hDIb
End If

DeleteObject m_hDC
End If

DeleteDC m_hDC

m_hDC = 0
m_hDIb = 0
m_hBmpOld = 0
m_lPtr = 0

CreateOverrideBitmap = hBmp
End Function

0 new messages