begin process at 2010 02 10 06:39:39
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Control

 > UTILISATION DES THREADS

UTILISATION DES THREADS


 Information sur la source

Note :
9,5 / 10 - par 2 personnes
9,50 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :Control Niveau :Initié Date de création :24/08/2004 Vu / téléchargé :6 285 / 526

Auteur : pinderlot

Ecrire un message privé
Site perso
Commentaire sur cette source (1)
Ajouter un commentaire et/ou une note

 Description

Cliquez pour voir la capture en taille normale
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

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


 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources du même auteur

Source avec Zip Source avec une capture PROGRAMME DE CANAL NOMMÉ

 Sources de la même categorie

Source avec Zip Source avec une capture GESTION DE CASES À COCHER PERSONNALISÉES DANS UN STRINGGRID par Jean_Jean
Source avec Zip UN TASKDIALOG EN TROIS CLICKS par chramade
Source avec Zip Source avec une capture DÉPLACER LES ITEMS D'UNE TLISTVIEW PAR DRAG AND DROP par krzysiu
Source avec Zip Source avec une capture DEPLACER LES ITEMS D'UNE LISTBOX VERS UNE AUTRE PAR DRAG AND... par japee
Source avec Zip Source avec une capture SELECTDIRECTORY AVEC UNE CHECKBOXE. par ROCABDEL

Commentaires et avis

Commentaire de Loulibier le 25/08/2004 22:12:39

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.

 Ajouter un commentaire




Nos sponsors


Sondage...

Comparez les prix


HTC Hero

Entre 550€ et 550€

CalendriCode

Février 2010
LMMJVSD
1234567
891011121314
15161718192021
22232425262728

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,421 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales