Листинг 2.7. Расширение массива
procedure TtdRecordList.rlExpand;
var
NewCapacity : integer;
begin
{если текущая емкость массива равна 0, установить новую емкость равной 4 элемента}
if (Capacity = 0) then
NewCapacity := 4
{если текущая емкость массива меньше 64, увеличить ее на 16 элементов}
else
if (Capacity < 64) then
NewCapacity := Capacity +16
{если текущая емкость массива 64 или больше, увеличить ее на 25%}
else
NewCapacity := Capacity + (Capacity div 4);
{убедиться, что мы не выходим за верхний индекс массива}
if (NewCapacity > FMaxElemCount) then begin
NewCapacity := FMaxElemCount;
if (NewCapacity = Capacity) then
rlError (tdeAtMaxCapacity, 'rlExpand', 0);
end;
{установить новую емкость}
Capacity := NewCapacity;
end;
procedure TtdRecordList.rlSetCapacity(aCapacity : integer);
begin
if (aCapacity <> FCapacity) then begin
{запретить переход через максимально возможное количество элементов}
if (aCapacity > FMaxElemCount) then
rlError(tdeCapacityTooLarge, 'rlSetCapacity', 0);
{повторно распределить или освободить память, если емкость массива уменьшена до нуля}
{$IFDEF Delphi1}
if (aCapacity= 0) than begin
FreeMem(FArray, word(FCapacity) * FElementSize);
FArray := nil
end
else begin
if (FCapacity = 0) then
GetMem( FArray, word (aCapacity) * FElementSize) else
FArray := ReallocMem(FArray,
word(FCapacity) * FElementSize,
word(aCapacity) * FElementSize);
end;
{$ELSE}
ReallocMem(FArray, aCapacity * FElementSize);
{$ENDIF}
{емкость уменьшается? если да, проверить счетчик}
if (aCapacity < FCapacity) then begin
if (Count > aCapacity) then
Count := aCapacity;
end;
{сохранить новую емкость}
FCapacity := aCapacity;
end
end;
Конечно, любой класс массива оказался бы бесполезным, если бы было невозможно считать элемент из массива. В классе TtdRecordList для этой цели имеется свойство Items. Единственным средством доступа для этого свойства является метод считывания rlGetItem. Во избежание ненужного копирования данных в элемент, метод rlGetItem возвращает указатель на элемент массива. Это позволяет не только считать, но и легко изменить элемент. Именно поэтому для свойства Items нет специального метода записи. Поскольку свойство отмечено ключевым словом default, доступ к отдельным элементам можно получить с помощью кода MyArray[i], а не MyArray.Items[i].
Листинг 2.8. Получение доступа к элементу массива
function TtdRecordList.rlGetItem(aIndex : integer): pointer;
begin
if (aIndex < 0) or (aIndex >= Count) then
rlError(tdeIndexOutOfBounds, 'rlGetItem', aIndex);
