unit BonMarGrafica;
{$mode objfpc}{$H+}
interface
uses
Graphics, ExtCtrls, Sysutils, FileUtil, Classes;
procedure ResizeImage(WrkPicInp:TPicture; var WrkPicOut:TPicture; aWidth, aHeight:Integer);
implementation
{Ridimensionamento di un'immagine
Tratto da qui: http://forum.lazarus.freepascal.org/index.php/topic,8282.msg39786.html#msg39786}
procedure ResizeImage(WrkPicInp:TPicture; var WrkPicOut:TPicture; aWidth, aHeight:Integer);
var Bmp:TBitmap;
RectPart, RectDest, RectResized:TRect;
WrkPropWidth, WrkPropHeight:Integer;
begin
//Calcolo i valori che serviranno per ridimensionare l'immagine in larghezza
if (WrkPicInp.Bitmap.Width > aWidth) then begin
//Se l'immagine deve essere rimpicciolita ...
WrkPicOut.Bitmap.Width:=WrkPicInp.Bitmap.Width;
WrkPropWidth:=Round(WrkPicInp.Bitmap.Width * WrkPicInp.Bitmap.Width / aWidth);
end else begin
//Se l'immagine deve essere ingrandita ...
WrkPicOut.Bitmap.Width:=aWidth;
WrkPropWidth:=Round(WrkPicInp.Bitmap.Width);
end;
//Calcolo i valori che serviranno per ridimensionare l'immagine in altezza
if (WrkPicInp.Bitmap.Height > aHeight) then begin
//Se l'immagine deve essere rimpicciolita ...
WrkPicOut.Bitmap.Height:=WrkPicInp.Bitmap.Height;
WrkPropHeight:=Round(WrkPicInp.Bitmap.Height * WrkPicInp.Bitmap.Height / aHeight);
end else begin
//Se l'immagine deve essere ingrandita ...
WrkPicOut.Bitmap.Height:=aHeight;
WrkPropHeight:=Round(WrkPicInp.Bitmap.Height);
end;
//Ora che ho tutto ciò che mi serve, posso fare il ridimensionamento vero e proprio
Bmp:=TBitmap.Create;
try
Bmp.Width:=WrkPropWidth;
Bmp.Height:=WrkPropHeight;
RectPart:=Rect(0, 0, WrkPicInp.Bitmap.Width, WrkPicInp.Bitmap.Height);
RectDest:=Rect(0, 0, WrkPicInp.Bitmap.Width, WrkPicInp.Bitmap.Height);
Bmp.Canvas.CopyRect(RectPart, WrkPicInp.Bitmap.Canvas, RectDest);
WrkPicOut.Bitmap.SetSize(WrkPicOut.Bitmap.Width, WrkPicOut.Bitmap.Height);
RectResized:=Rect(0, 0, WrkPicOut.Bitmap.Width, WrkPicOut.Bitmap.Height);
WrkPicOut.Bitmap.Canvas.StretchDraw(RectResized, Bmp);
//Se l'immagine è stata rimpicciolita, la parte che eccede le dimensioni finali è tutta nera.
//Esempio: immagine originale 200 * 200, io ho scelto di farla diventare
// 50 * 50. A questo punto ho un'immagine di dimensione 200 * 200,
// con l'immagine rimpicciolita che occupa i primi 50 * 50 pixel. Il
// resto dell'immagine è tutto nero.
//Faccio in modo di salvare solo la porzione di immagine che serve a me (Nell'esempio
//qui sopra, 50 * 50)
RectPart:=Rect(0, 0, aWidth, aHeight);
RectDest:=RectPart;
Bmp.Width:=aWidth;
Bmp.Height:=aHeight;
Bmp.Canvas.CopyRect(RectPart, WrkPicOut.Bitmap.Canvas, RectDest);
WrkPicOut.Bitmap.SetSize(aWidth, aHeight);
WrkPicOut.Bitmap.Assign(Bmp);
//Rendo trasparente lo sfondo finale dell'immagine, che altrimenti sarebbe nero
//WrkPicOut.Bitmap.Transparent:=False;
WrkPicOut.Bitmap.TransparentMode:=tmFixed;
finally
FreeAndNil(Bmp);
end;
end;
end.