diff --git a/components/lazutils/lazclasses.pas b/components/lazutils/lazclasses.pas
index 26f8354b38..45727ddec9 100644
--- a/components/lazutils/lazclasses.pas
+++ b/components/lazutils/lazclasses.pas
@@ -26,14 +26,20 @@ type
   TRefCountedObject = class(TFreeNotifyingObject)
   private
     FRefCount: Integer;
+    {$IFDEF WITH_REFCOUNT_DEBUG}
+    FDebugList: TStringList;
+    FInDestroy: Boolean;
+    {$ENDIF}
   protected
     procedure DoFree; virtual;
+    procedure DoReferenceAdded; virtual;
+    procedure DoReferenceReleased; virtual;
     property  RefCount: Integer read FRefCount;
   public
     constructor Create;
     destructor  Destroy; override;
-    procedure AddReference;
-    procedure ReleaseReference;
+    procedure AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr: Pointer = nil; DebugIdTxt: String = ''){$ENDIF};
+    procedure ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr: Pointer = nil; DebugIdTxt: String = ''){$ENDIF};
   end;
 
   { TRefCntObjList }
@@ -47,6 +53,9 @@ type
 procedure ReleaseRefAndNil(var ARefCountedObject);
 
 implementation
+{$IFDEF WITH_REFCOUNT_DEBUG}
+uses LazLoggerBase;
+{$ENDIF}
 
 { TFreeNotifyingObject }
 
@@ -75,33 +84,97 @@ end;
 
 { TRefCountedObject }
 
-procedure TRefCountedObject.AddReference;
+procedure TRefCountedObject.AddReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr: Pointer = nil; DebugIdTxt: String = ''){$ENDIF};
+{$IFDEF WITH_REFCOUNT_DEBUG}
+var
+  s: String;
+{$ENDIF}
 begin
+  {$IFDEF WITH_REFCOUNT_DEBUG}
+  if FDebugList = nil then FDebugList := TStringList.Create;
+  if (DebugIdAdr <> nil) or (DebugIdTxt <> '') then
+    s := inttostr(PtrUInt(DebugIdAdr))+': '+DebugIdTxt
+  else
+    s := 'not named';
+  if FDebugList.indexOf(s) < 0 then
+    FDebugList.AddObject(s, TObject(1))
+  else begin
+    if s <> 'not named' then
+      debugln(['TRefCountedObject.AddReference Duplicate ref ', s]);
+    FDebugList.Objects[FDebugList.IndexOf(s)] :=
+      TObject(PtrUint(FDebugList.Objects[FDebugList.IndexOf(s)])+1);
+  end;
+  {$ENDIF}
   Inc(FRefcount);
+  // call only if overridden
+  If TMethod(@DoReferenceAdded).Code <> Pointer(@TRefCountedObject.DoReferenceAdded) then
+    DoReferenceAdded;
 end;
 
 procedure TRefCountedObject.DoFree;
 begin
+  {$IFDEF WITH_REFCOUNT_DEBUG}
+  Assert(not FInDestroy, 'TRefCountedObject.DoFree: Double destroy');
+  FInDestroy := True;
+  {$ENDIF}
   Self.Free;
 end;
 
+procedure TRefCountedObject.DoReferenceAdded;
+begin
+  //
+end;
+
+procedure TRefCountedObject.DoReferenceReleased;
+begin
+  //
+end;
+
 constructor TRefCountedObject.Create;
 begin
   FRefCount := 0;
+  {$IFDEF WITH_REFCOUNT_DEBUG}
+  if FDebugList = nil then
+    FDebugList := TStringList.Create;
+  {$ENDIF}
   inherited;
 end;
 
 destructor TRefCountedObject.Destroy;
 begin
+  {$IFDEF WITH_REFCOUNT_DEBUG}
+  FDebugList.Free;
+  {$ENDIF}
   Assert(FRefcount = 0, 'Destroying referenced object');
   inherited;
 end;
 
-procedure TRefCountedObject.ReleaseReference;
+procedure TRefCountedObject.ReleaseReference{$IFDEF WITH_REFCOUNT_DEBUG}(DebugIdAdr: Pointer = nil; DebugIdTxt: String = ''){$ENDIF};
+{$IFDEF WITH_REFCOUNT_DEBUG}
+var
+  s: String;
+{$ENDIF}
 begin
   if Self = nil then exit;
+  {$IFDEF WITH_REFCOUNT_DEBUG}
+  if FDebugList = nil then FDebugList := TStringList.Create;
+  if (DebugIdAdr <> nil) or (DebugIdTxt <> '') then
+    s := inttostr(PtrUInt(DebugIdAdr))+': '+DebugIdTxt
+  else
+    s := 'not named';
+  assert(FDebugList.indexOf(s) >= 0, 'Has reference (entry) for '+s);
+  assert(PtrUint(FDebugList.Objects[FDebugList.IndexOf(s)]) > 0, 'Has reference (> 0) for '+s);
+  if PtrUint(FDebugList.Objects[FDebugList.IndexOf(s)]) = 1 then
+    FDebugList.Delete(FDebugList.IndexOf(s))
+  else
+    FDebugList.Objects[FDebugList.IndexOf(s)] :=
+      TObject(PtrInt(FDebugList.Objects[FDebugList.IndexOf(s)])-1);
+  {$ENDIF}
   Assert(FRefCount > 0, 'TRefCountedObject.ReleaseReference  RefCount > 0');
   Dec(FRefCount);
+  // call only if overridden
+  If TMethod(@DoReferenceReleased).Code <> Pointer(@TRefCountedObject.DoReferenceReleased) then
+    DoReferenceReleased;
   if FRefCount = 0 then DoFree;
 end;
 
@@ -130,5 +203,5 @@ begin
   Pointer(ARefCountedObject) := nil;
 end;
 
-end.
+end .