Недавно добавленные исходники

•  3D Designer  86

•  Sik Screen Capture  68

•  Patch Maker  63

•  Айболит (remote control)  75

•  ListBox Drag & Drop  64

•  Доска для игры Реверси  957

•  Графические эффекты  73

•  Рисование по маске  52

•  Перетаскивание изображений  59

•  Canvas Drawing  54

•  Рисование Луны  137

•  Поворот изображения  44

•  Рисование стержней  39

•  Paint on Shape  35

•  Генератор кроссвордов  49

•  Головоломка Paletto  51

•  Теорема Монжа об окружностях  99

•  Пазл Numbrix  46

•  Заборы и коммивояжеры  68

•  Игра HIP  52

•  Игра Go (Го)  45

•  Симулятор лифта  46

•  Программа укладки плитки  47

•  Генератор лабиринта  90

•  Проверка числового ввода  38

•  HEX View  93

•  Физический маятник  96

•  Задача коммивояжера  123

•  Автомобильная пробка  47

•  Квадратные сетки из слов  40

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



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





Похожие по теме исходники

Нейросеть для распознавания образов

Механизм станка качалки для нефти

Весы для взвешивания

Кувшины для воды

 

Доска для игры Реверси

Сортировка списка




Copyright © 2004-2021 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте   Facebook   Ссылка на Twitter