Application.ProcessMessages not working for progress bar(s) when looping through UniQuery

[stevel]

Using: Delphi XE, UniDAC 3.70.0.19, MySQL embedded database, Windows 7 64bit SP1

Hi,

Using TJvGradientProgressBar from latest JVCL as progress bars.

I have two progress bars within a loop that scrolls through all the records of a UniQuery.

pbCurrentOp2 and pbOverall are not updating despite having Application.ProcessMessage (3 of them!!) inside the loop.


Code and screenshot follows:

Code: Select all

procedure TfMain.btnStartClick(Sender: TObject);
var
  bakFl, imgFld, imgFl: string;
  p, r, t: integer;
begin
  (*
   Steps:
    - Create embedded MySQL database
    - 0.Connect to database
    - 1.Import from MySQL Backup script file into this database - 33% overall
    - 2.Extract images to folder                                - 33% overall
    - 3.Transfer data to Firebird                               - 33% overall
  *)

  //EnableUniSQL := False;

  try

    //UniConnection1.SpecificOptions.Values['EmbeddedParams'] := '--basedir=.'#13#10'--datadir=.\data';

    //Operation stage 1
    UniConnection1.ExecSQL('DROP DATABASE IF EXISTS mydb;', []);
    UniConnection1.ExecSQL('CREATE DATABASE mydb;', []);

    pbCurrentOp1.Position := 10;
    pbOverall.Position := 10;
    lblOvlPrg.Caption  := Format('%d %%', [10]);
    Application.ProcessMessages;

    UniConnection1.Database := 'mydb';
    UniConnection1.Open;

    bakFl := deBackupFl.Text;
    UniDump1.RestoreFromFile(bakFl);

    //Operation stage 2
    UniQuery2.Open;
    t := UniQuery2.Fields[0].AsInteger;
    UniQuery2.Close;

    imgFld := deImgFolder.Text;
    if imgFld[Length(imgFld)]  '\ then
      imgFld := imgFld + '\;

    with UniQuery1 do
    begin
      DisableControls;
      Open;
      First;

      r := 0;
      while not EOF do
      begin
        Inc(r);

        if FieldByName('individual_id').IsNull then
        begin
          Next;
          Continue;
        end;

        imgFl := imgFld + FieldByName('individual_id').AsString + '.jpg';
        TBlobField(FieldByName('Scan')).SaveToFile(imgFl);

        p := r div t * 100;
        pbCurrentOp2.Position := p;
        lblCurOpPrg2.Caption := Format('%d %%', [p]);
        pbOverall.Position := 33 + Trunc(p * 0.33);
        lblOvlPrg.Caption := Format('%d %%', [33 + Trunc(p * 0.33)]);
        Application.ProcessMessages;
        Application.ProcessMessages;
        Application.ProcessMessages;

        Next;
      end;

      Close;
    end;

    //Operation stage 3

    UniConnection1.Close;
    Caption := Caption + ' - Complete!';
  except
    on E: Exception do
      ShowMessage('Error: ' + E.Message);
  end;
end;

procedure TfMain.deBackupFlBeforeDialog(Sender: TObject; var AName: string;
  var AAction: boolean);
begin
  AAction := False;
  if OpenDialog1.Execute then
  begin
    deBackupFl.Text := OpenDialog1.FileName;
  end;
end;

procedure TfMain.UniDump1RestoreProgress(Sender: TObject; Percent: integer);
begin
  pbCurrentOp1.Position := Percent;
  lblCurOpPrg1.Caption := Format('%d %%', [Percent]);
  pbOverall.Position := 10 + Trunc(Percent * 0.23);
  lblOvlPrg.Caption  := Format('%d %%', [10 + Trunc(Percent * 0.23)]);
  Application.ProcessMessages;
end;

Please note that the pbCurrentOp1 progress bar (in UniDump1RestoreProgress method) updates on screen correctly. It is only the ones in the loop that are not updating on screen as the loop progresses. Rather the progress bars are updated on screen only after the loop completes.


Am I doing anything wrong? Is there any technique to have the progressbars to update while loop is executing?

TIA.

Regards,
Steve Faleiro

[invent]

Hello Steve,

are you sure, that there is an UniDAC-problem?

When I read your sourcecode, I see 2 possible problems:

1. What is Max of your progressbar?

Normally I have to set:

Code: Select all

Progressbar.Min := 0;
Progressbar.Max := Dataset.RecordCount;

2. What's about the field "individual_id ?

Code: Select all

if FieldByName('individual_id').IsNull then
        begin
          Next;
          Continue;
        end; 

In this case there are no changes of the progressbar.

If you think it's a UniDAC-Problem, it's helpful to see the SQL-Statements for UniQuery1 and UniQuery2.

Kind regards,
Gerd Brinkmann
invent GmbH

[stevel]

Indeed you are correct! There is nothing wrong with UniQuery component.

The error was solved by making a simple change:

From -

Code: Select all

p := r div t * 100;

To -

Code: Select all

p := Trunc((r / t) * 100);

In the former case, the division always resulted in a 0. Once I tested this, the solution was obvious.

Regards,
Steve Faleiro