我的Delphi程序似乎泄漏(My Delphi Program Seems to be Leaking)

我的Delphi程序似乎泄漏(My Delphi Program Seems to be Leaking)

好的，所以我对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

谢谢！

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!

最满意答案

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

Ok, I found the solution (finally) after tinkering around with it a bit and following a few of the pointers on here. No one really hit it right on the head, but everyone was on the right track. The problem was that I was calling GetDC() inside the FUNCTION (and in earlier versions the timer procedure as well). Moving it outside of "try ... finally" while keeping it in the function (as suggested) still didn't yield results, but it was getting close and gave me the idea that actually worked. So I moved it a bit further away - into the Form's OnCreate event.

Here's the final code:

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;

And the final tally: drumroll CPU usage: 00% idle, 01% spikes if you move the mouse fast enough; Memory usage: ~3,500 kB solid, remaining unchanged. I even bumped the timer up from 10 ms to 5 ms and still get the same numbers.

Here's the final project with all the aforementioned fixes: http://www.mediafire.com/file/ebc8b4hzre7q6r5/Color%20Picker.rar

Thanks to everyone who helped, I greatly do appreciate it! I'm going to go ahead and open source the project for everyone who stumbles across this post and finds it useful. No license, do with it whatever you will. No credit necessary, but if you want to leave my name in there, that would be cool :D