Image shrink by pixel averaging

[peterbone]

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