UTILISATION DES THREADS

3 fichiers .pas.

unit UCalculPair;

interface

uses
  Classes, SysUtils, StdCtrls;

type
  TCalculPairThread = class(TThread)
  private
    { Déclarations privées }
    NbCalcul: integer;
    ListBoxDest : TListBox;
    LabelNumCourDest : TLabel;
  protected
    procedure Execute; override;
    procedure paint;
  public
    constructor Create (LabelPair: TLabel; ListBoxPair : TListBox);
  end;

implementation
    constructor TCalculPairThread.Create (LabelPair: TLabel; ListBoxPair : TListBox);
begin
   inherited create(False);
    NbCalcul := 0;
    ListBoxDest := ListBoxPair;
    LabelNumCourDest := LabelPair;
end;

{ Important : Les méthodes et propriétés des objets des VCL ne peuvent être
  utilisées que dans des méthodes appelées avec Synchronize; par exemple :

      Synchronize(UpdateCaption);

  et UpdateCaption pourrait être :

    procedure TCalculPairThread.UpdateCaption;
    begin
      Form1.Caption := 'Mise à jour dans un thread';
    end; }

{ TCalculPairThread }

procedure TCalculPairThread.Execute;
begin
  { Placez le code du thread ici }
   while not terminated do
   begin
   NbCalcul := nbCalcul +1;
   Synchronize (paint);
   end;
end;

procedure TCalculPairThread.paint;
Begin
LabelNumCourDest.caption:=IntToStr(NbCalcul);
if (NbCalcul mod 2)=0 then
   ListBoxDest.items.add(IntToStr(NbCalcul));
End;
end.

-----------------------------------------------------------------------------------------------

unit UDessineThread;

interface

uses
  Classes, Graphics, SysUtils, StdCtrls;

type
  TDessineThread = class(TThread)
  private
    { Déclarations privées }
    m_iCouleur : integer;
    m_Label : TLabel;
    m_iCompteur : double;

  protected
    procedure Execute; override;
    procedure paint;

  public
    constructor Create (iCouleur: integer; LabelCompteur: TLabel);
  end;

implementation
uses UThreads;
  constructor TDessineThread.Create (iCouleur: integer; LabelCompteur: TLabel);
begin
    inherited Create(False); // False pour lancer l'éxécution
    m_iCouleur:=iCouleur;
    m_Label:=LabelCompteur;
    m_iCompteur:=0;
end;

{ Important : Les méthodes et propriétés des objets des VCL ne peuvent être
  utilisées que dans des méthodes appelées avec Synchronize; par exemple :

      Synchronize(UpdateCaption);

  et UpdateCaption pourrait être :

    procedure TDessineThread.UpdateCaption;
    begin
      Form1.Caption := 'Mise à jour dans un thread';
    end; }

{ TDessineThread }

procedure TDessineThread.Execute;
begin
  { Placez le code du thread ici }
  Randomize;
  while not Terminated do
        begin
        m_iCompteur:=m_iCompteur+1;
        Synchronize (paint);
        end;
end;

procedure TdessineThread.paint;
begin
  Form1.Canvas.Pixels[random(Form1.Width), random(Form1.Height)]:=m_iCouleur;
  m_Label.Caption:=FloatToStr(m_iCompteur);
  end;
end.

-----------------------------------------------------------------------------------------------

unit Uthreads;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls,UDessineThread, UCalculPair;

