IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Немогу закончить задачу на ООП
Skif_04
сообщение 25.05.2009 21:35
Сообщение #1





Группа: Пользователи
Сообщений: 4
Пол: Мужской

Репутация: -  0  +


Народ, помогите плиз закончить задачу на ООП...
Вот то, что я набросал

program Lr18_1;
{Программа, демонстрирующая использование графических объектов}
uses
Crt, Graph;
type
PGraphObject=^TGraphObject;
TGraphObject=object {базовый объект}
Active: Boolean; {признак видимости объекта}
x,y: Integer; {координаты объекта}
Color: Integer; {цвет объекта}
constructor Init; {конструктор объекта}
destructor Done;virtual; {деструктор}

procedure Locate (Nx,Ny:Integer); {задание коорди-нат}
procedure Step (Dx,Dy:Integer); {сдвиг объекта}
procedure Move; {хаотичное движение}

procedure Show; {отобразить объект на экране}

procedure Hide; {скрыть объект}

procedure Paint;virtual; {процедура рисования объекта}
procedure Clear;virtual; {процедура стирания объекта}
end;
PPoint=^TPoint;
TPoint=object(TGraphObject) {точка}
{Задание координат и цвета точки}
constructor InitData(Nx,Ny,c:Integer);
procedure Paint;virtual;
procedure Clear;virtual;
end;

PRectangle=^TRectangle;
TRectangle=object(TGraphObject) {прямоугольник}
Width,Heigh:Integer; {ширина и высота прямоугольника}

{Задание координат, размеров и цвета прямоугольника}
constructor InitData(Nx,Ny,W,H,c:Integer);
procedure Paint;virtual;
procedure Clear;virtual;
end;

constructor TGraphObject.Init;
begin
Active:=False; {изначально объект невидим}
end;
destructor TGraphObject.Done;
begin
Hide; {перед уничтожением сотрем объект с эк-рана}
end;

procedure TGraphObject.Locate;
begin
Hide; {скроем объект}
x:=Nx; {зададим новые координаты}
y:=Ny;
Show; {отобразим на новом месте}
end;

procedure TGraphObject.Step;
begin
Hide; {скроем объект}
x:=x+Dx; {переместим объект}
y:=y+Dy;
Show; {отобразим на новом месте}
end;

procedure TGraphObject.Move;
begin
Step(Random(5)-2,Random(5)-2); {шагнем случайным образом}
end;

procedure TGraphObject.Show;
begin
if not Active then {если объект невидим, то...}
begin
Active:=True; {установим флажок видимости}
Paint; {нарисуем объект}
end;
end;

procedure TGraphObject.Hide;
begin
if Active then {если объект видим, то...}
begin
Active:=False; {сбросим флажок видимости}
Clear; {сотрем объект}
end;
end;

procedure TGraphObject.Paint;
begin
end;

procedure TGraphObject.Clear;
begin
end;

constructor TPoint.InitData;
begin
inherited Init; {инициализация унаследованных полей}
x:=Nx; {установим координаты}
y:=Ny;
Color:=c; {зададим цвет}
end;

procedure TPoint.Paint;
begin
PutPixel(x,y,Color);
end;

procedure TPoint.Clear;
begin
PutPixel(x,y,0);
end;

constructor TRectangle.InitData;
begin
inherited Init;
x:=Nx;
y:=Ny;
Width:=W;
Heigh:=H;
Color:=c;
end;

procedure TRectangle.Paint;
var
i,j:Integer;
begin
i:=Width Div 2;
j:=Heigh Div 2;
SetColor(Color);
Rectangle(x-i,y-j,x+i,y+j);
end;

procedure TRectangle.Clear;
var
i,j:Integer;
begin
i:=Width Div 2;
j:=Heigh Div 2;
SetColor(0);
Rectangle(x-i,y-j,x+i,y+j);
end;

{Переход в графический режим}
procedure InitVideo;
var
grDriver,grMode:Integer;
begin
grDriver:=Detect;
InitGraph(grDriver,grMode,'');
if GraphResult<>grOk then
begin
Writeln('Ошибка при инициализации графики !');
Halt(1);
end;
end;

{Возврат в текстовый режим}
procedure DoneVideo;
begin
CloseGraph;
end;

var
a:array[1..150] of PGraphObject; {массив произвольных объектов}
i:Integer;
begin
ClrScr; {Переход в графический режим}
InitVideo;
{Инициализируем генератор случайных чисел}
Randomize;
{Создаем 150 графических объектов}
for i:=1 to 150 do
case Random(2) of
0:{Точку} a[i]:=New(PPoint,InitData(
20+Random(600), 20+Random(440), {координаты}
1+Random(14))); {цвет}
1:{создаем прямоугольник}
a[i]:=New(PRectangle,InitData(
20+Random(600), 20+Random(440), {координаты}
3+Random(5), 3+Random(5), {размеры}
1+Random(14))); {цвет}
end;
while not KeyPressed do
for i:=1 to 150 do
a[i]^.Move; {Хаотично перемещаем объект}
ReadKey;
{Уничтожаем объект}
for i:=1 to 150 do
Dispose (a[i],Done);
{Возвращаемся в текстовый режим}
DoneVideo;
end.


Сюда надо еще добавить возможность изменения размерв обьектов и прога должна продимонстрировать процесс надувания воздушного шарика...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
volvo
сообщение 26.05.2009 9:25
Сообщение #2


Гость






Зачем же FloodFill, если можно рисовать уже закрашенную окружность:

procedure tcircle.Paint;
begin
setfillstyle(solidfill, color);
fillellipse(CX, CY, R, R);
end;
procedure tcircle.Clear;
begin
setfillstyle(solidfill, getbkcolor);
fillellipse(CX, CY, R + 2, R + 2); { !!! }
end;

(я всегда при затирании объекта делаю это "с запасом", чтоб лишнего ничего не оставалось на экране)
 К началу страницы 
+ Ответить 
Skif_04
сообщение 26.05.2009 11:44
Сообщение #3





Группа: Пользователи
Сообщений: 4
Пол: Мужской

Репутация: -  0  +


Прекрасно работает. Огромнейшое спасибо за помощь!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 20.07.2025 18:11
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"