4

给出此错误的程序。有时立即，有时在短时间内

http://www1.datafilehost.com/d/39f524c0 线程在某些 try finally 块中暂停

资源：

http://www1.datafilehost.com/d/1cae7b24 EOufOfResources 调试期间

我很抱歉英语不好。我有以下问题：我尝试制作 5 fps 的屏幕截图并在其上绘制光标图标，在 PNG 中重新编码 BMP 并通过阻塞套接字 Indy 通过网络发送它。发送按比例压缩并放置在主窗体上的 TImage（桌面图像）上的屏幕截图后。如果我在计时器中执行所有这些操作 - 如果我在 Synchronize() 中执行所有这些代码，则一切正常，它也可以正常工作，但它会导致界面冻结，我想摆脱它，并做所以在线程中的 PNG 压缩中，现在我尝试打破几个 Synchronize() 来查找错误（我收到错误 EOutOfResources），但我做不到。请帮忙。这是我的代码： 

  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;
4

2 回答 2

2

首先在我的delphi 2010中我必须更换

unit CaptureUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

和

unit CaptureUnit;

interface

uses
  Windows, Messages, SysUtils, Variants,
  Classes, Graphics, Controls, Forms, Dialogs;

在 unit.pas 中也是如此

您不应该将位图分配给Picture.Assign(bmp);

procedure TCaptureThread.showthumb;
begin
    CaptureForm.DesktopImage.Picture.Assign(bmp);
end;

不久之后，我也收到错误 EOutOfResources）。

您应该将位图分配给 Picture.Bitmap.Assign(bmp);

procedure TCaptureThread.showthumb;
begin
    CaptureForm.DesktopImage.Picture.Bitmap.Assign(bmp);
end;

更改后，我让您的程序运行了 20 分钟而没有出现错误。然后我手动完成。

更新：

屏幕截图：在 Vcl 视频播放和拉伸和移动捕获区域时运行的程序。

在此处输入图像描述

希望它可以帮助你。

于 2013-05-04T01:59:18.550 回答
0

解决了这个问题。中写了代码 Synchronize()，除了PNG压缩和压缩前使用的方法Canvas.Lock，压缩后Canvas.UnLock。这可以让您避免另一个线程对Canvas. 感谢 bummi 的建议（TCanvas 不是线程保存）。正确Execute的方法在这里：

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;
于 2013-05-04T14:03:53.760 回答