03.03.2015, 18:20
|
Прохожий
|
|
Регистрация: 03.03.2010
Сообщения: 13
Репутация: 10
|
|
Уменьшить масштаб изображения
Необходимо уменьшить масштаб полученного снимка с минимальными потерями качества.
Результат: масштаб был уменьшен с помощью функции ResizeBitmap - качество изображения изменилось с худшим результатом:
Качество изображения без функции нормальное, но масштаб 1366х768:
Прошу помочь разобраться с уменьшением масштаба изображения с минимальными потерями в качества.
Код:
uses Jpeg;
function ResizeBitmap(BmpIn : TBitmap; NewWidth, NewHeight : Integer) : TBitmap;
begin
Result := TBitmap.Create;
try
Result.Width := NewWidth;
Result.Height := NewHeight;
Result.PixelFormat := BmpIn.PixelFormat;
Result.Canvas.StretchDraw(Rect(0, 0, Result.Width, Result.Height), BmpIn);
except
Result.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
JpegIm: TJpegImage;
bm: TBitMap;
ScrJpg : String;
begin
ScrJpg := 'screenshot.jpg';
DeleteFile(ScrJpg);
bm := TBitMap.Create;
bm.Width := Screen.Width;
bm.Height := Screen.Height;
BitBlt(bm.Canvas.Handle, 0, 0, bm.Width, bm.Height, GetDC(0), 0, 0, SRCCOPY);
bm := ResizeBitmap(bm, 1280, 720);
JpegIm := TJpegImage.Create;
JpegIm.Assign(bm);
JpegIm.CompressionQuality := 90;
JpegIm.Compress;
JpegIm.SaveToFile(ScrJpg);
bm.Destroy;
JpegIm.Destroy;
Form1.Close;
end;
|