Delphi TThread内存泄漏中的奇怪BitBlt

我有一个简单的程序，它每秒拍摄几次屏幕截图。我创建了一个简单的代码，它可以做到这一点，我可以运行它，我想很多次，它的工作正常。但是当我将相同的代码放入一个线程并运行它时，内存使用量开始上升，直到应用程序耗尽资源（大约10秒钟），然后线程当然会卡住

为了进行测试，我有一个带有两个按钮的表单。一个运行上述代码，另一个启动一个运行相同代码的线程。我甚至可以按住第一个按钮上的Enter键，并且没有内存泄漏，但当我单击第二个按钮时，线程会立即增加内存使用量（我甚至可以使用stop_thread变量停止它，但内存使用量仍然很高）

我知道问题与BitBlt行有关，因为没有它就不会有内存泄漏。但我不明白发生了什么和为什么。以及为什么在代码从主线程运行时不会发生这种情况。即使我将Button1代码放入一个循环，并从主线程无休止地运行它，内存使用率仍然很低。有什么区别

---

谢谢你的建议

Delphi的

TCanvas

不是线程安全的（）。如果我是你，我会用原始的Win32 API调用来实现这一点。谢谢你，我认为这解决了这个问题。当我在同步过程中运行代码的BitBlt部分（GetWindowDC、BitBlt、ReleaseDC）时，内存泄漏消失了。但我仍然不确定发生了什么。同步调用违背了线程的目的？所以你需要按照David的建议去做……你试过锁定画布了吗？@jano152:因为主UI线程会定期破坏

HDC

打开的

TCanvas

句柄，这些对象没有被积极使用。使用

TCanvas.Lock（）。如果我是你，我会用原始的Win32 API调用来实现这一点。谢谢你，我认为这解决了这个问题。当我在同步过程中运行代码的BitBlt部分（GetWindowDC、BitBlt、ReleaseDC）时，内存泄漏消失了。但我仍然不确定发生了什么。同步调用违背了线程的目的？所以你需要按照David的建议去做……你试过锁定画布了吗？@jano152:因为主UI线程会定期破坏
HDC
打开的
TCanvas
句柄，这些对象没有被积极使用。使用
TCanvas.Lock（）。
...

type
  TMyThread = class(TThread)
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

var
  Form1: TForm1;
  stop_thread: Boolean;
  my_thread: TMyThread;

...

constructor TMyThread.Create();
begin
  inherited Create(true);
  FreeOnTerminate:=true;
  Suspended:=true;
end;

destructor TMyThread.Destroy;
begin
  inherited;
end;

procedure TMyThread.Execute;
var screen_bmp: TBitmap;
    desktop_hdc: HDC;
begin
  while(stop_thread=false)do
  begin
    screen_bmp:=TBitmap.Create;
    screen_bmp.PixelFormat:=pf32bit;
    screen_bmp.Height:=Screen.Height;
    screen_bmp.Width:=Screen.Width;
    desktop_hdc:=GetWindowDC(GetDesktopWindow);
    BitBlt(screen_bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, desktop_hdc, 0, 0, SRCCOPY);
    ReleaseDC(GetDesktopWindow, desktop_hdc);
    screen_bmp.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var screen_bmp: TBitmap;
    desktop_hdc: HDC;
begin
  screen_bmp:=TBitmap.Create;
  screen_bmp.PixelFormat:=pf32bit;
  screen_bmp.Height:=Screen.Height;
  screen_bmp.Width:=Screen.Width;
  desktop_hdc:=GetWindowDC(GetDesktopWindow);
  BitBlt(screen_bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, desktop_hdc, 0, 0, SRCCOPY);
  ReleaseDC(GetDesktopWindow, desktop_hdc);
  screen_bmp.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  stop_thread:=false;
  Button2.Enabled:=false;
  my_thread:=TMyThread.Create;
  my_thread.Resume;
end;