Delphi屏幕截图完美解决方案

转载 2007年10月10日 15:40:00

可以截取layered窗口(包括透明窗口)的代码:

procedure CaptureScreen(AFileName: string);
const
  CAPTUREBLT = $40000000;
var
  hdcScreen: HDC;
  hdcCompatible: HDC;
  bmp: TBitmap;
  hbmScreen: HBITMAP;
begin
  hdcScreen := CreateDC('DISPLAY', nil, nil, nil);
  hdcCompatible := CreateCompatibleDC(hdcScreen);
  hbmScreen := CreateCompatibleBitmap(hdcScreen,
    GetDeviceCaps(hdcScreen, HORZRES),
    GetDeviceCaps(hdcScreen, VERTRES));
  SelectObject(hdcCompatible, hbmScreen);
  bmp := TBitmap.Create;
  bmp.Handle := hbmScreen;
  BitBlt(hdcCompatible,
    0, 0,
    bmp.Width, bmp.Height,
    hdcScreen,
    0, 0,
    SRCCOPY or CAPTUREBLT);

  bmp.SaveToFile(AFileName);
  bmp.Free;
  DeleteDC(hdcScreen);
  DeleteDC(hdcCompatible);
end;

DX Primary Surface截图代码!包含DX8与DX9两个版本

...
interface

{$DEFINE D3D9}

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons,
{$IFDEF D3D9}
  // D3DX9, // use D3D to save surface
  Direct3D9
{$ELSE}
  // D3DX8, // use D3D to save surface
  Direct3D8
{$ENDIF};
...
procedure TForm1.BitBtn1Click(Sender: TObject);
// Capture screen through D3D.
var
  BitsPerPixel: Byte;
  {$IFDEF D3D9}
  pD3D: IDirect3D9;
  pSurface: IDirect3DSurface9;
  g_pD3DDevice: IDirect3DDevice9;
  {$ELSE}
  pD3D: IDirect3D8;
  pSurface: IDirect3DSurface8;
  g_pD3DDevice: IDirect3DDevice8;
  {$ENDIF}
  D3DPP: TD3DPresentParameters;
  ARect: TRect;
  LockedRect: TD3DLockedRect;
  BMP: TBitmap;
  i, p: Integer;
begin
  BitsPerPixel := GetDeviceCaps(Canvas.Handle, BITSPIXEL);
  FillChar(d3dpp, SizeOf(d3dpp), 0);
  D3DPP.Windowed := True;
  D3DPP.Flags := D3DPRESENTFLAG_LOCKABLE_BACKBUFFER;
  D3DPP.SwapEffect := D3DSWAPEFFECT_DISCARD;
  D3DPP.BackBufferWidth := Screen.Width;
  D3DPP.BackBufferHeight := Screen.Height;
  D3DPP.BackBufferFormat := D3DFMT_X8R8G8B8;
  {$IFDEF D3D9}
  pD3D := Direct3DCreate9(D3D_SDK_VERSION);
  pD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, GetDesktopWindow,
    D3DCREATE_SOFTWARE_VERTEXPROCESSING, @D3DPP, g_pD3DDevice);
  g_pD3DDevice.CreateOffscreenPlainSurface(Screen.Width, Screen.Height, D3DFMT_A8R8G8B8, D3DPOOL_SCRATCH, pSurface, nil);
  g_pD3DDevice.GetFrontBufferData(0, pSurface);
  {$ELSE}
  pD3D := Direct3DCreate8(D3D_SDK_VERSION);
  pD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_REF, GetDesktopWindow,
    D3DCREATE_SOFTWARE_VERTEXPROCESSING, D3DPP, g_pD3DDevice);
  g_pD3DDevice.CreateImageSurface(Screen.Width, Screen.Height, D3DFMT_A8R8G8B8, pSurface);
  g_pD3DDevice.GetFrontBuffer(pSurface);
  {$ENDIF}
  // use D3D to save surface. Notes: D3DX%ab.dll is required!
