Класс для реализации списка Variant'ов на основе TCollection
Класс реализует коллекцию элементов типа Variant, которые могут интерпретироваться как Integer, String или Currency.
Динамический список этих элементов может быть именованным, где каждому элементу присваивается имя. Это условие по умолчанию не обрабатывается, так что с этим классом можно работать просто как с динамическим списком величин типа Variant.
Довольно удобно.
Можно искать в списке по значению (IndexOF), по имени (GetValueFromName), удалять из списка.
Функция JoinList возвращает строку из символьного представления всех элементов списка разделенных заданным сепаратором.
Скачать файл (2K)
unit ListUtils; interface Uses Classes , SysUtils; Type TListsItem = class(TCollectionItem) Private FValue : Variant; FName : String; Protected Function GetAsInteger : LongInt; Procedure SetAsInteger(AValue : LongInt ); Function GetAsString : String; Procedure SetAsString(AValue : String ); Function GetAsCurrency : Currency; Procedure SetAsCurrency(AValue : Currency ); Public procedure AssignTo( Dest: TPersistent ); override; property Value : Variant read FValue write FValue; property Name : String read FName write FName; property AsInteger : LongInt read GetAsInteger write SetAsInteger; property AsString : String read GetAsString write SetAsString; property AsCurrency : Currency read GetAsCurrency write SetAsCurrency; End; TCollectionListItemClass = class (TListsItem); TLists = class (TCollection) private function GetListItem(Index : Integer) : TListsItem; Public Constructor Create(ItemClass: TCollectionItemClass); Function AddItem( Value : Variant; AName : String ='' ) : TListsItem; Procedure FillFromArray(ArValue : array of Variant); Procedure FillFromNamedArray(ArValue , ArName : array of Variant ); Function IndexOf( Value : Variant ) : Integer; Function JoinList( Separator : String = ',') : String; Function GetFromName(AName : String ) : TListsItem; Function GetValueFromName(AName : String; DefaultValue : Variant ) : Variant; Procedure DeleteFromValue( Value : Variant; All : Boolean = FALSE); Procedure DeleteFromName(AName : String ); Property AnItems[Index : Integer] : TListsItem read GetListItem; default; End; implementation //---------------------------------------------------------------------------------------- // TLists //---------------------------------------------------------------------------------------- Constructor TLists.Create(ItemClass: TCollectionItemClass); Begin Inherited Create(ItemClass); End; //---------------------------------------------------------------------------------------- function TLists.GetListItem(Index : Integer) : TListsItem; Begin Result:=TListsItem(Items[Index]); End; //---------------------------------------------------------------------------------------- function TLists.AddItem(Value : Variant; AName : String = '') : TListsItem; Begin Result:=TListsItem(Self.Add); Result.FValue:=Value; Result.FName:=AName; End; //---------------------------------------------------------------------------------------- function TLists.IndexOf(Value : Variant): Integer; begin Result := 0; while (Result < Count) and ( AnItems[Result].Value <> Value) do Inc(Result); IF Result = Count then Result := -1; end; //---------------------------------------------------------------------------------------- Function TLists.JoinList( Separator : String = ',') : String; Var i : Integer; Begin Result:=''; IF Count > 0 Then Begin For i:=0 To Count-1 Do Result:= Result + AnItems[i].AsString + Separator; Result:=Copy(Result , 1 , Length(Result)-1 ); End; End; //---------------------------------------------------------------------------------------- Procedure TLists.DeleteFromValue( Value : Variant; All : Boolean = FALSE); Var i : Integer; Begin i:=IndexOf(Value); IF i >= 0 Then Delete(i); End; //---------------------------------------------------------------------------------------- Procedure TLists.DeleteFromName(AName : String ); Var i : Integer; AItem : TListsItem; Begin AItem:=GetFromName(AName); IF AItem <> nil Then Delete(AItem.Index); End; //---------------------------------------------------------------------------------------- Function TLists.GetFromName(AName : String ) : TListsItem; Var i : Integer; Begin Result:=nil; For i:=0 To Count-1 Do IF CompareText(AnItems[i].FName , AName) = 0 Then Begin Result:=AnItems[i]; Exit; End; End; //---------------------------------------------------------------------------------------- Function TLists.GetValueFromName(AName : String; DefaultValue : Variant ) : Variant; Begin Result:=DefaultValue; IF GetFromName(AName) <> nil Then Result:= GetFromName(AName).Value; End; //---------------------------------------------------------------------------------------- Procedure TLists.FillFromArray(ArValue : array of Variant); Var i : Integer; Begin Clear; For i:=Low(ArValue) TO High(ArValue) Do AddItem(ArValue[i]); End; //---------------------------------------------------------------------------------------- Procedure TLists.FillFromNamedArray(ArValue , ArName : array of Variant ); Var i , No : Integer; Begin FillFromArray(ArValue); No:=High(ArName); IF No > High(ArValue) Then No:=High(ArValue); For i:=Low(ArName) TO No Do AnItems[i].FName:=ArName[i] ; End; //---------------------------------------------------------------------------------------- //**************************************************************************************** //---------------------------------------------------------------------------------------- // TListItem //---------------------------------------------------------------------------------------- procedure TListsItem.AssignTo( Dest: TPersistent ); Begin IF Dest Is TListsItem Then Begin TListsItem(Dest).FValue:=FValue; TListsItem(Dest).FName:=FName; End Else inherited; End; //---------------------------------------------------------------------------------------- Function TListsItem.GetAsInteger : LongInt; Begin if TVarData(FValue).VType <> varNull then Result := TVarData(FValue).vInteger else Result := 0; End; //---------------------------------------------------------------------------------------- Procedure TListsItem.SetAsInteger(AValue : LongInt ); Begin FValue:=AValue; End; //---------------------------------------------------------------------------------------- Function TListsItem.GetAsString : String; Begin Result:=VarToStr(FValue); End; //---------------------------------------------------------------------------------------- Procedure TListsItem.SetAsString(AValue : String ); Begin FValue:=AValue; End; //---------------------------------------------------------------------------------------- Function TListsItem.GetAsCurrency : Currency; Begin if TVarData(FValue).VType <> varNull then Result := TVarData(FValue).vCurrency else Result := 0; End; //---------------------------------------------------------------------------------------- Procedure TListsItem.SetAsCurrency(AValue : Currency ); Begin FValue:=AValue; End; //---------------------------------------------------------------------------------------- end.
