Среда программирования:
Delphi (Lazarus)
Основное отличие движения по неоднородному фону от движения по однородному фону состоит в том, что движущийся объект уже не закрашивается цветом фона, а восстанавливается часть изображения по которому движется объект и лишь затем происходит его прорисовка.
Для сохранения части изображения используется класс TBitMap (битовая карта изображения). Используя методы этого класса вырезаем часть изображения и по таймеру производим восстановление изображения и прорисовку объекта на новом месте.
unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Buttons, ExtCtrls, StdCtrls; type { TForm1 } TForm1 = class(TForm) Button1: TButton; PaintBox1: TPaintBox; Timer1: TTimer; procedure Button1Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { private declarations } // координаты прорисовки объекта. Доступны всем процедурам класса TForm1 x1, y1 : Integer; ARect : TRect; BitMap : TBitMap; public { public declarations } // процедура прорисовки облака procedure Cloud (x, y: Integer; ColorCloud: TColor); end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.Cloud(x, y: Integer; ColorCloud: TColor); begin // прорисовка облака из трех эллипсов with PaintBox1.Canvas do begin Pen.Style := psClear; Brush.Color := ColorCloud; Ellipse(x,y,x+80,y+40); Ellipse(x+30,y+10,x+120,y+50); Ellipse(x+40,y-10,x+150,y+35); end; end; procedure TForm1.Button1Click(Sender: TObject); begin // установка начальных значений x1:=0; y1:=50; Timer1.Interval:=30; // прорисовка картинки по которой двигается объект PaintBox1.Canvas.Brush.Color := clBlue; PaintBox1.Canvas.Rectangle(0,0, PaintBox1.Width, PaintBox1.Height); PaintBox1.Canvas.Brush.Color := clYellow; PaintBox1.Canvas.Ellipse(50,50, 150, 150); Cloud(200,100,clWhite); Cloud(400,10,clWhite); // Сохранение части изображения в BitMap-массив BitMap := TBitmap.Create; BitMap.Width := PaintBox1.Width; BitMap.Height := 100; ARect := Rect(0,y1-10,PaintBox1.Width,y1+90); BitMap.Canvas.CopyRect(ARect,PaintBox1.Canvas, ARect); // Включение таймера - запуск анимации Timer1.Enabled := true; end; procedure TForm1.Timer1Timer(Sender: TObject); begin // Восстановление изображения из BitMap-массива ARect := Rect(0,y1-10,PaintBox1.Width,y1+90); PaintBox1.Canvas.CopyRect(ARect, BitMap.Canvas, ARect); // Прорисовка объекта Cloud(x1,y1,clWhite); x1 := x1+1; // Если объект вышел за пределы окна, то начать движение объекта сначала if x1 > PaintBox1.Width then x1:= -100; end; end.
Прикрепленный файл | Размер |
---|---|
Демонстрация урока | 597.5 кб |