Klasse auf Interface testen

[Linor]

Hallo Zusammen,

auch wenn diese Frage des öfteren kam, eine konkrete Lösung habe ich bis jetzt nicht gefunden, auch ein Workaround wäre schon nett

Also folgendes:

Delphi-Quellcode:

TBasis = class
   procedure DoSomething;
end;

TNachfahre = class(TBasis, IMyInterface)
   procedure DoNachfahre;
end;

procedure TBasis.DoSomething;
begin
   if ( Supports(Self, IMyInterface) ) then
      DoSomethingElse;
end;

procedure TNachfahre. DoNachfahre;
begin
   ...
end;

procedure UndLos;
var
   n: TNachfahre;
begin
   n := TNachfahre.Create;
   n.DoSomething;

   n.DoNachfahre;  // Exception!
end;

Ich bin mir bewusst das Supports oben die Klassenreferenz (Self) in ein IMyInterface umwandelt, nur ich möchte an dieser Stelle nur eine Entscheidung treffen wenn das Interface unterstützt wird, die Referenz auf das Interface interessiert mich da nicht die Bohne. Denkbar wäre auch Supports mehrere male aufzurufen, was aber nicht geht, da Self nach dem verlassen von DoSomething zerstört ist und beim verlassen auch das Interface gekilled wird.

Wie ich oben schon schrieb, suche ich kein warum sondern ein wie!?

Also das sowas möglich wäre:

Delphi-Quellcode:

procedure TBasis.DoSomething;
begin
   if ( Supports(Self, IMyInterface) ) then
      DoSomethingElse;
   if ( Supports(Self, IMyOtherInterface) ) then
      DoSomethingDifferent;
end;

Im Grunde analog zu:

Delphi-Quellcode:

procedure TBasis.DoSomething;
begin
   if ( Self is TMyClass ) then
      DoSomethingElse;
   if ( Self is TMyOtherClass ) then
      DoSomethingDifferent;
end;

[himitsu]

Im Basistyp behandelt man besser keine Nachfahren.
Dort stellt man eher eine "änderbare" Schnittstelle zur Verfügung
und überschreibt dieses in den Nachfahren.

Delphi-Quellcode:

TBasis = class
   procedure DoSomething; virtual;
   // oder procedure DoSomething; virtual; abstract;
end;

TNachfahre = class(TBasis, IMyInterface)
   procedure DoSomething; override;
end;

TAnderes = class(TBasis, IMyOtherInterface)
   procedure DoSomething; override;
end;

[shmia]

Anstelle von Supports kannst du auch mal GetInterfaceEntry versuchen.
Vorsicht, du bist dann nahe an den internen Datenstrukturen von Delphi.

Delphi-Quellcode:

if Assigned(self.GetInterfaceEntry(IMyInterface)) then
   DoSomethingElse;
if Assigned(self.GetInterfaceEntry(IMyOtherInterface)) then
   DoSomethingDifferent;

Aber wie schon himitsu geschrieben hat solltest du das nicht abfragen.

[Linor]

Hallo,

danke für die schnellen Antworten, GetInterfaceEntry funktioniert wunderbar. Habe in der Zwischenzeit noch TInterfacedPersistent gefunden was ich anstelle von TInterfacedObject verwenden kann, kommt mir an anderen Stellen noch mehr zugute, da ich noch andere Stellen habe wo ich testen muss ein Objekt ein bestimmtes Interface unterstützt.

@himitsu: Im Prinzip hast du Recht, und ich verwende das auch so, nur habe ich eine Methode in der Basis-Klasse die von den Vorfahren per inherited aufgerufen wird und Default-Funktionen ausführt, die abgeleiteten Klassen erweitern diese nur. Jetzt müsste ich in jedem Nachfahren, der das Interface implementiert, immer wieder den gleichen Code einfügen...

Delphi-Quellcode:

procedure Vater.DoSomething;
begin
   ActionEins.Enabled := Check...
   ActionZwei.Enabled := Check...
end;

procedure Sohn.DoSomething;
begin
   inherited;

   ActionDrei.Enabled := Check...
   ActionInterface.Enabled := Check...
end;

procedure Tochter.DoSomething;
begin
   inherited;

   ActionVier.Enabled := Check...
end;

procedure Enkel.DoSomething;
begin
   inherited;

   ActionFünf.Enabled := Check...
   ActionInterface.Enabled := Check...
end;

Um das zu umgehen:

Delphi-Quellcode:

procedure Vater.DoSomething;
begin
   ActionEins.Enabled := Check...
   ActionZwei.Enabled := Check...

   if ( Supports(Self, MyInterface) ) then
      ActionInterface.Enabled := Check...
end;

Spart mir viel redundanten Code... Ich bin mir bewusst das man das auch über Klassen lösen könnte, aber ich habe eine bestehende Klassenhierarchie und möchte nur ein paar Objekte um Funktionen erweitern, will aber erkennen ob ich ein gerade ein Objekt vor mir habe das ein bestimmtes Verhalten implementiert. Ich arbeite viel mit:

Delphi-Quellcode:

procedure DoSomething(Vater: TVater);
var
   auto; IHatEinAuto;
begin
   if ( Supports(Vater, IHatEinAuto, auto) ) then
      auto.FahreLos;
end;

procedure UndLos;
var
   sohn: TSohn; tochter: TTochter; enkel: TEnkel;
begin
   sohn := TSohn.Create;
   DoSomething(sohn);
   sohn.DoAnything;

   tochter := TTochter.Create;
   DoSomething(tochter);
   tochter.DoAnything;

   enkel := TEnkel.Create;
   DoSomething(enkel);
   enkel.DoAnything;

end;

[Sir Rufo]

Wäre schön wenn du statt der CODE Tags die DELPHI Tags nutzen könntest