The Visitor Pattern – Part 4 – The Art of Delphi Programming

The interface approach introduced in Part 2 of this series and extended in Part 3 did cover most of our needs. But there is nothing that can’t be done better with the right tools.

I’ve been using this approach for a couple of years and it made my life a lot easier. You need an export as DXF? No problem! Displaying in OpenGL? I’ll write a new visitor!

Writing the additional interfaces was easy done with the help of a customized code template, so that has never been a pain. The only thing that bothered me over time was that I could only apply the Visitor Pattern to classes I have control of. I just wasn’t able to visit, say, all the components of a TForm in a descent fashion (i.e. not queueing if component is something then <typecast>).

While digging through the new features of Delphi 2010 I discovered a solution which is as clean, lean, flexible and elegant as it could be. A little RTTI and some decent naming convention did the trick. Here is the code:

unit uVisitor;

interface

type
  TVisitor = class
  public
    procedure Visit(Instance: TObject); virtual;
  end;

implementation

uses
  Rtti;

procedure TVisitor.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;

end.

unit uVisitor;

interface

type

TVisitor = class

public

procedure Visit(Instance: TObject); virtual;

end;

implementation

uses

Rtti;

procedure TVisitor.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;

currentClass := currentClass.ClassParent;

until currentClass = nil;

end;

end.

And here is a visitor capable of handling some VCL controls on a form together with an example of its usage:

type
  TMyVisitor = class(TVisitor)
  public
    procedure VisitButton(Instance: TButton);
    procedure VisitLabel(Instance: TLabel);
    procedure VisitEdit(Instance: TEdit);
    procedure VisitMemo(Instance: TMemo);
  end;

procedure TMyVisitor.VisitButton(Instance: TButton);
begin
  Instance.Caption := 'a button';
end;

procedure TMyVisitor.VisitEdit(Instance: TEdit);
begin
  Instance.Text := 'an edit';
end;

procedure TMyVisitor.VisitLabel(Instance: TLabel);
begin
  Instance.Caption := 'a label';
end;

procedure TMyVisitor.VisitMemo(Instance: TMemo);
begin
  Instance.Lines.Clear;
  Instance.Lines.Add('a memo');
end;

procedure TForm40.Button1Click(Sender: TObject);
var
  I: Integer;
  visitor: TMyVisitor;
begin
  visitor := TMyVisitor.Create;
  try
    for I := 0 to ComponentCount - 1 do
      visitor.Visit(Components[I]);
  finally
    visitor.Free;
  end;
end;

type

TMyVisitor = class(TVisitor)

public

procedure VisitButton(Instance: TButton);

procedure VisitLabel(Instance: TLabel);

procedure VisitEdit(Instance: TEdit);

procedure VisitMemo(Instance: TMemo);

end;

procedure TMyVisitor.VisitButton(Instance: TButton);

begin

Instance.Caption := 'a button';

end;

procedure TMyVisitor.VisitEdit(Instance: TEdit);

begin

Instance.Text := 'an edit';

end;

procedure TMyVisitor.VisitLabel(Instance: TLabel);

begin

Instance.Caption := 'a label';

end;

procedure TMyVisitor.VisitMemo(Instance: TMemo);

begin

Instance.Lines.Clear;

Instance.Lines.Add('a memo');

end;

procedure TForm40.Button1Click(Sender: TObject);

var

I: Integer;

visitor: TMyVisitor;

begin

visitor := TMyVisitor.Create;

try

for I := 0 to ComponentCount - 1 do

visitor.Visit(Components[I]);

finally

visitor.Free;

end;

If you need to visit some class, just introduce a new method with a suitable name and signature and you are done. No new interfaces, no fiddling around with classes. It just works right out of the box.

I’m still visualizing some possible scenarios where this approach can be useful, too. Stay tuned.

Author: Uwe Raabe

Addicted to Pascal/Delphi since the late 70's View all posts by Uwe Raabe

Author: Uwe Raabe

4 thoughts on “The Visitor Pattern – Part 4”