Image slide effect. BitBlt shimmers

Question

I want to create a slide effect: one bitmap is painted from right to left on a form's canvas. For this I use BitBlt.

I call this function in a Timer (20ms):

var ViewPort: TRect;
ViewPort.Left   := 0;
ViewPort.Top    := 0;
ViewPort.Width  := 1400;
ViewPort.Height := 900;

x: integer := spnStep.Value;  //SpinBox.Value = 10

procedure TfrmTester.Slide(BMP: TBitmap; ViewPort: TRect);
begin
 Inc(x, spnStep.Value);

 if x >= ViewPort.Width then
  begin
   x:= ViewPort.Width;
   Timer.Enabled:= FALSE;
  end;

 BitBlt(frmTester.Canvas.Handle,
        ViewPort.Width-x, 0,    //  X, Y
        x, ViewPort.Height,     // cX, cY
      BMP.Canvas.Handle, 0, 0, SRCCOPY);
end;

However, the image does not progress smoothly. It has some kind of flicker, but not the kind of flicker that we know in the VCL. It is difficult to describe it. It is like the image moves two pixels forward and then one pixel backward.

How to make the image move smoothly? Could the actually be caused by the refresh rate of the monitor?

Update: I don't know why, but it is caused by the timer. If I call Slide() in a 'for' loop then the animation is smooth. I know that the timer has an accuracy of ~15ms, but I still don't get it why it makes the image to shimmer. If I add a sleed(1) inside the loop the shimmer effect appears again, and it is even worse. It really looks like the image is drawn twice.

Andreas Rejbrand · Accepted Answer · 2021-06-13T21:47:46.297

First, you should only paint on the form in the form's OnPaint handler. I don't know if you do that or not, but you should do so.

Second, you cannot really rely on the temporal distance between successive WM_TIMER messages being very precise or even constant. So it is better to check the actual time each time you paint. For instance, you may use the formula Position = Original Position + Velocity × Time known from school physics.

Also, to avoid flickering, you should probably handle WM_ERASEBKGND.

Putting these together,

unit AnimatedRabbit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, ExtCtrls;

type
  TMainForm = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    FRabbit: TBitmap;
    FStartTime: TDateTime;
  const
    Speed = -100;
    function GetRabbitLeft: Double;
  protected
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  public

  end;

var
  MainForm: TMainForm;

implementation

uses
  DateUtils;

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FRabbit := TBitmap.Create;
  FRabbit.LoadFromFile('K:\rabbit.bmp');
  FStartTime := Now;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FRabbit);
end;

procedure TMainForm.FormPaint(Sender: TObject);
var
  x: Integer;
begin
  x := Round(GetRabbitLeft);
  BitBlt(
    Canvas.Handle,
    x,
    0,
    FRabbit.Width,
    FRabbit.Height,
    FRabbit.Canvas.Handle,
    0,
    0,
    SRCCOPY
  );
  Canvas.Brush.Color := Color;
  if x > 0 then
    Canvas.FillRect(Rect(0, 0, x - 1, ClientHeight));
  if x + FRabbit.Width < ClientWidth then
    Canvas.FillRect(Rect(x + FRabbit.Width, 0, ClientWidth, ClientHeight));
end;

function TMainForm.GetRabbitLeft: Double;
begin
  Result := ClientWidth + Speed * SecondSpan(Now, FStartTime);
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
  Invalidate;
  if GetRabbitLeft + FRabbit.Width < 0 then
    Timer1.Enabled := False;
end;

procedure TMainForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

end.

~~I think this is as good as you can make it using GDI (a graphics API from the 1980s). I bet it will look better in Direct2D (or OpenGL, if you prefer that).~~

Update

After further investigation, I suspect that the usual timer isn't good enough. The problem is two-fold: (1) The best FPS obtainable by a normal timer is too low. (2) The fact that the duration between two consecutive WM_TIMER messages isn't constant causes visual issues.

If I instead use a high-resolution multimedia timer, ignoring the fact that they are deprecated, I get a nicer result:

unit AnimatedRabbit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, ExtCtrls;

const
  WM_DOINVALIDATE = WM_USER + 1;

type
  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FRabbit: TBitmap;
    FStartTime: TDateTime;
    FMMEvent: Cardinal;
  const
    Speed = -100;
    function GetRabbitLeft: Double;
  protected
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMDoInvalidate(var Message: TMessage); message WM_DOINVALIDATE;
  public

  end;

var
  MainForm: TMainForm;

implementation

uses
  DateUtils, MMSystem, Math;

{$R *.dfm}

procedure RepaintFunc(wTimerID: UINT; msg: UINT; dwUser: NativeUINT;
  dw1, dw2: NativeUINT); stdcall;
begin
  PostMessage(MainForm.Handle, WM_DOINVALIDATE, 0, 0);
