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