type
  TForm1 = class(TForm)
    Btnstartrouge: TBitBtn;
    Btnstoprouge: TBitBtn;
    Btnstartjaune: TBitBtn;
    Btnstopjaune: TBitBtn;
    Btnstartbleu: TBitBtn;
    Btnstopbleu: TBitBtn;
    TBRouge: TTrackBar;
    TBJaune: TTrackBar;
    TBBleue: TTrackBar;
    Labelrouge: TLabel;
    Labeljaune: TLabel;
    Labelbleue: TLabel;
    BtnSuspendPair: TButton;
    BtnResumePair: TButton;
    BtnStartPair: TButton;
    BtnStopPair: TButton;
    TBpair: TTrackBar;
    ListBoxPair: TListBox;
    LabelPair: TLabel;
    procedure BtnstartrougeClick(Sender: TObject);
    procedure BtnstartjauneClick(Sender: TObject);
    procedure BtnstartbleuClick(Sender: TObject);
    procedure BtnstoprougeClick(Sender: TObject);
    procedure BtnstopjauneClick(Sender: TObject);
    procedure BtnstopbleuClick(Sender: TObject);
    procedure TBRougeChange(Sender: TObject);
    procedure TBJauneChange(Sender: TObject);
    procedure TBBleueChange(Sender: TObject);
    procedure BtnStartPairClick(Sender: TObject);
    procedure BtnStopPairClick(Sender: TObject);
    procedure TBpairChange(Sender: TObject);
    procedure BtnSuspendPairClick(Sender: TObject);
    procedure BtnResumePairClick(Sender: TObject);
  private
    { Déclarations privées }
    DessineThreadRouge: TDessineThread;
    DessineThreadJaune: TDessineThread;
    DessineThreadBleue: TDessineThread;
    PairThread: TCalCulPairThread;
  public
    { Déclarations publiques }

  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure TForm1.BtnstartrougeClick(Sender: TObject);
begin
Btnstartrouge.Enabled:=False;
Btnstoprouge.Enabled:=True;
DessineThreadRouge:=TDessineThread.Create(clRed, Labelrouge);

end;

procedure TForm1.BtnstartjauneClick(Sender: TObject);
begin
Btnstartjaune.Enabled:=False;
Btnstopjaune.Enabled:=True;
DessineThreadJaune:=TDessineThread.Create(clYellow, Labeljaune);

end;

procedure TForm1.BtnstartbleuClick(Sender: TObject);
begin
Btnstartbleu.Enabled:=False;
Btnstopbleu.Enabled:=True;
DessineThreadBleue:=TDessineThread.Create(clBlue, Labelbleue);

end;

procedure TForm1.BtnstoprougeClick(Sender: TObject);
begin
Btnstartrouge.Enabled:=true;
Btnstoprouge.Enabled:=False;
DessineThreadRouge.Free;

end;

procedure TForm1.BtnstopjauneClick(Sender: TObject);
begin
Btnstartjaune.Enabled:=true;
Btnstopjaune.Enabled:=False;
DessineThreadJaune.Free;

end;

procedure TForm1.BtnstopbleuClick(Sender: TObject);
begin
Btnstartbleu.Enabled:=true;
Btnstopbleu.Enabled:=False;
DessineThreadBleue.Free;

end;

procedure TForm1.TBRougeChange(Sender: TObject);
begin
if DessineThreadRouge <> nil then
   DessineThreadRouge.Priority:=TThreadPriority(TBRouge.Position);
end;

procedure TForm1.TBJauneChange(Sender: TObject);
begin
if DessineThreadJaune <> nil then
   DessineThreadJaune.Priority:=TThreadPriority(TBJaune.Position);
end;

procedure TForm1.TBBleueChange(Sender: TObject);
begin
if DessineThreadBleue <> nil then
   DessineThreadBleue.Priority:=TThreadPriority(TBBleue.Position);
end;

procedure TForm1.BtnStartPairClick(Sender: TObject);
begin
ListBoxPair.clear;
BtnStartPair.Enabled:=False;
BtnStopbleu.Enabled:=True;
PairThread := TCalCulPairThread.create(LabelPair, ListBoxPair);
end;

procedure TForm1.BtnStopPairClick(Sender: TObject);
begin
ListBoxPair.clear;
BtnStartPair.Enabled:=True;
BtnStopbleu.Enabled:=False;
PairThread.free;

end;

procedure TForm1.TBpairChange(Sender: TObject);
begin
if PairThread <> nil then
   PairThread.Priority:=TThreadPriority(TBPair.Position);

end;

procedure TForm1.BtnSuspendPairClick(Sender: TObject);
begin
PairThread.Suspend;
end;

procedure TForm1.BtnResumePairClick(Sender: TObject);
begin
PairThread.Resume;
end;

end.