Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
29
Добавлен:
16.04.2013
Размер:
5.74 Кб
Скачать
unit Canvas;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure xz(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
{$J+}
{$WRITEABLECONST ON}

procedure TForm1.xz(Sender: TObject);
const
{шасси автомобиля}
osn:array[1..6] of TPoint=((x:485;y:355),(x:605;y:355),
(x:605;y:375),(x:385;y:375),
(x:385;y:365),(x:485;y:365));
{кабина}
kab:array[1..6] of TPoint=((x:485;y:365),(x:485;y:305),
(x:455;y:305),(x:445;y:335),
(x:395;y:345),(x:395;y:365));
{окно 1}
ok1:array[1..4] of TPoint=((x:480;y:335),(x:467;y:335),
(x:467;y:308),(x:480;y:308));
{окно 2}
ok2:array[1..4] of TPoint=((x:463;y:335),(x:448;y:335),
(x:457;y:308),(x:463;y:308));
{ Процедура установки цвета пера и цвета кисти }
procedure fillcolor(a,b:LongWord);
begin {fillcolor}
with Form1.Canvas do
begin
Pen.Color := a;
Brush.Color:= b;
end;
end; {fillcolor}

begin {FormClick}
//Form1.WindowState := wsMaximized;{Установить макс.размер окна приложе-}
with Form1.Canvas do {ния, чтобы рисунок был виден полностью}
begin
fillcolor(clBlack,clBlue); FillRect(Rect(0,0,639,400)); {небо}
fillcolor(clBlack,clGreen);FillRect(Rect(0,400,639,479)); {трава}
fillcolor(clYellow,clYellow);Ellipse(550,10,630,90); {солнце}
fillcolor(clWhite,clWhite); Ellipse(20,20,80,80); {облако}
Ellipse(50,0,150,100); Ellipse(110,10,190,90);
fillcolor(clMaroon,clMaroon);FillRect(Rect(495,325,625,355));{кузов}
fillcolor(clGray,clGray); PolyGon(osn); {шасси автомобиля}
fillcolor(clSilver,clSilver);PolyGon(kab); {кабина}
fillcolor(clTeal,clTeal); PolyGon(ok1); {окно1}
PolyGon(ok2); {окно2}
fillcolor(clBlack,clBlack);
Ellipse(400,350,450,400); Ellipse(540,350,590,400); {шины}
fillcolor(clSilver,clSilver);
Ellipse(415,365,435,385); Ellipse(555,365,575,385); {диски колес}
end;
form1.Canvas.Lock ;
end; {FormClick}





procedure TForm1.Button1Click(Sender: TObject);
const
CarLength = 245; {Длина изображения автомобиля}
CarHeight = 96; {Высота изображения автомобиля}
XL : Integer = 385; {Координаты}
YL = 305; {прямоугольника с }
XR : Integer = 625; {изображением}
YR = 400; {автомобиля}
var {Копия изображения автомобиля}
CarImage : array [1..CarLength,1..CarHeight] of TColor;


{--------------------------------------}
procedure SaveCar; {Сохранить копию изображения автомобиля}
var {--------------------------------------}
x, y : Integer; {Координаты пикселей}
i, j : Integer; {Индексы элементов массива}
begin {SaveCar}
x := XL;
for i:=1 to CarLength do
begin
y := YL;
for j:=1 to CarHeight do
begin
CarImage[i,j] := Form1.Canvas.Pixels[x,y];
y := y + 1;
end;
x := x + 1;
end;
end; {SaveCar}
{------------------------------}
procedure EraseCar; {Стереть изображение автомобиля}
begin {----------} {EraseCar}
with Form1.Canvas do
begin
Brush.Color := clBlue; {Цвет неба, на фоне которого едет авто}
FillRect(Rect(XL,YL,XR,YR));
end;
end; {EraseCar}
{------------------------------------------}
procedure DisplayCar; {Воспроизвести копию изображения автомобиля}
var {------------------------------------------}
x, y : Integer; {Координаты пикселей}
i, j : Integer; {Индексы элементов массива}
begin {DisplayCar}
x := XL;
for i:=1 to CarLength do
begin
y := YL;
for j:=1 to CarHeight do
begin
Form1.Canvas.Pixels[x,y] := CarImage[i,j];
y := y + 1;
end;
x := x + 1;
end;
end; {DisplayCar}

begin {Button1Click}
xz(Form1); {Нарисовать автомобиль}
SaveCar;
repeat
// EraseCar;

Xl:=xl-5 ; {Движение влево}
Xr:= xr -5;

DisplayCar;
until XL<0;
end; {Button1Click}

end.
Соседние файлы в папке laba4(canvas)
  • #
    16.04.20136.43 Кб28Canvas.dcu
  • #
    16.04.201351 б27Canvas.ddp
  • #
    16.04.2013513 б27Canvas.dfm
  • #
    16.04.20135.74 Кб29Canvas.pas
  • #
    16.04.201351 б27Canvas.~ddp
  • #
    16.04.2013513 б27Canvas.~dfm
  • #
    16.04.20135.74 Кб27Canvas.~pas
  • #
    16.04.201333 б30zadanie.txt
  • #
    16.04.2013330 б27_Canvas.cfg