function hIcon2fbImage(byval hIcon as HICON) as FB.Image ptr
' This function converts an HICON to an FB.Image.
'
' Important:
' 1) This implementation does not account for black&white icons.
' 2) If an icon is fully transparent, stored in 32-bit and didn't set
' the transparency-mask, then you will get a fully opaque icon
' with whatever background colour was used.
' The implementation is hacky. I couldn't find a way to determine
' if the bitrate of the originally loaded icon is 32-bit or lower.
' If it is lower than 32-bit, then Windows still responds with
' "it's 32-bit". Unfortunately Windows doesn't fill the alpha
' channel, so that when displaying it using alpha channels, the
' icon will be fully transparent.
' I couldn't find a way to reliably determine, if an icon is
' 32-bit or lower. The following occurs:
' a) The icon is 32-bit and has some alpha values which are not 0
' and also not 255 (i.e. neither fully transparent nor fully
' opaque). In that case the script finds these pixels and knows
' that the icon was originally in 32-bit.
' b) The icon is 32-bit but is completely transparent (all alpha
' values are zero). Furthermore the transparency bitmask was
' not set (i.e. it's all zero). Due to all-zero alpha values
' the script does not know that it's a 32-bit image. It will
' then look at the bitmask. If the bitmask says "this pixel is
' opaque" (i.e. the the pixel has a value of zero in the
' bitmask), then the script will assume that the image has a
' bitrate lower than 32. Since the bitmask is fully zero, it
' will, erroneously, set the image as fully opaque.
' c) The icon has a bitrate lower than 32-bit. Then all alpha
' values will be zero. The script will then use the bitmask to
' determine if a pixel is supposed to be fully opaque or fully
' transparent.
' 3) This implementation assumes that "standard" icons are used, i.e.,
' icons with a width that is a multiple of 16. Otherwise memory
' alignment requires another step (using a temporary buffer).
'

' Check alignment.
' We cannot use getDIBits, if the bits used per row don't match the width
' times the bits per pixel. getDIBits does not account for the padding in
' each row. Icons usually have a width that is a multiple of 16. Thus,
' generally, we shouldn't have an alignment issue.
' As a remedy, if there is padding, we could use a temporary buffer that we
' pass to getDIBits and then copy the buffer (with padding) to the image.
assert(img->pitch = w*(img->bpp))
if img->pitch <> w*(img->bpp) then
imageDestroy(img)
deleteObject(icoInfo.hbmMask)
deleteObject(icoInfo.hbmColor)
return 0
end if

' Determine whether the original icon is 32-bit or lower.
' If the original icon is 32-bit but fully transparent and did not set the
' bitmask to white, then this script will, erroneously, think that the
' original image has a bitrate lower than 32.
for i as integer = 0 to img->height-1
for j as integer = 0 to img->width-1
dim as ubyte ptr p = getPixelAddress(img,i,j)+3
if (*p > 0) then
deleteObject(icoInfo.hbmMask)
deleteObject(icoInfo.hbmColor)
return img
end if
next j
next i

' We have determined that the original image is not 32-bit. Thus the alpha
' channel is set to completely transparent. We will now fix that.
' Generally 24-bit encoding doesn't allow for transparency information.
' However the icon comes with a bitmask which determines if a pixel is
' fully opaque or fully transparent.
' We will now make use of it and set the pixels accordingly.
' Note: We only need to act, if the bitmask defines a pixel to be fully
' opaque (since it already is fully transparent).
' Fully opaque is encoded as "black", i.e., zero.
for i as integer = 0 to img->height-1
for j as integer = 0 to img->width-1
dim as const ulong src_transparencyMask = *(imgb+i*w+j)
if (src_transparencyMask = 0) then
dim as ubyte ptr alpha_byte = getPixelAddress(img,i,j)+3
*alpha_byte = 255
end if
next j
next i
deleteObject(icoInfo.hbmMask)
deleteObject(icoInfo.hbmColor)

for i as integer = lbound(icons) to ubound(icons)
if fileExists(icons(i)) then
extractIconEx(icons(i), 0, @hLargeIcon, @hSmallIcon, 1)
smallIcon = hIcon2fbImage(hSmallIcon)
largeIcon = hIcon2fbImage(hLargeIcon)
destroyIcon(hSmallIcon)
destroyIcon(hLargeIcon)
if smallIcon then
put (100, 10+50*(i-1)), smallIcon, ALPHA
imageDestroy(smallIcon)
end if
if largeIcon then
put (150, 10+50*(i-1)), largeIcon, ALPHA
imageDestroy(largeIcon)
end if
end if
next i
sleep

type T_BASE_ICONDIR_ENTRY field = 1
private:
_width as const ubyte ' A value of "0" means a width of 256.
_height as const ubyte ' A value of "0" means a height of 256.

public:
declare const property width() as integer
declare const property height() as integer
cColorsInPalette as const ubyte ' Number of colors in the color palette.
' Must be "0", if the color palette is
' missing. Is zero for images with a
' bitrate higher than 8.
reserved as const ubyte ' Should be "0".
colorPlane as const ushort ' Should be 0 or 1.
bpp as ushort ' bits per pixel (might not be specified)
szImageData as const ulong ' number of bytes of the image data
end type

public const property T_BASE_ICONDIR_ENTRY.width() as integer
if this._width = 0 then
return 256
else
return cast(uinteger,this._width)
end if
end property

public const property T_BASE_ICONDIR_ENTRY.height() as integer
if this._height = 0 then
return 256
else
return cast(integer,this._height)
end if
end property

type T_BASE_ICONDIR_HEADER field = 1
reserved as const ushort ' Must be "0".
contentType as const ushort ' Must be "1" for icon or "2" for cursor image.
cEntries as const ushort ' Number of images.
end type

' We have two different structs extended from a parent struct. Both extended
' structs have different sizes. Thus, if we cast a pointer which points to an
' array of the structs, and access it as x[i], it will yield wrong results.
' We need to account for the differenz sizes. Therefore, first, we will cast
' "x" to a byte pointer and then add sizeof(originalStruct)*index.
' Afterwards, we cast the result back to the parent struct type "typeof(*x)".
#macro ao(x,i,szT)
cptr( typeof(*(x)) ptr, _
cptr(byte ptr,(x)) + (i)*(szT) _
)
#endmacro

function getPreferredImage( _
byval entries as const T_BASE_ICONDIR_ENTRY ptr, _
byval szT as const integer, _
byval cEntries as const integer, _
byval prefResX as const integer, _
byval prefResY as const integer, _
byval prefBitDepth as const integer) as integer
' Find the icon image that resembles the preferred parameters the most.
' First find the images which are the closest in size.
' Images with the same ratio are preferred, even if they're much larger.
' Among them find the image with the same color depth as the preferred one.
' If that doesn't exist, find the image with a color depth which is
' larger and closest to the preferred one.
' If that doesn't exist, find the image with a color depth which is
' smaller and closest to the preferred one.
'
dim as integer imgID = -1
if (cEntries <= 0) then return imgID

' No need to continue searching for a better fit, if the fit is already
' perfect.
if (bestErrSize = 0) andAlso (bestErrRatio = 0) andAlso (bestErrBpp = 0) then
return imgID
end if
next i

return imgID
end function

sub determineColorDepth overload(byval entry as T_BASE_ICONDIR_ENTRY ptr)
' The color depth of the icon images can be zero (not specified).
' We cannot reliably determine the color depth by looking at the number
' of color planes or the number of colors in the palette.
' color planes:
' In new icons this is usually set to 1, independent of the color
' depth. But there are also many icons which set it to 0.
' According to wikipedia values greater than 1 are also possible.
' colors in palette:
' This should only be greater than 0, if the color depth is <= 8.
' If 256 colors are used, then this value will be zero.
' This value will also be zero for icons with more than 256 colors.
' If an icon has a color depth of 4 bit, then the number of colors
' doesn't have to equal 16. It can also be 15 or 14 etc.
' We could now use the number of colors in the palette to determine
' the bit rate for many icons. Say an icon uses 158 colors, then the
' color depth would be 8 bit. However here's the big problem:
' If this value is wrong and we pass the wrong color depth to Windows,
' then our programme will crash. However it will do just fine, if we
' leave the color depth specification blank.
' So rather than risking a crash, we will let Windows determine the
' correct color depth by analyzing the image data. Unfortunately
' we cannot query Windows for the color depth.
' This will influence how we select the icon that fits best to the
' user's preferences and also the conversion to an FB.Image.
' For the latter, see the function description of "hIcon2fbImage".
'
' A not implemented alternative is to determine the color depth ourselves,
' by analyzing the image data (BMP- and PNG-format).
'
end sub

sub determineColorDepth overload( _
byval entries as T_BASE_ICONDIR_ENTRY ptr, _
byval szT as const integer, _
byval cEntries as const integer)
for i as integer = 0 to cEntries-1
dim as T_BASE_ICONDIR_ENTRY ptr entry = ao(entries,i,szT)
' First let's check whether the color depth is not specified.
if ( entry->bpp = 0 ) then
determineColorDepth(entry)
end if
next i
end sub

