Results 1 to 30 of 30

Thread: CreateIconFromResourceEx not working

  1. #1

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    CreateIconFromResourceEx not working

    This is driving m crazy ... I am storing the bytes of an icon file in a Byte array and then trying to create the icon with the CreateIconFromResourceEx API but for some annoying reason, it is not returning the icon handle.

    This is the straightforward code I am using:

    Code:
    Private Declare Function CreateIconFromResourceEx Lib "user32.dll" _
    (ByRef presbits As Any, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, _
    ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As Long
    
    
    Sub CRAZY()
    
      Dim fileNum As Integer
      Dim bData() As Byte
    
      fileNum = FreeFile
      Open "C:\Users\Info-Hp\Downloads\MyIcon.ico" For Binary As fileNum
      ReDim bData(0 To LOF(fileNum) - 1&)
      Get fileNum, , bData()  
      Close fileNum
    
    'CreateIconFromResourceEx Returns 0 !!!
    MsgBox CreateIconFromResourceEx(bData(0), UBound(bData) * 4 + 4, 1&, &H30000, 0, 0, 0&)
    
    End Sub
    I also tried CreateIconFromResourceEx(bData(0), UBound(bData) * 4 + 1&, 1&, &H30000, 0, 0, 0&)

    Still not working!

    I really don't see what might be causing the problem... Can anybody please, tell me what I am doing wrong ?

    Thanks.
    Last edited by JAAFAR; Apr 10th, 2021 at 06:17 AM.

  2. #2
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: CreateIconFromResourceEx not working

    Stuff like:

    Code:
    ByRef presbits As Any
    Is sort of hilarious. You are saying to pass a pointer ("p") ByRef, but that's not what you are doing or supposed to be doing. Instead:

    Code:
    ByRef resbits As Any
    I.e., no "p" prefix.

    As far as the second argument goes... that's a byte count passed ByVal. Why are you multiplying the value by 4???

    You also seem to use the "&" type decorator erratically.

    As written, your sample code above also leaks an Icon handle on success.

  3. #3

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by dilettante View Post
    Stuff like:

    Why are you multiplying the value by 4???
    Thanks

    My bad, It should be
    Code:
    hIcon=CreateIconFromResourceEx(bData(0), ByVal UBound(bData) + 1&, 1&, &H30000, 0&, 0&, 0&)
    Msgbox hIcon
    DstroyIcon hIcon
    But still doesn't work ... hIcon returns 0
    Last edited by JAAFAR; Apr 10th, 2021 at 09:56 AM.

  4. #4
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: CreateIconFromResourceEx not working

    I think the problem is that you are passing the contents of an ICO file ("icon bag") that normally contains a directory structure and then one or more images.

    This function wants an icon image's "bits" not an ICO file.

  5. #5
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by JAAFAR View Post
    I am storing the bytes of an icon file in a Byte array and then trying to create the icon with the CreateIconFromResourceEx API but for some annoying reason, it is not returning the icon handle.
    An "Icon-file" has a different format, compared to what is stored in an "Icon-resource".

    So you have to "pre-parse" this Icofile-ByteArray, to retrieve the proper Offsets to the resource-stream.

    Code, "stolen" from my cGDIPlusCache-implementation here:
    https://www.vbforums.com/showthread....-cls-revisited
    (slightly adapted and shortened, to return only the hIcon, or hCursor-handle).

    Code:
    Public Function GetIconOrCursorFromArray(B() As Byte, ByVal DesiredSize&, Optional HotSpotX!, Optional HotSpotY!) As Long
      Dim bpp, sz As Long, Offs As Long
      For Each bpp In Array(32, 24, 16, 8, 1)
        Offs = GetIcoHdrOffs(B, bpp, DesiredSize, sz, HotSpotX, HotSpotY)
        If Offs Then Exit For
      Next
      If Offs = 0 Then Err.Raise vbObjectError, , "the ByteArray doesn't contain any valid Icons or Cursors"
      
      Offs = B(Offs) + 256& * B(Offs + 1) + 65536 * B(Offs + 2)
      GetIconOrCursorFromArray = CreateIconFromResourceEx(B(Offs), UBound(B) + 1 - Offs, 1, &H30000, sz, sz, 0)
    End Function
    
    Private Function GetIcoHdrOffs(B() As Byte, ByVal bpp&, ByVal dsz&, sz&, hsx!, hsy!) As Long
      Dim i As Long, MaxW(1 To 256) As Integer, Offs As Long
     
      For i = 0 To B(4) - 1
        If B(2) = 1 And B(12 + i * 16) = bpp Then MaxW((511 + B(6 + i * 16)) Mod 256 + 1) = i + 1
        If B(2) = 2 Then 'it's a Cursor-resource apparently
          Offs = B(18 + i * 16) + 256& * B(19 + i * 16) + 65526 * B(20 + i * 16)
          If B(Offs + 14) = bpp Then MaxW((511 + B(6 + i * 16)) Mod 256 + 1) = i + 1
        End If
      Next
      
      For i = 1 To 256
        If MaxW(i) Then sz = i: GetIcoHdrOffs = (MaxW(i) - 1) * 16 + 18
        If GetIcoHdrOffs > 0 And i >= dsz Then Exit For
      Next
      If sz Then hsx = B((MaxW(sz) - 1) * 16 + 10) / sz: hsy = B((MaxW(sz) - 1) * 16 + 12) / sz
    End Function
    HTH

    Olaf

  6. #6

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: CreateIconFromResourceEx not working



    I think the problem is that you are passing the contents of an ICO file ("icon bag") that normally contains a directory structure and then one or more images.

    This function wants an icon image's "bits" not an ICO file.
    AFAIK, the icon file contains only 1 image and I thought that normal binary input\output operations would get me the icon Bits.

    In fact, I have tried with many other icon files but no luck with any of them !


    This the file opened in an icon editor:
    Last edited by JAAFAR; Apr 10th, 2021 at 10:42 AM.

  7. #7

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by Schmidt View Post
    An "Icon-file" has a different format, compared to what is stored in an "Icon-resource".

    So you have to "pre-parse" this Icofile-ByteArray, to retrieve the proper Offsets to the resource-stream.

    Olaf

    Thanks but no chance ... Still, no Icon handle is returned.
    No error raised- I just get a null Icon handle.

    This is what i am doing :
    Code:
    Option Explicit
    
    Private Declare Function CreateIconFromResourceEx Lib "user32.dll" _
    (ByVal presbits As Byte, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, _
    ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As Long
    
    
    Sub Test()
    
        Dim fileNum As Integer
        Dim bData() As Byte
        
        fileNum = FreeFile
        Open "C:\Users\Info-Hp\Downloads\1.ico" For Binary As fileNum
        ReDim bData(0 To LOF(fileNum) - 1&)
        Get fileNum, 1, bData()
        Close fileNum
        
        Dim hIcon As Long
        hIcon = GetIconOrCursorFromArray(bData, UBound(bData))
        MsgBox hIcon
        DestroyIcon hIcon
    
    End Sub
    
    
    Public Function GetIconOrCursorFromArray(B() As Byte, ByVal DesiredSize&, Optional HotSpotX!, Optional HotSpotY!) As Long
      Dim bpp, sz As Long, Offs As Long
      For Each bpp In Array(32, 24, 16, 8, 1)
        Offs = GetIcoHdrOffs(B, bpp, DesiredSize, sz, HotSpotX, HotSpotY)
        If Offs Then Exit For
      Next
      If Offs = 0 Then Err.Raise vbObjectError, , "the ByteArray doesn't contain any valid Icons or Cursors"
      
      Offs = B(Offs) + 256& * B(Offs + 1) + 65536 * B(Offs + 2)
      GetIconOrCursorFromArray = CreateIconFromResourceEx(B(Offs), UBound(B) + 1 - Offs, 1, &H30000, sz, sz, 0)
    End Function
    
    Private Function GetIcoHdrOffs(B() As Byte, ByVal bpp&, ByVal dsz&, sz&, hsx!, hsy!) As Long
      Dim i As Long, MaxW(1 To 256) As Integer, Offs As Long
     
      For i = 0 To B(4) - 1
        If B(2) = 1 And B(12 + i * 16) = bpp Then MaxW((511 + B(6 + i * 16)) Mod 256 + 1) = i + 1
        If B(2) = 2 Then 'it's a Cursor-resource apparently
          Offs = B(18 + i * 16) + 256& * B(19 + i * 16) + 65526 * B(20 + i * 16)
          If B(Offs + 14) = bpp Then MaxW((511 + B(6 + i * 16)) Mod 256 + 1) = i + 1
        End If
      Next

  8. #8
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by JAAFAR View Post
    ...no Icon handle is returned.

    This is what i am doing :
    Code:
    Option Explicit
    
    Private Declare Function CreateIconFromResourceEx Lib "user32.dll" _
    (ByVal presbits As Byte, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, _
    Just change it back to what it was before (there was nothing wrong with it).

    Olaf

  9. #9

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by Schmidt View Post
    Just change it back to what it was before (there was nothing wrong with it).

    Olaf
    Ok- ! Excellent - It is now working

    Thanks very much for all your help Olaf and dilettante.

    I will still have to wrap my mind around the GetIcoHdrOffs routine so I understand it .

  10. #10
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by JAAFAR View Post
    I will still have to wrap my mind around the GetIcoHdrOffs routine so I understand it .
    It's based on "hardwired Byte-Offsets", to loop through the "Icon-FileHeader-parts"
    (without applying RtlMoveMemory, to copy the current Byte-Contents into "more speaking UDTs").

    https://docs.fileformat.com/image/ico/

    Olaf

  11. #11
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: CreateIconFromResourceEx not working

    Why not just use LoadImage() instead?

  12. #12

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: CreateIconFromResourceEx not working

    I think, I spoke too soon .

    It is now always giving me the error : "the ByteArray doesn't contain any valid Icons or Cursors"

    This is the exact entire code that I am using:
    Code:
    Option Explicit
    
    Private Declare Function CreateIconFromResourceEx Lib "user32.dll" _
    (ByRef presbits As Any, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, _
    ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As Long
    
    
    Sub Test()
    
        Dim fileNum As Integer
        Dim bData() As Byte
        Const ICON_FILE_PATH_NAME As String = "C:\Users\Info-Hp\Downloads\1.ico"
        
        Debug.Print Dir(ICON_FILE_PATH_NAME)  'ok
        
        fileNum = FreeFile
        Open ICON_FILE_PATH_NAME For Binary As fileNum
        ReDim bData(0 To LOF(fileNum) - 1&)
        Get fileNum, , bData()
        Close fileNum
        
        Debug.Print UBound(bData)  'ok
        
        Dim hIcon As Long
        hIcon = GetIconOrCursorFromArray(bData, UBound(bData))
        MsgBox hIcon
        
        If hIcon Then DestroyIcon hIcon
        
    
    End Sub
    
    
    Public Function GetIconOrCursorFromArray(B() As Byte, ByVal DesiredSize&, Optional HotSpotX!, Optional HotSpotY!) As Long
      Dim bpp, sz As Long, Offs As Long
      For Each bpp In Array(32, 24, 16, 8, 1)
        Offs = GetIcoHdrOffs(B, bpp, DesiredSize, sz, HotSpotX, HotSpotY)
        If Offs Then Exit For
      Next
      If Offs = 0 Then Err.Raise vbObjectError, , "the ByteArray doesn't contain any valid Icons or Cursors"
      
      Offs = B(Offs) + 256& * B(Offs + 1) + 65536 * B(Offs + 2)
      GetIconOrCursorFromArray = CreateIconFromResourceEx(B(Offs), UBound(B) + 1 - Offs, 1, &H30000, sz, sz, 0)
    End Function
    
    Private Function GetIcoHdrOffs(B() As Byte, ByVal bpp&, ByVal dsz&, sz&, hsx!, hsy!) As Long
      Dim i As Long, MaxW(1 To 256) As Integer, Offs As Long
     
      For i = 0 To B(4) - 1
        If B(2) = 1 And B(12 + i * 16) = bpp Then MaxW((511 + B(6 + i * 16)) Mod 256 + 1) = i + 1
        If B(2) = 2 Then 'it's a Cursor-resource apparently
          Offs = B(18 + i * 16) + 256& * B(19 + i * 16) + 65526 * B(20 + i * 16)
          If B(Offs + 14) = bpp Then MaxW((511 + B(6 + i * 16)) Mod 256 + 1) = i + 1
        End If
      Next
     If sz Then hsx = B((MaxW(sz) - 1) * 16 + 10) / sz: hsy = B((MaxW(sz) - 1) * 16 + 12) / sz
    End Function
    Last edited by JAAFAR; Apr 10th, 2021 at 11:30 AM.

  13. #13
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: CreateIconFromResourceEx not working

    Code:
    ByVal presbits As Byte
    This makes no sense because the "p" tells the reader that you are passing a pointer but a pointer would be a Long, not a Byte.

    Code:
    ByRef resbits As Byte
    Makes more sense. In this case As Any works as well, might be better if your program uses Long or Integer arrays as well though few would do that.

    If you are going to use C naming conventions in your VB6 programs at least use them correctly.

  14. #14

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by dilettante View Post
    This makes no sense because the "p" tells the reader that you are passing a pointer but a pointer would be a Long, not a Byte.
    Yes I agree, I just copied/pasted the API declare from the net and never changed it.

    BTW, None of the following work :
    ByRef presbits As Any
    ByRef presbits As Byte

    I keep getting the error when using olaf's routine (GetIconOrCursorFromArray) :
    "the ByteArray doesn't contain any valid Icons or Cursors"

  15. #15

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: CreateIconFromResourceEx not working

    Ok- I finally seem to have worked this out.

    The actual icon file bit-data starts at the 23rd Byte so, I started counting from there onwards.

    For future reference:

    Code:
    Option Explicit
    
    Private Declare Function CreateIconFromResourceEx Lib "user32.dll" _
    (ByRef presbits As Any, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, _
    ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags As Long) As Long
    
    
    Public Sub WORKING()
    
        Const ICON_FILE_PATH_NAME As String = "C:\Users\Info-Hp\Downloads\1.ico"
        
        Dim fNr As Integer
        Dim bData() As Byte
        Dim hIcon As Long
     
        fNr = FreeFile()
        Open ICON_FILE_PATH_NAME For Binary As #fNr
            ReDim bData(0 To (LOF(fNr) - 23))
            Get #fNr, 23, bData()
        Close #fNr
        
        hIcon = CreateIconFromResourceEx(bData(0), UBound(bData), 1&, &H30000, 0&, 0&, 0&)
        
        MsgBox hIcon
    
        If hIcon Then DestroyIcon hIcon
    
    End Sub
    Thanks everyone.
    Last edited by JAAFAR; Apr 10th, 2021 at 12:24 PM.

  16. #16
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by JAAFAR View Post
    I think, I spoke too soon .

    It is now always giving me the error : "the ByteArray doesn't contain any valid Icons or Cursors"

    This is the exact entire code that I am using:
    Code:
     
    ...
        hIcon = GetIconOrCursorFromArray(bData, UBound(bData))
    ...
    The second Argument of this function wants your "Desired" (or "Prefered") IconSize (not the Ubound of the ByteArray).

    And that DesiredSize should be in the typical range for IconSizes between 16 to 256.
    (...a single IconFile can contain several Icons in several ColorDepths and Sizes).

    Edit: Please remove the "cut-off" of the first 23 Bytes from your ByteArray-retrieving code!
    (our postings did overlap).


    Olaf
    Last edited by Schmidt; Apr 10th, 2021 at 12:26 PM.

  17. #17

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by Schmidt View Post
    The second Argument of this function wants your "Desired" (or "Prefered") IconSize (not the Ubound of the ByteArray).

    And that DesiredSize should be in the typical range for IconSizes between 16 to 256.
    (...a single IconFile can contain several Icons in several ColorDepths and Sizes).

    Olaf
    Thanks, but no matter what size I pass in the second argument, GetIconOrCursorFromArray still errors out.

    Anyway,
    Code:
    my last posted code
    seems to work ok on all icons I have tried the code on.

  18. #18

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2013
    Posts
    658

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by Schmidt View Post
    Edit: Please remove the "cut-off" of the first 23 Bytes from your ByteArray-retrieving code!
    (our postings did overlap).


    Olaf
    Sorry, I didn't understand what you mean .

    EDIT:
    Do you mean :

    Code:
    ReDim bData(0 To LOF(fileNum) - 23)
    Get fileNum, 23, bData()
    Then
    Code:
    hIcon = GetIconOrCursorFromArray(bData, UBound(bData))
    Tried that as well, I still get the same error
    Last edited by JAAFAR; Apr 10th, 2021 at 12:44 PM.

  19. #19
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by JAAFAR View Post
    Sorry, I didn't understand what you mean .
    What I mean is, that you have to leave the ByteArray intact in its entirety (exactly as it sits in the *.ico-file).

    The reason it didn't work in your last posted code (with a Proper "DesiredSize" as e.g. 16 or 32 instead of the ByteArray-Ubound), is the mangled SubRoutine, which you somehow "shortened"...

    Meaning, that your GetIcoHdrOffs does not match with what I posted in #5.

    Olaf

  20. #20
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: CreateIconFromResourceEx not working

    Is there some reason to avoid LoadImage()?

    Name:  sshot.png
Views: 346
Size:  11.4 KB

    Code:
    Option Explicit
    
    Private Const WIN32_NULL As Long = 0
    
    Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
    
    Private Enum DI_FLAGS
        DI_MASK = &H1&
        DI_IMAGE = &H2&
        DI_NORMAL = &H3&
        DI_COMPAT = &H4&
        DI_DEFAULTSIZE = &H8&
        DI_NOMIRROR = &H10&
    End Enum
    
    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 DI_FLAGS) As Long
    
    Private Const IMAGE_ICON = 1
    
    Private Const LR_LOADFROMFILE = &H10&
    
    Private Declare Function LoadImage Lib "user32" Alias "LoadImageW" ( _
        ByVal hInstance As Long, _
        ByVal pszName As Long, _
        ByVal uType As Long, _
        ByVal cx As Long, _
        ByVal cy As Long, _
        ByVal fuLoad As Long) As Long
    
    Private Sub Form_Load()
        Const STEP_BY  As Long = 10
        Dim N As Long
        Dim hIcon As Long
    
        AutoRedraw = True
        ScaleMode = vbPixels
        For N = STEP_BY To ScaleWidth Step STEP_BY
            Line (N, 0)-(N, ScaleHeight - 1)
        Next
        For N = STEP_BY To ScaleHeight Step STEP_BY
            Line (0, N)-(ScaleWidth - 1, N)
        Next
        hIcon = LoadImage(WIN32_NULL, _
                          StrPtr("globe.ico"), _
                          IMAGE_ICON, _
                          32, _
                          32, _
                          LR_LOADFROMFILE)
        DrawIconEx hDC, _
                   0, _
                   0, _
                   hIcon, _
                   0, _
                   0, _
                   0, _
                   WIN32_NULL, _
                   DI_NORMAL
        DestroyIcon hIcon
        hIcon = LoadImage(WIN32_NULL, _
                          StrPtr("globe.ico"), _
                          IMAGE_ICON, _
                          64, _
                          64, _
                          LR_LOADFROMFILE)
        DrawIconEx hDC, _
                   ScaleX(ScaleWidth * 1 / 3, ScaleMode, vbPixels), _
                   0, _
                   hIcon, _
                   0, _
                   0, _
                   0, _
                   WIN32_NULL, _
                   DI_NORMAL
        DestroyIcon hIcon
        hIcon = LoadImage(WIN32_NULL, _
                          StrPtr("globe.ico"), _
                          IMAGE_ICON, _
                          128, _
                          128, _
                          LR_LOADFROMFILE)
        DrawIconEx hDC, _
                   ScaleX(ScaleWidth * 2 / 3, ScaleMode, vbPixels), _
                   0, _
                   hIcon, _
                   0, _
                   0, _
                   0, _
                   WIN32_NULL, _
                   DI_NORMAL
        DestroyIcon hIcon
        AutoRedraw = False
    End Sub

  21. #21
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by JAAFAR View Post
    Ok- I finally seem to have worked this out.

    The actual icon file bit-data starts at the 23rd Byte so, I started counting from there onwards.
    Just to make sure, there's no confusion ... the above is wrong and will mislead others...

    Here again a fully working example (Form-Code which should work on any machine) -
    which does make use of the 2 Helper-Routines (exactly as I've posted them already in #5):

    Code:
    Option Explicit
    
    Private Declare Function CreateIconFromResourceEx Lib "user32.dll" (presbits As Any, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal Flags 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
    Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
     
    Private IcoBytes() As Byte, hIcon As Long, sz As Long
    
    Private Sub Form_Load() 'let's avoid the FileSystem - and download an *.ico into a ByteArray first
      With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "http://vbRichClient.com/favicon.ico", 0: .Send
        IcoBytes = .ResponseBody 'let's store the result in a ByteArray at Form-level
      End With
    End Sub
    
    Private Sub Form_Click() 'the downloaded Ico from vbRichClient.com contains two Icons (in 16 and 32 size)
      sz = 16: hIcon = GetIconOrCursorFromArray(IcoBytes, sz) 'get the 16x16 version from the ByteArray
      If hIcon Then
         DrawIconEx hDC, sz, 10, hIcon, sz, sz, 0, 0, 3 '<- DI_NORMAL
         DestroyIcon hIcon: hIcon = 0
      End If
      
      sz = 32: hIcon = GetIconOrCursorFromArray(IcoBytes, sz) 'get the 32x32 version from the ByteArray
      If hIcon Then
         DrawIconEx hDC, sz, 6, hIcon, sz, sz, 0, 0, 3 '<- DI_NORMAL
         DestroyIcon hIcon: hIcon = 0
      End If
    End Sub
    
    Public Function GetIconOrCursorFromArray(B() As Byte, ByVal DesiredSize&, Optional HotSpotX!, Optional HotSpotY!) As Long
      Dim bpp, sz As Long, Offs As Long
      For Each bpp In Array(32, 24, 16, 8, 1)
        Offs = GetIcoHdrOffs(B, bpp, DesiredSize, sz, HotSpotX, HotSpotY)
        If Offs Then Exit For
      Next
      If Offs = 0 Then Err.Raise vbObjectError, , "the ByteArray doesn't contain any valid Icons or Cursors"
      
      Offs = B(Offs) + 256& * B(Offs + 1) + 65536 * B(Offs + 2)
      GetIconOrCursorFromArray = CreateIconFromResourceEx(B(Offs), UBound(B) + 1 - Offs, 1, &H30000, sz, sz, 0)
    End Function
    
    Private Function GetIcoHdrOffs(B() As Byte, ByVal bpp&, ByVal dsz&, sz&, hsx!, hsy!) As Long
      Dim i As Long, MaxW(1 To 256) As Integer, Offs As Long
     
      For i = 0 To B(4) - 1
        If B(2) = 1 And B(12 + i * 16) = bpp Then MaxW((511 + B(6 + i * 16)) Mod 256 + 1) = i + 1
        If B(2) = 2 Then 'it's a Cursor-resource apparently
          Offs = B(18 + i * 16) + 256& * B(19 + i * 16) + 65526 * B(20 + i * 16)
          If B(Offs + 14) = bpp Then MaxW((511 + B(6 + i * 16)) Mod 256 + 1) = i + 1
        End If
      Next
      
      For i = 1 To 256
        If MaxW(i) Then sz = i: GetIcoHdrOffs = (MaxW(i) - 1) * 16 + 18
        If GetIcoHdrOffs > 0 And i >= dsz Then Exit For
      Next
      If sz Then hsx = B((MaxW(sz) - 1) * 16 + 10) / sz: hsy = B((MaxW(sz) - 1) * 16 + 12) / sz
    End Function
    Clicking the Form will then produce this IconRender-Output for the two sizes in the IcoByteArray...
    (using a downloaded favicon.ico from vbRichClient.com, where the resulting ByteArray contains a 16x16 and a 32x32 icon):



    HTH

    Olaf

  22. #22
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by dilettante View Post
    Is there some reason to avoid LoadImage()?
    Being able to "derive" hIcons directly from a ByteArray is quite handy.
    (e.g. when you store these Ico-Resources in a DB-Table BlobField, or when they come in via a Download)

    Olaf

  23. #23
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by Schmidt View Post
    Being able to "derive" hIcons directly from a ByteArray is quite handy.
    (e.g. when you store these Ico-Resources in a DB-Table BlobField, or when they come in via a Download)
    Sounds entirely contrived. ICO is not an image format you would normally store in a database or download. But ok, I guess.

    You could also make use of OleLoadPictureEx() to do this:

    Code:
    Public Function GetPic( _
        ByRef Bytes() As Byte, _
        Optional ByVal Size As Integer = LP_DEFAULT) As IPicture
        'Returns Nothing on failure.
        Dim Stream As IUnknown
    
        Set Stream = SHCreateMemStream(Bytes(LBound(Bytes)), UBound(Bytes) - LBound(Bytes) + 1)
        If Not Stream Is Nothing Then
            OleLoadPictureEx Stream, 0, WIN32_FALSE, IID_IPicture, Size, Size, LP_DEFAULT, GetPic
        End If
    End Function
    Name:  sshot.png
Views: 344
Size:  14.2 KB

    No need for any hackery or assumptions about the internal format of ICO files. As a plus you get automatic lifetime management of the hIcon wrapped within the IPicture object, making handle leaks nearly impossible.
    Attached Files Attached Files
    Last edited by dilettante; Apr 10th, 2021 at 10:33 PM. Reason: replaced attachment, cosmetic cleanup

  24. #24
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,412

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by dilettante View Post
    ICO is not an image format you would normally store in a database or download.
    https://en.wikipedia.org/wiki/Favicon

  25. #25
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: CreateIconFromResourceEx not working

    Yes, there is one absurd case. And today it often is not in ICO format anyway.
    Last edited by dilettante; Apr 10th, 2021 at 10:37 PM.

  26. #26
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,412

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by dilettante View Post
    Yes, there is one absurd case.
    How many websites are there? I suspect the vast majority have favicon.ico files that are downloaded.

  27. #27
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: CreateIconFromResourceEx not working

    You're still grasping. And besides, I offered an approach that can do this without ICO spelunking.

  28. #28
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,412

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by dilettante View Post
    Sounds entirely contrived. ICO is not an image format you would normally store in a database or download.
    Quick search shows major browsers download and store favicons in an SQLite database. Who's grasping?

  29. #29
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: CreateIconFromResourceEx not working

    Being able to "derive" hIcons directly from a ByteArray is quite handy.
    (e.g. when you store these Ico-Resources in a DB-Table BlobField, or when they come in via a Download)
    Quote Originally Posted by dilettante View Post
    Sounds entirely contrived...
    But it isn't.
    What you still recommend is, that Image-Resources have to be stored in an age-old platform-specific container:
    - a Dll in "MS-PE-format"

    Nobody out there is storing resources in this way anymore.
    The currently broadest accepted way is, to store the resources (entire resource-folders) in a "Zip-container"
    (although these container-files will not necessarily have the file-extension *.zip).

    Quote Originally Posted by dilettante View Post
    You could also make use of OleLoadPictureEx() to do this:
    To anyone who's still reading this thread... please don't use this -
    because even on Win10 it still chokes on "Vista-Icons with PNG-content".

    See the link below... the "expert" in post #2 knew about this as well...
    https://www.vbforums.com/showthread....a-Icons-VB-Yes

    Quote Originally Posted by dilettante View Post
    No need for any hackery or assumptions about the internal format of ICO files.
    Dile, not every code-snippet you don't understand, is a hack...

    Olaf

    Edit: FWIW, I've just uploaded a Demo for "ZipContainer-based ResourceHandling, queryable via SQL" into the Codebank.
    https://www.vbforums.com/showthread....ontainer-Files
    Last edited by Schmidt; Apr 11th, 2021 at 10:38 AM.

  30. #30
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    673

    Re: CreateIconFromResourceEx not working

    Quote Originally Posted by dilettante View Post
    Sounds entirely contrived. ICO is not an image format you would normally store in a database or download. But ok, I guess.

    You could also make use of OleLoadPictureEx() to do this:

    Code:
    Public Function GetPic( _
        ByRef Bytes() As Byte, _
        Optional ByVal Size As Integer = LP_DEFAULT) As IPicture
        'Returns Nothing on failure.
        Dim Stream As IUnknown
    
        Set Stream = SHCreateMemStream(Bytes(LBound(Bytes)), UBound(Bytes) - LBound(Bytes) + 1)
        If Not Stream Is Nothing Then
            OleLoadPictureEx Stream, 0, WIN32_FALSE, IID_IPicture, Size, Size, LP_DEFAULT, GetPic
        End If
    End Function
    Name:  sshot.png
Views: 344
Size:  14.2 KB

    No need for any hackery or assumptions about the internal format of ICO files. As a plus you get automatic lifetime management of the hIcon wrapped within the IPicture object, making handle leaks nearly impossible.
    in my system win7 run the demo, 3 pictures are all the same size !may be Size =32 \ 48 \128 have no change

Posting Permissions

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



Click Here to Expand Forum to Full Width