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 - [email protected]
http://lists.freepascal.org/mailman/listinfo/fpc-devel
