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;
mais ai é spo mais uma procedure
ResponderExcluir