Книга: Фундаментальные алгоритмы и структуры данных в Delphi

Класс TtdObjectList

Класс TtdObjectList

А сейчас мы создадим новый класс списка, который работает как TList, но имеет два отличия: он хранит экземпляры некоторого класса (или его дочерних классов) и при необходимости уничтожает все содержащиеся в нем объекты. Другими словами, это будет специализированный список, в котором не будет двух описанных в предыдущем разделе недостатков. Назовем наш класс TtdObjectList. Он отличается от класса TObjectList в Delphi 5 и более поздних версиях тем, что будет безопасным к типам.

Он не будет дочерним классом TList. Конечно, в нем будут содержаться те же методы, но их реализация будет основана на делегировании к методам с теми же именами внутреннего класса TList.

Класс TtdObjectList имеет один новый очень важный атрибут - владение данными. Это класс будет функционировать либо точно так же, как TList, т.е. при уничтожении его элементы не будут освобождаться (он не владеет данными), либо будет иметь полный контроль над своими элементами и при необходимости будет их удалять (он владеет данными). Установка атрибута владения данными выполняется при создании экземпляра класса TtdObjectList, и после этого уже не будет возможности изменить тип владения данными.

Кроме того, класс будет обеспечивать безопасность к типам (type safety). При создании экземпляра класса, необходимо указывать какой тип (или класс) объектов будет в нем храниться. Во время добавления или вставки нового элемента специальный метод будет проверять соответствие типа нового объекта объявленному типу элементов списка.

Интерфейс класса TtdObjectList напоминает интерфейс класса TList. В нем не реализован метод Pack, поскольку в список будут добавляться только объекты, не равные nil. Подробное описание метода Sort будет приведено в главе 5.

Листинг 2.10. Объявление класса TtdObjectList

TtdObjectList = class private

FClass : TClass;

FDataOwner : boolean;

FList : TList;

FName : TtdNameString;

protected

function olGetCapacity : integer;

function olGetCount : integer;

function olGetItem(aIndex : integer): TObject;

procedure olSetCapacity(aCapacity : integer);

procedure olSetCount(aCount : integer);

procedure olSetItem(aIndex : integer; aItem : TObject);

procedure olError(aErrorCode : integer; const aMethodName : TtdNameString; aIndex : integer);

public

constructor Create(aClass : TClass;

aDataOwner : boolean);

destructor Destroy; override;

function Add(aItem : TObject): integer;

procedure Clear;

procedure Delete(aIndex : integer);

procedure Exchange(aIndex1, aIndex2 : integer);

function First : TObject;

function IndexOf(aItem : TObject): integer;

procedure Insert(aIndex : integer; aItem : TObject);

function Last : TObject;

procedure Move(aCurIndex, aNewIndex : integer);

function Remove(aItem : TObject): integer;

procedure Sort(aCompare : TtdCompareFunc);

property Capacity : integer read olGetCapacity write olSetCapacity;

property Count : integer read olGetCount write olSetCount;

property DataOwner : boolean read FDataOwner;

property Items[Index : integer] : TObject read olGetItem write olSetItem; default;

property List : TList read FList;

property Name : TtdNameString read FName write FName;

end;

Целый ряд методов класса TtdObjectLiet является простыми интерфейсами для вызова соответствующих методов внутреннего класса FList. Например, вот реализация метода TtdObjectList.First:

Листинг 2.11. Метод TtdObjectList.First

function TtdObjectList.First : TObject;

begin

Result := TObject(FList.First);

end;

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

Листинг 2.12. Метод TtdObjectList.Move

procedure TtdObjectList.Move(aCurIndex, aNewIndex : integer);

begin

{проверяем индексы сами, а не перекладываем эту обязанность на список}

if (aCurIndex < 0) or (aCurIndex >= FList.Count) then

olError(tdeIndexOutOfBounds, 'Move', aCurIndex);

if (aNewIndex < 0) or (aNewIndex >= FList.Count) then

olError(tdeIndexOutOfBounds, 'Move', aNewIndex);

{переместить элементы}

FList.Move(aCurIndex, aNewIndex);

end;

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

Листинг 2.13. Конструктор и деструктор класса TtdObjectList

constructor TtdObjectList.Create(aClass : TClass; aDataOwner : boolean);

begin

inherited Create;

{сохранить класс и флаг владения данными}

FClass := aClass;

FDataOwner := aDataOwner;

{создать внутренний список}

FList := TList.Create;

end;

destructor TtdObjectList.Destroy;

begin

{если список содержит элементы, очистить их и уничтожить список}

if (FList <> nil) then begin

Clear;

FList.Destroy;

end;

inherited Destroy;

end;

Если вы не уверены, каким образом передавать значение параметра aClass, приведем пример с использованием класса TButton:

var

MyList : TtdObjectList;

begin

• • •

MyList := TtdObjectList.Create(TButton, false);

