PDA

View Full Version : Image shrink by pixel averaging



peterbone
14-06-2004, 11:51 AM
Hi

I need a procedure that will shrink a bitmap using pixel averaging for best quality. I have written one myself (below) but I'm sure it can be speeded up and also it doesn't take into account sub-pixels. Can anyone point me to some code? Thanks


procedure Shrink(ARatio : Real ; ABitmap : TBitmap ; var ABitmapOut : TBitmap);
Var
Lx, Ly : integer;
LyBox, LxBox : integer;
TR, TG, TB : integer;
avR, avG, avB : integer;
LRowIn, LRowOut : pRGBTripleArray;
LBoxCount : integer;
LScanLineBytes : integer;
begin
LRowOut := ABitmapOut.ScanLine[0];
LScanLineBytes := Integer(ABitmapOut.Scanline[1]) - Integer(LRowOut);
for Ly := 0 to ABitmapOut.Height-1 do begin
for Lx := 0 to ABitmapOut.Width-1 do begin

TR := 0; TG := 0; TB := 0;
LBoxCount := 0;
for LyBox := trunc(Ly*ARatio) to trunc((Ly+1)*ARatio) - 1 do begin
LRowIn := ABitmap.ScanLine[LyBox];
for LxBox := trunc(Lx*ARatio) to trunc((Lx+1)*ARatio) - 1 do begin
TR := TR + LRowIn[LxBox].rgbtRed;
TG := TG + LRowIn[LxBox].rgbtGreen;
TB := TB + LRowIn[LxBox].rgbtBlue;
Inc(LBoxCount);
end;
end;

avR := TR div LBoxCount;
avG := TG div LBoxCount;
avB := TB div LBoxCount;
LRowOut[Lx].rgbtBlue := avB;
LRowOut[Lx].rgbtGreen := avG;
LRowOut[Lx].rgbtRed := avR;
end;
Inc(Integer(LRowOut), LScanLineBytes);
end;
end;

Peter

Traveler
14-06-2004, 12:11 PM
I wanted to try your code but recieved an error on pRGBTripleArray.
Does it require D7? I've tried it using D5.

peterbone
14-06-2004, 01:21 PM
Sorry, I forgot to put those types in

TRGBTripleArray = array[0..100000] of TRGBTriple;
PRGBTripleArray = ^TRGBTripleArray;

I've now made the algorithm much faster by holding the lines for each box in an array which cuts down the number of scanline calls a lot

procedure Shrink(ARatio : Real ; ABitmap, ABitmapOut : TBitmap);
Var
Lx, Ly : integer;
LyBox, LxBox, LyBox1, LyBox2, LxBox1, LxBox2 : integer;
TR, TG, TB : integer;
avR, avG, avB : integer;
LRowIn, LRowOut : pRGBTripleArray;
LBoxCount : integer;
LRowBytes : integer;
LBoxRows : array of pRGBTripleArray;
begin
SetLength(LBoxRows, trunc(ARatio)+1);

LRowOut := ABitmapOut.ScanLine[0];
LRowBytes := Integer(ABitmapOut.Scanline[1]) - Integer(LRowOut);
for Ly := 0 to ABitmapOut.Height-1 do begin

LyBox1 := trunc(Ly*ARatio);
LyBox2 := trunc((Ly+1)*ARatio) - 1;

for LyBox := LyBox1 to LyBox2 do
LBoxRows[LyBox-LyBox1] := ABitmap.ScanLine[LyBox];

for Lx := 0 to ABitmapOut.Width-1 do begin

LxBox1 := trunc(Lx*ARatio);
LxBox2 := trunc((Lx+1)*ARatio) - 1;

TR := 0; TG := 0; TB := 0;
LBoxCount := 0;
for LyBox := LyBox1 to LyBox2 do begin
LRowIn := LBoxRows[LyBox-LyBox1];
for LxBox := LxBox1 to LxBox2 do begin
TR := TR + LRowIn[LxBox].rgbtRed;
TG := TG + LRowIn[LxBox].rgbtGreen;
TB := TB + LRowIn[LxBox].rgbtBlue;
Inc(LBoxCount);
end;
end;

avR := TR div LBoxCount;
avG := TG div LBoxCount;
avB := TB div LBoxCount;
LRowOut[Lx].rgbtBlue := avB;
LRowOut[Lx].rgbtGreen := avG;
LRowOut[Lx].rgbtRed := avR;

end;
Inc(Integer(LRowOut), LRowBytes);
end;
end;

I'm amazed at how much this has speeded it up. It's now about 50 times faster! So it looks like I've solved my problem but this thread wasn't a complete waste because you can now use my code.

Peter

Harry Hunt
14-06-2004, 03:30 PM
const
MaxPixelCount = 65536;

type
TRGBArray = array[0..MaxPixelCount - 1] of TRGBTriple;
pRGBArray = ^TRGBArray;

