这是一段DX代码!!是保存为一个BMP文件!
我不需要保存文件。只需要将它存放在Tbitmap的变量中。或者直接返回tbitmap。。帮忙修改修改呗。。在线等
function GetBitmapFromScreen(lpFileName: PChar):bool;
var
 lpBuf: Pchar;
 hBitmap,hOld: windows.HBITMAP ;
 hDC,hcDC: windows.HDC;
 bb: BITMAP;
 b: BITMAPINFO;
 hp,fh: THANDLE ;
 dwX,dwY: DWORD;
begin
 fh := INVALID_HANDLE_VALUE;
 //***************
 dwX := GetSystemMetrics(SM_CXSCREEN);
 dwY := GetSystemMetrics(SM_CYSCREEN);
 hDC := GetDC(0);
 hcDC:=CreateCompatibleDC(hDC);
 hBitmap:=CreateCompatibleBitmap(hDC,dwX,dwY);
 hOld :=windows.HBITMAP(SelectObject(hcDC,hBitmap));
 BitBlt(hcDC,0, 0,dwX,dwY, hDC, 0, 0, SRCCOPY); 
 bb.bmWidth:=dwX;
 bb.bmHeight :=dwY;
 bb.bmPlanes := 1;
 bb.bmWidthBytes:=bb.bmWidth*3;
 bb.bmBitsPixel:=3;
 bb.bmType:=0;
 b.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
 b.bmiHeader.biWidth:=dwX;
 b.bmiHeader.biHeight :=dwY;
 b.bmiHeader.biPlanes := 1;
 b.bmiHeader.biBitCount        :=3*8;
 b.bmiHeader.biCompression      := BI_RGB;
 b.bmiHeader.biSizeImage        := 0;
 b.bmiHeader.biXPelsPerMeter     := 0;
 b.bmiHeader.biYPelsPerMeter     := 0;
 b.bmiHeader.biClrUsed         := 0;
 b.bmiHeader.biClrImportant      := 0;
 b.bmiColors[0].rgbBlue:=8;
 b.bmiColors[0].rgbGreen:=8;
 b.bmiColors[0].rgbRed:=8;
 b.bmiColors[0].rgbReserved:=0;
 hp:=GetProcessHeap;
 lpBuf:=PChar(HeapAlloc(hp,fh,bb.bmHeight*bb.bmWidth*4));
 GetDIBits(hcDC,hBitmap,0,dwY,lpBuf,b,DIB_RGB_COLORS);
 SaveBitmapToFile(@bb,lpFileName,lpBuf);
 ReleaseDC(0,hDC);
 DeleteDC(hcDC); 
 DeleteObject(hBitmap);
 DeleteObject(hOld);
 HeapFree(hp,0,lpBuf);
 Result:=True;
end;
delphi

