вот код:
program ll;
{napishite programmu, demonstriruyuchuyu na ekrane padenie dogdevih kapil'i krugi na vode}
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;
PRectangle=^TRectangle;
TRectangle=object(TGraphObject) {прямоугольник}
ddx,ddy:Integer; {ширина и высота прямоугольника}
constructor InitData(Nx,Ny,zx,zy,c:Integer);
procedure Paint;virtual;
procedure Clear;virtual;
end;
PCirc=^TCirc;
TCirc=object(TGraphObject) {круг}
Rad: Integer;
constructor InitData(Nx,Ny,R,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
delay(30);
Step(0,3); {шагнем случайным образом}
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;
procedure InitVideo;
var
grDriver,grMode:Integer;
begin
grDriver:=Detect;
InitGraph(grDriver,grMode,'');
if GraphResult<>grOk then
begin
Writeln('Error!!!!');
Halt(1);
end;
end;
{Возврат в текстовый режим}
procedure DoneVideo;
begin
CloseGraph;
end;
constructor TRectangle.InitData;
begin
inherited Init;
x:=Nx;
y:=Ny;
ddx:=zx;
ddy:=zy;
Color:=c;
end;
procedure TRectangle.Paint;
begin
SetColor(color);
Rectangle(x,y,x+ddx,y+ddy);
end;
procedure TRectangle.Clear;
begin
SetColor(1);
Rectangle(x,y,x+ddx,y+ddy);
SetFillStyle(1,1);
end;
constructor TCirc.InitData;
begin
inherited Init;
x:=Nx;
y:=Ny;
Rad:=R;
Color:=c;
end;
procedure TCirc.Paint;
begin
SetColor(color);
Circle(x,y,Rad);
end;
procedure TCirc.Clear;
begin
SetColor(1);
Circle(x,y,Rad);
end;
Var
a,b:array[1..200] of PGraphObject; {массив произвольных объектов}
i,j:Integer;
pryam:PGraphObject;
begin
ClrScr;
InitVideo;
SetBkColor(1);
pryam:=New (PRectangle, InitData (0,0,100,100,0));
Randomize;
for i:=1 to 200 do
a[i]:=New(PCirc, InitData(0+Random(getmaxx),0+Random(getmaxy), 1,9));
while not KeyPressed do
for i:=1 to 200 do
a[i]^.Move;
a[i]^.Done;
ReadKey;
for i:=1 to 200 do
Dispose (a[i],Done);
{Возвращаемся в текстовый режим}
DoneVideo;
End.