Mega Code Archive
How to implement flickerless animation of a sprite moving across a background image
<![CDATA[
Title: How to implement flickerless animation of a sprite moving across a background image
// Global variables
var
Form1: TForm1;
x, y, xvel, yvel, xold, yold: integer;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
ARect: TRect; // Destination/Source rectangles
begin
// Initialize sprites position/velocity
x := 0;
y := 0;
xvel := 2;
yvel := 2;
xold := 0;
yold := 0;
// copy background to the image
ARect := Rect(0, 0, ImageBackground.Width, ImageBackground.Height);
with Image1.Canvas do
begin
CopyMode := cmSrcCopy;
CopyRect(ARect, ImageBackground.Canvas, ARect);
end;
// start animation
Timer1.Enabled := True;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
Dest, Sour: TRect; // Destination/Source rectangles
begin
// Erase sprite from old position
Sour := Rect(xold, yold, xold ImageMask.Width, yold ImageMask.Height);
with Image1.Canvas do
begin
CopyMode := cmSrcCopy;
CopyRect(Sour, ImageBackground.Canvas, Sour);
end;
// Draw new sprite
Sour := Rect(0, 0, ImageMask.Width, ImageMask.Height);
Dest := Rect(x, y, x ImageMask.Width, y ImageMask.Height);
with Image1.Canvas do
begin
// Place mask onto image
CopyMode := cmSrcAnd;
CopyRect(Dest, ImageMask.Canvas, Sour);
// Place sprite into mask
CopyMode := cmSrcPaint;
CopyRect(Dest, ImageSprite.Canvas, Sour);
end;
{
if multiple sprites are being used, then erase them all before drawing them
all. Do not erase and draw each sprite in turn
}
// store sprites old position before updating
xold := x;
yold := y;
// Update sprites position (equations to describe movement of sprite)
Inc(x, xvel);
Inc(y, yvel);
if x = ImageBackground.Width then x := -ImageMask.Width;
if y = ImageBackground.Height then y := -ImageMask.Height;
end;
]]>