Code pratique : une pile Lifo événementielle

---

Objectif : Nous proposons ici en suivant pas à pas l'enrichissement du code de montrer comment implanter un nouvel événement nommé OnTruc dans une classe dénotée ClassA. Puis nous appliquerons cette démarche à une pile Lifo qui sera rendu sensible à l'empilement et au dépilement, par adjonction de deux événements à la classe.

Pour construire un nouvel événement dans ClassA :

• Il nous faut d'abord définir un type pour l'événement : EventTruc
• Il faut ensuite mettre dans ClassA une propriété d'événement : property OnTruc : EventTruc
• Il faut créer un champ privé nommé FOnTruc de type EventTruc en lecture et écriture qui servira de champ de stockage de la propriété OnTruc.

 
Version-1 du code source

Unit  UDesignEvent  ;
 
 interface
 type
   EventTruc  =  procedure  ( Sender: TObject ;  info :string )  of  object  ;
  
   ClassA  =  class
 private
   FOnTruc  :  EventTruc  ;
 public
   OnTruc  :  EventTruc  read  FOnTruc   write  FOnTruc  ;
end;

implementation
 
 
end.

• Il nous faut maintenant construire une méthode qui va déclencher l'événement, nous utilisons une procédure surchargeable dynamiquement afin de permettre des redéfinitions utlérieures par les descendants.

 
Lorsque l'événement se nomme OnXXX, les équipes de développement Borland donnent la fin du nom de l'événement OnXXX à la procédure redéfinissable. Ici  pour l'événement OnTruc à la place de DeclencheTruc, nous la nommerons Truc.

Version-2 du code source

Unit  UDesignEvent  ;
 
 interface
 type
   EventTruc  =  procedure  ( Sender: TObject ;  info :string )  of  object  ;
   ClassA  =  class
 private
   FOnTruc  :  EventTruc  ;
 protected
  procedure  Truc(s :string ) ; virtual ;  // surchargeable dynamiquement
  public
   OnTruc  :  EventTruc  read  FOnTruc   write  FOnTruc  ;
end;

implementation
 
 procedure  ClassA.Truc(s :string ) ;
 begin
  if  Assigned ( FOnTruc )  then
    FOnTruc ( self  , s)
  end;
 
end.

• Pour terminer, il nous reste à définir un ou plusieurs gestionnaires possibles de l'événement OnTruc (ici nous en avons mis quatre), et à en connecter un à la propriété OnTruc de l'objet de classe ClassA.

Nous définissons une classe ClasseUse qui utilise sur un objet de classe ClassA l'événement OnTruc.

 

Version-3 du code source

Unit  UDesignEvent  ;
 
 interface
 type    EventTruc  =  procedure  ( Sender: TObject ;  info :string )  of  object  ;
  
   ClassA  =  class
 private
   FOnTruc  :  EventTruc  ;
 protected
  procedure  Truc(s :string ) ; virtual ;  // surchargeable dynamiquement
  public
   ObjA  :  ClassA  ;
   OnTruc  :  EventTruc  read  FOnTruc   write  FOnTruc  ;
  procedure  LancerTruc ;  // Declenche l'événement OnTruc
end;

ClasseUse  =  class
 public
  procedure  method_100( Sender: TObject ;  info :string ) ;
  procedure  method_101( Sender: TObject ;  info :string ) ;
  procedure  method_102( Sender: TObject ;  info :string ) ;
  procedure  method_103( Sender: TObject ;  info :string ) ;
  procedure  principale ;
end;

implementation
 
  {-------------------  ClassA   ------------------------}
  procedure  ClassA.Truc(s :string ) ;
 begin
  if  Assigned ( FOnTruc )  then
    FOnTruc ( self  , s)
  end;
 
 procedure  ClassA.LancerTruc  ;
 begin
   ....
  Truc ("événement déclenché") ;
   ....
  end;
  {-------------------  ClasseUse   ------------------------}
  procedure  ClasseUse.principale ;
 begin
   //....
   ObjA  :=  ClassA.Create  ;
   ObjA.OnTruc  :=  method_102  ;  // connexion
  //....
   ObjA.LancerTruc  ;  // lancement
  end;
 
 procedure  ClasseUse.method_100( Sender: TObject ;  info :string ) ;
 begin
   //....
  end;
 
 procedure  ClasseUse.method_101( Sender: TObject ;  info :string ) ;
 begin
   //....
  end;
 
 procedure  ClasseUse.method_102( Sender: TObject ;  info :string ) ;
 begin
   //....
  end;
 
 procedure  ClasseUse.method_103( Sender: TObject ;  info :string ) ;
 begin
   //....
  end;
 
