[Delphi] Boite de dialogue "Patientez"

Boite de dialogue "Patientez" [Delphi] - Delphi/Pascal - Programmation

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)
Reply

Marsh Posté le 11-04-2004 à 17:00:56   

Reply

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.
 
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é) ?


Ca existe :hot: ! 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...

Reply

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.
 
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é) ?


Ce serait qqch ds ce genre-là ?
 
http://www.ifrance.com/lduprouget/copiefichiers.png
 
Windows y a pensé :jap: Michel Bardou aussi :D

Reply

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 ? :heink: )
 
Merci d'avance.


---------------
Un site web qu'il est beau (v2.0)
Reply

Marsh Posté le 13-04-2004 à 21:28:08    

max2048 a écrit :

Oui ça serait parfait ça :) C'est un composant à part ?
(Et Michel Bardou, c'est qui ? :heink: )
 
Merci d'avance.


Pas un composant à part (VCL ou composant non visuel). Michel Bardou : le prof de Delphi par excellence :jap: Je te conseille son site (tutoriels, forum, etc). Avec Dieu :jap: tjrs présent (as Paul Thot).  
 
Je te maile ça ? Les lignes sont un peu longues à afficher ici, je crois  :heink:  
 
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.

Reply

Marsh Posté le 13-04-2004 à 21:34:17    

max2048 a écrit :

Oui ça serait parfait ça :) C'est un composant à part ?
(Et Michel Bardou, c'est qui ? :heink: )
 
Merci d'avance.


 
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 :D
 
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;
 
***********
 

Reply

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...
 

Reply

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...)
 
Je vais aller voir le site dont tu m'as parlé, je crois que ça me fera pas de mal...
 
 


"(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...

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed