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

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

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

 
 Ответить  Открыть новую тему 
> ООП Озеро, Прога в принципе готова но надо кое-что добавить и помочь с СОБЫТИЯМИ
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 37
Пол: Мужской
Реальное имя: Серёга

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


Программа запускается, рыбки плавают, но есть пара моментов, которые надо исправить:
1) Первое и самое главное надо реализовать поедание рыб (если встретились 2 рыбы разного вида: щука и карась, то щука должна съесть карася) и размножение (если встретились рыбы одного вида, чтобы появилась еще одна рыба такого вида), в приницпе реализация не сложная, но нужно сделать её с помощью СОБЫТИЙ( но я не знаю, как события вообще делаются, в лекциях не написана их реализация) Помогите пожалуйста!
2) Небольшая проблема : меня попросили убрать параметры next,prev из объекта fish, т.е чтобы это хранилось где-то в другом месте.
Помогите пожалуйста!!! Вот текст программы:

Unit fishing;

interface

Uses graph,crt;
type
PFish=^TFish;
PFishgood=^TFishgood;
PFishbad=^TFishbad;

TOzero=object
first,last:PFish;
procedure Init(N:byte);
procedure Move;
destructor Done;
end;

Tfish=object
x,y,dimension:integer;
colour:byte;
xSpeed,ySpeed,napr:integer;
fishtype:byte;
next,prev:PFish;
constructor init;
procedure Show(Flag:boolean); virtual;
procedure Move;
procedure Smena(var C,Dist:word);{поиск припятствий}
end;

TFishgood=object(TFish)
Constructor init;
procedure Show(flag:boolean); virtual;
procedure Smena(var C,Dist:word);
end;

TFishbad=object(TFish)
Constructor Init;
Procedure Show(flag:boolean); virtual;
Procedure Smena(var C,Dist:word);
end;
var
Aqua:TOzero;

implementation

procedure Fishka(var P:PFish);
begin
If Random(10)=0 then
New(PFishbad(P),Init)
else
New(PFishgood(P),Init);
end;


procedure TOzero.init(N:byte);
var
M:integer;
t:PFish;
begin
M:=0;
Initgraph(M,M,'D:\BP\bgi');
setcolor(blue);
rectangle(GetMaXX-500,GetMaXY-400,GetMaXX,GetMaXY);
Fishka(First);
First^.Next:=nil;
First^.prev:=nil;
Last:=First;
for M:=2 to N do
begin
Fishka(t);
Last^.next:=t;
t^.Prev:=last;
last:=t;
end;
end;

procedure TOzero.Move;
var
CFish:PFish;
begin
repeat
Cfish:=first;
while Cfish<>nil do
begin
Cfish^.Move;
Cfish:=Cfish^.next;
end;
setcolor(blue);
Rectangle(GetMaXX-500,GetMaXY-400,GetMaXX,GetMaXY);
Delay(1000);
until keypressed;
end;

destructor TOzero.Done;
var
t,tt:PFish;
begin
tt:=First;
while tt<>nil do
begin
t:=tt;
tt:=tt^.next;
Dispose(t);
end;
CloseGraph;
end;

Procedure tFish.Show(Flag:boolean);
begin
end;

constructor TFish.init;
begin
x:=Random(GetMaXX-500)+500;
y:=Random(GetMaXY-400)+400;
colour:=random(15)+1;
xSpeed:=Random(5);
ySpeed:=Random(5);
napr:=1;
fishtype:=0;
Show(True);
end;

constructor TFishgood.Init;
begin
inherited Init;
fishtype:=1;
end;

constructor TFishbad.Init;
begin
inherited Init;
fishtype:=2;
end;

procedure Tfishgood.Show(Flag:boolean);
begin
if Flag then
Setcolor(4)
else
Setcolor(GetBkColor);
MoveTo(x,y);
LineTo(x-10*napr, y+10*napr);
LineTo(x-10*napr, y-10*napr);
LineTo(x,y);
end;

procedure Tfishbad.Show(Flag:boolean);
begin
if Flag then
Setcolor(10)
else
Setcolor(GetBkColor);
MoveTo(x,y);
LineTo(x-40*napr, y+7*napr);
LineTo(x-40*napr, y-7*napr);
LineTo(x,y);
end;

procedure TFish.Move;
var
Col,D:word;
begin
Show(false);
Smena(Col,D);
if (Col=blue) or (Random(3000)<30) then
napr:=-napr;
case Random(2) of
0: Inc(x,xSpeed*napr);
1: Inc(y,ySpeed*napr);
end;
Show(true);
end;

Procedure TFish.Smena(var C,Dist:word);
var
P:word;
begin
C:=GetBkColor;
P:=GetPixel(x+napr,y);
if P<>C then
begin
C:=P;
end;
end;

Procedure TFishbad.Smena(var C,Dist:word);
var
P:word;
begin
C:=GetBkColor;
P:=GetPixel(x+napr,y);
if P<>C then
begin
C:=P;
end;
end;

Procedure TFishgood.Smena(var C,Dist:word);
var
P:word;
begin
C:=GetBkColor;
P:=GetPixel(x+napr,y);
if P<>C then
begin
C:=P;
end;
end;

begin
Randomize

end.


М
Используй теги



Сообщение отредактировано: klem4 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 28.09.2020 15:45
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name