{ *************************************************************************** Copyright (c) 2016-2018 Kike Pérez Unit : Quick.Lists Description : Generic Lists functions Author : Kike Pérez Version : 1.0 Created : 04/11/2018 Modified : 04/1º/2018 This file is part of QuickLib: https://github.com/exilon/QuickLib *************************************************************************** Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. *************************************************************************** } unit Quick.Lists; {$i QuickLib.inc} interface uses Classes, SysUtils, RTTI, System.Generics.Collections, System.Generics.Defaults; type TSearchDictionary = class(TObjectDictionary) private fIndexName : string; fFieldName : string; public property IndexName : string read fIndexName write fIndexName; property FieldName : string read fFieldName write fFieldName; end; TIndexList = class private fList : TList>; fDictionaryIndex : TObjectDictionary>; public constructor Create; destructor Destroy; override; property List : TList> read fList; function Get(const aIndexName : string) : TSearchDictionary; procedure Add(const aIndexName, aFieldName : string); procedure Remove(const aIndexName : string); end; TIndexedObjectList = class(TList) private fOwnsObjects: Boolean; fIndexes : TIndexList; protected procedure Notify(const Value: T; Action: TCollectionNotification); override; public constructor Create(aOwnsObjects: Boolean = True); overload; constructor Create(const aComparer: IComparer; aOwnsObjects: Boolean = True); overload; constructor Create(const aCollection: TEnumerable; aOwnsObjects: Boolean = True); overload; destructor Destroy; override; property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects; property Indexes : TIndexList read fIndexes; function Get(const aIndexName : string; aValue : Variant) : T; end; implementation { TIndexedObjectList } constructor TIndexedObjectList.Create(aOwnsObjects: Boolean); begin inherited Create; FOwnsObjects := aOwnsObjects; fIndexes := TIndexList.Create; end; constructor TIndexedObjectList.Create(const aComparer: IComparer; aOwnsObjects: Boolean); begin inherited Create(aComparer); FOwnsObjects := aOwnsObjects; fIndexes := TIndexList.Create; end; constructor TIndexedObjectList.Create(const aCollection: TEnumerable; aOwnsObjects: Boolean); begin inherited Create(aCollection); FOwnsObjects := aOwnsObjects; fIndexes := TIndexList.Create; end; procedure TIndexedObjectList.Notify(const Value: T; Action: TCollectionNotification); var sindex : TSearchDictionary; ctx: TRttiContext; rtype: TRttiType; rfield: TRttiField; propvalue : TValue; begin inherited; if Action = cnAdded then begin for sindex in fIndexes.List do begin rtype := ctx.GetType(TypeInfo(T)); rfield := rtype.GetField(sindex.FieldName); if rfield = nil then raise Exception.CreateFmt('Cannot add value to "%s" search dictionary!',[sindex.IndexName]); propvalue := rfield.GetValue(TObject(Value)); sindex.Add(propvalue.AsVariant,Value); end; end; //remove object if owned if OwnsObjects and (Action = cnRemoved) then begin for sindex in fIndexes.List do begin rtype := ctx.GetType(TypeInfo(T)); rfield := rtype.GetField(sindex.FieldName); if rfield = nil then raise Exception.CreateFmt('Cannot remove value to "%s" search dictionary!',[sindex.IndexName]); propvalue := rfield.GetValue(TObject(Value)); sindex.Remove(propvalue.AsVariant); end; Value.DisposeOf; end; end; destructor TIndexedObjectList.Destroy; begin inherited; fIndexes.Free; end; function TIndexedObjectList.Get(const aIndexName: string; aValue : Variant): T; var sindex : TSearchDictionary; begin Result := nil; sindex := fIndexes.Get(aIndexName.ToLower); if sindex <> nil then sindex.TryGetValue(aValue,Result) else raise Exception.CreateFmt('Index "%s" not found!',[aIndexName]); end; { TIndexList } procedure TIndexList.Add(const aIndexName, aFieldName: string); var sdict : TSearchDictionary; ctx: TRttiContext; rtype: TRttiType; rfield: TRttiField; begin rtype := ctx.GetType(TypeInfo(T)); rfield := rtype.GetField(aFieldName); if rfield = nil then raise Exception.CreateFmt('Not found field "%s" to create a search dictionary!',[aFieldName]); sdict := TSearchDictionary.Create; sdict.IndexName := aIndexName; sdict.FieldName := aFieldName; fList.Add(sdict); fDictionaryIndex.Add(aIndexName.ToLower,sdict); end; procedure TIndexList.Remove(const aIndexName: string); var sdict : TSearchDictionary; begin if not fDictionaryIndex.ContainsKey(aIndexName) then raise Exception.CreateFmt('Cannot remove an inexistent "%s" search dictionary!',[aIndexName]); fList.Remove(sdict); fDictionaryIndex.Remove(aIndexName.ToLower); sdict.Free; end; constructor TIndexList.Create; begin fList := TList>.Create; fDictionaryIndex := TObjectDictionary>.Create; end; destructor TIndexList.Destroy; var sindex : TSearchDictionary; begin for sindex in fList do sindex.Free; fList.Free; fDictionaryIndex.Free; inherited; end; function TIndexList.Get(const aIndexName: string): TSearchDictionary; begin Result := nil; fDictionaryIndex.TryGetValue(aIndexName,Result); end; end.