Практических целей не стоит, просто хобби. Не помню зачем как-то понадобился список (хранить, например, строки). Читать про готовые решения было лень. Решил написать свой… Основной прикол: список создаётся для конкретного размера элементов в нём.
Исходный код: bitbucket.org
Программка для тестирования (написана лишь бы работало, рядом с файлами нужно поместить содержимое из b0a3d7a2_units): bitbucket.org
Вот основной файл реализации списка:
- Код: Выделить всё
//──────────────────────────────────────────────────────────────────────────────
{
B0A3D7A2_UniList.pas
Copyright 2010-2013 Andrew V. Dromaretsky <dromaretsky@gmail.com>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
//──────────────────────────────────────────────────────────────────────────────
unit B0A3D7A2_UniList;
//──────────────────────────────────────────────────────────────────────────────
{$ifdef FPC}
{$mode Delphi}{$H+}
{$else}// If not FPC than maybe Delphi32
{$define DELPHI32}
{$endif}
//──────────────────────────────────────────────────────────────────────────────
interface
//──────────────────────────────────────────────────────────────────────────────
uses
Classes, SysUtils, B0A3D7A2_Types;
//──────────────────────────────────────────────────────────────────────────────
type
// Тип для работы с кодами ошибок в списке TUniList
UniListErrCode = Int16U;
const
// Константы для описания ошибок при работе с TUniList
UniListErrNone: UniListErrCode = $0000; // неизвестно
UniListErrOk: UniListErrCode = $0001; // операция выполнена
UniListErrLock: UniListErrCode = $0002; // список заблокирован
UniListErrEdit: UniListErrCode = $0004; // список редактируется
UniListErrParam: UniListErrCode = $0008; // неверные параметры
UniListErrMem: UniListErrCode = $0010; // ошибка работы с памятью (очень плохо)
UniListErrInit: UniListErrCode = $0020; // ошибка при инициализации элементов через _OnAdd
UniListErrFree: UniListErrCode = $0040; // ошибка при освобождении элементов через _OnDel
// Failed to free some elements
UniListErrInitOk: UniListErrCode = $0080; // попытка инициализации элементов проведена
UniListErrFreeOk: UniListErrCode = $0100; // попытка высвобождения элементов проведена
// Done trying to free elements
UniListErrAll: UniListErrCode = $FFFF; // ?
type
// Тип функции вызываемой при добавлении или удалении элемента
// для инициализации (если элемент это клас то нужно вызвать его конструктор)
// и для очистки перед удалением (например если в элементе содержится ссылка на текстовую строку,
// которую необходимо очистить перед удалением элемента, что бы не висела в памяти)
TUniListElOp = function(Index: IntU; Value: Pointer): IntU of object;
// Универсальный список на основе динамического массива
TUniList = class(TObject)
private
_Array: Int8UAD; // Динамический массив в котором хранятся элементы списка
_Size: PtrUInt; // Размер элемента в байтах
_Count: IntU; // Количество элементов
_Edit: Boolean;
// Для предотвращения попыток изменить список пока он изменяется в другом месте
_LockKey: IntU; // Ключ для блокировки списка от изменений (0 - разблокировано)
_OnAdd: TUniListElOp;
// Переменная хранящая указатель на функцию вызываемую при добавлении нового элемента
_OnDel: TUniListElOp; // ... удалении элемента
_OnChange: TNotifyEvent;
// Переменная хранящая указатель на функцию вызываемую перед какими либо изменениями
_OnChanged: TNotifyEvent; // ... после изменений
protected
procedure ChangeStart;
procedure ChangeFinish;
public
// Добавить несколько элементов
// с вызовом OnAdd если функция существует
// если необходимо добавить N элементов, то лучше вызвать Add(N),
// а потом каждый из них уже изменить как надо, чем выполнять Add N-раз
// так как каждый раз будет происходить выделение памяти,
// в то время как в первом случае память будет выделена сразу под
// все добавляемые элементы
function Add(const Len: IntU = 1; const Key: IntU = 0): UniListErrCode; virtual;
// Вызов функций инициализации новых элементов
function ElementsInit(Position: IntU; const Len: IntU = 1): UniListErrCode; virtual;
// Вызов функций высвобождения элементов
function ElementsFree(Position: IntU; const Len: IntU = 1): UniListErrCode; virtual;
// Проверка возможности выполнения функции Ins (нет ли выхода за пределы списка и т.п.)
// Используется при вызове функции Ins
function CheckIns(const Position: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode; virtual;
// Вставка новых элементов в определенную позицию
// с вызовом OnAdd если функция существует
function Ins(const Position: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode; virtual;
// Проверка возможности выполнения функции Del (нет ли выхода за пределы списка и т.п.)
// Используется при вызове функции Del
function CheckDel(const Position: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode; virtual;
// Удаление нескольких элементов с вызовом OnDel если
// функция существует
function Del(const Position: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode; virtual;
// Проверка возможности выполнения функции ExChng (нет ли выхода за пределы списка и т.п.)
// Используется при вызове функции ExChng
function CheckExChng(const Pos1, Pos2: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode; virtual;
// Обмен элементами: Len-элементов из позиции Pos1 будут перемещены
// в позицию Pos2 и наоборот
function ExChng(const Pos1, Pos2: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode; virtual;
// Проверка возможности выполнения функции Move (нет ли выхода за пределы списка и т.п.)
// Используется при вызове функции Move
function CheckMove(const Pos1, Pos2: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode; virtual;
// Перемещение Len-элементов хранящихся в позиции Src будут перемещены в позицию
// Dest
function Move(const Pos1, Pos2: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode; virtual;
// Проверка возможности выполнения функции CheckClear
// Используется при вызове функции CheckClear
function CheckClear(const Key: IntU = 0): UniListErrCode;
// Очистка - удаление всех элементов с вызовом OnDel если
// функция существует
function Clear(const Key: IntU = 0): UniListErrCode; virtual;
// Функции для блокировки/разблокировки списка
// Заблокировать список от изменений. Вернёт False если уже был заблокирован
function Lock(const Key: IntU): Boolean; virtual;
// Проверить заблокирован ли список
function Locked: Boolean; virtual;
// Проверить ключ
function KeyCheck(const Key: IntU): Boolean; virtual;
// Разблокировать список. Вернёт False если уже был разблокирован
function Unlock(const Key: IntU): Boolean; virtual;
// Возвращает _Size
function GetElementSize: IntU;
// Устанавливает значение _Size
// если новая длинна элемента не укладывается челое число раз в
// длине миссива хранящего элементы, то последний будет
// соответственно дополнен нулями и в лубом случе будет изменено _Count
//procedure SetElementSize(S: IntU);
// Возвращает указатель на I-й элемент
// если есть выход за границы списка то возвращает nil
function GetElement(I: IntU): Pointer;
// Возвращает _Count
function GetCount: IntU;
// Требуется для работы со свойством OnAdd
function GetOnAdd: TUniListElOp;
// Требуется для работы со свойством OnAdd
procedure SetOnAdd(S: TUniListElOp);
// Требуется для работы со свойством OnDel
function GetOnDel: TUniListElOp;
// Требуется для работы со свойством OnDel
procedure SetOnDel(S: TUniListElOp);
// Требуется для работы со свойством OnChange
function GetOnChange: TNotifyEvent;
// Требуется для работы со свойством OnChange
procedure SetOnChange(S: TNotifyEvent);
// Требуется для работы со свойством OnChanged
function GetOnChanged: TNotifyEvent;
// Требуется для работы со свойством OnChanged
procedure SetOnChanged(S: TNotifyEvent);
// Конструктор
constructor Create(ElementSize: IntU = SizeOf(Pointer));
// Деструктор
destructor Destroy; override;
// Свойтво возвращает указатель на элемент
property Element[index: IntU]: Pointer read GetElement; default;
published
// Свойтво для работы с _Count
property Count: IntU read GetCount;
property ElementSize: IntU read GetElementSize; //write SetElementSize;
// Адресс функции, которую нужно вызвать при добавлении нового элемента
property OnAdd: TUniListElOp read GetOnAdd write SetOnAdd;
// Адресс функции, которую нужно вызвать при удалении имеющегося элемента
property OnDel: TUniListElOp read GetOnDel write SetOnDel;
// Адресс функции, которая вызывается перед изменениями
property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
// Адресс функции, которая вызывается после изменений
property OnChanged: TNotifyEvent read GetOnChanged write SetOnChanged;
end;
//──────────────────────────────────────────────────────────────────────────────
implementation
//──────────────────────────────────────────────────────────────────────────────
constructor TUniList.Create(ElementSize: IntU = SizeOf(Pointer));
begin
inherited Create;
if ElementSize > 0 then
begin
_Size := ElementSize;
end
else
begin
_Size := SizeOf(Pointer);
end;
_Count := 0;
_Edit := False;
_LockKey := 0;
_OnAdd := nil;
_OnDel := nil;
_OnChange := nil;
_OnChanged := nil;
end;
//──────────────────────────────────────────────────────────────────────────────
destructor TUniList.Destroy;
begin
_LockKey := 0; // сброс ключа блокировки, что-бы выполнить последующую очистку
_Edit := False;
Clear;
_OnAdd := nil;
_OnDel := nil;
_OnChange := nil;
_OnChanged := nil;
inherited;
end;
//──────────────────────────────────────────────────────────────────────────────
procedure TUniList.ChangeStart;
begin
try
if @_OnChange <> nil // если указатель на функцию не нулевой,
// то необходимо вызвать функцию сигнализирующую о начале изменений
then
begin
_OnChange(Self);
end;
finally
_Edit := True;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
procedure TUniList.ChangeFinish;
begin
try
if @_OnChanged <> nil // если указатель на функцию не нулевой,
// то необходимо вызвать функцию сигнализирующую о завершении изменений
then
begin
_OnChanged(Self);
end;
finally
_Edit := False;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.GetElement(I: IntU): Pointer;
begin
Result := nil;
if (I < _Count) AND (NOT _Edit) then
begin
PtrUInt(Result) := PtrUInt(_Array) + PtrUInt(I) * _Size;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.GetCount: IntU;
begin
Result := _Count;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.GetOnAdd: TUniListElOp;
begin
Result := _OnAdd;
end;
//──────────────────────────────────────────────────────────────────────────────
procedure TUniList.SetOnAdd(S: TUniListElOp);
begin
if @S <> @_OnAdd then
begin
_OnAdd := S;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.GetOnDel: TUniListElOp;
begin
Result := _OnDel;
end;
//──────────────────────────────────────────────────────────────────────────────
procedure TUniList.SetOnDel(S: TUniListElOp);
begin
if @S <> @_OnDel then
begin
_OnDel := S;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.GetOnChange: TNotifyEvent;
begin
Result := _OnChange;
end;
//──────────────────────────────────────────────────────────────────────────────
procedure TUniList.SetOnChange(S: TNotifyEvent);
begin
if @S <> @_OnChange then
begin
_OnChange := S;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.GetOnChanged: TNotifyEvent;
begin
Result := _OnChanged;
end;
//──────────────────────────────────────────────────────────────────────────────
procedure TUniList.SetOnChanged(S: TNotifyEvent);
begin
if @S <> @_OnChanged then
begin
_OnChanged := S;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
// Заблокировать список от изменений. Вернёт False если уже был заблокирован
function TUniList.Lock(const Key: IntU): Boolean;
begin
Result := False;
if _LockKey = 0 then
begin
_LockKey := Key;
Result := True;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
// Проверить заблокирован ли список
function TUniList.Locked: Boolean;
begin
Result := (_LockKey <> 0);
end;
//──────────────────────────────────────────────────────────────────────────────
// Проверить ключ
function TUniList.KeyCheck(const Key: IntU): Boolean;
begin
Result := (_LockKey = Key);
end;
//──────────────────────────────────────────────────────────────────────────────
// Разблокировать список. Вернёт False если уже был разблокирован
function TUniList.Unlock(const Key: IntU): Boolean;
begin
Result := False;
if (_LockKey = Key) AND (Key <> 0) then
begin
_LockKey := 0;
Result := True;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.Add(const Len: IntU = 1; const Key: IntU = 0): UniListErrCode;
// Добавление новых элементов
begin
// Данная функция реализована через функцию вставки новых элементов в конец
Result := Ins(_Count, Len, Key);
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.ElementsInit(Position: IntU; const Len: IntU = 1): UniListErrCode;
var
MemPos: PtrUInt;
Pos: IntU;
PosLast: IntU;
begin
Result := UniListErrNone;
if (@_OnAdd <> nil) AND (Len > 0) AND (Position + Len <= _Count) then
begin
MemPos := PtrUInt(_Array) + Position * _Size; // указатель на первый элемент
Pos := Position;
PosLast := Position + Len;
while Pos < PosLast do
begin
try
_OnAdd(Pos, Pointer(MemPos)); // вызываем функцию инициализации элемента
except
Result := Result OR UniListErrInit;
end;
// переходим к следующему с номером Pos и адресом MemPos
Pos := Pos + 1;
MemPos := MemPos + _Size;
end;
Result := Result OR UniListErrInitOk;
end
else
begin
Result := Result OR UniListErrParam;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.ElementsFree(Position: IntU; const Len: IntU = 1): UniListErrCode;
var
MemPos: PtrUInt;
Pos: IntU;
PosLast: IntU;
begin
Result := UniListErrNone;
if (@_OnDel <> nil) AND (Len > 0) AND (Position + Len <= _Count) then
begin
MemPos := PtrUInt(_Array) + Position * _Size; // указатель на первый элемент
Pos := Position;
PosLast := Position + Len;
while Pos < PosLast do
begin
try
_OnDel(Pos, Pointer(MemPos)); // вызываем функцию освобождения элемента
except
Result := Result OR UniListErrFree;
end;
// переходим к следующему с номером Pos и адресом MemPos
Pos := Pos + 1;
MemPos := MemPos + _Size;
end;
Result := Result OR UniListErrFreeOk;
end
else
begin
Result := Result OR UniListErrParam;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.CheckIns(const Position: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode;
begin
Result := UniListErrNone;
if (NOT KeyCheck(Key)) AND (Locked) then
begin
Result := Result OR UniListErrLock; // список заблокирован
end;
if _Edit then
begin
Result := Result OR UniListErrEdit; // список изменяется
end;
if (Len <= 0) OR (Position > _Count) then
// Нельзя вставить элементы за пределами списка, разве что в конце
begin
Result := Result OR UniListErrParam; // неверные параметры
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.Ins(const Position: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode;
// Вставка новых элементов в определенную позицию
var
MemLen1: PtrUInt; // начальная длина списка (в байтах)
MemLen2: PtrUInt; // конечная длина списка (в байтах)
MemLenAdd: PtrUInt; // сколько нужно добавить памяти (в байтах)
MemPos1: PtrUInt; // позиция для вставки (в байтах)
MemPos2: PtrUInt; // позиция куда сдвигать старые данные (в байтах)
MemLenMov: PtrUInt; // сколько сдвигать данных (в байтах)
begin
Result := CheckIns(Position, Len, Key);
if Result = UniListErrNone then // проверка параметров вызова
begin
try
try
ChangeStart; // начало изменения списка
MemLen1 := Length(_Array); // текущая длина массива
MemLenAdd := Len * _Size;
// память которую необходимо выделить для новых элементов
MemLen2 := MemLen1 + MemLenAdd; // новое значение длины
SetLength(_Array, MemLen2); // выставляется новое значение длины массива
_Count := _Count + Len; // увеличение счетчика элементов в списке
MemPos1 := PtrUInt(_Array) + Position * _Size; // адресс в который
// необходимо вставить новые элементы
MemPos2 := MemPos1 + MemLenAdd; // куда сдвигать старые данные
MemLenMov := MemLen1 - Position * _Size; // сколько сдвигать старых данных
system.Move(Pointer(MemPos1)^, Pointer(MemPos2)^, MemLenMov);
// перемещение уже имеющихся элементов
system.FillChar(Pointer(MemPos1)^, MemLenAdd, 0); // очистка освободившейся
// памяти на всякий случай
Result := Result OR UniListErrOk;
Result := Result OR ElementsInit(Position, Len); // вызов функции для
// инициализации новых элементов;
finally
ChangeFinish; // изменения в списке завершены
end;
except
Result := Result OR UniListErrMem;
end;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.CheckDel(const Position: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode;
begin
Result := UniListErrNone;
if (NOT KeyCheck(Key)) AND (Locked) then
begin
Result := Result OR UniListErrLock; // список заблокирован
end;
if _Edit then
begin
Result := Result OR UniListErrEdit; // список изменяется
end;
if (Len <= 0) OR (Position + Len > _Count) then
// Нельзя удалить несуществующие элементы
// а удалять 0 штук везсмысленно
begin
Result := Result OR UniListErrParam; // неверные параметры
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.Del(const Position: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode;
// Удаление нескольких элементов в определенной позиции
var
MemLen1: IntU; // начальная длина списка (в байтах)
MemLen2: IntU; // конечная длина списка (в байтах)
MemLenRem: IntU; // сколько нужно убавить памяти (в байтах)
MemPos1: IntU; // позиция для удаления (в байтах)
MemPos2: IntU; // позиция откуда сдвигать старые данные (в байтах)
MemLenMov: IntU; // сколько сдвигать данных (в байтах)
begin
Result := CheckDel(Position, Len, Key);
if Result = UniListErrNone then // проверка параметров вызова
begin
try
try
ChangeStart; // начало изменения списка
Result := Result OR ElementsFree(Position, Len); // вызов функции для
// освобождения элементов
MemPos1 := PtrUInt(_Array) + Position * _Size; // получение адреса
// первого элемента из удаляемых
MemLen1 := Length(_Array); // текущая длина массива
MemLenRem := Len * _Size; // размер удаляемых элементов
MemPos2 := MemPos1 + MemLenRem; // адрес первого элемента за удаляемыми
MemLen2 := MemLen1 - MemLenRem; // вычисление новой длины массива
MemLenMov := MemLen1 - (Position + Len) * _Size; // размер перемещаемой области
system.Move(Pointer(MemPos2)^, Pointer(MemPos1)^, MemLenMov);
// перемещение элементов следующих за удаляемыми
system.FillChar(Pointer(MemPos1 + MemLenMov)^, MemLenRem, 0); // заполнение нулями
// освободившейся области, во избежание проблем
SetLength(_Array, MemLen2); // установка новой длины массива
_Count := _Count - Len; // изменение счетчика кол-ва элементов в списке
Result := Result OR UniListErrOk;
finally
ChangeFinish; // изменения в списке завершены
end;
except
Result := Result OR UniListErrMem;
end;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.CheckExChng(const Pos1, Pos2: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode;
begin
Result := UniListErrNone;
if (NOT KeyCheck(Key)) AND (Locked) then
begin
Result := Result OR UniListErrLock; // список заблокирован
end;
if _Edit then
begin
Result := Result OR UniListErrEdit; // список изменяется
end;
if (Pos1 = Pos2) OR (Len <= 0) OR // имеет ли смысл операция
(Pos1 + Len > _Count) OR (Pos2 + Len > _Count) OR // есть ли выход за пределы
((Pos1 > Pos2) AND (Pos1 - Pos2 < Len)) OR // или пересечение
((Pos1 < Pos2) AND (Pos2 - Pos1 < Len)) then
begin
Result := Result OR UniListErrParam; // неверные параметры
end;
end;
//──────────────────────────────────────────────────────────────────────────────
// Смена - Len-элементов из розиции Pos1 перемещаются в позицию Pos2 и наоборот
function TUniList.ExChng(const Pos1, Pos2: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode;
var
MemPos1: PtrUInt;
MemPos2: PtrUInt;
MemLen: PtrUInt; // длина перемещаемой памяти
Buf: Int8UAD; // временный буфер
begin
Result := CheckExChng(Pos1, Pos2, Len, Key);
if Result = UniListErrNone then // проверка параметров вызова
begin
try
try
ChangeStart; // начало изменения списка
MemLen := Len * _Size; // размер данных для обработки
SetLength(Buf, MemLen); // инициализация временного буфера
MemPos1 := PtrUInt(_Array) + Pos1 * _Size; // вычисление адреса Pos1
MemPos2 := PtrUInt(_Array) + Pos2 * _Size; // вычисление адреса Pos2
system.Move(Pointer(MemPos1)^, Pointer(Buf)^, MemLen); // копирование данных
// из позиции Pos1 в буфер
system.Move(Pointer(MemPos2)^, Pointer(MemPos1)^, MemLen);
// копирование данных из Pos2 в Pos1
system.Move(Pointer(Buf)^, Pointer(MemPos2)^, MemLen);
// копирование данных из буфера в Pos2
system.FillChar(Pointer(Buf)^, MemLen, 0); // очистка буфера, на всякий случай
Result := Result OR UniListErrOk;
finally
SetLength(Buf, 0); // освобождение памяти буфера
ChangeFinish; // изменения в списке завершены
end;
except
Result := Result OR UniListErrMem;
end;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.CheckMove(const Pos1, Pos2: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode;
begin
Result := UniListErrNone;
if (NOT KeyCheck(Key)) AND (Locked) then
begin
Result := Result OR UniListErrLock; // список заблокирован
end;
if _Edit then
begin
Result := Result OR UniListErrEdit; // список изменяется
end;
if (Pos1 = Pos2) OR (Len <= 0) OR // имеет ли смысл операция
(Pos1 + Len > _Count) OR (Pos2 + Len > _Count) // есть ли выход за пределы
then
begin
Result := Result OR UniListErrParam; // неверные параметры
end;
end;
//──────────────────────────────────────────────────────────────────────────────
// Перемещение блока элементов длинной Len из позиции Pos1 в Pos2
// остальные элементы просто сдвигаются, количество элементов в целом не меняется
function TUniList.Move(const Pos1, Pos2: IntU; const Len: IntU = 1;
const Key: IntU = 0): UniListErrCode;
var
MemPos1: PtrUInt;
MemPos2: PtrUInt;
MemPos3: PtrUInt;
MemPos4: PtrUInt;
MemLen12: PtrUInt;
MemLen34: PtrUInt;
Buf: Int8UAD;
begin
Result := CheckMove(Pos1, Pos2, Len, Key);
if Result = UniListErrNone then // проверка параметров вызова
begin
try
try
ChangeStart; // начало изменения списка
MemLen12 := Len * _Size; // размер обрабатываемых данных в байтах
SetLength(Buf, MemLen12); // выделени памяти для буфера
MemPos1 := PtrUInt(_Array) + Pos1 * _Size; // адрес Pos1
MemPos2 := PtrUInt(_Array) + Pos2 * _Size; // адрес Pos2
system.Move(Pointer(MemPos1)^, Pointer(Buf)^, MemLen12); // копирование
// данных из позиции Pos1 в буфер
if MemPos1 < MemPos2 // проверка условия и последующее вычиления параметров
// памяти которую нужно передвинуть
then
begin
MemPos3 := MemPos1 + MemLen12;
MemPos4 := MemPos1;
MemLen34 := MemPos2 - MemPos1;
end
else
begin
MemPos3 := MemPos2;
MemPos4 := MemPos2 + MemLen12;
MemLen34 := MemPos1 - MemPos2;
end;
system.Move(Pointer(MemPos3)^, Pointer(MemPos4)^, MemLen34); // перемещение
// остальных элементов списка
system.Move(Pointer(Buf)^, Pointer(MemPos2)^, MemLen12); // копирование данных
// из буфера в позицию Pos2
system.FillChar(Pointer(Buf)^, MemLen12, 0); // очистка буфера, на всякий случай
Result := Result OR UniListErrOk;
finally
SetLength(Buf, 0); // очистка буфера
ChangeFinish; // изменения в списке завершены
end;
except
Result := Result OR UniListErrMem;
end;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.CheckClear(const Key: IntU = 0): UniListErrCode;
begin
Result := UniListErrNone;
if (NOT KeyCheck(Key)) AND (Locked) then
begin
Result := Result OR UniListErrLock; // список заблокирован
end;
if _Edit then
begin
Result := Result OR UniListErrEdit; // список изменяется
end;
end;
//──────────────────────────────────────────────────────────────────────────────
// Полная очистка
function TUniList.Clear(const Key: IntU = 0): UniListErrCode;
begin
Result := CheckClear(Key);
if Result = UniListErrNone then // проверка параметров вызова
begin
try
try
ChangeStart;
Result := Result OR ElementsFree(0, _Count);
system.FillChar(Pointer(_Array)^, _Count * _Size, 0);
Result := Result OR UniListErrOk;
finally
_Count := 0; // обнуление счетчика элементов
// очистка массива, на всякий случай
SetLength(_Array, 0); // удаление массива данных
ChangeFinish;
end;
except
Result := Result OR UniListErrMem;
end;
end;
end;
//──────────────────────────────────────────────────────────────────────────────
function TUniList.GetElementSize: IntU;
begin
Result := _Size;
end;
//──────────────────────────────────────────────────────────────────────────────
end.
Вроде как работает, теперь стало интересно нужно ли оно вообще и насколько безграмотно написан код)
Спасибо!
Не стал бы таким пользоваться, проверять все эти коды... тем более что исключения затем и были введены, чтобы от них избавиться.
?