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

hc2pp10m  于 2022-12-03  发布在  其他
关注(0)|答案(2)|浏览(159)

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

3yhwsihp1#

下面是两个函数(带公差和不带公差)来替换颜色:
奖金:
代码测试功能也提供。加载你的图像在一个TIimage控件,然后使用MouseUp事件改变颜色下的鼠标。

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

gblwokeq2#

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;

相关问题