Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Dudas con barra de progreso (https://www.clubdelphi.com/foros/showthread.php?t=95259)

Badillo 25-06-2021 20:45:59

Dudas con barra de progreso
 
Saludos a todos, soy nuevo y necesito ayuda con el copiado con barra de progreso. He tomado el código que tienen publicado y lo acomode a un formulario de tipo diálogo, pero tengo varias dudas y quisiera sus opiniones. Les pongo el código y los puntos de dudas.

unit UBarraProgreso;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ShellAPI, XPMan, StdCtrls, System.UITypes;

type
TAccionFichero = (accCopiar, accMover);

TFormBarraProgreso = class(TForm)
Button5: TButton;
LabelNombreArchivo: TLabel;
ProgressBar1: TProgressBar;
LabelHacia: TLabel;
LabelDesde: TLabel;
labelCopiando: TLabel;
procedure Button5Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
FListaOrigen, FListaDestino: TStrings;
FAccion: TAccionFichero;
procedure MoverFicheros;
procedure MoverFicheros2;
public
{ Public declarations }
property ListaOrigen: TStrings read FListaOrigen write FListaOrigen;
property ListaDestino: TStrings read FListaDestino write FListaDestino;
property Accion: TAccionFichero read FAccion write FAccion;
end;

var
FormBarraProgreso: TFormBarraProgreso;

implementation

{$R *.dfm}

var Cancel: LongBool;

function ProgressRoutine(TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: Int64; dwStreamNumber, dwCallbackReason, hSourceFile, hDestinationFile: Cardinal; lpData: Pointer): Cardinal; stdcall;
var
Value: Cardinal;
begin
Application.ProcessMessages;
case dwCallbackReason of
CALLBACK_CHUNK_FINISHED:
FormBarraProgreso.ProgressBar1.Position := (TotalBytesTransferred * 100) div TotalFileSize;
end;
Result := PROGRESS_CONTINUE;
end;

procedure TFormBarraProgreso.Button5Click(Sender: TObject);
begin
Cancel := True;
Close //01-Cuando se cancela la acción de copiar mediante el botón Cancelar, entonces tambien cierre el formulario (No funciona, me pueden ayudar con alguna idea)
end;

procedure TFormBarraProgreso.FormActivate(Sender: TObject);
begin
MoverFicheros
end;

procedure TFormBarraProgreso.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Cancel := True;
ModalResult := mrOk //02-Cuando se cancela la acción de copiar mediante el botón Cerrar del formulario, entonces cancele y cierre el formulario (No funciona, me pueden ayudar con alguna idea)
end;

procedure TFormBarraProgreso.MoverFicheros;
var
i: Integer;
begin
for i := 0 to FListaOrigen.Count - 1 do
begin
labelCopiando.Caption := 'Copiando ' + IntToStr(i+1) + ' de ' + IntToStr(FListaOrigen.Count) + ' Archivos';
LabelDesde.Caption := 'Desde: ' + ExtractFilePath(FListaOrigen.Strings[i]);
LabelHacia.Caption := 'Hacia: ' + ExtractFilePath(FListaDestino.Strings[i]);
LabelNombreArchivo.Caption := ExtractFileName(FListaDestino.Strings[i]);

if (FAccion = accCopiar) then
CopyFileEx(pChar(FListaOrigen.Strings[i]), pChar(FListaDestino.Strings[i]), @ProgressRoutine, nil, @Cancel, 0);
// else
// 03-Llamar a la funcion o procedmiento que moverá los ficheros (Me pueden ayudar con alguna idea)

if (Cancel = True) then Break;
end;
Cancel := True;
FormBarraProgreso.Close //04-Cuando termine el proceso, entonces cierre el formulario de forma automática (No funciona, me pueden ayudar con alguna idea)
end;

//
//Puntos en los que les pido ayuda para solucionarlos
//
//01-Cuando se cancela la acción de copiar mediante el botón Cancelar, entonces tambien cierre el formulario (No funciona, me pueden ayudar con alguna idea)
//02-Cuando se cancela la acción de copiar mediante el botón Cerrar del formulario, entonces cancele y cierre el formulario (No funciona, me pueden ayudar con alguna idea)
//03-Llamar a la funcion o procedmiento que moverá los ficheros (Me pueden ayudar con alguna idea)
//04-Cuando termine el proceso, entonces cierre el formulario de forma automática (No funciona, me pueden ayudar con alguna idea)
//05-Cuando cancelo la copia por cualquiera de las vÃ*as, cierro el formulario de forma manual despues de unos segundos;
// entonces, cuando realizo nuevamente la ejecución del proceso (abir el formulario y ejecutar todo desde el principio)
// abre bien el formulario, pero no copia nada, es decir no se jecuta la acción alguna y supuestamente el formulario es operativamente funcional.
//
// Les dejo el código con el cual realizo la llamada al formulario

{
procedure TForm1.Button1Click(Sender: TObject);
var
xListaOrigen, xListaDestino: TStrings;
begin
xListaOrigen := TStringList.Create;
xListaDestino := TStringList.Create;

xListaOrigen.Add('D:\video1.avi');
xListaOrigen.Add('D:\video2.avi');
xListaOrigen.Add('D:\video3.avi');

xListaDestino.Add('F:\01-videoProcesado.avi');
xListaDestino.Add('F:\02-videoProcesado.avi');
xListaDestino.Add('F:\03-videoProcesado.avi');

Application.CreateForm(TFormBarraProgreso, FormBarraProgreso);
FormBarraProgreso.Accion := accCopiar;
FormBarraProgreso.ListaOrigen := xListaOrigen;
FormBarraProgreso.ListaDestino := xListaDestino;
FormBarraProgreso.ShowModal;
FormBarraProgreso.Destroy;

end;

}

end.v

Casimiro Noteví 25-06-2021 21:15:11

Bienvenido a clubdelphi, por favor, no olvides leer nuestra guía de estilo, gracias.
Has puesto tu pregunta en el foro "Trucos", y no es un truco, por lo que la paso a varios.
Recuerda, para otras ocasiones que pongas código, usa las etiquetas apropiadas, ejemplo:


Neftali [Germán.Estévez] 28-06-2021 09:09:36

Hola y bienvenido a los foros.

Para estos casos, con tanto código, es más sencillo para el resto de usuarios entender el problema y hacer cambios, que hagas un pequeño proyecto de ejemplo y lo adjuntes al mensaje (sólo código fuente, no ejecutables).
De esa es más fácil probarlo.

Si no te deja colocar links o adjuntos contacta conmigo por privado, me lo envías y yo lo adjunto.


La franja horaria es GMT +2. Ahora son las 22:09:26.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi