Screen Capture with Pure Windows API

Post date: Mar 12, 2010 12:32:34 AM

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;