150分求“每秒抓超过7次的整屏图像到文件中(仅800*600*16M色就可以了)”(50分)

我只向知道截dx程序的显示画面。哪位大侠能帮帮忙吗？谢了！

向xWings同志学习！

提前！

参考一下CSDN中的
谈Delphi编程中“流”的应用
五、实际应用之四：利用流实现网络传输屏幕图像

大家应该见过很多网管程序，这类程序其中有一个功能就是监控远程电脑的屏幕。实际上，这也是利用流操作来实现的。下面我们给出一个例子，这个例子分两个程序，一个服务端，一个是客户端。程序编译后可以直接在单机、局部网或者互联网上使用。程序中已经给出相应注释。后面我们再来作具体分析。
新建一个工程，在Internet面版上拖一个ServerSocket控件到窗口，该控件主要用于监听客户端，用来与客户端建立连接和通讯。设置好监听端口后调用方法Open或者Active:=True即开始工作。注意：跟前面的NMUDP不同，当Socket开始监听后就不能再改变它的端口，要改变的话必须先调用Close或设置Active为False，否则将会产生异常。另外，如果该端口已经打开的话，就不能再用这个端口了。所以程序运行尚未退出就不能再运行这个程序，否则也会产生异常，即弹出出错窗口。实际应用中可以通过判断程序是否已经运行，如果已经运行就退出的方法来避免出错。
当客户端有数据传入，将触发ServerSocket1ClientRead事件，我们可以在这里对接收的数据进行处理。在本程序中，主要是接收客户端发送过来的字符信息并根据事先的约定来进行相应操作。
程序全部代码如下：

