LISTING DE FICHIERS (FORMAT TEXTE ET IMPRESSION)
cs_Delphiprog
Messages postés
4297
Date d'inscription
samedi 19 janvier 2002
Statut
Membre
Dernière intervention
9 janvier 2013
-
14 janv. 2006 à 17:24
cs_GillesA Messages postés 1 Date d'inscription mercredi 29 janvier 2003 Statut Membre Dernière intervention 17 décembre 2006 - 17 déc. 2006 à 20:12
cs_GillesA Messages postés 1 Date d'inscription mercredi 29 janvier 2003 Statut Membre Dernière intervention 17 décembre 2006 - 17 déc. 2006 à 20:12
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/35572-listing-de-fichiers-format-texte-et-impression
https://codes-sources.commentcamarche.net/source/35572-listing-de-fichiers-format-texte-et-impression
17 déc. 2006 à 20:12
Ce source m'a permis de gagner un peu de temps. Merci donc.
Mais il est dommage que la procédure d'impression ne gère pas les sauts de page.
Voici un exemple de procédure qui le fait :
procedure TFormListe.BImprimeClick(Sender: TObject);
var i,L,verti:integer;
begin
Verti:=GetDeviceCaps(Printer.Handle,VERTRES);
L:=0;
with Printer do
begin
BeginDoc;
for i := 0 to Listbox1.Items.Count-1 do
begin
Canvas.TextOut(200,200 + (L *Canvas.TextHeight(Listbox1.Items[i])),
Listbox1.Items[i]);
inc(L);
if i = Listbox1.Items.Count-1
then EndDoc
else if 200 + ((L+1) *Canvas.TextHeight(Listbox1.Items[i]))>Verti
then begin
NewPage;
L:=0;
end;
end;
end;
end;
Cordialement,
30 janv. 2006 à 09:28
Voici le code modifié pour:
- ne pas perdre le premier fichier lors de l'appel aux fonctions "findfirst" et "fndnext"
- ignorer les répertoires "." et ".." renvoyés par ces fonctions
- ignorer les minuscules et majuscules lors des filtres
- remplacer les blancs de décalage par des tabulations (je préfère car c'est plus pratique en cas d'export pour relecture sous excel par exemple). Dans ce cas mettre la propriété "TabWidth" de la ListBox1 à 6 pour une meilleure présentation à l'écran.
- j'ai aussi rajouter une checkbox "CBListe" qui permet d'obtenir une liste triée sous la forme:
Chemin tab Nom du fichier tab Extension
****************
procedure TFormListe.cherche(chemin, filtre: string; sousrep: boolean; Decal: integer);
var fichier: TSearchRec;
nom, n, x, ch: string;
function Decalage: string;
begin
result := DupeString(#9, Decal);
end;
procedure coupe(const nom: string; out n, x: string);
begin
n := ExtractFileName(nom); //Extraction du nom AVEC extension
n := ChangeFileExt(n, ''); //Suppression de l extension
x := ExtractFileExt(nom); //Extraction de l extension AVEC delimiteur
end;
function Filtrage(nom, filtre: string): boolean;
var fn, fx, nn, nx: string;
Nok, Xok: boolean;
begin
result := false;
if filtre = '*.*' then result := true
else begin
coupe(filtre, fn, fx);
coupe(nom, nn, nx);
nok := false;
xok := false;
if fn = '*' then nok := true
else begin
if AnsiUpperCase(fn) = AnsiUpperCase(nn) then nok := true;
end;
if fx = '.*' then xok := true
else begin
if AnsiUpperCase(fx) = AnsiUpperCase(nx) then xok := true;
end;
if (nok true) and (xok true) then result := true;
end;
end;
begin
if FindFirst(chemin + '*.*', faAnyFile, Fichier) = 0 then // fichier .
begin
repeat
ch := chemin;
if (fichier.Attr and faDirectory) = faDirectory then // Dossier
begin
if (fichier.name <> '..') and (fichier.name <> '.') then
begin
if CBListe.Checked then
ch := ch + Fichier.name
else
begin
if CBDossier.Checked then nom := ' [Dossier]' else nom := '';
Listbox1.Items.Add(Decalage + Fichier.Name + nom);
end;
if SousRep then
begin
cherche(chemin + Fichier.Name + '\', filtre, sousrep, Decal + 1);
end;
end;
end
else
begin // Fichier
// Filtrage
if Filtrage(Fichier.Name, Filtre) then
begin
nom := Fichier.Name;
coupe(nom, n, x);
if CBExtention.Checked then
if CBListe.Checked then
Listbox1.Items.Add(ch + #9 + nom + #9 + x)
else Listbox1.Items.Add(Decalage + nom)
else
begin
if CBListe.Checked then
Listbox1.Items.Add(ch + #9 + n + #9 + x)
else Listbox1.Items.Add(Decalage + n);
end;
end;
end;
until Findnext(fichier) <> 0;
FindClose(fichier);
end;
end;
procedure TFormListe.BRechercheClick(Sender: TObject);
begin
Listbox1.Clear;
cherche(EChemin.Text, EFiltre.Text, CBSousRepertoire.Checked, 0);
if CBListe.Checked then Listbox1.Sorted := true;
end;
*************la suite sans changement***********
******************************
Bonne journée à tous
29 janv. 2006 à 07:24
J'en profite pour faire une nouvelle remarque concernant les filtres:
- il faut transformer les chaines, pour les comparaisons, en minuscules ou majuscules sinon on saute des fichiers. Si par exemple avec le code actuel on fait une recherche des fichiers "*.pdf" on ne liste pas ceux qui ont ".PDF" en tant qu'extension.
28 janv. 2006 à 15:03
23 janv. 2006 à 14:32
J'ai oublié de joindre une solution possible pour le caractère "." dans le nom du fichier.
Je vous propose de modifier la procédure "coupe" comme suit:
------------------------------------
Procedure coupe(const nom : string; out n,x : string);
var i : integer;
begin
i := pos('.',nom);
n := ExtractFileName(nom); //Extraction du nom AVEC extension
n := ChangeFileExt(n,''); //Suppression de l extension
x := ExtractFileExt(nom); //Extraction de l extension AVEC delimiteur
end;
-------------------------------------
et de modifier le test dans la fonction "filtrage"
................
if fx='.*' then xok:=true
................
Merci pour votre patience
23 janv. 2006 à 14:09
La fonction ExtractFileExt retourne l'extension AVEC LE SEPARATEUR (.ext)
Dans la procédure Filtrage le test "if fx='*'......" doit être remplacé par "if fx='.*'....."
Cordialement
23 janv. 2006 à 13:45
- les versions actuelles de Windows acceptent le point "." dans le nom de fichier et non seulement comme délimiteur de l'extension.
- la Procedure Coupe ne fonctionne pas dans ce cas.
- il convient de rechercher le "." de l'extension en partant de la fin de la chaine.
Cordialement
16 janv. 2006 à 17:16
15 janv. 2006 à 02:32
"Je suis accro à la fonction format(), je te consille de remplacer :
cherche(chemin+'\'+Fichier.Name+'\',filtre,sousrep,Decal+6);
par
cherche( format('%s\%s\',[chemin,Fichier.Name],filtre,sousrep,Decal+6));"
Erreur tu fait mon jeune ami, format vas dans ce cas diminuer faiblement les perfomances.
sont utilisation aurait ete plutot a conseiller sur une convertion d'entier ou de réel vers une chaine mais dans le cas d'une concatenation de chaine format n'est pas vraiment utile, voir meme un peu handicapante sur du traitement massif.
chemin+'\'+Fichier.Name+'\'
reste donc dans ce cas la meilleure solution, meme si sa lecture et un chouilla moins claire que l'utilisation de format.
@philipe :
- declarer StrUtils dans la close Uses pour que la procedure Cherche fonctionne correctement :
// MODIFICATION POUR PROCEDURE CHERCHE : //
Procedure TFormListe.cherche(const chemin, filtre : string; const sousrep : boolean; const Decal : integer);
var fichier : TSearchRec;
nom, n, x : string;
Function Decalage : string;
begin
// utilisation de DupeString pour créer la chaine de decalage,
// bien qu'on aurait pus utiliser le caractere Tabulation (#9)
result := DupeString(#32,Decal);
end;
Procedure coupe(const nom : string; out n,x : string);
// N et X n'ont pas besoin de donner leur valeur a la fonction donc OUT et pas VAR
// Nom n'est pas a passer comme VAR car jamais modifier par la fonction.
var i : integer;
begin
i := pos('.',nom);
n := copy(nom,0,i-1);
// ExtractFileExt permet de recuperer au mieux l'extention réelle d'un fichier.
x := ExtractFileExt(nom);
end;
Function Filtrage(const nom, filtre : string) : boolean;
var fn, fx, nn, nx : string;
begin
result := false;
coupe(filtre,fn,fx);
coupe(nom,nn,nx);
// une belle operation logique vaux mieux que plusieurs variables de controle.
if (filtre = '*.*') or
(((fn '*') or (fn nn)) and ((fx = '*') or (fx = nx))) then
result := true;
end;
begin
try
FindFirst(chemin+'*.*', faAnyFile, fichier);
while FindNext(fichier) = 0 do begin
// ProcessMessages Permet de rafraichir l'affichage en cours de traitement,
// mais diminuerat egalement les perfomances de la methode.
//> Application.ProcessMessages;
// Evitons de prendre en compte les "rootdirs" . et .. afin d'eviter de
// bien mauvaise surprise quand on utilise la recursivitée.
if (Fichier.Name <> '.') and (Fichier.Name <> '..') then begin
// on ecrit correctement la condition pour le traitement des repertoires.
if (fichier.Attr and faDirectory) <> 0 then begin
if CBDossier.Checked then
nom := ' [Dossier]'
else
nom := '';
Listbox1.Items.Add(Decalage+Fichier.Name+nom);
if SousRep then
cherche(chemin+'\'+Fichier.Name+'\',filtre,sousrep,Decal+6);
end else begin
if Filtrage(Fichier.Name,Filtre) then begin
nom := Fichier.Name;
if CBExtention.Checked then
Listbox1.Items.Add(Decalage+nom)
else begin
coupe(nom,n,x);
Listbox1.Items.Add(Decalage+n);
end;
end;
end;
end;
end;
finally
// meme si tout se passe mal, on ferme "Fichier"
FindClose(fichier);
end;
end;
// MODIFICATION DE LA PROCEDURE BENREGISTRECLICK : //
procedure TFormListe.BEnregistreClick(Sender: TObject);
begin
// comme l'a fait remarquer DelphiProg et comme indiqué dans l'aide delphi
if SaveDialog1.Execute then
ListBox1.Items.SaveToFile(SaveDialog1.FileName);
end;
14 janv. 2006 à 22:16
Ok pour IncludeTrailingBackSlash :p
14 janv. 2006 à 22:09
Les fonctions IncludeTrailingBackSlash et IncludeTrailingPathDelimiter exitent déjà (SysUtils.pas) et sont faites pour cela.
14 janv. 2006 à 17:24
1- Dans le code :
FindFirst(chemin+'*.*', faAnyFile, Fichier); // fichier .
FindNext(fichier); // fichier ..
while FindNext(fichier) = 0 do
Tu as bien de la chance d'avoir utilisé le masque *.* et l'attribut faAnyFile. Sinon, comme tu ne testes pas la valeur de retour de la fonction FindFirst, on peut craindre le pire avec le code qui suit.
2- FindNext(Fichier);
C'est bien beau, mais que fais-tu du résultat attribué à Fichier ?
Visiblement, le premier fichier listé ne doit pas apparaitre dans tes listes !
3- if (fichier.Attr and 16)=16 then // Dossier
Il est préférable d'utiliser les constantes qui sont plus lisibles :
if (fichier.Attr and faDirectory)= faDirectory then
4- Dans la procédure BEnregistreClick, tu te compliques bien la vie quand tu écris :
if SaveDialog1.Execute then
begin
assignfile(sortie,SaveDialog1.FileName);
rewrite(sortie);
for i:=0 to Listbox1.Items.Count-1 do
writeln(sortie,Listbox1.Items[i]);
closefile(Sortie);
end;
Alors que ceci suffit :
if SaveDialog1.Execute then
ListBox1.Items.SaveToFile(SaveDialog1.FileName);
En prime, c'est bien plus rapide.
Voila quelques retouches simples à mettre en oeuvre. En espérant que cela te sera utile.