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;