Program Lab8;
Uses {Используемые модули}
crt, graph;
const {Описание констант}
NPoints = 200; {Количество точек(звёзд) на экране}
type {Описание типов}
TGrObj = object {Абстрактный объект с общими полями и методами}
x,y: integer; {Опорная точка}
color: word; {Цвет фигуры}
constructor Init(aX, aY: integer; aColor: word);
procedure Draw(aColor: word); Virtual;
procedure Show;
procedure Hide;
procedure MoveTo(dx,dy: integer);
end;
TPoint = object(TGrObj) {Объект точки}
procedure Draw(aColor: word); Virtual;
end;
TLine = object(TGrObj) {Объект линии}
dx,dy: integer;
constructor Init(x1,y1,x2,y2: integer; aColor: word);
procedure Draw(aColor: word); Virtual;
end;
TCircle = object(TGrObj) {Объект окружности}
R: integer;
constructor Init(aX,aY,aR: integer; aColor: word);
procedure Draw(aColor: word); Virtual;
end;
TRect = object(TLine) {Объект прямоугольника}
procedure Draw(aColor: word); Virtual;
end;
TGrApp = object {Программный объект}
Points: array [1..NPoints] of TPoint;
Line: TLine;
Circ: TCircle;
Rect: TRect;
ActiveObj: Integer;
procedure Init;
procedure Run;
procedure Done;
procedure ShowAll;
procedure MoveActive(dx,dy: integer);
end;
constructor TGrObj.Init; {Инициализация}
procedure TGrObj.Draw; {Рисование фигуры, процедура для переопределения}
procedure TGrObj.Show; {Показ фигуры}
procedure TGrObj.Hide; {Скрытие фигуры}
procedure TGrObj.MoveTo; {Сдвиг фигуры}
procedure TPoint.Draw; {Рисование точки}
constructor TLine.Init; {Инициализация линии, с наследованием}
procedure TLine.Draw; {Рисование линии}
constructor TCircle.Init;{Инициализация окружности, с наследованием}
procedure TCircle.Draw; {Рисование окружности}
procedure TRect.Draw; {Рисование прямоугольника}
procedure TGrApp.Init; {Инициализация программаного объекта}
begin
{определение видеоадаптера и инициалиция графического режима}
{Инициализация точек, линии, окружности и прямоугольника}
for k:=1 to NPoints do
Points[k].Init(Random(GetMaxX), Random(GetMaxY), 7);
Line.Init({координаты и цвет});
Circ.Init({координаты, радиус и цвет });
Rect.Init({координаты и цвет});
ShowAll; {Отображение всех графических объектов}
ActiveObj:=1; {задание активного элемента}
end;
procedure TGrApp.Run; {Работа программного объекта}
begin
repeat
case ReadKey of
#27: Stop:=true; {Выход по нажатию Esc}
#9: begin {Выбор активного объекта нажатием Tab}
inc(ActiveObj);
if ActiveObj>3 then ActiveObj:=1;
end;
#13: Init; {Повторная инициализация(отрисовка) по нажатию Enter}
#0: case ReadKey of {перемещение объекта во все стороны на 5 px}
#72: MoveActive(0,-d); {вверх}
#75: MoveActive(-d,0); {влево}
#77: MoveActive(d,0); {вправо}
#80: MoveActive(0,d); {вниз}
end;
end;
ShowAll; {Отображение всех графических объектов с новыми координатами}
until Stop;
end;
procedure TGrApp.Done; {Завершение работы графического режима}
procedure TGrApp.ShowAll; {Отображение всех графических}
procedure TGrApp.MoveActive; {Перемещение объектов}
var {описание переменных}
App: TGrApp; {переменная объектового типа}
begin
App.Init; {Инициализация}
App.Run; {Сама работа}
App.Done; {Завершение работы}
end.
Программа позволяет перемещать простые геометрические фигуры по экрану, на фоне «звездного» неба. Выбор фигуры осуществляется клавишей Tab.
Рисунок 1 – Результат работы программы(исходное состояние)
Рисунок 2 – Результат работы программы(процесс работы)
Program Lab8;
uses
crt, graph;
const
NPoints = 200;
type
TGrObj = object
x,y: integer;
color: word;
constructor Init(aX, aY: integer; aColor: word);
procedure Draw(aColor: word); Virtual;
procedure Show;
procedure Hide;
procedure MoveTo(dx,dy: integer);
end;
TPoint = object(TGrObj)
procedure Draw(aColor: word); Virtual;
end;
TLine = object(TGrObj)
dx,dy: integer;
constructor Init(x1,y1,x2,y2: integer; aColor: word);
procedure Draw(aColor: word); Virtual;
end;
TCircle = object(TGrObj)
R: integer;
constructor Init(aX,aY,aR: integer; aColor: word);
procedure Draw(aColor: word); Virtual;
end;
TRect = object(TLine)
procedure Draw(aColor: word); Virtual;
end;
TGrApp = object
Points: array [1..NPoints] of TPoint;
Line: TLine;
Circ: TCircle;
Rect: TRect;
ActiveObj: Integer;
procedure Init;
procedure Run;
procedure Done;
procedure ShowAll;
procedure MoveActive(dx,dy: integer);
end;
procedure TGrObj.Draw;
begin
end;
constructor TGrObj.Init;
begin
x:=aX;
y:=aY;
color:=aColor;
end;
procedure TGrObj.Show;
begin
Draw(color);
end;
procedure TGrObj.Hide;
begin
Draw(GetBkColor);
end;
procedure TGrObj.MoveTo;
begin
Hide;
x:=x+dx;
y:=y+dy;
Show;
end;
procedure TPoint.Draw;
begin
PutPixel(x,y,color);
end;
constructor TLine.Init;
begin
inherited Init(x1,y1,aColor);
dx:=x2-x1;
dy:=y2-y1;
end;
procedure TLine.Draw;
begin
SetColor(aColor);
Line(x,y,x+dx,y+dy);
end;
constructor TCircle.Init;
begin
inherited Init(aX,aY,aColor);
R:=aR;
end;
procedure TCircle.Draw;
begin
SetColor(aColor);
Circle(x,y,r);
end;
procedure TRect.Draw;
begin
SetColor(aColor);
Rectangle(x,y,x+dx,y+dy);
end;
procedure TGrApp.Init;
var
d,r,k: integer;
begin
d:=Detect;
InitGraph(d,r,'');
for k:=1 to NPoints do
Points[k].Init(Random(GetMaxX), Random(GetMaxY), 7);
{end for}
Line.Init(GetMaxX div 3, GetMaxY div 3, 2*GetMaxX div 3, 2*GetMaxY div 3, LightRed);
Circ.Init(GetMaxX div 2, GetMaxY div 2, (Random(GetMaxY)+50) div 5, White);
Rect.Init(2*GetMaxX div 5, 2*GetMaxY div 5, 3*GetMaxX div 5, 3*GetMaxY div 5, Yellow);
ShowAll;
ActiveObj:=1;
end;
procedure TGrApp.Run;
const
d = 5;
var
Stop: boolean;
begin
Stop:=false;
repeat
case ReadKey of
#27: Stop:=true;
#9: begin
inc(ActiveObj);
if ActiveObj>3 then ActiveObj:=1;
end;
#13: Init;
#0: case ReadKey of
#72: MoveActive(0,-d);
#75: MoveActive(-d,0);
#77: MoveActive(d,0);
#80: MoveActive(0,d);
end;
{end case}
end;
ShowAll;
until Stop;
end;
procedure TGrApp.Done;
begin
CloseGraph
end;
procedure TGrApp.ShowAll;
var
k: integer;
begin
for k:=1 to NPoints do
Points[k].Show;
{end for}
Line.Show;
Circ.Show;
Rect.Show;
end;
procedure TGrApp.MoveActive;
begin
case ActiveObj of
1: Rect.MoveTo(dx,dy);
2: Circ.MoveTo(dx,dy);
3: Line.MoveTo(dx,dy);
end;
end;
var
App: TGrApp;
begin
App.Init;
App.Run;
App.Done;
end.
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.