Delphi EOutOfResources Screen Capturing - multithreading

Question

The program which is giving this error. Sometimes immediately, sometimes after a short time
http://www1.datafilehost.com/d/39f524c0 Thread Suspends in some try finally block
Source:
http://www1.datafilehost.com/d/1cae7b24 EOufOfResources During debugging
Im sorry for bad English. I have the following problem: I try to do 5 fps screenshots and draw the cursor icon on them, recode BMP in PNG and send it over the network through blocking sockets Indy. After sending a screenshot proportionally compressed and placed on TImage (desktopimage) on the main form. If I'm doing all this in a timer - that everything works fine if I am doing all of this code in Synchronize() it also works fine, but it causes freezing of the interface, I want to get rid of it, and doing so in PNG compression in the thread, now I tried to break several Synchronize() to find the error (I get an error EOutOfResources), but I could not. Please help. Here is my code:
TCaptureThread = class(TThread)
private
bmp: TBitmap;
DC: HDC;
h:hwnd;
thumbRect : TRect;
maxWidth, maxHeight:integer;
png:TPNGImage;
Stream:TMemoryStream;
RecBlock:TCommBlock;
r: TRect;
CI: TCursorInfo;
Icon: TIcon;
II: TIconInfo;
commblock:TCommblock;
procedure showthumb;
procedure send;
procedure stretch;
procedure getscreen;
procedure fixsize;
protected
procedure Execute; override;
constructor Create(CreateSuspended: Boolean);
destructor destroy; override;
end;
constructor TCaptureThread.Create(CreateSuspended: Boolean);
begin
bmp:=TBitmap.Create;
Stream:=TMemoryStream.Create;
png:=TPNGImage.Create;
Icon := TIcon.Create;
inherited Create(CreateSuspended);
end;
destructor TCaptureThread.destroy;
begin
png.Free;
bmp.Free;
Icon.Free;
stream.Free;
inherited;
end;
procedure TCaptureThread.Execute;
begin
inherited;
while not Terminated do
begin
Synchronize(fixsize);
Synchronize(getscreen);
r := bmp.Canvas.ClipRect;
try
CI.cbSize := SizeOf(CI);
if GetCursorInfo(CI) then
if CI.Flags = CURSOR_SHOWING then
begin
Icon.Handle := CopyIcon(CI.hCursor);
if GetIconInfo(Icon.Handle, II) then
begin
bmp.Canvas.Draw(
ci.ptScreenPos.x - Integer(II.xHotspot) - r.Left - Form4.Left,
ci.ptScreenPos.y - Integer(II.yHotspot) - r.Top - Form4.Top,
Icon
);
end;
end;
finally
end;
try
png.Assign(bmp);
png.CompressionLevel := 9;
png.SaveToStream(stream);
stream.Position :=0;
Recblock.Command :='STREAM';
Recblock.Msg :='';
Recblock.NameFrom := MyName;
Synchronize(send);
finally
end;
try
thumbRect.Left := 0;
thumbRect.Top := 0;
if bmp.Width > bmp.Height then
begin
thumbRect.Right := maxWidth;
thumbRect.Bottom := (maxWidth * bmp.Height) div bmp.Width;
end
else
begin
thumbRect.Bottom := maxHeight;
thumbRect.Right := (maxHeight * bmp.Width) div bmp.Height;
end;
Synchronize(stretch);
bmp.Width := thumbRect.Right;
bmp.Height := thumbRect.Bottom;
Synchronize(showthumb);
finally
end;
sleep(200);
end;
end;
procedure TCaptureThread.getscreen;
begin
DC:=GetDC(0);
bitblt(bmp.Canvas.Handle, 0, 0, Form4.Width+Form4.Left, Form4.Height+Form4.Top,
DC, Form4.Left, Form4.Top, SRCCOPY);
ReleaseDC(0, DC);
end;
procedure TCaptureThread.fixsize;
begin
maxWidth := Form1.DesktopImage.Width;
maxHeight := Form1.DesktopImage.Height;
bmp.Height:=Form4.Height;
bmp.Width:=Form4.Width;
end;
procedure TCaptureThread.send;
begin
Form1.Streamclient.IOHandler.Write(RawToBytes(Recblock,sizeof(recblock)),sizeof(recblock));
Form1.Streamclient.IOHandler.Write(stream,stream.Size,true);
end;
procedure TCaptureThread.showthumb;
begin
Form1.DesktopImage.Picture.Assign(bmp);
end;
procedure TCaptureThread.stretch;
begin
SetStretchBltMode(bmp.Canvas.Handle, HALFTONE);
StretchBlt(bmp.Canvas.Handle,0,0,thumbRect.Right,thumbRect.Bottom,bmp.Canvas.Handle,0,0,bmp.Width,bmp.Height,SRCCOPY);
end;

Answer 1

First in my delphi 2010 i must replace
unit CaptureUnit;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
with
unit CaptureUnit;
interface
uses
Windows, Messages, SysUtils, Variants,
Classes, Graphics, Controls, Forms, Dialogs;
The same also in unit.pas
You should not assign a Bitmap to Picture.Assign(bmp);
procedure TCaptureThread.showthumb;
begin
CaptureForm.DesktopImage.Picture.Assign(bmp);
end;
After a short time I get also an error EOutOfResources).
You should assign a Bitmap to Picture.Bitmap.Assign(bmp);
procedure TCaptureThread.showthumb;
begin
CaptureForm.DesktopImage.Picture.Bitmap.Assign(bmp);
end;
after I changed it, I got your program run for 20 minutes without getting an error. Then I finished it manually.
Update:
Screenshot : program running while Vcl Video playing and stretching and moving the Capture Area.
Hope it helps you.

Answer 2

Solved the problem. Wrote the code in Synchronize(), except PNG compression and before compression used method Canvas.Lock, after compression Canvas.UnLock. This allows you to avoid the influence of the another thread to Canvas. Thanks for bummi's advice(TCanvas is not threadsave). Correctly Execute method is here:
procedure TCaptureThread.Execute;
begin
inherited;
while not Terminated do
begin
Synchronize(size);
Synchronize(getscreen);
Synchronize(drawcursor);
try
png.Canvas.Lock;
bmp.Canvas.Lock;
png.Assign(bmp);
png.CompressionLevel := 9;
png.Canvas.Unlock;
bmp.Canvas.Unlock;
finally
end;
try
Synchronize(stretch);
Synchronize(showthumb);
finally
end;
sleep(200);
end;
end;