Mega Code Archive
Make a flickerless animation using copyrect
<![CDATA[
var
Form1: TForm1;
x, y, xvel, yvel, xold, yold: Integer;
implementation
{$R *.dfm}
{You will need an image, called ImageSprite, containing a sprite bitmap with
black as the background (the transparent part). You will also need an image,
called ImageMask, containing a black silouette of the sprite with white as the
background and an Image called ImageBackground containing the background
image. All these images are set to visible := false. Image1 is the image you
will see and is the same size as the background image.}
procedure TForm1.Button1Click(Sender: TObject);
var
ARect: TRect; // Destination/Source rectangles
begin
//Initialize sprites position/velocity
x := 0;
y := 100;
xvel := 3;
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 - ImageMask.Width) or (x < 0) then xvel := -xvel;
if (y > ImageBackground.Height - ImageMask.Height) or (y < 0) then yvel := -yvel;
end;
]]>