Einzelnen Beitrag anzeigen

Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#6

AW: Wie Event-Handler der gemeinsamen Basisklasse auseinanderhalten?

  Alt 29. Apr 2011, 13:48
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;
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat