1. Accueil
  2. Delphi / Pascal
  3. Sources Delphi / Pascal
  4. Sources Control
  5. Utilisation des threads

Utilisation des threads

Soyez le premier à donner votre avis sur cette source.

Vue 9 435 fois - Téléchargée 920 fois

Télécharger le projet
Commenter

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.
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Signaler

Ce programme est un bon exemple d'utilisation des threads.

Il faudrait juste que les boutons Suspend et Resume soin "disabled" lorque le thread est inactif.

Bonne continuation sur Delphi.
Signaler
Messages postés
309
Date d'inscription
jeudi 6 juin 2002
Statut
Membre
Dernière intervention
24 septembre 2008
 2
Très bon code où l'on comprend bien le fonctionnement des threads.

J'aurais simplement rajouté un sleep(1) dans le excute des threads pour éviter certains plantage.
S'inscrire maintenant

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.

Du même auteur (pinderlot)