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