Visitor Pattern

[Uwe Raabe]

Das ganze läßt sich allerdings viel eleganter, flexibler und nebenbei noch typsicher mit Interfaces realisieren. Dabei können die Basis-Klasse und die abgeleiteten Klassen in unterschiedlichen Units liegen und brauchen über den konkreten Visitor gar nichts wissen. Der Visitor muss natütlich alle Klassen kennen, die er besuchen will.

Delphi-Quellcode:

unit uVisitorTypes;

interface

type
  IVisitor = interface
    ['{59A6BE7C-6BD7-4746-AA37-F42DCB6D8D01}']
    procedure Visit(Instance: IInterface);
    procedure NotSupported(const Name: string);
  end;

  IVisited = interface
    ['{6C55ECC2-E1AB-43DD-96EC-755FF5C12400}']
    procedure Accept(Visitor: IVisitor);
  end;

implementation

end.

Delphi-Quellcode:

unit uBase;

interface

uses
  Classes, uVisitorTypes;

type
  { wahlweise auch von TInterfacedObject ableiten }
  TBase = class(TInterfacedPersistent, IVisited)
  protected
    procedure Accept(Visitor: IVisitor); virtual;
  public
  end;

  IBaseVisitor = interface
    ['{ACD6D82F-8C09-4B13-833B-9C653B99E050}']
    procedure VisitBase(Instance: TBase);
  end;

implementation

uses
  SysUtils;

procedure TBase.Accept(Visitor: IVisitor);
var
  MyVisitor: IBaseVisitor;
begin
  if Supports(Visitor, IBaseVisitor, MyVisitor) then
    MyVisitor.VisitBase(Self)
  else
    Visitor.NotSupported(ClassName);
end;

end.

Delphi-Quellcode:

unit unitA;

interface

uses
  uBase, uVisitorTypes;

type
  TA = class(TBase)
  private
    FAZeugs: string;
  protected
    procedure Accept(Visitor: IVisitor); override;
  public
    property AZeugs: string read FAZeugs write FAZeugs;
  end;

  IAVisitor = interface
    ['{3CEF1431-741C-4482-AC9C-1C787DE003C9}']
    procedure VisitA(Instance: TA);
  end;

implementation

uses
  SysUtils;

procedure TA.Accept(Visitor: IVisitor);
var
  MyVisitor: IAVisitor;
begin
  if Supports(Visitor, IAVisitor, MyVisitor) then
    MyVisitor.VisitA(Self)
  else
    Visitor.NotSupported(ClassName);
end;

end.

Delphi-Quellcode:

unit unitB;

interface

uses
  uBase, uVisitorTypes;

type
  TB = class(TBase)
  private
    FBZeugs: string;
  protected
    procedure Accept(Visitor: IVisitor); override;
  public
    property BZeugs: string read FBZeugs write FBZeugs;
  end;

  IBVisitor = interface
    ['{801E4A2D-74B6-49FC-8BC6-DCB995AF25F6}']
    procedure VisitB(Instance: TB);
  end;

implementation

uses
  SysUtils;

procedure TB.Accept(Visitor: IVisitor);
var
  MyVisitor: IBVisitor;
begin
  if Supports(Visitor, IBVisitor, MyVisitor) then
    MyVisitor.VisitB(Self)
  else
    Visitor.NotSupported(ClassName);
end;

end.

Delphi-Quellcode:

unit uVisitor;

interface

uses
  uVisitorTypes, unitA, unitB;

type
  { wahlweise auch von TInterfacedPersistent ableiten }
  TVisitor = class(TInterfacedObject, IVisitor, IAVisitor, IBVisitor)
  protected
    procedure NotSupported(const Name: string);
    procedure VisitA(Instance: TA);
    procedure VisitB(Instance: TB);
  public
    procedure Visit(Instance: IInterface);
  end;

implementation

uses
  SysUtils;

procedure TVisitor.NotSupported(const Name: string);
begin
  // nach Bedarf ignorieren oder Fehler melden
end;

procedure TVisitor.Visit(Instance: IInterface);
var
  visited: IVisited;
begin
  if Supports(Instance, IVisited, visited) then
    visited.Accept(Self)
  else
    // nach Bedarf ignorieren oder Fehler melden
end;

procedure TVisitor.VisitA(Instance: TA);
begin
  Writeln(Instance.AZeugs);
end;

procedure TVisitor.VisitB(Instance: TB);
begin
  Writeln(Instance.BZeugs);
end;

end.