Utilisation des threads

Description

Ce petit programme très simple qui colore l'écran en rouge, jaune, bleu et qui affiche les nombres pairs et impairs permet de comprendre l'utilisation et l'intérêt des threeads.

Source / Exemple :


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.

Codes Sources

A voir également

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.