Create an interfaced TStringList (Views: 28)
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. |