Multithreading 来自线程的同步事件-内存泄漏

Multithreading 来自线程的同步事件-内存泄漏,multithreading,delphi,events,graphics,memory-leaks,Multithreading,Delphi,Events,Graphics,Memory Leaks,我正在试图找到来自线程的内存泄漏源。线程重复触发同步事件,返回线程保护的对象 我通过调用过程在线程内触发此事件 procedure TDeskMonThread.DoOnImage(const ID: Integer; const R: TRect; ABmp: TLockBmp); begin FSyncOnImageID:= ID; FSyncOnImageRect:= R; FSyncOnImageBmp:= ABmp; Synchronize(SYNC_OnImage

我正在试图找到来自线程的内存泄漏源。线程重复触发同步事件,返回线程保护的对象

我通过调用过程在线程内触发此事件

procedure TDeskMonThread.DoOnImage(const ID: Integer; const R: TRect;
  ABmp: TLockBmp);
begin
  FSyncOnImageID:= ID;
  FSyncOnImageRect:= R;
  FSyncOnImageBmp:= ABmp;
  Synchronize(SYNC_OnImage);
end;
3个专用字段仅用于此目的-事件触发器中使用的临时存储。TLockBmp只是TBitmap的一个包装,它有一个关键部分,需要锁定和解锁

然后,同步调用以下过程:

procedure TDeskMonThread.SYNC_OnImage;
begin
  if Assigned(FOnImage) then //trigger event
    FOnImage(FSyncOnImageID, FSyncOnImageRect, FSyncOnImageBmp);
end;
procedure TfrmMain.ThreadOnImage(const ID: Integer; const R: TRect;
  ABmp: TLockBmp);
var
  B: TBitmap;
begin
  if ID = FCurMon then begin //Only draw if it's the current monitor
    B:= ABmp.Lock;
    try
      FBmp.Assign(B); //Copy bitmap over
    finally
      ABmp.Unlock; //Hurry and unlock so thread can continue its work
    end;
    ResizeBitmap(FBmp, pbView.ClientWidth, pbView.ClientHeight, clBlack);
    pbView.Canvas.Draw(0, 0, FBmp); //Draw to canvas
  end;
end;
procedure ResizeBitmap(Bitmap: TBitmap; Width, Height: Integer; Background: TColor);
var
  R: TRect;
  B: TBitmap;
  X, Y: Integer;
begin
  if assigned(Bitmap) then begin
    B:= TBitmap.Create;
    try
      if Bitmap.Width > Bitmap.Height then begin
        R.Right:= Width;
        R.Bottom:= ((Width * Bitmap.Height) div Bitmap.Width);
        X:= 0;
        Y:= (Height div 2) - (R.Bottom div 2);
      end else begin
        R.Right:= ((Height * Bitmap.Width) div Bitmap.Height);
        R.Bottom:= Height;
        X:= (Width div 2) - (R.Right div 2);
        Y:= 0;
      end;
      R.Left:= 0;
      R.Top:= 0;
      B.PixelFormat:= Bitmap.PixelFormat;
      B.Width:= Width;
      B.Height:= Height;
      B.Canvas.Brush.Color:= Background;
      B.Canvas.FillRect(B.Canvas.ClipRect);
      B.Canvas.StretchDraw(R, Bitmap);
      Bitmap.Width:= Width;
      Bitmap.Height:= Height;
      Bitmap.Canvas.Brush.Color:= Background;
      Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
      Bitmap.Canvas.Draw(X, Y, B);
    finally
      B.Free;
    end;
  end;
end;
此事件由以下程序处理:

procedure TDeskMonThread.SYNC_OnImage;
begin
  if Assigned(FOnImage) then //trigger event
    FOnImage(FSyncOnImageID, FSyncOnImageRect, FSyncOnImageBmp);
end;
procedure TfrmMain.ThreadOnImage(const ID: Integer; const R: TRect;
  ABmp: TLockBmp);
var
  B: TBitmap;
begin
  if ID = FCurMon then begin //Only draw if it's the current monitor
    B:= ABmp.Lock;
    try
      FBmp.Assign(B); //Copy bitmap over
    finally
      ABmp.Unlock; //Hurry and unlock so thread can continue its work
    end;
    ResizeBitmap(FBmp, pbView.ClientWidth, pbView.ClientHeight, clBlack);
    pbView.Canvas.Draw(0, 0, FBmp); //Draw to canvas
  end;
end;
procedure ResizeBitmap(Bitmap: TBitmap; Width, Height: Integer; Background: TColor);
var
  R: TRect;
  B: TBitmap;
  X, Y: Integer;
begin
  if assigned(Bitmap) then begin
    B:= TBitmap.Create;
    try
      if Bitmap.Width > Bitmap.Height then begin
        R.Right:= Width;
        R.Bottom:= ((Width * Bitmap.Height) div Bitmap.Width);
        X:= 0;
        Y:= (Height div 2) - (R.Bottom div 2);
      end else begin
        R.Right:= ((Height * Bitmap.Width) div Bitmap.Height);
        R.Bottom:= Height;
        X:= (Width div 2) - (R.Right div 2);
        Y:= 0;
      end;
      R.Left:= 0;
      R.Top:= 0;
      B.PixelFormat:= Bitmap.PixelFormat;
      B.Width:= Width;
      B.Height:= Height;
      B.Canvas.Brush.Color:= Background;
      B.Canvas.FillRect(B.Canvas.ClipRect);
      B.Canvas.StretchDraw(R, Bitmap);
      Bitmap.Width:= Width;
      Bitmap.Height:= Height;
      Bitmap.Canvas.Brush.Color:= Background;
      Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
      Bitmap.Canvas.Draw(X, Y, B);
    finally
      B.Free;
    end;
  end;
end;
现在我把它缩小到ResizeBitmap,因为当我注释掉那行代码时,我没有得到内存泄漏。以下是程序:

procedure TDeskMonThread.SYNC_OnImage;
begin
  if Assigned(FOnImage) then //trigger event
    FOnImage(FSyncOnImageID, FSyncOnImageRect, FSyncOnImageBmp);
end;
procedure TfrmMain.ThreadOnImage(const ID: Integer; const R: TRect;
  ABmp: TLockBmp);
var
  B: TBitmap;
begin
  if ID = FCurMon then begin //Only draw if it's the current monitor
    B:= ABmp.Lock;
    try
      FBmp.Assign(B); //Copy bitmap over
    finally
      ABmp.Unlock; //Hurry and unlock so thread can continue its work
    end;
    ResizeBitmap(FBmp, pbView.ClientWidth, pbView.ClientHeight, clBlack);
    pbView.Canvas.Draw(0, 0, FBmp); //Draw to canvas
  end;
end;
procedure ResizeBitmap(Bitmap: TBitmap; Width, Height: Integer; Background: TColor);
var
  R: TRect;
  B: TBitmap;
  X, Y: Integer;
begin
  if assigned(Bitmap) then begin
    B:= TBitmap.Create;
    try
      if Bitmap.Width > Bitmap.Height then begin
        R.Right:= Width;
        R.Bottom:= ((Width * Bitmap.Height) div Bitmap.Width);
        X:= 0;
        Y:= (Height div 2) - (R.Bottom div 2);
      end else begin
        R.Right:= ((Height * Bitmap.Width) div Bitmap.Height);
        R.Bottom:= Height;
        X:= (Width div 2) - (R.Right div 2);
        Y:= 0;
      end;
      R.Left:= 0;
      R.Top:= 0;
      B.PixelFormat:= Bitmap.PixelFormat;
      B.Width:= Width;
      B.Height:= Height;
      B.Canvas.Brush.Color:= Background;
      B.Canvas.FillRect(B.Canvas.ClipRect);
      B.Canvas.StretchDraw(R, Bitmap);
      Bitmap.Width:= Width;
      Bitmap.Height:= Height;
      Bitmap.Canvas.Brush.Color:= Background;
      Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
      Bitmap.Canvas.Draw(X, Y, B);
    finally
      B.Free;
    end;
  end;
end;
内存泄漏消息让我感到困惑:

X3的变化取决于它运行的时间,但不是迭代的次数。例如,线程可能重复20次迭代并显示x3,或者可能重复10次迭代并显示x7,但我甚至找不到与迭代次数相比泄漏次数的模式。这似乎发生在随机时刻,而不是每次迭代

因此,我开始调试ResizeBitmap过程,但当我自己运行它时,即使是重复和快速运行,我也从未得到任何内存泄漏。这似乎与从线程中重复调用它有关。我知道它正在创建/销毁TBitmap的一个实例,这可能不是最好的做法,但是,我只在从线程重复调用它时才得到这个内存泄漏。我假设资源中有一个隐藏的异常,它实际上从未引发异常,因此被困为内存泄漏

内存泄漏可能来自哪里?如何防止这种情况发生?

EOutOfResources没有自己的构造函数,因此请尝试在各种构造函数中设置条件断点,以防异常发生,只有self.ClassType=EOutOfResources时才会触发。然后您将找到创建异常对象的点,并且您应该能够使用堆栈跟踪来了解从该点开始发生了什么

此外,如果使用FullDebugMode,泄漏检查通常会变得越来越容易。您需要从SourceForge下载FastMM4的完整版本,并在启用FullDebugMode和日志记录的情况下重建项目。然后,您将获得一个文件,其中包含有关内存泄漏的详细调试信息,而不仅仅是内存泄漏对话框,包括创建时的堆栈跟踪。

资源没有自己的构造函数,因此,请尝试在各种异常构造函数中放置条件断点,这些异常仅在self.ClassType=EOutOfResources时触发。然后您将找到创建异常对象的点,并且您应该能够使用堆栈跟踪来了解从该点开始发生了什么


此外,如果使用FullDebugMode,泄漏检查通常会变得越来越容易。您需要从SourceForge下载FastMM4的完整版本,并在启用FullDebugMode和日志记录的情况下重建项目。然后,您将获得一个文件,其中包含有关内存泄漏的详细调试信息,而不仅仅是内存泄漏对话框,包括创建时的堆栈跟踪。

请注意,解锁位图不会使线程继续执行任何工作。线程仍然必须等待Synchronize返回,直到事件处理程序完成运行,才会发生这种情况。您需要完整版本的FastMM来获取分配堆栈跟踪。或者更好的是,Mad4上的泄漏检测。@Rob True,我的意思是,它不会被锁定太久-只要我不再需要它,就解锁它,以便其他人可以访问它,因为下面两行代码可能会稍微耗时。然而,这是假设有更多的线程,而实际上没有,但是对于更多线程的未来实现,如果我打算这样做,我会确保它准备就绪。请注意,解锁位图不会让线程继续执行任何工作。线程仍然必须等待Synchronize返回,直到事件处理程序完成运行,才会发生这种情况。您需要完整版本的FastMM来获取分配堆栈跟踪。或者更好的是,Mad4上的泄漏检测。@Rob True,我的意思是,它不会被锁定太久-只要我不再需要它,就解锁它,以便其他人可以访问它,因为下面两行代码可能会稍微耗时。不过,这是假设有更多的线程,而实际上并没有,但对于更多线程的未来实现,如果我打算这样做,我会确保它已经准备好了。