end;

procedure TMainForm.FormCreate(Sender: TObject);
const
  TargetResolution = 1;
var
  tc: TTimeCaps;
  res: Cardinal;
begin
  FRabbit := TBitmap.Create;
  FRabbit.LoadFromFile('K:\rabbit.bmp');
  FStartTime := Now;
  if timeGetDevCaps(@tc, SizeOf(tc)) <> TIMERR_NOERROR then
    Exit;
  res := EnsureRange(TargetResolution, tc.wPeriodMin, tc.wPeriodMax);
  if timeBeginPeriod(res) <> TIMERR_NOERROR then
    Exit;
  FMMEvent := timeSetEvent(10, res, RepaintFunc, 0, TIME_PERIODIC);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  timeKillEvent(FMMEvent);
  FreeAndNil(FRabbit);
end;

procedure TMainForm.FormPaint(Sender: TObject);
var
  x: Integer;
begin
  x := Round(GetRabbitLeft);
  BitBlt(
    Canvas.Handle,
    x,
    0,
    FRabbit.Width,
    FRabbit.Height,
    FRabbit.Canvas.Handle,
    0,
    0,
    SRCCOPY
  );
  Canvas.Brush.Color := Color;
  if x > 0 then
    Canvas.FillRect(Rect(0, 0, x - 1, ClientHeight));
  if x + FRabbit.Width < ClientWidth then
    Canvas.FillRect(Rect(x + FRabbit.Width, 0, ClientWidth, ClientHeight));
end;

function TMainForm.GetRabbitLeft: Double;
begin
  Result := ClientWidth + Speed * SecondSpan(Now, FStartTime);
end;

procedure TMainForm.WMDoInvalidate(var Message: TMessage);
begin
  Invalidate;
end;

procedure TMainForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

end.

Update 2

And here is the non-deprecated version:

unit AnimatedRabbit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, ExtCtrls;

const
  WM_DOINVALIDATE = WM_USER + 1;

type
  TMainForm = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FRabbit: TBitmap;
    FStartTime: TDateTime;
    FTimer: THandle;
  const
    Speed = -100;
    function GetRabbitLeft: Double;
  protected
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMDoInvalidate(var Message: TMessage); message WM_DOINVALIDATE;
  public

  end;

var
  MainForm: TMainForm;

implementation

uses
  DateUtils, Math;

{$R *.dfm}

procedure RepaintFunc(Context: Pointer; Success: Boolean); stdcall;
begin
  PostMessage(MainForm.Handle, WM_DOINVALIDATE, 0, 0);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  FRabbit := TBitmap.Create;
  FRabbit.LoadFromFile('K:\rabbit.bmp');
  FStartTime := Now;
  if not CreateTimerQueueTimer(FTimer, 0, RepaintFunc, nil, 0, 10, 0) then
    RaiseLastOSError;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  DeleteTimerQueueTimer(0, FTimer, INVALID_HANDLE_VALUE);
  FreeAndNil(FRabbit);
end;

procedure TMainForm.FormPaint(Sender: TObject);
var
  x: Integer;
begin
  x := Round(GetRabbitLeft);
  BitBlt(
    Canvas.Handle,
    x,
    0,
    FRabbit.Width,
    FRabbit.Height,
    FRabbit.Canvas.Handle,
    0,
    0,
    SRCCOPY
  );
  Canvas.Brush.Color := Color;
  if x > 0 then
    Canvas.FillRect(Rect(0, 0, x - 1, ClientHeight));
  if x + FRabbit.Width < ClientWidth then
    Canvas.FillRect(Rect(x + FRabbit.Width, 0, ClientWidth, ClientHeight));
end;

function TMainForm.GetRabbitLeft: Double;
begin
  Result := ClientWidth + Speed * SecondSpan(Now, FStartTime);
end;

procedure TMainForm.WMDoInvalidate(var Message: TMessage);
begin
  Invalidate;
end;

procedure TMainForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

end.

Also, I previously said that the precise result depends on CPU, GPU, OS, and monitor. But it also depends on the eye and brain. The thing that makes this animation require such a high-quality timer is the fact that the motion is a simple translation with constant velocity, and the eye + brain can easily spot any imperfection. If we had animated a bouncing ball or SHM, an old-school timer would have been enough.

