Создание эскиза для JPEG изображений

type
  TCharArray = array of Char;
  TRGBArray = array [Word] of TRGBTriple;
  pRGBArray = ^TRGBArray;

procedure SmoothResize(Src, Dst: TBitmap);
var
  x, y: Integer;
  xP, yP: Integer;
  xP2, yP2: Integer;
  SrcLine1, SrcLine2: pRGBArray;
  t3: Integer;
  z, z2, iz2: Integer;
  DstLine: pRGBArray;
  DstGap: Integer;
  w1, w2, w3, w4: Integer;
begin
  Src.PixelFormat := pf24Bit;
  Dst.PixelFormat := pf24Bit;

  if (Src.Width = Dst.Width) and (Src.Height = Dst.Height) then
    Dst.Assign(Src)
  else
  begin
    DstLine := Dst.ScanLine[0];
    DstGap := Integer(Dst.ScanLine[1]) - Integer(DstLine);

    xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width);
    yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height);
    yP := 0;

    for y := 0 to pred(Dst.Height) do
    begin
      xP := 0;

      SrcLine1 := Src.ScanLine[yP shr 16];

      if (yP shr 16 < pred(Src.Height)) then
        SrcLine2 := Src.ScanLine[succ(yP shr 16)]
      else
        SrcLine2 := Src.ScanLine[yP shr 16];

      z2 := succ(yP and $FFFF);
      iz2 := succ((not yP) and $FFFF);
      for x := 0 to pred(Dst.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; { for }
      Inc(yP, yP2);
      DstLine := pRGBArray(Integer(DstLine) + DstGap);
    end; { for }
  end; { if }
end; { SmoothResize }

procedure DrawScaledJPGImage(Source: TStream; Canvas: TCanvas; x, y, MaxWidth: Integer);
var
  OldBitmap: TBitmap;
  NewBitmap: TBitmap;
  aWidth: Integer;
  JPG: TJpegImage;
begin
  JPG := TJpegImage.Create;
  try
    Source.Position := 0;
    JPG.LoadFromStream(Source);
    OldBitmap := TBitmap.Create;
    try
      OldBitmap.Assign(JPG);
      aWidth := OldBitmap.Width;
      if (OldBitmap.Width > MaxWidth) then
      begin
        aWidth := MaxWidth;
        NewBitmap := TBitmap.Create;
        try
          NewBitmap.Width := MaxWidth;
          NewBitmap.Height := MulDiv(MaxWidth, OldBitmap.Height, OldBitmap.Width);
          SmoothResize(OldBitmap, NewBitmap);
          if NewBitmap.Height < 120 then
            Canvas.Draw(x, y + ((Canvas.ClipRect.Bottom - NewBitmap.Height) div 2), NewBitmap)
          else
            Canvas.Draw(x, y, NewBitmap);
        finally
          NewBitmap.Free;
        end;
      end;
    finally
      OldBitmap.Free;
    end;
  finally
    JPG.Free;
  end;
end;

procedure CreateThumbnail(ImageFileName: string; Stream: TMemoryStream);
var
  JPGStream: TMemoryStream;
  Thumbnail: TBitmap;
  JPG: TJpegImage;
begin
  JPGStream := TMemoryStream.Create;
  try
    JPGStream.LoadFromFile(ImageFileName);
    JPGStream.Position := 0;
    Thumbnail := TBitmap.Create;
    try
      Thumbnail.Width := 120;
      Thumbnail.Height := 120;
      DrawScaledJPGImage(JPGStream, Thumbnail.Canvas, 0, 0, Thumbnail.Width);
      JPG := TJpegImage.Create;
      try
        JPG.Assign(Thumbnail);
        JPG.SaveToStream(Stream);
      finally
        JPG.Free;
      end;
    finally
      Thumbnail.Free;
    end;
  finally
    JPGStream.Free;
  end;
end;