![]() |
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 |
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: |
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