//  D3DXSaveSurfaceToFile('Desktop.bmp', D3DXIFF_BMP, pSurface, nil,  nil);
  // use Bitmap to save surface
  ARect := Screen.DesktopRect;
  pSurface.LockRect(LockedRect, @ARect, D3DLOCK_NO_DIRTY_UPDATE or D3DLOCK_NOSYSLOCK or D3DLOCK_READONLY);
  BMP := TBitmap.Create;
  BMP.Width := Screen.Width;
  BMP.Height := Screen.Height;
  case BitsPerPixel of
    8:  BMP.PixelFormat := pf8bit;
    16: BMP.PixelFormat := pf16bit;
    24: BMP.PixelFormat := pf24bit;
    32: BMP.PixelFormat := pf32bit;
  end;
  p := Cardinal(LockedRect.pBits);
  for i := 0 to Screen.Height - 1 do
    begin
      CopyMemory(BMP.ScanLine[i], Ptr(p), Screen.Width * BitsPerPixel div 8);
      p := p + LockedRect.Pitch;
    end;
  BMP.SaveToFile('Desktop.bmp');
  BMP.Free;
  pSurface.UnlockRect;
end;


 

以上DX截图代码,不需要额外的DLL支持,有DirectX 9.0即可
采用上面的2个方案以外,还有些视频播放器的图像不能截取吧,呵呵
怎么解决呢?
它们使用的,是称为"覆盖表面"的技术,截取覆盖表面,需要Hook的手段才行

思路是:
通过Hook DDraw的DirectDrawCreate(RealOne用)同DirectDrawCreateEx(WMP用)
获得IDirectDraw(7)
再COM Hook CreateSurface,注意RealOne使用的是通过QueryInterface获得IDirectDraw2
WMP则是IDirectDraw7
Hook了CreateSurface后,就能获得OverlaySurface
所以必须在软件使用前,启动全局Hook,才有效
在需要截图的时候
Lock Overlay Surface,读取数据,马上Unlock,以免损失性能
解码读出来的数据,即可,但是由于获得的数据是显卡硬件VRAM的数据,一般是YUY2,YV12等格式,需要转换为RGB格式
例如,在我的GF6600上,RealOne(RMVB)用的是YUY2,而WMP(AVI)用的是YV12,还与当前播放的文件格式有关提供主表面截图源码和覆盖表面截图的测试程序http://lysoft.lz169.com/projects/DXCapture.rar
现在支持YV12,NV12,YUY2,UUVY 4个格式

Tag:
 

D3D中几种DrawPrimitive用法

前面的学习,我们知道如何现实一个三角形了,这就意味着我们掌握了如何把我们需要的顶点参数(例如坐标,颜色等等)送入后台缓冲,然后提交前台显示。今天给大家说说对自己的顶点的渲染方式的问题。 大家先一起回...
  • binbingg
  • binbingg
  • 2013-02-19 15:22:50
  • 811

Delphi中BitBlt函数实现屏幕对象抓图

 uses WinTypes, WinProcs, Forms, Controls, Classes, Graphics;function CaptureScreenRect( ARect: TRec...
  • aroc_lo
  • aroc_lo
  • 2009-11-26 13:30:00
  • 1935

delphi 截图简单的实现

delphi 截图
  • rznice
  • rznice
  • 2015-06-30 13:20:02
  • 2386

Delphi仿QQ屏幕截屏程序

  • 2015年09月18日 15:26
  • 674KB
  • 下载

Delphi实现简单的区域截屏

  • 2017年08月22日 21:47
  • 331KB
  • 下载

Delphi6控件内容完整截屏

由于用户那套旧系统需要截取Form中控件的内容,但经常因内容超长而截屏不完整(又被踢下坑了)。 经搜索,网上有不少关于这方面的资料(感谢他们的分享),再自己琢磨了一下,得到了以下代码。 值得注意的是,...
  • zhaogang
  • zhaogang
  • 2016-12-13 15:59:21
  • 684

DELPHI写的截图小工具源码(部分)

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 1...
  • u010636606
  • u010636606
  • 2016-08-27 20:47:38
  • 1150

DELPHI屏幕截图抓屏工具源代码

  • 2010年02月19日 15:04
  • 3.23MB
  • 下载

Delphi写的一个屏幕截取函数

 procedure CopyScreen(x : integer; y : integer; Width : integer; Height : integer; bm : TBitMap);var...
  • aroc_lo
  • aroc_lo
  • 2009-11-26 13:32:00
  • 482

Delphi图象截取编程示例(7)

(七)抓取窗体或控件图片窗体创建一个新的Form2,保存为Capture2.pas。设置属性BorderIcons的四个属性为false.BorderStyle设为bsNone,FormStyle设为...
  • LuckyJan
  • LuckyJan
  • 2004-11-02 10:45:00
  • 6330
收藏助手
不良信息举报
您举报文章:Delphi屏幕截图完美解决方案
举报原因:
原因补充:

(最多只允许输入30个字)