unit Unit1;{服务端程序}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, JPEG,ExtCtrls, ScktComp;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
procedure ServerSocket1ClientRead(Sender: TObject;Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
procedure Cjt_GetScreen(var Mybmp: TBitmap;
DrawCur: Boolean);
{自定义抓屏函数,DrawCur表示抓鼠标图像与否}
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
MyStream: TMemorystream;{内存流对象}
implementation
{$R *.DFM}
procedure TForm1.Cjt_GetScreen(var Mybmp: TBitmap;
DrawCur: Boolean);
var
Cursorx, Cursory: integer;
dc: hdc;
Mycan: Tcanvas;
R: TRect;
DrawPos: TPoint;
MyCursor: TIcon;
hld: hwnd;
Threadld: dword;
mp: tpoint;
pIconInfo: TIconInfo;
begin

Mybmp := Tbitmap.Create;
{建立BMPMAP }
Mycan := TCanvas.Create;
{屏幕截取}
dc := GetWindowDC(0);
try
Mycan.Handle := dc;
R := Rect(0, 0, screen.Width, screen.Height);
Mybmp.Width := R.Right;
Mybmp.Height := R.Bottom;
Mybmp.Canvas.CopyRect(R, Mycan, R);
finally
releaseDC(0, DC);
end;

Mycan.Handle := 0;
Mycan.Free;
if DrawCur then
{画上鼠标图象}
begin

GetCursorPos(DrawPos);
MyCursor := TIcon.Create;
getcursorpos(mp);
hld := WindowFromPoint(mp);
Threadld := GetWindowThreadProcessId(hld, nil);
AttachThreadInput(GetCurrentThreadId, Threadld, True);
MyCursor.Handle := Getcursor();
AttachThreadInput(GetCurrentThreadId, threadld, False);
GetIconInfo(Mycursor.Handle, pIconInfo);
cursorx := DrawPos.x - round(pIconInfo.xHotspot);
cursory := DrawPos.y - round(pIconInfo.yHotspot);
Mybmp.Canvas.Draw(cursorx, cursory, MyCursor);
{画上鼠标}
DeleteObject(pIconInfo.hbmColor);{GetIconInfo 使用时创建了两个bitmap对象. 需要手工释放这两个对象}
DeleteObject(pIconInfo.hbmMask);{否则,调用他后,他会创建一个bitmap,多次调用会产生多个,直至资源耗尽}
Mycursor.ReleaseHandle;
{释放数组内存}
MyCursor.Free;
{释放鼠标指针}
end;


end;

procedure TForm1.FormCreate(Sender: TObject);
begin

ServerSocket1.Port := 3000;
{端口}
ServerSocket1.Open;
{Socket开始侦听}
end;

procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin

if ServerSocket1.Active then
ServerSocket1.Close;
{关闭Socket}
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
S, S1: string;
MyBmp: TBitmap;
Myjpg: TJpegimage;
begin

S := Socket.ReceiveText;
if S = 'cap' then
{客户端发出抓屏幕指令}
begin

try
MyStream := TMemorystream.Create;{建立内存流}
MyBmp := TBitmap.Create;
Myjpg := TJpegimage.Create;
Cjt_GetScreen(MyBmp, True);
{True表示抓鼠标图像}
Myjpg.Assign(MyBmp);
{将BMP图象转成JPG格式,便于在互联网上传输}
Myjpg.CompressionQuality := 10;
{JPG文件压缩百分比设置,数字越大图像越清晰,但数据也越大}
Myjpg.SaveToStream(MyStream);
{将JPG图象写入流中}
Myjpg.free;
MyStream.Position := 0;{注意:必须添加此句}
s1 := inttostr(MyStream.size);{流的大小}
Socket.sendtext(s1);
{发送流大小}
finally
MyBmp.free;
end;

end;

if s = 'ready' then
{客户端已准备好接收图象}
begin

MyStream.Position := 0;
Socket.SendStream(MyStream);
{将流发送出去}
end;

end;

end.


上面是服务端，下面我们来写客户端程序。新建一个工程，添加Socket控件ClientSocket、图像显示控件Image、一个 Panel 、一个Edit、两个 Button和一个状态栏控件StatusBar1。注意：把Edit1和两个 Button放在Panel1上面。ClientSocket的属性跟ServerSocket差不多，不过多了一个Address属性，表示要连接的服务端IP地址。填上IP地址后点“连接”将与服务端程序建立连接，如果成功就可以进行通讯了。点击“抓屏”将发送字符给服务端。因为程序用到了JPEG图像单元，所以要在Uses中添加Jpeg.
全部代码如下：
unit Unit2{客户端};
interface
uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls,ScktComp,ExtCtrls,Jpeg, ComCtrls;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Image1: TImage;
StatusBar1: TStatusBar;
Panel1: TPanel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
procedure ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
MySize: Longint;
MyStream: TMemorystream;{内存流对象}
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin

{-------- 下面为设置窗口控件的外观属性 ------------- }
{注意:把Button1、Button2和Edit1放在Panel1上面}
Edit1.Text := '127.0.0.1';
Button1.Caption := '连接主机';
Button2.Caption := '抓屏幕';
Button2.Enabled := false;
Panel1.Align := alTop;
Image1.Align := alClient;
Image1.Stretch := True;
StatusBar1.Align:=alBottom;
StatusBar1.SimplePanel := True;
{----------------------------------------------- }
MyStream := TMemorystream.Create;
{建立内存流对象}
MySize := 0;
{初始化}
end;

procedure TForm1.Button1Click(Sender: TObject);
begin

if not ClientSocket1.Active then

begin

ClientSocket1.Address := Edit1.Text;
{远程IP地址}
ClientSocket1.Port := 3000;
{Socket端口}
ClientSocket1.Open;
{建立连接}
end;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin

Clientsocket1.Socket.SendText('cap');
{发送指令通知服务端抓取屏幕图象}
Button2.Enabled := False;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin

StatusBar1.SimpleText := '与主机' + ClientSocket1.Address + '成功建立连接!';
Button2.Enabled := True;
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin

Errorcode := 0;
{不弹出出错窗口}
StatusBar1.SimpleText := '无法与主机' + ClientSocket1.Address + '建立连接!';
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin

StatusBar1.SimpleText := '与主机' + ClientSocket1.Address + '断开连接!';
Button2.Enabled := False;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
MyBuffer: array[0..10000] of byte;
{设置接收缓冲区}
MyReceviceLength: integer;
S: string;
MyBmp: TBitmap;
MyJpg: TJpegimage;
begin

StatusBar1.SimpleText := '正在接收数据......';
if MySize = 0 then
{MySize为服务端发送的字节数，如果为0表示为尚未开始图象接收}
begin

S := Socket.ReceiveText;
MySize := Strtoint(S);
{设置需接收的字节数}
Clientsocket1.Socket.SendText('ready');
{发指令通知服务端开始发送图象}
end
else

begin
{以下为图象数据接收部分}
MyReceviceLength := socket.ReceiveLength;
{读出包长度}
StatusBar1.SimpleText := '正在接收数据,数据大小为:' + inttostr(MySize);
Socket.ReceiveBuf(MyBuffer, MyReceviceLength);
{接收数据包并读入缓冲区内}
MyStream.Write(MyBuffer, MyReceviceLength);
{将数据写入流中}
if MyStream.Size >= MySize then
{如果流长度大于需接收的字节数，则接收完毕}
begin

MyStream.Position := 0;
MyBmp := tbitmap.Create;
MyJpg := tjpegimage.Create;
try
MyJpg.LoadFromStream(MyStream);
{将流中的数据读至JPG图像对象中}
MyBmp.Assign(MyJpg);
{将JPG转为BMP}
StatusBar1.SimpleText := '正在显示图像';
Image1.Picture.Bitmap.Assign(MyBmp);
{分配给image1元件 }
finally {以下为清除工作 }
MyBmp.free;
MyJpg.free;
Button2.Enabled := true;
{ Socket.SendText('cap');添加此句即可连续抓屏 }
MyStream.Clear;
MySize := 0;
end;

end;

end;

end;

procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin

MyStream.Free;
{释放内存流对象}
if ClientSocket1.Active then
ClientSocket1.Close;
{关闭Socket连接}
end;

end.


程序原理：运行服务端开始侦听，再运行客户端，输入服务端IP地址建立连接，然后发一个字符通知服务端抓屏幕。服务端调用自定义函数Cjt_GetScreen抓取屏幕存为BMP，把BMP转换成JPG，把JPG写入内存流中，然后把流发送给客户端。客户端接收到流后做相反操作，将流转换为JPG再转换为BMP然后显示出来。
注意：因为Socket的限制，不能一次发送过大的数据，只能分几次发。所以程序中服务端抓屏转换为流后先发送流的大小，通知客户端这个流共有多大，客户端根据这个数字大小来判断是否已经接收完流，如果接收完才转换并显示。
这个程序跟前面的自制OICQ都是利用了内存流对象TMemoryStream。其实，这个流对象是程序设计中用得最普遍的，它可以提高I/O的读写能力，而且如果你要同时操作几个不同类型的流，互相交换数据的话，用它作“中间人”是最好不过的了。比如说你把一个流压缩或者解压缩，就先建立一个TMemoryStream对象，然后把别的数据拷贝进去，再执行相应操作就可以了。因为它是直接在内存中工作，所以效率是非常高的。有时侯甚至你感觉不到有任何的延迟。
程序有待改进的地方：当然可以加一个压缩单元，发送前先压缩再发送。注意：这里也是有技巧的，就是直接把BMP压缩而不要转换成JPG再压。实验证明：上面程序一幅图像大小大概为40-50KB，如果用LAH压缩算法处理一下便只有8-12KB，这样传输起来就比较快。如果想更快的话，可以采用这样的方法：先抓第一幅图像发送，然后从第二幅开始只发跟前一幅不同区域的图像。外国有一个程序叫Remote Administrator，就是采用这样的方法。他们测试的数据如下：局部网一秒钟100-500幅，互联网上，在网速极低的情况下，一秒钟传输5-10幅。说这些题外话只想说明一个道理：想问题，特别是写程序，特别是看起来很复杂的程序，千万不要钻牛角尖，有时侯不妨换个角度来想。程序是死的，人才是活的。当然，这些只能靠经验的积累。但是一开始就养成好习惯是终身受益的！

xwings:
我仔细看过你的代码，根本没有经过处理，只是直接将抓到的屏幕在两个image上画了出了，
不知道我的理解对不对？

不是啊. 有一个image显示的是关键帧. 有一个显示的是 和关键帧运算过的图象.然后再压缩,再解压缩,

Here is some code fragment I wrote before, I use incremental image
check and dcom todo
it,

//Sender code
unit u_SnapThread;

interface

uses
Classes,
MonClient_TLB, dbugintf


type
TSnapThread = class (TThread)
protected
FActive : boolean;
FisFirstSnap : boolean;
FRefreshCount: integer;
FInterval : integer;
FWidth : integer;
FHeight : integer;
FSnapEvent : IMonCliEvents;
public
constructor Create (
const AInterval, AWidth, AHeight : integer;
ASnapEvent : IMonCliEvents
);
destructor Destroy;
override;
procedure Execute;
override;
property Active : boolean read FActive;
end;

type
PRGB24 = ^TRGB24;
TRGB24 = packed record
b, g, r: byte;
end;

PRGB24Array = ^TRGB24Array;
TRGB24Array = packed array[0..maxint div sizeof(TRGB24) - 1] of TRGB24;

implementation

uses
Windows, Messages, SysUtils,
Controls, ExtCtrls, Graphics,
Forms , Variants


Const
INT_Refresh=10;
INT_CheckSize=50;
INT_CheckRate=6;

{ TSnapThread }

constructor TSnapThread.Create (
const AInterval, AWidth, AHeight : integer;
ASnapEvent : IMonCliEvents
);
begin

inherited Create (TRUE);
FInterval := AInterval;
FWidth := AWidth;
FHeight := AHeight;
FSnapEvent := ASnapEvent;
// FSnapEvent := TObjectMarshaler.CreateMarshalObject (IMonCliEvents, ASnapEvent);
end;


destructor TSnapThread.Destroy;
begin

inherited;
end;


procedure TSnapThread.Execute;
var
timerCounter:integer;
LastSnapbmp : TBitmap;

Procedure SendBmpChip( pBmpChip:TBitmap;
px,py:integer)
var
TransBuff:OleVariant;
P: Pointer;
lx,ly:OleVariant;
Stream : TMemoryStream;
begin

Stream:=TMemoryStream.Create;
pBmpChip.SaveToStream(Stream);
// SendDebug('Send:'+inttostr(Stream.Size));
TransBuff := varArrayCreate([0, Stream.Size], varByte);
try
P := VarArrayLock(TransBuff);
try
Move(Stream.Memory^, P^, Stream.Size);
finally
VarArrayUnlock(TransBuff);
end;

lx:=OleVariant(px);
ly:=OleVariant(py);
FSnapEvent.EventFired(TransBuff,lx,ly);
finally
TransBuff:=null;
Stream.Free;
end;

end;


procedure CompareBitmap(bmpSource, bmpDest:TBitmap;
CheckSize,CheckRate:integer);
function CompareRGB(RGBFirst,RGBSecond:TRGB24):boolean;
begin

if (RGBFirst.b=RGBSecond.b) and
(RGBFirst.g=RGBSecond.g) and
(RGBFirst.r=RGBSecond.r)
// and (RGBFirst.a=RGBSecond.a)
then

begin

result:=true ;
end
else

begin

result:=false;
end;

end;

function CompareColor(RGBFirst,RGBSecond:TColor):boolean;
begin

if RGBFirst=RGBSecond then

begin

result:=true
end
else

begin

result:=false;
end;

end;

var
x, i, j, k: integer;
sl: PRGB24Array;
s2: PRGB24Array;
Xcount, Ycount:integer;
bmpCheck1, bmpCheck2: TBitmap;
isDiff:boolean;
begin

try
bmpCheck1:=TBitmap.Create;
bmpCheck2:=TBitmap.Create;
bmpCheck1.Width:=CheckSize;
bmpCheck2.Width:=CheckSize;
bmpCheck1.Height:=CheckSize;
bmpCheck2.Height:=CheckSize;
Xcount:= bmpSource.Width div CheckSize;
Ycount:= bmpSource.Height div CheckSize;
for j:= 0 to Ycountdo

begin

for i := 0 to Xcountdo

begin

bmpCheck1.Canvas.CopyRect(Rect(0,0,CheckSize,CheckSize) ,
bmpSource.Canvas,
Rect(i*CheckSize,j*CheckSize,(i+1)*CheckSize,(j+1)*CheckSize))
bmpCheck2.Canvas.CopyRect(Rect(0,0,CheckSize,CheckSize) ,
bmpDest.Canvas,
Rect(i*CheckSize,j*CheckSize,(i+1)*CheckSize,(j+1)*CheckSize))
isDiff:=false;
for k:=1 to CheckSize-1do

begin

if k mod CheckRate<>0 then
Continue;
// sl := bmpCheck1.ScanLine[k];
// s2 := bmpCheck2.ScanLine[k];
for x := 0 to CheckSize - 1do

begin

if x mod CheckRate<>0 then
Continue;
if not CompareColor(bmpCheck1.Canvas.pixels[x,k],
bmpCheck2.Canvas.pixels[x,k]) then

// if not CompareRGB(sl[x],s2[x]) then

begin

SendBmpChip(bmpCheck2, i*CheckSize,j*CheckSize);
isDiff:=true;
break;
end;

end;

if isDiff then
break;
end;

end;

end;

finally
bmpCheck1.Free;
bmpCheck2.Free;
end;

end;




proceduredo
Snap(const Limitwidth, Limitheight:integer);
var
DC:hwnd;
BackgroundCanvas:tcanvas;
backgroundbmp:tbitmap;
begin

DC := GetDC (0);
BackgroundCanvas := TCanvas.Create;
BackgroundCanvas.Handle := DC;
backgroundbmp:=tbitmap.create;
backgroundbmp.width:=Limitwidth
backgroundbmp.height:=Limitheight
backgroundbmp.Canvas.CopyRect (Rect (0, 0, Limitwidth, Limitheight), BackgroundCanvas,
Rect (0, 0, Screen.Width, Screen.Height));
try
if (FisFirstSnap) or (FRefreshCount=INT_Refresh) then

begin

SendBmpChip(backgroundbmp, 0, 0 );
FRefreshCount:=0;
FisFirstSnap:=false;
end
else

CompareBitmap(LastSnapBmp, backgroundbmp, INT_CheckSize, INT_CheckRate);
LastSnapBmp.Assign(backgroundbmp);
finally

backgroundbmp.free;
BackgroundCanvas.free;
end;

end;


begin

{ initialize new thread into an STA }
FActive := TRUE;
FisFirstSnap:=true;
FRefreshCount:=0;
LastSnapbmp:=TBitmap.create;
// InitializeCOM (TRUE, atSTA);

{ unmarshal SearchStatus callback interface so we can use it from this thread }
// FSnapEvent.UnMarshalObject (PSnapEvent);
while not (Terminated)do

begin

inc(FRefreshCount);
do
Snap (FWidth, FHeight);
Sleep(FInterval)
end;


{ uninitialize thread from STA }
// InitializeCOM (FALSE, atSTA);
LastSnapbmp.Free;
FActive := FALSE;
end;


end.

end.


// Receiver code
procedure Tfm_Snap.ConvertData(const Value, px, py: OleVariant);
var
Stream: TMemoryStream;
SnapBmp: TBitmap;
P: Pointer;
begin

if VarIsNull(Value) or VarIsEmpty(Value) then

else

begin

Stream := TMemoryStream.Create;
SnapBmp:= TBitmap.Create;
try
Stream.Size := VarArrayHighBound(Value, 1);
// SendDebug('get:'+inttostr(Stream.Size));
P := VarArrayLock(Value);
try
Stream.Write(P^, Stream.Size);
finally
VarArrayUnlock(Value);
end;

inc(FCount);
Stream.Position := 0;
SnapBmp.LoadFromStream(Stream);
Canvas.StretchDraw(Rect(integer(px), integer(py),
SnapBmp.Width+integer(px), SnapBmp.Height+ integer(py)),
SnapBmp);
if (SnapBmp.Width>Width) or (SnapBmp.Height>Height-80) then

begin

Width:=SnapBmp.Width;
Height:=SnapBmp.Height+40;
end;


finally
SnapBmp.Free;
Stream.Free;
end;

end;

end;

xwings
你好，能够详细谈谈关键帧的作用吗
测试过每压缩一幅图像要多少时间？

关注，
不知道大家有没有考虑过用H263来压缩图象?

大家好：
我经过比较，觉得不管采取哪种方式，都不能达到你想的速度，
因为任何压缩算法都需要占用大量的cpu时间，就没有办法处理其他任务了
有人知道怎样直接获取显卡的控制？直接获得显存数据？

must use DDK

如果大家对显卡芯片的资料熟的话，可以对寄存器直接读，用dma方式读显存。但是这要和硬件打交道，而且针对特定的显卡
，我现在再做的就是这个工作。

to luoshitu
可以介绍一下么?

我做的是pci的显卡

我也想要，gxfzdyj@sina.com

据说ATI的显卡这方面比较快.各位有谁知道一点的?

压缩过程需要一个压缩比大，压缩解压缩速度快的东西，见过JINGTAO 哪里有一个LHA
据说速度不错，不知道哪个大哥用过

各位英雄！请提供个FFT转换的例子或者是/////。。。。。。。。。。。。。。。。。。。。。。。。。。。。
最好了，要不然，我怎么样入手呀，，，
问题地址是：
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1097282
我已经把WAV格式的文件结构分析得十分清楚，但是应用时就会有各种问题，，
就是我说的频谱分析，，，傅利叶 ----》转换怎么样做呢？？？
还要我在打印（屏幕）输出一个波形文件时，速度慢（BCB/DELPHI中的CAVANC画布）
怎么样解决它呢？？？？

这样是不能够完成实时显示的需要的，我手里还有个几千分，如果大佬你有诚意说明给我这个
东西怎么样搞，，，分数好商量！！！！！！

QQ:65466700
MAIL: Along@IT-Town.com

gz

看看上一期的电脑报软件版，有个利用Vc的Dll来抓屏并压缩的，我没看仔细。我看了没研究，应该是比较好的
能轻松解决这个问题