TProgressBar va retrasado

[atani123]

Tengo un problema de visualizacion y no encuentro como solucionarlo. A ver si alguien sabe como hacerlo.

Supongamos esta parte de codigo (pgbfile es un TProgressBar)

Código Delphi [-]
var i, j : integer;
begin
  pgbfile.Min := 1;
  pgbfile.Max := 100000;
  for j := 1 To 5 do
  begin
    for I := 1 To 100000 do
    begin
      pgbfile.Position := I;
    end;
    sleep(1000);
    application.ProcessMessages;
  end;
  showmessage( 'fin');
end;

Vale pues el progressbar no sigue el ritmo, las cuatro primeras veces la barra solo llega hasta el 10% y vuelve a comenzar, y la ultima vez, sale el mensaje de "fin" y el progressbar aun va por el 70%.

Supongo que el tema es que el ProgressBar lleva un Thread independiente, pero es posible evitar esto y sincronizarlo exacto. Antes con Delphi 7 esto era clavado pero ahora con XE tengo este problema. Solo es estetico, pero queda muy feo que un proceso finalice cuando en pantalla la barra va por el 80%.


gracias a todos de nuevo.

[[duilioisola]]

Prueba movieno la línea Application.ProcessMessages
Será mas lento, pues por cada iteración del bucle (100.000 veces) debe verificar si hay mensajes pendientes de procesar.

Código Delphi [-]
var i, j : integer;
begin
  pgbfile.Min := 1;
  pgbfile.Max := 100000;
  for j := 1 To 5 do
  begin
    for I := 1 To 100000 do
    begin
      pgbfile.Position := I;
      Application.ProcessMessages;
    end;
    sleep(1000);
  end;
  showmessage( 'fin');
end;

Puedes mejorar el rendimiento si ejecutas esta línea solo cada n pasadas.

Código Delphi [-]
    for I := 1 To 100000 do
    begin
      pgbfile.Position := I;
      // Solo procesa esto cada 1000 iteraciones del bucle
      if (I mod 1000 = 0) then
         Application.ProcessMessages;
    end;

[atani123]

Nada tio, el resultado es el mismo, quiza avanza un poco mas, pero el resultado sigue siendo el mismo

[[duilioisola]]

He probado tu código, sin modificar y me funciona perfectamente.
Cinco veces avanza de 0 a 100% la barra de progreso.
Al final la barra está completa y sale el mensaje de "fin".

Esto me hace pensar que lo que tu tienes no es exactamente lo que has publicado aquí.
Yo solo he creado un proyecto de prueba con un ProgressBar y un botón, que en su evento OnClick ejecuta tu código.
Has la prueba con un proyecto nuevo para verificar que no se trata de alguna otra cosa que influya en tu aplicación.

También puedes porbar con Repaint.

Código Delphi [-]
    for I := 1 To 10000 do
    begin
      pgbfile.Position := I;
      pgbfile.Repaint;
    end;

[atani123]

He hecho lo que tu dices, proyecto nuevo, 2 button y un progressbar, el codigo y el resultado es el mismo, no llega al 100%.

Si pongo el repaint, si que funciona pero el tiempo se multiplica. Me puedes pasar tu exe compilado, a ver si es problema de compilacion o de procesador o tarjeta grafica.

Si puedes mandamelo a esta direccion xxxxxx@xxxxxx.xx

2 botones y y progress bar, esta es la Unit tal cual

Código Delphi [-]
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    pgbfile: TProgressBar;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var i, j : integer;
begin
  pgbfile.Min := 1;
  pgbfile.Max := 100000;
  for j := 1 To 5 do
  begin
    for I := 1 To 100000 do
    begin
      pgbfile.Position := I;
      pgbfile.repaint;
    end;
    sleep(1000);
  end;
  showmessage( 'fin');
end;

procedure TForm1.Button2Click(Sender: TObject);
var i, j : integer;
begin
  pgbfile.Min := 1;
  pgbfile.Max := 100000;
  for j := 1 To 5 do
  begin
    for I := 1 To 100000 do
    begin
      pgbfile.Position := I;
      Application.ProcessMessages;
    end;
    sleep(1000);
  end;
  showmessage( 'fin');
end;

end.

Gracias.

[atani123]

Nuevos datos

Si State = pbsNormal el recorrido (1 pasada) lo hace en menos de 1 segundo pero no repinta bien
Si State es pbsError o pbsPaused tarda bastante mas y repinta bien.

¿Cuanto te tarda a ti mas o menos en hacer los 100000 ciclos?

[[duilioisola]]

Me tarda 28 a 32 segundos sin hacer nada en el bucle.
Tarda de 49 a 52 segundos si hago Repaint o ProcessMessages.

Código Delphi [-]
procedure TFMMain.Button1Click(Sender: TObject);
 var i, j : integer;
 Comienzo: TDateTime;
