unit Visitor;
interface
uses
System.SysUtils,
System.Generics.Collections;
type
IVisitorHandler =
interface
['
{7C5BA846-6286-406A-AC87-3BC89F2E9F21}']
procedure Visit(
const Instance : TObject );
end;
IVisitorHandler<T :
class> =
interface( IVisitorHandler )
end;
TVisitor =
class
private
FVisitorDict : TDictionary<TClass, IVisitorHandler>;
public
constructor Create;
destructor Destroy;
override;
procedure RegisterType<T :
class>( AVisitor : IVisitorHandler<T> );
overload;
procedure RegisterType<T :
class>( AVisitor : TProc<T> );
overload;
procedure Clear;
procedure Visit( Instance : TObject );
end;
TVisitorHandler =
class abstract( TInterfacedObject, IVisitorHandler )
protected
procedure Visit(
const Instance : TObject );
virtual;
abstract;
end;
TVisitorHandler<T :
class> =
class abstract( TVisitorHandler, IVisitorHandler<T> )
end;
TAnonVisitorHandler<T :
class> =
class( TVisitorHandler<T> )
private
FVisitor : TProc<T>;
protected
procedure Visit(
const Instance : TObject );
override;
public
constructor Create( AVisitor : TProc<T> );
end;
implementation
{ TVisitor }
procedure TVisitor.Clear;
begin
FVisitorDict.Clear;
end;
constructor TVisitor.Create;
begin
inherited;
FVisitorDict := TDictionary<TClass, IVisitorHandler>.Create;
end;
destructor TVisitor.Destroy;
begin
FVisitorDict.Free;
inherited;
end;
procedure TVisitor.RegisterType<T>( AVisitor : TProc<T> );
begin
RegisterType<T>( TAnonVisitorHandler<T>.Create( AVisitor ) );
end;
procedure TVisitor.RegisterType<T>( AVisitor : IVisitorHandler<T> );
begin
FVisitorDict.AddOrSetValue( T, AVisitor );
end;
procedure TVisitor.Visit( Instance : TObject );
var
LClass : TClass;
begin
LClass := Instance.ClassType;
while Assigned( LClass )
do
begin
if FVisitorDict.ContainsKey( LClass )
then
begin
FVisitorDict[LClass].Visit( Instance );
Break;
end;
LClass := LClass.ClassParent;
end;
end;
{ TAnonVisitorHandler<T> }
constructor TAnonVisitorHandler<T>.Create( AVisitor : TProc<T> );
begin
inherited Create;
FVisitor := AVisitor;
end;
procedure TAnonVisitorHandler<T>.Visit(
const Instance : TObject );
begin
FVisitor( Instance
as T );
end;
end.