Forum > General
Adding interfaces to any class (tnx Warfley!)
Thaddy:
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---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<T:class,constructor> = 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<T>.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<T>._AddRef : longint;winapi; begin _addref:=InterlockedIncrement(frefcount); end; function TInterfaced<T>._Release : longint;winapi; begin Result := InterlockedDecrement(frefcount); if Result = 0 then Destroy; end; destructor TInterfaced<T>.Destroy; begin FRefCount:=0; FDestroyCount:=0; inherited Destroy; end; procedure TInterfaced<T>.AfterConstruction; begin InterlockedDecrement(frefcount); end; procedure TInterfaced<T>.BeforeDestruction; begin if frefcount <> 0 then halt(204); end; class function TInterfaced<T>.NewInstance : TObject; begin result:= inherited NewInstance; TInterfaced<T>(result).frefcount := 1; end; type TInterfacedStringlist = TInterfaced<TStringlist>; 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:
Hi
Nifty \o/ Me Likey 8-)
...ahumm, the curly bracket in this:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---class(}T,IInterfaced)is just a typo, right?!?
Regards Benny
Thaddy:
Actually a pasto, not a typo. Corrected.
What Frederic implemented has, much, much more possibilities, though.
Not only this.
Because with a class restriction <T:class> now all methods and members of TObject are available instead or the previous dummy.
This is quite an important change.
cdbc:
Hi Thaddy
Yup, that /little/ difference is actually *all-important*... As I said: Nifty \o/
Regards Benny
Thaddy:
what I find is:
Cosy here, nice and calm...
Few can see it.
Navigation
[0] Message Index
[#] Next page