Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
Delphi XE3 Enterprise
|
AW: Wie Event-Handler der gemeinsamen Basisklasse auseinanderhalten?
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)
|
|
Zitat
|