Soyez le premier à donner votre avis sur cette source.
Vue 9 435 fois - Téléchargée 920 fois
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.
Il faudrait juste que les boutons Suspend et Resume soin "disabled" lorque le thread est inactif.
Bonne continuation sur Delphi.
J'aurais simplement rajouté un sleep(1) dans le excute des threads pour éviter certains plantage.
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.