图像幻灯片效果。BitBlt闪烁

html5 • • 问答

我想创建一个幻灯片效果：在窗体的画布上从右到左绘制一个位图。为此，我使用 BitBlt。

我在定时器（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;

但是，图像进展并不顺利。它有某种闪烁，但不是我们在 VCL 中所知道的那种闪烁。很难描述它。这就像图像向前移动两个像素，然后向后移动一个像素。

如何让图像流畅地移动？难道真的是由显示器的刷新率引起的吗？

更新：我不知道为什么，但它是由计时器引起的。如果我在“for”循环中调用 Slide()，那么动画是平滑的。我知道计时器的精度约为 15 毫秒，但我仍然不明白为什么它会使图像闪烁。如果我在循环内添加一个雪橇（1），则会再次出现微光效果，而且情况更糟。看起来图像真的被绘制了两次。

回答

首先，您应该只在表单OnPaint处理程序中的表单上绘画。我不知道你是否这样做，但你应该这样做。

其次，您不能真正依赖于WM_TIMER非常精确甚至恒定的连续消息之间的时间距离。所以每次画画时最好检查一下实际时间。例如，您可以使用Position = Original Position + Velocity × Time学校物理中已知的公式。

此外，为了避免闪烁，您可能应该处理WM_ERASEBKGND.

把这些放在一起，

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.

我认为这与使用 GDI（1980 年代的图形 API）一样好。我敢打赌它在 Direct2D（或 OpenGL，如果你喜欢的话）中看起来会更好。

更新

经过进一步调查，我怀疑通常的计时器不够好。问题有两个：(1) 普通计时器可获得的最佳 FPS 太低。(2) 两个连续WM_TIMER消息之间的持续时间不是恒定的这一事实会导致视觉问题。

如果我改为使用高分辨率多媒体计时器，忽略它们已被弃用的事实，我会得到更好的结果：

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.

更新 2

这是未弃用的版本：

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.

另外，我之前说过精确的结果取决于 CPU、GPU、操作系统和显示器。但这也取决于眼睛和大脑。使这个动画需要如此高质量计时器的原因是，运动是一个简单的匀速平移，眼睛+大脑可以很容易地发现任何缺陷。如果我们为弹跳球或 SHM 设置动画，那么老式计时器就足够了。

以上是图像幻灯片效果。BitBlt闪烁的全部内容。
THE END
分享
二维码
< <上一篇
下一篇>>