So this isn't a full on project (although it will be part of an upcoming one), just some code- doing this conversion in VB turned out to be very difficult for someone unfamiliar with graphics APIs. Found tons of other people having the same question with mostly incomplete answers, and I couldn't find anywhere showing it done in VB.. spent hours figuring it out from other codes, which turned the issue into something far more complicated than the ultimate solution I found turned out to be.
The use case this was developed as a response to was to be able to use take hIcon's extracted from files and be able to use them as a value for MENUITEMINFO.hbmpItem.
The initial hIcon can be from any source that has that type returned; e.g. ExtractIcon[Ex], LoadImage, etc.
The use case this was developed as a response to was to be able to use take hIcon's extracted from files and be able to use them as a value for MENUITEMINFO.hbmpItem.
Code:
'Declares
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
bmiColors(3) As Byte
End Type
Private Const DIB_RGB_COLORS = 0&
Private Const DI_NORMAL = 3&
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByRef lplpVoid As Any, ByVal Handle As Long, ByVal dw 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 istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
'Functions
Public Function HBitmapFromHIcon(hIcon As Long, cx As Long, cy As Long) As Long
Dim hdc As Long
Dim hBackDC As Long
Dim hBitmap As Long
Dim hBackSV As Long
hdc = GetDC(0)
hBackDC = CreateCompatibleDC(hdc)
hBitmap = Create32BitHBITMAP(hBackDC, cx, cy)
hBackSV = SelectObject(hBackDC, hBitmap)
DrawIconEx hBackDC, 0, 0, hIcon, cx, cy, 0, 0, DI_NORMAL
Call SelectObject(hBackDC, hBackSV)
Call ReleaseDC(0, hdc)
Call DeleteDC(hBackDC)
HBitmapFromHIcon = hBitmap
End Function
Public Function Create32BitHBITMAP(hdc As Long, cx As Long, cy As Long) As Long
Dim bmi As BITMAPINFO
Dim hdcUsed As Long
bmi.bmiHeader.biSize = Len(bmi.bmiHeader)
bmi.bmiHeader.biPlanes = 1
bmi.bmiHeader.biCompression = 0
bmi.bmiHeader.biWidth = cx
bmi.bmiHeader.biHeight = cy
bmi.bmiHeader.biBitCount = 32
Create32BitHBITMAP = CreateDIBSection(hdc, bmi, DIB_RGB_COLORS, ByVal 0&, 0, 0)
End Function