Question

好的，所以我对Delphi很陌生（正如你从我的代码中看到的那样 - 尽量不要笑得太厉害并且伤害自己），但我已经设法制作了一个小桌面画布颜色选择器。它有效，有点，这就是我在这里的原因：D

似乎在泄漏。它使用大约2 MB的内存开始，每秒爬升大约2 kB，直到10分钟左右达到大约10 MB。在我的双核2.7 ghz cpu上，它使用5％到20％的CPU功率，波动。在没有停止计时器的情况下运行约10分钟后，我的计算机没有响应。

您可以在下面的源代码中看到我正在释放TBitmap（或尝试，不确定它是否正在执行它，似乎没有工作）。

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  GetCursorPos(MousePos);

  try
    Canvas1 := TCanvas.Create;
    Canvas1.Handle := GetDC(0);
    Pxl  := TBitmap.Create;
    Pxl.Width  := 106;
    Pxl.Height := 106;
    W := Pxl.Width;
    H := Pxl.Height;
    T := (W div 2);
    L := (H div 2);
    Zoom := 10;
    Rect1 := Rect(MousePos.X - (W div Zoom), MousePos.Y - (H div Zoom), MousePos.X + (W div Zoom), MousePos.Y + (H div Zoom));
    Rect2 := Rect(0, 0, H, W);
    Pxl.Canvas.CopyRect(Rect2, Canvas1, Rect1);
    Pxl.Canvas.Pen.Color := clRed;
    Pxl.Canvas.MoveTo(T, 0);
    Pxl.Canvas.LineTo(L, H);
    Pxl.Canvas.MoveTo(0, T);
    Pxl.Canvas.LineTo(W, L);
    Image1.Picture.Bitmap := Pxl;
  finally
    Pxl.Free;
  end;

  try
    Pxl2 := TBitmap.Create;
    Pxl2.Width  := 1;
    Pxl2.Height := 1;
    Box1 := MousePos.X;
    Box2 := MousePos.Y;

    BitBlt(Pxl2.Canvas.Handle, 0, 0, 1, 1, GetDC(0), Box1, Box2, SRCCOPY);
    C := Pxl2.Canvas.Pixels[0, 0];
    Coord.Text := IntToStr(Box1) + ', ' + IntToStr(Box2);
    DelColor.Text := ColorToString(C);
    HexColor.Text := IntToHex(GetRValue(C), 2) + IntToHex(GetGValue(C), 2) + IntToHex(GetBValue(C), 2);
    RGB.Text := IntToStr(GetRValue(C)) + ', ' + IntToStr(GetGValue(C)) + ', ' + IntToStr(GetBValue(C));
    Panel1.Color := C;
  finally
    Pxl2.Free;
  end;
end;

