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 ?
It's hard to write code when delegation is used: An interface may be retrieved from the delegation object, and it may be retrieved from the declaring object.
To avoid this trouble, I let the IObserErAble pattern be implemented through a method in the base interface IUnknownEx.

This means:
- The accessible IObservErAble interface is allways that of the TObserverList !!


Reference counting
The code should be written so that it doesn't really matter whether refcounting is used or not, but I would not recommend using refcounting in the TObserverList.
Maybe one needs an TInterfaceList to cope with refcounting (here interfaces are not having their refcount increased when attached, as
they are cast to pointers).


Download source code

Program listing:


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.