begin
  Comienzo := Now;
  pgbfile.Min := 1;
  pgbfile.Max := 100000;
  for j := 1 To 5 do
  begin
    for I := 1 To 100000 do
    begin
      pgbfile.Position := I;
      // 52 segundos : pgbfile.Repaint;
      // 49 segundos : Application.ProcessMessages;
      // 28 segundos : Sin instrucciones aqui
    end;
    Application.ProcessMessages;
    sleep(1000);
  end;
  ShowMessage( 'fin ' + DateTimeToStr(Now - Comienzo));
end;

[[duilioisola]]

Te dejo el ejemplo que hice aquí: https://www.dropbox.com/s/c376crthg5...uebas.zip?dl=0
Es el código del proyecto y el ejecutable.

[[nlsgarcia]]

atani123,

Empezado por atani123

...Tengo un problema de visualización...el Progressbar no sigue el ritmo...las cuatro primeras veces la barra solo llega hasta el 10% y vuelve a comenzar, y la ultima vez, sale el mensaje de "fin" y el Progressbar aun va por el 70%...Supongo que el tema es que el ProgressBar lleva un Thread independiente, ¿pero es posible evitar esto y sincronizarlo exacto?...Solo es estético...Antes con Delphi 7 esto era clavado pero ahora con XE tengo este problema...

