Класс реализует коллекцию элементов типа Variant, которые могут
интерпретироваться как Integer, String или Currency. Динамический список этих
элементов может быть именованным, где каждому элементу присваивается имя. Это
условие по умолчанию не обрабатывается, так что с этим классом можно работать
просто как с динамическим списком величин типа Variant. Довольно
удобно. Можно искать в списке по значению (IndexOF), по имени
(GetValueFromName), удалять из списка. Функция JoinList
возвращает строку из символьного представления всех элементов списка разделенных
заданным сепаратором.
unit ListUtils;
interfaceuses Classes, SysUtils;
type
TListsItem = class(TCollectionItem)
private
FValue: Variant;
FName: string;
protectedfunction GetAsInteger: LongInt;
procedure SetAsInteger(AValue: LongInt);
function GetAsString: string;
procedure SetAsString(AValue: string);
function GetAsCurrency: Currency;
procedure SetAsCurrency(AValue: Currency);
publicprocedure 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)
privatefunction GetListItem(Index: Integer): TListsItem;
publicconstructor Create(ItemClass: TCollectionItemClass);
function AddItem(Value: Variant; AName: string = ''): TListsItem;
procedure FillFromArray(ArValue: arrayof Variant);
procedure FillFromNamedArray(ArValue, ArName: arrayof 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);
begininherited 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 thenbeginfor 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 <> nilthen
Delete(AItem.Index);
end;
//----------------------------------------------------------------------------------------function TLists.GetFromName(AName: string): TListsItem;
var
i: Integer;
begin
Result := nil;
for i := 0 to Count - 1 doif CompareText(AnItems[i].FName, AName) = 0 thenbegin
Result := AnItems[i];
Exit;
end;
end;
//----------------------------------------------------------------------------------------function TLists.GetValueFromName(AName: string; DefaultValue: Variant): Variant;
begin
Result := DefaultValue;
if GetFromName(AName) <> nilthen
Result := GetFromName(AName).Value;
end;
//----------------------------------------------------------------------------------------procedure TLists.FillFromArray(ArValue: arrayof Variant);
var
i: Integer;
begin
Clear;
for i := Low(ArValue) to High(ArValue) do
AddItem(ArValue[i]);
end;
//----------------------------------------------------------------------------------------procedure TLists.FillFromNamedArray(ArValue, ArName: arrayof 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);
beginif Dest is TListsItem thenbegin
TListsItem(Dest).FValue := FValue;
TListsItem(Dest).FName := FName;
endelseinherited;
end;
//----------------------------------------------------------------------------------------function TListsItem.GetAsInteger: LongInt;
beginif 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;
beginif TVarData(FValue).VType <> varNull then
Result := TVarData(FValue).vCurrency
else
Result := 0;
end;
//----------------------------------------------------------------------------------------procedure TListsItem.SetAsCurrency(AValue: Currency);
begin
FValue := AValue;
end;
//----------------------------------------------------------------------------------------end.
Статья Класс для реализации списка Variant-ов на основе TCollection раздела Компоненты и Классы Коллекции может быть полезна для разработчиков на Delphi и FreePascal.
Комментарии и вопросы
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.