Boite de dialogue "Patientez" [Delphi] - Delphi/Pascal - Programmation
Marsh Posté le 13-04-2004 à 20:59:44
max2048 a écrit : Je voudrais, pendant une copie de nombreux fichiers, afficher une boîte de dialogue avec un message du genre "La copie des fichiers est en cours, veuillez patienter..." et un bouton Annuler pour pouvoir éventuellement stopper la copie. Il faudrait aussi que cette boite soit modale, et qu'elle se ferme automatiquement quand la copie des fichiers est terminée. |
Ca existe ! J'ai ça sur mon dur. Je te fais une ch'tite photo pr bien savoir si c'est cela que tu veux Une seconde...
Marsh Posté le 13-04-2004 à 21:04:41
max2048 a écrit : Je voudrais, pendant une copie de nombreux fichiers, afficher une boîte de dialogue avec un message du genre "La copie des fichiers est en cours, veuillez patienter..." et un bouton Annuler pour pouvoir éventuellement stopper la copie. Il faudrait aussi que cette boite soit modale, et qu'elle se ferme automatiquement quand la copie des fichiers est terminée. |
Ce serait qqch ds ce genre-là ?
Windows y a pensé Michel Bardou aussi
Marsh Posté le 13-04-2004 à 21:16:46
Oui ça serait parfait ça C'est un composant à part ?
(Et Michel Bardou, c'est qui ? )
Merci d'avance.
Marsh Posté le 13-04-2004 à 21:28:08
max2048 a écrit : Oui ça serait parfait ça C'est un composant à part ? |
Pas un composant à part (VCL ou composant non visuel). Michel Bardou : le prof de Delphi par excellence Je te conseille son site (tutoriels, forum, etc). Avec Dieu tjrs présent (as Paul Thot).
Je te maile ça ? Les lignes sont un peu longues à afficher ici, je crois
C'est une fonction de Windows. Borland l'a intégrée à SHFileOperation. Une structure (pardon : record) à initialiser, et hop, c'est parti ! Elle contient son propre pointeur vers la fonction de l'OS qui se charge de ça.
Marsh Posté le 13-04-2004 à 21:34:17
max2048 a écrit : Oui ça serait parfait ça C'est un composant à part ? |
Tentative d'affichage (on verra comment ça passe )
ATTENTION ! 1/ il doit manquer un '//' quelque part. Je le corrige sans cesse ds mes progs : le compilo te dira où.
2/ Les fôtes d'aurtograffe ne sont pas de moi
Les routines:
// Requiert ShellApi ds Uses !
procedure copier(Handle:HWND;Source,Cible:String);
var
lpFileOp:TSHFileOpStructA;
TabFrom:array[0..255] of char;
i:integer;
begin
For i:=0 to length(Source)-1 do TabFrom[i]:=Source[i+1];
TabFrom[length(Source)]:=#0;// pFrom peut contenir plusieurs noms de fichier. Les noms doivent être séparés par le caractère #0.
TabFrom[length(Source)+1]:=#0;// d'après mes essais, le dernier nom de fichier doit être suivi de deux caractères #0.
{-----préparation du paramètre lpFileOp qui sera passé en paramètre à SHFileOperation -----}
lpFileOp.Wnd:=handle;
lpFileOp.wFunc:=FO_COPY; // l'action sera une copie
lpFileOp.pFrom:=TabFrom; // contient le ou les fichiers /dossiers à recopier
lpFileOp.pTo:=PAnsiChar(Cible); // ce vers quoi on recopie
lpFileOp.fFlags:=FOF_NOCONFIRMATION;
// + FOF_RENAMEONCOLLISION; //si le fichier cible existe déjà,
// il est copié sous un nom du style copie (1) de...
{ fin de la préparation du paramètre lpFileOp}
SHFileOperation(lpFileOp); // procède à la copie
end;
procedure effacer(Handle:HWND;Source:String);
var
lpFileOp:TSHFILEOPSTRUCTA;
TabFrom:array[0..255] of char;
i:integer;
begin
For i:=0 to length(Source)-1 do TabFrom[i]:=Source[i+1];
TabFrom[length(Source)]:=#0;
TabFrom[length(Source)+1]:=#0;
lpFileOp.Wnd:=handle;
lpFileOp.wFunc:=FO_DELETE; // l'action sera un effacement
lpFileOp.pFrom:=TabFrom; // contient le ou les fichiers /dossiers à recopier
lpFileOp.pTo:='';
lpFileOp.fFlags:=FOF_NOCONFIRMATION;
SHFileOperation(lpFileOp); // procède à l'effacement
end;
procedure deplacer(Handle:HWND;Source,Cible:String);
var
lpFileOp:TSHFILEOPSTRUCTA;
TabFrom:array[0..255] of char;
i:integer;
begin
For i:=0 to length(Source)-1 do TabFrom[i]:=Source[i+1];
TabFrom[length(Source)]:=#0;
TabFrom[length(Source)+1]:=#0;
lpFileOp.Wnd:=handle;
lpFileOp.wFunc:=FO_MOVE; // l'action sera un déplacement
lpFileOp.pFrom:=TabFrom; // contient le ou les fichiers /dossiers à déplacer
lpFileOp.pTo:=PAnsiChar(Cible); // ce vers quoi on déplace
lpFileOp.fFlags:=FOF_NOCONFIRMATION;
// + FOF_RENAMEONCOLLISION; //si le fichier cible existe déjà,
le copier sous un nom du style copie (1) de...
SHFileOperation(lpFileOp); // procède au déplacement
end;
procedure renommer(Handle:HWND;Source,Cible:String);
var
lpFileOp:TSHFILEOPSTRUCTA;
TabFrom:array[0..255] of char;
i:integer;
begin
For i:=0 to length(Source)-1 do TabFrom[i]:=Source[i+1];
TabFrom[length(Source)]:=#0;
TabFrom[length(Source)+1]:=#0;
lpFileOp.Wnd:=handle;
lpFileOp.wFunc:=FO_RENAME; // l'action sera un "renommage"
lpFileOp.pFrom:=TabFrom; // contient le ou les fichiers /dossiers à déplacer
lpFileOp.pTo:=PAnsiChar(Cible); // ce vers quoi on déplace
lpFileOp.fFlags:=FOF_NOCONFIRMATION;
// + FOF_RENAMEONCOLLISION; //si le fichier cible existe déjà,
il le copier sous un nom du style copie (1) de...
SHFileOperation(lpFileOp); // procède au déplacement
end;
******************* MES petites adaptations ***************
-----------------------------
procedure Ton_Nom_Renommer(Handle:HWND;Source,Cible:String);
var
lpFileOp:TSHFILEOPSTRUCTA;
TabFrom:array[0..255] of char;
i:integer;
begin
For i:=0 to length(Source)-1 do TabFrom[i]:=Source[i+1];
TabFrom[length(Source)]:=#0;
TabFrom[length(Source)+1]:=#0;
lpFileOp.Wnd:=handle;
lpFileOp.wFunc:=FO_RENAME; // l'action sera un "renommage"
lpFileOp.pFrom:=TabFrom; // contient le ou les fichiers /dossiers à déplacer
lpFileOp.pTo:=PAnsiChar(Cible); // ce vers quoi on déplace
//lpFileOp.fFlags:=FOF_ALLOWUNDO; // préserve la possibilité d'annuler le déplacement
// + FOF_RENAMEONCOLLISION; //si le fichier cible existe déjà, il le copie sous un nom du style copie (1) de..
SHFileOperation(lpFileOp); // procède au déplacement
end;
procedure Ton_Nom_Effacer(Handle:HWND;Source:String; Vers_Corbeille : boolean);
var
lpFileOp:TSHFILEOPSTRUCTA;
TabFrom:array[0..255] of char;
i:integer;
begin
For i:=0 to length(Source)-1 do TabFrom[i]:=Source[i+1];
TabFrom[length(Source)]:=#0;
TabFrom[length(Source)+1]:=#0;
lpFileOp.Wnd:=handle;
lpFileOp.wFunc:=FO_DELETE; // l'action sera un effacement
lpFileOp.pFrom:=TabFrom; // contient le ou les fichiers /dossiers
// à recopier
lpFileOp.pTo:='';
if Vers_Corbeille = TRUE then
begin
lpFileOp.fFlags:=FOF_ALLOWUNDO;
// préserve la possibilité d'annuler l'effacement
end
else
begin
// Pas de possibilité d'annuler l'effacement
lpFileOp.fFlags:=FOF_NOCONFIRMATION;
end;
SHFileOperation(lpFileOp); // procède à l'effacement
end;
procedure Ton_Nom_Deplacer(Handle:HWND;Source,Cible:String);
var
lpFileOp:TSHFILEOPSTRUCTA;
TabFrom:array[0..255] of char;
i:integer;
begin
For i:=0 to length(Source)-1 do TabFrom[i]:=Source[i+1];
TabFrom[length(Source)]:=#0;
TabFrom[length(Source)+1]:=#0;
lpFileOp.Wnd:=handle;
lpFileOp.wFunc:=FO_MOVE; // l'action sera un déplacement
lpFileOp.pFrom:=TabFrom; // contient le ou les fichiers /dossiers à déplacer
lpFileOp.pTo:=PAnsiChar(Cible); // ce vers quoi on déplace
//lpFileOp.fFlags:=FOF_ALLOWUNDO; // préserve la possibilité d'annuler le déplacement
// + FOF_RENAMEONCOLLISION; //si le fichier cible existe déjà, il le copie sous un nom du style copie (1) de..
SHFileOperation(lpFileOp); // procède au déplacement
end;
***********
Marsh Posté le 13-04-2004 à 23:54:46
Ben écoute merci beaucoup
(M'enfin ça fait beaucoup de code quand même...)
Je vais aller voir le site dont tu m'as parlé, je crois que ça me fera pas de mal...
Marsh Posté le 14-04-2004 à 07:54:01
max2048 a écrit : Ben écoute merci beaucoup |
"(M'enfin ça fait beaucoup de code quand même...)" : tu l'enregistre ds un fichier .TXT (par exemple), et tu extrais les procédures "à la demande", comme moi. Pas tellement de code que ça...
Marsh Posté le 11-04-2004 à 17:00:56
Je voudrais, pendant une copie de nombreux fichiers, afficher une boîte de dialogue avec un message du genre "La copie des fichiers est en cours, veuillez patienter..." et un bouton Annuler pour pouvoir éventuellement stopper la copie. Il faudrait aussi que cette boite soit modale, et qu'elle se ferme automatiquement quand la copie des fichiers est terminée.
Ma question : Est-ce qu'il est possible de faire ça avec des procédures comme ShowMessage ou MessageDlg, ou bien est-ce que je suis obligé de créer une nouvelle fiche (et donc une nouvelle unité) ?
---------------
Un site web qu'il est beau (v2.0)