Pregunto: ¿Que versión de Delphi y Windows utilizas?, ¿Es Windows de 32 o 64 bits?.

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FreePBThread(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TPBThread = class(TThread)
  private
     procedure UpdatePB;
  protected
     procedure Execute; override;
  end;

const
   Max = 100000;
   PBStep = 1;

var
  Form1: TForm1;
  PBThread : TPBThread;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
   Label1.Caption := EmptyStr;
   Label1.AutoSize := True;
   Label1.Font.Color := clBlue;
end;

procedure TPBThread.UpdatePB;
var
   PctDone : Extended;
   PBPos, PBMax, PctPB : String;
begin
   with form1 do
   begin
      if Assigned(PBThread) then
      begin
         ProgressBar1.StepBy(PBStep);
         PctDone := ProgressBar1.Position / ProgressBar1.Max;
         PBPos := FormatFloat('#,###,###,###', ProgressBar1.Position);
         PBMax := FormatFloat('#,###,###,###', ProgressBar1.Max);
         PctPB := FormatFloat('0.00 %', PctDone * 100);
         Label1.Caption := Format('Estadística : %s de %s (Ejecutado %s)',[PBPos, PBMax, PctPB]);
      end;
   end;
end;

procedure TPBThread.Execute;
var
   i : Integer;
begin
   FreeOnTerminate := True;
   for i := 1 to Max do
   begin
      if not Terminated then
         Synchronize(UpdatePB)
      else
         Exit;
   end
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   if not Assigned(PBThread) then
   begin
      ProgressBar1.Position := 0;
      ProgressBar1.Min := 1;
      ProgressBar1.Max  := Max;
      PBThread := TPBThread.Create(False);
      PBThread.OnTerminate := FreePBThread;
   end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   if Assigned(PBThread) then
   begin
      PBThread.Terminate;
      PBThread := nil;
      ProgressBar1.Position := 0;
      Label1.Caption := EmptyStr;
   end
   else
      MessageDlg('No Existe un Hilo Activo para Finalizar', mtInformation, [mbOK], 0);
end;

procedure TForm1.FreePBThread(Sender: TObject);
begin
   PBThread := nil;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   if Assigned(PBThread) then
      CanClose := False;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action := caFree;
end;

end.

El código anterior en Delphi XE7 sobre Windows 7 Professional x32, Ejemplifica el uso de un TProgressBar en un hilo y como sincronizar este con la aplicación, como se muestra en la siguiente imagen:



Nota: El código del ejemplo, funciona correctamente en Delphi 7 sobre Windows 7 Professional x32.

Espero sea útil

Nelson.

[atani123]

Empezado por duilioisola

Te dejo el ejemplo que hice aquí: https://www.dropbox.com/s/c376crthg5...uebas.zip?dl=0
Es el código del proyecto y el ejecutable.

Mira, he puesto tu ejecutable, sin compilar ni tocar nada como podras ver en la fecha de exe es el que tu me has pasado y he hecho un video con los resultados, exactamente los mismo. Asi que debe de ser algo de windows, es muy extraño. (W7 profesional x64)

https://dl.dropboxusercontent.com/u/72239104/prueba.zip

[[nlsgarcia]]

atani123,

Empezado por atani123

...he puesto tu ejecutable, sin compilar ni tocar nada...los resultados, exactamente los mismo...debe de ser algo de windows, es muy extraño...(W7 profesional x64)...

Pregunto : ¿Probastes el código sugerido el Msg #9?

Te comento que el código del Msg #9 funciona sin ningún tipo de cambio en Delphi 7 y Delphi XE7 sobre Windows 7 Professional x32 y Delphi XE4 sobre Windows 7 Professional x64, te sugiero probarlo sin ninguna modificación y ver si se mantiene el mismo comportamiento.

Espero sea útil

Nelson.

[atani123]

Buenos dias de nuevo, nlsgarcia si que probé tu codigo y funciona correctamente pero siceramente se complica demasiado para simplemente utilizar un progressbar.

El objetivo final es que el progressbar vaya incluido dentro del evento OnzipProgress del Tzipmaster por eso el StepIt no me sirve y utilizo el Position.

Los nuevos avances son los siguientes, he coseguido que funcione con el codigo original, cambiando dentro de las opciones de aplicacion el Thenes, es decir, "Project/Options/Application/Runtime Themes = None" pero vamos, pierde toda la gracia de windows 7.

Tengo que decir que decir tambien que TProgressBar tienes 2 propiedades que son el BarColor y BarBackgroundColor, que por supuesto no funcionan a no ser que se desactive lo de los temas.

No se, ¿alguien tiene alguna idea o algo que aportar?,

Gracias a todos

[Casimiro Notevi]

Empezado por atani123

No se, ¿alguien tiene alguna idea o algo que aportar?

Ese comentario es bastante despectivo para quien te está ayudando, ¿no crees?

[atani123]

Empezado por Casimiro Notevi

Ese comentario es bastante despectivo para quien te está ayudando, ¿no crees?

Pues no, no lo creo, o por lo menos no es esa mi intencion, al contrario.

Siento que sea interpretado asi pero por mas que lo leo no logro ver cual es la ofensa. Aun asi pido disculpas a quien pueda sentirse ofendido por mis palabras ya que esa interpretacion esta muy lejos de mi intencion que es la de agradecer hasta el simple hecho de que sea leido mi mensaje.

Simplemente estoy de nuevo solicitando ayuda a los mas expertos "alguien tiene alguna idea" e indicar que estoy abierto a cualquier sugerencia "o algo que aportar", esta ha sido mi unica intencion y no logro ver donde esta el menosprecio hacia los que considero mis compañeros, asi que si puedes indicarme donde esta mi error no dudes en que lo rectificare de inmediato.

[Casimiro Notevi]

Empezado por atani123

.. probé tu codigo y funciona correctamente pero siceramente se complica demasiado para simplemente utilizar un progressbar.

Es que el código lo único que hace es poner un progresbar, que es lo que necesitas. ¿Exactamente qué quieres conseguir?, mejor dicho, de qué otra forma más fácil se te ocurre que pueda hacerse lo que necesitas. Es que a lo mejor no hemos comprendido bien lo que estás buscando.

[[nlsgarcia]]

atani123,

Empezado por atani123

...probé tu código y funciona correctamente pero sinceramente se complica demasiado para simplemente utilizar un ProgressBar...

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TPBThread = class(TThread)
  private
     procedure UpdatePB;
  protected
     procedure Execute; override;
  end;

const
   Max = 100000;

var
  Form1: TForm1;
  PBThread : TPBThread;

implementation

{$R *.dfm}

procedure TPBThread.UpdatePB;
begin
   with Form1 do
      ProgressBar1.Position := ProgressBar1.Position + 1;
end;

procedure TPBThread.Execute;
var
   i : Integer;
begin
   FreeOnTerminate := True;
   for i := 1 to Max do
      Synchronize(UpdatePB)
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ProgressBar1.Position := 0;
   ProgressBar1.Min := 1;
   ProgressBar1.Max  := Max;
   PBThread := TPBThread.Create(False);
end;

end.

El código anterior en Delphi XE7 sobre Windows 7 Professional x32, es una versión simplificada del código sugerido en el Msg #9, como se muestra en la siguiente imagen:



Espero sea útil

Nelson.

[atani123]

Os cuento, es simplemente un compresor que utiliza el TZipMaster y muestra el progreso parcial y total de la compresion.

Lo he solucionado de la siguiente forma (chapuza, pero funciona y de momento no puedo perder mas tiempo con esto). El progressbar actuaba mal con el Style=pbsNormal, si se ponia a psbError o psbPaused funcionaba bien, si ponia referesh o repaint tambien iba mal asi que al final poniendo el codigo de esta forma funciona:

Código Delphi [-]
PB.Position := nPos;
PB.StepBy(-1);
PB.StepBy(1);

Debe de ser que asignando directamente a Position el paint tiene que tener algun bug, y forzando con StepBy parece que se fuerza correctamente el pintado.

Lo propuesto por nlsgarcia funcionaba perfectamente, y seguramente es una opcion mas elegante que la que he adoptado pero considero que es mas simple a la hora de interpretar el codigo en un futuro. aun asi la guardo en mi biblioteca porque nunca se sabe.

Bueno gente, muchas gracias a todos y espero no haberos mareado mucho