delphi change canvas pixel color

Question

i need to convert all pixels of a canvas

found this function after a quick search in google

but dont work correct , but it seems must work good!!

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;

this function dont make any change on the file

for example i used like this

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;

but the output and input files are the same!!!

how can i assign a color to a pixel rightly!?

Answer 1

Your code has three problems with it:

1. Pixels are 0-indexed in both dimensions, so you need to change your loops accordingly.

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

2. your function DOES NOT modify the original TBitmap, it allocates and modifies a new TBitmap and then returns that to the caller, but the caller is ignoring that new bitmap, expecting the original TBitmap to have been modified instead. You are saving the original TBitmap to file, which is why you don't see any of the pixels changed.

3. You are leaking memory for both TBitmap objects;

Try this instead:

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;

Or this:

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;

That being said, RGBBitmapTo1Bit() is slow in both versions. A faster version would be more like this:

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;

Or:

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

It also does not do what its name suggests - convert a bitmap to 1bit. To do that, you have to set the TBitmap.PixelFormat property instead:

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;

Or:

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