6

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!

4

1 回答 1

1

让我给你一个例子，如何使用 XPObserver 单元。首先模拟一个数据模型的几个接口：

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只是包装一个byte值，它具有返回值并随机更改它的方法。IColorChannelObserver向它注册自己的接口的实现者也可以观察到它。

IColor只是包装一个TColor值，它只有一个返回值的方法。IColorObserver向它注册自己的接口的实现者也可以观察到它。

一个类实现IColorChannel，没什么难的：

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;

现在是一个实现IColorRGB 的类，它将包含并观察三个实例TColorChannel- 即单个观察者多主体关系：

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;

如果三个通道值中的任何一个发生更改，颜色将应用更改并依次通知所有观察者。

现在使用这些类的数据模块：

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;

最后是一个使用该数据模块并且只知道接口而不知道实现类的表单：

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;

表单实现了接口，但没有引用计数。它注册自己以观察数据模块的四个属性中的每一个，每当颜色通道更改时，它会在状态栏窗格中显示值，当颜色更改时，它会更新自己的背景颜色。有按钮可以随机更改颜色通道。

数据模块属性和其他更改数据的方法都可以有更多的观察者。

使用 FastMM4 在 Delphi 5 和 Delphi 2009 中测试，没有内存泄漏。当表单中没有匹配的DeleteObserver()每个调用时，就会出现泄漏AddObserver()。

于 2012-06-22T10:31:18.823 回答