Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[18.222.125.171] |
|
Сообщ.
#1
,
|
|
|
TRecordList<T: record> — класс для удобного хранения списка записей
В 2010-м Delphi наконец-то допилили поддержку дженериков до нормального уровня, и я реализовал давнюю мечту - потомок TList для хранения записей (в том числе с полями ссылочного типа). Список поддерживает добавление как уже выделенных указателей на запись, так и самих записей (в этом случае он выделяет память и создает копию). Освобождение памяти происходит автоматически. Также добавлены методы для поиска и сортировки по произвольному условию. Если список отсортирован, производится бинарный поиск, который намного быстрее поиска перебором. 09.12.2010 Добавлена поддержка сортировки, свойство Duplicates, бинарный поиск. type // под 2009 не работает с объявлением типа PT = ^T {$IF CompilerVersion < 21.0}Только для Delphi 2010+{$IFEND} { Список, заточенный под хранение указателей на записи На добавление принимает как уже выделенные указатели, так и константные записи При удалении элемента память освобождается внутри класса Если надо объявить тип указателя на запись, это делается так: type PRec = TRecordList<TRec>.PT, поскольку компилятор считает, что ^TRec и TRecordList<TRec>.^T - это разные типы Поддерживает сортировку и двоичный поиск. При этом функция сравнения, использованная для сортировки, сохраняется в поле класса и используется при поиске } TRecordList<T: record> = class(TList) public type PT = ^T; TMatchFn = reference to function(const item: PT): Boolean; TCompareFn = reference to function(const item1, item2: PT): Integer; TNotifyFn = reference to procedure(const item: PT; Action: TListNotification); protected // fields FOnCheckMatch: TMatchFn; FOnCompare : TCompareFn; FOnNotify : TNotifyFn; FSorted : Boolean; FDuplicates : TDuplicates; // overridden methods function Get(Index: Integer): PT; procedure Put(Index: Integer; Item: PT); procedure Notify(Ptr: Pointer; Action: TListNotification); override; // setters procedure SetSorted(Value: Boolean); procedure SetOnCompare(Fn: TCompareFn); // internal methods function BinaryFind(const Item: T; var Index: Integer): Boolean; public // methods function Add(Item: PT): Integer; overload; function Add(const Item: T): Integer; overload; function Locate(const Item: T): Integer; overload; function Locate(MatchFn: TMatchFn): Integer; overload; procedure Sort; overload; procedure Sort(CompareFn: TCompareFn); overload; // properties property Items[Index: Integer]: PT read Get write Put; default; property Sorted: Boolean read FSorted write SetSorted; property Duplicates : TDuplicates read FDuplicates write FDuplicates; property OnCheckMatch : TMatchFn read FOnCheckMatch write FOnCheckMatch; property OnCompare : TCompareFn read FOnCompare write SetOnCompare; property OnNotify : TNotifyFn read FOnNotify write FOnNotify; end; {$ENDIF} ... {$REGION 'TRecordList<T>'} {$IF CompilerVersion >= 21.0} // Удостоверяемся, что сортировка и бинарный поиск будет производиться // с одним и тем же методом сравнения procedure TRecordList<T>.SetOnCompare(Fn: TCompareFn); begin FOnCompare := Fn; FSorted := False; end; // Бинарный поиск; возвращает True, если элемент найден. // В Index - индекс искомого или ближайшего к нему элемента function TRecordList<T>.BinaryFind(const Item: T; var Index: Integer): Boolean; var Start, Finish, I, CompRes: Integer; begin Result := False; Start := 0; Finish := Count - 1; while Start <= Finish do begin I := (Start + Finish) shr 1; CompRes := FOnCompare(Get(I), @Item); if CompRes = ValLess then Start := I + 1 else begin Finish := I - 1; if CompRes = ValEqual then begin Result := True; if Duplicates <> dupAccept then Start := I; end; end; end; // while Index := Start; end; // Если список отсортирован, то делаем бинарный поиск. Если нет - простой перебор function TRecordList<T>.Locate(const Item: T): Integer; begin if not FSorted then Result := Locate(FOnCheckMatch) else if not BinaryFind(Item, Result) then Result := -1; end; // Простой перебор function TRecordList<T>.Locate(MatchFn: TMatchFn): Integer; var ppList: PPointerList; begin if not Assigned(MatchFn) then raise Exception.Create('MatchFn is not assigned'); ppList := List; for Result := 0 to Count - 1 do if MatchFn(PT(ppList^[Result])) then Exit; Result := -1; end; // Сортировка на основе присвоенного ранее обработчика события procedure TRecordList<T>.Sort; begin if not Assigned(FOnCompare) then raise Exception.Create('FOnCompare is not assigned'); inherited SortList(TListSortCompareFunc(FOnCompare)); end; // Сортировка на основе указанной функции - копирует её в поле обработчика procedure TRecordList<T>.Sort(CompareFn: TCompareFn); begin OnCompare := CompareFn; Sort; FSorted := True; end; // Установка свойства procedure TRecordList<T>.SetSorted(Value: Boolean); begin if FSorted <> Value then begin if Value then Sort; FSorted := Value; end; end; // Добавление указателя function TRecordList<T>.Add(Item: PT): Integer; begin if not FSorted then Result := Count else if BinaryFind(Item^, Result) then case Duplicates of dupIgnore : Exit; dupError : IceUtils.Error('Duplicate record'); end; Insert(Result, Item); end; // Добавление записи (выделяет память и копирует запись) function TRecordList<T>.Add(const Item: T): Integer; var pItem: PT; begin pItem := AllocMem(SizeOf(T)); pItem^ := Item; Result := Add(pItem); end; // Уведомление об удалении элемента - освобождаем выделенную память procedure TRecordList<T>.Notify(Ptr: Pointer; Action: TListNotification); begin if Assigned(FOnNotify) then FOnNotify(PT(Ptr), Action); // удаляем запись if Action = lnDeleted then begin {$HINTS OFF}Finalize(PT(Ptr)^);{$HINTS ON} // если нечего финализировать, то компилер проигнорирует эту строку FreeMemory(PT(Ptr)); end; end; // Простые обёртки для получения и присвоения элементов в нужном типе procedure TRecordList<T>.Put(Index: Integer; Item: PT); begin inherited Put(Index, Item); end; function TRecordList<T>.Get(Index: Integer): PT; begin Result := PT(inherited Get(Index)); end; {$IFEND} {$ENDREGION} Пример использования: type TRec = record b: byte; a: array of Byte; s: string; end; PRec = TRecordList<TRec>.PT; // !!! объявление указателя на запись var lst: TRecordList<TRec>; rec: TRec; pr: PRec; // создание lst := TRecordList<TRec>.Create; // сортировка lst.Sort(function(const Item1, Item2: PRec): Integer begin Result := AnsiCompareStr(Item1.s, Item2.s); end); // добавление записи rec.b := 1; SetLength(rec.a, 10); rec.s := 'foo'; lst.Add(rec); // добавление указателя на запись pr := AllocMem(SizeOf(TRec)); pr.b := 2; SetLength(pr.a, 20); pr.s := 'bar'; lst.Add(pr); // получение элемента log(lst[0].s); log(lst[1].s); // поиск по произвольному условию log(IntToStr( lst.Locate(function (const item: PRec): Boolean begin Result := item.b = 2; end))); Эта тема была разделена из темы "TRecordList<T: record> — класс для удобного хранения списка записей" |