求最快的截屏函数！最好是 50ms 之内！
http://www.delphi2007.net/DelphiMultimedia/html/delphi_20061024164940207.html
用 GetDC 的方法截屏大概耗时 180ms 左右。这对于远程控制来说显然是太慢了，
有没有更快的截屏方法。
听说设置系统重画钩子可以只截取屏幕变化的部分，从而可以提高速度。
这种使用钩子的方法，怎么作呢？
有另外的办法也行，只要够快就行！
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;
这个函数应该不错
这个函数就是用的 GetDC ，在线程中执行，在我的电脑上还是用了 172ms
能发送一个printscreen键消息吗？
相当于按一下printscreen那个拷屏键，
然后用使用剪贴板的数据就可以了
blog.joycode.com/jiangsheng/posts/10410.aspx
to jiangsheng(蒋晟.Net[MVP]) ：
你在文章中提到用系统钩子拦截重画消息，VNC 的源代码我看不懂，用 Delphi 如何拦截，拦截后如何截屏变化的部分？
另外听说用 DirectX 可以直接访问显存，但是用 DirecxX 如何截屏呢？
用 DelphiX（封装 DirecxX 的 Delphi 组件） 如何截屏呢？
up
mark
Benchmarks shows that DirecxX is much slower then GDI
I don't know Delphi. If you don't know C++ you can rewrite all Windows API calls in Delphi.
如果楼主愿意给分的话，我可以帮你编写一个速度超快的载图函数，而且带压缩功能。
如果想从剪切板读出图片数据，保存为一张BMP文件，也非常简单：
先发送一个PrintScreen键，再通过Image控件的SaveToFile()方法保存即可！
VNC没有完全的Delphi Source,但是却有Delphi的组件,只是核心层仍然是使用的C++的DLL.
另外楼主最好搞清楚,你说的那个50ms是针对你的机器配置来说的,也许在别人机器上能达到50ms以内,但是放到你的机器上就不是那么回事了.
一个程序员,自己提出来的需求都如此,那么如果是你的客户提出类似的需求你会如何?
想快,估计只能用驱动层面上的
to mwy654321(无条件为你):
你要多少分，我再开个帖子，你把代码给我！
学习中，关注~~~~~
//mwy654321的方法如下：
uses Clipbrd;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
keybd_event(VK_SNAPSHOT, 0, 0, 0);
keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0);
if not ClipBoard.HasFormat(CF_BITMAP) then Exit;
Image1.Picture.Bitmap.LoadFromClipboardFormat(CF_BITMAP,
ClipBoard.GetAsHandle(CF_BITMAP), 0);
end;
首先, 此种应用不必设置系统钩子, 那种方法只会更慢
其次, 不要使用CopyRect, 因为CopyRect调用的StretchBlt, 直接使用BitBlt更快
对于BitBlt,
首先, 此种应用不必设置系统钩子, 那种方法只会更慢
其次, 不要使用CopyRect, 因为CopyRect调用的StretchBlt, 直接使用BitBlt更快
对于BitBlt, 我的笔记本电脑测试结果为 1024 x 768 只需要 3 ms
如果楼主的机器需要的时间超过50ms,那只能说明楼主的机器的显卡太烂, 应当立马更换
BitBlt的性能一般与CPU性能无关, 主要与显卡性能相关
示例如下:
注意, 对于性能测试, 我的例子中
Caption := Caption + 'OK';
这句看似废话, 其实必不可少; 因为 BitBlt会立即返回, 其交给显卡上的GPU完成相关操作
这句Caption := Caption + 'OK';是确保所有BitBlt GPU操作完成, 否则, 如果没有此句,
时间之差接近于0
procedure TForm1.Button1Click(Sender: TObject);
var
oldTick, NewTick: DWord;
aBit: TBitmap;
i: Integer;
dc: HDC;
begin
aBit := TBitmap.Create;
try
aBit.Width := Screen.Width;
aBit.Height := Screen.Height;
OldTick := GetTickCount;
for i := 0 to 999 do
begin
dc := GetDc(HWND_DESKTOP);
Win32Check(bitblt(aBit.Canvas.Handle, i mod 10, i mod 10, aBit.Width, aBit.Height, dc, 0, 0, SRCCOPY));
ReleaseDC(HWND_DESKTOP, dc);
end;
Caption := Caption + 'OK';
NewTick := GetTickCount;
finally
aBit.Free;
end;
Beep();
ShowMessage(Format('%u - %u = %d', [NewTick, OldTick, NewTick - OldTick]));
end;
请教楼上的，为什么要弄个循环在这里？一次bitblt不就ok了吗
for i := 0 to 999 do
begin
dc := GetDc(HWND_DESKTOP);
Win32Check(bitblt(aBit.Canvas.Handle, i mod 10, i mod 10, aBit.Width, aBit.Height, dc, 0, 0, SRCCOPY));
ReleaseDC(HWND_DESKTOP, dc);
end;
回楼上: 我弄一个循环是为了测试bitblt的性能
因为 GetTickCount的精度只有10ms, 而一次bitblt会小于10ms
这样, 可以使用 总时间/次数 计算每次的时间消耗
对于楼上许多人提供的Print Screen加Paste From Clipboard的方法, 我只能说这种方法太弱
其一性能很差
其二破坏了Clipboard (此乃大忌)
但别对于楼主这种应用来说, 远程控制被控制的机器的Clipboard就不能用了
to spirit_sheng(老盛) :
我用你的方法在我的机器上测试，怎么于其它方法相差无几，耗时还是 170～180 ms。
另外你说设置系统钩子会更慢，为什么？我听说 Radmin 就是用的这种办法！
这是我把你的代码稍加修改后的代码，没什么问题吧？
procedure BitBlt_CapScreen(AStream: TMemoryStream; Left, Top, Width, Height: Integer);
var
aBit: TBitmap;
dc: HDC;
begin
aBit := TBitmap.Create;
try
aBit.Width := Screen.Width;
aBit.Height := Screen.Height;
dc := GetDc(HWND_DESKTOP);
Win32Check(BitBlt(aBit.Canvas.Handle, 0, 0, aBit.Width, aBit.Height, dc, 0, 0, SRCCOPY));
ReleaseDC(HWND_DESKTOP, dc);
// Caption := Caption + 'OK';
aBit.SaveToStream(AStream);
finally
aBit.Free;
end;
end;
我去掉 Caption := Caption + 'OK'; 也很正常啊！
楼主把你的机器环境帖出来的吧
我的是 Dell Latitude D600
CPU Intel(R) Pentium(R) M Processor 725 (1.6 GHz)
显卡 ATI Mobility RADEONTM 9000 图形卡，带有 32MB DDR 内存
操作系统 Windows XP Profressional SP2 (简体中文)
在我的机器上1024x768只要3ms, 你说要170～180 ms, 相差也太大了
TO: 楼主, 我那 Caption := Caption + 'OK'; 主要是基于计时考虑的
因为 BitBlt 是立即返回的
我的机器是集成显卡。听说集成显卡已经没有显存了，所用内存是在主内存中叩！
我的机器是 CPU 2.6 GHz, 内存是 512 MB, 操作系统是 Windows2000 Server
请教下spirit_sheng(老盛)
我用你的代码，
明明很快就听见
Beep();
但showmessage却等了几秒才跳出来，这是为啥
ShowMessage(Format('%u - %u = %d', [NewTick, OldTick, NewTick - OldTick]));
To: 楼上
这也就是我帖子里的说的, 你加上那句Caption := Caption + 'OK'; 后, Beep 就不会很快了出现了
bitblt 函数会很快返回, 其具体会交由显卡完成
ShowMessage 操作也要请求显卡完成, 所以, 其会等待GPU可用才能继续执行
TO: 楼主, 你的集成显卡太差了, 更换显卡是王道
不能叫客户也去换把 ：）
用循环测试Bitblt的方法有问题，GetDC可能耗费的时间更多。
楼主，你可以看看这个http://www.delphibox.com/article.asp?articleid=3710远程屏幕传输 差异截图