TMPJpegFileResizer = class(TObject)
  public
    // Изменить размер рисунка и сохранить.
    class procedure ResizeAndSave(
      // Изображение.
      const AImage: Graphics.TBitmap;
      // Имя файла (куда следует сохранить готовое изображение.)
      const AFileName: String;
      // Размер изображения.
      const ASize: Word;
      // Качество сохранения (по умолчанию 75).
      const AQuality: Word = 75);
  end;

// Модуль изменения размеров изображения.
unit MPJpegFileResizer;

interface

uses
  Graphics, Types;

type
  // Измерения изображения.
  TMPDimensions = TPoint;

  // Класс изменения размеров изображения.
  TMPJpegFileResizer = class(TObject)
  protected
    // Получить измерения изображения.
    class function GetDimensions(
      // Изображение.
      const AImage: Graphics.TBitmap;
      // Размер изображения.
      const ASize: Word): TMPDimensions;
    // Сохранить изображение в файл.
    class procedure SaveJPEGPictureFile(
      // Изображение.
      const AImage: Graphics.TBitmap;
      // Имя графического файла.
      const AFileName: String;
      // Качество сохранения изображения.
      const AQuality: Integer);
    // Установить размеры изображению.
    class procedure SetDimensions(
      // Изображение.
      const AImage: Graphics.TBitmap;
      // Размеры изображения.
      const ADimensions: TMPDimensions);
    // Выполнить ровное изменение размера.
    class procedure SmoothResize(
      // Исходное изображение.
      const ASourceImage: Graphics.TBitmap;
      // Конечное изображение.
      const ADestinationImage: Graphics.TBitmap);
  public
    // Изменить размер рисунка и сохранить.
    class procedure ResizeAndSave(
      // Изображение.
      const AImage: Graphics.TBitmap;
      // Имя файла (куда следует сохранить готовое изображение).
      const AFileName: String;
      // Размер изображения.
      const ASize: Word;
      // Качество сохранения (по умолчанию 75).
      const AQuality: Word = 75);
  end;

implementation

uses
  JPEG, SysUtils, Windows;

type
  // Массив цветовых составляющих.
  TRGBArray = array[Word] of TRGBTriple;
  // Указатель на массив цветовых составляющих.
  PRGBArray = ^TRGBArray;

{ TMPJpegFileResizer }

class function TMPJpegFileResizer.GetDimensions(const AImage: Graphics.TBitmap;
  const ASize: Word): TMPDimensions;
begin
  if AImage.Width > AImage.Height then
  begin
    Result.X := ASize;
    Result.Y := AImage.Height * ASize div AImage.Width;
  end
  else
  begin
    Result.X := AImage.Width * ASize div AImage.Height;
    Result.Y := ASize;
  end;
end;

class procedure TMPJpegFileResizer.ResizeAndSave(const AImage: Graphics.TBitmap;
  const AFileName: String; const ASize, AQuality: Word);
var
  NewImage: Graphics.TBitmap;
begin
  if (AImage.Width > ASize) or (AImage.Height > ASize) then
  begin
    NewImage := Graphics.TBitmap.Create;
    try
      TMPJpegFileResizer.SetDimensions(NewImage,
        TMPJpegFileResizer.GetDimensions(AImage, ASize));
      TMPJpegFileResizer.SmoothResize(AImage, NewImage);
      TMPJpegFileResizer.SaveJPEGPictureFile(NewImage, AFileName, AQuality);
    finally
      NewImage.Free;
    end;
  end;
end;

class procedure TMPJpegFileResizer.SaveJPEGPictureFile(
  const AImage: Graphics.TBitmap; const AFileName: String;
  const AQuality: Integer);
begin
  ForceDirectories(ExtractFilePath(AFileName));
  with TJPegImage.Create do
  begin
    try
      Assign(AImage);
      CompressionQuality := AQuality;
      SaveToFile(AFileName);
    finally
      Free;
    end;
  end;
end;

class procedure TMPJpegFileResizer.SetDimensions(const AImage: Graphics.TBitmap;
  const ADimensions: TMPDimensions);
begin
  AImage.Width := ADimensions.X;
  AImage.Height := ADimensions.Y;
end;

class procedure TMPJpegFileResizer.SmoothResize(const ASourceImage,
  ADestinationImage: Graphics.TBitmap);
var
  x, y, xP, yP, xP2, yP2, t3, z, z2, iz2, DstGap, w1, w2, w3, w4: Integer;
  SrcLine1, SrcLine2, DstLine: PRGBArray;
begin
  ASourceImage.PixelFormat := pf24Bit;
  ADestinationImage.PixelFormat := pf24Bit;
  if (ASourceImage.Width = ADestinationImage.Width) and
     (ASourceImage.Height = ADestinationImage.Height) then
    ADestinationImage.Assign(ASourceImage)
  else
  begin
    DstLine := ADestinationImage.ScanLine[0];
    DstGap  := Integer(ADestinationImage.ScanLine[1]) - Integer(DstLine);
    xP2 := MulDiv(Pred(ASourceImage.Width), $10000, ADestinationImage.Width);
    yP2 := MulDiv(Pred(ASourceImage.Height), $10000, ADestinationImage.Height);
    yP  := 0;
    for y := 0 to Pred(ADestinationImage.Height) do
    begin
      xP := 0;
      SrcLine1 := ASourceImage.ScanLine[yP shr 16];
      if (yP shr 16 < Pred(ASourceImage.Height)) then
        SrcLine2 := ASourceImage.ScanLine[Succ(yP shr 16)]
      else
        SrcLine2 := ASourceImage.ScanLine[yP shr 16];
      z2  := Succ(yP and $FFFF);
      iz2 := Succ((not yp) and $FFFF);
      for x := 0 to Pred(ADestinationImage.Width) do
      begin
        t3 := xP shr 16;
        z  := xP and $FFFF;
        w2 := MulDiv(z, iz2, $10000);
        w1 := iz2 - w2;
        w4 := MulDiv(z, z2, $10000);
        w3 := z2 - w4;
        DstLine[x].rgbtRed :=
          (SrcLine1[t3].rgbtRed * w1 + SrcLine1[t3 + 1].rgbtRed * w2 +
          SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16;
        DstLine[x].rgbtGreen :=
          (SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +
          SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;
        DstLine[x].rgbtBlue :=
          (SrcLine1[t3].rgbtBlue * w1 + SrcLine1[t3 + 1].rgbtBlue * w2 +
          SrcLine2[t3].rgbtBlue * w3 + SrcLine2[t3 + 1].rgbtBlue * w4) shr 16;
        Inc(xP, xP2);
      end;
      Inc(yP, yP2);
      DstLine := PRGBArray(Integer(DstLine) + DstGap);
    end;
  end;
end;

end.