Скриншот на Winapi

  • Автор темы nuclearpartizan
  • Дата начала
Статус
Закрыто для дальнейших ответов.
N

nuclearpartizan

Гость
#1
Делаю скриншот из своей программы таким образом:
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;
Все отлично работает. Но размер скрина получается ~1,5mb
Можно как-то уменьшить размер файла без использования модулей jpeg, graphics? Размер программы критичен.
 
Статус
Закрыто для дальнейших ответов.