Версия для печати темы

Автор: SeregaR1Val 2.12.2007 15:14

Программа запускается, рыбки плавают, но есть пара моментов, которые надо исправить:
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.

М

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