1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:

function Bitmap2Ddb( hbitmap: HBITMAP; bits: longword ): THANDLE;
var
  hdib: THANDLE;
  ahdc: HDC;
  bitmap: windows.TBITMAP;
  wLineLen,
  wColSize: DWORD;
  dwSize: DWORD;
  lpbi: PBITMAPINFOHEADER;
  lpBits: PBYTE;
begin
  GetObject(hbitmap,sizeof(BITMAP),@bitmap) ;

  // DWORD align the width of the DIB
  // Figure out the size of the colour table
  // Calculate the size of the DIB
  //
  wLineLen := (bitmap.bmWidth*integer(bits)+31)div 32 * 4;
  if (bits <= 8) then wColSize:=sizeof(RGBQUAD)* (1 SHL bits)
    else wColSize:=0;
  dwSize := sizeof(BITMAPINFOHEADER) + wColSize +
    wLineLen*bitmap.bmHeight;

  //
  // Allocate room for a DIB and set the LPBI fields
  //
  hdib := GlobalAlloc(GHND,dwSize); //allocate bitmap handle
  if (hdib=0) then
  begin
    result:=hdib;
    exit;
  end;

  lpbi := GlobalLock(hdib) ;  // lock bitmap handle and get back pointer

  lpbi^.biSize := sizeof(BITMAPINFOHEADER) ;
  lpbi^.biWidth := bitmap.bmWidth ;
  lpbi^.biHeight := bitmap.bmHeight ;
  lpbi^.biPlanes := 1 ;
  lpbi^.biBitCount := bits ;
  lpbi^.biCompression := BI_RGB ;
  lpbi^.biSizeImage := dwSize - sizeof(BITMAPINFOHEADER) - wColSize ;
  lpbi^.biXPelsPerMeter := 0 ;
  lpbi^.biYPelsPerMeter := 0 ;
  if bits <= 8 then lpbi^.biClrUsed := 1 SHL bits
    else lpbi^.biClrUsed:=0;
  lpbi^.biClrImportant := 0 ;

  //
  // Get the bits from the bitmap and stuff them after the LPBI
  //
  lpBits := pointer(longword(lpbi)+lpbi^.biSize+wColSize) ;

  ahdc := CreateCompatibleDC(0) ;

  // retrieve the bits of hbitmap and copy them into the buffer lpBits using the specified format in lpbi
  if GetDIBits(ahdc,hbitmap,0,bitmap.bmHeight,lpBits,PBITMAPINFO(lpbi)^, DIB_RGB_COLORS) = 0 then
  begin
    messagebox(0, 'Error retrieving bitmap bits', 'Error', mb_ok);
  end;

  if bits <= 8 then  lpbi^.biClrUsed := (1 SHL bits)
    else lpbi^.biClrUsed:=0;

  DeleteDC(ahdc) ;
  GlobalUnlock(hdib);

  result:=hdib ;
end;


function TScreenCam.captureScreenFrame(left, top, width, height: integer): PBITMAPINFOHEADER;
var
  hScreenDC: HDC;
  hMemDC: HDC;
  hbm: HBITMAP;
  oldbm: HBITMAP;
  pBM_HEADER: PBITMAPINFOHEADER;
  xpoint: TPOINT;
  hcur: HCURSOR;
  aniconinfo: ICONINFO;
  ret: BOOL;
begin
  hScreenDC:=CreateDC('DISPLAY',nil,nil,nil);
  hMemDC:=CreateCompatibleDC(hScreenDC);
  hbm := CreateCompatibleBitmap(hScreenDC, width, height);
  try
    oldbm := SelectObject(hMemDC, hbm);
    BitBlt(hMemDC, 0, 0, width, height, hScreenDC, left, top, SRCCOPY); // bit block transfer from  hScreenDC to hMemdc

    //Get Cursor Pos
    GetCursorPos( xPoint );
    hcur:= windows.getCursor;
    dec(xPoint.x, left);
    dec(xPoint.y, top);

    //Draw the Cursor
    if (FrecordCursor) then
    begin
      ret  := GetIconInfo( hcur,  aniconinfo );
      if (ret) then
      begin
        dec(xPoint.x, aniconinfo.xHotspot);
        dec(xPoint.y, aniconinfo.yHotspot);

        //need to delete the hbmMask and hbmColor bitmaps
        //otherwise the program will crash after a while after running out of resource
        if (aniconinfo.hbmMask <> 0) then DeleteObject(aniconinfo.hbmMask);
        if (aniconinfo.hbmColor <> 0) then DeleteObject(aniconinfo.hbmColor);
      end;
      DrawIcon( hMemDC,  xPoint.x,  xPoint.y, fcursor); // hcur
    end;

    SelectObject(hMemDC,oldbm);
    pBM_HEADER := GlobalLock(Bitmap2Ddb(hbm, bits));  // lock bitmap handle and get pointer
    //LPBITMAPINFOHEADER pBM_HEADER = (LPBITMAPINFOHEADER)GlobalLock(Bitmap2Dib(hbm, 24));
    if (pBM_HEADER = NIL) then
    begin
      MessageBox(0,'Error capturing a frame!','Error',MB_OK OR MB_ICONEXCLAMATION);
      result:=NIL; exit;
    end;
  finally
    DeleteObject(hbm);
    DeleteDC(hMemDC);

    DeleteDC(hScreenDC) ;
  end;
  result:=pBM_HEADER;
end;