Какой тип у m_elements[bl]?
Зачем перекрывать метод free?!!
Код: Выделить всё
procedure TIndexTreeElement.free;
begin
if Self <> nil then Self.Destroy;
end;
Вот здесь:
Код: Выделить всё
IMemoryUser = interface(IInterface)
['{69856B39-CEC0-42F0-87EF-AE870FE20C0A}']
procedure free;
end;
"procedure free;" быть не должно!
Не знаю как в 2009, но в 6 дельфях, если не используешь COM, GUID'ы присваивать не обязательно. С помощью них можно было бы создать экземпляр класса, обслуживающего интерфейс, не зная о нём ничего, кроме этого самого гуида.
В описании сласса TIndexTreeElement, еадо убрать "procedure free;". Вы перекрываете метод, который правильно уничтожает экземпляр объекта и вызывает деструктор.
Вот этого:
Код: Выделить всё
procedure TIndexTreeElement.free;
begin
if Self <> nil then Self.Destroy;
end;
Тоже быть не должно! Все проблемы у тебя именно от этого метода free=). Ты варнинги при компиляции читаешь вообще?=))) Там очень полезные вещи пишутся.
Alexander писал(а):А может подскажите, вызывается деструктор Destroy у объекта при таком удалении?
Мне необходимо при удалении объекта производить некоторые действия.
Хотя сам проверю когда время будет.
Да конечно! Но вы перекрыли правильный метод Free. К тому же вызывать его не нужно для интерфейсов. Достаточно обнулить ссылки и дельфи сделает всё за тебя.
Итак:
Код: Выделить всё
type
IMemoryUser = interface(IInterface)
['{69856B39-CEC0-42F0-87EF-AE870FE20C0A}']
end;
IIndexElementsIterator = interface(IMemoryUser)
['{E512EC2B-16A5-4F38-A320-F7EB0777CCAC}']
procedure reset;
function hasNext: boolean;
function next: Int64;
end;
IIndexTreeElement = interface(IMemoryUser)
['{AA39ADC5-FB8B-4A9F-A6F3-87A5BA863222}']
function isExists(number: int64): boolean;
function isNotExists(number: int64): boolean;
function isNotExistsOnServer(number: int64): boolean;
procedure setExists(number: int64);
procedure setNotExists(number: int64);
procedure setNotExistsOnServer(number: int64);
function existsCount: Int64;
function notExistsOnServerCount: Int64;
function usedMemory: Int64;
procedure clear;
end;
TIndexTreeElement = class(TInterfacedObject, IIndexTreeElement)
private
m_elements: TIndexElementsArray;
m_level: TTreeLevel;
m_iCoef: Int64;
m_iFirst: Int64;
constructor Create(first: Int64; coef: Int64; level: TTreeLevel);
function getSubTree(number: Int64; cr: boolean): IIndexTreeElement;
public
destructor Destroy; override;
function isExists(number: Int64): boolean;
function isNotExists(number: Int64): boolean;
function isNotExistsOnServer(number: Int64): boolean;
procedure setExists(number: Int64);
procedure setNotExists(number: Int64);
procedure setNotExistsOnServer(number: Int64);
function existsCount: Int64;
function notExistsOnServerCount: Int64;
function usedMemory: Int64;
procedure clear;
// procedure free; // Этой строчки не должно быть!!!
end;
//------------------------------------------
// ..
//------------------------------------------
procedure TIndexTreeElement.clear;
var i: Integer;
begin
if Self = nil then exit;
for i := 0 to ElementsCount - 1 do
begin
if m_elements[i] <> nil then
m_elements[i] := nil; // надо вот так.
// m_elements[i].free;
end;
тип TIndexElementsArray должен быть массивом интерфейсов, а не массивом объектов.