Wie Event-Handler der gemeinsamen Basisklasse auseinanderhalten?

[RSE]

Hallo!

Ich habe eine Klasse TMain, die einen Event nach dem Observer-Pattern bereitstellt (also mit Register- und Unregister-Prozeduren, um mehrere Handler bedienen zu können). In der Register-Prozedur rufe ich zuerst die Unregister-Prozedur auf, um sicherzustellen, dass kein Handler doppelt registriert wird (durch etwaige Fehler an anderer Stelle). Danach wird der Handler in die Liste hinzugefügt.

In einer Basisklasse TBase, ist solch ein Event-Handler definiert. Diese Basisklasse wird nie direkt instanziert, sondern vorher immer zuerst 1x abgeleitet (z.B. als TSpec1, TSpec2, TSpec3 usw.). Die Instanzen von TSpec1 und TSpec2 registrieren nun bei der Instanzierung beide den Handler für den Event bei TMain. Da der Handler aber in der Basisklasse definiert ist, sind die Einsprungadressen (@Handler) alle gleich, beim Anlegen einer Instanz wird ja nur der Speicherplatz für die Felder (Membervariablen) neu reserviert, der ausführbare Code wird für alle Instanzen einer Klasse gemeinsam genutzt. Folge: Bei der Registrierung des Handlers von TSpec1 läuft alles nach Plan. Soll aber der Handler von TSpec2 registriert werden, dann wird der Handler von TSpec1 aus der Liste der Handler entfernt, da er die gleiche Einsprungadresse hat... Wie kann ich diese beiden Handler voneinander unterscheiden? Die Einsprungadresse reicht offensichtlich nicht aus.

p.s. Dabei stellt sich mir gleich die Frage: Wie funktioniert eigentlich die Zuordnung zu der richtigen Instanz, wenn die Handler aufgerufen werden (wenn der Event feuert)? Vielleicht kann man ja den gleichen oder einen daran angelehnten Mechanismus nutzen, um die Handler voneinander zu unterscheiden.

[Bummi]

Habe ich jetzt nicht ganz verstanden.
Jedes instanzierte Objekt der abgeleiteten Klasse verwaltete die Handlerliste in seinem eigenen Speicherbereich, ob der in einer Basisklasse oder später implementiert wurde spielt doch hierbei keine Rolle....

[ChrisE]

Hallo,

man könnte die Registerprozeduren auf eine Klasse anstatt eine Methode definieren (z.B. TObjectList zur Verwaltung). TBase müsste dann Methode bereitstellen zur Informierung der Klasse sowie evtl. eine Methode für SollInformiert werden. Diese können ja in TBase abstract bleiben und in TSpecX implementiert werden.

PseudoCode:

Delphi-Quellcode:

//...
FMyList := TObjectList.Create(FALSE); //  OwnsObjects auf false setzten
//...
TMain.RegisterBaseClass(ABase: TBase);
var
  ind: Integer;
begin
  ind := FMyList.IndexOf(ABase);
  if ind <> -1 then 
  begin
    FMyList.Add(ABase);
  end;
end;
end;

TMain.UnregisterBaseClass(ABase: TBase);
var
  ind: Integer;
begin
  ind := FMyList.IndexOf(ABase);
  if ind <> -1 then 
  begin
    FMyList.Delete(ABase);
  end;
end;

TMain.AlleInformieren;
var
  i: Integer;
begin
  for i := 0 to FMyList.Count -1 do
  begin
    base := TBase(FMyList[i]);
    if base.SollInformiertWerden then
    begin
      base.Info(<Parameter>);
    end;
  end;
end;

Ungetestet :-)

Gruß, Chris

[RSE]

@Bummi:
Nein, der Event wird durch TMain verwaltet, es gibt TMain.RegisterEvent und TMain.UnRegisterEvent. In TMain ist also auch die Liste der Handler, die aufgerufen werden, wenn der Event feuert.

