Пример 3. Метод базовой точки

 

Создадим приложение, демонстрирующее анимацию, основанную на методе базовой точки.

 

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls;

 

type

  TForm1 = class(TForm)

    Timer1: TTimer;

    procedure Timer1Timer(Sender: TObject);

    procedure FormActivate(Sender: TObject);

 

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

  x, y: integer;

implementation

 

{$R *.dfm}

 

procedure Train(x,y: integer;   // координаты базовой точки

                  color: TColor); // цвет линий

const

  dx = 5;

  dy = 5;

var

  buf: TColor;

begin

  with form1.canvas do

  begin

    buf:=pen.Color;   // сохраним текущий цвет

    pen.Color:=color; // установим нужный цвет

    //  вагон

    Rectangle(x,y,x+16*dx,y+9*dy);

    Rectangle(x+dx,y+dy,x+5*dx,y+5*dy);

    Rectangle(x+6*dx,y+dy,x+10*dx,y+5*dy);

    Rectangle(x+6*dx,y+dy,x+10*dx,y+5*dy);

    Rectangle(x+11*dx,y+dy,x+15*dx,y+5*dy);

 

    //колёса вагона

    Ellipse(x+dx,y+7*dy,x+5*dx,y+11*dy);

    Ellipse(x+2*dx,y+8*dy,x+4*dx,y+10*dy);

    Ellipse(x+11*dx,y+7*dy,x+15*dx,y+11*dy);

    Ellipse(x+12*dx,y+8*dy,x+14*dx,y+10*dy);

    // кабина

    MoveTo(x+16*dx,y+6*dy);

    LineTo(x+18*dx,y+6*dy);

    MoveTo(x+16*dx,y+8*dy);

    LineTo(x+18*dx,y+8*dy);

 

    MoveTo(x+17*dx,y);

    LineTo(x+24*dx,y);

    arc(x+24*dx,y-dy,x+17*dx,y+2*dy,x+24*dx,y,x+17*dx,y);

    Rectangle(x+18*dx,y,x+23*dx,y+9*dy);

 

    Rectangle(x+19*dx,y+dy,x+22*dx,y+4*dy+1);

    Rectangle(x+19*dx,y+4*dy,x+22*dx,y+8*dy);

    Rectangle(x+23*dx-1,y+4*dy,x+36*dx,y+9*dy);

    // труба

    Rectangle(x+32*dx-1,y-dy,x+34*dx,y+4*dy+1);

    // колёса

    Ellipse(x+20*dx,y+7*dy,x+24*dx,y+11*dy);

    Ellipse(x+21*dx,y+8*dy,x+23*dx,y+10*dy);

 

    Ellipse(x+25*dx,y+7*dy,x+29*dx,y+11*dy);

    Ellipse(x+26*dx,y+8*dy,x+28*dx,y+10*dy);

 

    Ellipse(x+30*dx,y+7*dy,x+34*dx,y+11*dy);

    Ellipse(x+31*dx,y+8*dy,x+33*dx,y+10*dy);

 

    Polygon([Point(x+35*dx,y+8*dy), Point(x+36*dx,y+8*dy),

    Point(x+37*dx,y+10*dy), Point(x+35*dx,y+10*dy)]);

    pen.Color:=buf; // восстановим старый цвет карандаша

 

  end;

end;

 

// обработка сигнала таймера

procedure TForm1.Timer1Timer(Sender: TObject);

begin

   Train(x,y,form1.color); // стереть рисунок

   if x < Form1.ClientWidth

      then x := x+5

      else begin // новый рейс

        x := 0;

        y := Random(50) + 100;

      end;

   Train(x,y,clMaroon);     // нарисовать в новой точке

end;

 

procedure TForm1.FormActivate(Sender: TObject);

begin

     x:=0;

     y:=50;

     Form1.Color:=clInfoBk;

     Timer1.Interval := 50; // сигнал таймера каждые 50 мСек

      flower(10,10,clRed);

 

end;

end.

 

Вид приложения во время его выполнения: