+ TAggregatedObject, fixes #8149

git-svn-id: trunk@6089 -

rtl/inc/objpas.inc

@@ -753,6 +753,43 @@
          TInterfacedObject(NewInstance).frefcount:=1;
       end;
       
+{****************************************************************************
+                               TAGGREGATEDOBJECT
+****************************************************************************}
+
+    constructor TAggregatedObject.Create(const aController: IUnknown);
+
+      begin
+        inherited Create;
+        { do not keep a counted reference to the controller! }
+        fcontroller := Pointer(aController);
+      end;
+
+    function TAggregatedObject.QueryInterface(
+      const iid : tguid;out obj) : longint;stdcall;
+
+      begin
+         Result := IUnknown(fcontroller).QueryInterface(iid, obj);
+      end;
+
+    function TAggregatedObject._AddRef : longint;stdcall;
+
+      begin
+         Result := IUnknown(fcontroller)._AddRef;
+      end;
+
+    function TAggregatedObject._Release : longint;stdcall;
+
+      begin
+         Result := IUnknown(fcontroller)._Release;
+      end;    
+  
+    function TAggregatedObject.GetController : IUnknown;
+
+      begin
+         Result := IUnknown(fcontroller);
+      end;    
+
 
 {****************************************************************************
                              Exception Support

rtl/inc/objpash.inc

@@ -227,6 +227,20 @@
        end;
        TInterfacedClass = class of TInterfacedObject;
        
+       TAggregatedObject = class(TObject)
+       private
+          fcontroller: Pointer;
+          function GetController: IUnknown;
+       protected
+          { implement methods of IUnknown }
+          function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
+          function _AddRef : longint;stdcall;
+          function _Release : longint;stdcall;
+       public
+          constructor Create(const aController: IUnknown);
+          property Controller : IUnknown read GetController;
+       end;
+
        { some pointer definitions }
        PUnknown = ^IUnknown;
        PPUnknown = ^PUnknown;