Delphi - Gerar miniatura de imagem

Função que gera a miniatura:
procedure CreateThumbnail(InStream, OutStream: TStream;
  Width, Height: integer; FillColor: TColor);
var
  JpegImage: TJpegImage;
  Bitmap: TBitmap;
  Ratio: double;
  ARect: TRect;
  AHeight, AHeightOffset: integer;
  AWidth, AWidthOffset: integer;
begin
  // Check for invalid parameters
  if Width < 1 then
    raise Exception.Create('Invalid Width');
  if Height < 1 then
    raise Exception.Create('Invalid Height');
  JpegImage := TJpegImage.Create;
  try
    // Load the image
    JpegImage.LoadFromStream(InStream);
    // Create bitmap, and calculate parameters
    Bitmap := TBitmap.Create;
    try
      Ratio := JpegImage.Width / JpegImage.Height;
      if Ratio > 1 then
      begin
        AHeight := Round(Width / Ratio);
        AHeightOffset := (Height - AHeight) div 2;
        AWidth := Width;
        AWidthOffset := 0;
      end
      else
      begin
        AWidth := Round(Height * Ratio);
        AWidthOffset := (Width - AWidth) div 2;
        AHeight := Height;
        AHeightOffset := 0;
      end;
      Bitmap.Width := Width;
      Bitmap.Height := Height;
      Bitmap.Canvas.Brush.Color := FillColor;
      Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
      // StretchDraw original image
      ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset,
        AHeight + AHeightOffset);
      Bitmap.Canvas.StretchDraw(ARect, JpegImage);
      // Assign back to the Jpeg, and save to the file
      JpegImage.Assign(Bitmap);
      JpegImage.SaveToStream(OutStream);
    finally
      Bitmap.Free;
    end;
  finally
    JpegImage.Free;
  end;
end;

Como usar:
procedure MakeThumbnail(const InFileName, OutFileName: string;
  Width, Height: integer; FillColor: TColor);
var
  InStream, OutStream: TFileStream;
begin
  InStream := TFileStream.Create(InFileName, fmOpenRead);
  try
    OutStream := TFileStream.Create(OutFileName, fmOpenWrite or fmCreate);
    try
      CreateThumbnail(InStream, OutStream, Width, Height, FillColor);
    finally
      OutStream.Free;
    end;
  finally
    InStream.Free;
  end;
end;

Um comentário: