更改位图的像素颜色 [英] change a bitmap's pixel colour

问题描述

我正在尝试更改位图的像素颜色（如果是白色）。我写了下面的代码。但这太慢了！我想检查像素的颜色是否为白色，如果是白色，则将颜色更改为黑色。

I am trying to change a bit-map's pixel color if it's white. I wrote following code. But it's awfully slow!. i want to check if a pixel's color is white or not, and if it is white, change the color to black.

有人可以建议更好的方法吗？ >

Can anybody suggest a better approach?

procedure TForm1.Button1Click(Sender: TObject);
var
  BitMap1 : TBitmap;
  X, Y, Size : Integer;

  P: Cardinal;
begin
  BitMap1 := TBitmap.Create;
  bitMap1.LoadFromFile('image1.bmp');

  for Y := 0 to Bitmap1.Height - 1 do
  begin
    for X := 0 to Bitmap1.width  * size - 1 do
    begin
    p := BitMap1.Canvas.Pixels[X,Y];
    if p = 255 then
      BitMap1.Canvas.Pixels[X,Y] := 0;

    end;
  end;

  Image1.Picture.Assign(BitMap1);
end;

推荐答案

您应该使用扫描线。示例：

You should use scanlines for this. Example:

procedure ChangeWhiteToBlack(var Bitmap: TBitmap);
var
  scanline: PRGBTriple;
  y: Integer;
  x: Integer;
begin
  Assert(Bitmap.PixelFormat = pf24bit);
  for y := 0 to Bitmap.Height - 1 do
  begin
    scanline := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
    begin
      with scanline^ do
      begin
        if (rgbtBlue = 255) and (rgbtGreen = 255) and (rgbtRed = 255) then
          FillChar(scanline^, sizeof(TRGBTriple), 0);
      end;
      inc(scanline);
    end;
  end;
end;

尝试这样：

procedure TForm5.FormCreate(Sender: TObject);
var
  bm: TBitmap;
begin
  bm := TBitmap.Create;
  try
    bm.LoadFromFile('C:\Users\Andreas Rejbrand\Desktop\test.bmp');
    ChangeWhiteToBlack(bm);
    bm.SaveToFile('C:\Users\Andreas Rejbrand\Desktop\test2.bmp');
  finally
    bm.Free;
  end;
end;

更新：您只需要对代码进行非常小的修改即可它可以在32位位图上工作：

Update: You need only a very minor modification of the code to make it work on 32-bit bitmaps instead:

procedure ChangeWhiteToBlack32(var Bitmap: TBitmap);
var
  scanline: PRGBQuad;
  y: Integer;
  x: Integer;
begin
  Assert(Bitmap.PixelFormat = pf32bit);
  for y := 0 to Bitmap.Height - 1 do
  begin
    scanline := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
    begin
      with scanline^ do
      begin
        if (rgbBlue = 255) and (rgbGreen = 255) and (rgbRed = 255) then
          FillChar(scanline^, sizeof(TRGBQuad), 0);
      end;
      inc(scanline);
    end;
  end;
end;

其实你可以做

procedure ChangeWhiteToBlack24(var Bitmap: TBitmap);
var
  scanline: PRGBTriple;
  y: Integer;
  x: Integer;
begin
  Assert(Bitmap.PixelFormat = pf24bit);
  for y := 0 to Bitmap.Height - 1 do
  begin
    scanline := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
    begin
      with scanline^ do
      begin
        if (rgbtBlue = 255) and (rgbtGreen = 255) and (rgbtRed = 255) then
          FillChar(scanline^, sizeof(TRGBTriple), 0);
      end;
      inc(scanline);
    end;
  end;
end;

procedure ChangeWhiteToBlack32(var Bitmap: TBitmap);
var
  scanline: PRGBQuad;
  y: Integer;
  x: Integer;
begin
  Assert(Bitmap.PixelFormat = pf32bit);
  for y := 0 to Bitmap.Height - 1 do
  begin
    scanline := Bitmap.ScanLine[y];
    for x := 0 to Bitmap.Width - 1 do
    begin
      with scanline^ do
      begin
        if (rgbBlue = 255) and (rgbGreen = 255) and (rgbRed = 255) then
          FillChar(scanline^, sizeof(TRGBQuad), 0);
      end;
      inc(scanline);
    end;
  end;
end;

procedure ChangeWhiteToBlack(var Bitmap: TBitmap);
begin
  case Bitmap.PixelFormat of
    pf24bit: ChangeWhiteToBlack24(Bitmap);
    pf32bit: ChangeWhiteToBlack32(Bitmap);
  else
    raise Exception.Create('Pixel format must be pf24bit or pf32bit.');
  end;
end;

如果您不想使单一的程序同时兼容24位和32位，作为 TLama 的位图。 [有两个独立程序的一个好处是这些简短的程序更容易阅读（并维护）。]

if you don't want to make a single procedure that works with both 24-bit and 32-bit bitmaps, as TLama did. [One benefit of having two separate procedures is that these short procedures are easier to read (and maintain).]

这篇关于更改位图的像素颜色的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！