RefCountObject.pas

type
  TRefCountObject = class(TObject)
  protected
    ExtraReferencesCount: Integer;  { Default 0 }
  public
    procedure Free;
    function GetReference: TRefCountObject;
  end;

procedure TRefCountObject.Free;
begin
  if Self <> nil then
    if ExtraReferencesCount > 0 then
      Dec(ExtraReferencesCount)
    else
      inherited Free;
end;

function TRefCountObject.GetReference: TRefCountObject;
begin
  Inc(ExtraReferencesCount);
  Result:=Self;
end;

// ---------- Test ----------

procedure TestCreate;
begin
  if obj = nil then
    obj:=TRefCountObject.Create
  else
    obj:=obj.GetReference;
end;

procedure testGet;
begin
  if obj <> nil then
    Caption:=IntToStr(obj.ExtraReferencesCount)
  else
    Caption:='nil';
end;

procedure TestDestroy;
begin
  if obj <> nil then
    if obj.ExtraReferencesCount > 0 then
      Obj.Free
    else
      FreeAndNil(obj);
end;