如何在Delphi上替换TCanvas上的颜色？

如何在Delphi XE2上替换TCanvas上的颜色？以下代码运行速度非常慢：

  for y := ARect.Top to ARect.Top + ARect.Height - 1 do
    for x := ARect.Left to ARect.Left + ARect.Width - 1 do
      if Canvas.Pixels[x, y] = FixedColor then
        Canvas.Pixels[x, y] := Canvas.Pixels[ARect.Left, ARect.Top];

对于懒惰的人（如我），以下是完整的代码。
有两种功能：带公差/不带公差

奖金：
还提供了测试功能的代码（将鼠标移到TImage上，以查看在第二个TImage上实时应用ReplaceColor）

procedure-ReplaceColor（BMP:TBitmap；OldColor，NewColor:TColor）；
变量
x、 y：整数；
R、 G，B：字节；
R_，G_，B_：字节；
aPixel:PRGBTriple；
开始
R:=GetRValue（旧颜色）；
G:=GetGValue（OldColor）；
B:=GetBValue（OldColor）；
R_:=GetRValue（NewColor）；
G_uz:=GetGValue（NewColor）；
B_u:=GetBValue（NewColor）；
BMP.PixelFormat:=pf24位；
对于y:=0到BMP.Height-1 do
对于x:=0到BMP.Width-1 do
开始
aPixel:=BMP.ScanLine[y]；
公司（aPixel，x）；
if（aPixel^.rgbtRed=R）
和（aPixel^.rgbtGreen=G）
和（aPixel^.rgbtBlue=B）然后
开始
aPixel^.rgbtRed:=R；
aPixel^.rgbtGreen:=G；
aPixel^.rgbtBlue:=B；
结束；
结束；
结束；
程序ReplaceColor（BMP:TBitmap；旧颜色，新颜色：TColor；公差，公差G，公差B:Byte）；
变量
x、 y：整数；
R、 G，B：字节；
R_，G_，B_：字节；
aPixel:PRGBTriple；
开始
R:=GetRValue（旧颜色）；
G:=GetGValue（OldColor）；
B:=GetBValue（OldColor）；
R_:=GetRValue（NewColor）；
G_uz:=GetGValue（NewColor）；
B_u:=GetBValue（NewColor）；
BMP.PixelFormat:=pf24位；
对于y:=0到BMP.Height-1 do
对于x:=0到BMP.Width-1 do
开始
aPixel:=BMP.ScanLine[y]；
公司（aPixel，x）；
if（abs（aPixel^.rgbtRed-R）<公差）
和（abs（aPixel^.rgbtGreen-G）<公差G）
和（abs（aPixel^.rgbtBlue-B）<公差B）然后
开始
aPixel^.rgbtRed:=R；
aPixel^.rgbtGreen:=G；
aPixel^.rgbtBlue:=B；
结束；
结束；
结束；
过程TfrmTester.imgReplaceOrigMouseMove（发送方：TObject；Shift:TShiftState；X，Y：整数）；
变量
像素：t彩色；
BMP:TBitmap；
开始
像素：=imgReplaceOrig.Picture.Bitmap.Canvas.Pixels[x，y]；
pnlTop.Color:=像素；
如果像素<0，则退出；
标签1.标题：='x'+IntToStr（x）+'：y='
+IntToStr（Y）
+'r'+IntToStr（GetRValue（像素））
+'，g'+IntToStr（GetGValue（像素））
+，b'+IntToStr（GetBValue（Pixel））；
BMP:=TBitmap.Create；
BMP.Assign（imgReplaceOrig.Picture.Bitmap）；
ReplaceColor（BMP，像素，clBlue，44,44,44）；
imgReplace.Picture.Assign（BMP）；
FreeAndNil（BMP）；
结束；

您是否看到了

FillRect

过程？或者

FloodFill

？

如果Canvas.Pixels[x，y]=FixedColor

也工作得很慢。扫描线属性将比像素贴图快10-100倍：是的，我意识到，

scanline

在这里是一个理想的解决方案。相关的。如果你能将其作为一个完整的工作函数发布，这样其他人就可以复制/粘贴它了，那就太好了：）