Wenn nun TSpec1 instanziert wird, dann ruft es TMain.RegisterEvent(EventHandler) auf. Dieses Verhalten ist komplett in TBase implementiert, incl. der Prozedur EventHandler. Das gleiche macht auch TSpec2. Daher erscheinen in der Liste von TMain nacheinander mehrere "Eventhandler"-Prozeduren mit gleichen Einsprungadressen.

@ChrisE:
Das würde sicherlich funktionieren, aber schön ist das nicht. Ein Event, der als Handler gleich eine ganze Klasse verlangt und dann beim Auslösen lediglich eine Methode daraus aufruft...

[shmia]

Anscheinend möchtest du mit einem Event aus einer Quelle mehrere Empfänger (auch bekannt als Consumer, Eventhandler ,Listener oder Eventsink).
Das wäre dann eine 1 zu N Beziehung.
Leider kann Delphi das nicht von Hause aus.

Im Anhang ist eine Unit, mit der man mehrere Eventhandler aufrufen kann;
vielleicht kannst du damit etwas anfangen.

[Bummi]

Wir haben unsere Lösung mit RTTI und Generics umgesetzt, daher kannst Du aus dem Codeauszug gegf. allenfalls Anregungen entnehmen

Delphi-Quellcode:

//....
procedure TEventDistributor.RegisterObserver(ASubject: TObject; ASubjectEventName: String; AObserver: TObject; AObserverMethodName: String);
begin
  RegisterObserver(ASubject, ASubjectEventName, GetMethod(AObserver, AObserverMethodName));
end;

procedure TEventDistributor.RegisterObserver(ASubject : TObject; ASubjectEventName : String; AObserverMethod : TMethod);
var
  ARegisteredEventsDictionary : TObjectDictionary<String, TList<TMethod>>;
begin
  // ensure that the event name is known for the given subject
  CheckEventExists(ASubject, ASubjectEventName);

  // register the subject if necessary
  if not FRegisteredEvents.ContainsKey(ASubject) then
    FRegisteredEvents.Add(ASubject, TObjectDictionary<String, TList<TMethod>>.Create([doOwnsValues]));

  // get the subjects event dictionary
  if FRegisteredEvents.TryGetValue(ASubject, ARegisteredEventsDictionary) then begin
    // register the event name into the subjects event dictionary if necessary
    if not ARegisteredEventsDictionary.ContainsKey(AnsiUpperCase(ASubjectEventName)) then
      ARegisteredEventsDictionary.Add(AnsiUpperCase(ASubjectEventName), TList<TMethod>.Create);

    if ARegisteredEventsDictionary.Items[AnsiUpperCase(ASubjectEventName)].IndexOf(AObserverMethod) = -1 then
      ARegisteredEventsDictionary.Items[AnsiUpperCase(ASubjectEventName)].Add(AObserverMethod);
  end
end;


//....


procedure TEventDistributor.UnregisterObserver(AObserver: TObject; AObserverMethodName : String = '');
var
  ASubjectEnumerator : TDictionary<TObject, TObjectDictionary<String, TList<TMethod>>>.TKeyEnumerator;
  ASubjectEventsEnumerator : TDictionary<String, TList<TMethod>>.TKeyEnumerator;
  AObserverMethodList : TList<TMethod>;
  nMethodCount : Integer;
begin
  // get the subject enumerator
  ASubjectEnumerator := FRegisteredEvents.Keys.GetEnumerator;
  try
    while ASubjectEnumerator.MoveNext do begin
      // get the event name enumerator
      ASubjectEventsEnumerator := FRegisteredEvents.Items[ASubjectEnumerator.Current].Keys.GetEnumerator;
      try
        while ASubjectEventsEnumerator.MoveNext do begin
          // get the method list for the even
          AObserverMethodList := FRegisteredEvents.Items[ASubjectEnumerator.Current].Items[ASubjectEventsEnumerator.Current];

          // remove methods related to the Observer
          for nMethodCount := AObserverMethodList.Count - 1 downto 0 do
            // when dealing with components also remove methods related to child components from the method list
            if (TObject(AObserverMethodList[nMethodCount].Data) is TComponent) and (AObserver is TComponent) then begin
              if ComponentIsOrOwns(TComponent(AObserver), TComponent(AObserverMethodList[nMethodCount].Data)) then
                // delete all methods if no method name was given. othercase delete the method with the corresponding code address
                if (AObserverMethodName = '') or (GetMethod(AObserver, AObserverMethodName).Code = TComponent(AObserverMethodList[nMethodCount].Code)) then
                  AObserverMethodList.Delete(nMethodCount);
            end
            // when dealing with objects (not components) ...
            else
              // delete all methods if no method name was given. othercase delete the method with the corresponding code address
              if (AObserverMethodName = '') or (GetMethod(AObserver, AObserverMethodName).Code = TComponent(AObserverMethodList[nMethodCount].Code)) then begin
                AObserverMethodList.Delete(nMethodCount);
                break;
              end;

          // remove the event dictionary if there are no methods registered and refresh the enumerator
          if AObserverMethodList.Count = 0 then begin
            FRegisteredEvents.Items[ASubjectEnumerator.Current].Remove(ASubjectEventsEnumerator.Current);
            ASubjectEventsEnumerator.Free;
            ASubjectEventsEnumerator := FRegisteredEvents.Items[ASubjectEnumerator.Current].Keys.GetEnumerator;
          end
          else
            FRegisteredEvents.Items[ASubjectEnumerator.Current].TrimExcess;
        end;
      finally
        ASubjectEventsEnumerator.Free;
      end;

      // remove the subject dictionary if there are no event names registered and refresh the enumerator
      if FRegisteredEvents.Items[ASubjectEnumerator.Current].Count = 0 then begin
        FRegisteredEvents.Remove(ASubjectEnumerator.Current);
        ASubjectEnumerator.Free;
        ASubjectEnumerator := FRegisteredEvents.Keys.GetEnumerator;
      end;
    end;
  finally
    ASubjectEnumerator.Free;
  end;

  FRegisteredEvents.TrimExcess;
end;


//....

procedure TEventDistributor.NotifyObservers(ASubject: TObject; ASubjectEventName: String; const ValueArguments: array of TValue);
var
  AMethod : TMethod;
  ARegisteredEventsDictionary : TObjectDictionary<String, TList<TMethod>>;
begin
  if FStopped then
    Exit;

  CheckEventExists(ASubject, ASubjectEventName);

  if FRegisteredEvents.TryGetValue(ASubject, ARegisteredEventsDictionary) then
    if ARegisteredEventsDictionary.ContainsKey(AnsiUpperCase(ASubjectEventName)) then
      for AMethod in ARegisteredEventsDictionary.Items[AnsiUpperCase(ASubjectEventName)] do
        InvokeMethod(AMethod, ValueArguments);
end;

function TEventDistributor.InvokeMethod(AMethod : TMethod; const Args: array of TValue): TValue;
var
  HandlerValue: TValue;
  HandlerObj: TObject;
  MethodRecPtr: ^TMethod;
  rttiContext: TRttiContext;
  rttiMethod: TRttiMethod;
begin
   Result := nil;

   HandlerValue := AMethod.Code;
   if HandlerValue.IsEmpty then
     Exit;

   MethodRecPtr := HandlerValue.GetReferenceToRawData;

   HandlerObj := AMethod.Data;

   for rttiMethod in rttiContext.GetType(HandlerObj.ClassType).GetMethods do
     if rttiMethod.CodeAddress = AMethod.Code then begin
       Result := rttiMethod.Invoke(HandlerObj, Args);
       Exit;
     end;
   raise EInsufficientRtti.Create(SEventHandlerHasInsufficientRTTI);
 end;

[RSE]

@ Bummi und shmia:

Die Lösung meines Problems steckte in euren beiden Beiträgen gleichermaßen: Ein Methodenzeiger zeigt nicht auf die Einsprungadresse der Prozedur, sondern auf einen Record vom Typ TMethod:

Delphi-Quellcode:

  TMethod = record
    Code, Data: Pointer;
  end;

Er besteht also zusätzlich aus einem Zeiger auf den Datenbereich der Instanz. Wenn ich nun beide Teile teste, anstatt nur @Handler, dann ist mein Problem gelöst. :-D

Vielen Dank!