Image slide effect. BitBlt shimmers - delphi

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.

Answer 1

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.

Answer 2

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.

Answer 3

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;