Вот рабочий вариант:
| Код |
program Project1;
uses
Windows;
procedure ScreenShot(const Width, Height: LongInt; const Filename: string);
var
Bih: TBitmapInfoHeader;
Bfh: TBitmapFileHeader;
CDC, DC: HDC;
CBmp: HBitMap;
Bmp: Pointer;
BmpInfo: TBitMapInfo;
F, Size, Written: LongWord;
begin
DC := GetDC(0);
CDC := CreateCompatibleDC(DC);
Bih.biSize := SizeOf(TBitmapInfoHeader);
Bih.biWidth := Width;
Bih.biHeight := Height;
Bih.biPlanes := 1;
Bih.biBitCount := GetDeviceCaps(DC, BITSPIXEL) * GetDeviceCaps(DC, PLANES);
if Bih.biBitCount = 32 then Bih.biBitCount := 24;
Size := 3 * Width * Height;
Bfh.bfType := $4D42;
Bfh.bfOffBits := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader);
BmpInfo.bmiHeader := Bih;
CBmp := CreateDIBSection(DC, BmpInfo, 0, Bmp, 0, 0);
SelectObject(CDC, CBmp);
StretchBlt(CDC, 0, 0, Width, Height, DC, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), SRCCOPY);
F := CreateFile(PChar(Filename), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, 0, 0);
WriteFile(F, Bfh, SizeOf(TBitmapFileHeader), Written, nil);
WriteFile(F, Bih, SizeOf(TBitmapInfoHeader), Written, nil);
WriteFile(F, Bmp^, Size, Written, nil);
CloseHandle(F);
end;
begin
ScreenShot(1024,768,'file.bmp');
end.
|
|