Question

我需要转换画布的所有像素

在google

中快速搜索后找到此功能

但不正确，但看起来一定很好!!

function RGBBitmapTo1Bit(OriginalBitmap : TBitmap) : TBitmap;
var
  x, y : integer;
begin
  result := TBitmap.Create;
  result.width := OriginalBitmap.width;
  result.height := OriginalBitmap.height;

  for x := 1 to OriginalBitmap.width do
     for y := 1 to OriginalBitmap.height do
      begin
        result.Canvas.Pixels[x, y] := clBlack;
      end;

end;

此功能不对文件进行任何更改

例如我像这样使用

procedure TForm1.Button2Click(Sender: TObject);
var
imgf : TBitmap;
begin
if od1.Execute then
begin
  imgf := TBitmap.Create;
  imgf.LoadFromFile(od1.FileName);
  RGBBitmapTo1Bit(imgf);
  imgf.SaveToFile(ExtractFilePath(od1.FileName)+'test.bmp');
end;

但输出和输入文件是相同的!!!

如何正确地为像素指定颜色！？

Answer 1

您的代码有三个问题：

像素在两个维度都是0索引，因此您需要相应地更改循环。

for x := 0 to OriginalBitmap.width-1 do
  for y := 0 to OriginalBitmap.height-1 do

你的函数不修改原始的TBitmap，它分配并修改一个新的TBitmap然后将它返回给调用者，但是调用者忽略了那个新的位图，期望原始的TBitmap已被修改。您将原始TBitmap保存到文件中，这就是您没有看到任何像素发生变化的原因。
您正在泄漏TBitmap个对象的内存;

请改为尝试：

function RGBBitmapTo1Bit(OriginalBitmap : TBitmap) : TBitmap;
var
  x, y : integer;
begin
  Result := TBitmap.Create;
  Result.Width := OriginalBitmap.Width;
  Result.Height := OriginalBitmap.Height;

  for x := 0 to OriginalBitmap.Width-1 do
    for y := 0 to OriginalBitmap.Height-1 do
    begin
      Result.Canvas.Pixels[x, y] := clBlack;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  imgf : TBitmap;
  imgf2 : TBitmap;
begin
  if od1.Execute then
  begin
    imgf := TBitmap.Create;
    try
      imgf.LoadFromFile(od1.FileName);
      imgf2 := RGBBitmapTo1Bit(imgf);
      try
        imgf2.SaveToFile(ExtractFilePath(od1.FileName)+'test.bmp');
      finally
        imgf2.Free;
      end;
    finally
      imgf.Free;
    end;
  end;
end;

或者这个：

procedure RGBBitmapTo1Bit(OriginalBitmap : TBitmap);
var
  x, y : integer;
begin
  for x := 0 to OriginalBitmap.Width-1 do
    for y := 0 to OriginalBitmap.Height-1 do
    begin
      OriginalBitmap.Canvas.Pixels[x, y] := clBlack;
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  imgf : TBitmap;
begin
  if od1.Execute then
  begin
    imgf := TBitmap.Create;
    try
      imgf.LoadFromFile(od1.FileName);
      RGBBitmapTo1Bit(imgf);
      imgf.SaveToFile(ExtractFilePath(od1.FileName)+'test.bmp');
    finally
      imgf.Free;
    end;
  end;
end;

话虽如此，RGBBitmapTo1Bit()在两个版本中都很慢。更快的版本更像是这样：

function RGBBitmapTo1Bit(OriginalBitmap : TBitmap) : TBitmap;
begin
  Result := TBitmap.Create;
  Result.Width := OriginalBitmap.Width;
  Result.Height := OriginalBitmap.Height;
  Result.Canvas.Brush.Color := clBlack;
  Result.Canvas.FillRect(Rect(0, 0, Result.Width, Result.Height));
end;

function RGBBitmapTo1Bit(OriginalBitmap : TBitmap) : TBitmap;
begin
  Result := TBitmap.Create;
  Result.Canvas.Brush.Color := clBlack;
  Result.Width := OriginalBitmap.Width;
  Result.Height := OriginalBitmap.Height;
end;

或者：

procedure RGBBitmapTo1Bit(OriginalBitmap : TBitmap);
begin
  OriginalBitmap.Canvas.Brush.Color := clBlack;
  OriginalBitmap.Canvas.FillRect(Rect(0, 0, OriginalBitmap.Width, OriginalBitmap.Height));
end;

它也没有顾名思义 - 将位图转换为1位。为此，您必须设置TBitmap.PixelFormat属性：

function RGBBitmapTo1Bit(OriginalBitmap : TBitmap) : TBitmap;
begin
  Result := TBitmap.Create;
  Result.PixelFormat := pf1Bit;
  Result.Canvas.Brush.Color := clBlack;
  Result.Width := OriginalBitmap.Width;
  Result.Height := OriginalBitmap.Height;
end;

或者：

procedure RGBBitmapTo1Bit(OriginalBitmap : TBitmap);
begin
  OriginalBitmap.PixelFormat := pf1Bit;
  OriginalBitmap.Canvas.Brush.Color := clBlack;
  OriginalBitmap.Canvas.FillRect(Rect(0, 0, OriginalBitmap.Width, OriginalBitmap.Height));
end;

德尔福改变画布像素颜色

1 个答案: