1. Accueil
  2. Delphi / Pascal
  3. Sources Delphi / Pascal
  4. Sources Formulaire
  5. Afficher le contenu d'un dossier dans un menu

Afficher le contenu d'un dossier dans un menu

Soyez le premier à donner votre avis sur cette source.

Vue 12 111 fois - Téléchargée 1 318 fois

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

Ajouter un commentaire Commentaires
metdlp Messages postés 4 Date d'inscription jeudi 31 juillet 2003 Statut Membre Dernière intervention 11 mai 2010
13 oct. 2003 à 18:10
merci fabien por ce souce
mais as tu essayer ta fonction sous XP chez mois ça marche pas mais en Win 98 ça tourne bien
AhmedBoudali Messages postés 14 Date d'inscription mardi 24 octobre 2000 Statut Membre Dernière intervention 13 décembre 2005
18 janv. 2003 à 09:42
J' adore le détournement de composant et tans pis pour les puristes !

Je mets 6 avec mention "Encore"
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)