请问怎样实现连续高速抓图(100分)

我用的是内存流和timer实现连续抓图！但速度并不行！
这是我的程序
var
DC: HDC;
Canvas: TCanvas;
MyBitmap: TBitmap;
aPicture : TPicture;
jpg:tjpegimage;
begin
DC := GetDC(0);
mybitmap:=tbitmap.Create;
canvas:=tcanvas.Create;
Canvas.Handle := DC;
with Screen do
begin
MyBitmap.Width := Width;
MyBitmap.Height := Height;
Application.ProcessMessages;
MyBitmap.Canvas.CopyRect(Rect(0, 0, Width, Height), Canvas,
Rect(0, 0, Width, Height));
end;
jpg:=tjpegimage.Create ;
aPicture:= TPicture.Create;
apicture.Bitmap:=mybitmap;
jpg.Assign(apicture.Bitmap);
TempStream[zuatu] := TMemoryStream.Create;
jpg.SaveToStream(TempStream[zuatu]);
ReleaseDC(0, DC);
mybitmap.free;
canvas.Free;
jpg.Free;
apicture.Free ;
zuatu:=zuatu-1;
if zuatu<1 then timer1.free;

bitmap 对象作为全局变量（反正你每次都要同样大小的图）。
去掉 processmessages 。

如果可能，jpg 处理单独使用线程，但是优先级设置成最低。

listen

什么？

你的APICTURE变量好象可以省略，直接用JPG.ASSIGN(MYBITMAP).
考虑填加一句：“jpg.JPEGNeeded;”当然要先设置好JPG的压缩参数。图质量和大小
由你自己决定。

至于“MyBitmap.Canvas.CopyRect(Rect(0, 0, Width, Height), Canvas,
Rect(0, 0, Width, Height));”此句话可用如下语句替换：
“bitblt(Mybitmap.canvas.handle,0,0,width,height,Canvas.handle,0,0,SRCCOPY);”
其实性能上不会有太大的变化。

以上建议还未检验，你可以先试试。 同意mikedeakins的观点。
BTW:你要求多高的速度?

我测试发现在win98下要比NT快些！
我发现主要慢的地方是：
TempStream[zuatu] := TMemoryStream.Create;
jpg.SaveToStream(TempStream[zuatu]);
不知道怎么解决？
在NT下明显的有延迟现象！在抓图的时候不能正常的运行！明显的感觉很慢！
不知道有人门解决吗？

一:是否考虑将TempStream[zuatu] 定义为全局变量
在程序初始化时,提前创建TempStream数组.
在使用时用TempStream[zuatu].clear替换
TempStream[zuatu] := TMemoryStream.Create;
应有所改善.
二:经查看delphi的Tjpeg帮助文件发现如下描述:
"SaveToStream expects JPEG image data and
may incur overhead of a compression cycle
if the source is a bitmap."
按我得理解是:SaveToStream函数最好提交JPEG
文件格式的数据,bitmap格式可能会引发压缩循环
之类的系统开销.

所以,如我上帖建议:考虑填加一句：
“jpg.JPEGNeeded;”当然要先设置好JPG的压缩参数。
图像质量和大小由你自己决定。

lie

你是不是想偷看别人的屏幕？

不是！我正在写一个关于图形的软件！
我用了很多种方法都不行！
我想直接读取显存！可能行，但不知怎么实现！？

直接读显存的话可能需要VXD编程.
或者你可以尝试一个TRichVW(好象是这个名字),是直接读写硬件的..

好问题，继续!!!

将DC、Canvas、MyBitmap、aPicture、jpg、TempStream都定义为全局变量，在抓图之前
统一创建，抓图结束后全部撤消，速度应该可达到5～7幅/S。
整个过程中最慢的应该是将BMP压缩为JPG，可考虑用Zlib直接压缩BMP，速度差不多而压缩
比更高且图像不失真。

能不能达到 15幅/S 以上，我才有兴趣。

如何提高传输速度才是关键！

试试！可以连续抓取！

var

Form1 : TForm1;

Fetchf : Boolean;

path : string;

Count : integer;


implementation


{$R *.DFM}


Procedure TForm1.UpdataTrackBar ;

begin

TrackBar.min := MdPlayer.StartPos;

TrackBar.max := MdPlayer.Length;

TrackBar.Position := MdPlayer.Position;

Label2.Caption := '当前位置： '

+Inttostr(MdPlayer.Position);

end;


procedure TForm1.InitShow;

begin

with Mdplayer do begin

Form1.Caption := FileName ;

Path := ExtractFilePath(FileName)+'bmp';

