在网上找了个 Delphi 的远程桌面代码,但是 跑着跑着,发送图片的线程就异常退出了... 调试了一下,发现貌似是 线程中操作 TBitmap 的缘故 ,想请教下是为什么??如下是我的测试代码,已经弄得比较简单了:主界面Form1中的代码:procedure TForm1.Button1Click(Sender: TObject);
var bmp:TBitMap;
DC:HDC;
ms:TMemoryStream;
i:integer;
begin
ms:=TMemoryStream.Create;
DC := GetDC(0);
bmp:=TBitMap.Create;
bmp.Width := 64;
bmp.Height := 64;
bmp.PixelFormat:= pf8bit; for i:=0 to 10000 do
begin
BitBlt(bmp.Canvas.Handle, 0, 0, 64, 64, DC, 0, 0, SRCCOPY);
ms.Clear;
bmp.SaveToStream(ms);
end;
Memo1.Lines.Add(inttostr(ms.Size)); ReleaseDC(0, DC);
ms.Free;
bmp.Free;
end;procedure TForm1.Button2Click(Sender: TObject);
var TestThread:TTestThread;
begin
TestThread:=TTestThread.Create(false);
end;线程中代码:procedure TTestThread.Execute;
var bmp:TBitmap;
DC:HDC;
ms:TMemoryStream;
i:integer;
begin
ms:=TMemoryStream.Create;
DC := GetDC(0);
bmp:=TBitmap.Create;
bmp.Width := 64;
bmp.Height := 64;
bmp.PixelFormat:= pf8bit; for i:=0 to 10000 do
begin
try
Bmp.Canvas.Lock;
BitBlt(bmp.Canvas.Handle, 0, 0, 64, 64, DC, i, i, SRCCOPY);
Bmp.Canvas.UnLock;
ms.Clear;
bmp.SaveToStream(ms);
Form1.Memo1.Lines.Add(inttostr(i)+' - '+inttostr(ms.Size));
except on E:Exception do
Form1.Memo1.Lines.Add(E.Message);
end;
end; ReleaseDC(0, DC);
ms.Free;
bmp.Free; Form1.Memo1.Lines.Add('Thread Over');
end;点击 Button1 ,运行一切正常。点击 Button2 ,for 中跑着跑着就会 报错:“Out of system resources”,加了Bmp.Canvas.Lock;和Bmp.Canvas.UnLock; 也一样,for 中次数多了 就报错了...请问如何解决??
var bmp:TBitMap;
DC:HDC;
ms:TMemoryStream;
i:integer;
begin
ms:=TMemoryStream.Create;
DC := GetDC(0);
bmp:=TBitMap.Create;
bmp.Width := 64;
bmp.Height := 64;
bmp.PixelFormat:= pf8bit; for i:=0 to 10000 do
begin
BitBlt(bmp.Canvas.Handle, 0, 0, 64, 64, DC, 0, 0, SRCCOPY);
ms.Clear;
bmp.SaveToStream(ms);
end;
Memo1.Lines.Add(inttostr(ms.Size)); ReleaseDC(0, DC);
ms.Free;
bmp.Free;
end;procedure TForm1.Button2Click(Sender: TObject);
var TestThread:TTestThread;
begin
TestThread:=TTestThread.Create(false);
end;线程中代码:procedure TTestThread.Execute;
var bmp:TBitmap;
DC:HDC;
ms:TMemoryStream;
i:integer;
begin
ms:=TMemoryStream.Create;
DC := GetDC(0);
bmp:=TBitmap.Create;
bmp.Width := 64;
bmp.Height := 64;
bmp.PixelFormat:= pf8bit; for i:=0 to 10000 do
begin
try
Bmp.Canvas.Lock;
BitBlt(bmp.Canvas.Handle, 0, 0, 64, 64, DC, i, i, SRCCOPY);
Bmp.Canvas.UnLock;
ms.Clear;
bmp.SaveToStream(ms);
Form1.Memo1.Lines.Add(inttostr(i)+' - '+inttostr(ms.Size));
except on E:Exception do
Form1.Memo1.Lines.Add(E.Message);
end;
end; ReleaseDC(0, DC);
ms.Free;
bmp.Free; Form1.Memo1.Lines.Add('Thread Over');
end;点击 Button1 ,运行一切正常。点击 Button2 ,for 中跑着跑着就会 报错:“Out of system resources”,加了Bmp.Canvas.Lock;和Bmp.Canvas.UnLock; 也一样,for 中次数多了 就报错了...请问如何解决??
解决方案 »
- 有人对delphi和flash采用ExternalInterface交互熟悉么?
- dbgrideh 急急急急积极
- 请指教,如何查找一个目录下面所有的文件夹(包括字子文件夹下的文件夹)并在其他位置创建这些文件夹!谢谢
- 学习其它语言之随笔感慨
- 请问这个record的句子是什么意思?没见过这样子写的。谢谢
- Delphi如何用ADOconnection+Ini动态连接SQL Server2000数据库
- 请教高手!关于组件问题,谢谢!!
- 为什么我使用Find declaration找不到我在其他UNIT文件中的变量定义呢?
- Delphi2010都出来了,还有人用Delphi7吗?
- 有挑战性的sql语句
- OLE访问Excel,提示错误“Variant does reference to an automation object”
- Delphi
为什么 我这句 “Form1.Memo1.Lines.Add(inttostr(i)+' - '+inttostr(ms.Size));”打印出来的结果,bmp并没有增加??
点击 Button2 后,Memo出现:0 - 5174
1 - 5174
2 - 5174
3 - 5174
4 - 5174
5 - 5174
6 - 5174
7 - 5174
8 - 5174
9 - 5174
..........
995 - 5174
996 - 5174
997 - 5174
998 - 5174
999 - 5174
1000 - 5174
Out of system resources
Out of system resources
Out of system resources
Out of system resources
Out of system resources
Out of system resources
Out of system resources
.......
Out of system resources
Out of system resources
Thread Over
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,jpeg,StdCtrls, ExtCtrls; //截取屏幕时要用到jpeg对象保存图像数据type
TForm1 = class(TForm)
Image1: TImage;
procedure Image1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;
jpegscreen:Tjpegimage;implementation{$R *.dfm}
procedure ScreenCap(LeftPos,TopPos,RightPos,BottomPos:integer);
var
bmpscreen:Tbitmap;
FullscreenCanvas:TCanvas;
dc:HDC;
sourceRect, destRect: TRect;
begin
dc:=getdc(0);
fullscreencanvas:=Tcanvas.Create;
fullscreencanvas.Handle:=dc;
bmpscreen:=Tbitmap.create;
bmpscreen.Width :=screen.Width ;
bmpscreen.Height :=screen.Height ;
sourcerect:=rect(0,0,screen.Width ,screen.Height );
destrect:= rect(0,0,screen.Width ,screen.Height);
bmpscreen.Canvas.CopyRect(sourcerect,fullscreenCanvas,destrect); //使用copyrect方法把屏幕canvas中的数据复制到jpeg中
jpegscreen:=Tjpegimage.Create;
jpegscreen.Assign (bmpscreen);
jpegscreen.CompressionQuality:=40;
FullscreenCanvas.Free;
bmpscreen.Free;
ReleaseDC(0, DC);
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
ScreenCap(0,0,screen.width,screen.height);
image1.Picture.Bitmap.Assign(jpegscreen);
jpegscreen.Free ;
end;end.
你可以看看任务管理器 你的程序内容使用肯定特别高
你最好把PixelFormat设置到最低 这样可能会好些
我原来也发过类似的帖子
var bmp:TBitmap;
DC:HDC;
ms:TMemoryStream;
i:integer; fullscreencanvas:Tcanvas;
sourceRect, destRect: TRect;
begin
ms:=TMemoryStream.Create;
DC := GetDC(0);
bmp:=TBitmap.Create;
bmp.Width := 64;
bmp.Height := 64;
bmp.PixelFormat:= pf8bit; fullscreencanvas:=Tcanvas.Create;
fullscreencanvas.Handle:=DC;
sourcerect:=rect(0,0,64 ,64 );
destrect:= rect(0,0,64 ,64); for i:=0 to 10000 do
begin
try
Bmp.Canvas.Lock;
Bmp.Canvas.CopyRect(sourcerect,fullscreenCanvas,destrect); // 这里 修改了
// BitBlt(bmp.Canvas.Handle, 0, 0, 64, 64, DC, i, i, SRCCOPY);
Bmp.Canvas.UnLock;
ms.Clear;
bmp.SaveToStream(ms);
Form1.Memo1.Lines.Add(inttostr(i)+' - '+inttostr(ms.Size));
except on E:Exception do
Form1.Memo1.Lines.Add(E.Message);
end;
end; ReleaseDC(0, DC);
ms.Free;
bmp.Free; fullscreencanvas.Free; Form1.Memo1.Lines.Add('Thread Over');
end;
一样的错误啊...
按照樓上修正下PixelForma呢
try
BitMap1.LoadFromFile('c:\Program Files\common Files\Borland Shared\Images\Splash\256color\factory.bmp');
BitMap2.Assign(BitMap1); // Copy BitMap1 into BitMap2
BitMap2.Dormant; // Free up GDI resources
BitMap2.FreeImage; // Free up Memory.
Canvas.Draw(20,20,BitMap2); // Note that previous calls don't lose the image BitMap2.Monochrome := true;
Canvas.Draw(80,80,BitMap2);
BitMap2.ReleaseHandle; // This will actually lose the bitmap;
finally
BitMap1.Free;
BitMap2.Free;
end;摘抄自帮助.
我那个程序里跟画东西比较多 所以我的是2000个就崩溃了
Form1.Memo1.Lines.Add(inttostr(i)+' - '+inttostr(ms.Size));
應放在一個過程中操作,然後用synchronize調用。如:
procedure ProName;
begin
Form1.Memo1.Lines.Add(inttostr(i)+' - '+inttostr(ms.Size));
end;
在線程中按如下調用:
synchronize(ProName);
//我的程序处理
begin
pBit.Dormant;
pBit.FreeImage;
JPEGMap := TJPEGImage.create;
JPEGMap.Assign(pBit);
end;这是我那个程序处理的我最后是把PixelFormat 设置的低一些,
然后用TJPEGImage来保存BitMap的内容,就基本上避免了崩溃的事
不过还是不能太多,因为毕竟内存有限
Bmp.Canvas.UnLock;
调个位置
03年的时候在大富翁论坛上有讨论的。