Procedure screenshot (shot:string);var dibH:hBitmap; bits:pointer; info:TBITMAPINFO; width,height:integer; screenDC,dibDC:hDC; f:file of byte; FileHeader:TBITMAPFILEHEADER; begin &NBSP;SCREENDC: = GetDC (GetDesktopWindow); &NBSP;DIBDC: = CreateCompatibleDC (SCREENDC); width: = GetDeviceCaps (screendc,horzres); height: = GetDeviceCaps (screendc,vertres); Info.bmiHeader.biXPelsPerMeter: = Round (GetDeviceCaps (screendc,logpixelsx) *39.37); Info.bmiHeader.biYPelsPerMeter: = Round (GetDeviceCaps (screendc,logpixelsy) *39.37); zeromemory (@ Info,sizeof (info)); with info.bmiheader do begin Bisize: = SizeOf (tbitmapinfoheader); Biwidth: = width; Biheight: = height; biplanes: = 1; biBitCount: = 24; bicompression: = bi_rgb; end; &NB Sp;dibh: = CreateDIBSection (dibdc,info,dib_rgb_colors,bits,0,0); selectobject (DibDC,dibH); bitblt ( dibdc, 0,0,WID th,height, screendc, 0,0, &NB Sp srccopy); releasedc (GETDESKTOPWINDOW,SCREENDC); assignfile (f,shot); rewrite (f); if width and 3 <> 0 then width: = (width div 4) +1); with fileheader do begin Bfty PE: = Ord (' B ') + (ord (' M ') SHL 8);   Bfsize: = SizeOf (Tbitmapfileheader) +sizeof (tbitmapinfoheader) +width*height*3; Bfoffbits: = SizeOf (tbitmapinfoheader); end; blockwrite (F, Fileheader,sizeof (Tbitmapfileheader)); blockwrite (f,info.bmiheader,sizeof (TBITMAPINFOHEADER)) ; blockwrite (f,bits^,width*height*3); closefile (f); DeleteObject (Dibh); deletedc (DIBDC); end;
Grab screen images with API functions