Quote:
> Yes, I've seen that call before. It returns two handles, one to the
BitMask
> data, and one to the Color-data. But after that I'm again stuck ....
For
> some reason I than have to do/should be doing a number of things, like
> retrieving (?) the icon's bitmap-header (that does not want to match with
> the Icon I just loaded :-( )
Yes, the Bitmap's returned by ExtractIcon() are Device Dependant Bitmap's
and as such bound to screen resolution (Or always 1-bpp in the case of the
mask). Here's an example of how to use the function to retrieve the
information if you or anyone else needs it:
'***
Private Declare Function GetIconInfo Lib "user32" _
(ByVal hIcon As Long, ByRef piconinfo As IconInfo) As Long
Private Declare Function GetObject Lib "gdi32" Alias _
"GetObjectA" (ByVal hObject As Long, _
ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" _
Alias "ExtractIconA" (ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Declare Function DestroyIcon Lib "user32" _
(ByVal hIcon As Long) As Long
Private Type IconInfo
fIcon As Long
xHotspot As Long
yHotspot As Long
hbmMask As Long
hbmColor As Long
End Type
Private Type Bitmap ' 14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Sub Form_Load()
Dim IconInf As IconInfo
Dim MaskBMInf As Bitmap
Dim ColourBMInf As Bitmap
Dim hIcon As Long
' Extract the icon from the file
hIcon = ExtractIcon(App.hInstance, _
"C:\WinNT\System32\Shell32.dll", 0)
If (hIcon) Then
' Grab the icon information
Call GetIconInfo(hIcon, IconInf)
' Grab the Bitmap information
Call GetObject(IconInf.hbmMask, _
Len(MaskBMInf), MaskBMInf)
Call GetObject(IconInf.hbmColor, _
Len(ColourBMInf), ColourBMInf)
' Display what we got back
Call MsgBox("[ Icon ]:" & vbCrLf & _
"Icon: " & CBool(IconInf.fIcon) & vbCrLf & _
"Hotspot: " & IconInf.xHotspot & ", " & _
IconInf.yHotspot & vbCrLf & _
vbCrLf & "[ Mask ]:" & vbCrLf & _
BMInfToSting(MaskBMInf) & vbCrLf & _
vbCrLf & "[ Colour ]:" & vbCrLf & _
BMInfToSting(ColourBMInf), _
vbInformation, "Icon info")
' Delete source bitmaps (They're only copies)
Call DeleteObject(IconInf.hbmColor)
Call DeleteObject(IconInf.hbmMask)
' Clean up icon
Call DestroyIcon(hIcon)
End If
End Sub
Private Function BMInfToSting(ByRef inInf As Bitmap) As String
With inInf
BMInfToSting = "Type: " & .bmType & vbCrLf & _
"Width: " & .bmWidth & vbCrLf & _
"Height: " & .bmHeight & vbCrLf & _
"WidthBytes: " & .bmWidthBytes & vbCrLf & _
"Planes: " & .bmPlanes & vbCrLf & _
"BitsPixel: " & .bmBitsPixel & vbCrLf & _
"Bits(): 0x" & Hex(.bmBits)
End With
End Function
'***
Quote:
> and some other stuff, like with the
> Device-Context, which feels like I'm busy making a detour around the
world,
> when all I seek to do is to get my hands on on the icon-data of the
> just-extracted icon ...
Once you have the Bitmap handles you can use GetBitmapBits() to extract the
raw data directly from the image into a VB Byte array, mess around with the
data then blast it all back with SetBitmapBits(). Alternatively if you
don't feel comfortable writing bit-depth independent code (The screen could
be running at any number of different bit-depths) then you can select the
Bitmap's temporarily into DC's, then use the GetDIBits() call to extract the
data in a device independent form. Similarly SetDIBits() will push the data
back again when you're done editing it but be careful on palette'd displays,
this technique often results in odd effects due to the GDI's odd way of
colour re-mapping.
Quote:
> Well, that part I've allready nailed-down. With aid of exactly the site
> you're suggesting I've retrieved the description of how the icon-file
should
> look like. I'm able to, by way of a very crude re-assembly of an on-screen
> Icon (in an image-box) (scanning it pixel-by-pixel to re-create the
> Color-table for example) to generate a (somewhat) acceptable icon-file.
So,
> it should not be a problem (anymore :-)
Here's an example of the above methods it will extract the icon information,
invert the data, reset the data and draw it:
'***
Private Declare Function GetIconInfo Lib "user32" _
(ByVal hIcon As Long, ByRef piconinfo As IconInfo) As Long
Private Declare Function GetObject Lib "gdi32" Alias _
"GetObjectA" (ByVal hObject As Long, _
ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Declare Function DestroyIcon Lib "user32" _
(ByVal hIcon 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 GetDIBits Lib "gdi32" _
(ByVal aHDC As Long, ByVal hBitmap As Long, _
ByVal nStartScan As Long, ByVal nNumScans As Long, _
ByRef lpBits As Any, ByRef lpBI As BITMAPINFOHEADER, _
ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" _
(ByVal hdc As Long, ByVal hBitmap As Long, _
ByVal nStartScan As Long, ByVal nNumScans As Long, _
ByRef lpBits As Any, ByRef lpBI As BITMAPINFOHEADER, _
ByVal wUsage As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" _
(ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" _
(ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function BitBlt Lib "gdi32" _
(ByVal hDestDC As Long, ByVal x As Long, _
ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Type IconInfo
fIcon As Long
xHotspot As Long
yHotspot As Long
hbmMask As Long
hbmColor As Long
End Type
Private Type Bitmap ' 14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Type BITMAPINFOHEADER '40 bytes
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPel{*filter*}eter As Long
biYPel{*filter*}eter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private Function DrawInvIcon(ByVal outDC As Long, _
ByVal outX As Long, ByVal outY As Long, _
ByVal inIcon As Long) As Boolean
Dim IconInf As IconInfo
Dim MaskBMInf As Bitmap
Dim ColourBMInf As Bitmap
Dim MyDC As Long, OldBMP As Long
Dim BMData() As Byte
Dim BMInf As BITMAPINFOHEADER
Dim LoopData As Long
Dim MaskDC As Long, OldMask As Long
Dim OldFore As Long, OldBack As Long
' Check the icon exists
If (inIcon = 0) Then Exit Function
' Grab the icon information
If (GetIconInfo(inIcon, IconInf) = 0) Then Exit Function
' Grab the Bitmap information
Call GetObject(IconInf.hbmMask, _
Len(MaskBMInf), MaskBMInf)
Call GetObject(IconInf.hbmColor, _
Len(ColourBMInf), ColourBMInf)
' Create temporary device context
MyDC = CreateCompatibleDC(0)
' Select Colour part of icon into DC
OldBMP = SelectObject(MyDC, IconInf.hbmColor)
If (OldBMP) Then ' Set bitmap information
With BMInf
.biWidth = ColourBMInf.bmWidth
.biHeight = ColourBMInf.bmHeight
.biBitCount = 32
.biPlanes = 1
.biSize = Len(BMInf)
.biSizeImage = ( _
ColourBMInf.bmWidthBytes * _
ColourBMInf.bmHeight)
' Size data array
ReDim BMData(.biSizeImage - 1) As Byte
End With
' Grab Bitmap data from the colour Bitmap
If (GetDIBits(MyDC, IconInf.hbmColor, 0, _
ColourBMInf.bmHeight, BMData(0), BMInf, 0)) Then
' Invert Bitmap data
For LoopData = 0 To BMInf.biSizeImage - 1
BMData(LoopData) = BMData(LoopData) Xor &HFF
Next LoopData
' Push edited data back into the colour Bitmap
Call SetDIBits(MyDC, IconInf.hbmColor, 0, _
ColourBMInf.bmHeight, BMData(0), BMInf, 0)
End If
' Create new DC, select mask Bitmap into it
MaskDC = CreateCompatibleDC(0)
OldMask = SelectObject(MaskDC, IconInf.hbmMask)
' Set the fore and back colours in preperation
' to draw the mask onto the colour data
Call SetTextColor(MyDC, vbWhite)
Call SetBkColor(MyDC, vbBlack)
' Overlay mask image onto colour image
' (The masked area's must be black,
' we've just inverted them to white)
Call BitBlt(MyDC, 0, 0, BMInf.biWidth, _
BMInf.biHeight, MaskDC, 0, 0, vbSrcAnd)
' Set the fore and back colours of the
' destination canvas to draw mask
OldFore = SetTextColor(outDC, vbWhite)
OldBack = SetTextColor(outDC, vbBlack)
' Draw the mask to the destination DC
Call BitBlt(outDC, outX, outY, BMInf.biWidth, _
BMInf.biHeight, MaskDC, 0, 0, vbSrcAnd)
' Overlay the colour data
Call BitBlt(outDC, outX, outY, BMInf.biWidth,
...
Icons - How to gain access to the Mask, image as well as the Color-table : ExtractIcon