dcsimg
Results 1 to 7 of 7

Thread: [VB6] Code Snippet: Converting an hIcon to an hBitmap

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,351

    [VB6] Code Snippet: Converting an hIcon to an hBitmap

    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.
    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
    The initial hIcon can be from any source that has that type returned; e.g. ExtractIcon[Ex], LoadImage, etc.

    EDIT - KNOWN ISSUES
    **The above code only works for 24-bit icons with an alpha channel.**
    For 24-bit icons without an alpha channel, and icons with 256 or fewer colors:
    Code:
    Public Function HBitmapFromHIconNoAlpha(hIcon As Long) As Long
    Dim himg As Long
    Dim hb As Long
    GdipCreateBitmapFromHICON hIcon, himg
    GdipCreateHBITMAPFromBitmap himg, hb, &HFF000000
    GdipDisposeImage himg
    HBitmapFromHIconNoAlpha = hb
    End Function
    (note that this requires gdiplus to be initialized, so use the entire module below which includes it)

    This of course requires knowing which one to use, I'm working on one without GDIPlus, in the mean time there's this one from Leandro Ascierto's clsMenuImage:
    Code:
    Option Explicit
    'If you are using this don't just copy the main function, note the startup and shutdown of gdiplus
    Public gInitToken As Long
    Private Const PixelFormat32bppRGB   As Long = &H22009
    Private Type GdiplusStartupInput
        GdiplusVersion           As Long
        DebugEventCallback       As Long
        SuppressBackgroundThread As Long
        SuppressExternalCodecs   As Long
    End Type
    Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
    End Type
    Private Type ARGB
        Blue            As Byte
        Green           As Byte
        Red             As Byte
        Alpha           As Byte
    End Type
    Private Type BitmapData
        Width           As Long
        Height          As Long
        Stride          As Long
        PixelFormat     As Long
        Scan0           As Long
        Reserved        As Long
    End Type
    Private Enum ImageLockMode
        ImageLockModeRead = &H1
        ImageLockModeWrite = &H2
        ImageLockModeUserInputBuf = &H4
    End Enum
    Private Declare Function GdiplusStartup Lib "GdiPlus.dll" (Token As Long, gdipInput As GdiplusStartupInput, GdiplusStartupOutput As Long) As Long
    Private Declare Sub GdiplusShutdown Lib "GdiPlus.dll" (ByVal Token As Long)
    Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GdiPlus.dll" (ByVal hBmp As Long, ByVal hPal As Long, GpBitmap As Long) As Long
    Private Declare Function GdipGetImagePixelFormat Lib "GDIplus" (ByVal Image As Long, ByRef PixelFormat As Long) As Long
    Private Declare Function GdipGetImageDimension Lib "GDIplus" (ByVal Image As Long, ByRef Width As Single, ByRef Height As Single) As Long
    Private Declare Function GdipBitmapLockBits Lib "GDIplus" (ByVal BITMAP As Long, ByRef RECT As RECT, ByVal Flags As ImageLockMode, ByVal PixelFormat As Long, ByRef LockedBitmapData As BitmapData) As Long
    Private Declare Function GdipBitmapUnlockBits Lib "GDIplus" (ByVal BITMAP As Long, ByRef LockedBitmapData As BitmapData) As Long
    Private Declare Function GdipDisposeImage Lib "GdiPlus.dll" (ByVal Image As Long) As Long
    
    Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    
    
    Public Sub InitGDIP()
        Static Token    As Long
        If Token = 0 Then
            Dim gdipInit As GdiplusStartupInput
            gdipInit.GdiplusVersion = 1
            GdiplusStartup Token, gdipInit, ByVal 0&
            gInitToken = Token
        End If
    End Sub
    
    Public Function pvIsAlphaIcon(ByVal IconHandle As Long) As Boolean
    
        Dim tARGB() As ARGB
        Dim tRECT As RECT
        Dim tICONINFO As ICONINFO
        Dim tBitmapData As BitmapData
        Dim lPixelFormat As Long
        Dim lngX As Long
        Dim lngY As Long
        Dim sngWidth As Single
        Dim sngHeight As Single
        Dim lngArgbBmp As Long
        Dim lngColorBmp As Long
        Dim bolRet As Boolean
        Dim hr As Long
        
    On Error GoTo e0
    If gInitToken = 0 Then InitGDIP
    hr = GetIconInfo(IconHandle, tICONINFO)
    If hr <> 0 Then
        If tICONINFO.hBMColor <> 0 Then
            If GdipCreateBitmapFromHBITMAP(tICONINFO.hBMColor, 0&, lngColorBmp) = 0 Then
                If GdipGetImagePixelFormat(lngColorBmp, lPixelFormat) = 0 Then
                    If lPixelFormat <> PixelFormat32bppRGB Then
                        bolRet = False
                    Else
                        If GdipGetImageDimension(lngColorBmp, sngWidth, sngHeight) = 0 Then
                            With tRECT
                                .Right = CLng(sngWidth)
                                .Bottom = CLng(sngHeight)
                            End With
                            ReDim tARGB(tRECT.Right - 1&, tRECT.Bottom - 1&)
                            With tBitmapData
                                .Scan0 = VarPtr(tARGB(0&, 0&))
                                .Stride = 4& * tRECT.Right
                            End With
                            If GdipBitmapLockBits(lngColorBmp, tRECT, ImageLockModeRead Or ImageLockModeUserInputBuf, lPixelFormat, tBitmapData) = 0 Then
                                For lngY = 0 To tBitmapData.Height - 1
                                    For lngX = 0 To tBitmapData.Width - 1
                                        If tARGB(lngX, lngY).Alpha > 0 Then
                                            If tARGB(lngX, lngY).Alpha < 255 Then
                                                bolRet = True
                                                Exit For
                                            End If
                                        End If
                                    Next lngX
                                    If bolRet Then Exit For
                                Next lngY
                                Call GdipDisposeImage(lngArgbBmp)
                                Call GdipBitmapUnlockBits(lngColorBmp, tBitmapData)
                            End If
                        End If
                    End If
                End If
                Call GdipDisposeImage(lngColorBmp)
            End If
            Call DeleteObject(tICONINFO.hBMColor)
        End If
        Call DeleteObject(tICONINFO.hBMMask)
    Else
        bolRet = False
    End If
    pvIsAlphaIcon = bolRet
    ReleaseGDIP
    On Error GoTo 0
    Exit Function
    
    e0:
    Debug.Print "modGDIP.pvIsAlphaIcon.Error->" & Err.Description & " (" & Err.Number & ")"
        
    End Function
    Public Function HBitmapFromHIconNoAlpha(hIcon As Long) As Long
    Dim himg As Long
    Dim hb As Long
    GdipCreateBitmapFromHICON hIcon, himg
    GdipCreateHBITMAPFromBitmap himg, hb, &HFF000000
    GdipDisposeImage himg
    HBitmapFromHIconNoAlpha = hb
    End Function
    Public Sub ReleaseGDIP()
    GdiplusShutdown gInitToken
    End Sub

  2. #2
    Fanatic Member
    Join Date
    Mar 2009
    Posts
    804

    Re: [VB6] Code Snippet: Converting an hIcon to an hBitmap

    Public Function HIconFromHBitmap(hIcon As Long, cx As Long, cy As Long) As Long

    A bit confused. If it is returning an hBitmap, should it not be

    Public Function HBitmapFromHIcon(hIcon As Long, cx As Long, cy As Long) As Long

  3. #3

  4. #4
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    18,533

    Re: [VB6] Code Snippet: Converting an hIcon to an hBitmap

    FYI. Solution will not work converting icon to 32bpp bitmap in XP because DrawIconEx does not render to the alpha channel, all values are zero and image is therefore 100% transparent unless the channel is ignored and in that case, transparency is lost. Granted XP is on it's way out, but since it is still in use, thought this note would be appropriate.

    On a side note. I haven't tested your code on Vista+. Curious as to whether the bitmap's RGB channels are rendered premultiplied against the alpha channel or not? To be sure, an alpha-blended hIcon would need to be used else the alpha channel will just be a combination of 0 and 255.
    Last edited by LaVolpe; Mar 26th, 2015 at 09:20 AM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  5. #5

    Thread Starter
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,351

    Re: [VB6] Code Snippet: Converting an hIcon to an hBitmap

    I've only tested it on Win7 and Win8, though I'm pretty sure if it works on those it will work on Vista. XP would be the problem. Would definitely like some feedback if anyone wants to check out XP/Vista... obviously a solution compatible with all versions would be better.

  6. #6
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    18,533

    Re: [VB6] Code Snippet: Converting an hIcon to an hBitmap

    Later tonite, I'll try it on Vista if no one else has done it before then. When I tried it on XP, double checked the alpha channel and it was all zeroes. A one-size fits all method would still probably be better to reroute to the simpler/faster method if the O/S supports it. In either case, it would be worth noting whether the alpha channel is indeed correct and whether or not RGB is premultiplied or not. Since Win7 appears to work for you, I'm assuming that the alpha channel is written into unless you were testing non-transparent icons
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  7. #7
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    18,533

    Re: [VB6] Code Snippet: Converting an hIcon to an hBitmap

    Just a follow-up. On Vista, DrawIconEx indeed does render into the alpha channel. The pixel's RGB values are NOT premultiplied against the alpha value
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width