Adding interfaces to any class (tnx Warfley!) lazarus / 21-General ---------------------------------------------------------------------- Thaddy · 2024-12-10 11:52 A couple of weeks ago I proposed a feature request that enables you to add a COM interface to any class. Warfley implemented it and Florian committed it two days ago. Since my dreamed up code in the feature request contains a bug (I could not test it, because it did not exist in the first place) Here is the working code that I envisioned:Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i Program examplecom;{   The ability to add a COM interface to classes   that do not inherit from TInterfacedObject.    Allows automatic memory management (ARC style)}  {$mode delphi}uses classes; type  { you can skip this and use simply IInterface here }  IInterfaced = interface   ['{ADEAD83C-06E1-41A5-A40B-C19D06FE8B9F}']  end;   TInterfaced = class(T,IInterfaced)  private    frefcount:integer;    FDestroyCount:integer;  public    { winapi is cross platform: the compiler chooses the right calling convention }  function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;      out obj) : longint;winapi;    function _AddRef : longint;winapi;    function _Release : longint;winapi;    destructor destroy;override;  procedure AfterConstruction;override;        procedure BeforeDestruction;override;    class function NewInstance : TObject;override;  end;    function TInterfaced.QueryInterface(  {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;winapi;  begin    if GetInterface(iid,obj) then      result:=S_OK     else      result:=longint(E_NOINTERFACE);  end;   function TInterfaced._AddRef : longint;winapi;  begin    _addref:=InterlockedIncrement(frefcount);  end;   function TInterfaced._Release : longint;winapi;  begin    Result := InterlockedDecrement(frefcount);    if Result = 0 then      Destroy;  end;   destructor TInterfaced.Destroy;  begin    FRefCount:=0;    FDestroyCount:=0;    inherited Destroy;  end;   procedure TInterfaced.AfterConstruction;  begin    InterlockedDecrement(frefcount);  end;   procedure TInterfaced.BeforeDestruction;  begin    if frefcount <> 0 then    halt(204);  end;   class function TInterfaced.NewInstance : TObject;  begin    result:= inherited NewInstance;    TInterfaced(result).frefcount := 1;  end;  type  TInterfacedStringlist = TInterfaced;   var  List:IInterfaced;  SList:TStringlist;begin  List :=TInterfacedStringlist.create;  with list as TInterfacedStringlist do  begin    Add('some text');    writeln(Text);  end;  { alternatively }  Slist := list as TInterfacedStringlist;  slist.add('some more text');  writeln(slist.text);  { no leaks! }end. Again, tnx Warfley!! THIS ONLY WORKS FOR A TRUNK LATER THAN DECEMBER 8, 2024 If you can't read the above don't bother to ask questions. ---------------------------------------------------------------------- cdbc · 2024-12-10 12:35 Hi Nifty \o/ Me Likey  ...ahumm, the curly bracket in this:Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i class(}T,IInterfaced)is just a typo, right?!? Regards Benny ---------------------------------------------------------------------- Thaddy · 2024-12-10 12:52 Actually a pasto, not a typo. Corrected. What Frederic implemented has, much, much more possibilities, though. Not only this. Because with a class restriction now all methods and members of TObject are available instead or the previous dummy. This is quite an important change. ---------------------------------------------------------------------- cdbc · 2024-12-10 13:35 Hi Thaddy Yup, that /little/ difference is actually *all-important*... As I said: Nifty \o/ Regards Benny ---------------------------------------------------------------------- Thaddy · 2024-12-10 18:32 what I find is: Cosy here, nice and calm... Few can see it. ---------------------------------------------------------------------- ASerge · 2024-12-11 15:18 Quote from: Thaddy on December 10, 2024, 12:52:27 pmHere is the working code that I envisioned:... But what if we do without generic, for which a lot of code will be generated for each class: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i {$MODE OBJFPC}{$APPTYPE CONSOLE} uses SysUtils, Classes; type  TIntfWrapper = class(TInterfacedObject, IInterface)  strict private    FObj: TObject;    FOwned: Boolean;    function QueryInterface(constref iid: TGuid; out Obj): LongInt; winapi;  public    constructor Create(AObj: TObject; AOwned: Boolean = True);    destructor Destroy; override;  end; { TSome } constructor TIntfWrapper.Create(AObj: TObject; AOwned: Boolean);begin  FObj := AObj;  FOwned := AOwned;end; destructor TIntfWrapper.Destroy;begin  if FOwned then    FreeAndNil(FObj);  inherited;end; function TIntfWrapper.QueryInterface(constref iid: TGuid; out Obj): LongInt; winapi;begin  if IsEqualGUID(iid, IObjectInstance) then  begin    Pointer(Obj) := FObj;    Result := S_OK;  end else    Result := inherited;end; var  IList: IInterface;begin  IList := TIntfWrapper.Create(TStringList.Create);  with IList as TStringList do  begin    Add('some text');    Writeln(Text);  end;  Readln;end.There is no need to wait for the new version of FPC, it works now. ---------------------------------------------------------------------- Thaddy · 2024-12-11 18:33 @Aserge It is about avoiding TInterfacedObject and bolt on COM support to existing classes. I can't see that you have missed that... ( there is some more news.. look at the T... ) To prevent flame wars: Noobs should shut up.. for now. Do not even bother to react. ---------------------------------------------------------------------- ASerge · 2024-12-11 19:04 Quote from: Thaddy on December 11, 2024, 07:33:28 pm@Aserge It is about avoiding TInterfacedObject and bolt on COM support to existing classes. I can't see that you have missed that... ( there is some more news.. look at the T... ) I'm sorry, but I really don't understand. Why can't TInterfacedObject be used? Is this a continuation of some other topic? ---------------------------------------------------------------------- Thaddy · 2024-12-11 19:08 Because this allows no inheritance of TInterfacedObject? Is that so hard to grasp? This not a party trick, find out what happens with T... Again, noobs should not even try to answer... ---------------------------------------------------------------------- ASerge · 2024-12-11 20:15 Quote from: Thaddy on December 11, 2024, 08:08:54 pmBecause this allows no inheritance of TInterfacedObject? Is that so hard to grasp? Hard. In my example: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i constructor Create(AObj: TObject;...any object, not only inherited from TInterfacedObject. ---------------------------------------------------------------------- cdbc · 2024-12-11 21:01 Hi @ASerge: Look closer my friend... It takes a as 'specialization *and* at the same time, inherits from . This makes for the "Bolted On" aspect. Note: I jumped through some hoops, trying to get it all to work, in 'IStringList' Regards Benny ---------------------------------------------------------------------- lainz · 2024-12-11 21:29 Awesome addition. Congratulations! Finally we can have any interfaced object with easy and don't re writing code. ---------------------------------------------------------------------- PascalDragon · 2024-12-12 19:58 Quote from: ASerge on December 11, 2024, 04:18:23 pmQuote from: Thaddy on December 10, 2024, 12:52:27 pmHere is the working code that I envisioned:... But what if we do without generic, for which a lot of code will be generated for each class: As Thaddy said, the point is not to inherit from TInterfacedObject if e.g. you have some class hierarchy for which you can't simply change the ancestor (e.g. some third party code). And in that case the generic approach will keep the amount of duplicated source code small (in the binary there will still be a duplicate for each class type). ---------------------------------------------------------------------- ASerge · 2024-12-13 00:40 Quote from: PascalDragon on December 12, 2024, 08:58:19 pmAnd in that case the generic approach will keep the amount of duplicated source code small (in the binary there will still be a duplicate for each class type). I still don't understand why we need to add a hierarchy and additional code to each class. Let me rewrite my example. Unit with one(!) function: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i unit uIntfWrapper; {$mode ObjFPC}{$H+} interface function WrapByInterface(SomeObj: TObject; AOwned: Boolean = True): IInterface; implementation uses SysUtils, Classes; type  TIntfWrapper = class(TInterfacedObject, IInterface)  strict private    FObj: TObject;    FOwned: Boolean;    function QueryInterface(constref iid: TGuid; out Obj): LongInt; winapi;  public    constructor Create(AObj: TObject; AOwned: Boolean = True);    destructor Destroy; override;  end; function WrapByInterface(SomeObj: TObject; AOwned: Boolean): IInterface;begin  Result := TIntfWrapper.Create(SomeObj, AOwned);end; { TIntfWrapper } constructor TIntfWrapper.Create(AObj: TObject; AOwned: Boolean);begin  FObj := AObj;  FOwned := AOwned;end; destructor TIntfWrapper.Destroy;begin  if FOwned then    FreeAndNil(FObj);  inherited;end; function TIntfWrapper.QueryInterface(constref iid: TGuid; out Obj): LongInt; winapi;begin  if IsEqualGUID(iid, IObjectInstance) then  begin    Pointer(Obj) := FObj;    Result := S_OK;  end else    Result := inherited;end; end. and using it: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i {$MODE OBJFPC}{$APPTYPE CONSOLE} uses SysUtils, Classes, uIntfWrapper; var  IList: IInterface;begin  IList := WrapByInterface(TStringList.Create);  with IList as TStringList do  begin    Add('some text');    Writeln(Text);  end;  Readln;end.No hierarchy, no inheritance, no code duplication. One function for all cases, and you use your class as it is. ---------------------------------------------------------------------- Warfley · 2024-12-13 09:42 In this example you can convert the TIntfWrapper to the base class using the as operator. But how do you convert it back? So if you have a base object you know is wrapped into a TIntfWrapper, you can't get that wrapper. With Thaddies approach the object itself is the wrapper: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i // Convert interface to objectMyInterface as TMyClass;// Converting to interfaceTInterfaced(myInstance) as IInterface  Independently of that, what would be interesting to extend Thaddys code with a generic interface parameter. Haven't tested it, but it would be quite neat if that is possible: Code: Pascal  [Select][+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i TInterfaced = class(T,I)...So one could for example write an interface that mirrors the public signature of an existing object (like TStringList) and use this to create a TStringList derivate an interfaced version with that ---------------------------------------------------------------------- ASerge · 2024-12-13 14:05 Quote from: Warfley on December 13, 2024, 10:42:20 amBut how do you convert it back? What for? If we have an object A, then convert it to B, then why back? Just use A. ---------------------------------------------------------------------- Warfley · 2024-12-13 14:48 For example, you want to create the object, pass it to another object and get it back later. E.g. as transferral of ownership. Is not that uncommon.