begin process at 2012 02 11 08:05:47
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Formulaire

 > AFFICHER LE CONTENU D'UN DOSSIER DANS UN MENU

AFFICHER LE CONTENU D'UN DOSSIER DANS UN MENU


 Information sur la source

Note :
8 / 10 - par 2 personnes
8,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Formulaire Niveau :Expert Date de création :16/12/2002 Date de mise à jour :16/12/2002 20:36:06 Vu / téléchargé :9 152 / 547

Auteur : fabiin

Ecrire un message privé
Site perso
Commentaire sur cette source (2)
Ajouter un commentaire et/ou une note

 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

  • //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;
//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

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources du même auteur

Source avec Zip CAPTUER LE SON SORTANT ET L'ENREGISTRER DANS UN FICHIER WAV
CALCUL D'UNE MOYENNE
CHANGER LA DURÉE D'AFFICHAGE DES BULLES D'AIDES (HINT)
Source avec Zip Source avec une capture ASCII-T : PETIT SOFT D'ASCII ART.
CHANGER CONTRASTE / LUMINOSIT&#201; (L'ALGORITHME)

 Sources de la même categorie

Source avec Zip Source avec une capture EXEMPLE DE MANUAL DOCKING OU COMMENT DONNER DE LA SOUPLESSE ... par cirec
Source avec Zip Source avec une capture WEBDEZIGN FORMULAIRE par craftsystem
Source avec Zip Source avec une capture GESTION DE CALENDRIER DYNAMIQUE par docfullspeed
Source avec Zip APPARITION PROGRESSIVE D'UNE FENÊTRE par wolf691300
Source avec une capture UN CADRE CONTENANT UN NAVIGATEUR TYPE MAGNÉTOSCOPE par speletux

Commentaires et avis

Commentaire de AhmedBoudali le 18/01/2003 09:42:35

J' adore le détournement de composant et tans pis pour les puristes !

Je mets 6 avec mention "Encore"

Commentaire de metdlp le 13/10/2003 18:10:16

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

 Ajouter un commentaire




Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,562 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales