如何在 Delphi 中替换 Canvas 上的颜色？

Question

如何在 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];

Answer 1

对于懒惰的人（比如我），这里是完整的代码。
有两个功能：有/无公差。

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

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;

Answer 2

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;