DELPHI/Часто задаваемые вопросы и ответы на них/Компоненты



На главную

Подписка

Новости

Главная / DELPHI / Часто задаваемые вопросы и ответы на них / Компоненты / Класс для реализации списка Variant-ов на основе TCollection

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

Автор: Елена Филиппова

Класс реализует коллекцию элементов типа Variant, которые могут интерпретироваться как Integer, String или Currency. Динамический список этих элементов может быть именованным, где каждому элементу присваивается имя. Это условие по умолчанию не обрабатывается, так что с этим классом можно работать просто как с динамическим списком величин типа Variant. Довольно удобно. Можно искать в списке по значению (IndexOF), по имени (GetValueFromName), удалять из списка.
Функция JoinList возвращает строку из символьного представления всех элементов списка разделенных заданным сепаратором.

Скачать файл ListUtils.zip (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.

Источник получения информации: http://www.delphiworld.narod.ru