How to use the XPObserver unit contained in dunit's DUnitWizard, to implement an observer pattern, or even a MVC pattern?

Question

There are good examples of Observer pattern in Delphi, thanks to the wise questions & answers on Stackoverflow, such as Best way to implement observer pattern in Delphi and Are there any Videos/Screen casts or other resources on how to use Interfaces in Delphi?. From those stackoverflow questions, the following links of instructive materials are extracted:

1. Joanna Carter's blog

2. SourceMaking site

3. TDelphiHobbyist's blog

4. itte.no site

5. dunit's DUnitWizard

In that second stackoverflow question, mghie described dunit's DUnitWizard's XPObserver.pas as very interesting and other XP*.pas as worthing a closer look. However, the XPObserver unit is referenced only in two places, in dunit\Contrib\DUnitWizard\Source\Common\dunit\XPObserverTests.pas where the only interest of the test seems to be checking of reference counting, and dunit\Contrib\DUnitWizard\Source\DelphiExperts\DUnitProject\XPTestedUnitUtils.pas where only the IXPFamily type declared in the XPObserver unit is used.

I therefore wonders what is the best practice of using this XPObserver unit.

For example: Design questions, such as:

(1) How to use the XPObserver unit to implement an observer pattern that do something?

(2) How to use XPObserver to implement a MVC pattern?

Or coding questions like:

(3) XPObserver's TXPSubjects is claimed to provide the capability of enabling single observer<->multiple subject relation. However, FSubjects is declared private. There is also no getters. I wonder is this by design? (For example, the author has written // ...***DON'T*** refactor this method!! in TXPSubject.DeleteObserver. I am thus not confident to modify the code because I cannot understand this and maybe other parts completely.) If so, what is the supposed way to use TXPSubjects to enable single observer<->multiple subject relation?

Thank you very much for your time and comments!

Answer 1

Let me give you an example how to use the XPObserver unit. First several interfaces to simulate a data model:

type
  IColorChannel = interface(IXPSubject)
    function GetValue: byte;
    procedure RandomChange;
  end;

  IColorChannelObserver = interface(IXPObserver)
    ['{E1586F8F-32FB-4F77-ACCE-502AFDAF0EC0}']
    procedure Changed(const AChannel: IColorChannel);
  end;

  IColor = interface(IXPSubject)
    function GetValue: TColor;
  end;

  IColorObserver = interface(IXPObserver)
    ['{0E5D2FEC-5585-447B-B242-B9B57FC782F2}']
    procedure Changed(const AColor: IColor);
  end;

IColorChannel just wraps a byte value, it has methods to return the value and to randomly change it. It is also observable by implementers of the IColorChannelObserver interface that register themselves with it.

IColor just wraps a TColor value, it has just a method to return the value. It is also observable by implementers of the IColorObserver interface that register themselves with it.

A class implementing IColorChannel, nothing difficult about it:

type
  TColorChannel = class(TXPSubject, IColorChannel)
    function GetValue: byte;
    procedure RandomChange;
  private
    fValue: byte;
  end;

function TColorChannel.GetValue: byte;
begin
  Result := fValue;
end;

procedure TColorChannel.RandomChange;
var
  Value, Idx: integer;
  Icco: IColorChannelObserver;
begin
  Value := Random(256);
  if fValue <> Value then begin
    fValue := Value;
    for Idx := 0 to ObserverCount - 1 do begin
      // Or use the Supports() function instead of QueryInterface()
      if GetObserver(Idx).QueryInterface(IColorChannelObserver, Icco) = S_OK then
        Icco.Changed(Self);
    end;
  end;
end;

Now a class implementing IColor for RGB, which will contain and observe three instances of TColorChannel - i.e. the single observer multiple subjects relation:

type
  TRGBColor = class(TXPSubject, IColor, IColorChannelObserver)
    function GetValue: TColor;
  private
    fRed: IColorChannel;
    fGreen: IColorChannel;
    fBlue: IColorChannel;
    fValue: TColor;
    function InternalUpdate: boolean;
  public
    constructor Create(ARed, AGreen, ABlue: IColorChannel);

    procedure Changed(const AChannel: IColorChannel);
  end;

constructor TRGBColor.Create(ARed, AGreen, ABlue: IColorChannel);
begin
  Assert(ARed <> nil);
  Assert(AGreen <> nil);
  Assert(ABlue <> nil);
  inherited Create;
  fRed := ARed;
  fRed.AddObserver(Self, fRed);
  fGreen := AGreen;
  fGreen.AddObserver(Self, fGreen);
  fBlue := ABlue;
  fBlue.AddObserver(Self, fBlue);
  InternalUpdate;
end;