Count := 0;

if FileName < > '' then begin

Open;

TrackBar.Enabled := True;

UpdataTrackBar;

TrackBar.SetFocus ;

Frames := 1;

label1.Caption :='文件名: ' +

FileName + #13#10 +' 总长度: '+ Inttostr(Length);

label1.Caption :=Label1.Caption +

#13#10 +' 起始位置: '+ Inttostr(StartPos)

end else begin

Label1.Caption :='';

Label2.Caption :='';

end;

end;

end;


procedure TForm1.FormCreate(Sender: TObject);

begin

MdPlayer.FileName :='';

TrackBar.Enabled := False;

InitShow;

end;


procedure TForm1.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

mdPlayer.Close ;

end;


procedure TForm1.SpeedButton1Click(Sender: TObject);

begin

if SpeedButton1.Down then begin

Fetchf := True;

mdPlayer.Frames := updown1.Position

end

else Fetchf := False;

end;


procedure TForm1.Button1Click(Sender: TObject);

begin

MdPlayer.Close ;

TrackBar.Enabled := False;

label1.Caption := '';

label2.Caption := '';

if OpenDlg.Execute then begin

mdPlayer.FileName := OpenDlg.FileName ;

InitShow ;

end;

end;


procedure TForm1.MdPlayerClick(Sender: TObject;

Button: TMPBtnType;

var DoDefault: Boolean);

var MyBmp : TBitmap;

MyCanvas : Tcanvas;

dc : Hdc;

rect : TRect;

name

tmp : String;

begin

UpdataTrackBar;

if ((Button = btBack) or (Button = btStep))

and Fetchf then

try

myBmp := TBitMap.Create ;

MyCanvas := TCanvas.Create ;

rect := mdPlayer.DisplayRect ;


Dc := GetDc(Panel1.Handle);

myCanvas.Handle := dc;


myBmp.Width := rect.Right - rect.Left ;

myBmp.Height := rect.Bottom - rect.Top ;

myBmp.Canvas.CopyRect(rect

myCanvas

Rect);

count :=count+1;


if count< 10 then name := '000' + Inttostr(count)

else if count < 100 then name := '00'

+ Inttostr(count)

else if count< 1000 then name := '0'

+ Inttostr(count);

name := Path + name + '.bmp';

myBmp.SaveToFile(name);


finally

ReleaseDC(0

dc);

myBmp.Free;

myCanvas.Free;

end;

end;


procedure TForm1.TrackBarChange(Sender: TObject);

begin

MdPlayer.Position := TrackBar.Position ;

Label2.Caption := '当前位置： '

+Inttostr(MdPlayer.Position);

end;


end.

传输速度不一定是关键.经ZLIB压缩后每幅图像大小在15~50K之间,如在局域网内传输的话
每秒钟传递20幅根本不成问题;如果是在互联网上可考虑用增量算法,只传递相邻两幅图像
的不同之处,每幅大小在几百字节至几K字节之间.
图像压缩对速度影响是最大的.纯粹截取BMP图像并在本机显示,在PIII550+M64(32M)+128M
的机器上可达30幅/s,但一压缩,无论是jpg还是Zlib,都只能达到5~7幅/s.因此,找到一种
快速的、压缩比不是太低的压缩算法才是最重要的.

同志们，请在离线chm中用关键词“高速 GDI”搜索。

话题193564的标题是： 请教高手，如何高速检测屏幕变化！ (100分) 分类：图形图象
“通过DirectDraw检测屏幕变化的问题已经解决,效果比GDI好的多”
“用directdraw其实很简单，创建primarySurface,ddsd.ipsuface就是指向显存的Addr.”
“primarySurface指的是当前显示内存,lock后就可直接访问它”

既解决了速度问题，又可以有效的减小图像的大小（只要改变的部分，稍加压缩就可以了）。
OK？

to creation-zy：
能不能将“请教高手，如何高速检测屏幕变化！ (100分) 分类：图形图象”的原文
贴出来？我没有离线数据。谢谢先！

原文主要的内容如下，creation-zy其实已经总结的很清楚了：

kevin he
>抱歉,这几天无暇进入,用directdraw其实很简单:创建
>primarySurface,ddsd.ipsuface就是指向显存的
>Addr.

o*o
>据我所知，这个DDSURFACEDESC.ipsuface只是与你所创建的Surface
>关联的地址，而且可以是系统内存的地址。
>仍然需要自己把屏幕图象送到这个Surface。

kevin he
>to o*o,jpfree
> primarySurface指的是当前显示内存,lock后就可直接访问它,