Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

My Delphi Program Seems to be Leaking

Ok, so I'm pretty new to Delphi (as you'll see from my code - try not to laugh too hard and hurt yourselves), but I've managed to make a little desktop canvas color picker. It works, kinda, and that's why I'm here :D

It seems to be leaking. It starts off using about 2 MB of memory, and climbs up about 2 kB per second until it reaches about 10 MB after 10 minutes or so. On my dual core 2.7 ghz cpu, it's using anywhere from 5% to 20% cpu power, fluctuating. My computer became unresponsive after running it for about 10 minutes without stopping the timer.

You can see in the source code below that I am freeing the TBitmap (or trying to, not sure if it's doing it, doesn't seem to be working).

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;

Note: The timer is set to run every 10 ms, if that makes any difference.

ANY and all help figuring out why this is leaking and using so much resources would be greatly appreciated!

You can nab the project here if you want it (Delphi 2010): http://www.mediafire.com/file/cgltcy9c2s80f74/Color%20Picker.rar

Thanks!

like image 571
Clowerweb Avatar asked Dec 28 '22 18:12

Clowerweb


2 Answers

You never free your Canvas1 object, leaking both process heap and GDI obj. handles.

like image 57
OnTheFly Avatar answered Dec 30 '22 06:12

OnTheFly


As user said above, TCanvas instance which owns DC of desktop window never freed, not releasing DC. I found another DC leak here:

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

This not solves memory leak but explains why Windows becomes unresponsive after 20 minutes (assuming previous issue has been patched already)


Every GetDC call requires ReleaseDC counter-part. GDI objects in the fact are even more precious than memory.

like image 25
Premature Optimization Avatar answered Dec 30 '22 08:12

Premature Optimization