Работа с простой графикой и OpenGL. Delphi (Lazarus)

• Название: Delphi (Lazarus)
• Дата: 02.05.2018
• Размер: 0.56 Mb.
• Имя файла: Работа с простой графикой и OpenGL .docx
• Тип: Документы; #42659
• страница: 4 из 6

Простая анимация. Линейное движение объекта по однородному фону

18. Февраль 2013 - 18:24 | admin

Среда программирования: 

Delphi (Lazarus)

Линейное движение по однородному фону является довольно простым в плане программной реализации. Достаточно закрашивать объект цветом фона, изменять его координаты и прорисовывать в новом месте, повторяя эти действия через определенный интервал времени.

Для реализации анимации, помимо двух уже известных компонентов TPaintBox (поле для рисования) и TButton (кнопка запуска), понадобится компонент TTimer со вкладки System. Компонент Timer имеет единственное событие OnTimer, которое выполняется пока Timer включен с интервалом по времени, установленным в свойстве Interval.

Расположите компонент Timer1 на форме. Установите его свойства Timer1.Interval := 100 и Timer1.Enabled := false



В коде программы необходимо прописать три процедуры (см. урок "Процедуры и функции при построении изображений"). Процедуру отрисовки объекта procedure TForm1.Cloud, процедуру, отрабатывающую на событие OnTimer, - procedure TForm1.Timer1Timer и процедуру запуска анимации, срабатывающую на нажатие кнопки, procedure TForm1.Button1Click.

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;

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+100,y+50);

end;

end;

 

 

procedure TForm1.Button1Click(Sender: TObject);

begin

// установка начальных значений

x1:=0;

y1:=50;

Timer1.Interval:=100;

// прорисовка картинки по которой двигается объект

PaintBox1.Canvas.Brush.Color := clBlue;

PaintBox1.Canvas.Rectangle(0,0, PaintBox1.Width, PaintBox1.Height);

// Включение таймера - запуск анимации

Timer1.Enabled := true;

end;

 

procedure TForm1.Timer1Timer(Sender: TObject);

begin

// Закраска объекта цветом фона

Cloud(x1,y1,clBlue);

// Изменение координат прорисовки

x1:=x1+1;

// Прорисовка объекта в новом месте

Cloud(x1,y1,clWhite);

end;

 

end.

Простая анимация. Линейное движение объекта по неоднородному фону

19. Февраль 2013 - 15:18 | admin

Среда программирования: 

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.