Imports System.Runtime.InteropServices
Imports System.Drawing.Imaging
Public Class IconExtraction
#Region "API"
<DllImport("shell32.dll", EntryPoint:="ExtractIconEx", CharSet:=CharSet.Auto)> _
Private Shared Function ExtractIconEx(ByVal Filename As String, ByVal IconIndex As Integer, ByRef hIconLarge As IntPtr, ByRef hIconSmall As IntPtr, ByVal IconCount As Integer) As IntPtr
End Function
<DllImport("shell32.dll", EntryPoint:="SHGetFileInfo", CharSet:=CharSet.Auto)> _
Private Shared Function SHGetFileInfo(ByVal FileName As String, ByVal FileAttributes As Integer, ByRef Buffer As SHFileInfo, ByVal FileInfo As Integer, ByVal Flags As Integer) As IntPtr
End Function
<DllImport("user32", EntryPoint:="GetIconInfo", CharSet:=CharSet.Auto)> _
Private Shared Function GetIconInfo(ByVal hIcon As IntPtr, ByRef piconinfo As ICONINFO) As IntPtr
End Function
<DllImport("Gdi32", EntryPoint:="CreateDC", CharSet:=CharSet.Auto)> _
Private Shared Function CreateDC(ByVal Driver As String, ByVal DeviceName As String, ByVal Output As String, ByVal Mode As IntPtr) As IntPtr
End Function
<DllImport("Gdi32", EntryPoint:="GetDeviceCaps", CharSet:=CharSet.Auto)> _
Private Shared Function GetDeviceCaps(ByVal hDC As IntPtr, ByVal Index As Integer) As Integer
End Function
<DllImport("Gdi32", EntryPoint:="DeleteDC", CharSet:=CharSet.Auto)> _
Private Shared Function DeleteDC(ByVal hDC As IntPtr) As Boolean
End Function
<DllImport("user32", EntryPoint:="DestroyIcon", CharSet:=CharSet.Auto)> _
Private Shared Function DestroyIcon(ByVal hIcon As IntPtr) As IntPtr
End Function
#End Region
#Region "Structures"
Private Structure SHFileInfo
Public hIcon As IntPtr
Public iIcon As Integer
Public dwAttributes As Integer
Public szDisplayName As String
Public szTypeName As String
End Structure
Private Structure ICONINFO
Dim fIcon As Boolean
Dim xHotspot As Integer
Dim yHotspot As Integer
Dim hbmMask As IntPtr
Dim hbmColor As IntPtr
End Structure
#End Region
#Region "Constants"
Private Const SHGFI_ICON = &H100
Private Const SHGFI_SMALLICON = &H1 ' Small icon
Private Const SHGFI_LARGEICON = &H0 ' Large icon
Private Const SHGFI_USEFILEATTRIBUTES = &H10
Private Const BITSPIXEL As Integer = 12
Private Const PLANES As Integer = 14
#End Region
#Region "Private Functions"
'Used by the alphafix
Private Shared Function GetColorDepth() As Integer
Dim screenDC As IntPtr = CreateDC("DISPLAY", Nothing, Nothing, IntPtr.Zero)
Dim bitDepth As Integer = GetDeviceCaps(screenDC, BITSPIXEL)
bitDepth *= GetDeviceCaps(screenDC, PLANES)
DeleteDC(screenDC)
Return bitDepth
End Function
Private Shared Function FixAlphaBitmap(ByVal bmSource As Bitmap) As Bitmap
Dim X, Y As Integer
Dim C As Color
Dim bAlphaFound As Boolean
'WARNING! This function will fail if the passed bitmap is not of
'the correct Pixelformat.
Dim bmData As Imaging.BitmapData
Dim bmBounds As New Rectangle(0, 0, bmSource.Width, bmSource.Height)
'create a new bitmap with an ARGB format and point it to the same memory
'location as the original bitmap.
bmData = bmSource.LockBits(bmBounds, ImageLockMode.ReadOnly, bmSource.PixelFormat)
Dim dstBitmap As New Bitmap(bmData.Width, bmData.Height, bmData.Stride, PixelFormat.Format32bppArgb, bmData.Scan0)
bmSource.UnlockBits(bmData)
bmData = Nothing
For Y = 0 To dstBitmap.Height - 1
For X = 0 To dstBitmap.Width - 1
C = dstBitmap.GetPixel(X, Y)
If C.A <> 0 Then
bAlphaFound = True
Exit For
End If
Next
If bAlphaFound = True Then Exit For
Next
If Not bAlphaFound Then dstBitmap = Nothing
Return dstBitmap
End Function
#End Region
Public Shared Function GetIconCount(ByVal FileName As String) As Integer
Dim hCount As IntPtr
hCount = ExtractIconEx(FileName, -1, Nothing, Nothing, 1)
Return hCount.ToInt32
End Function
Public Shared Function ExtractLargeIcon(ByVal FileName As String, ByVal Index As Integer) As Icon
Dim hIcon As IntPtr
ExtractIconEx(FileName, Index, hIcon, Nothing, 1)
Return Icon.FromHandle(hIcon)
End Function
Public Shared Function ExtractSmallIcon(ByVal FileName As String, ByVal Index As Integer) As Icon
Dim hIcon As IntPtr
ExtractIconEx(FileName, Index, Nothing, hIcon, 1)
Return Icon.FromHandle(hIcon)
End Function
Public Shared Function ExtractLargeAssociatedIcon(ByVal FileName As String) As Icon
Dim sh As New SHFileInfo()
SHGetFileInfo(FileName, 0, sh, Marshal.SizeOf(sh), SHGFI_ICON Or SHGFI_LARGEICON Or SHGFI_USEFILEATTRIBUTES)
GC.Collect()
Return Icon.FromHandle(sh.hIcon)
End Function
Public Shared Function ExtractSmallAssociatedIcon(ByVal FileName As String) As Icon
Dim sh As New SHFileInfo()
SHGetFileInfo(FileName, 0, sh, Marshal.SizeOf(sh), SHGFI_ICON Or SHGFI_SMALLICON Or SHGFI_USEFILEATTRIBUTES)
GC.Collect()
Return Icon.FromHandle(sh.hIcon)
End Function
Public Shared Function ConvertToBitmap(ByVal hIcon As IntPtr) As Bitmap
Dim B As Bitmap
Dim hBitmap As IntPtr
Dim bmp As Bitmap
Dim ii As New ICONINFO()
GetIconInfo(hIcon, ii)
hBitmap = ii.hbmColor
bmp = Bitmap.FromHbitmap(hBitmap)
If Environment.OSVersion.Version.Major >= 5 AndAlso _
Environment.OSVersion.Version.Minor >= 1 AndAlso _
GetColorDepth() = 32 Then
Try
B = FixAlphaBitmap(bmp).Clone
Catch
If B Is Nothing Then B = Bitmap.FromHicon(hIcon)
End Try
Else
B = Bitmap.FromHicon(hIcon)
End If
DestroyIcon(hBitmap)
DestroyIcon(hIcon)
GC.Collect()
hBitmap = Nothing
bmp = Nothing
ii = Nothing
Return B
End Function
End Class
