求 用DirectDraw抓取屏幕图像的Delphi源代码

Question

求 用DirectDraw抓取屏幕图像的Delphi源代码
谢谢

Answer 1

首先,下载
http://kuga.51.net/download/files/directx7.rar
(我没有找到更高版本的SDK,不过我原来VC也是用DX7写的,在DX9下应该可用)
全部程序如下:unit dxcapu;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  DirectDraw, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
      g_pDD           : IDirectDraw7;
      g_ddcaps: TDDCaps_DX7 ;
      g_pDDSPrimary:IDIRECTDRAWSURFACE7;
      hRet    : HRESULT;
      ddsd,ddsdl:TDDSurfaceDesc2;
     procedure ErrorOut(hRet : HRESULT; FuncName : string);
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}
const
  Is555:boolean=false;
 function GetRed(color:WORD ):byte;
 begin
    if( Is555 ) then
        result:= (color shr 7) and $ff
    else
        result:= (color shr 8) and $ff;
end; function GetGreen(color:WORD ):byte;
begin
    if( Is555 ) then
         result:= (color shr 2) and $ff
    else
         result:=  (color shr 3) and $ff;
end;function GetBlue(color:WORD):byte;
begin
    result:= (color and $1f) shl 3;
end      ;procedure TForm1.ErrorOut(hRet : HRESULT; FuncName : string);
var
  OutString : string;
begin
  OutString := FuncName + ': ' + #13 + DDErrorString(hRet);
  MessageBox(0, PChar(OutString), PChar(Caption), MB_OK or MB_ICONSTOP);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
fp:tfilestream;
lpBuffer:pword;
nPitch:integer;      // 表面跨距
nWidth, nHeight:integer;  // 表面宽高
FileHeader:   BITMAPFILEHEADER ;
Header:BITMAPINFOHEADER ;
wd: WORD;
i,j:integer;
bt:byte;
begin
 hRet := DirectDrawCreateEx(nil, g_pDD, IDirectDraw7, nil);
  if hRet <> DD_OK then
    begin
      ErrorOut(hRet, 'DirectDrawCreateEx');
      Exit;
    end;
  // Setting the cooperate level
  hRet := g_pDD.SetCooperativeLevel(Handle, DDSCL_NORMAL);
  if hRet <> DD_OK then
    begin
      ErrorOut(hRet, 'SetCooperativeLevel');
      Exit;
    end;
  ZeroMemory(@g_ddcaps,sizeof(g_ddcaps));
  g_ddcaps.dwSize := sizeof(g_ddcaps);
  hRet := g_pDD.GetCaps(@g_ddcaps,nil);
 if hRet <> DD_OK then
  begin
      ErrorOut(hRet, 'GetCaps');
      Exit;
  end;
  ZeroMemory(@ddsd,sizeof(ddsd));
  ddsd.dwSize         := sizeof(ddsd);
  ddsd.dwFlags        := DDSD_CAPS;
  ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;
  hRet :=g_pDD.CreateSurface(ddsd, g_pDDSPrimary,nil);
 if hRet <> DD_OK then
  begin
      ErrorOut(hRet, 'CreateSurface');
      Exit;
  end;
 fp:=tfilestream.create('e:\temp\t.bmp',fmOpenReadWrite or fmCreate );
 fp.Seek(0,0);
 ZeroMemory(@ddsdl,sizeof(ddsdl));
 ddsdl.dwSize := sizeof(ddsdl);
 hRet := g_pDDSPrimary.Lock( nil, ddsd, DDLOCK_WAIT, 0 );
 if hRet <> DD_OK then
  begin
      ErrorOut(hRet, 'Lock');
      Exit;
  end;
  lpBuffer := ddsd.lpSurface;
  nWidth := ddsd.dwWidth;
  nHeight := ddsd.dwHeight;
  nPitch  := ddsd.lPitch shr 1;    //lPitch以Byte为单位，GraphPitch以WORD为单位。所以GraphPitch = lPitch / 2;
  ShowMessage(Format('%d %d %d',[nWidth,  nHeight , nPitch ]));   FileHeader.bfType := $4D42;
   FileHeader.bfSize := nWidth * nHeight * 3 + $36;
   FileHeader.bfReserved1 := 0;
   FileHeader.bfReserved2 := 0;
   FileHeader.bfOffBits := $36;
   fp.Write(FileHeader, sizeof(BITMAPFILEHEADER));   // 保存文件信息
   Header.biSize := sizeof(BITMAPINFOHEADER);  // 结构的大小
   Header.biWidth := nWidth;          // 宽
   Header.biHeight := nHeight;          // 高
   Header.biPlanes := 1;            // 固定
   Header.biBitCount := 24;            // 颜色数
   Header.biCompression := BI_RGB;        // 是否压缩
   Header.biSizeImage := nWidth * nHeight * 3;  // 图片的大小
   Header.biXPelsPerMeter := 0;
   Header.biYPelsPerMeter := 0;
   Header.biClrUsed := 0;
   Header.biClrImportant := 0;
   fp.write(Header, Header.biSize);
   fp.Seek($36,0);   lpBuffer := pword(pchar(lpBuffer)+ 2*( nPitch* (nHeight - 1)));
   for  i:=0  to  nHeight-1 do
   begin
     for  j:=0 to nWidth-1 do
     begin
       wd := lpBuffer^;
       bt:= GetBlue( wd ); // 蓝
       fp.write( bt, 1);
       bt:= GetGreen( wd );  // 绿
       fp.write( bt, 1);
       bt:= GetRed( wd );    // 红
       fp.write( bt, 1);
       inc(lpBuffer);
     end;
     lpBuffer  := pword(pchar(lpBuffer)-2*(nWidth+nPitch)); // 指针转到上一行的开始
   end;
   fp.Free;
   // 解锁表面
   hRet:= g_pDDSPrimary.Unlock( nil );
   ShowMessage('ok');end;end.