procedure CopyScreen(FileName:string);
var
widthscreen, heightscreen, i:Integer;
hdc1, dib, hdc, nb, hf:cardinal;
bmf:tagBITMAPINFO;
bmfh:tagBITMAPFILEHEADER;
adr
ointer;
buf:byte;
buff:array of byte;
str:_OFSTRUCT;
begin
widthscreen:=GetSystemMetrics(SM_CXSCREEN);//ширина экрана
heightscreen:=GetSystemMetrics(SM_CYSCREEN);//высота экрана
hdc:=GetDC(0);//контекст экрана
hdc1:=CreateCompatibleDC(hdc);//совместимый контекст
bmf.bmiHeader.biSize:=SizeOf(bmf.bmiHeader);
bmf.bmiHeader.biWidth:=widthscreen;
bmf.bmiHeader.biHeight:=heightscreen;
bmf.bmiHeader.biPlanes:=1;
bmf.bmiHeader.biBitCount:=24;
bmf.bmiHeader.biCompression:=BI_RGB;
bmf.bmiHeader.biSizeImage:=((widthscreen*3+3) and $FFFFFFFC)*heightscreen;
dib:=CreateDibSection(hdc1, bmf, DIB_RGB_COLORS, adr, 0, 0);
SelectObject(hdc1, dib);
BitBlt(hdc1, 0, 0, widthscreen, heightscreen, hdc, 0, 0, SRCCOPY);
bmfh.bfType:=$4D42;
bmfh.bfSize:=SizeOf(bmfh)+40+bmf.bmiHeader.biSizeImage;
bmfh.bfOffBits:=SizeOf(bmfh)+40;
SetLength(buff, bmf.bmiHeader.biSizeImage);
GetDiBits(hdc1, dib, 1, heightscreen, @buff[0], bmf, DIB_PAL_COLORS);
hf:=OpenFile(PChar(FileName), str, OF_CREATE or OF_READWRITE);
WriteFile(hf, bmfh.bfType, 2, nb, nil);
WriteFile(hf, bmfh.bfSize, 4, nb, nil);
buf:=0;
For i:=1 to 4 do
WriteFile(hf, buf, 1, nb, nil);
WriteFile(hf, bmfh.bfOffBits, 4, nb, nil);
WriteFile(hf, bmf.bmiHeader.biSize, 4, nb, nil);
WriteFile(hf, bmf.bmiHeader.biWidth, 4, nb, nil);
WriteFile(hf, bmf.bmiHeader.biHeight, 4, nb, nil);
WriteFile(hf, bmf.bmiHeader.biPlanes, 2, nb, nil);
WriteFile(hf, bmf.bmiHeader.biBitCount, 2, nb, nil);
WriteFile(hf, bmf.bmiHeader.biCompression, 4, nb, nil);
WriteFile(hf, bmf.bmiHeader.biSizeImage, 4, nb, nil);
For i:=1 to 16 do
WriteFile(hf, buf, 1, nb, nil);
WriteFile(hf, buff[0], bmf.bmiHeader.biSizeImage, nb, nil);
buff:=nil;
CloseHandle(hf);
DeleteObject(hdc1);
DeleteObject(dib);
end;