Re: [fpc-devel] Considerations about observer [was: Free Pascal 2.6.2 rc1]

[Graeme Geldenhuys]

On 2012-11-28 10:07, Graeme Geldenhuys wrote:
> 
> You can add a CORBA interface to any existing class, and it doesn't need
> to descend from TInterfacedObject either. CORBA is not COM interfaces.
> 

In case anybody is in doubt. Here is a small example where CORBA
interfaces are attached to TComponent (aka TInterfacedObject
descendants) and TObject classes.

With CORBA interfaces - unlike COM interfaces - we can extend *any*
class. A lot more useful!



----8<-------------8<-------------8<-------------8<-------------8<----
MyShape was created
MyShape is being freed
----------------
MyShape was created
AttachObserver called - MyShape
MyShape is being freed
----------------
MyNonInterfacedObjectClass was created
AttachObserver called - MyNonInterfacedObjectClass
MyNonInterfacedObjectClass is being freed
----------------
----8<-------------8<-------------8<-------------8<-------------8<----


Regards,
  - Graeme -

-- 
fpGUI Toolkit - a cross-platform GUI toolkit using Free Pascal
http://fpgui.sourceforge.net/


program test;

{$mode objfpc}{$h+}
{$ifdef mswindows}
  {$apptype console}
{$endif}

{$interfaces corba}

uses
  Classes, SysUtils;
  
type

  IObserved = interface
  ['{5DEEE4A1-8D50-4EA2-96C6-E47EFB65A563}']
    procedure AttachObserver(AObserver: TObject);
  end;

  { 3rd party component - out of our control }
  TShape = class(TComponent)
  private
    FName: string;
  public
    constructor Create(const AName: string); virtual; reintroduce;
    property Name: string read FName write FName;
  end;


  { my personal extensions }
  TSquare = class(TShape, IObserved)
  private
    FSize: integer;
    { IObserved interface }
    procedure AttachObserver(AObserver: TObject);
  public
    property Size: integer read FSize write FSize;
  end;


  { my non-TInterfacedObject class }
  TMyClass = class(TObject, IObserved)
  private
    FName: string;
    { IObserved interface }
    procedure AttachObserver(AObserver: TObject);
  public
    property Name: string read FName write FName;
  end;


{ TShape }

constructor TShape.Create(const AName: string);
begin
  inherited Create(nil);
  FName := AName;
end;


procedure TSquare.AttachObserver(AObserver: TObject);
begin
  writeln('AttachObserver called - ', Name);
end;

{ TMyClass }

procedure TMyClass.AttachObserver(AObserver: TObject);
begin
  writeln('AttachObserver called - ', Name);
end;



var
  s1: TShape;
  s2: TSquare;
  s3: TMyClass;
  intf: IObserved;
begin
  { Lets try the Shape first }
  s1 := TShape.Create('MyShape');
  writeln(s1.Name + ' was created');

  if Supports(s1, IObserved, intf) then
    intf.AttachObserver(nil);

  writeln(s1.Name + ' is being freed');
  s1.Free;
  writeln('----------------');
  
  { now lets try the Square }
  s2 := TSquare.Create('MyShape');
  writeln(s2.Name + ' was created');

  if Supports(s2, IObserved, intf) then
    intf.AttachObserver(nil);

  writeln(s2.Name + ' is being freed');
  s2.Free;
  writeln('----------------');

  { now lets try the the non-TInterfacedObject class }
  s3 := TMyClass.Create;
  s3.Name := 'MyNonInterfacedObjectClass';
  writeln(s3.Name + ' was created');

  if Supports(s3, IObserved, intf) then
    intf.AttachObserver(nil);

  writeln(s3.Name + ' is being freed');
  s3.Free;
  writeln('----------------');
end.


_______________________________________________
fpc-devel maillist  -  fpc-devel@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-devel