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