Delphi World - Сделать немерцающей анимацию при помощи CopyRect
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Сделать немерцающей анимацию при помощи CopyRect

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

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;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования