Wie Event-Handler der gemeinsamen Basisklasse auseinanderhalten?

[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.

Vielen Dank!