Screen Capture with Pure Windows API

posted 11 Mar 2010, 16:32 by Delphi Basics   [ updated 11 Mar 2010, 16:46 ]
The generic method of programmatically capturing the screen results in a large executable size.  By employing one of the techniques discussed in this tutorial, Small Applications in Delphi - Tutorial by n0v4 and only using Windows API calls in the procedure, we can reduce the size of the final executable.

uses
 Windows;

procedure Screenshot(shot: string);
 var
  dibH : hBitmap;
  bits : pointer;
  info : TBITMAPINFO;
  width,height : integer;
  screenDC,dibDC : hDC;
  f : file of byte;
  FileHeader : TBITMAPFILEHEADER;
begin
    screenDC := getDC(getDeskTopWindow);
    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;
    dibH := createDIBSection(dibDC,info,DIB_RGB_COLORS,bits,0,0);
    selectObject(dibDC,dibH);
    bitblt(
           dibDC,
           0,0,width,height,
           screenDC,
           0,0,
           SRCCOPY);
    releaseDC(getDeskTopWindow,screenDC);
    assignFile(f,shot);
    reWrite(f);

    if width and 3 <> 0 then
       width := 4*((width div 4)+1);

    with fileHeader do
    begin
         bfType := 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;

To use in a form:

procedure TForm1.Button1Click(Sender: TObject);
var
  shot:string;
begin
   shot:='shot.jpg';
   screenshot(shot);
end;
Comments