解决方案 »

  1.   

    你可以创建一个 Delphi 的 TBitmap,取代 Windows API 创建的 hBitmap。前面稍微改一下:var dBitmap: TBitmap;dwX := GetSystemMetrics(SM_CXSCREEN);
    dwY := GetSystemMetrics(SM_CYSCREEN); dBitmap := TBitmap.Create;
    dBitmap.Width := dwX;
    dBitmap.Height := dwY;
    hBitmap := dBitmap.Handle;你的函数直接返回这个 dBitmap 就行了。当然,函数定义需要稍微改一下,后面那几条不必要的语句也要删除,包括保存文件,释放 hDC,还有前两条 Delete 语句。这你懂。Delphi 的 TBitmap 相当于获取 hDC 和创建 bitmap。请注意,TBitmap 是在函数内部创建的,调用方完成处理后要负责释放这个 TBitmap。
      

  2.   

    我又检查一遍,是我看得不仔细,抱歉。稍微调整一下:前面的两行还需要保留:
      hDC := GetDC(0);
      hcDC:=CreateCompatibleDC(hDC); 虽然创建 TBitmap 不需要 hDC,但后面的处理还需要,所以这两行需要保留。这样,后面的代码只需要删除保存文件和 DeleteObject(hBitmap)这一行就行了。我重写了你的函数,试过,能抓屏。把我修改后的代码都给你贴上吧:function GetBitmapFromScreen: TBitmap;
    var
      lpBuf: Pchar;
      hBitmap,hOld: windows.HBITMAP ;
      hDC,hcDC: windows.HDC;
      bb: BITMAP;
      b: BITMAPINFO;
      hp,fh: THANDLE ;
      dwX,dwY: DWORD;
      dBitmap: TBitmap;
    begin
      fh := INVALID_HANDLE_VALUE;
     //***************
      dwX := GetSystemMetrics(SM_CXSCREEN);
      dwY := GetSystemMetrics(SM_CYSCREEN);  hDC := GetDC(0);
      hcDC:=CreateCompatibleDC(hDC);  hBitmap:=CreateCompatibleBitmap(hDC,dwX,dwY);
      dBitmap := TBitmap.Create;
      dBitmap.Width := dwX;
      dBitmap.Height := dwY;
      hBitmap := dBitmap.Handle;  hOld :=windows.HBITMAP(SelectObject(hcDC,hBitmap));
      BitBlt(hcDC,0, 0,dwX,dwY, hDC, 0, 0, SRCCOPY);
      bb.bmWidth:=dwX;
      bb.bmHeight :=dwY;
      bb.bmPlanes := 1;
      bb.bmWidthBytes:=bb.bmWidth*3;
      bb.bmBitsPixel:=3;
      bb.bmType:=0;
      b.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
      b.bmiHeader.biWidth:=dwX;
      b.bmiHeader.biHeight :=dwY;
      b.bmiHeader.biPlanes := 1;
      b.bmiHeader.biBitCount        :=3*8;
      b.bmiHeader.biCompression      := BI_RGB;
      b.bmiHeader.biSizeImage        := 0;
      b.bmiHeader.biXPelsPerMeter     := 0;
      b.bmiHeader.biYPelsPerMeter     := 0;
      b.bmiHeader.biClrUsed         := 0;
      b.bmiHeader.biClrImportant      := 0;
      b.bmiColors[0].rgbBlue:=8;
      b.bmiColors[0].rgbGreen:=8;
      b.bmiColors[0].rgbRed:=8;
      b.bmiColors[0].rgbReserved:=0;
      hp:=GetProcessHeap;
      lpBuf:=PChar(HeapAlloc(hp,fh,bb.bmHeight*bb.bmWidth*4));
      GetDIBits(hcDC,hBitmap,0,dwY,lpBuf,b,DIB_RGB_COLORS);  //SaveBitmapToFile(@bb,lpFileName,lpBuf);
      ReleaseDC(0,hDC);
      DeleteDC(hcDC);
      //DeleteObject(hBitmap);
      DeleteObject(hOld);
      HeapFree(hp,0,lpBuf);  Result := dBitmap;
    end;
      

  3.   

    上面还有一行需要删除,虽然不影响运行,但是没用,空耗资源:
      //hBitmap:=CreateCompatibleBitmap(hDC,dwX,dwY);仓促修改,丢三落四的,抱歉了。不过这段代码完全没问题,如果你还取不出图来,应该从调用方找问题。
      

  4.   

    万分感谢!!但是还是有问题哦 不知道是不是我的编译器的问题!抓一张图没有问题。但是多抓几张问题就来了提示 存储空间不足 无法处理此信息!!
    我是这样调用的 Image1.Picture.Assign(GetBitmapFromScreen);
      

  5.   

    jackout:你没释放返回的 TBitmap 呀。不妨先把函数返回值赋给某个变量,比方说 Bitmap,待 Assign 之后用 Bitmap.Free 把它释放掉。如果屏幕分辨率很高,抓一次屏就要吃掉一大块内存。给个建议:你不妨直接把 TImage.Picture.Bitmap 作为参数传给函数,这样就不用在函数内部一次次创建,然后再一次次释放了,而且能提高处理速度。
      

  6.   

    嗯 好的我改改函数吧!就不还回bitmap了 直接传递一个bitmap参数进去  或者直接传递一个bitmap的handle过去也可以吧