Delphi 更改画布像素颜色

我需要转换画布的所有像素
我在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;

但是输出和输入文件是相同的！！！
我怎样才能正确地将颜色分配给像素！？

你的代码有三个问题：
1.像素在两个维度上都是0索引的，因此您需要相应地更改循环。

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

1.你的函数不修改原始的TBitmap，它分配和修改一个新的TBitmap，然后返回给调用者，但调用者忽略了新的位图，期望原始的TBitmap已经被修改。您正在将原始TBitmap保存到文件中，这就是为什么您看不到任何像素更改的原因。
1.您正在泄漏两个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;

Delphi 更改画布像素颜色

1条答案

相关问题

热门标签

最新问答