Sorry, I forgot to put those types in

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

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

[pascal]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;[/pascal]

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