Первым реальным отличием нового списка от стандартного класса TList является метод Clear. Он предназначен для проверки того, владеет ли список данными. В случае положительного результата, перед уничтожением списка все его элементы будут удалены. (Обратите внимание, что здесь для удаления каждого отдельного элемента не используется метод Delete класса FList. Намного эффективнее очищать список после освобождения памяти, занимаемой его элементами.)

Листинг 2.14. Метод TtdObjectList.Clear

procedure TtdObjectList.Clear;

var

i : integer;

begin

{если данные принадлежат списку, перед очисткой списка освобождаем память, занимаемую элементами}

if DataOwner then

for i := 0 to pred(FList.Count) do

TObject(FList[i]).Free;

FList.Clear;

end;

Методы Delete и Remove перед удалением выполняют один и тот же тип проверки, и если список владеет данными, объект освобождается, после чего удаляется и список. Обратите внимание, что в методе Remove используется не вызов метода FList.Remove, а полная реализация метода. Такой подход называется "кодированием на основе главных принципов". Он обеспечивает более глубокий контроль и дает более высокую эффективность.

Листинг 2.15. Удаление элемента из списка TtdObjectList

procedure TtdObjectList.Delete(aIndex : integer);

begin

{проверяем индексы сами, а не перекладываем эту обязанность на список}

if (aIndex < 0) or (aIndex >= FList.Count) then

olError(tdeIndexOutOfBounds, 'Delete', aIndex);

{если список владеет объектами, освобождаем память, занимаемую удаляемым элементом}

if DataOwner then

TObject(FList[aIndex]).Free;

{удалить элемент из списка}

FList.Delete(aIndex);

end;

function TtdObjectList.Remove(aItem : TObject): integer;

begin

{найти требуемый элемент}

Result := IndexOf(aItem);

{если элемент найден...}

if (Resul <> -1) then begin

{если список владеет объектами, освобождаем память, занимаемую удаляемым элементом}

if DataOwner then

TObject(FList[Result]).Free;

{удалить элемент из списка}

FList.Delete(Result);

end;

end;

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

var

MyObjectList : TtdObjectList;

SomeObject : TObject;

begin

• • •

MyObjectList[0] := SomeObject;

Все кажется довольно-таки безобидным, но подумайте, что случится, если данные принадлежат списку. В результате выполнения оператора присваивания элемент с индексом 0 будет замещен новым объектом, SomeObject. Предыдущий объект будет безвозвратно потерян, и ссылки на него окажутся недействительными. Таким образом, перед заменой старый объект нужно освободить. Конечно, сначала следует проверить принадлежит ли новый объект к требуемому типу.

Листинг 2.16. Запись элемента в TtdObjectList

procedure TtdObjectList.olSetItem(aIndex : integer;

aItem : TObject);

begin

{проверить тип элемента}

if (aItem = nil) then

olError(tdeNilItem, 'olSetItem', aIndex);

if not (aItem is FClass) then

olError(tdeInvalidClassType, 'olSetItem', aIndex);

{проверяем индексы сами, а не перекладываем эту обязанность на список}

if (aIndex < 0) or (aIndex >= FList.Count) then

olError(tdeIndexOutOfBounds, 'olSetItem', aIndex);

{если список владеет объектами и объект с текущим индексом должен быть заменен новым объектом, сначала освобождаем старый объект}

if DataOwner and (aItemoFList [aIndex]) then

TObject(FList[aIndex]).Free;

{сохранить в списке новый объект}

FList[aIndex] := aItem;

end;

И, наконец, рассмотрим методы Add и Insert. Как и Remove, метод Add написан с учетом главных принципов, поэтому вместо FList.Add используется FList.Insert.

Листинг 2.17. Методы Add и Insert класса TtdObjectList

function TtdObjectList.Add(aItem : TObject): integer;

begin

{проверить тип элемента}

if (aItem = nil) then

olError(tdeNilItem, 'Add', FList.Count);

if not (aItem is FClass) then

olError(tdeInvalidClassType, 'Add', FList.Count);

{вставить новый элемент в конец списка}

Result := FList.Count;

FList.Insert(Result, aItem);

end;

procedure TtdObjectList.Insert(aIndex : integer; aItem : TObject);

begin

{проверить тип элемента}

if (aItem = nil) then

olError(tdeNilItem, 'Insert', aIndex);

if not (aItem is FClass) then

olError(tdeInvalidClassType, 'Insert', aIndex);

{проверяем индексы сами, а не перекладываем эту обязанность на список}

if (aIndex < 0) or (aIndex > FList.Count) then

olError(tdeIndexOutOfBounds, 'Insert', aIndex);

{вставить новый элемент в список}

FList.Insert(aIndex, aItem);

end;

Полный код класса TtdObjectList можно найти на Web-сайте издательства, в разделе материалов. После выгрузки материалов отыщите среди них файл TDObjLst.pas.

Оглавление книги

Оглавление статьи/книги

Генерация: 1.675. Запросов К БД/Cache: 3 / 1
поделиться
Вверх Вниз