Afficher le contenu d'un dossier dans un menu

Télécharger le projet
Commenter

Description

Salut, je suis en train de dévelloper cette procedure.
Elle explore le contenu d'un dossier et affiche l'arborescence dans un Menu (Modifiable facilement pour d'autre composants)

Pour la lancer il faut faire, par exemples :

Affiche le contenu dans un popupmenu, sans les icones
ListeDemProgs(PopupMenu1.Items,'C:\Program Files\',false);

Affiche le contenu dans un popupmenu, avec les icones
ListeDemProgs(PopupMenu1.Items,'C:\Program Files\',true);

Affiche le contenu dans menu autre, sans les icones
ListeDemProgs(Menu1,'C:\Program Files\',false);

Source / Exemple : 


//voici la procedure
//-----------------------------------------------------------
procedure ListeDemProgs(Dir:TMenuItem;Chemin:string;Icone:boolean=false);
var
R:integer;
SearchRec: TSearchRec;
TmpItem: TMenuItem;
TmpIcon: Word;
TmpIconImg : TIcon;
PFichier: array[0..2048] of char;
begin
if Chemin='' then exit;
Dir.Clear;  //efface le contenu du menu
TmpIconImg := TIcon.Create; //Temporaire pour l'icone
TmpIcon := 0;

R := FindFirst(Chemin+'*.*', faAnyFile, SearchRec); //lance la recherche
try
  while R = 0 do begin
    if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') and (SearchRec.Attr and faHidden=0) and (SearchRec.Attr and faSysFile = 0) then begin
      TmpItem := TMenuItem.Create(Dir); // crée le nouvel élément
      TmpItem.Caption := SearchRec.Name; //le texte
      //Icone
      if Icone then begin
        StrCopy(PFichier, PChar(Chemin + SearchRec.Name));
        TmpIconImg.Handle := ExtractAssociatedIcon(Application.Handle,PFichier,TmpIcon);
        TmpItem.Bitmap.Height := 32;
        TmpItem.Bitmap.Width := 32;
        TmpItem.Bitmap.Canvas.Draw(0,0,TmpIconImg);
      end;

      if (SearchRec.Attr and faDirectory) <> 0 then begin //si c un rep, continu l'arborecense
        ListeDemProgs(TmpItem,Chemin+SearchRec.Name+'\',Icone);
      end else begin //si c un fichier, enlève l'extention, et ajout le click
        TmpItem.Caption := Copy(TmpItem.Caption,1,Length(TmpItem.Caption)-4);
        TmpItem.Hint := Chemin+SearchRec.Name; //pour lancer le fichier après
        TmpItem.OnClick := PopupMenuProgsClick; // quand on klik dessus
      end;

      Dir.Add(TmpItem);// ajoute l'élément
    end;
      R := FindNext(SearchRec); // au suivant
  end;
 finally
  FindClose(SearchRec);
end;
TmpIconImg.Free; //vide l'icone
end;

//Ceci permet de lancer le fichier kan on clique dessus !!!
//-------------------------------------------------------
procedure PopupMenuProgsClick(Sender: TObject);
var
TmpS:string;
begin
  with Sender as TMenuItem do
  begin
  //lance le fichier
  shellexecute(application.Handle,nil,pchar(Hint),nil,nil,SW_SHOW);
  end;

end;

Conclusion :


Voila
Pour un exemple qui marche, voir le zip.
Sinon, cette procedure est loin d'être fonctionnelle.
Déja, la construiction des icones est suepr lent,
Les icones sont chargés en 32*32 puis redim en 16*16, c pas bien joli
Quand c'est un raccourcis, la petite flêche est mise sur l'icone, faudrai faire un truk pour lire l'icone du vrai fichier.

voila, si vous avez des suggestions ou quoi que se soit :)
merci
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (fabiin)