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
Code:
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
Bookmarks