How to use the XPObserver block contained in dunit DUnitWizard to implement an observer pattern or even an MVC pattern?

Question

There are good examples of Observer patterns in Delphi, thanks to wise questions and answers on Stackoverflow, such as The best way to implement an observer pattern in Delphi and Are there any videos / screens or other resources on how to use interfaces in Delphi? . The following tutorial links are extracted from these stackoverflow questions:

• Joanna Carter Blog

• Source site

• TDelphiHobbyist Blog

• website itte.no

• dunit DUnitWizard

This second question, stackoverflow mghie described dunit DUnitWizard XPObserver.pas as a very interesting and the other XP*.pas how deserving a closer look. However, the XPObserver block XPObserver referenced only in two places, in dunit\Contrib\DUnitWizard\Source\Common\dunit\XPObserverTests.pas , where the test’s only interest is to check the reference count and dunit\Contrib\DUnitWizard\Source\DelphiExperts\DUnitProject\XPTestedUnitUtils.pas , which uses only the IXPFamily type declared in the XPObserver block.

So I wonder what is the best use of this XPObserver block.

For example: design issues, for example:

(1) How to use the XPObserver block to implement an observer pattern that does something?

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

Or questions such as:

(3) XPObserver TXPSubjects is said to provide the ability to include a single observer<->multiple subject relationship. However, FSubjects declared private. There are also no getters. Interestingly, this is by design? (For example, the author wrote // ...***DON'T*** refactor this method!! in TXPSubject.DeleteObserver . Therefore, I am not sure about modifying the code because I cannot fully understand this and, maybe other parts.) If so, how can TXPSubjects be used to include a single observer<->multiple subject relation?

Thanks so much for your time and comments!

Answer 1

Let me give you an example of using the XPObserver block. First, several interfaces for modeling 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 simply wraps a byte value, it has methods for returning a value and randomly changing it. It is also observed by the developers of the IColorChannelObserver interface who register with it.

IColor just wraps the TColor value, it only has a method to return the value. This is also observed by the developers of the IColorObserver interface who register with it.

A class that implements IColorChannel is nothing complicated about this:

 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 that implements IColor for RGB, which will contain and observe three instances of TColorChannel - that is, the ratio of several observer subjects:

 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, will notify all its observers.

Now the 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 this data module and knows only about interfaces, nothing about 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; 

A form implements interfaces, but is not counted. It registers itself to observe each of the four properties of the data module; whenever a color channel changes, it displays a value in the status bar panel, when a color changes it, updates its own background color. There are buttons for randomly changing color channels.

Both modules can be more observers for the properties of the data module and other ways to modify data.

Tested in both Delphi 5 and Delphi 2009 using FastMM4, there are no memory leaks. There will be leaks if there is no corresponding call to DeleteObserver() for each AddObserver() on the form.