end.
 

---

Code pratique : une pile Lifo événementielle

Objectif : Nous livrons une classe de pile lifo héritant d'une Tlist (Un objet Tlist de Delphi, stocke un tableau de pointeurs, utilisé ici pour gérer une liste d'objets) et qui est réactive à l'empilement et au dépilement d'un objet. Nous suivons la démarche précédente en nous inspirant de son code final pour construire deux événements dans la pile lifo et lui permettre de réagir à ces deux événements.


unit   ULifoEvent  ;
 
 interface
 uses   classes,Dialogs  ;
  
 type
   DelegateLifo  =  procedure  (  Sender:  TObject  ;   s  :string  )  of   object  ;
  
   ClassLifo  =  class  (TList)
  private
   FOnEmpiler  :  DelegateLifo  ;
   FOnDepiler  :  DelegateLifo  ;
 public
  function   Est_Vide   : boolean  ;
  procedure   Empiler (elt  : string  )  ;
  procedure   Depiler (  var   elt  : string  )  ;
   property   OnEmpiler  :  DelegateLifo   read   FOnEmpiler   write   FOnEmpiler  ;
   property   OnDepiler  :  DelegateLifo   read   FOnDepiler   write   FOnDepiler  ;
end;

ClassUseLifo  =  class
 public
  procedure   EmpilerListener(  Sender:  TObject  ;   s  :string  )  ;
  procedure   DepilerListener(  Sender:  TObject  ;   s  :string  )  ;
  constructor   Create  ;
  procedure   main  ;
end;

implementation
 
 procedure   ClassLifo.Depiler(  var   elt  : string  )  ;
 begin
  if   not   Est_Vide   then
  begin
    elt  :=string  (self.First)  ;
    self.Delete(0)  ;
    self.Pack  ;
    self.Capacity  :=  self.Count  ;
   if   assigned(FOnDepiler)   then
     FOnDepiler (  self  ,elt )
   end
 end;
 
 procedure   ClassLifo.Empiler(elt  : string  )  ;
 begin
   self.Insert(0 , PChar(elt))  ;
  if   assigned(FOnEmpiler)   then
    FOnEmpiler (  self  ,elt )
  end;
 
 
 function   ClassLifo.Est_Vide  : boolean  ;
 begin
  result  :=   self.Count  =  0  ;
 end;
 
  { ClassUseLifo }
 
  constructor   ClassUseLifo.Create  ;
 begin
  inherited;
 end;
 
 procedure   ClassUseLifo.DepilerListener(  Sender:   TObject  ;   s  :string  )  ;
 begin
   writeln  (  'On a depile : '  ,s)  ;
 end;
 
 procedure   ClassUseLifo.EmpilerListener(  Sender:   TObject  ;   s  :string  )  ;
 begin
   writeln  (  'On a empile : '  ,s)  ;
 end;
 
 procedure   ClassUseLifo.main  ;
 var
   pileLifo  :  ClassLifo  ;
   ch  :string  ;
  begin
    pileLifo  :=  ClassLifo.Create  ;
    pileLifo.OnEmpiler  :=   EmpilerListener  ;
    pileLifo.OnDepiler  :=   DepilerListener  ;
    pileLifo.Empiler(  '[ eau ]'  )  ;
    pileLifo.Empiler(  '[ terre ]'  )  ;
    pileLifo.Empiler(  '[ mer ]'  )  ;
    pileLifo.Empiler(  '[ voiture ]'  )  ;
    writeln  (  'Depilement de la pile :'  )  ;
   while   not   pileLifo.Est_Vide   do
   begin
     pileLifo.Depiler(ch)  ;
     writeln  (ch)  ;
   end;
    writeln  (  'Fin du depilement.'  )  ;
    readln  ;
  end;
  
end.