Comment afficher l'icône d'un dossier dans un Listview [Résolu]

Signaler
Messages postés
37
Date d'inscription
jeudi 14 février 2019
Statut
Membre
Dernière intervention
22 juillet 2020
-
Messages postés
37
Date d'inscription
jeudi 14 février 2019
Statut
Membre
Dernière intervention
22 juillet 2020
-
Bonjour à Tous,
Comment afficher les icônes de tous les dossiers d'un répertoire dans un ListView ?.
(Les vrais icônes des dossiers du répertoire, pas une image d'un ImageList )
En vous remerciant d'avance,
Cordialement

3 réponses

Messages postés
199
Date d'inscription
samedi 15 novembre 2003
Statut
Membre
Dernière intervention
10 septembre 2020
7
salut
regarde si quelque chose comme ça peut convenir
placer 1 bouton et 1 ListeView.
var  ImageList1 : TImageList;
procedure TForm1.Button2Click(Sender: TObject);
var
  spath: string;
  dir: string;
  Filter: Word;
  SysStr: Widestring;
  i: Integer;
  mIcon: TIcon;
  SearchRec: TSearchRec;
  ListItem: TListItem;
  FileInfo: SHFILEINFOw;

begin
  ListView1.Clear;
  ImageList1 := TImageList.Create(nil);
  ImageList1.BkColor := clMenu;
  ImageList1.ShareImages := True;
  ImageList1.Masked := True;
  ImageList1.Width := 32;
  ImageList1.Height := 32;
  ImageList1.Clear;

  if SelectDirectory(dir, [sdAllowCreate, sdPerformCreate, sdPrompt], 0) then
      spath := dir;
  Filter  := 0;
  if spath[Length(spath)] <> '\' then
    spath               := spath + '\';

  ListView1.SmallImages := ImageList1; // LargeImages := ImageList1;
  ListView1.ViewStyle   := vsReport;
  ListView1.Columns.Add;
  ListView1.Columns.Add;
  mIcon := TIcon.Create;

  try
    ListView1.Items.BeginUpdate; 
    SearchRec.Attr := FaDirectory;
    i := FindFirst(spath + '*.*', FaDirectory, SearchRec); // faAnyFile, SearchRec);
    while i = 0 do
    begin
      application.ProcessMessages;
      with ListView1 do
      begin
        If (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        Begin
          if (SearchRec.Attr and FaDirectory) = FaDirectory then  //pour afficher seulement les dossiers
          begin
            SysStr   := spath + SearchRec.Name;
            ListItem := ListView1.Items.Add;
            SHGetFileInfo(PwideChar(SysStr), 0, FileInfo, SizeOf(FileInfo), SHGFI_DISPLAYNAME);
            ListItem.Caption := FileInfo.szDisplayName;
            SHGetFileInfo(PwideChar(SysStr), 0, FileInfo, SizeOf(FileInfo), SHGFI_TYPENAME);
            ListItem.SubItems.Add(FileInfo.szTypeName);
            SHGetFileInfo(PwideChar(SysStr), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_LARGEICON or
              SHGFI_SMALLICON);
            mIcon.Handle := ExtractAssociatedIcon(hInstance, PChar(SysStr), Filter);
            // Image1.Canvas.Draw(0, 0, mIcon);
            ListItem.ImageIndex := ImageList1.AddIcon(mIcon);

          end;
        End;

      end;
      i := FindNext(SearchRec);
    end;
  finally
    ListView1.Items.EndUpdate;
    mIcon.Free;
   // ImageList1.Free;
  end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ImageList1.Free;
end;



Messages postés
37
Date d'inscription
jeudi 14 février 2019
Statut
Membre
Dernière intervention
22 juillet 2020

bonsoir Papyvore;
Merci encore une fois de plus pour ton aide.
Je teste ça de suite et je te tiens informé du résultat
MERCI encore
Sincères salutations
Messages postés
37
Date d'inscription
jeudi 14 février 2019
Statut
Membre
Dernière intervention
22 juillet 2020

je viens de tester, ça marche
c'est aussi le code que j'avais trouvé pour afficher les icônes des fichiers, puis, modifié pour l'affichage des répertoires.

https://codes-sources.commentcamarche.net/source/41025-astuce-comment-afficher-les-icones-des-fichiers-listes-dans-un-tfilelisbox

Avec ton instruction: Icon.Handle ...
l'image des icônes sont plus précises, que l'instruction que j'avais trouvé
et j'ai aussi agrandit la taille du Timagelist, je l'ai mis aussi à 32 pixels
Super, merci pour me confirmer le code que j'avais trouvé et modifier selon mes besoins.

Je n'ai pas eu le temps de le mettre en ligne, c'est quasiment le même, peu de choses changent, juste la façon de rechercher avec findfirst

Merci encore
bien cordialement