meh.... your example is as almost as choppy as mine. I guess, you are right.... maybe cannot be done smoothly without Direct2D. — Gabriel, Jun 13 '21 at 20:00
@Z80: Please try to run the code; I realise that the MP4 added a lot of "flickering". The MP4 is bad, it looks better in reality. It also looks marginally better in Direct2D, I just tried it. — Andreas Rejbrand, Jun 13 '21 at 20:01
Yes. I ran your example. No modifications, expect of a bigger picture (1400x900px). It is quite similar to what I see in the video. — Gabriel, Jun 13 '21 at 20:02
I looked better at the "shimmering" effect (your and mine). It looks like parts of the image are moved forwards, but some parts are not... at least not immediately. — Gabriel, Jun 13 '21 at 20:08
PS: I think it can be done also with GetTickCount instead of hires timer. — Gabriel, Jun 14 '21 at 09:46
@Z80: No. You need the system to invoke your refreshing code regularly. Hence, you need a timer that sends you `WM_TIMER` messages, or a timer that invokes a procedure of your choice regularly. `GetTickCount` only tells you the current time. It won't make any code execute! — Andreas Rejbrand, Jun 14 '21 at 09:47
@adreas- Yes, but one could use a loop instead of a timer and wait in the loop. But instead of sleep one could use GetTickCount. Of course this will freeze the program. I need my slide effect to be 1-second longs. I think I afford to freeze the program for 1 second. But don't get me wrong. I don't disagree with you. The timer is a more elegant solution. — Gabriel, Jun 14 '21 at 17:25

score 3 · Answer 2 · answered Jun 13 '21 at 19:12

3

You should not be drawing on the Form's Canvas from outside of its OnPaint event at all. All of the drawing should be in the OnPaint event only. Have your timer save the desired information into variables that the Form can access, and then Invalidate() the Form, and let its OnPaint event draw the image using the latest saved information.

Alternatively, simply display your BMP inside a TImage control, and then have the timer set that control's Left/Top/Width/Height properties as needed. Let the TImage handle the drawing of the image for you.

answered Jun 13 '21 at 19:12

Remy Lebeau

555,201
31
458
770

So, my Slide procedure should be inside OnPain, and then in the timer I call MyForm.Invalidate? – Gabriel Jun 13 '21 at 19:24
"*my Slide procedure should be inside OnPain*" - no. It should save the provided parameters, and any calcaluted values as needed, to variables that the `OnPaint` handler can access. "*and then in the timer I call MyForm.Invalidate?*" - yes. – Remy Lebeau Jun 13 '21 at 19:43
1

@Z80: The `BitBlt` should definitely be in `OnPaint`. What Remy is trying to say is probably that the things before the `BitBlt` in your `Slide` shouldn't be in `OnPaint` (but in the timer, for instance). – Andreas Rejbrand Jun 13 '21 at 20:26
Sorry. My bad. I was thinking at the main painting function (BitBlt) which is in Slide. I shouldn't have use "Slide" in my comment. – Gabriel Jun 14 '21 at 09:42

score 0 · Answer 3 · answered Jun 14 '21 at 18:57

0

You can use AnimateWindow

Here's the DFM. Just add client aligned TPicture inside the TPanel

object Form30: TForm30
  Left = 0
  Top = 0
  Caption = 'Form30'
  ClientHeight = 337
  ClientWidth = 389
  Color = clBtnFace
  DoubleBuffered = True
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 389
    Height = 289
    Align = alTop
    BevelOuter = bvNone
    Color = clRed
    FullRepaint = False
    ParentBackground = False
    ShowCaption = False
    TabOrder = 0
    Visible = False
  end
  object Button1: TButton
    Left = 136
    Top = 304
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 1
    OnClick = Button1Click
  end
end

And the Button1.OnClick handler:

procedure TForm30.Button1Click(Sender: TObject);
begin
    AnimateWindow(Panel1.Handle, 1000, AW_SLIDE or AW_HOR_POSITIVE or AW_ACTIVATE);
end;

answered Jun 14 '21 at 18:57

dwrbudr

607
4
8

got it: Winapi.Windows.AnimateWindow – Gabriel Jun 14 '21 at 19:46
https://stackoverflow.com/questions/8625201/delphi-animatewindow-like-in-firefox – Gabriel Jun 14 '21 at 20:03
that flickers like hell!! – Gabriel Jun 14 '21 at 20:03
This is also synchronous -- that is, you block the GUI thread during the animation. You shouldn't do that for even half a second. (What if the user tries to move or resize the window? Minimize or restore? What if Windows decides that the app is not responding and replaces its window with a white ghost window?) – Andreas Rejbrand Jun 14 '21 at 20:15
It doesn't flicker at all on my side with image 1400x900. Make sure to set TPanel.FullRepaint to False, and form DoubleBuffered to True. @AndreasRejbrand: Delphi's TSplitView is asynchronous? No. – dwrbudr Jun 15 '21 at 05:00
@dwrbudr: Yes, `TSplitView`'s methods return immediately and use a timer to do the animation! But even if that control had been badly designed, that wouldn't mean that it is OK to do so! – Andreas Rejbrand Jun 15 '21 at 06:35

Image slide effect. BitBlt shimmers

3 Answers3

Update

Update 2