THREAD ET CRÉATION DYNAMIQUE DES COMPOSANTS

Commentaire de bhmalek le 11/06/2006 11:24:03

J'attends vos remarques, je sais bien que mon travail est décevant, et c'est justement pourquoi je l'ai posté.
Je commence dans delphi et j'aimerai corriger mes fautes dés le debut, allez jetez pour une fois un coup d'oeil sur la source et dites moi quesque vous en pensez ...

Commentaire de Delphiprog le 11/06/2006 17:56:13 administrateur CS

Très bon travail, bien au contraire.

Voici quelques pistes d'améliorations :
- tu masques les problèmes de portée en déclarant la classe TMaTache dans la même unité que TForm1. En agissant ainsi, le constructeur que tu as déclaré en protected devient accessible.
Pour mieux structurer ton travail, je te recommande de déclarer TMaTache dans une autre unité comme ceci :

unit UMaTache;

interface

uses
  Classes, SysUtils, StdCtrls, ComCtrls, Controls;

type
  TMaTache = class(TThread)
  private
    barre: TProgressbar;
    button: TButton;
    vitesse: integer;
    pause: boolean;
  protected
    procedure buttonclick(Sender: TObject);
    procedure construire(parent: TWinControl; y: integer);
    procedure execute; override;
    procedure detruire(Sender: tobject);
  public
    boite: TCheckBox;
    constructor Create(parent: TWinControl; y, v: integer);
  end;

implementation

{ TMaTache }

procedure TMaTache.buttonclick(Sender: TObject);
begin
  if barre.position = barre.Max then
  begin
    barre.Position := 0;
    pause := false;
  end
  else
    Pause := not Pause;

  if pause then
    button.Caption := 'Continue'
  else
    button.Caption := 'Stop';
end;

procedure TMaTache.construire(parent: twincontrol; y: integer);
begin
  barre := tprogressbar.Create(parent);
  barre.Parent := parent;
  barre.SetBounds(30, y, 300, 20);

  boite := tcheckbox.Create(parent);
  boite.Parent := parent;
  boite.SetBounds(10, y, 14, 17);
  boite.checked := false;
  boite.Caption := '';

  button := tbutton.Create(parent);
  button.Parent := parent;
  button.SetBounds(340, y-5, 70, 30);
  button.Caption := 'Stop';
  button.OnClick := buttonclick;

  pause := false;
end;

constructor TMaTache.Create(parent: twincontrol; y, v: integer);
begin
  inherited create(false);
  FreeOnTerminate := true;
  construire(parent, y);
  vitesse := v;
  OnTerminate := detruire;
end;

procedure TMaTache.detruire(Sender: tobject);
begin
  barre.Free;
  button.Free;
  boite.Free;
  inherited terminate;
end;

procedure TMaTache.execute;
var
  i: integer;
begin
  repeat
    sleep(vitesse);
    i := barre.Position;
    if not pause then
      barre.Position := i + 1;
      
    if i = Barre.Max then
      button.Caption := 'Restart';
  until terminated;
end;

end.

Au passage, tu auras remarqué quelques restructurations, simplifications et optimisations du code :o).
En effet, à chaque fois que tu modifies les propriétés Top, Left, Height ou Width d'un composant visuel, ce dernier est redessiné. Avec le méthode SetBounds, il n'est redessiné qu'une fois.
A noter aussi que seuls le constructeur et la propriété Boite ont besoin d'être exposés à l'extérieur de la classe et doivent donc figurer en section Public.

