Resize a JPEG image. (re-post)

[nostrad...@yahoo.com]

Use the following 'smooth bitmap resize'. Gives better results than
stretchdraw.

- Hide quoted text -
- Show quoted text -
Ken White wrote:

> Korpela Asko,

> > I have digital photos size 1024x768 and would like to
> > resize pictures permanently for web use to 800x600.
> > How should I do it? On screen I can stretch pictures
> > at will, but there is no saving property to use.

> What format are the pictures in? If they're Delphi-compatible images
> (Bitmap, Jpeg, etc.) it's very easy.

> Let's presume that they're JPEGs. Add 'Jpeg' to your uses clause. (Watch
> out for wrap in the code below.)

> procedure TForm1.Button1Click(Sender: TObject);
> var
> Bmp: TBitmap;
> Jpg : TJpegImage;
> begin
> Jpg := TJpegImage.Create;
> try
> Jpg.LoadFromFile( YourImageFile );
> Bmp := TBitmap.Create;
> try

Bmp.Width:= 1024;
Bmp.Height:= 768;
> Bmp.Draw(0,0,Jpeg );

SmoothResize(Bmp,800,600);

> Jpg.Assign( Bmp );
> Jpg.SaveToFile( YourSmallerImageFile );
> finally
> Bmp.Free;
> end;
> finally
> Jpg.Free;
> end;
> end;

type
TRGBArray = ARRAY[0..32767] OF TRGBTriple;
pRGBArray = ^TRGBArray;

procedure TForm1.SmoothResize(abmp:TBitmap; NuWidth,NuHeight:integer);
var
xscale, yscale : Single;
sfrom_y, sfrom_x : Single;
ifrom_y, ifrom_x : Integer;
to_y, to_x : Integer;
weight_x, weight_y : array[0..1] of Single;
weight : Single;
new_red, new_green : Integer;
new_blue : Integer;
total_red, total_green : Single;
total_blue : Single;
ix, iy : Integer;
bTmp : TBitmap;
sli, slo : pRGBArray;
begin
abmp.PixelFormat := pf24bit;
bTmp := TBitmap.Create;
bTmp.PixelFormat := pf24bit;
bTmp.Width := NuWidth;
bTmp.Height := NuHeight;
xscale := bTmp.Width / (abmp.Width-1);
yscale := bTmp.Height / (abmp.Height-1);
for to_y := 0 to bTmp.Height-1 do begin
sfrom_y := to_y / yscale;
ifrom_y := Trunc(sfrom_y);
weight_y[1] := sfrom_y - ifrom_y;
weight_y[0] := 1 - weight_y[1];
for to_x := 0 to bTmp.Width-1 do begin
sfrom_x := to_x / xscale;
ifrom_x := Trunc(sfrom_x);
weight_x[1] := sfrom_x - ifrom_x;
weight_x[0] := 1 - weight_x[1];
total_red := 0.0;
total_green := 0.0;
total_blue := 0.0;
for ix := 0 to 1 do begin
for iy := 0 to 1 do begin
sli := abmp.Scanline[ifrom_y + iy];
new_red := sli[ifrom_x + ix].rgbtRed;
new_green := sli[ifrom_x + ix].rgbtGreen;
new_blue := sli[ifrom_x + ix].rgbtBlue;
weight := weight_x[ix] * weight_y[iy];
total_red := total_red + new_red * weight;
total_green := total_green + new_green * weight;
total_blue := total_blue + new_blue * weight;
end;
end;
slo := bTmp.ScanLine[to_y];
slo[to_x].rgbtRed := Round(total_red);
slo[to_x].rgbtGreen := Round(total_green);
slo[to_x].rgbtBlue := Round(total_blue);
end;
end;
abmp.Width := bTmp.Width;
abmp.Height := bTmp.Height;
abmp.Canvas.Draw(0,0,bTmp);
bTmp.Free;
end;

--
Charles Hacker
Lecturer in Electronics and Computing
School of Engineering
Griffith University - Gold Coast
Australia

Hi Charles Hacker.

I am using your SmoothResize to resize a bitmap (which has Jpeg data
on it's canvas) resize and it works unbelievably well. Thanks!

Regards,
Notra Damus

[Vlad Mad]

пятница, 8 августа 2008 г. в 21:22:38 UTC+2, nostrad...@yahoo.com:

Hi all, thank you for the contribution to public.
I used this code and observed some performance issues, so I suggest the fix, which makes it run almost 10 times faster, move ScanLine to the outer loop only:
procedure SmoothResize(abmp:TBitmap; NuWidth,NuHeight:integer);

type
TRGBArray = ARRAY[0..32767] OF TRGBTriple;
pRGBArray = ^TRGBArray;

var
xscale, yscale : Single;
sfrom_y, sfrom_x : Single;
ifrom_y, ifrom_x : Integer;
to_y, to_x : Integer;
weight_x, weight_y : array[0..1] of Single;
weight : Single;
new_red, new_green : Integer;
new_blue : Integer;
total_red, total_green : Single;
total_blue : Single;
ix, iy : Integer;
bTmp : TBitmap;
sli, slo : pRGBArray;

slArray: array[0..1] of pRGBArray;

begin
abmp.PixelFormat := pf24bit;
bTmp := TBitmap.Create;
bTmp.PixelFormat := pf24bit;
bTmp.Width := NuWidth;
bTmp.Height := NuHeight;
xscale := bTmp.Width / (abmp.Width-1);
yscale := bTmp.Height / (abmp.Height-1);
for to_y := 0 to bTmp.Height-1 do
begin
sfrom_y := to_y / yscale;
ifrom_y := Trunc(sfrom_y);
weight_y[1] := sfrom_y - ifrom_y;
weight_y[0] := 1 - weight_y[1];

slArray[0] := abmp.Scanline[ifrom_y];
slArray[1] := abmp.Scanline[ifrom_y + 1];
slo := bTmp.ScanLine[to_y];

for to_x := 0 to bTmp.Width-1 do
begin
sfrom_x := to_x / xscale;
ifrom_x := Trunc(sfrom_x);
weight_x[1] := sfrom_x - ifrom_x;
weight_x[0] := 1 - weight_x[1];
total_red := 0.0;
total_green := 0.0;
total_blue := 0.0;
for ix := 0 to 1 do

for iy := 0 to 1 do
begin

sli := slArray[iy];

new_red := sli[ifrom_x + ix].rgbtRed;
new_green := sli[ifrom_x + ix].rgbtGreen;
new_blue := sli[ifrom_x + ix].rgbtBlue;
weight := weight_x[ix] * weight_y[iy];
total_red := total_red + new_red * weight;
total_green := total_green + new_green * weight;
total_blue := total_blue + new_blue * weight;
end;

slo[to_x].rgbtRed := Trunc(total_red);
slo[to_x].rgbtGreen := Trunc(total_green);
slo[to_x].rgbtBlue := Trunc(total_blue);