Как сделать анимацию немерцающей

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

Мерцание возникает, когда цвет точки меняется два раза подряд. Например, правильнее объект при его перемещении стирать и затем рисовать на новом месте не на экране, а в памяти, и выводить на форму уже готовое изображение поверх предыдущего. В таком случае смена цветов на экране происходит только один раз.

var
  bm: TBitMap;

procedure TForm1.FormCreate(Sender: TObject);
begin
  bm := TBitMap.Create;
  bm.Width := Form1.ClientWidth;
  bm.Height := Form1.ClientHeight;
  with bm.Canvas do
  begin
    Font.name := 'Arial';
    Font.Size := 50;
    Font.Color := clBlue;
  end;
  Timer1.Interval := 100;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  s: string;
  Hour, Min, Sec, MSec: Word;
begin
  DecodeTime(Time, Hour, Min, Sec, MSec);
  with bm.Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := clWhite;
    FillRect(ClipRect);
    s := TimeToStr(Time);
    TextOut((bm.Width - TextWidth(s)) div 2,
    (bm.Height - TextHeight(s)) div 2, s);
    Pen.Mode := pmMask;
    Pen.Width := 20;
    Pen.Color := clLime;
    Brush.Style := bsClear;
    Rectangle(bm.Width div 2 - (MSec * bm.Width) div 5000,
    bm.Height div 2 - (MSec * bm.Height) div 5000,
    bm.Width div 2 + (MSec * bm.Width) div 5000,
    bm.Height div 2 + (MSec * bm.Height) div 5000);
  end;
  Form1.Canvas.Draw(0, 0, bm);
end;

Перед фликарингом (мерцанием), вы можете попробовать следующее:

1. Двойная буферизация: вместо рисования прямо на канвасе формы, создайте временный битмап, нарисуйте на нем и затем скопируйте его содержимое в канвас формы. таким образом, только один обновление будет виден в то время.
2. Перерисуйте всю сцену: вместо обновления отдельных частей анимации, перерисуйте всю сцену заново каждый кадр. это может помочь избежать артефактов рисования.
3. Используйте Canvas.Lock и Canvas.Unlock: заблокируйте канвас перед рисованием, а затем разблокируйте его после завершения операции рисования. это поможет предотвратить вмешательство других процессов в ваш код рисования.

Вот модифицированная версия вашего кода, которая включает эти предложения:

var
  bm: TBitmap;
  temp_bm: TBitmap;

procedure TForm1.FormCreate(Sender: TObject);
begin
  bm := TBitmap.Create;
  bm.Width := Form1.ClientWidth;
  bm.Height := Form1.ClientHeight;
  with bm.Canvas do
  begin
    Font.Name := 'Arial';
    Font.Size := 50;
    Font.Color := clBlue;
  end;

  temp_bm := TBitmap.Create;
  temp_bm.Width := Form1.ClientWidth;
  temp_bm.Height := Form1.ClientHeight;
  with temp_bm.Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := clWhite;
  end;

  Timer1.Interval := 100;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  s: string;
  Hour, Min, Sec, MSec: Word;
begin
  DecodeTime(Time, Hour, Min, Sec, MSec);

  with temp_bm.Canvas do
  begin
    // Clear the temporary bitmap
    Brush.Style := bsSolid;
    Brush.Color := clWhite;
    FillRect(ClipRect);

    s := TimeToStr(Time);
    TextOut((temp_bm.Width - TextWidth(s)) div 2,
            (temp_bm.Height - TextHeight(s)) div 2, s);

    Pen.Mode := pmMask;
    Pen.Width := 20;
    Pen.Color := clLime;
    Brush.Style := bsClear;

    Rectangle(temp_bm.Width div 2 - (MSec * temp_bm.Width) div 5000,
               temp_bm.Height div 2 - (MSec * temp_bm.Height) div 5000,
               temp_bm.Width div 2 + (MSec * temp_bm.Width) div 5000,
               temp_bm.Height div 2 + (MSec * temp_bm.Height) div 5000);
  end;

  // Copy the temporary bitmap to the form's canvas
  Form1.Canvas.Lock;
  try
    Form1.Canvas.Draw(0, 0, temp_bm);
  finally
    Form1.Canvas.Unlock;
  end;
end;

В этом модифицированном коде:

• Создайте новый переменную temp_bm для служения как временного битмапа для рисования.
• В событии таймера, я очищаю и перерисовываю всю сцену на временном битмапе (temp_bm).
• После завершения рисования, я копирую содержимое temp_bm в канвас формы используя Form1.Canvas.Draw.
• Это должно помочь уменьшить или избежать фликаринга (мерцания) в вашей анимации.

Статья рассказывает о способах создания анимации без мерцания, описывая методы стирания и рисования объектов в памяти для предотвращения смены цветов на экране более одного раза.

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

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

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