Au niveau de l'unité Unit1 (maintenant allégée), on trouve le code restant avec quelques réaménagements commentés plus bas :
type
  TForm1 = class(TForm)
    btnCreate: TButton;
    btnDestroy: TButton;
    Edit1: TEdit;
    XPManifest1: TXPManifest;
    procedure FormCreate(Sender: TObject);
    procedure btnCreateClick(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure btnDestroyClick(Sender: TObject);
  private
    function FirstFree: integer;
    {Redimensionne la fenêtre en fonction du nombre
    de Threads actifs}
    procedure ResizeWindow(Nombre: integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

uses UMaTache;

{$R *.dfm}
var
  MesTaches: array of TMaTache;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //inutile => setlength(MesTaches, 0);
end;

procedure TForm1.btnCreateClick(Sender: TObject);
var
  i: integer;
begin
  i := length(MesTaches);
  if FirstFree = 0 then
  begin
    setlength(MesTaches, i + 1);
    ResizeWindow(i);
  end
  else
    i := FirstFree - 1;

  MesTaches[i] := TMaTache.Create(Self, ((30 * i) + 10), StrToIntDef(edit1.Text, 0));
end;

procedure TForm1.Edit1Change(Sender: TObject);
var
  i: integer;
begin
  i := StrToIntDef(edit1.Text, 0);
  btnCreate.Enabled := (i > 0) and (i < 10000);
end;

function TForm1.FirstFree: integer;
var
  i: integer;
begin
  result := 0;
  for i := length(MesTaches) - 1 downto 0 do
    if not assigned(MesTaches[i]) then
      result := i + 1;
end;

procedure TForm1.btnDestroyClick(Sender: TObject);
var
  i, j: integer;
begin
  i := length(MesTaches);
  if i = 0 then
    exit;
  for j := 0 to i - 1 do
  begin
    if MesTaches[j] = nil then
      continue;
    if MesTaches[j].boite.checked then
    begin
      MesTaches[j].Terminate;
      MesTaches[j] := nil;
    end;
  end;
  j := i - 1;
  while MesTaches[j] = nil do
  begin
    dec(i);
    dec(j);
  end;
  setlength(MesTaches, i);

  ResizeWindow(i);
end;

procedure TForm1.ResizeWindow(Nombre: integer);
begin
  Height := 90 + Nombre * 30;
  btnCreate.Top := Height - 60;
  btnDestroy.Top := Height - 60;
  edit1.Top := Height - 58;
end;

Observations :
- bien que ce ne soit pas une erreur, il est habituel de déclarer tes propres routines en section Public ou Private et non dans la section par défaut (bien que cette dernière soit en réalité de portée Public).
- le code dans Edit1Change a été simplifié
- le code dupliqué redimensionnant la fenêtre Form1 a été déplacé dans une méthode nommée ResizeWindow

En déclarant chaque classe dans son unité propre, c'est aussi le meilleur moyen de permettre sa réutilisation.
Si je n'avais qu'une critique à faire, ce serait celle-ci.

Globalement, tu as bien travaillé et tu es sur la bonne voie ;o)

Commentaire de MAURICIO le 12/06/2006 16:53:54

Salut Bhmalek,
ta source m' a interessé parce que Delphiprog et moi même avons étudié les threads (pour faire une boite de dialogue avec gauge pour faire patienter l' utilisateur ...) et que nous sommes tombés sur un os.
Malheureusement tu ne résouds pas non plus le problème qui est, s' il existe un autre processus bloquant, celui-ci empêchera tes gauges d' avancer...

Voilà comment tu peux tester ce que je dit:
Mets un bouton sur ta form avec le code suivant:

procedure TForm1.SpeedButton1Click(Sender: TObject);
var i: integer;
begin
  for i := 0 to 99 do
    sleep(100);
end;

Ensuite tu compiles et tu executes une ou 2 gauges et tu cliques sur le bouton que je te propose et tu verras que ta gauge s' arrête tans que le code dans le bouton n' est pas fini...

Malheureusement nous n' avons pas trouvé de solution à ce problème.
Ici on pourrait résoudre le problème gràce à l' utilisation de application.ProcessMessages dans le For mais cela serait impossible lors de l' execution d' un code SQL par exemple.

Très bonne 1ere source tout de même !!!

A+