var
  aBitmap: TBitmap;
  x, y: Integer;
  aPixel: PRGBTriple;

 ...

  aBitmap := TBitmap.Create;
  try
    aBitmap.PixelFormat := pf24bit;
    aBitmap.Height := ARect.Height;
    aBitmap.Width := ARect.Width;
    aBitmap.Canvas.CopyRect(TRect.Create(0, 0, aBitmap.Width, aBitmap.Height), Canvas, ARect);
    for y := 0 to aBitmap.Height - 1 do
      for x := 0 to aBitmap.Width - 1 do
      begin
        aPixel := aBitmap.ScanLine[y];
        Inc(aPixel, x);
        if (aPixel^.rgbtRed = GetRValue(FixedColor)) and (aPixel^.rgbtGreen = GetGValue(FixedColor)) and (aPixel^.rgbtBlue = GetBValue(FixedColor)) then
          aPixel^ := PRGBTriple(aBitmap.ScanLine[y])^;
      end;
    Canvas.Draw(ARect.Left, ARect.Top, aBitmap);
  finally
    aBitmap.Free;
  end;

procedure ReplaceColor(BMP: TBitmap; OldColor, NewColor: TColor);
VAR
   x, y: Integer;
   R,G,B: Byte;
   R_,G_,B_: Byte;
   aPixel: PRGBTriple;
begin
 R:= GetRValue(OldColor);
 G:= GetGValue(OldColor);
 B:= GetBValue(OldColor);

 R_:= GetRValue(NewColor);
 G_:= GetGValue(NewColor);
 B_:= GetBValue(NewColor);

 BMP.PixelFormat := pf24bit;
 for y := 0 to BMP.Height - 1 do
  for x := 0 to BMP.Width - 1 do
   begin
     aPixel := BMP.ScanLine[y];
     Inc(aPixel, x);
     if  (aPixel^.rgbtRed   = R)
     AND (aPixel^.rgbtGreen = G)
     AND (aPixel^.rgbtBlue  = B) then
      begin
       aPixel^.rgbtRed   := R_;
       aPixel^.rgbtGreen := G_;
       aPixel^.rgbtBlue  := B_;
      end;
   end;
end;


procedure ReplaceColor(BMP: TBitmap; OldColor, NewColor: TColor; ToleranceR, ToleranceG, ToleranceB: Byte);
VAR
   x, y: Integer;
   R,G,B: Byte;
   R_,G_,B_: Byte;
   aPixel: PRGBTriple;
begin
 R:= GetRValue(OldColor);
 G:= GetGValue(OldColor);
 B:= GetBValue(OldColor);

 R_:= GetRValue(NewColor);
 G_:= GetGValue(NewColor);
 B_:= GetBValue(NewColor);

 BMP.PixelFormat := pf24bit;
 for y := 0 to BMP.Height - 1 do
  for x := 0 to BMP.Width - 1 do
   begin
     aPixel := BMP.ScanLine[y];
     Inc(aPixel, x);
     if  (abs(aPixel^.rgbtRed  - R)< ToleranceR)
     AND (abs(aPixel^.rgbtGreen- G)< ToleranceG)
     AND (abs(aPixel^.rgbtBlue - B)< ToleranceB) then
      begin
       aPixel^.rgbtRed   := R_;
       aPixel^.rgbtGreen := G_;
       aPixel^.rgbtBlue  := B_;
      end;
   end;
end;


procedure TfrmTester.imgReplaceOrigMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
VAR
   Pixel: TColor;
   BMP: TBitmap;
begin
  Pixel := imgReplaceOrig.Picture.Bitmap.Canvas.Pixels[x, y];
  pnlTop.Color:= Pixel;
  if Pixel < 0 then EXIT;

  Label1.Caption := 'x'+IntToStr(X)+':y='
         + IntToStr(Y)
         +'  r'+ IntToStr(GetRValue(Pixel))
         +', g'+ IntToStr(GetGValue(Pixel))
         +', b'+ IntToStr(GetBValue(Pixel));

 BMP:= TBitmap.Create;
 BMP.Assign(imgReplaceOrig.Picture.Bitmap);
 cGraphUtil.ReplaceColor(BMP, Pixel, clBlue, 44, 44, 44);
 imgReplace.Picture.Assign(BMP);
 FreeAndNil(BMP);
end;