Класс для реализации списка Variant-ов на основе TCollection

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.