Fiche d'attente pendant traitement sur base de donnéesRésolu

Question

Bonjour,

Je suis en cours de programmation d'une petite application qui gère une base de données (récupération d'un fichier texte avec séparateur, dans une base, création de l'index, etc). Le traitement dure plus ou prou 3 à 4 minutes. Au démarrage de ce traitement dans la Form1, j'ouvre une form2 avec création d'un progressbar par thread. Apparement le thread ne s'execute qu'à la fin du traitement ??? 
Ci- joint le code. Merci pour votre aide.

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
unit Unit1;


interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, dbf;


type
  TForm1 = class(TForm)
    Button1: TButton;
    Dbf1: TDbf;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;


var
  Form1: TForm1;


implementation


uses Unit3;


{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
begin
  Form3.Show;
  Dbf1.Open;
  Dbf1.Close;
  Dbf1.Exclusive := true;
  Dbf1.Open;
  Dbf1.RegenerateIndexes; // une des parties du traitement 
  Dbf1.Close;
  Dbf1.Exclusive := false;
  Form3.Close;
end;


end.
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
unit Unit3;


interface


uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Extctrls, SyncObjs;


type
  TMaTache = class(Tthread)
  private
    Barre:TProgressBar;
  protected
    procedure Construire(parent:twincontrol);
    procedure Execute;override;
    procedure Detruire(Sender: tobject);
  public
    constructor Create(parent:twincontrol);
  end;


  TForm3 = class(TForm)
    Label1: TLabel;
    procedure OnShow(Sender: TObject);
  private
  public
  end;


var
  Form3: TForm3;


implementation


uses Unit1;


{$R *.dfm}


var
  MaTache : TMatache;


procedure Tmatache.Construire(parent: twincontrol);
begin
 Barre:=TProgressBar.Create(parent);
 Barre.Parent:=parent;
 Barre.SetBounds(55, 170, 300, 20);
end;


constructor Tmatache.Create(parent:twincontrol);
begin
  inherited Create(false);
  FreeOnTerminate := true;
  Construire(parent);
  OnTerminate := Detruire;
end;


procedure TMaTache.Detruire;
begin
 Barre.Free;
 inherited Terminate;
end;


procedure TMaTache.Execute;
var
 i:integer;
begin
 i := 0;
 repeat
  sleep(100);
  inc(i);
    barre.Position:=i;
    if i=100 then i:=0;
 until i > 100;
end;


procedure TForm3.OnShow(Sender: TObject);
begin
  MaTache := TMaTache.Create(self);
end;


end.
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

beckerich · Accepted Answer

bonsoir,

ajoute quelques Application.ProcessMessages dans le code, cela permettra peut-être d'afficher la progression.

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form3.Show;
  Application.ProcessMessages;
  Dbf1.Open;
  Dbf1.Close;
  Dbf1.Exclusive := true;
  Dbf1.Open;
  Dbf1.RegenerateIndexes; // une des parties du traitement 
  Application.ProcessMessages;

  Dbf1.Close;
  Dbf1.Exclusive := false;
  Form3.Close;
end;

pdos · Answer

Bonsoir,

Désolé 'beckerich' mais la solution proposée ne résoud pas le problème. Apparement, le processus de la gestion de base de données prend le dessus et ne rend pas la main au thread ???

beckerich · Answer

j'ai déjà vu une solution quelque part, avec l'utilisation d'une fonction de rappel, mais je ne sais plus où... ça ne t'avance pas, désolé .
Si tu as le source de TDBF, essaye de le modifier et d'ajouter soit un appel à ProcessMessages dans procedure TDbfFile.PackIndex ou d'appeler une fonction de rappel lors du processus.
Une fonction de rappel est une fonction que tu passes comme argument à une autre fonction.

Modifie RegenerateIndex pour pouvoir lui fournir une fonction de rappel.
Modifie PackIndex pour pouvoir lui passer cette fonction.

Dans PackIndex, 

    try
      while cur <= last do
      begin
        ReadRecord(cur, FPrevBuffer);
        lIndexFile.Insert(cur, FPrevBuffer);
---> appel de la fonction de rappel
        inc(cur);
      end;
    except
      on E: EDbfError do
      begin
        lIndexFile.DeleteIndex(lIndexFile.IndexName);
        raise;
      end;
    end;

et dans la fonction de rappel que tu as définit dans ton programme, tu mets la barre de progression à jour.

J'espère que cela peut aller car je n'ai pas installé TDBf, donc je ne peux pas tester ce que j'avance...
Bonne soirée à coder,
Luc.

beckerich · Answer

j'ai quand même testé :

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, dbf, Grids, DBGrids, Gauges, StdCtrls;

type
  TForm1 = class(TForm)
    Dbf1: TDbf;
    pro: TDataSource;
    DBGrid1: TDBGrid;
    Button1: TButton;
    Gauge1: TGauge;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
    procedure rappel(i_index: integer);
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  Gauge1.Progress := 0;
  Dbf1.RegenerateIndexes(rappel);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  dbf1.Open;
end;

procedure TForm1.rappel(i_index: integer);
begin
  Gauge1.AddProgress(i_index*10);
  Sleep(500);
end;

end.

Fiche d'attente pendant traitement sur base de données

4 réponses

Votre réponse

Discussions similaires