Create an interfaced TStringList

Problem/Question/Abstract:

How to create an interfaced TStringList

Answer:

unit InterfacedStrings;

interface

uses
  Classes;

type
  IudStrings = interface
    ['{3F36AFFE-8D71-4C24-AAE4-620A6D58E4D1}']
    function Strings: TStrings;
  end;

  TInterfacedStringList = class(TStringList, IudStrings)
  private
    FRefCount: Integer;
  protected
    { IudStrings }
    function Strings: TStrings;
    { IInterface }
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    procedure AfterConstruction; override;
    class function NewInstance: TObject; override;
  end;

implementation

{ TInterfacedStringList }

function TInterfacedStringList.Strings: TStrings;
begin
  Result := Self;
end;

function TInterfacedStringList._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TInterfacedStringList._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then
    Destroy;
end;

function TInterfacedStringList.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

procedure TInterfacedStringList.AfterConstruction;
begin
  inherited;
  InterlockedDecrement(FRefCount);
end;

class function TInterfacedStringList.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TInterfacedStringList(Result).FRefCount := 1;
end;

end.