Delphi Contrôle boucles

 (CD-ROMDelphi.ProcessMessages\MessageBoucle)

Objectif : Utiliser la méthode "ProcessMessages" pour interrompre, reprendre et arrêter l'exécution de la boucle :

                                for i:=1 to 2000 do ....
 

La fiche principale, le code associé dans la unit
 

Exécuter le programme
 

La fiche principale du  projet :

                                                                                                Remonter 

Le code de la Unit fiche principale :

unit UBoucles;

 interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

 type
  TForm1 = class(TForm)
    Memo1: TMemo;
    ButtonLancer: TButton;
    ButtonInterrupt: TButton;
    Buttonreprise: TButton;
    Edit1: TEdit;
    ButtonArret: TButton;
    Edit2: TEdit;
    procedure ButtonLancerClick(Sender: TObject);
    procedure ButtonInterruptClick(Sender: TObject);
    procedure ButtonrepriseClick(Sender: TObject);
    procedure ButtonArretClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

 var
  Form1: TForm1;
  FlagStop,FlagInterrupt:boolean;

implementation

{$R *.DFM}

 procedure RAZTout;
begin
 with Form1 do begin
  FlagInterrupt:=false;
  FlagStop:=false;
  Memo1.clear;
  Edit1.text:='';
  Edit2.text:='';
 end
end;

 procedure TForm1.ButtonLancerClick(Sender: TObject);
var i:integer;
begin
 RAZTout;
 for i:=1 to 2000 do
 begin
  Memo1.lines.add(inttostr(i));
  Application.ProcessMessages;
  if FlagStop then begin
    Edit2.text:='Arrêt demandé: '+inttostr(i);
    FlagStop:=false;
    exit
    {tester ici : break,exit,halt}
   end;
  if FlagInterrupt then
  begin
   Edit1.text:='Interruption: '+inttostr(i);
   repeat
     Application.ProcessMessages;
   until (FlagInterrupt=false)or(FlagStop=true) ;
  end
 end;
 Edit1.text:='Fin de la boucle '
end;

 procedure TForm1.ButtonInterruptClick(Sender: TObject);
begin
 FlagInterrupt:=true;
end;

 procedure TForm1.ButtonrepriseClick(Sender: TObject);
begin
 FlagInterrupt:=false;
end;

 procedure TForm1.ButtonArretClick(Sender: TObject);
begin
 FlagStop:=true;
end;

 procedure TForm1.FormCreate(Sender: TObject);
begin
 RAZTout;
end;

 end.                                                                Remonter