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;
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.