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.
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.
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.
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
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.
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
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").
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.
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.
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.
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.
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.
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):
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)
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
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.
Last edited by dilettante; Apr 10th, 2021 at 10:33 PM.
Reason: replaced attachment, cosmetic cleanup
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)
Originally Posted by dilettante
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).
Originally Posted by dilettante
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".
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
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