德尔福改变画布像素颜色

Question

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

在谷歌快速搜索后发现此功能

但是工作不正确,但似乎必须工作得很好!!

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

您的代码有三个问题:

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

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

2. 你的函数不会修改原始函数TBitmap,它会分配和修改一个new TBitmap,然后将它返回给调用者,但是调用者忽略了那个新的位图,TBitmap而是期望修改原始的位图.您将原始TBitmap文件保存到文件,这就是您没有看到任何像素更改的原因.

3. 你正在泄漏两个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;