Using your code and other code on the internet as well some of my own I made
the extended icon class....
Its a good wrapper....
Note that although your method is nice cause you avoid read/writes from the
disk it is not very reliable....
Check for example icon for ".mdb" using the registry method vs the dummy file
method.
anyway here goes.....
------------------------ Code Start ------------------------------------------
--------------
Imports System.Runtime. InteropServices
Imports System.Drawing, System.Drawing. Imaging
Imports Microsoft.Win32
Public Class ExtendedIcon
'Inherits Drawing.Icon Declared NotInheritable. .. as if there was nothing
wrong with it!
#Region " FileInfo API"
#Region " Constants"
Private Const SHGFI_ICON = &H100
Private Const SHGFI_SMALLICON = &H1
Private Const SHGFI_LARGEICON = &H0
#End Region
#Region " Structures"
Private Structure SHFILEINFO
Public hIcon As IntPtr
Public iIcon As Integer
Public dwAttributes As Integer
<VBFixedString( 260), MarshalAs(Unman agedType.ByValT Str, SizeConst:
=260)> _
Public szDisplayName As String
<VBFixedString( 80), MarshalAs(Unman agedType.ByValT Str, SizeConst:=80)
_
Public szTypeName As String
End Structure
#End Region
Private Declare Function SHGetFileInfo Lib "shell32" Alias
"SHGetFileInfoA " _
(ByVal pszPath As String, _
ByVal dwFileAttribute s As Integer, _
ByRef psfi As SHFILEINFO, _
ByVal ByValcbFileInfo As Integer, _
ByVal uFlags As Integer) As Integer
#End Region 'Get Icon from a file
#Region " IconInfo API"
<DllImport("gdi 32.dll", SetLastError:=T rue)> _
Private Shared Function DeleteObject(By Val hObject As IntPtr) As Boolean
End Function
<DllImport("use r32.dll", CallingConventi on:=CallingConv ention.Cdecl)> _
Private Shared Function GetIconInfo(ByV al hIcon As IntPtr, ByRef
piconinfo As ICONINFO) As Boolean
End Function
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 'Correct alpha blending
Private Base As Icon 'The underlying icon class
#Region " Original Constructors"
Public Sub New(ByVal IconFile As String)
Base = New Icon(IconFile)
End Sub
Public Sub New(ByVal Original As Icon, ByVal Size As Size)
Base = New Icon(Original, Size)
End Sub
Public Sub New(ByVal Type As System.Type, ByVal Resource As String)
Base = New Icon(Type, Resource)
End Sub
Public Sub New(ByVal Stream As IO.Stream)
Base = New Icon(Stream)
End Sub
Public Sub New(ByVal Stream As IO.Stream, ByVal Width As Integer, ByVal
Height As Integer)
Base = New Icon(Stream, Width, Height)
End Sub
#End Region
#Region " Original Methods"
Public Function Clone() As ExtendedIcon
Return New ExtendedIcon(CT ype(Base.Clone, Icon))
End Function
Public Function CreateObjRef(By Val RequestedType As System.Type) As
System.Runtime. Remoting.ObjRef
Return Base.CreateObjR ef(RequestedTyp e)
End Function
Public Sub Dispose()
Base.Dispose()
End Sub
Public Shared Function FromHandle(ByVa l Handle As IntPtr) As ExtendedIcon
Return New ExtendedIcon(Ic on.FromHandle(H andle))
End Function
Public Function GetLifeTimeServ ice() As Object
Return Base.GetLifetim eService
End Function
Public Function InitializeLifeT imeService() As Object
Return Base.Initialize LifetimeService ()
End Function
Public Sub Save(ByVal ToStream As IO.Stream)
Base.Save(ToStr eam)
End Sub
#End Region
#Region " Original Properties"
Public ReadOnly Property Handle() As IntPtr
Get
Return Base.Handle
End Get
End Property
Public ReadOnly Property Height() As Integer
Get
Return Base.Height
End Get
End Property
Public ReadOnly Property Size() As Drawing.Size
Get
Return Base.Size
End Get
End Property
Public ReadOnly Property Width() As Integer
Get
Return Base.Width
End Get
End Property
#End Region
#Region " Added Constructors"
Friend Sub New(ByVal Prototype As Icon)
Base = Prototype
End Sub
Public Sub New(ByVal Stream As IO.Stream, ByVal Size As Size)
Me.New(Stream, Size.Width, Size.Height)
End Sub
Public Sub New(ByVal Buffer As Byte())
Dim Stream As New BufferStream(Bu ffer)
Base = New Icon(Stream)
End Sub
Public Sub New(ByVal Buffer As Byte(), ByVal Size As Size)
Me.New(Buffer, Size.Width, Size.Height)
End Sub
Public Sub New(ByVal Buffer As Byte(), ByVal Width As Integer, ByVal
Height As Integer)
Dim Stream As New BufferStream(Bu ffer)
Base = New Icon(Stream, Width, Height)
End Sub
#End Region
#Region " Added Methods"
Public Function ToBitmap() As Drawing.Bitmap
Dim Info As New ICONINFO
GetIconInfo(Bas e.Handle, Info)
Dim bmp As Bitmap = Bitmap.FromHbit map(Info.hbmCol or)
DeleteObject(In fo.hbmColor)
DeleteObject(In fo.hbmMask)
If Bitmap.GetPixel FormatSize(bmp. PixelFormat) < 32 Then
Return Base.ToBitmap
End If
Dim bmData As Imaging.BitmapD ata
Dim bmBounds As New Rectangle(0, 0, bmp.Width, bmp.Height)
bmData = bmp.LockBits(bm Bounds, _
ImageLockMode.R eadOnly, _
bmp.PixelFormat )
Dim dstBitmap As New Bitmap(bmData.W idth, _
bmData.Height, _
bmData.Stride, _
PixelFormat.For mat32bppArgb, _
bmData.Scan0)
Dim x, y As Integer
Dim IsAlphaBitmap As Boolean = False
For y = 0 To bmData.Height - 1
For x = 0 To bmData.Width - 1
Dim PixelColor As Color
PixelColor = Color.FromArgb( Marshal.ReadInt 32(bmData.Scan0 ,
(bmData.Stride * y) + (4 * x)))
If PixelColor.A > 0 And PixelColor.A < 255 Then
IsAlphaBitmap = True
Exit For
End If
Next
If IsAlphaBitmap Then Exit For
Next
bmp.UnlockBits( bmData)
If IsAlphaBitmap Then
Return New Bitmap(dstBitma p)
Else
Return New Bitmap(Base.ToB itmap)
End If
End Function 'Correct alpha blending, picked this up somewhere on the net
Public Shared Function FromFileExtensi on(ByVal Extension As String, ByVal
Method As FileExtensionMe thod, Optional ByVal Size As IconSize = IconSize.
Small) As ExtendedIcon
Select Case Method
Case FileExtensionMe thod.DummyFile
'Create a dummy file in the Internet Cache special folder
Dim TheFile As New IO.FileInfo(Env ironment.GetFol derPath
(Environment.Sp ecialFolder.Int ernetCache) & "\Dummy." & Extension)
Dim TheIcon As Icon
If Not TheFile.Exists Then 'Dont want to stumble uppon
something
TheFile.Create. Close() 'Just created the file and closed
the stream
TheIcon = Extract(TheFile .FullName, Size)
TheFile.Delete( ) 'We created it so lets kill it
Else
TheIcon = Extract(TheFile .FullName, Size) 'Dont delete
anything that was already there
End If
Return New ExtendedIcon(Th eIcon)
Case FileExtensionMe thod.Registry
Dim AppPath As String
AppPath = ApplicationPath (Extension) 'Get the associated
application path from the registry
Return New ExtendedIcon(Ex tract(AppPath, Size)) 'return it's
icon
End Select
End Function
Public Shared Function FromAnyFile(ByV al FilePath As String, Optional
ByVal Size As IconSize = IconSize.Small) As ExtendedIcon
Return New ExtendedIcon(Ex tract(FilePath, Size))
End Function
#End Region
#Region " Support Methods"
Private Shared Function Extract(ByVal File As String, ByVal Size As
IconSize) As System.Drawing. Icon
Dim aSHFileInfo As SHFILEINFO
Dim cbFileInfo As Integer
Dim uflags As Integer
Dim Icon As System.Drawing. Icon
Select Case Size
Case IconSize.Large
uflags = SHGFI_ICON Or SHGFI_LARGEICON
Case Else
uflags = SHGFI_ICON Or SHGFI_SMALLICON
End Select
cbFileInfo = Marshal.SizeOf( aSHFileInfo)
SHGetFileInfo(F ile, 0, aSHFileInfo, cbFileInfo, uflags)
Icon = System.Drawing. Icon.FromHandle (aSHFileInfo.hI con)
Return Icon
End Function
Private Shared Function ApplicationName (ByVal ext As String) As String
Dim registeredExten sion As RegistryKey = Registry.Classe sRoot.
OpenSubKey(ext)
ApplicationName = registeredExten sion.GetValue(" ")
registeredExten sion.Close()
End Function
Private Shared Function ApplicationPath (ByVal ext As String) As String
Dim associatedAppli cation As RegistryKey
Dim AppName As String = ApplicationName (ext)
Dim properties() As String
Try
associatedAppli cation = Registry.Classe sRoot.OpenSubKe y(AppName &
"\shell\open\co mmand")
properties = Split(associate dApplication.Ge tValue(""), """")
Catch ex As Exception
Exit Function
Finally
associatedAppli cation.Close()
End Try
If properties Is Nothing OrElse properties.Leng th = 0 Then Return ""
Dim S As String
For Each S In properties
If Dir(S) <> "" And S <> "" Then
Return S
End If
If InStr(S, " ") <> 0 Then
Dim SS() As String = S.Split
Dim f As String
For Each f In SS
If InStr(f, "\") = 0 Then f = Environment.Sys temDirectory
& "\" & f
If Dir(f) <> "" And f <> "" Then
Return f
End If
Next
End If
Next
End Function
#End Region
#Region " Support Classes"
Private Class BufferStream
Inherits IO.Stream
Private Buffer As Byte()
Private Pos As Long
Sub New(ByVal B As Byte())
Buffer = B
End Sub
Public Overrides ReadOnly Property CanRead() As Boolean
Get
Return False
End Get
End Property
Public Overrides ReadOnly Property CanSeek() As Boolean
Get
Return False
End Get
End Property
Public Overrides ReadOnly Property CanWrite() As Boolean
Get
Return False
End Get
End Property
Public Overrides Sub Flush()
End Sub
Public Overrides ReadOnly Property Length() As Long
Get
Return Buffer.Length
End Get
End Property
Public Overrides Property Position() As Long
Get
Return Pos
End Get
Set(ByVal Value As Long)
Pos = Value
End Set
End Property
Public Overrides Function Read(ByVal inbuffer() As Byte, ByVal offset
As Integer, ByVal count As Integer) As Integer
Dim i As Long, ib As Integer
'Stupid Icon class reads everything at once...
'I gave it a length of 160MB and it still tried to read it at
once
For i = Pos + offset To Pos + offset + count - 1
inbuffer(ib) = Buffer(i)
ib += 1
Next
End Function
Public Overrides Function Seek(ByVal offset As Long, ByVal origin As
System.IO.SeekO rigin) As Long
Select Case origin
Case IO.SeekOrigin.B egin
Pos = offset
Case IO.SeekOrigin.C urrent
Pos += offset
Case IO.SeekOrigin.E nd
Pos = Buffer.Length - offset
End Select
End Function
Public Overrides Sub SetLength(ByVal value As Long)
End Sub
Public Overrides Sub Write(ByVal buffer() As Byte, ByVal offset As
Integer, ByVal count As Integer)
End Sub
Sub Dispose()
Erase Buffer
End Sub
End Class 'For constructor using byte array
#End Region
End Class
#Region " Enums"
Public Enum FileExtensionMe thod
Registry 'Check the windows Registry... Not 100%
DummyFile ' Create a dummy file with the extension and let windows decide
End Enum
Public Enum IconSize
Small ' eeeer Small :)
Large ' If not small then...
End Enum
#End Region
------------------------------------------ Code End --------------------------
-----------------
--
Message posted via
http://www.dotnetmonster.com 
