You can use the as operator:
var
intf1: IIntf1;
intf2: IIntf2;
begin
intf1 := Resolve<IIntf1>;
intf2 := intf2 as IIntf2;
Attention! The compile generates a call to System._IntfCast which throws an exception if QueryInterface does return 0.
So it is not the same behavior like it is for classes where an as returns nil if the instance does not inherit from the given class.
So I guess what you asking for is some kind of Supports method that only checks the interfaces registered with the container?
Otherwise I cannot think of any way how something the container could provide would be any shorter than a Supports call.
--
You received this message because you are subscribed to the Google Groups "Spring Framework for Delphi" group.
To unsubscribe from this group and stop receiving emails from it, send an email to spring4d+u...@googlegroups.com.
To post to this group, send email to spri...@googlegroups.com.
To view this discussion on the web visit
https://groups.google.com/d/msg/spring4d/-/d8-Whd09zaAJ.
For more options, visit https://groups.google.com/groups/opt_out.
In your example the instance behind the fIntf1 field has no clue about the TTT instance it is part of.
So you need something to delegate QueryInterface back to the container it is part of. System.TAggregatedObject is for this case but it has some problems as it does not work when used as interface reference itself as it does not only delegate the QueryInterface to its container but also the _AddRef and _Release calls causing memory leaks (as reported 7 years ago: http://qc.embarcadero.com/wc/qcmain.aspx?d=24316 – and still open ^^)
So here is what I wrote:
type
IAggregation = interface
['{566FCC7E-6E0D-4401-BE34-61C0C6F6C125}']
function GetContainer: IInterface;
procedure SetContainer(const Value: IInterface);
property Container: IInterface read GetContainer write SetContainer;
end;
TAggregation = class(TInterfacedObject)
private
fContainer: Pointer;
protected
function GetContainer: IInterface;
procedure SetContainer(const Value: IInterface);
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
public
constructor Create(Container: IInterface); overload;
property Container: IInterface read GetContainer write SetContainer;
end;
constructor TAggregation.Create(Container: IInterface);
begin
fContainer := Pointer(Container);
end;
function TAggregation.GetContainer: IInterface;
begin
Result := IInterface(fContainer);
end;
function TAggregation.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
Result := inherited QueryInterface(IID, Obj);
if Result = E_NOINTERFACE then
Result := IInterface(fContainer).QueryInterface(IID, Obj);
end;
procedure TAggregation.SetContainer(const Value: IInterface);
begin
fContainer := Pointer(Value);
end;
now you can write code like this:
type
IFoo = interface
['{3E53FECD-A143-4BE1-B940-115979244A5A}']
end;
IBar = interface(IAggregation)
['{FA50D22B-FBC8-4B20-8F21-CD8B168DEDD0}']
end;
TBar = class(TAggregation, IBar)
end;
TFoo = class(TInterfacedObject, IFoo, IBar)
private
fBar: IBar;
procedure SetBar(const Value: IBar);
protected
property Bar: IBar read fBar write SetBar implements IBar;
end;
procedure TFoo.SetBar(const Value: IBar);
begin
if Assigned(fBar) then
fBar.Container := nil;
fBar := Value;
if Assigned(fBar) then
fBar.Container := Self;
end;
var
obj: TFoo;
foo: IFoo;
bar: IBar;
foo2: IFoo;
begin
// simulate container creating the object
obj := TFoo.Create;
obj.Bar := TBar.Create;
foo := obj;
bar := foo as IBar;
foo2 := bar as IFoo;
end;