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!
You never free your Canvas1 object, leaking both process heap and GDI obj. handles.
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.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With