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; PResizable = ^TResizable; TResizable = object(TGraphObject) constructor init; procedure factorSize(factor: real); procedure Grow(factor: real); virtual; end; PPoint=^TPoint; TPoint=object(TGraphObject) {точка} {Задание координат и цвета точки} constructor InitData(Nx,Ny,c:Integer); procedure Paint;virtual; procedure Clear;virtual; end; PRectangle=^TRectangle; TRectangle=object(TResizable) {прямоугольник} Width,Heigh:Integer; {ширина и высота прямоугольника} {Задание координат, размеров и цвета прямоугольника} constructor InitData(Nx,Ny,W,H,c:Integer); procedure Paint;virtual; procedure Clear;virtual; procedure Grow(factor: real); virtual; end; PCircle = ^TCircle; TCircle = object(tresizable) CX, CY, R: integer; constructor init(centerx, centery, radius, clr: integer); procedure Paint;virtual; procedure Clear;virtual; procedure Grow(factor: real); 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 TRectangle.Grow(factor: real); begin Heigh := Trunc(Heigh * factor); Width := Trunc(Width * factor); end; constructor TResizable.init; begin inherited init; end; procedure TResizable.factorSize(factor: real); begin Hide; Grow(factor); Show; end; procedure TResizable.Grow(factor: real); begin end; constructor tcircle.init(centerx, centery, radius, clr: integer); begin inherited init; CX := centerx; CY := centery; R := radius; color := clr; end; procedure tcircle.Paint; begin setcolor(color); circle(CX, CY, R); end; procedure tcircle.Clear; begin setcolor(getbkcolor); circle(CX, CY, R); end; procedure tcircle.Grow(factor: real); begin R := Trunc(R * factor); 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; {массив произвольных объектов} sphere: PCircle; 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 begin a[i]^.Move; {Хаотично перемещаем объект} if typeof(a[i]^) = TypeOf(TRectangle) then begin PResizable(a[i])^.factorSize(1.12); end; end; ReadKey; cleardevice; Sphere := new(PCircle, init(getmaxx div 2, getmaxy div 2, 10, lightred)); Sphere^.Show; while not keypressed do begin Sphere^.factorSize(1.2); delay(100); end; dispose(Sphere, done); {Уничтожаем объект} for i:=1 to 150 do Dispose (a[i],Done); {Возвращаемся в текстовый режим} DoneVideo; end.