求一个最快的柔化算法!(50分)

求一个最快的BMP图柔化算法!
这个是我用的实在太慢了！！！
var
Map1:TBitmap;
xMax,yMax,i,j,m,n:integer;
r,g,b:integer;
begin
Map1:=TBitmap.create;
xMax:=Map1.Width-1;
yMax:=map1.Height-1;
For i:=1 to xMax-1 do
begin
For j:=1 to yMax-1 do
begin
r:=0;
g:=0;
b:=0;
for m:=i-1 to i+1 do
for n:=j-1 to j+1 do
begin
r:=r+GetRValue(map1.Canvas.Pixels[m,n]);
g:=g+GetRValue(map1.Canvas.Pixels[m,n]);
b:=b+GetRValue(map1.Canvas.Pixels[m,n]);
end;
r:=r div 9;
g:=g div 9;
b:=b div 9;
map1.Canvas.Pixels[i,j]:=RGB(r,g,b);

end;
end;
Image1.Picture.Bitmap.Assign(map1);
map1.Free;
end;

没人愿意回答吗，我自己顶起!

1、你代码中用了三处 GetRValue 是手误吧，应该是 GetR/G/BValue ?
2、效率低下的原因是你多次、直接操作 Pixels 数组
3、别的方法我不知道，不过针对上面的原则是可以优化的

这是原始的：
procedure ChangeBitmap(AMap: TBitmap);
var
xMax, yMax, I, J, M, N: Integer;
R, G, B: Integer;
nColor: TColor;
begin
Assert(AMap <> nil);

xMax := AMap.Width - 1;
yMax := AMap.Height - 1;
for I := 1 to xMax - 1 do
begin
for J := 1 to yMax - 1 do
begin
R := 0;
G := 0;
B := 0;
for M := I - 1 to I + 1 do
for N := J - 1 to J + 1 do
begin
nColor := AMap.Canvas.Pixels[M, N];
R := R + GetRValue(nColor);
G := G + GetGValue(nColor);
B := B + GetBValue(nColor);
end;
R := R div 9;
G := G div 9;
B := B div 9;
AMap.Canvas.Pixels[I, J] := RGB(R, G, B);
end;
end;
end;

这是针对 24bit 改进的优化算法：
procedure ChangeBitmapEx(AMap: TBitmap);
type
PRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..MAXWORD - 1] of TRGBTriple;
var
pScanLine: PRGBTripleArray;
nScanlineBytes: Integer;
xMax, yMax, I, J, M, N: Integer;
R, G, B: Integer;
cMap: array of array of TRGBTriple;
begin
Assert(AMap <> nil);
AMap.PixelFormat := pf24bit;

pScanLine := AMap.Scanline[0];
nScanlineBytes := Integer(AMap.Scanline[1]) - Integer(pScanLine);

SetLength(cMap, AMap.Width);
for I := 0 to AMap.Width - 1 do
SetLength(cMap, AMap.Height);

for I := 0 to AMap.Height - 1 do
begin
for J := 0 to AMap.Width - 1 do
cMap[J, I] := pScanLine[J];
Inc(Integer(pScanLine), nScanlineBytes);
end;

xMax := AMap.Width - 1;
yMax := AMap.Height - 1;

for I := 1 to xMax - 1 do
for J := 1 to yMax - 1 do
begin
R := 0;
G := 0;
B := 0;
for M := I - 1 to I + 1 do
for N := J - 1 to J + 1 do
with cMap[M, N] do
begin
R := R + rgbtRed;
G := G + rgbtGreen;
B := B + rgbtBlue;
end;
with cMap[I, J] do
begin
rgbtRed := R div 9;
rgbtGreen := G div 9;
rgbtBlue := B div 9;
end;
end;

pScanLine := AMap.Scanline[0];
nScanlineBytes := Integer(AMap.Scanline[1]) - Integer(pScanLine);

for I := 0 to AMap.Height - 1 do
begin
for J := 0 to AMap.Width - 1 do
pScanLine[J] := cMap[J, I];
Inc(Integer(pScanLine), nScanlineBytes);
end;
end;

在我的机器上一幅 256*256 的位图 ChangeBitmap 耗时 69.3s，而 ChangeBitmapEx 耗时 0.02s

如果不想改变 PixelFormat，方法是根据 24bit 或者 8bit 之类的，选择合适的“TRGBTriple”（其实已经柔化了修改 PixelFormat 也没什么），Scanline 具体的使用方式参考：
http://homepages.borland.com/efg2lab/ImageProcessing/Scanline.htm
;>

