Уменьшить картинку - Есть изображение каких-то там размеров. Нужно уменьшить его вдвое по всем параметрам. процедура уменьшает размер картинки (jpg) в два раза

[Kronos913]

Добрый день
Задача такая:

Есть изображение каких-то там размеров. Нужно уменьшить его вдвое по всем параметрам, потому что занимает уж слишком много места, очень долго загружается, а такая четкость не нужна

[northener]

Что значит "есть изображение каких-то там размеров"?

[Arigato]

Набросал пример, процедура уменьшает размер картинки (jpg) в два раза, при этом можно поиграться с параметром "степень сжатия", чтобы сделать файл еще меньше:

uses JPEG;

procedure HalveImage(const SourceFileName, DestFileName: string);
var
  jpg: TJPEGImage;
  bmp, bmp2: TBitMap;
  Rect: TRect;
begin
  jpg := TJPEGImage.Create;
  jpg.LoadFromFile(SourceFileName);
  bmp := TBitmap.Create;
  bmp.Assign(jpg);
  bmp2 := TBitMap.Create;
  bmp2.Width := bmp.Width div 2;
  bmp2.Height := bmp.Height div 2;
  with Rect do begin
    Left := 0;
    Top := 0;
    Right := bmp2.Width;
    Bottom := bmp2.Height;
  end;
  bmp2.Canvas.StretchDraw(Rect, bmp);
  bmp.Free;
  jpg.Assign(bmp2);
  bmp2.Free;
  // степень сжатия (1..100), чем меньше, тем компактнее файл
  jpg.CompressionQuality := 70;
  jpg.SaveToFile(DestFileName);
  jpg.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  HalveImage('1.jpg', '2.jpg');
  ShowMessage('ok');
end;