Fiche d'attente pendant traitement sur base de données [Résolu]

pdos 2 Messages postés mercredi 8 novembre 2000Date d'inscription 28 novembre 2008 Dernière intervention - 21 nov. 2008 à 15:59 - Dernière réponse : beckerich 308 Messages postés jeudi 29 septembre 2005Date d'inscription 17 septembre 2013 Dernière intervention
- 28 nov. 2008 à 23:03
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
Afficher la suite 

Votre réponse

5 réponses

Meilleure réponse
beckerich 308 Messages postés jeudi 29 septembre 2005Date d'inscription 17 septembre 2013 Dernière intervention - 28 nov. 2008 à 19:23
3
Merci
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;

Merci beckerich 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 72 internautes ce mois-ci

Commenter la réponse de beckerich
Meilleure réponse
pdos 2 Messages postés mercredi 8 novembre 2000Date d'inscription 28 novembre 2008 Dernière intervention - 28 nov. 2008 à 20:37
3
Merci
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 ???

Merci pdos 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 72 internautes ce mois-ci

Commenter la réponse de pdos
Meilleure réponse
beckerich 308 Messages postés jeudi 29 septembre 2005Date d'inscription 17 septembre 2013 Dernière intervention - 28 nov. 2008 à 21:36
3
Merci
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.

Merci beckerich 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 72 internautes ce mois-ci

Commenter la réponse de beckerich
Meilleure réponse
beckerich 308 Messages postés jeudi 29 septembre 2005Date d'inscription 17 septembre 2013 Dernière intervention - 28 nov. 2008 à 22:31
3
Merci
j'ai modifié les sources du composant et créé un dpk pour delphi 2007 que j'ai installé. Pas de problème.
je n'ai pas testé car pas de base de données.
si ça t'intéresse...envoie-moi un message privé sur
http://www.delphifr.com/auteur/BECKERICH/588531.aspx
Luc.

Merci beckerich 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 72 internautes ce mois-ci

Commenter la réponse de beckerich
Meilleure réponse
beckerich 308 Messages postés jeudi 29 septembre 2005Date d'inscription 17 septembre 2013 Dernière intervention - 28 nov. 2008 à 23:03
3
Merci
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.

Merci beckerich 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 72 internautes ce mois-ci

Commenter la réponse de beckerich

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.