procedure Resample(SourceBitmap, DestBitmap: TBitmap);
var
x,y,xP,yP,
yP2,xP2: Integer;
SourceRow, SourceRow2, DestRow: pRGBArray;
t,z,z2,iz2: Integer;
pc: TRGBTriple;
w1,w2,w3,w4: Integer;
Col1,Col2: TRGBTriple;
begin
if (DestBitmap.Width < 1) or (DestBitmap.Height < 1) then
Exit;
if(DestBitmap.Width = SourceBitmap.Width) and (DestBitmap.Height =
SourceBitmap.Height) then
begin
BitBlt(DestBitmap.Canvas.Handle, 0, 0, DestBitmap.Width, DestBitmap.Height,
SourceBitmap.Canvas.Handle, 0, 0, SRCCOPY);
Exit;
end;
xP2 := ((SourceBitmap.Width - 1) shl 15) div DestBitmap.Width;
yP2 := ((SourceBitmap.Height - 1) shl 15) div DestBitmap.Height;
yP := 0;
for y := 0 to DestBitmap.Height - 1 do
begin
xP := 0;
SourceRow := SourceBitmap.ScanLine[yP shr 15];
if yP shr 16 < SourceBitmap.Height - 1 then
SourceRow2 := SourceBitmap.ScanLine[yP shr 15 + 1]
else
SourceRow2 := SourceBitmap.ScanLine[yP shr 15];
z2 := yP and $7FFF;
iz2 := $8000 - z2;
DestRow := DestBitmap.ScanLine[Y];
for x := 0 to DestBitmap.Width - 1 do
begin
t := xP shr 15;
Col1 := SourceRow[t];
Col2 := SourceRow2[t];
z := xP and $7FFF;
w2 := (z * iz2) shr 15;
w1 := iz2 - w2;
w4 := (z * z2) shr 15;
w3 := z2 - w4;
pc.rgbtBlue:= (Col1.rgbtBlue * w1 + SourceRow[T + 1].rgbtBlue * w2 +
Col2.rgbtBlue * w3 + SourceRow2[T + 1].rgbtBlue * w4) shr 15;
pc.rgbtGreen:= (Col1.rgbtGreen * w1 + SourceRow[T + 1].rgbtGreen * w2 +
Col2.rgbtGreen * w3 + SourceRow2[T + 1].rgbtGreen * w4) shr 15;
pc.rgbtRed:= (Col1.rgbtRed * w1 + SourceRow[T + 1].rgbtRed * w2 +
Col2.rgbtRed * w3 + SourceRow2[T + 1].rgbtRed * w4) shr 15;
DestRow[X] := PC;
Inc(xP, xP2);
end;
Inc(yP, yP2);
end;
end;


This is a routine for bilinear resample. I didn't write it (That's why it's so poorly formatted :lol:), but It's pretty fast and gives you great results.

peterbone
14-06-2004, 03:37 PM
I think mine's better than that :roll: . The bilinear method averages a box of 2 by 2 pixels from the source bitmap for each pixel in the destination bitmap - but mine averages the maximum number of pixels. So if you reduce by 5 times, it will average a 5 by 5 box of pixels from the source. Also, mine seems to be a lot more optimized because I've reduced the number of scanline calls a lot.
Thanks though.

Peter

Harry Hunt
14-06-2004, 03:40 PM
yeah, you're right. Yours is much more optimized. I've been using this one for quite some time because I was too lazy to write my own :P but I guess I'll write my own in assembler next time I need one.

Harry Hunt
14-06-2004, 04:06 PM
I wrote a small benchmarking program for the two resample routines to see how much faster yours is... You can download it here:
http://public.xcessred.com/resamplespeed.zip (3 KB, Source code only).

Yours gave me a division by zero error. I put in an if-statement to bypass that but that seems to make it not work ( :roll: ). I just copied and pasted your code but either I did something wrong or your code has a bug. Maybe you can look at it and tell me why it's not working :P

My guess is I misinterpreted the ARatio parameter....

peterbone
15-06-2004, 09:43 AM
yes, you got the ratio calculation inverted. I agree that your way round makes more sense but the program needs it that way round or it would just have to invert it itself - so it's quicker that way round. It would probably be a better all purpose procedure if the ratio was calculated in the procedure itself but I'm using it to resize multiple bitmaps by the same ratio so I left it as it is to avoid repetition. So at the moment you have to set the bitmap dimensions for source and destination and make sure the ratio is correct for those dimensions before calling the procedure.

I havn't tried your comparison program yet because you didn't include the form.

I also just changed my procedure slightly because I realized that the ABitmapOut doesn't need to be a var - I edited the code in my post above.

Peter

Harry Hunt
15-06-2004, 02:17 PM
Thanks for looking at it!

It works now and I uploaded the ZIP file again, this time with the DFM included (stupid me!)

Check it out. "My" routine is actually faster than yours.

peterbone
15-06-2004, 02:54 PM
oh yeah, yours is fast! But remember mine isn't doing the same algorithm. Mine's giving much better quality because it's using as much information from the source bitmap as possible. The speed of mine will decrease compared to yours as the shrink ratio increases - and in your demo the shrink ratio is very large.

Peter

Harry Hunt
15-06-2004, 03:43 PM
I agree. The quality of yours is much better.