Created by
Stefan Glienke
| program VisitorDemo;
{$APPTYPE CONSOLE}
uses
Generics.Collections,
SysUtils;
type
TAction<T> = reference to procedure(const obj: T);
IVisitor = interface
procedure Visit(const value: TObject);
end;
IVisitorRegistry = interface(IVisitor)
procedure RegisterVisitor(cls: TClass; const action: TAction<TObject>);
end;
TVisitorRegistry = class(TInterfacedObject, IVisitor, IVisitorRegistry)
private
fVisitors: TDictionary<TClass,TAction<TObject>>;
public
constructor Create;
destructor Destroy; override;
procedure RegisterVisitor(cls: TClass; const action: TAction<TObject>);
procedure Visit(const value: TObject);
end;
{ TVisitorRegistry }
constructor TVisitorRegistry.Create;
begin
inherited Create;
fVisitors := TDictionary<TClass,TAction<TObject>>.Create;
end;
destructor TVisitorRegistry.Destroy;
begin
fVisitors.Free;
inherited;
end;
procedure TVisitorRegistry.RegisterVisitor(cls: TClass; const action: TAction<TObject>);
begin
fVisitors.Add(cls, action);
end;
procedure TVisitorRegistry.Visit(const value: TObject);
var
cls: TClass;
action: TAction<TObject>;
begin
cls := value.ClassType;
repeat
if fVisitors.TryGetValue(cls, action) then
begin
action(value);
Break;
end;
cls := cls.ClassParent;
until cls = nil;
end;
type
TFoo = class
end;
TBar = class
end;
TFooBar = class(TBar)
end;
var
visitor: IVisitorRegistry;
foo: TFoo;
bar: TBar;
fooBar: TFooBar;
begin
visitor := TVisitorRegistry.Create;
visitor.RegisterVisitor(TFoo, TAction<TObject>(procedure(const x: TFoo) begin Writeln(x.ClassName) end));
visitor.RegisterVisitor(TBar, TAction<TObject>(procedure(const x: TBar) begin Writeln(x.ClassName) end));
foo := TFoo.Create;
bar := TBar.Create;
visitor.Visit(foo);
visitor.Visit(bar);
fooBar := TFooBar.Create;
visitor.Visit(fooBar);
Readln;
end.
|