[vb6] Icon Handle to File/Array

[LaVolpe]

I've seen a few posts since I offered this code this time last year. So instead of it hiding in some user's thread, I think it is more suited here.

Here is a good routine to save icon handles to file.
1. It handles 1, 4 , 8, 16, 24 & 32 bit icons. But 16 bit are converted to 24 bit for saving.
2. Note that 32bit alpha icons will not be saved correctly unless running XP or better; nor will the hIcon display correctly anyway.
3. If successful, the passed array to the function will contain the icon in correct image/file format. Just save the array to a file.

Too long to post, so download from attachment. Add the code to a form, module, usercontrol, or class as desired.

Let me comment on #2 above. The reason you might get poor quality is rather simple. You may be running Windows 2000 and you extracted an icon or retrieved a handle to an icon that is 32bpp. Only on XP and higher will those icons display properly. Since the attached code is getting the icon image from handle, what you see is what you get. If the icon is not displayed properly by the system, the result is also poor quality. Just FYI.

Bonus code: Assign icon from the array directly to a VB picture/icon property without first saving to file. Again, note that VB won't load 32 bpp icons.

' sample call
Private Sub Command1_Click()
    Dim hIconData() As Byte
    ' replace Me.Icon.Handle with the icon handle you want to use
    If SaveHICONtoArray(Me.Icon.Handle, hIconData()) = True Then
        Set Image1.Picture = ArrayToStdPicture(hIconData)
    End If
End Sub

The routine and declarations needed for above sample call

Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Public Function ArrayToStdPicture(theArray() As Byte) As IPicture
    
    ' function creates a stdPicture from the passed array
    ' Note: The array was already validated as not empty before this was called
    
    Dim o_hMem  As Long
    Dim o_lpMem  As Long
    Dim aGUID(0 To 3) As Long
    Dim IIStream As IUnknown
    
    aGUID(0) = &H7BF80980    ' GUID for stdPicture
    aGUID(1) = &H101ABF32
    aGUID(2) = &HAA00BB8B
    aGUID(3) = &HAB0C3000
    
    o_hMem = GlobalAlloc(&H2&, UBound(theArray) + 1)
    If Not o_hMem = 0& Then
        o_lpMem = GlobalLock(o_hMem)
        If Not o_lpMem = 0& Then
            CopyMemory ByVal o_lpMem, theArray(0), UBound(theArray) + 1
            Call GlobalUnlock(o_hMem)
            If CreateStreamOnHGlobal(o_hMem, 1&, IIStream) = 0& Then
                  Call OleLoadPicture(ByVal ObjPtr(IIStream), 0&, 0&, aGUID(0), ArrayToStdPicture)
            End If
        End If
    End If

End Function

.