Delphi Contrôle 2Fiches

 (CD-ROMDelphi.ProcessMessages\Message2fiches)

Objectif : Utiliser la méthode "ProcessMessages" pour interrompre l'exécution de deux boucles " for i:=1 to 2000 do ...." situées chacune dans une fiche différente. Cet exercice basé sur l'exemple boucles traitant de ce problème dans une seule fiche, contient deux fiches (une fiche principale la fiche "Form1" et une fiche secondaire "Form2"). En observant bien le comportement de l'exécution vous comprendrez comment fonctionne la méthode ProcessMessages qui interrompt le code en cours pour aller traiter les messages de la file d'attente jusqu'à épuisement avant de revenir au  code initial.
 

La fiche principale, le code associé dans la unit

La fiche secondaire, le code associé dans la unit

Exécuter le programme
 

La fiche principale du  projet :

La fiche secondaire du  projet :

Le code de la Unit fiche principale :

unit Uprocessmess;

interface

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

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

var
  Form1: TForm1;
  FlagStop:boolean;

implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.ButtonLancerClick(Sender: TObject);
var i:integer;
begin
 FlagStop:=false;
 memo1.clear;
 for i:=1 to 2000 do
 begin
  memo1.lines.add(inttostr(i));
  Application.ProcessMessages;
  if FlagStop then
  begin
   Edit1.text:='Interruption: '+inttostr(i);
   Break
  end
 end
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 FlagStop:=false;
end;

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

end.                                                                      Remonter 
 
 

Le code de la Unit fiche secondaire :

unit Unit2;

interface

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

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

var
  Form2: TForm2;

implementation
 var FlagStop:boolean;
{$R *.DFM}

procedure TForm2.ButtonLancerClick(Sender: TObject);
var i:integer;
begin
 FlagStop:=false;
 memo1.clear;
 for i:=1 to 2000 do
 begin
  memo1.lines.add(inttostr(i));
  Application.ProcessMessages;
  if FlagStop then
  begin
   Edit1.text:='Interruption: '+inttostr(i);
   Break
  end
 end
end;

procedure TForm2.ButtonInterruptClick(Sender: TObject);
begin
 FlagStop:=true;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
 FlagStop:=false;
 Show
end;

end.                                                           Remonter