Delphi support generic for IInterface. I have the follow construct using generic IInterface:
type
IVisitor<T> = interface
['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}']
procedure Visit(o: T);
end;
TMyVisitor = class(TInterfacedObject, IVisitor<TButton>, IVisitor<TEdit>)
procedure Visit(o: TButton); overload;
procedure Visit(o: TEdit); overload;
end;
implementation
procedure TMyVisitor.Visit(o: TButton);
begin
ShowMessage('Expected: TButton, Actual: ' + o.ClassName);
end;
procedure TMyVisitor.Visit(o: TEdit);
begin
ShowMessage('Expected: TEdit, Actual: ' + o.ClassName);
end;
TMyVisitor class implement two interface: IVisitor<TButton> and IVisitor<TEdit>.
I attempt invoke the methods:
procedure TForm6.Button1Click(Sender: TObject);
var V: IInterface;
begin
V := TMyVisitor.Create;
(V as IVisitor<TButton>).Visit(Button1);
(V as IVisitor<TEdit>).Visit(Edit1);
end;
The output I have is:
Expected: TEdit, Actual: TButton
Expected: TEdit, Actual: TEdit
Apparently, the code doesn't invoke procedure TMyVisitor.Visit(o: TButton) when execute (V as IVisitor<TButton>).Visit(Button1).
Is this a bug in Delphi or I should avoid implement multiple generic IInterface? All above codes have test in Delphi XE6.
as operator requires interface GUID to be able to tell which interface you are referring to. Since generic interfaces share same GUID as operator will not work with them. Basically, compiler cannot tell the difference between IVisitor<TButton> and IVisitor<TEdit> interfaces.
However, you can solve your problem using enhanced RTTI:
type
TCustomVisitor = class(TObject)
public
procedure Visit(Instance: TObject);
end;
TVisitor = class(TCustomVisitor)
public
procedure VisitButton(Instance: TButton); overload;
procedure VisitEdit(Instance: TEdit); overload;
end;
procedure TCustomVisitor.Visit(Instance: TObject);
var
Context: TRttiContext;
CurrentClass: TClass;
Params: TArray<TRttiParameter>;
ParamType: TRttiType;
SelfMethod: TRttiMethod;
s: string;
begin
Context := TRttiContext.Create;
CurrentClass := Instance.ClassType;
repeat
s := CurrentClass.ClassName;
Delete(s, 1, 1); // remove "T"
for SelfMethod in Context.GetType(Self.ClassType).GetMethods('Visit' + s) do
begin
Params := SelfMethod.GetParameters;
if (Length(Params) = 1) then
begin
ParamType := Params[0].ParamType;
if ParamType.IsInstance and (ParamType.AsInstance.MetaclassType = CurrentClass) then
begin
SelfMethod.Invoke(Self, [Instance]);
Exit;
end;
end;
end;
CurrentClass := CurrentClass.ClassParent;
until CurrentClass = nil;
end;
If you need to have Visitor interface you can change declarations to
type
IVisitor = interface
['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}']
procedure Visit(Instance: TObject);
end;
TCustomVisitor = class(TInterfacedObject, IVisitor)
public
procedure Visit(Instance: TObject);
end;
You can then use that in following manner, just by calling Visit and appropriate Visit method will be called.
procedure TForm6.Button1Click(Sender: TObject);
var V: IVisitor;
begin
V := TMyVisitor.Create;
V.Visit(Button1);
V.Visit(Edit1);
end;
Above code is based on Uwe Raabe's code and you can read more http://www.uweraabe.de/Blog/?s=visitor
And here is extended visitor interface and class that can operate on non-class types. I have implemented only calls for string, but implementation for other types consists only of copy-paste code with different typecast.
IVisitor = interface
['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}']
procedure Visit(const Instance; InstanceType: PTypeInfo);
procedure VisitObject(Instance: TObject);
end;
TCustomVisitor = class(TInterfacedObject, IVisitor)
public
procedure Visit(const Instance; InstanceType: PTypeInfo);
procedure VisitObject(Instance: TObject);
end;
procedure TCustomVisitor.Visit(const Instance; InstanceType: PTypeInfo);
var
Context: TRttiContext;
Params: TArray<TRttiParameter>;
ParamType: TRttiType;
SelfMethod: TRttiMethod;
begin
Context := TRttiContext.Create;
case InstanceType.Kind of
tkClass : VisitObject(TObject(Instance));
// template how to implement calls for non-class types
tkUString :
begin
for SelfMethod in Context.GetType(Self.ClassType).GetMethods('VisitString') do
begin
Params := SelfMethod.GetParameters;
if (Length(Params) = 1) then
begin
ParamType := Params[0].ParamType;
if ParamType.TypeKind = tkUString then
begin
SelfMethod.Invoke(Self, [string(Instance)]);
Exit;
end;
end;
end;
end;
end;
end;
procedure TCustomVisitor.VisitObject(Instance: TObject);
var
Context: TRttiContext;
CurrentClass: TClass;
Params: TArray<TRttiParameter>;
ParamType: TRttiType;
SelfMethod: TRttiMethod;
s: string;
begin
Context := TRttiContext.Create;
CurrentClass := Instance.ClassType;
repeat
s := CurrentClass.ClassName;
Delete(s, 1, 1); // remove "T"
for SelfMethod in Context.GetType(Self.ClassType).GetMethods('Visit' + s) do
begin
Params := SelfMethod.GetParameters;
if (Length(Params) = 1) then
begin
ParamType := Params[0].ParamType;
if ParamType.IsInstance and (ParamType.AsInstance.MetaclassType = CurrentClass) then
begin
SelfMethod.Invoke(Self, [Instance]);
Exit;
end;
end;
end;
CurrentClass := CurrentClass.ClassParent;
until CurrentClass = nil;
end;
Enhanced Visitor can be used like this:
TVisitor = class(TCustomVisitor)
public
procedure VisitButton(Instance: TButton); overload;
procedure VisitEdit(Instance: TEdit); overload;
procedure VisitString(Instance: string); overload;
end;
var
v: IVisitor;
s: string;
begin
s := 'this is string';
v := TVisitor.Create;
// class instances can be visited directly via VisitObject
v.VisitObject(Button1);
v.Visit(Edit1, TypeInfo(TEdit));
v.Visit(s, TypeInfo(string));
end;
Collected from the Internet
Please contact [email protected] to delete if infringement.
Comments