to: LSUPER
谢谢你的回答，ScanLine()应是正解。三处GetRValuer的引用可以得到黑白图像，算是手误吧！
不过有没有比上面代码更快的呢？请大家继续！。。。
分不够我会再加！

我只针对24bit!

呵呵，期待高人新的柔化算法 ...

就用你的方法，我可以缩短你的时间一百倍。

我的代码比较长，但是速度还能忍受，我的本本上处理256*256的图1000次,时间范围是0-6毫秒。
LZ可以试试。


procedure SmoothImage(SrcBmp, OutBmp: TBitmap);
var
X, Y, nPicth, nColor, nOffset: Integer;
pSrcBitsTop, pSrcBitsCur, pSrcBitsBottom, pDestBits: PByteArray;
begin
nPicth := SrcBmp.Width * 3;
if nPicth and 3 <> 0 then
nPicth := nPicth + 4 - (nPicth and 3);

pSrcBitsBottom := SrcBmp.ScanLine[SrcBmp.Height - 1];
pSrcBitsCur := pSrcBitsBottom;
pSrcBitsTop := pSrcBitsBottom;
Inc( PByte(pSrcBitsCur), nPicth );
Inc( PByte(pSrcBitsTop), nPicth * 2 );

pDestBits:= OutBmp.ScanLine[SrcBmp.Height- 1];
Inc( PByte(pDestBits), nPicth + 3 );

//处理 rect=( 1, 1, Width - 2, Height - 2 ) 的区域
for Y := 1 to SrcBmp.Height - 2 do
begin
nOffset := 0;
for X := 1 to SrcBmp.Width - 2 do
begin
nColor := pSrcBitsTop[nOffset + 0] + pSrcBitsTop[nOffset + 3] + pSrcBitsTop[nOffset + 6] +
pSrcBitsCur[nOffset + 0] + pSrcBitsCur[nOffset + 3] + pSrcBitsCur[nOffset + 6] +
pSrcBitsBottom[nOffset + 0] + pSrcBitsBottom[nOffset + 3] + pSrcBitsBottom[nOffset + 6];
pDestBits[nOffset + 0] := nColor div 9;
nColor := pSrcBitsTop[nOffset + 1] + pSrcBitsTop[nOffset + 4] + pSrcBitsTop[nOffset + 7] +
pSrcBitsCur[nOffset + 1] + pSrcBitsCur[nOffset + 4] + pSrcBitsCur[nOffset + 7] +
pSrcBitsBottom[nOffset + 1] + pSrcBitsBottom[nOffset + 4] + pSrcBitsBottom[nOffset + 7];
pDestBits[nOffset + 1] := nColor div 9;
nColor := pSrcBitsTop[nOffset + 2] + pSrcBitsTop[nOffset + 5] + pSrcBitsTop[nOffset + 8] +
pSrcBitsCur[nOffset + 2] + pSrcBitsCur[nOffset + 5] + pSrcBitsCur[nOffset + 8] +
pSrcBitsBottom[nOffset + 2] + pSrcBitsBottom[nOffset + 5] + pSrcBitsBottom[nOffset + 8];
pDestBits[nOffset + 2] := nColor div 9;
Inc( nOffset, 3 );
end;
Inc( PByte(pSrcBitsTop), nPicth );
Inc( PByte(pSrcBitsCur), nPicth );
Inc( PByte(pSrcBitsBottom), nPicth );
Inc( PByte(pDestBits), nPicth );
end;

//处理 第一行和最后一行
if SrcBmp.Height > 1 then
begin
pSrcBitsBottom := SrcBmp.ScanLine[1];
pSrcBitsCur := pSrcBitsBottom;
Inc( PByte(pSrcBitsCur), nPicth );

pDestBits:= OutBmp.ScanLine[0];
Inc( PByte(pDestBits), 3 );

nOffset := 0;
for X := 1 to SrcBmp.Width - 2 do
begin
nColor := pSrcBitsCur[nOffset + 0] + pSrcBitsCur[nOffset + 3] +
pSrcBitsBottom[nOffset + 0] + pSrcBitsBottom[nOffset + 3];
pDestBits[nOffset + 0] := nColor div 4;
nColor := pSrcBitsCur[nOffset + 1] + pSrcBitsCur[nOffset + 4] +
pSrcBitsBottom[nOffset + 1] + pSrcBitsBottom[nOffset + 4];
pDestBits[nOffset + 1] := nColor div 4;
nColor := pSrcBitsCur[nOffset + 2] + pSrcBitsCur[nOffset + 5] +
pSrcBitsBottom[nOffset + 2] + pSrcBitsBottom[nOffset + 5];
pDestBits[nOffset + 2] := nColor div 4;
Inc( nOffset, 3 );
end;

