Listing de fichiers (format texte et impression)
Soyez le premier à donner votre avis sur cette source.
Vue 7 941 fois - Téléchargée 888 fois
Description
Avec lui vous pouvez lister des repertoirs et sous repertoirs pour les editer sur imprimente ou dans un ficher texte(txt).
Codes Sources
A voir également
- Listing de fichiers (format texte et impression)
- Visual Basic / VB.NET : Coder decoder fichier en base-64 pour transmission en format texte dans un m - Guide
- Forcer les colonnes et les cellules d'un fichier csv en format texte ✓ - Forum - C# / .NET
- Delphi richedit format text - Forum - Delphi / Pascal
- Richedit et texte formatté - Forum - Delphi / Pascal
- VBA Excel - Création d'un dictionnaire au format texte - Conseils pratiques - Visual Basic / VB.NET
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,
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
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.
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
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.