procedure TForm1.OnKeyDown(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    if Timer1.Enabled then
      begin
        Timer1.Enabled := false;
        Panel2.Caption := 'Got it! Press Enter to reset.';
      end
    else
      begin
        Timer1.Enabled := true;
        Panel2.Caption := 'Press Enter to lock color.';
      end;
  end;
end;

注意：定时器设置为每10毫秒运行一次，如果这有任何不同。

任何有助于弄清楚为何泄漏并使用如此多资源的人都会非常感激！

如果需要，可以在这里抓住项目（Delphi 2010）：http://www.mediafire.com/file/cgltcy9c2s80f74/Color%20Picker.rar

谢谢！

Answer 1

你永远不会释放你的Canvas1对象，泄漏进程堆和GDI obj。处理。

Answer 2

如上所述，拥有桌面窗口DC的TCanvas实例从未释放，不释放DC。我在这里发现了另一个DC泄漏：

BitBlt(Pxl2.Canvas.Handle, 0, 0, 1, 1, GetDC(0), Box1, Box2, SRCCOPY);
                                       ^^^^^^^^

这不能解决内存泄漏问题，但可以解释为什么Windows在20分钟后无响应（假设上一个问题已经修补）

每次GetDC调用都需要 ReleaseDC反对。事实上的GDI对象甚至比记忆更珍贵。

Answer 3

好的，我找到了解决方案（最后），稍后修改了一下，然后按照这里的一些指示。没人真正击中它，但每个人都在正确的轨道上。问题是我在FUNCTION中调用GetDC() （在早期版本中也调用了计时器过程）。将它移到“try ... finally”之外，同时将其保持在函数中（如建议的那样）仍然没有产生结果，但它已经接近并且给了我实际工作的想法。所以我把它移动了一点 - 进入Form的OnCreate事件。

这是最终的代码：

function DesktopColor(const X, Y: Integer): TColor;
begin
  Color1 := TCanvas.Create;
  Color1.Handle := DC;
  Result := GetPixel(Color1.Handle, X, Y);
  Color1.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  GetCursorPos(Pos);
  Rect1 := Rect(Pos.X - (W div Zoom), Pos.Y - (H div Zoom), Pos.X + (W div Zoom), Pos.Y + (H div Zoom));
  Rect2 := Rect(0, 0, H, W);
  Pxl.Canvas.CopyRect(Rect2, Canvas1, Rect1);
  Pxl.Canvas.Pen.Color := clRed;
  Pxl.Canvas.MoveTo(T, 0);
  Pxl.Canvas.LineTo(L, H);
  Pxl.Canvas.MoveTo(0, T);
  Pxl.Canvas.LineTo(W, L);
  Image1.Picture.Bitmap := Pxl;
  Coord.Text := IntToStr(Pos.X) + ', ' + IntToStr(Pos.Y);
  C := DesktopColor(Pos.X, Pos.Y);
  DelColor.Text := ColorToString(C);
  HexColor.Text := IntToHex(GetRValue(C), 2) + IntToHex(GetGValue(C), 2) + IntToHex(GetBValue(C), 2);
  RGB.Text := IntToStr(GetRValue(C)) + ', ' + IntToStr(GetGValue(C)) + ', ' + IntToStr(GetBValue(C));
  Panel1.Color := C;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Pxl := TBitmap.Create;
  Canvas1 := TCanvas.Create;
  DC := GetDC(0);
  Pxl.Width  := 106;
  Pxl.Height := 106;
  Canvas1.Handle := DC;
  W := Pxl.Width;
  H := Pxl.Height;
  T := (W div 2);
  L := (H div 2);
  Zoom := 10;
  Timer1.Enabled := True;
end;

procedure TForm1.OnKeyDown(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    if Timer1.Enabled then
      begin
        Timer1.Enabled := false;
        Panel2.Caption := 'Got it! Press Enter to reset.';
      end
    else
      begin
        Timer1.Enabled := true;
        Panel2.Caption := 'Press Enter to lock color.';
      end;
  end;
end;

procedure TForm1.OnDestroy(Sender: TObject);
begin
  ReleaseDC(0, Canvas1.Handle);
  ReleaseDC(0, Color1.Handle);
end;

最后的计数：鼓声 CPU使用率：00％空闲，如果你足够快地移动鼠标，则会出现01％的峰值;内存使用量：~3,500 kB solid，保持不变。我甚至将定时器从10毫秒提升到5毫秒，仍然得到相同的数字。

这是包含所有上述修复的最终项目：http://www.mediafire.com/file/ebc8b4hzre7q6r5/Color%20Picker.rar

感谢所有帮助过的人，我非常感谢！我将继续为每个偶然发现这篇文章并发现它有用的人开源项目。没有许可证，无论你想做什么都可以。没有必要的信用，但如果你想留下我的名字，那就太酷了：D

Answer 4

对DesktopColor

中代码的一些评论

如果创建或GetDC失败，则不会锁定任何资源，解锁或免费将生成错误，因为您正在尝试释放不存在的资源。

规则是初始化应始终在try之前完成，否则您将不知道解构该条目是否安全。
在这种情况下，这不是一个大问题，因为GetxDC / ReleaseDC不会产生异常，如果不成功则只返回0。

其次，我建议进行测试以确保使用DC的呼叫成功。使用Delphi对象时，您不需要它，因为异常会处理这些，但Windows DC不使用异常，因此您必须自己进行测试。我建议使用断言，因为您可以在调试时启用它，并在调试程序时禁用它们。

但是因为GetxDC从不生成异常并且保持一致，所以我建议将代码更改为：

{$C+} //enable assertions for debug purposes.
//or {$C-} //Disable assertions in production code

function DesktopColor(const X, Y: Integer): TColor;
var 
  Color: TCanvas; 
  Handle: THandle;   
begin     
  Color := TCanvas.Create;
  //If the create fails GetWindowsDC will not get stored anywhere 
  //and we cannot free it. 
  Handle:= GetWindowDC(GetDesktopWindow); 
  try
    Assert(Handle <> 0);
    Color.Handle := Handle; //Will generate an exception if create failed. 
    Handle := 0;       
    Result := GetPixel(Color.Handle, X, Y);   
  finally   
    //Free the handle if it wasn't transfered to the canvas.
    if Handle <> 0 then ReleaseDC(0, Handle); 
    Color.Free;  //TCanvas.Destroy will call releaseDC on Color.handle.
                 //If the transfer was succesful 
  end; {tryf}   
end;

相同的论点适用于Timer1Timer。

警告
当您禁用断言时，Delphi将从您的项目中删除整个assert语句，因此不要将任何带副作用的代码放入断言中！

<强>链接：
断言：http://beensoft.blogspot.com/2008/02/using-assert.html

我的德尔菲计划似乎在泄漏

4 个答案: