Это метод программирования, опирающийся на структурную организацию программы

Вид материалаДокументы
Иерархия этих классов
Полиморфные объекты
Подобный материал:
1   2   3   4   5

Иерархия этих классов:







Суть наследования заключается в том, что потомки могут использовать поля данных и методы прародителей без определения этих полей и методов в классе потомка. Говорят, что поля данных и методы прародителей наследуются потомками.

Пример:

type

tDot=

object

active:Boolean;

X,Y:Integer;

procedure Show;

procedure Hide;

procedure MoveBy(dX,dY:Integer);

procedure MoveTo(NewX,NewY:Integer);

procedure Init(X_,Y_:Integer);

end;

tCircle=

object(tDot)

radius:Real;

procedure Show;

procedure Hide;

procedure MoveBy(dX,dY:Integer);

procedure MoveTo(NewX,NewY:Integer);

procedure Init(X_,Y_,R_:Integer);

end;

var aDot: tDot;

aCircle: tCircle;

В теле объекта aCircle можно пользоваться полями X, Y, active, как если бы они были определены в tCircle, а не в tDot. При этом они никакого отношения не имеют к объекту aDot , т.е. к tDot.X, aDot.Y, aDot.Active. Это aCircle.X, aCircle.Y, aCircle.Active. Но по своей структуре они дублируют соответствующие поля объекта aDot.

А вот вызов методов aCircle.Show, aCircle.Hide и aCircle.Move(...) идет по-другому. Реально это tCircle.Show, tCircle.Hide и tCircle.Move(...), а методы для aDot — это tDot.Show, tDot.Hide и tDot.Move(...), "настроенные" на конкретный экземпляр класса, то есть "знающие", кого показывать, скрывать, перемещать.

Процедура Init переопределена так, что теперь надо задавать радиус, в отличие от прародителя:

Процедура Init в tCircle переопределена так, что теперь надо задавать радиус, в отличие от прародителя. Говорят, что она перекрывает соответствующий метод прародителя.

procedure tCircle.Init(X_,Y_,R_:Integer);

begin

tDot.Init(X_,Y_);

R:=R_;

end;

procedure tCircle.Hide;

var TmpColor:Word;

begin

...{нарисовать окружность цветом фона}

active:=false;

end;

procedure tCircle.MoveBy(dX,dY:Integer);

begin

Hide;

X:=X+dX;

Y:=Y+dY;

Show;

end;

procedure tCircle.MoveTo(NewX,NewY:Integer);

begin

Hide;

X:=NewX;

Y:=NewY;

Show;

end;

Замечание: в принципе типы полей данных в потомках переопределять нельзя (по сравнению с прародителями). Все поля, имеющиеся у прародителей, имеются и у всех их потомков, плюс новые поля, которые дополнительно определены для потомков. Но начиная с Delphiи в Object PASCAL была введена возможность перекрытия полей данных.

Мы пока рассматриваем только так называемые статические методы. Они вызываются так, как скомпилированы для соответствующего типа; их можно переопределять в потомках. Но зато каждый раз надо дублировать текст: процедура Move для tCircle абсолютно аналогична процедуре Move для tDot. Если бы мы не описали процедуру tCircle.Move, благодаря наследованию вызвалась бы tDot.Move! И показалось бы перемещение точки, а не окружности. Существуют также виртуальные методы, которые позволяют обеспечить большую гибкость, чем статические. Но о них речь пойдет позже.

Часто используют типы, называемые абстрактными, у которых единственное назначение — "растить" от них наследников "в разные стороны", чтобы иметь в наследниках соответствующие поля и методы. При этом изменение реализации такого класса автоматически "бесплатно" меняет поведение всех потомков. А вот интерфейс абстрактных классов стараются не менять, иначе надо переписывать почти всю программу — менять все вызовы соответствующих методов в потомках. У абстрактных классов не бывает экземпляров объектов (т.е. переменных такого типа — реально вызываемых объектов).

Пример:

type

tLocation=

object

X,Y:Integer;

procedure Init(X_,Y_:Integer);

function GetX:Integer;

function GetY:Integer;

end;

tDot=

object(tLocation)

active:Boolean;

procedure Init(X_,Y_:Integer);

procedure Show;

procedure Hide;

procedure MoveBy(dX,dY:Integer);

end;

тут tLocation — абстрактный тип; у него не будет экземпляров. Зато из любого потомка можно будет вызывать методы GetX и GetY.


Пример объектно-ориентированной программы: движение фигур по экрану.

unit Figures;

interface

uses…;

type

tLocation=

object

X,Y:Integer;

procedure Init(X_,Y_:Integer);

function GetX:Integer;

function GetY:Integer;

end;

tpDot=tDot; {тип 'указатель на экземпляр класса tDot'. См.далее}

tDot=

object(tLocation)

aсtive:Boolean;

constructor Init(X_,Y_:Integer); {конструктор. См. далее}

destructor Done;virtual; {деструктор. См. далее}

procedure Show;virtual; {виртуальный метод. См. далее}

procedure Hide;virtual;

function IsActive:Boolean;

procedure MoveBy(dX,dY:Integer);virtual;

procedure MoveTo(newX,newY:Integer);virtual;

end;

tpCircle=tCircle; {указатель на экземпляр tCircle}

tCircle=

object(tDot)

R:Integer;

constructor Init(X_,Y_:Integer;R_:Integer);

procedure Show;virtual;

procedure Hide;virtual;

procedure ChangeRadius(dR:Integer);virtual;

end;

{——— секция реализации ———}

implementation

{методы tLocation}

procedure tLocation.Init(X_,Y_:Integer);

begin

X:=X_;

Y:=Y_;

end;

function tLocation.GetX:Integer;

begin

GetX:=X;

end;

function tLocation.GetY:Integer;

begin

GetY:=Y;

end;

{методы tDot}

constructor tDot.Init(X_,Y_:Integer);

begin

tLocation.Init(X_,Y_);

active:=false;

end;

destructor tDot.Done;

begin

Hide;{это tDot.Hide для объекта класса tDot}

end;

procedure tDot.Show;

begin

… {нарисовали текущим цветом}

active:=true; {пометили состояние как активное}

end;

procedure tDot.Hide;

begin

… {нарисовали цветом фона}

active:=false; {пометили состояние как неактивное}

end;

function tDot.IsActive:Boolean;

begin

Result:=active;

end;

procedure tDot.MoveBy(dX,dY:Integer);

begin

Hide;{ это tDot.Hideдля объекта dDot,tCircle.Hideдля aCircle и т.д.}

X:=X+dX;

Y:=Y+dY;

Show; {tDot.Show для aDot, tCircle.Show для aCirle и т.д.

end;

procedure tDot.MoveTo(newX,newY:Integer);

begin

Hide;

X:=newX;

Y:=newY;

Show;

end;

{методы tCircle}

constructor tCircle.Init(X_,Y_,R_:Integer);

begin

tDot.Init(X_,Y_); {инициализация прародителя}

R:=R_;

end;

procedure tCircle.Show;

begin

…{ рисование окружности }

Active:=true;

end;

procedure tCircle.Hide;

var TmpColor:tColor;

begin

TmpColor:=; {запомнили текущий цвет рисования}

…{установили текущим цвет фона}

…{нарисовали окружность цветом фона, т.е. скрыли}

…{восстановили текущий цвет рисования}

Active:=false; {пометили состояние как неактивное}

end;

procedure tCircle.ChangeRadius(dR:Integer);

begin

Hide;

R:=R+dR;

if R<0 then R:=0; {радиус не может быть отрицательным}

Show;

end;

end.

В качестве примера использования модуля Figures напишем программу, в которой используются классы модуля Figures, а также добавляется наследник класса tCircle. При этом для него статический метод Init и виртуальные методы Show и Hide переписываются заново (как говорят — перекрываются), а все другие методы (например, moveBy) наследуются.

Unit Figure1; {добавление наследника}

Uses…,Figures; {используем модуль Figures}

type

tArc=

object(tCircle)

angle1,angle2:Integer;

construсtor Init(X_,Y_,R_,angle1_,angle2_:Integer);

procedure Show;virtual; {метод перекрывается}

procedure Hide;virtual; {также перекрывается}

end;

var

aArc:tArc;

aCircle:tCircle;

pArc:tArc;

{методы Arc}

constructor tАrc.Init(X_,Y_,R_,angle1_,angle2_:Integer);

begin

tCircle.Init(X_,Y_,R_);

angle1:=angle1_;

angle2:=angle2_;

end;

procedure tArc.Show;

begin

…{рисуем дугу текущим цветом}

Active:=true;

end;

procedure tArc.Hide;

var TmpColor:tColor;

begin

TmpColor:=…; {запоминаем текущий цвет}

…{устанавливаем цвет фона текущим цветом рисования}

…{рисуем дугу цветом фона}

Active:=false; {помечаем состояние как неактивное}

…{восстанавливаем текущий цвет}

end;

Form1.Button1Click(…);{по нажатию кнопки идет отрисовка фигур}

begin

aCircle.Init(100,100,50); {инициализировали поля окружности}

aCircle.MoveTo(10);{чтобы остановить перемещение окружности и начать

двигать дугу нажмите }

aArc.Init(120,190,25,0,90); {инициализировали поля дуги}

aArc.MoveBy (5,14); *****

end.


Виртуальные методы. Конструкторы. Раннее и позднее связывание. Полиморфизм.

В приведенной выше программе при описании объектов некоторые методы заданы как виртуальные (virutal). В этом случае перед вызовом какого-либо метода соответствующего экземпляра класса (переменной объектного типа) этот экземпляр (объект) должен быть инициализирован с помощью специального метода, называемого конструктор (constructor). Обычно в Borland Pascal ему давалось имя Init, а в Delphi - Create. Конструктор у объекта в языке Object PASCALможет быть не один, но у каждого из них должно быть свое имя. В C++ и в Java имя конструктора всегда совпадает с именем класса, но конструкторов также может быть несколько. При этом они должны отличаться списком параметров конструкторов. В зависимости от способа инициализации иногда бывает целесообразно вызывать тот или иной конструктор. Например, для окружности в ряде случаев можно задавать некое значение радиуса "по умолчанию". Допустим, это 50 пикселей. Тогда можно написать следующий конструктор (назовем его Init1):

constructor tCircle.Init1(X_,Y_:integer);

begin

Init(X_,Y_,50)

end;

При вызове такого конструктора надо задавать только координаты окружности.

В отличие от статических методов, где можно переопределять не только реализацию методов, но и их список параметров, виртуальные должны при переопределении в потомках иметь одну и ту же сигнатуру (список параметров и их типы). То есть виртуальные методы должны отличаться только реализацией.

Например, нельзя определить в tDot метод MyShow(X_,Y_:Integer);virtual, а в tCircle задать MyShow(X_,Y_,R_:Integer);virtual. Зато, благодаря виртуальным методам, благодаря наличию полиморфизма, можно не переписывать несколько раз тела этих методов, которые выглядят одинаково, но относятся к разным объектам. Например, вместо описания в классе tCircle метода MoveBy, буква в букву повторяющего метод MoveBy для класса tDot в случае статических методов Show и Hide:

procedure tCircle.MoveBy(dX,dY:Integer);

begin

Hide;

X=X+dX;

Y=Y+dY;

Show;

end;

и множества таких же (для tArc любого и нового типа фигуры), можно описать методы Show и Hide в иерархии как виртуальные, и сделать описание процедуры MoveBy только один раз для tDot, а для потомков использовать наследование. При этом виртуальные процедуры Hide и Show будут выполняться по-своему для своей фигуры, т.к. для виртуальных методов они берутся из класса, к которому относится вызывающий их объект, (например, из tCircle для объекта aCircle), а не из класса, в котором компилируется метод прародителя tDot для метода MoveBy. Методы Show и Hide, естественно, перекрываются в каждом классе-потомке, т.е. имеют разные реализации для разных фигур.

Надо отметить, что конструкторы в Turbo Pascal не могли быть виртуальными, хотя и могли наследоваться как обычные статические методы. В Object PASCAL начиная с Delphi 2.0 конструкторы можно объявлять виртуальными, хотя без особой необходимости не следует этого делать.

Текст модуля, в котором описан тип tArc, создан независимо от текста модуля Figures и использует только его интерфейсную часть и комбинированный бинарный файл

Figures.dcu. Он может быть даже намного позже компиляции файла .dcu!). Но экземпляры tArc свободно могут пользоваться унаследованными виртуальными методами MoveBy, MoveTo. При этом MoveBy, MoveTo вызывают методы Show и Hide, которые для Arc свои, вновь написанные, и скомпилированы они гораздо позднее, чем модуль Figures! Это — позднее связывание: вызов методов (имени методов с его реализацией в каком либо классе) определение, к какому классу относится виртуальный метод, происходит во время выполнения программы. А статические правила имеют раннее связывание, на этапе компиляции. При этом какой тип соответствуетметоду в программе, метод такого типа и вызывается. То есть если написан вызов Row в реализации метода tDot.moveBy, то будет вызван метод tDot.Show даже в случае вызова aCircle.moveBy(…). Если же метод Show виртуальный, вызовется tCircle.Show.

Полиморфные объекты — такие, у которых есть виртуальные методы, то есть такие методы, которые способны выполняться для объектов иерархии, тип которых неизвестен при компиляции.

Позднее связывание: для каждого класса создается таблица виртуальных методов (VMT) (Virtual Methods Table). VMT содержит для каждого метода указатель на адрес кода, выполняющего метод. Экземпляры объектного типа не содержат VMT (она едина для всего класса), а только ссылку на нее. Эта ссылка используется в момент вызова виртуального метода объектом. А так как каждый объект имеетссылку на метод, соответствующийсвоему классу, то вызывается метод из соответствующего класса. Как бы работала программа, если бы все методы были описаны как статические? По наследованию вызвался бы метод для прародителя tDot, и методы Show и Hide в tDot.MoveBy или tDot.MoveTo всегда воспринимались бы "настроенными" на тот тип, к которому все это относилось в момент компиляции, то есть к tDot. Значит, всегда двигалась бы точка, а не окружность или дуга!

Для виртуальных методов дело обстоит по-другому. При вызове объектом этого метода происходит переход по ссылке на таблицу виртуальных методов для класса, к которому принадлежит объект. Поэтому выполняется метод потомка, а не метод прародителя. И при перемещении дуги рисуется дуга, а не точка. Если же в потомке соответствующий метод не перекрыт, в таблице виртуальных методов стоит ссылка на последний в иерархии прародителей метод с тем же именем.

Рассмотрим, как бы себя вели экземпляры классов, описанных ниже, с теми же методами, что и в предыдущей программе, но описанные как статические:

type

tDot=

object(tLocation)

procedure Show;

procedure Hide;

procedure MoveBy(dX,dY:integer);

...

end;

tCircle=

object(tDot)

procedure Show; {перекрывается статический метод}

procedure Hide; {перекрывается статический метод}

{процедура MoveBy не перекрывается, она наследуется}

...

end;

tArc=

object(tCircle)

...

procedure Show; {перекрывается второй раз}

procedure Hide; {перекрывается второй раз}

{процедура Move не перекрывается, она наследуется}

...

end;

...

{-реализация методов-}

procedure tDot.MoveBy(dX,dY:integer);

begin

Show;

X:=X+dX;

Y:=Y+dY;

Hide;

end;

...

var aCircle:tCircle;

aArc:tArc;

...

При вызове aArc.MoveBy(5,10) вызовется метод tDot.MoveBy, т.к. он наследуется классами tCircle и tArc от класса tDot, и ни в tCircle, ни в tArc этот метод не перекрыт. В методе tDot.MoveBy вызываются методы Show и Hide. Все упомянутые методы описаны как статические. Поскольку статические методы встраиваются в исполняемый код программы "сразу", на этапе компиляции программы, они вызываются именно для того типа, в котором определены, то есть это tDot.Show и tDot.Hide . Поэтому в нашем случае tDot.Show покажет, а tDot.Hide погасит точку на экране с координатами дуги aArc.X и aArc.Y. По-видимому, это несколько не то, что бы мы хотели. Для того, чтобы двигалась дуга, процедуры Show и Hide в tDot надо пометить как виртуальные:

procedure Show;virtual;

procedure Hide;virtual;

а во всей иерархии объектов (tCircle, tArc и т. д.) надо пометить их как перекрытые:

procedure Show;override;

procedure Hide;override;

Стоит отметить, что не обязательно помечать метод MoveBy как виртуальный: он может быть и статическим.

Как теперь будет осуществляться вызов aArc.MoveBy(5,10)? В методе tDot.MoveBy, который вызывается благодаря наследованию, вызываются методы Show и Hide из класса вызывающего их объекта, т.е. tArc.Show и tArc.Hide, поскольку методы помечены как виртуальные. В результате рисуется и перемещается дуга.

Что бы произошло, если бы в tCircle виртуальные методы Show и Hide были перекрыты (переопределены так, что рисовалась и скрывалась бы окружность), в tArc они не были еще раз перекрыты и наследовались бы от tCircle? В таблице виртуальных методов каждого класса хранятся указатели на виртуальные методы для данного класса, а также для всех его прародителей. Если виртуальный метод в классе не перекрыт, указатель для метода настраивается на метод ближайшего прародителя, в котором метод определен или перекрыт. Поэтому в случае двигалась бы окружность.

type tFigure=tDot;

Procedure moveFigure(var aFigure:tFigure,dx,dy,integer)

begin

aFigure.moveBy(dx,dy)

end;

В приведенном примере используется полиморфизм: на этапе компиляции программы неизвестно, какого типа объект aFigure вызовет метод moveBy. А поскольку реализация метода осущесталяется с помощью виртуальных методов Show и Hide , их вызовы будут осуществляться для класса, к которому относится вызывающий их объект aFigure, а не для класса tDot.


Динамические объекты. Выделение и высвобождение памяти. Деструкторы.

Указатель на объект устроен так же, как обычные указатели:




Описание указателей на объект:

type tpCircle=tCircle; {тип "указатель на объект типа tCircle"}

var pCircle:tpCircle; {экземпляр этого типа, т.е. указатель на объект

типа tCircle}

pCircle:tCircle; {другой вариант описания указателя на экземпляр

класса tCircle}

Создание нового объекта в "куче" (heap), на который при создании этого объекта "переключается" указатель pCircle:

New(pCircle);

Независимо от числа созданных объектов, pCircle указывает на последний из таких объектов. Если два раза сделать такой вызов, т.е. New(pCircle), то указатель на предпоследний объект потеряется, как и в случае с обычными динамическими переменными (см. Часть1).

Доступ к полям объекта:

a:=pCircle.X;

pCircle.MoveBy(10,21)

и т.п. При этом pCircle читается как "указатель на объект типа tCircle", а pCircle — как "объект типа tCircle, на который ссылается указатель pCircle".

Если в объекте есть виртуальные методы, он обязательно должен быть инициализирован конструктором до вызова первого своего метода:

pCircle.Init(100,100,50);

В противном случае произойдет аварийное завершение программы или зависание компьютера, т.к. настройка на таблицу виртуальных методов для каждого экземпляра класса производится только при вызове конструктора. Поэтому для объектов существует специальная форма оператора New с двумя параметрами, именем указателя на объект и конструктора:

New(pCircle,Init(100,100,50));

Указатель на динамически создаваемый экземпляр можно сразу получить, используя New как функцию. Стоит отметить, что при этом в качестве параметра оператора New ставится не имя указателя, а имя его типа. При этом динамически создается экземпляр указанного типа. Так, если:

type tpArc=tArc;

var pArc:tpArc;

то можно записать либо

New(pArc);

pArc.Init(100,100,20,0,90);

либо

pArc:=New(tpArc);

pArc.Init(100,100,20,0,90);

либо

pArc:=New(tpArc,Init(100,100,20,0,90));

Последняя форма записи короче и надежнее (в других есть возможность вызова конструктора не сразу, а после произвольного числа операторов, и по ошибке виртуальный метод можно вызвать до вызова конструктора). Поэтому при работе с объектами практически всегда используют New в форме функции, когда одновременно идет инициализация конструктором.

Удаление объекта (обычно динамического) производится с помощью вызова специального метода — деструктора. Конструкторов и деструкторов для одного объекта может быть несколько. Если основной конструктор в Turbo Pascal обычно называют Init, то основной деструктор — Done ("сделано"). Деструкторы, в отличие от конструкторов, могут быть виртуальными. Более того, их рекомендуется делать виртуальными, так как в них обычно отсутствуют параметры.

Высвобождение памяти, занимаемой динамическими объектами, производится с помощью оператора Dispose, который имеет обычный для динамических переменных синтаксис:

Dispose(pCircle);

Этот оператор высвобождает память, занимаемую объектом, на который указывает указатель (т.е. на который он "настроен", "переключен"). Надо отметить, что сам указатель pCircle при этом не уничтожается, а продолжает указывать на то же место в памяти. Вызов через pCircle объекта aCircle после того, как соответствующий ему участок памяти высвобожден, недопустим и обычно вызывает ошибку выполнения программы или "зависание" компьютера. Если в объекте есть динамически созданные поля или структуры, их надо убирать в определенной последовательности (иначе либо они могут остаться в памяти как "мусор", либо может произойти попытка повторно убрать уже уничтоженную часть структуры). Поэтому обычно используют специальный метод (в Borland Pascal рекомендуется называть его Done) для удаления динамического объекта. Его желательно делать виртуальным. В этом случае при наличии полиморфизма заранее неизвестно, что удаляется: прародитель или потомок, так как указатель может быть настроен либо на того, либо на другого, и это узнается только во время работы программы. А число полей и, соответственно, занимаемый размер памяти у этих объектов разный. Чтобы правильно производить удаление из памяти полиморфных объектов, метод объявляют деструктором. При этом работа метода замедляется, т.к. происходит проверка, кто вызван — прародитель или потомок. Но зато автоматически высвобождается правильное количество памяти (на основе доступа к механизму позднего связывания при вызове специального варианта Dispose с деструктором):

Dispose(pCircle,Done);

Вызов деструктора без Dispose не приводит к автоматическому высвобождению памяти, и он работает как обычный метод. Надо отметить, что идеология работы с конструкторами и деструкторами в Turbo Pascal является запутанной и непродуманной. Эти недостатки ликвидированы в Delphi.


Правила присваивания. Совместимость типов для объектов.

Для потомков при использовании их "на месте" прародителей любого уровня имеется два основных варианта совместимости типов (по вызовам и по присваиваниям) между:

  1. экземплярами объектов,
  1. указателями на экземпляры объектов,
  1. формальными и фактическими параметрами.

Потомки могут использоваться вместо прародителей (но не наоборот!) по следующей причине: используемый тип должен для совместимости полностью "заполнять" поля типа, вместо которого он подставляется.

Например:

aDot:=aCircle;

aDot:=aArc;

{aCircle:=aDot - так нельзя!}

При этом в наш объект, которому присваивается значение, копируются только те поля данных, которые имеются в Dot, а остальные оказываются ненужными и игнорируются. Если бы мы попытались сделать присваивания в обратную сторону (aCircle:=aDot или aArc:=aDot), часть полей результата не смогла бы заполниться. Поэтому присваивания типа "потомок:=прародитель" недопустимы. Стоит отметить, что описанные выше разрешенные присваивания объектов как таковых в последующих версиях PASCAL невозможны, и работа с объектами идет только через указатели (смотри далее раздел про Delphi).

Для указателей присваивание pDot:=pCircle допустимо, а pCircle:=pDot недопустимо, т.е. указателю на прародителя можно присвоить указатель на потомка, но не наоборот. Это правило логически вытекает из описанного выше правила совместимости для объектов. Оно сохранено в Delphi, хотя его основа — правило присваивания объектов — в Delphi ликвидировано. Поэтому изучение объектной модели Turbo Pascal полезно для правильного понимания объектной модели Delphi.

В TurboPascal имеется предопределенный тип Pointer, совместимый по присваиванию для всех типов указателей, то есть переменной типа Pointer можно присвоить указатель любого типа. Но при дальнейшем ее использовании следить за работой с указателями на тип должен сам программист. Обратное присваивание (указателю на объект указателя типа Pointer) возможно только с помощью явного указания приведения типов.

Особенностью рассмотренных правил совместимости является то, что при работе с указателями на полиморфные объекты (т.е. при наличии в объектах виртуальных методов) бывает заранее неизвестно, какой тип вызовется. Вызов:

pDot.Show

может показать и точку, и круг, и дугу (и даже еще неизвестного нам потомка) в зависимости от того, указатель на какую фигуру был присвоен указателю pDot. Это может зависеть от различных условий. Например, от решения пользователя в программе. В приводимом ниже примере указателю типа tpDot намеренно дано название не pDot, а pFigure, чтобы подчеркнуть, что он может указывать на произвольную фигуру — потомок tDot:

var FigKey:Char;

pFigure:tpDot;

begin

...

outTextXY('Choose type of a figure:0-dot,1-circle,2-arc',0,10);

readln(FigKey);

case FigKey of

'0':pFigure:=pDot;

'1':pFigure:=pCircle;

'2':pFigure:=pArc;

end;

...

pFigure.Show; {не забыть, что до этого экземпляр должен был быть

инициализирован конструктором!}

...

end;

Выбор конкретного виртуального метода для объекта pFigure происходит во время выполнения программы.


Пример на создание, присваивание и уничтожение динамических объектов.

Unit FigDemo1;

Uses…,Figures,FigArc;

var FigKey:char;

Ang1_ini,Ang2_ini,R_ini,X_ini,Y_ini:Integer; newX,newY,newR:Integer;

pFigure:tpDot;

outside:Boolean;

begin

OutTextXY('type of figure:0-dot,1-circle,2-arc,0,10);

Readln(FigKey);

OutTextXY('Coordinate X=',0,20);Readln(X_ini);

OutTextXY('Coordinate Y=',0,30);Readln(Y_ini);

case FigKey of

'0':pFigure:=New(tpDot,Init(X_ini,Y_ini));

'1':begin

OutTextXY('Radius R=',0,40);Readln(R_ini);

pFigure:=New(tpCircle,Init(X_ini,Y_ini,R_ini));

end;

else

begin

OutTextXY('Radius R=',0,40);Readln(R_ini);

OutTextXY('Start angle=',0,50);Readln(Ang1_ini);

OutTextXY('End angle=',0,60);Readln(Ang2_ini);

pFigure:=New(tpArc,Init(X_ini,Y_ini,R_ini,ang1_ini,ang2_ini));

end;

end{/case};

pFigure.Show;

repeat

OutTextXY('New X=',0,90);readln(NewX);

OutTextXY('New Y=',0,80);readln(NewY);

OutSide:=(NewX<0)OR(NewX>639)OR(NewY<100)OR(NewY>479));

pFigure.MoveTo(NewX,NewY)

until Outside;

OutTextXY('End of work.Press ',0,90);Readln;

Dispose(pFigure,Done)

end.


Пример динамического выделения и высвобождения памяти для однонаправленного списка объектов.

Создадим список, в котором хранятся различные фигуры — объекты иерархии с классом-прародителем tDot. Введем запись типа "узел", ссылающийся на одну фигуру и один другой (предыдущий) узел:

Тело списка (или для простоты просто список) будет состоять из набора таких узлов. Самый первый узел, которому не на кого указывать как на предыдущий, имеет указатель со значением nil. Указатель на последний узел списка хранится в поле LastNode нашего объекта. Этот объект типа tList реально будет являться заголовком списка, где хранятся нужные поля данных (в нашем случае — pLastNode) и ссылки на методы объекта. Сам же список будет создаваться в динамической области памяти. К списку можно добавлять новый узел методом Add, а уничтожать методом Done. Метод Report позволяет в процессе работы выводить информацию о координатах фигур, находящихся в списке.

unit ListDemo;

uses…,Figures,FigArc;

type

tpFigure=tpDot;

tpNode=tNode;{для указателей разрешен опережающий вызов описания типа}

tNode= {хотя тип tNode определен только в этом месте}

record {каждый узел списка состоит из:}

pFigure:tpFigure; {-указателя на фигуру}

pPrevious:tpNode; {-указателя на предыдущий узел списка}

end;

tList=

object {объект этого типа будет управлять списком}

pLastNode:tpNode; {указатель на последний узел списка}

constructor Init; {инициализация полей и методов "управляющего"

объекта}

destructor Done;virtual;{уничтожение списка и высвобождение памяти}

procedure Add(pFig:tpFigure); {добавить узел со ссылкой на

pFig в конец списка}

procedure Report; {вывод на экран информации о списке}

end;

{-реализация методов tList-}

constructor tList.Init;

begin

pLastNode:=nil; {в списке узлов нет, и pLastNode никуда не указывает}

end;

procedure tList.Add(pFig:tpFigure); {в качестве параметра передается

указатель на фигуру, которую надо внести в список}

var pCurrent:tpNode; {локальная переменная типа 'указатель на узел'}

begin

New(pCurrent); {создали новый узел, он пока не в списке}

pCurrent.pFigure:=pFig; {установили его указатель pFigure на фигуру,

на которую "настроен" pFig}

pCurrent.pPrevious:=pLastNode; {установили его указатель pPrevious

на последний узел списка; если это первый узел списка,

то pPrevious получает значение nil - см. конструктор}

pLastNode:=pCurrent; {обозначили узел как последний в списке;

теперь наш узел состоит в списке}

end;

destructor tList.Done;

var pCurrent:tpNode;

begin

while pLastNode<>nil do {движемся от последнего узла списка до начала,

т.е. пока pLastNode не укажет на nil}

begin

pCurrent:=pLastNode; {настраиваем pCurrent на последний узел}

Dispose(pCurrent.pFigure,Done);{высвобождаем память, занятую под

фигуру. Важно, что ее метод Done - виртуальный}

pLastNode:= pCurrent.pPrevious; {обозначаем предыдущий узел как

последний}

Dispose(pCurrent); {устраняем узел, на который настроен указатель

pCurrent}

end;

end;

procedure tList.Report; {вывод на экран координат фигур списка}

var pCurrent:tpNode;

tmp:string;

begin

pCurrent:=pLastNode; {настроились на последний узел списка}

while pCurrent<>nil do {движемся по списку до первого узла}

begin

Str(pCurrent.pFigure.GetX:3,tmp); {в строку tmp вводим 3 цифры

значения X}

OutText('X='+tmp+' '); {выводим значение X на экран}

Str(pCurrent.pFigure.GetY:3,tmp); {в строку tmp – значениеY}

OutText('Y='+tmp+' '); {выводим значение Y на экран}

pCurrent:=pCurrent.pPrevious; {настроились на предыдущий узел}

end;

end;

{-переменные основной программы-}

var

aList:tList; {экземпляр типа "список"}

pArc:tpArc; {указатель на дугу}

pCircle:tpCircle; {указатель на окружность}

{-основная программа-}

begin

InitGraph(GraphDriver,GraphMode,''); {инициализация графики}

if GraphResult<>GrOk then Halt(1); {в случае ошибки - остановка

программы}

aList.Init; {создали список. В нем нет узлов, а поле pLastNode равно nil}

aList.Add(New(tpArc,Init(120,80,20,10,90))); {добавили в список

дугу}

aList.Add(New(tpCircle,Init(300,200,100))); {добавили окружность}

aList.Add(New(tpCircle,Init(150,150,50))); {другую окружность}

aList.pLastNode.pFigure.Show; {показали последнюю фигуру списка}

aList.pLastNode.pFigure.MoveTo(200,200); {передвинули ее}

aList.Report; {вывели на экран координаты фигур списка}

aList.Add(New(tpDot,Init(100,100))); {добавили в список точку}

aList.pLastNode.pPrevious.pPrevious.pFigure.Show; {показали

третью с конца фигуру, т.е. первую окружность}

aList.pLastNode.pFigure.Move(20,50); {передвинули точку}

aList.Report; {вывели координаты фигур списка}

aList.Done; {уничтожили список}

OutTextXY('Press to exit',0,10);

end.


Очередь, стек, двунаправленный список.

Совершенно аналогичным образом можно создавать объект — двунаправленный список, в котором каждый узел имеет указатели как "влево" (на предыдущий узел), так и "вправо" (на последующий). В таком объекте полезно иметь поля:
  • pLastNode — указатель на последний узел списка,
  • pFirstNode — указатель на первый элемент.
  • nNodes — число имеющихся на данный момент узлов (в Delphi аналогичное поля обычно носит имя Count),
  • pCurrent — указатель на текущий узел списка (с которым мы в данный момент работаем),
  • nCurrent — номер текущего узла.

Кроме того, надо предусмотреть методы:
  • Insert (i:integer, pFig:tpFigure) — вставка нового узла с фигурой, на которую настроен pFig, в позицию с номером i (при этом номер прежнего узла с номером i становится i+1 и т.д.),
  • Delete (i:integer) — уничтожение узла i,
  • Exchange(i,j) — обмен двух узлов местами.

Примеры использования нашего однонаправленного списка:
  1. очередь ("первый вошел — первый вышел");
  2. стек ("последний вошел — первый вышел").

В случае очереди мы создаем потомка класса tList:

tQueue=object(tList)

procedure Remove;

end;

в котором процедура Remove удаляет первый узел списка, при этом оставшаяся часть списка не меняется, но второй узел становится первым и т.д., т.е. весь список как бы сдвигается на один узел к началу. В случае стека мы создаем потомка класса tList, описание которого совпадает с предыдущим случаем:

tSteck=object(tList)

procedure Remove;

end;

но в котором процедура Remove удаляет не первый, а последний узел. При этом как и в предыдущем случае оставшаяся часть списка не меняется.