procedure TRGBColor.Changed(const AChannel: IColorChannel);
var
  Idx: integer;
  Ico: IColorObserver;
begin
  if InternalUpdate then
    for Idx := 0 to ObserverCount - 1 do begin
      if GetObserver(Idx).QueryInterface(IColorObserver, Ico) = S_OK then
        Ico.Changed(Self);
    end;
end;

function TRGBColor.GetValue: TColor;
begin
  Result := fValue;
end;

function TRGBColor.InternalUpdate: boolean;
var
  Value: TColor;
begin
  Result := False;
  Value := RGB(fRed.GetValue, fGreen.GetValue, fBlue.GetValue);
  if fValue <> Value then begin
    fValue := Value;
    Result := True;
  end;
end;

If any of the three channel values changes the color will apply the change and in turn notify all its observers.

Now a data module using these classes:

type
  TDataModule1 = class(TDataModule)
    procedure DataModuleCreate(Sender: TObject);
  private
    fRed: IColorChannel;
    fGreen: IColorChannel;
    fBlue: IColorChannel;
    fColor: IColor;
  public
    property BlueChannel: IColorChannel read fBlue;
    property GreenChannel: IColorChannel read fGreen;
    property RedChannel: IColorChannel read fRed;
    property Color: IColor read fColor;
  end;

procedure TDataModule1.DataModuleCreate(Sender: TObject);
begin
  Randomize;

  fRed := TColorChannel.Create;
  fGreen := TColorChannel.Create;
  fBlue := TColorChannel.Create;

  fColor := TRGBColor.Create(fRed, fGreen, fBlue);
end;

And finally a form that uses that data module and knows only about the interfaces, nothing about the implementing classes:

type
  TForm1 = class(TForm, IXPObserver, IColorChannelObserver, IColorObserver)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ButtonClick(Sender: TObject);
  public
    procedure Changed(const AChannel: IColorChannel); overload;
    procedure Changed(const AColor: IColor); overload;
    procedure ReleaseSubject(const Subject: IXPSubject;
      const Context: pointer);
  private
    fChannels: array[0..2] of IColorChannel;
    fColor: IColor;
  end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Idx: integer;
begin
  Button1.Caption := 'red';
  Button1.Tag := 0;
  fChannels[0] := DataModule1.RedChannel;

  Button2.Caption := 'green';
  Button2.Tag := 1;
  fChannels[1] := DataModule1.GreenChannel;

  Button3.Caption := 'blue';
  Button3.Tag := 2;
  fChannels[2] := DataModule1.BlueChannel;

  for Idx := 0 to 2 do
    fChannels[Idx].AddObserver(Self, fChannels[Idx]);

  fColor := DataModule1.Color;
  fColor.AddObserver(Self, fColor);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  Idx: integer;
begin
  for Idx := Low(fChannels) to High(fChannels) do
    fChannels[Idx].DeleteObserver(Self);
  fColor.DeleteObserver(Self);
end;

procedure TForm1.ButtonClick(Sender: TObject);
var
  Button: TButton;
begin
  Button := Sender as TButton;
  if (Button.Tag >= Low(fChannels)) and (Button.Tag <= High(fChannels)) then
    fChannels[Button.Tag].RandomChange;
end;

procedure TForm1.Changed(const AChannel: IColorChannel);
var
  Idx: integer;
begin
  Assert(AChannel <> nil);
  for Idx := Low(fChannels) to High(fChannels) do
    if fChannels[Idx] = AChannel then begin
      while StatusBar1.Panels.Count <= Idx do
        StatusBar1.Panels.Add;
      StatusBar1.Panels[Idx].Text := IntToStr(AChannel.GetValue);
      break;
    end;
end;

procedure TForm1.Changed(const AColor: IColor);
begin
  Assert(AColor <> nil);
  Color := AColor.GetValue;
end;

procedure TForm1.ReleaseSubject(const Subject: IXPSubject;
  const Context: pointer);
var
  Idx: integer;
begin
  // necessary if the objects implementing IXPSubject are not reference-counted
  for Idx := Low(fChannels) to High(fChannels) do begin
    if Subject = fChannels[Idx] then
      fChannels[Idx] := nil;
  end;
  if Subject = fColor then
    fColor := nil;
end;

The form implements interfaces but isn't reference-counted. It registers itself to observe each of the four properties of the data module, whenever a color channel changes it shows the value in a status bar pane, when the color changes it updates its own background color. There are buttons to randomly change the color channels.

There could both be more observers for the data module properties and other means of changing the data.

Tested in both Delphi 5 and Delphi 2009 using FastMM4, there are no memory leaks. There will be leaks when there isn't a matching call of DeleteObserver() for each AddObserver() in the form.