' Load the library (exe or dll) as a datafile.
' This enables us to load 32-bit libraries as a 64-bit programme and
' vice versa.
dim as HMODULE hMod = loadLibraryEx(filename,0,LOAD_LIBRARY_AS_DATAFILE)
if (hMod = 0) then return 0

sub fixTransparency(byval img as FB.Image ptr, byval imgb as ulong ptr)
' We have determined that the original image is not 32-bit. Thus the alpha
' channel is set to completely transparent. We will now fix that.
' Generally 24-bit encoding doesn't allow for transparency information.
' However the icon comes with a bitmask which determines if a pixel is
' fully opaque or fully transparent.
' We will now make use of it and set the pixels accordingly.
' Note: We only need to act, if the bitmask defines a pixel to be fully
' opaque (since it already is fully transparent).
' Fully opaque is encoded as "black", i.e., zero.
dim as const integer w = img->width
dim as const integer h = img->height
for i as integer = 0 to h-1
for j as integer = 0 to w-1
dim as const ulong src_transparencyMask = *(imgb+i*w+j)
if (src_transparencyMask = 0) then
dim as ubyte ptr alpha_byte = getPixelAddress(img,i,j)+3
*alpha_byte = 255
end if
next j
next i
end sub

function isFullyTransparent(byval img as FB.Image ptr) as boolean
for i as integer = 0 to img->height-1
for j as integer = 0 to img->width-1
dim as const ubyte ptr p = getPixelAddress(img,i,j)+3
if (*p > 0) then return FALSE
next j
next i
return TRUE
end function

function hIcon2fbImage(byval hIcon as HICON, byval bpp as const integer = 0) as FB.Image ptr
' This function converts an HICON to an FB.Image.
'
' Important:
' 1) This implementation does not account for black&white icons.
' 2) If the color depth wasn't specified and the icon is fully transparent,
' stored in 32-bit and didn't set the transparency-mask, then you
' will get a fully opaque icon with whatever background color was used.
' The implementation is hacky. I couldn't find a robust way to
' determine if the bitrate of the originally loaded icon is 32-bit
' or lower. Unfortunately Windows doesn't fill the alpha
' channel, so that when displaying it using alpha channels, the
' icon will be fully transparent. The following occurs if the bit
' depth is not specified via "bpp":
' a) The icon is 32-bit and has some alpha values which are not 0
' (i.e. not fully transparent). In that case the script finds
' these pixels and knows that the icon was originally in 32-bit.
' b) The icon is 32-bit but is completely transparent (all alpha
' values are zero). Furthermore the transparency bitmask was
' not set (i.e. it's all zero). Due to all-zero alpha values
' the script does not know that it's a 32-bit image. It will
' then look at the bitmask. If the bitmask says "this pixel is
' opaque" (i.e. the the pixel has a value of zero in the
' bitmask), then the script will assume that the image has a
' bitrate lower than 32. Since the bitmask is fully zero, it
' will, erroneously, set the image as fully opaque.
' c) The icon has a bitrate lower than 32-bit. Then all alpha
' values will be zero. The script will then use the bitmask to
' determine if a pixel is supposed to be fully opaque or fully
' transparent.
' 3) This implementation assumes that "standard" icons are used, i.e.,
' icons with a width that is a multiple of 16. Otherwise memory
' alignment issues require another step (using a temporary buffer).
'

' Check alignment.
' We cannot use getDIBits, if the bits used per row don't match the width
' times the bits per pixel. getDIBits does not account for the padding in
' each row. Icons usually have a width that is a multiple of 16. Thus,
' generally, we shouldn't have an alignment issue.
' As a remedy, if there is padding, we could use a temporary buffer that we
' pass to getDIBits and then copy the buffer (with padding) to the image.
assert(img->pitch = w*(img->bpp))
if img->pitch <> w*(img->bpp) then
imageDestroy(img)
deleteObject(icoInfo.hbmMask)
deleteObject(icoInfo.hbmColor)
return 0
end if

dim as boolean doFixTransparency = FALSE
if (bpp > 0) then
if (bpp < 32) then doFixTransparency = TRUE
else
' Determine whether the original icon is 32-bit or lower.
' If the original icon is 32-bit but fully transparent and did not set the
' bitmask to white, then this script will, erroneously, think that the
' original image has a bitrate lower than 32.
doFixTransparency = isFullyTransparent(img)
end if