Класс для реализации списка 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.


Далее: Коллекции и работа с ними »»