Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 25-06-2021
Badillo Badillo is offline
Miembro
 
Registrado: jun 2021
Posts: 39
Poder: 0
Badillo Va por buen camino
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
Responder Con Cita
  #2  
Antiguo 25-06-2021
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.057
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
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:


Última edición por Casimiro Notevi fecha: 26-06-2021 a las 10:44:08.
Responder Con Cita
  #3  
Antiguo 28-06-2021
Avatar de Neftali [Germán.Estévez]
Neftali [Germán.Estévez] Neftali [Germán.Estévez] is offline
[becario]
 
Registrado: jul 2004
Ubicación: Barcelona - España
Posts: 18.293
Poder: 10
Neftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en brutoNeftali [Germán.Estévez] Es un diamante en bruto
Thumbs up

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.
__________________
Germán Estévez => Web/Blog
Guía de estilo, Guía alternativa
Utiliza TAG's en tus mensajes.
Contactar con el Clubdelphi

P.D: Más tiempo dedicado a la pregunta=Mejores respuestas.
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Barra de progreso nabucodonosor Delphi para la web 3 01-11-2012 10:57:04
Barra de Progreso XcamX MySQL 1 21-12-2010 11:24:52
Barra de progreso? marlulipe Impresión 5 26-02-2008 16:51:55
Barra de progreso al compactar Aprendiendo Conexión con bases de datos 2 02-05-2007 20:42:32
Mostrar progreso de descarga de IndyFTP con barra de progreso devicer Internet 2 05-12-2005 14:59:32


La franja horaria es GMT +2. Ahora son las 19:11:48.


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