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(UnmanagedType.ByValTStr, SizeConst:
=260)> _
Public szDisplayName As String
<VBFixedString(80), MarshalAs(UnmanagedType.ByValTStr, SizeConst:=80)
_
Public szTypeName As String
End Structure
#End Region
Private Declare Function SHGetFileInfo Lib "shell32" Alias
"SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes 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("gdi32.dll", SetLastError:=True)> _
Private Shared Function DeleteObject(ByVal hObject As IntPtr) As Boolean
End Function
<DllImport("user32.dll", CallingConvention:=CallingConvention.Cdecl)> _
Private Shared Function GetIconInfo(ByVal 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(CType(Base.Clone, Icon))
End Function
Public Function CreateObjRef(ByVal RequestedType As System.Type) As
System.Runtime.Remoting.ObjRef
Return Base.CreateObjRef(RequestedType)
End Function
Public Sub Dispose()
Base.Dispose()
End Sub
Public Shared Function FromHandle(ByVal Handle As IntPtr) As ExtendedIcon
Return New ExtendedIcon(Icon.FromHandle(Handle))
End Function
Public Function GetLifeTimeService() As Object
Return Base.GetLifetimeService
End Function
Public Function InitializeLifeTimeService() As Object
Return Base.InitializeLifetimeService()
End Function
Public Sub Save(ByVal ToStream As IO.Stream)
Base.Save(ToStream)
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(Buffer)
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(Buffer)
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(Base.Handle, Info)
Dim bmp As Bitmap = Bitmap.FromHbitmap(Info.hbmColor)
DeleteObject(Info.hbmColor)
DeleteObject(Info.hbmMask)
If Bitmap.GetPixelFormatSize(bmp.PixelFormat) < 32 Then
Return Base.ToBitmap
End If
Dim bmData As Imaging.BitmapData
Dim bmBounds As New Rectangle(0, 0, bmp.Width, bmp.Height)
bmData = bmp.LockBits(bmBounds, _
ImageLockMode.ReadOnly, _
bmp.PixelFormat)
Dim dstBitmap As New Bitmap(bmData.Width, _
bmData.Height, _
bmData.Stride, _
PixelFormat.Format32bppArgb, _
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.ReadInt32(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(dstBitmap)
Else
Return New Bitmap(Base.ToBitmap)
End If
End Function 'Correct alpha blending, picked this up somewhere on the net
Public Shared Function FromFileExtension(ByVal Extension As String, ByVal
Method As FileExtensionMethod, Optional ByVal Size As IconSize = IconSize.
Small) As ExtendedIcon
Select Case Method
Case FileExtensionMethod.DummyFile
'Create a dummy file in the Internet Cache special folder
Dim TheFile As New IO.FileInfo(Environment.GetFolderPath
(Environment.SpecialFolder.InternetCache) & "\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(TheIcon)
Case FileExtensionMethod.Registry
Dim AppPath As String
AppPath = ApplicationPath(Extension) 'Get the associated
application path from the registry
Return New ExtendedIcon(Extract(AppPath, Size)) 'return it's
icon
End Select
End Function
Public Shared Function FromAnyFile(ByVal FilePath As String, Optional
ByVal Size As IconSize = IconSize.Small) As ExtendedIcon
Return New ExtendedIcon(Extract(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(File, 0, aSHFileInfo, cbFileInfo, uflags)
Icon = System.Drawing.Icon.FromHandle(aSHFileInfo.hIcon)
Return Icon
End Function
Private Shared Function ApplicationName(ByVal ext As String) As String
Dim registeredExtension As RegistryKey = Registry.ClassesRoot.
OpenSubKey(ext)
ApplicationName = registeredExtension.GetValue("")
registeredExtension.Close()
End Function
Private Shared Function ApplicationPath(ByVal ext As String) As String
Dim associatedApplication As RegistryKey
Dim AppName As String = ApplicationName(ext)
Dim properties() As String
Try
associatedApplication = Registry.ClassesRoot.OpenSubKey(AppName &
"\shell\open\command")
properties = Split(associatedApplication.GetValue(""), """")
Catch ex As Exception
Exit Function
Finally
associatedApplication.Close()
End Try
If properties Is Nothing OrElse properties.Length = 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.SystemDirectory
& "\" & 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.SeekOrigin) As Long
Select Case origin
Case IO.SeekOrigin.Begin
Pos = offset
Case IO.SeekOrigin.Current
Pos += offset
Case IO.SeekOrigin.End
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 FileExtensionMethod
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 
