Плавно превратить один рисунок в другой

Delphi , Графика и Игры , Изображения

procedure TForm1.Button1Click(Sender: TObject);
const
  count = 100;
var
  i: integer;
  x, y: integer;
  bm, bm1, bm2: TBitMap;
  p1, p2, p: PByteArray;
  c: integer;
  k: integer;
begin
  bm := TBitMap.Create;
  bm1 := TBitMap.Create;
  bm2 := TBitMap.Create;
  bm1.LoadFromFile('Bitmap1.bmp');
  bm2.LoadFromFile('Bitmap2.bmp');
  if bm1.Height < bm2.Height then
  begin
    bm.Height := bm1.Height;
    bm2.Height := bm1.Height;
  end
  else
  begin
    bm.Height := bm2.Height;
    bm1.Height := bm2.Height;
  end;
  if bm1.Width < bm2.Width then
  begin
    bm.Width := bm1.Width;
    bm2.Width := bm1.Width;
  end
  else
  begin
    bm.Width := bm2.Width;
    bm1.Width := bm2.Width;
  end;
  bm.PixelFormat := pf24bit;
  bm1.PixelFormat := pf24bit;
  bm2.PixelFormat := pf24bit;

  Form1.Canvas.Draw(0, 0, bm1);
  for i := 1 to count - 1 do
  begin
    for y := 0 to bm.Height - 1 do
    begin
      p := bm.ScanLine[y];
      p1 := bm1.ScanLine[y];
      p2 := bm2.ScanLine[y];
      for x := 0 to bm.Width * 3 - 1 do
        p^[x] := round((p1^[x] * (count - i) + p2^[x] * i) / count);
    end;
    Form1.Canvas.Draw(0, 0, bm);
    Form1.Caption := IntToStr(round(i / count * 100)) + '%';
    Application.ProcessMessages;
    if Application.Terminated then
      break;
  end;
  Form1.Canvas.Draw(0, 0, bm2);
  Form1.Caption := 'done';
  bm1.Destroy; bm2.Destroy; bm.Destroy;
end;

Перевод текста на русский язык:

Это процедура Delphi, которая преобразует один битовую картинку в другую, постепенно изменяя пиксели оригинальной картинки для соответствия пикселям целевой картинки. Вот разбивка того, что код делает:

1. Он создает три объекта TBitMap: bm, bm1 и bm2. Первые два загружены из файлов "Bitmap1.bmp" и "Bitmap2.bmp", соответственно.
2. Он устанавливает высоту и ширину всех трех битмап в одинаковую величину, меньшую между двумя оригинальными изображениями.
3. Он устанавливает формат пикселей для всех трех битмап в 24-бит (RGB).
4. Затем процедура вступает в цикл, который повторяется count раз. В каждой итерации:
   • Она рисует оригинальную картинку (bm1) на канвасе формы.
   • Она проходит по каждому ряду пикселей в битмапе, используя указатели p, p1 и p2 для доступа к рядам.
   • Для каждого пикселя она рассчитывает взвешенный средний вес соответствующих пикселей из двух оригинальных битмап, используя текущую итерационную номер (i) как фактор. Полученное значение затем присваивается пикселю в промежуточной битмапе (bm).
   • Она рисует обновленную промежуточную битмап на канвасе формы.
   • Она обновляет заголовок формы с процентом выполнения (на основе текущей итерационного номера и count).
5. После цикла она рисует финальную целевую картинку (bm2) на канвасе формы и устанавливает заголовок формы в "done".

В отношении предложений и улучшений:

1. Рассмотрите использование более описательного имени переменной вместо i.
2. Вы можете упростить код, удалив повторные проверки высоты и ширины, так как вы устанавливаете их в одинаковую величину.
3. Вместо использования Application.ProcessMessages, рассмотрите использование Form1.Repaint или Canvas.Invalidate для обеспечения правильной перерисовки формы во время процесса преобразования.
4. Вы можете добавить обработку ошибок для случаев, когда файлы битмап не могут быть загружены или когда битмапы имеют разные форматы пикселей.

Вот альтернативное решение с более компактным и эффективным подходом:

procedure TForm1.Button1Click(Sender: TObject);
var
  bm, bm1, bm2: TBitMap;
  p, p1, p2: PByteArray;
  i: integer;
begin
  bm := TBitMap.Create;
  bm1 := TBitMap.Create;
  bm2 := TBitMap.Create;
  bm1.LoadFromFile('Bitmap1.bmp');
  bm2.LoadFromFile('Bitmap2.bmp');

   // Установка формата пикселей и размеров для соответствия наименьшей битмапе
  if bm1.Height < bm2.Height then
    bm.Height := bm1.Height
  else
    bm.Height := bm2.Height;

  if bm1.Width < bm2.Width then
    bm.Width := bm1.Width
  else
    bm.Width := bm2.Width;

  bm.PixelFormat := pf24bit;
  bm1.PixelFormat := pf24bit;
  bm2.PixelFormat := pf24bit;

   // Преобразование битмапы с помощью одиночной цикла
  for i := 0 to count - 1 do
  begin
    p := bm.ScanLine[0];
    p1 := bm1.ScanLine[0];
    p2 := bm2.ScanLine[0];

    for x := 0 to bm.Width * 3 - 1 do
      p^[x] := round((p1^[x] * (count - i) + p2^[x] * i) / count);

    Form1.Canvas.Draw(0, 0, bm);
    Form1.Caption := IntToStr(round(i / count * 100)) + '%';
    Application.ProcessMessages;
  end;

   // Рисование финальной целевой битмапы
  Form1.Canvas.Draw(0, 0, bm2);
  Form1.Caption := 'done';

  bm1.Destroy;
  bm2.Destroy;
  bm.Destroy;
end;

В этом коде используется одиночный цикл для преобразования битмапы и удаляются некоторые повторные проверки и расчеты. Он также использует более компактные переменные и удаляет ненужные присваивания.

Статья рассказывает о способе плавного преобразования одного рисунка в другой с помощью изменения каждого пикселя на основе линейной интерполяции между двумя исходными битмапами.

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

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

:: Главная :: Изображения ::