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.
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.