pSrcBitsTop := SrcBmp.ScanLine[SrcBmp.Height - 1];
pSrcBitsCur := pSrcBitsTop;
Inc( PByte(pSrcBitsCur), nPicth );

pDestBits:= OutBmp.ScanLine[OutBmp.Height - 1];
Inc( PByte(pDestBits), 3 );

nOffset := 0;
for X := 1 to SrcBmp.Width - 2 do
begin
nColor := pSrcBitsTop[nOffset + 0] + pSrcBitsTop[nOffset + 3] +
pSrcBitsCur[nOffset + 0] + pSrcBitsCur[nOffset + 3];
pDestBits[nOffset + 0] := nColor div 4;
nColor := pSrcBitsTop[nOffset + 1] + pSrcBitsTop[nOffset + 4] +
pSrcBitsCur[nOffset + 1] + pSrcBitsCur[nOffset + 4];
pDestBits[nOffset + 1] := nColor div 4;
nColor := pSrcBitsTop[nOffset + 2] + pSrcBitsTop[nOffset + 5] +
pSrcBitsCur[nOffset + 2] + pSrcBitsCur[nOffset + 5];
pDestBits[nOffset + 2] := nColor div 4;
Inc( nOffset, 3 );
end;
end;

//处理 第一列和最后一列
if SrcBmp.Width > 1 then
begin
nOffset := (SrcBmp.Width - 1) * 3;
pDestBits:= OutBmp.ScanLine[OutBmp.Height - 1];
pSrcBitsCur := SrcBmp.ScanLine[SrcBmp.Height - 1];
for Y := 0 to SrcBmp.Height - 1 do
begin
pDestBits[0] := (pSrcBitsCur[0] + pSrcBitsCur[3]) div 2;
pDestBits[1] := (pSrcBitsCur[1] + pSrcBitsCur[4]) div 2;
pDestBits[2] := (pSrcBitsCur[2] + pSrcBitsCur[5]) div 2;
pDestBits[nOffset + 0] := (pSrcBitsCur[nOffset + 0] + pSrcBitsCur[nOffset + 3]) div 2;
pDestBits[nOffset + 1] := (pSrcBitsCur[nOffset + 1] + pSrcBitsCur[nOffset + 4]) div 2;
pDestBits[nOffset + 2] := (pSrcBitsCur[nOffset + 2] + pSrcBitsCur[nOffset + 5]) div 2;
Inc( PByte(pSrcBitsCur), nPicth );
Inc( PByte(pDestBits), nPicth );
end;
end;
end;

这是测试速度的代码:

uses mmsystem;

procedure TForm1.Button1Click(Sender: TObject);
var
BmpSrc, BmpDest: TBitmap;
dwMilSec, dwMinCost, dwMaxCost, I: DWord;
begin
BmpSrc := TBitmap.Create;
BmpDest:= TBitmap.Create;

BmpSrc.LoadFromFile( 'yourimage.bmp' );
BmpSrc.PixelFormat := pf24Bit;
BmpDest.PixelFormat:= pf24Bit;
BmpDest.Width := BmpSrc.Width;
BmpDest.Height:= BmpSrc.Height;

dwMinCost := HIGH(dwMinCost);
dwMaxCost := 0;

for I := 0 to 1000 - 1 do
begin
dwMilSec := timeGetTime();
SmoothImage( BmpSrc, BmpDest );
dwMilSec := timeGetTime() - dwMilSec;
if dwMinCost > dwMilSec then
dwMinCost := dwMilSec;
if dwMaxCost < dwMilSec then
dwMaxCost := dwMilSec;
end;
Canvas.Draw( 0, 0, BmpSrc );
Canvas.Draw( BmpSrc.Width + 16, 0, BmpDest );
Caption := Format( 'Smooth image size=(%d,%d), tick=%d-%d',
[BmpSrc.Width, BmpSrc.Height, dwMinCost, dwMaxCost] );
BmpSrc.Free;
BmpDest.Free;
end;

谢谢各位的回答，我测试完就结贴！

用ScanLine，指针操作，比像素操作快N个数量级

多人接受答案了。