Soyez le premier à donner votre avis sur cette source.
Snippet vu 9 258 fois - Téléchargée 36 fois
Imports System.IO Imports Microsoft.Win32 Imports System Imports System.Drawing Imports System.Runtime.InteropServices Public Class AdvancedFileSysInfo Inherits System.IO.FileSystemInfo ' Enumération des valeurs dispo pour le paramètre flag de SHGetFileInfo <Flags()> Private Enum SHGFI SmallIcon = &H1 LargeIcon = &H0 Icon = &H100 DisplayName = &H200 Typename = &H400 SysIconIndex = &H4000 UseFileAttributes = &H10 End Enum Public Enum IconType SmallIcon = True LargeIcon = False End Enum ' Structure contenant les informations sur un objet du filesystem <StructLayout(LayoutKind.Sequential)> _ Private Structure SHFILEINFO Public hIcon As IntPtr Public iIcon As Integer Public dwAttributes As Integer <MarshalAs(UnmanagedType.LPStr, SizeConst:=260)> _ Public szDisplayName As String <MarshalAs(UnmanagedType.LPStr, SizeConst:=80)> _ Public szTypeName As String Public Sub New(ByVal B As Boolean) hIcon = IntPtr.Zero iIcon = 0 dwAttributes = 0 szDisplayName = vbNullString szTypeName = vbNullString End Sub End Structure ' Permet de retourver les informations sur un fichier, un répertoire, un disque Private Declare Auto Function SHGetFileInfo Lib "shell32" ( _ ByVal pszPath As String, ByVal dwFileAttributes As Integer, _ ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Integer, ByVal uFlagsn As SHGFI) As Integer Public Overrides ReadOnly Property Name() As String Get Dim Info As New FileInfo(Me.OriginalPath) Name = Info.Name Info = Nothing End Get End Property Public Overrides Sub Delete() Dim Info As New FileInfo(Me.OriginalPath) Info.Delete() Info = Nothing End Sub Public Overrides ReadOnly Property Exists() As Boolean Get Dim Info As New FileInfo(Me.OriginalPath) Exists = Info.Exists Info = Nothing End Get End Property ' Cette propriété retourne un icone, celui affiché dans l'explorer Public ReadOnly Property AssociatedIcon(ByVal IconSize As IconType, Optional ByVal MustExist As Boolean = True) As Icon Get If MustExist Then If Me.Exists Then Dim Info As New FileInfo(Me.OriginalPath) AssociatedIcon = GetIcon(Info.Extension, IconSize) Info = Nothing Else AssociatedIcon = Nothing End If Else Dim Info As New FileInfo(Me.OriginalPath) AssociatedIcon = GetIcon(Info.Extension, IconSize) Info = Nothing End If End Get End Property ' Permet de récupérer l'icone du fichier tel qu'il apparait dans l'explorer Private Function GetIcon(ByVal Path As String, Optional ByVal Ico As IconType = True) As Icon Dim info As New SHFILEINFO(True) Dim cbSizeInfo As Integer = Marshal.SizeOf(info) Dim flags As SHGFI = SHGFI.Icon Or SHGFI.UseFileAttributes If Ico = True Then flags += SHGFI.SmallIcon Else flags += SHGFI.LargeIcon End If SHGetFileInfo(Path, 256, info, cbSizeInfo, flags) Return Icon.FromHandle(info.hIcon) End Function Private Function ExtractDefaultIcon() As String Dim HKROOT As Registry Dim hsubKey As RegistryKey Dim sApplication As String ExtractDefaultIcon = "" hsubKey = HKROOT.ClassesRoot.OpenSubKey(Me.Extension) If Not hsubKey Is Nothing Then sApplication = hsubKey.GetValue("") hsubKey.Close() hsubKey = HKROOT.ClassesRoot.OpenSubKey(sApplication & "\DefaultIcon") If Not hsubKey Is Nothing Then ExtractDefaultIcon = hsubKey.GetValue("") hsubKey.Close() End If End If hsubKey = Nothing HKROOT = Nothing End Function Public Sub New(ByVal FileName As String) Me.OriginalPath = FileName End Sub End Class
11 déc. 2010 à 23:26
thePictureBox.Image = System.Drawing.Icon.ExtractAssociatedIcon(theFile).ToBitmap()
Il y a peut-être des limites, mais cela fonctionne, du moins avec VB 2010 Express.
21 mars 2010 à 14:33
21 mars 2010 à 14:32
Dans ton programme ça marche mais étrangement quand je l'implémente dans un de mes projets, il me charge l'icone (avec la flèche pour les raccourcis) et non la miniature... Moi y'a n'a pas conprendre...
14 mai 2007 à 11:49
Un peu d'aide serait le bienvenue.
Merci par avance.
FAB
12 avril 2007 à 17:04
http://www.vbfrance.com/code.aspx?ID=41631
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.