GetPixel的速度太慢了，请问如何用GetDIBits解决这个问题？

Question

声明：不想用TBitmap，务必用GetDIBits解决，怎么搞？(也就是说只想用API搞定)一下这段代码是我自己写的，对屏幕的每个点进行扫描。速度非常慢！！
即使把ListBox1.items.add(inttostr(Pix));注释掉，也要1分半钟左右，才能扫描完。
本人机器酷睿双核，4G内存，配置算是很不错了，还这么慢，怎么办？
procedure TForm1.Button1Click(Sender: TObject);
var
  X, Y: integer;
  iX, iY: integer;
  pix: DWORD;
  DC: HDC;
begin
  DC := GetDC(0);
  X := GetSystemMetrics(SM_CXSCREEN); //得到屏幕的宽度
  Y := GetSystemMetrics(SM_CYSCREEN); //得到屏幕的高度
  for iY := 4 to Y do //高度
    for iX := 1 to X do //宽度
    begin
      Pix := Windows.GetPixel(DC, iX, iY); 
      ListBox1.items.add(inttostr(Pix)); //输入每个像素点的颜色值
    end;
  Windows.ReleaseDC(0, DC);
end;///////////////////////// 这里是重点了 /////////////////////////
查了资料后，才知道可以用GetDIBits这个API，但是用起来好复杂，
找到了C代码后，将它翻译成了Delphi代码，却不知道怎么将lpBuf里面的每个像素点输出了。
研究了整整2天，能查到的资料也非常少，跪求高手解决，300相送。procedure TForm1.Button6Click(Sender: TObject);
const
  HEAP_ZERO_MEMORY = $8;
var
  b: BITMAPINFO;
  bb: bitmap;
  lpBuf: array of byte;
  _hbitmap, hold: hbitmap;
  _hdc, _hcdc: hdc;
  hp: thandle;
  dwx, dwy: dword;
begin
  dwX := GetSystemMetrics(SM_CXSCREEN);
  dwY := GetSystemMetrics(SM_CYSCREEN);
  _hDC := GetDC(0);
  _hcDC := CreateCompatibleDC(_hDC);
  _hBitmap := CreateCompatibleBitmap(_hDC, dwX, dwY);
  hOld := 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 := 24;
  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 := HeapAlloc(hp, HEAP_ZERO_MEMORY, bb.bmHeight * bb.bmWidth * 4);
  GetDIBits(_hcDC, _hBitmap, 0, dwY, lpBuf, b, DIB_RGB_COLORS);  for x := 1 to dwX do         //////////// 这里到底应该怎么输入每个像素点的颜色值啊？？？
    for y := 1 to dwY do       /// 难道是我的代码没翻译好？？？？？？？？？
      ListBox1.Items.Add(lpBuf[x, y]);  //输入每个像素点的颜色
  ReleaseDC(0, _hDC);
  DeleteDC(_hcDC);
  DeleteObject(_hBitmap);
  DeleteObject(hOld);
  HeapFree(hp, 0, lpBuf);
end;///////////////////////// 这里是重点了 /////////////////////////
查了资料后，才知道可以用GetDIBits这个API，但是用起来好复杂，
找到了C代码后，将它翻译成了Delphi代码，却不知道怎么将lpBuf里面的每个像素点输出了。
研究了整整2天，能查到的资料也非常少，跪求高手解决。
声明：不想用TBitmap，务必用GetDIBits解决，怎么搞？

Answer 1

  var dc : hdc;
      hBitmap : HBITMAP;
      i,j,FCurrX ,dstSize: integer;
      X,Y :integer; 
      Pix : byte; 
      lpBits : array of byte;
begin
  dc := getdc(0);
  X := GetSystemMetrics(SM_CXSCREEN); 
  Y := GetSystemMetrics(SM_CYSCREEN); 
  dstSize := X * Y * 3;
  setlength(lpBits ,dstSize);
  hBitmap := HBITMAP(Getcurrentobj(dc,OBJ_BITMAP));
  GetBitmap(hBitmap,dstSize,lpBits);
  for i := 0 to x -1 do
  begin
    FCurrX := i * X * 3;
    for j := 0 to Y - 1 do
    begin 
      Pix := RGB(lpBits[FCurrX + j * 3 + 2],lpBits[FCurrX + j * 3 + 1],lpBits[FCurrX + j * 3]); 
      ListBox1.items.add(inttostr(Pix)); 
    end; 
  end; 
  ReleaseDC(handle,dc);
end;未经测试

Answer 2

