长时间调用屏幕截取出错 Out of resources

[ahjoe]

截取屏幕画面保存到 Abmp 中。

function CaptureScreen4(Abmp: TBitmap): Boolean;
var
bmp: TBitmap;
adc: HDC;
begin
Result := False;
adc := GetDC(0);
if adc <> 0 then
try
bmp := TBitmap.Create();
bmp.Width := Screen.Width;
bmp.Height := Screen.Height;
Result := BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height,
adc, 0, 0, SRCCOPY);
if Result then
begin
Abmp.Width := bmp.Width;
Abmp.Height := bmp.Height;
Abmp.Canvas.Draw(0, 0, bmp);
end;
finally
bmp.Free();
ReleaseDC(0, adc);
end;
end;

大概每秒钟两次，运行2、3小时后，出错 Out of resources，怀疑是TBitmap类型造成的Device context句柄泄漏

[bdmh]

最好不要频繁的创建TBitmap，只创建一次，然后循环使用，这样试试

[ahjoe]

谢谢楼上的朋友，我也测试过，不是重复创建的问题，我用全局变量，只创建一次Bitmap，还是一样的效果。

[dd_zhouqian]

笨的办法就是屏蔽代码做测试

[dd_zhouqian]

另外你看下程序运行的时候内存大小有没有变化

[CassiaBlossom]

If a rotation or shear transformation is in effect in the source device context, BitBlt returns an error.

[CassiaBlossom]

[Quote=引用楼主 ahjoe 的回复:]
截取屏幕画面保存到 Abmp 中。

function CaptureScreen4(Abmp: TBitmap): Boolean;
var
bmp: TBitmap;
adc: HDC;
begin
Result := False;
adc := GetDC(0);
if adc <> 0 then
try
bmp := TBitmap.Cre……
[/Quote]

你修改一下你的代码看看到底是出了什么错

if Result then
begin
Abmp.Width := bmp.Width;
Abmp.Height := bmp.Height;
Abmp.Canvas.Draw(0, 0, bmp);
end else SysErrorMessage(GetLasterror);

不就知道是不是这里出问题了吗！

[ahjoe]

内存没有问题，程序占用内存不会增加。
单独写了个小程序来测试这个截屏代码，长时间运行却无问题，放到大程序中却有问题。很郁闷了。

[keeley20]

长时间运行出错 Out of resources 基本可以肯定是有地方内存没有释放，错误也未必就是在这个函数里面

[gyk120]

可以用process explorer测试一下句柄数量，看看是不是句柄泄露的问题

[ahjoe]

谢谢各位的帮助。昨晚一不小心发现了造成句柄泄漏的地方，不在这段代码，在别的地方，但是因为是调用的API，真正造成泄漏的地方不会出现异常。而在这个TBitmap代码里因为资源问题产生异常。错怪了TBitmap。