Проблема сохранения изменений цвета пикселей на холсте в Delphi с использованием TBitmap

Delphi , Графика и Игры , Canvas

При работе с графикой в среде разработки Delphi часто возникает необходимость в изменении цвета пикселей изображения. Одной из распространенных задач является изменение цвета всех пикселей холста на однородный цвет, например, черный. В процессе решения такой задачи пользователи могут столкнуться с проблемами, связанными с неправильной работой кода или несохранением изменений в файле.

Описание проблемы

Пользователь столкнулся с проблемой, пытаясь изменить цвет всех пикселей холста на черный. Была найдена функция RGBBitmapTo1Bit, которая должна была выполнить данную задачу, но при использовании этой функции изменения не сохранялись в файле. Пример кода, предоставленный пользователем, создавал новый экземпляр TBitmap и перебирал все пиксели, устанавливая их в черный цвет. Однако, несмотря на кажущуюся корректность функции, изменений в исходном файле не наблюдалось.

Пример кода с ошибками

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
      Result.Canvas.Pixels[x, y] := clBlack;
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;
end;

Подтвержденный ответ

В коде пользователя были выявлены следующие проблемы:

1. Индексация пикселей начинается с 0, следовательно, циклические операторы должны начинаться с 0 и заканчиваться на OriginalBitmap.Width-1 и OriginalBitmap.Height-1 соответственно.
2. Функция RGBBitmapTo1Bit создает новый экземпляр 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
      Result.Canvas.Pixels[x, y] := clBlack;
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 FillBitmapWithColor(OriginalBitmap : TBitmap; FillColor : TColor);
begin
  OriginalBitmap.Canvas.Brush.Color := FillColor;
  OriginalBitmap.Canvas.FillRect(OriginalBitmap bounds);
end;

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

Заключение

При работе с графическими объектами в Delphi важно обращать внимание на индексацию пикселей, правильное использование объектов и их освобождение после завершения работы. Также, существуют более оптимизированные способы изменения цвета всех пикселей, например, использование метода FillRect.

Создано по материалам из источника по ссылке.

Пользователь столкнулся с проблемой сохранения изменений цвета пикселей изображения на холсте в среде Delphi из-за неправильного использования объекта `TBitmap` и ошибок в коде, связанных с индексацией пикселей и управлением памятью.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Canvas ::