Filelistview - filelistbox mais affiche aussi les icônes des fichiers listés
Soyez le premier à donner votre avis sur cette source.
Vue 13 437 fois - Téléchargée 1 179 fois
Description
Voilà j'ai travaillé là-dessus, et comme c'est pas vraiment simple ( même si on peut dire que c'est compliqué non plus... ) j'en fais profiter tout le monde.
Donc voilà, c'est comme un FileListBox mais il affiche aussi les icônes des fichiers.
Les procédure sont justes décrites, mais le code n'est pas commenté, c'est facile à comprendre.
Pour rentrer dans les détails on extrait les icônes de deux manières différentes :
- s'il s'agit d'un fichier .exe .ico .lnk .cur .bmp ( enfin bref des extensions avec des icônes variables ), on extrait l'icône du fichier et on l'ajoute dans la l'imagelist, avec pour key le chemin complet du fichier
- s'il s'agit d'une autre extension où l'icône est constante ( genre .vbs ) on regarde si l'extension n'a pas déjà entrée dans l'imagelist ( grâce à sa Key qui correspond à l'extension ) avec un simple
r = ImageFile.ListImages.Item(extension).Index
si l'erreur 35601 est généré, c'est qu'il trouve pas la key "extension" alors on l'ajoute avec pour key l'extension et après il l'a trouvera. Voilà voilà.
Sinon c'est plutôt rapide ( moins d'une seconde pour listé 500 fichiers sur PII-300 )
Et un petit détail, pour éviter de surcharger l'imagelist, à chaque fois qu'on recharge la liste de fichiers, on clear l'imagelist.
Merci T De Lange, 2000 ( tomdl@attglobal.net ) pour les informations sur les deux apis utilisées.
Sinon le code est de moi.
Pas encore vu de bugs.
Donc voilà, c'est comme un FileListBox mais il affiche aussi les icônes des fichiers.
Les procédure sont justes décrites, mais le code n'est pas commenté, c'est facile à comprendre.
Pour rentrer dans les détails on extrait les icônes de deux manières différentes :
- s'il s'agit d'un fichier .exe .ico .lnk .cur .bmp ( enfin bref des extensions avec des icônes variables ), on extrait l'icône du fichier et on l'ajoute dans la l'imagelist, avec pour key le chemin complet du fichier
- s'il s'agit d'une autre extension où l'icône est constante ( genre .vbs ) on regarde si l'extension n'a pas déjà entrée dans l'imagelist ( grâce à sa Key qui correspond à l'extension ) avec un simple
r = ImageFile.ListImages.Item(extension).Index
si l'erreur 35601 est généré, c'est qu'il trouve pas la key "extension" alors on l'ajoute avec pour key l'extension et après il l'a trouvera. Voilà voilà.
Sinon c'est plutôt rapide ( moins d'une seconde pour listé 500 fichiers sur PII-300 )
Et un petit détail, pour éviter de surcharger l'imagelist, à chaque fois qu'on recharge la liste de fichiers, on clear l'imagelist.
Source / Exemple :
' Télécharger le zip c'est mieux parce qu'il y a un groupe de projet avec un exemple d'utilisation
' Sinon voici le source du contrôle
' Balancez ça dans notepad et enregistrer "FileListView.ctl"
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.UserControl FileListView
ClientHeight = 3630
ClientLeft = 0
ClientTop = 0
ClientWidth = 4815
ScaleHeight = 242
ScaleMode = 3 'Pixel
ScaleWidth = 321
Begin VB.PictureBox picIcon
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00800080&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 240
Left = 3720
ScaleHeight = 256
ScaleMode = 0 'User
ScaleWidth = 288
TabIndex = 1
Top = 1440
Visible = 0 'False
Width = 240
End
Begin MSComctlLib.ImageList ImageFile
Left = 3480
Top = 120
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
MaskColor = 8388736
_Version = 393216
End
Begin MSComctlLib.ListView file
Height = 3615
Left = 0
TabIndex = 0
Top = 0
Width = 3375
_ExtentX = 5953
_ExtentY = 6376
View = 3
LabelEdit = 1
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = 0 'False
HideColumnHeaders= -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 1
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Object.Width = 396875
EndProperty
End
End
Attribute VB_Name = "FileListView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private Const ILD_TRANSPARENT = &H1 'Couleur de la transparence ( je me comprends, essayez de changer pour comprendre )
' Constantes pour SHFILEINFO
Private Const SHGFI_DISPLAYNAME = &H200
Private Const SHGFI_EXETYPE = &H2000
Private Const SHGFI_SYSICONINDEX = &H4000
Private Const SHGFI_LARGEICON = &H0
Private Const SHGFI_SMALLICON = &H1
Private Const SHGFI_SHELLICONSIZE = &H4
Private Const SHGFI_TYPENAME = &H400
Private Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME _
Or SHGFI_SHELLICONSIZE _
Or SHGFI_SYSICONINDEX _
Or SHGFI_DISPLAYNAME _
Or SHGFI_EXETYPE
'Constantes combinnées ( grâce à l'opératuer "or" )le plus souvent utilisées lors de l'extraction d'une icône
'Combinez cette constante basique à une des constanctes SHGFI_LARGEICON ou SHGFI_SMALLICON grâce à "or" pour
'extraire les icônes avec la taille qui vous interresse
Private Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * 260
szTypeName As String * 80
End Type
' API utilisée pour extraire l'icône associé à un fichier
' Renvoie un nombre ( long ) qui représente le handle d'un icône ( qui varie à chaque sollicitation )
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbSizeFileInfo As Long, _
ByVal uFlags As Long) As Long
' API utilisée pour dessiner dans un pictureBox une icône grâce à son Handle ( extrait avec l'API SHGetFileInfo )
Private Declare Function ImageList_Draw Lib "comctl32.dll" _
(ByVal himl&, _
ByVal i&, _
ByVal hDCDest&, _
ByVal x&, _
ByVal y&, _
ByVal flags&) As Long
Dim ShInfo As SHFILEINFO
Dim Ctrl_Path As String ' Variable dans laquelle est stocké le chemin du dossier où se trouvent les fichiers listés
Dim Ctrl_Pattern As String ' Variable dans laquelle est stocké le Pattern des fichiers à lister
Event Click()
Event DblClick()
Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event ItemClick(ByVal Item As MSComctlLib.ListItem)
Event SelectFile(FileName As String, Fullpath As String)
Event PathChange(New_Path As String, Old_Path As String)
Private Sub file_Click()
RaiseEvent Click
End Sub
Private Sub file_DblClick()
RaiseEvent DblClick
End Sub
Private Sub file_ItemClick(ByVal Item As MSComctlLib.ListItem)
MsgBox Item.SmallIcon
RaiseEvent ItemClick(Item)
RaiseEvent SelectFile(Item.Text, Item.Key)
End Sub
Private Sub UserControl_Initialize()
loadFileList App.Path, Ctrl_Pattern
End Sub
'************************************************************************************
' Charge la liste des fichiers du répertoire "Path" selon les conditions du "Pattern"
'************************************************************************************
Private Sub loadFileList(Path As String, Pattern As String)
On Error GoTo error
Dim listeFichier As String
Dim itemx As ListItem
Dim fichier As String
Dim ShInfo As SHFILEINFO
Dim hIcon As Long
Dim imgx As ListImage
Dim fso As Variant
Dim extension As String
Dim WasSorted As Boolean
WasSorted = file.Sorted
file.Sorted = False
Set fso = CreateObject("Scripting.FileSystemObject")
file.ListItems.Clear
file.Refresh
file.SmallIcons = Nothing
ImageFile.ListImages.Clear
If Not Right(Path, 1) = "\" Then Path = Path & "\"
Ctrl_Path = Path
listeFichier = Dir(Path & Pattern, vbReadOnly + vbNormal + vbHidden + vbArchive + vbSystem)
Do Until listeFichier = ""
fichier = Path & listeFichier
Set itemx = file.ListItems.Add(, fichier, listeFichier)
itemx.Selected = False
listeFichier = Dir
extension = UCase(fso.GetExtensionName(fichier))
Select Case extension
Case "EXE"
hIcon = SHGetFileInfo(fichier, 0&, ShInfo, Len(ShInfo), _
BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
picIcon.Picture = Nothing
ImageList_Draw hIcon, ShInfo.iIcon, picIcon.hDC, 0, 0, ILD_TRANSPARENT
Set imgx = ImageFile.ListImages.Add(, fichier, picIcon.Image)
Case "ICO"
hIcon = SHGetFileInfo(fichier, 0&, ShInfo, Len(ShInfo), _
BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
picIcon.Picture = Nothing
ImageList_Draw hIcon, ShInfo.iIcon, picIcon.hDC, 0, 0, ILD_TRANSPARENT
Set imgx = ImageFile.ListImages.Add(, fichier, picIcon.Image)
Case "CUR"
hIcon = SHGetFileInfo(fichier, 0&, ShInfo, Len(ShInfo), _
BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
picIcon.Picture = Nothing
ImageList_Draw hIcon, ShInfo.iIcon, picIcon.hDC, 0, 0, ILD_TRANSPARENT
Set imgx = ImageFile.ListImages.Add(, fichier, picIcon.Image)
Case "BMP"
hIcon = SHGetFileInfo(fichier, 0&, ShInfo, Len(ShInfo), _
BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
picIcon.Picture = Nothing
ImageList_Draw hIcon, ShInfo.iIcon, picIcon.hDC, 0, 0, ILD_TRANSPARENT
Set imgx = ImageFile.ListImages.Add(, fichier, picIcon.Image)
Case "LNK"
hIcon = SHGetFileInfo(fichier, 0&, ShInfo, Len(ShInfo), _
BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
picIcon.Picture = Nothing
ImageList_Draw hIcon, ShInfo.iIcon, picIcon.hDC, 0, 0, ILD_TRANSPARENT
Set imgx = ImageFile.ListImages.Add(, fichier, picIcon.Image)
Case vbNullString
hIcon = SHGetFileInfo(fichier, 0&, ShInfo, Len(ShInfo), _
BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
picIcon.Picture = Nothing
ImageList_Draw hIcon, ShInfo.iIcon, picIcon.hDC, 0, 0, ILD_TRANSPARENT
Set imgx = ImageFile.ListImages.Add(, fichier, picIcon.Image)
Case Else
addIcon extension, fichier
End Select
Loop
If file.ListItems.Count = 0 Then Exit Sub
file.SmallIcons = ImageFile
For Each itemx In file.ListItems
fichier = itemx.Key
extension = UCase(fso.GetExtensionName(fichier))
If extension = "EXE" Or _
extension = "ICO" Or _
extension = "BMP" Or _
extension = vbNullString Or _
extension = "LNK" Then
file.ListItems.Item(fichier).SmallIcon = fichier
Else
file.ListItems.Item(fichier).SmallIcon = extension
End If
Next
file.Sorted = WasSorted
Exit Sub
error:
If Err.Number = 7 Or Err.Number = 35600 Then Resume Next 'Survient lorsque la capacité de l'imagelist est dépassé ( environ 400 images )
If Err.Number = 35601 Then Resume Next ' survient après la correction d'un key numérique
If Err.Number = 35603 Then ' survient lorsque la key est numérique ( exemple si le fichier s'appelle chaipas.123)
extension = "KEY_NEED2BE_A_STRING" & extension
hIcon = SHGetFileInfo(fichier, 0&, ShInfo, Len(ShInfo), _
BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
picIcon.Picture = Nothing
ImageList_Draw hIcon, ShInfo.iIcon, picIcon.hDC, 0, 0, ILD_TRANSPARENT
Set imgx = ImageFile.ListImages.Add(, extension, picIcon.Image)
file.SmallIcons = ImageFile
itemx.SmallIcon = extension
Err.Clear
Resume Next
Else
MsgBox "Une erreur inattendue est survenue." & vbCrLf & vbCrLf & "Numéro de l'erreur : " & vbCrLf & Err.Number & vbCrLf & vbCrLf & "Description de l'erreur : " & vbCrLf & Err.Description, vbExclamation, "Erreur..."
Err.Clear
Resume Next
End If
End Sub
'*********************************************************************************
' Lors de la procédure LoadFileList qui liste les fichiers d'un répertoire,
' si l'extension du fichier ajouté est différente des fichiers à icones variables
' ( .ico par exemple )pour ne pas surcharger l'ImageList, et pour gagner du temps,
' on évite d'extraire plusieurs fois la même icône associée à une extension
'
'En gros et vu de loin, si l'îcone associé à "Extension" n'est pas trouvé
'dans l'ImageList, l'erreur 35601
'*********************************************************************************
Private Sub addIcon(extension As String, fichier As String)
On Error GoTo error
Dim r As Variant
Dim hIcon As Long
Dim imgx As ListImage
r = ImageFile.ListImages.Item(extension).Index
Exit Sub
error:
If Err.Number = 35601 Then 'survient lorsque la key n'est pas trouvé
hIcon = SHGetFileInfo(fichier, 0&, ShInfo, Len(ShInfo), _
BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
picIcon.Picture = Nothing
ImageList_Draw hIcon, ShInfo.iIcon, picIcon.hDC, 0, 0, ILD_TRANSPARENT
Set imgx = ImageFile.ListImages.Add(, extension, picIcon.Image)
Err.Clear
Resume Next
Else
MsgBox "Une erreur inattendue est survenue." & vbCrLf & vbCrLf & "Numéro de l'erreur : " & vbCrLf & Err.Number & vbCrLf & vbCrLf & "Description de l'erreur : " & vbCrLf & Err.Description, vbExclamation, "Erreur..."
Err.Clear
Resume Next
End If
End Sub
Private Sub File_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub File_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub File_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
RaiseEvent SelectFile(file.SelectedItem.Text, file.SelectedItem.Key)
RaiseEvent Click
End Sub
Private Sub File_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
RaiseEvent MouseDown(Button, Shift, x, y)
End Sub
Private Sub File_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
RaiseEvent MouseMove(Button, Shift, x, y)
End Sub
Private Sub File_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
RaiseEvent MouseUp(Button, Shift, x, y)
End Sub
Private Sub UserControl_Resize()
file.Width = UserControl.ScaleWidth
file.Height = UserControl.ScaleHeight - file.Top
file.ColumnHeaders(1).Width = file.Width - 5
End Sub
Public Property Get Path() As String
Path = Ctrl_Path
End Property
Public Property Let Path(ByVal New_Path As String)
loadFileList New_Path, Ctrl_Pattern
PropertyChanged "Path"
End Property
'*************************************
'Renvoie le nom du fichier selectionné
'*************************************
Public Property Get FileName() As String
FileName = file.SelectedItem.Text
End Property
'************************************
'Selectionne un fichier dans la liste
'************************************
Public Property Let FileName(New_FileName As String)
Dim i As Integer
If Not New_FileName = "" Then
For i = 1 To file.ListItems.Count
If file.ListItems.Item(i).Text = New_FileName Then
file.ListItems.Item(i).Selected = True
Exit For
End If
Next i
Else
For i = 1 To file.ListItems.Count
file.ListItems.Item(i).Selected = False
Next i
End If
End Property
Public Property Get Pattern() As String
Pattern = Ctrl_Pattern
End Property
Public Property Let Pattern(ByVal New_Pattern As String)
Ctrl_Pattern = New_Pattern
loadFileList Ctrl_Path, New_Pattern
PropertyChanged "Pattern"
End Property
Public Property Get ListCount() As Integer
ListCount = file.ListItems.Count
End Property
Public Property Get ListIndex() As Integer
ListIndex = file.SelectedItem.Index
End Property
Public Property Let ListIndex(New_ListIndex As Integer)
file.ListItems.Item(New_ListIndex).Selected = True
End Property
Public Property Get Sorted() As Boolean
Sorted = file.Sorted
End Property
Public Property Let Sorted(New_State As Boolean)
file.Sorted = New_State
End Property
Public Sub Refresh()
loadFileList Ctrl_Path, Ctrl_Pattern
End Sub
Public Sub RemoveItem(fichier As String)
file.ListItems.Remove (fichier)
End Sub
Public Function HitTest(x As Single, y As Single)
On Error GoTo error:
HitTest = file.HitTest(x, y)
Exit Function
error:
HitTest = ""
End Function
Public Sub Selected(Item As Integer, State As Boolean)
file.ListItems.Item(Item).Selected = State
End Sub
Public Sub Clear()
file.ListItems.Clear
End Sub
Conclusion :
Merci T De Lange, 2000 ( tomdl@attglobal.net ) pour les informations sur les deux apis utilisées.
Sinon le code est de moi.
Pas encore vu de bugs.
Codes Sources
A voir également
- Ild_transparent
- Filelistbox - Meilleures réponses
- Vb.net filelistbox - Meilleures réponses
- Delphi / Pascal : [astuce] comment afficher les icônes des fichiers listés dans un tfi - Guide
- C / C++ / C++.NET : Afficher/cacher les icones du bureau - CodeS SourceS - Guide
- Un ocx façon filelistbox avec icones de fichiers , menu contextuel et raffraichissement auto - Codes sources - Visual Basic / VB.NET (Control)
- Visual Basic / VB.NET : Afficher toutes les Icones d'un fichier ICO - CodeS SourceS - Guide
- Afficher icone du fichier suivant type mine ✓ - Forum - VB.NET
- Messages postés
-
908
- Date d'inscription
- jeudi 26 juillet 2001
- Statut
- Modérateur
- Dernière intervention
- 1 février 2015
2Ce code est déjà paru en 1999, dans un tutotial
Alors je doute que tes méninges ait bien fonctionné. Par contre c'est bien de l'avoir mi sur ce site.
Il faut rendre à César ....
- Messages postés
-
908
- Date d'inscription
- jeudi 26 juillet 2001
- Statut
- Modérateur
- Dernière intervention
- 1 février 2015
2C'à me fait gagner un temp fou.
10
Salut. et merci encore
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.