Delphi: creare e gestire Eventi Multipli (utilizzando una TList)

Questo secondo esempio sulla gestione degli eventi in Delphi permette di registrare più classi ad uno stesso evento. Questo viene fatto utilizzando un oggetto TList; non ho idea se sia la soluzione migliore, ma può essere un buono spunto per capire meglio il meccanismo.
Anche in questo caso tutto il castello si regge sul tipo di dato procedurale, che si definisce in questo modo:

TDecollo = procedure(Sender:TObject) of object;

TDecollo non è altro che un puntatore ad una procedura, che ancora deve essere specificata. E’ lo stesso meccanismo con cui si gestiscono gli eventi in C#, utilizzando i delegate.

In questo esempio abbiamo:

• La classe TorreDiControllo che genera un evento “decollo”.
• Più Shuttle che si registra all’evento e partono quando arriva il segnale.

Per implementare l’evento multicast la classe TorreDiControllo mantiene al suo interno un lista di oggetti ShuttleProntoAlDecollo, che hanno al loro interno il riferimento alla procedura da chiamare:

    ShuttleProntoAlDecollo = class
 
    decollo: TDecollo;
    property OnDecollo: TDecollo read decollo write decollo;
 
    end;

Per registrarsi all’evento gli Shuttle usano questo metodo:

   procedure TorreDiControllo.AddShuttleProntoAlDecollo(proc: TDecollo);
      var s: ShuttleProntoAlDecollo;
    begin
 
    s := ShuttleProntoAlDecollo.Create;
 
    s.decollo := proc;
 
    // La TList
    ShuttlesProntiAlDecollo.Add(s);
 
  end;

dove:

• viene creto un nuovo oggetto ShuttleProntoAlDecollo
• viene associata alla sua proprietà decollo (che è un puntatore ad un procedura) la procedura specificata dal chiamante
• viene inserito l’oggetto creato nella lista

La procedura Decollo della TorreDiControllo richiama tutte le procedure registrate:

  for p in ShuttlesProntiAlDecollo do
    begin
 
      // Estraggo la classe ShuttleProntoAlDecollo dal TList
      s := ShuttleProntoAlDecollo(p);
 
      // Estraggo il puntatore alla procedura da chiamare
      f := s.decollo;
 
 
      // Chiamata della procedura indicata dallo shuttle
      if Assigned(f) then
        f(self);
 
    end;

Qui è possibile scaricare il progetto contenente le classi sopra descritte.