An Observer / Observable implementation in Delphi using Interfaces:
The idea behind this solution is that there would really nly be a need for a single class handling registration of observers in a list. All classes that implement the Observable pattern would delegate the IObserver interface to this class.
Furthermore, this fact: When you register yourself somewhere, it's because the other party provide interesting information. The other party also needs to know whether your address is still the same, and whether you're still alive. Sad if the information provider is about to send mail over and over after you're dead. As a concequence of this, the Observer and Observable patterns have been joined into a single IObservErAble interface. Whenever an IObservErAble attaches itself to another IObservErAble, the other party likewise connects to the requesting interface.
The Observer / Observable pattern pair could be extended,
of course. Personally I have chosen to keep this interface close to the pattern
"idea", as it is an intricate mechanism that
would benefit from not being touched too much. Bugs are likely to be created, and they are hard to find.
The only thing missing then, is to give the IObserverable interface a means to notify its owner. The class would not know anything about the owner class other than that it neccesarily implements the IObserverable interface. We have then two possible solutions:
a) Messaging - sending messages to the implementing object via Dispatch()
b) Create a basic interface for all objects implementing the IObserverable interface, in fact - a rudimentary interface for almost all classes in a system. Let's call this the IUnknownEx.
c) Provide an event handler for the IObserverable interface
This
model is based on alternative b), the IUnknownEx model.
Interface belonging to what object ?
unit UObserver;
interface
uses classes, SysUtils, Windows, Dialogs;
const
ALL_OBJECTS = nil;
REMOVE_ME = 1;
// Notification Messages
VAC_FREE = 1;
VAC_PROPCHANGED = 2;
type
IObservErAble = interface; // forward
IUnknownEx = interface(IUnknown)
['{062BCD20-05BD-11D6-A658-0000C0A8D864}']
// return the IObserverable interface if implemented, otherwise nil. This prevents "awkward" checking...
function _IObservErAble: IObservErAble;
// Incoming notification messages proc
procedure ObjectNotification(Action: word; Observable: IObservErAble; Obj, Item: IUnknownEx; Param: integer);
// If the object is in "update state", then don't notify observers
function Updating: boolean;
// A simple way of accessing the class...
function _Self: TObject;
end;
// IObservErAble (= IObserver + IObservable) is the messenger interface, meant for inter-object notifications.
// Dataobjects normally notify through their Owner collections. The receiver method is the IUnknownEx.ObjectNotification
IObservErAble = interface(IUnknown)
['{062BCD21-05BD-11D6-A658-0000C0A8D864}']
{IObserver members}
procedure _Notification(Action: word; Sender: IObservErAble; Obj, Item: IUnknownEx; Param: integer; var RemoveMe: boolean); // incoming notifications, pass on to Owner.ObjectNotification
{IObservable members}
function _GetOwner: IUnknownEx;
procedure Attach(Sender: IObservErAble); // add Sender to observerlist
procedure AttachTo(Target: IObservErAble); // add self to Target.IObserverable; add Target to Observed-list
procedure Detach(Sender: IObservErAble); // remove object from observerlist
procedure DetachFrom(Target: IObservErAble); // remove self from Target's observerlist; remove Target from Observed-list
procedure Notify(Action: word; Obj, Item: IUnknownEx; Param: integer); // Send notification to observers
property _Owner: IUnknownEx read _GetOwner;
{End IObservable members}
end;
TObserverList = class(TList, IObservErAble)
private
FObserved: TList; // List of Items that the owner is observing. The list itself holds attached Observers
FOwner: IUnknownEx;
// IUnknown members
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
// end IUnknown
protected
public
constructor Create(AOwner: IUnknownEx);
destructor destroy; override;
// IObservErAble members
function _GetOwner: IUnknownEx;
procedure Attach(Sender: IObservErAble);
procedure AttachTo(Target: IObservErAble);
procedure Detach(Sender: IObservErAble);
procedure DetachFrom(Target: IObservErAble);
procedure _Notification(Action: word; Sender: IObservErAble; Obj, Item: IUnknownEx; Param: integer; var RemoveMe: boolean);
procedure Notify(Action: word; Obj, Item: IUnknownEx; Param: integer);
// end IObservErAble
end;
// Note: The IObservErAble is not implemented, it's accessible through the IUnknownEx interface !!!
TSampleClass = class(TObject, IUnknownEx)
private
FObserverList: TObserverList;
FName: string;
FID: integer;
// IUnknown members
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
procedure SetName(const Value: string);
// end IUnknown
public
constructor create;
destructor destroy; override;
class function NextID: integer;
// IUnknownËx members
function _IObservErAble: IObservErAble;
procedure ObjectNotification(Action: word; Observable: IObservErAble; Obj, Item: IUnknownEx; Param: integer);
function Updating: boolean;
function _Self: TObject;
// end IUnknownEx
// Implementing IObserverable:
property Name: string read FName write SetName;
property ID: integer read FID;
end;
implementation
{ TObserverList }
constructor TObserverList.Create(AOwner: IUnknownEx);
begin
FOwner := AOwner;
FObserved:=TList.Create;
inherited Create;
end;
destructor TObserverList.destroy;
begin
DetachFrom(ALL_OBJECTS);
Notify(VAC_FREE, nil, nil, 1);
FObserved.Free;
inherited destroy;
end;
procedure TObserverList.AttachTo(Target: IObservErAble);
begin
Assert(Assigned(Target), 'TObserverList.Attach(Sender = nil!!!)');
if FObserved.IndexOf(pointer(Target)) < 0 then
FObserved.Add(pointer(Target));
Target.Attach(FOwner._IObservErAble);
end;
procedure TObserverList.Attach(Sender: IObservErAble);
begin
Assert(Assigned(Sender), 'TObserverList.Attach(Sender = nil!!!)');
if IndexOf(pointer(Sender)) < 0 then
Add(pointer(Sender));
end;
procedure TObserverList.DetachFrom(Target: IObservErAble);
var
i: integer;
begin
if Target = ALL_OBJECTS then begin
for i:=0 to FObserved.Count-1 do
IObserverable(FObserved[i]).Detach(FOwner._IObservErAble);
FObserved.Clear;
end
else begin
FObserved.Remove(pointer(Target));
Target.Detach(FOwner._IObservErAble);
end;
end;
procedure TObserverList.Detach(Sender: IObservErAble);
begin
Remove(pointer(Sender));
end;
// Incoming notifications
procedure TObserverList._Notification(Action: word; Sender: IObservErAble; Obj, Item: IUnknownEx; Param: integer; var RemoveMe: boolean);
begin
FOwner.ObjectNotification(Action, Sender, Obj, Item, Param);
RemoveMe := Param = 1;
end;
// Outgoing Notifications
// Sending Ation = VAC_FREE is done when the owner calls Destroy;
// All Observers are notified, then list is deleted.
procedure TObserverList.Notify(Action: word; Obj, Item: IUnknownEx; Param: integer);
function NotifyItem(AItem: IObservErAble): boolean;
begin
result := false;
AItem._Notification(Action, FOwner._IObservErAble, Obj, Item, Param, result);
end;
var
i : integer;
dummy : boolean;
begin
if FOwner.Updating then exit;
for i := Count - 1 downto 0 do
if NotifyItem(IObservErAble(Items[i])) and (Action <> VAC_FREE) then
Delete(i);
end;
function TObserverList._AddRef: Integer;
begin
result:=-1;
end;
function TObserverList._Release: Integer;
begin
result:=-1;
end;
function TObserverList.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function TObserverList._GetOwner: IUnknownEx;
begin
result:=FOwner;
end;
{ TSampleClass }
function TSampleClass._AddRef: Integer;
begin
result:=-1;
end;
function TSampleClass._IObservErAble: IObservErAble;
begin
result:=FObserverList;
end;
function TSampleClass._Release: Integer;
begin
result:=-1;
end;
constructor TSampleClass.create;
begin
inherited Create;
FObserverList:=TObserverList.Create(Self);
FID:=NextID;
end;
destructor TSampleClass.destroy;
begin
FObserverList.Free;
inherited destroy;
end;
procedure TSampleClass.ObjectNotification(Action: word; Observable: IObservErAble; Obj, Item: IUnknownEx; Param: integer);
var
AObject: TObject;
begin
case Action of
VAC_FREE:
begin
FObserverList.DetachFrom(Observable);
end;
VAC_PROPCHANGED:
begin
AObject:=Observable._Owner._Self;
with AObject as TSampleClass do
ShowMessage('Notification from TSampleClass instance (ID='+IntToStr(ID)+'): Property Changed (Name='+Name+')');
end;
end;
end;
function TSampleClass.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function TSampleClass.Updating: boolean;
begin
result:=false;
end;
procedure TSampleClass.SetName(const Value: string);
begin
if (FName <> value) then begin
FName := Value;
FObserverList.Notify(VAC_PROPCHANGED, nil, nil, 0);
end;
end;
function TSampleClass._Self: TObject;
begin
result:=Self;
end;
class function TSampleClass.NextID: integer;
const
gNextID: integer = 0;
begin
result:=gNextID;
inc(gNextID);
end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, UObserver,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Edit1: TEdit;
Button5: TButton;
Button6: TButton;
Button7: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
Obj1: TSampleClass;
Obj2: TSampleClass;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// Create 1st object
procedure TForm1.Button1Click(Sender: TObject);
begin
if Assigned(Obj1) then exit;
Obj1:=TSampleClass.Create;
end;
// Create 2nd object
procedure TForm1.Button2Click(Sender: TObject);
begin
if Assigned(Obj2) then exit;
Obj2:=TSampleClass.Create;
end;
// Let 2nd object observe 1st object
procedure TForm1.Button3Click(Sender: TObject);
begin
Obj2._IObservErAble.AttachTo(Obj1._IObservErAble);
end;
// Set property value of 1st object
procedure TForm1.Button4Click(Sender: TObject);
begin
Obj1.Name:=Edit1.Text;
end;
// Free objects, to sett that everything is OK with "coupling"
procedure TForm1.Button5Click(Sender: TObject);
begin
FreeAndNil(Obj1);
FreeAndNil(Obj2);
end;
// Let 1st object observe 2nd object
procedure TForm1.Button6Click(Sender: TObject);
begin
Obj1._IObservErAble.AttachTo(Obj2._IObservErAble);
end;
// Set property value of 2nd object
procedure TForm1.Button7Click(Sender: TObject);
begin
Obj2.Name:=Edit1.Text;
end;
end.