我只是告诉你怎么从一个DC上取到图像数据，至于你的DC是否正确，那就得你来调试了另外，更正一下程序

  for i := 0 to Y - 1 do
  begin
    FCurrX := i * X * 3;
    for j := 0 to X - 1 do
    begin 
      Pix := RGB(lpBits[FCurrX + j * 3 + 2],lpBits[FCurrX + j * 3 + 1],lpBits[FCurrX + j * 3]); 
      ListBox1.items.add(inttostr(Pix)); 
    end; 
  end;

Answer 3

取下屏幕截图，然后取图像的相素点，或者会快点。或者你用gdi+来操作。

Answer 4

var
  saveBitmap, Bitmap: HBITMAP;
  memDC: HDC;
  DC: HDC;
  bmi: TBitmapInfo;
  Buf: Pointer;
  p: PRGBTriple;
  Stride, Offset: Integer;
  x, y: Integer;
  w, h: Integer;
begin
  w := GetSystemMetrics(SM_CXSCREEN); 
  h := GetSystemMetrics(SM_CYSCREEN);
  Stride := ((w * 24 + 31) and $ffffffe0) shr 3;
  GetMem(Buf, h * Stride);
  try
    DC := GetDC(0);
    Bitmap := CreateCompatibleBitmap(DC, w, h);
    try
      memDC := CreateCompatibleDC(DC);
      saveBitmap := SelectObject(memDC, Bitmap);
      try
        BitBlt(memDC, 0, 0, w, h, DC, 0, 0, SRCCOPY);
      finally
        SelectObject(memDC, saveBitmap);
        DeleteDC(memDC);
      end;
      bmi.bmiHeader.biSize := Sizeof(TBitmapInfoHeader);
      bmi.bmiHeader.biWidth := w;
      bmi.bmiHeader.biHeight := h;
      bmi.bmiHeader.biPlanes := 1;
      bmi.bmiHeader.biBitCount := 24;
      bmi.bmiHeader.biCompression := BI_RGB;
      GetDIBits(DC, Bitmap, 0, h, Buf, bmi, DIB_RGB_COLORS);
    finally
      DeleteObject(Bitmap);
      ReleaseDC(0, DC);
    end;
  // 因为屏幕像素点数量在100万以上，下面这段代码可能造成程序没反应，如果要用这段代码测试一下，可把前面的w,h分别改为100
{
    Offset := Stride - bmi.bmiHeader.biWidth * 3;
    p := Buf;
    for y := 1 to h do
    begin
      for x := 1 to w do
      begin
         ListBox1.Items.Add(IntToStr(RGB(p^.rgbtRed, p^.rgbtGreen, p^.rgbtBlue)));
         Inc(p);
      end;
      Inc(Integer(p), Offset);
    end;
}
  finally
    FreeMem(Buf);
  end;
end;

Answer 5

这是几年前写的一个外挂的屏幕分析部分，用ScanLine很快
function TRxjh.ChongWu:Boolean;
var
  rowRGB :  pRGBQuadArray;
begin
  try
    FScreenPic2.FreeImage;
    BitBlt(FScreenPic2.Canvas.handle, 0, 0, 1, 1, FDC, 136, 55, SRCCOPY);
    rowRGB := FScreenPic2.ScanLine[0];
    Result := not((rowRGB[0].rgbGreen > $fa) and
                  (rowRGB[0].rgbRed   < $10) and
                  (rowRGB[0].rgbBlue  < $10));
  finally
  end;
end;

Answer 6

API也有是有函数可以处理的，只是代码多点，没有Scanline简单

Answer 7

var
  BitmapBits: ^TBitMapBits;
  //LoopRow,LoopCol:Integer;
  BmpInfo: BITMAP;
  bgColor: DWORD;
  b, g, r, offset: Integer;
  pxBytes: Integer;
  TempBmp: TBitmap;           //所有图元绘制的Bmp begin
    GetObject(TempBmp.Handle, SizeOf(BmpInfo), @BmpInfo);
    GetMem(BitmapBits, BmpInfo.bmHeight * BmpInfo.bmWidthBytes);
    GetBitmapBits(TempBmp.Handle, BmpInfo.bmHeight * BmpInfo.bmWidthBytes,
      BitmapBits);    pxBytes := BmpInfo.bmBitsPixel div 8;    i        := 1;
    while i <= TempBmp.Height do
    begin
      SameFlag := True;
      DifferentFlag := False;
      for j := 1 to TempBmp.Width do
      begin
        offset := i * BmpInfo.bmWidthBytes + j * pxBytes;
        b := BitMapBits[offset];
        g := BitMapBits[offset + 1];
        r := BitMapBits[offset + 2];
        bgColor := RGB(r, g, b);
      end;
      i := i + 1;
    end;
end;