How can I replace color on TCanvas on Delphi?

Question

How can I replace color on TCanvas on Delphi XE2? The following code works incredibly slow:

  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];

The scanline property will be 10-100x faster than the pixel map: http://blogs.embarcadero.com/pawelglowacki/2010/04/15/39051 — Argalatyr, Mar 03 '14 at 01:29
@Jerry - Would only help if all the to be replaced pixels are contiguous. — Sertac Akyuz, Mar 03 '14 at 02:02

Gabriel · Answer 1 · 2022-12-02T18:30:44.590

Here are two function (with and without tolerance) to replace the color:

Bonus:
Code to test the functions also provided. Load your image in a TImage control, then use the MouseUp event to change the color under mouse.

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.imgOnMouseUp(Sender: TObject; Shift: TShiftState; X, Y: Integer);
VAR
   PixelClr: TColor;
   BMP: TBitmap;
begin
  // Collect the new color, under mouse pointer
  PixelClr:= imgReplaceOrig.Picture.Bitmap.Canvas.Pixels[x, y];
  if PixelClr< 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);

 // Replace the color
 cGraphUtil.ReplaceColor(BMP, PixelClr, clBlue, 44, 44, 44);
 imgReplace.Picture.Assign(BMP);
 FreeAndNil(BMP);
end;

score 0 · Accepted Answer · edited Apr 29 '20 at 20:20

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;

It would be nice if you could post this as a full working function so others can just copy/paste it :) — Gabriel, Apr 26 '20 at 20:49

How can I replace color on TCanvas on Delphi?

2 Answers2