+ TTypedComObject

+ skeleton for TTypedComObjectFactory

git-svn-id: trunk@10711 -

packages/winunits-base/src/activex.pp

@@ -3094,14 +3094,16 @@ TYPE
   POleMenuGroupWidths = LPOLEMENUGROUPWIDTHS;
 
 
-    IProvideClassInfo = Interface (IUnknown)
-       ['{B196B283-BAB4-101A-B69C-00AA00341D07}']
-         function GetClassInfo(out pptti : ITypeInfo):HResult; StdCall;
-			 end;
-    IProvideClassInfo2 = Interface (IProvideClassInfo)
-       ['{A6BC3AC0-DBAA-11CE-9DE3-00AA004BB851}']
-         function GetGUID(dwguid:DWord;out pguid:TGUID):HResult; StdCall;
-	end;
+  IProvideClassInfo = Interface (IUnknown)
+    ['{B196B283-BAB4-101A-B69C-00AA00341D07}']
+    function GetClassInfo(out pptti : ITypeInfo):HResult; StdCall;
+  end;
+  
+  
+  IProvideClassInfo2 = Interface (IProvideClassInfo)
+    ['{A6BC3AC0-DBAA-11CE-9DE3-00AA004BB851}']
+    function GetGUID(dwguid:DWord;out pguid:TGUID):HResult; StdCall;
+  end;
 
 { ******************************************************************************************************************
                                                           stuff from objbase.h

packages/winunits-base/src/comobj.pp

@@ -175,6 +175,28 @@ unit comobj;
         property ThreadingModel: TThreadingModel read FThreadingModel;
       end;
 
+      { TTypedComObject }
+
+      TTypedComObject = class(TComObject, IProvideClassInfo)
+        function GetClassInfo(out pptti : ITypeInfo):HResult; StdCall;
+      end;
+
+      TTypedComClass = class of TTypedComObject;
+
+      { TTypedComObjectFactory }
+
+      TTypedComObjectFactory = class(TComObjectFactory)
+      private
+        FClassInfo: ITypeInfo;
+      public
+        constructor Create(AComServer: TComServerObject; TypedComClass: TTypedComClass; const AClassID: TGUID;
+          AInstancing: TClassInstancing; AThreadingModel: TThreadingModel = tmSingle);
+        function GetInterfaceTypeInfo(TypeFlags: Integer) : ITypeInfo;
+        procedure UpdateRegistry(Register: Boolean);override;
+        property ClassInfo : ITypeInfo read FClassInfo;
+      end;
+
+
     function CreateClassID : ansistring;
 
     function CreateComObject(const ClassID: TGUID) : IUnknown;
@@ -1036,6 +1058,35 @@ implementation
           FreeMem(Arguments);
       end;
 
+    { TTypedComObject }
+
+    function TTypedComObject.GetClassInfo(out pptti: ITypeInfo): HResult;stdcall;
+      begin
+        Result:=S_OK;
+        pptti:=TTypedComObjectFactory(factory).classinfo;
+      end;
+
+
+    { TTypedComObjectFactory }
+
+    constructor TTypedComObjectFactory.Create(AComServer: TComServerObject; TypedComClass: TTypedComClass; const AClassID: TGUID;
+      AInstancing: TClassInstancing; AThreadingModel: TThreadingModel = tmSingle);
+      begin
+        RunError(217);
+      end;
+
+
+    function TTypedComObjectFactory.GetInterfaceTypeInfo(TypeFlags: Integer): ITypeInfo;
+      begin
+        RunError(217);
+      end;
+
+
+    procedure TTypedComObjectFactory.UpdateRegistry(Register: Boolean);
+      begin
+        RunError(217);
+      end;
+
 
 const
   Initialized : boolean = false;