Класс для манипулирования списком целых чисел

Delphi , Компоненты и Классы , Классы

Автор: Vitaly Sergienko
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Класс для манипулирования списком целых чисел

Класс для манипулирования списком целых чисел
Класс TxIntegerList позволяет оперировать динамическим списком целых
чисел (тип LONGINT). Ограничение на количество

Как можно применить
Применение аналогично использованию TStringList :-)

Ограничения
Проверенно на Delphi 6.0 + SP2.

Зависимости: Classes
Автор:       softland, softland@zmail.ru, Волгоград
Copyright:   softland
Дата:        9 августа 2002 г.
***************************************************** }

(*
@abstract(provides methods to operate on AutoCAD scripts)
@author(Vitaly Sergienko (softland@zmail.ru))
@created(10 Feb 1996)
@lastmod(4 Aug 2002)

Базовая версия исходного кода взята из книги, название уже не помню :-(

ver 1.0.4

Класс для манипулирования списком целых чисел
  Класс TxIntegerList позволяет оперировать динамическим списком целых
  чисел (тип LONGINT). Ограничение на количество

Как можно применить
  Применение аналогично использованию TStringList :-)

Ограничения
  Проверенно на Delphi 6.0 + SP2.

Форматирование комментариев подготовлено для обработки исходников программой rjPasDoc
*)

unit IntList;

interface

uses Classes;

const
  (* Константа возвращаемая при успешном завершении функции *)
  _OK_ = 1;

  (* Константа возвращаемая при неудачном завершении функции *)
  _ERROR_ = 0;

type

  (* Класс генерации exception при переполнении списка *)
  EOutOfRange = class(EListError);

  (* Класс обеспечивает создание, удаление, вставку и доступ к элементам динами-
     ческого списка вещественных чисел.
     Дополнительно поддерживается сортировка списка, поиск минимального и макси-
     мального значений в списке.
  *)
  TxIntegerList = class(TPersistent)
  private
    //список содержащий числа
    FList: TList;
    //переключатель возможности содержания повторяющихся значений
    FDuplicates: TDuplicates;
    //min значение в списке
    FMin: LONGINT;
    //max значение в списке
    FMax: LONGINT;
    //Размер типа LONGINT в байтах
    FSizeOfLong: integer;
    //Отображение отсортированности списка
    FSorted: Boolean;
    //Чтение min из потока
    procedure ReadMin(Reader: TReader);
    //Запись min в поток
    procedure WriteMin(Writer: TWriter);
    //Чтение max из потока
    procedure ReadMax(Reader: TReader);
    //Запись max в поток
    procedure WriteMax(Writer: TWriter);
    //Чтение значений из потока
    procedure ReadIntegers(Reader: TReader);
    //Запись значений в поток
    procedure WriteIntegers(Writer: TWriter);
    //Отсортировать список и установть признак
    procedure SetSorted(Value: Boolean);
    procedure QuickSort(L, R: integer);
  protected
    procedure DefineProperties(Filer: TFiler); override;
    //Поиск значения, возвращается true если значение найдено
    function Find(N: LONGINT; var Index: integer): Boolean; virtual;
    //Возвращает количество элементов в списке
    function GetCount(): integer;
    //Возвращает элемент по номеру
    function GetItem(Index: integer): LONGINT;
    //Устанавливает элемент по номеру
    procedure SetItem(Index: integer; Value: LONGINT); virtual;
    //Устанавливает min
    procedure SetMin(Value: LONGINT);
    //Устанавливает max
    procedure SetMax(Value: LONGINT);
    //Сортирует список
    procedure Sort(); virtual;
  public
    constructor Create();
    destructor Destroy(); override;
    //Добавляет значение в список
    function Add(Value: LONGINT): integer; virtual;
    //Добавляет значения в список из другого списка
    procedure AddIntegers(List: TxIntegerList); virtual;
    //Добавляет значения в список из другого списка, удаляя старые значения
    procedure Assign(Source: TPersistent); override;
    //Очищает список
    procedure Clear(); virtual;
    //Удаляет из списка элемент
    procedure Delete(Index: integer); virtual;
    //Сравнивает два списка
    function Equals(List: TxIntegerList): Boolean;
    //Меняет местами два элемента в списке
    procedure Exchange(Index1, Index2: integer); virtual;
    //Возвращает номер элемента
    function IndexOf(N: LONGINT): integer; virtual;
    //Вставляет элемент в список
    procedure Insert(Index: integer; Value: LONGINT); virtual;
    //Переносит элемент
    procedure Move(CurIndex, NewIndex: integer); virtual;
    //Свойство отображающее возможность хранения повторяющихся значений
    property Duplicates: TDuplicates read FDuplicates write FDuplicates;
    //Количество элементов в списке
    property Count: integer read GetCount;
    //Доступ к элементам по номеру
    property Items[Index: integer]: LONGINT read GetItem write Setitem; default;
    property Min: LONGINT read FMin write SetMin;
    property Max: LONGINT read FMax write SetMax;
    property Sorted: Boolean read FSorted write SetSorted;
  end;

implementation
uses WinTypes;

constructor TxIntegerList.Create();
begin
  inherited Create();
  FList := TList.Create();
  FSizeOfLong := SizeOf(LONGINT);
end;

destructor TxIntegerList.Destroy();
begin
  Clear();
  FList.Free();
  inherited Destroy();
end;

procedure TxIntegerList.Assign(Source: TPersistent);
begin
  if Source is TxIntegerList then
  begin
    Clear;
    AddIntegers(TxIntegerList(Source));
  end
  else
    inherited Assign(Source);
end;

procedure TxIntegerList.DefineProperties(Filer: TFiler);
begin
  Filer.DefineProperty('Min', ReadMin, WriteMin, min <> 0);
  Filer.DefineProperty('Max', ReadMax, WriteMax, FMax <> 0);
  Filer.DefineProperty('Integers', ReadIntegers, WriteIntegers, Count > 0);
end;

procedure TxIntegerList.ReadMin(Reader: TReader);
begin
  FMin := Reader.ReadInteger();
end;

procedure TxIntegerList.WriteMin(Writer: TWriter);
begin
  Writer.WriteInteger(FMin);
end;

procedure TxIntegerList.ReadMax(Reader: TReader);
begin
  FMax := Reader.ReadInteger();
end;

procedure TxIntegerList.WriteMax(Writer: TWriter);
begin
  Writer.WriteInteger(FMax);
end;

procedure TxIntegerList.ReadIntegers(Reader: TReader);
begin
  Reader.ReadListBegin(); (* Считывание маркера начала списка *)
  Clear; (* Очистка иекущего списка *)
  while not Reader.EndOfList do
    Add(Reader.ReadInteger()); (* Добавление к списку хранящихся целых *)
  Reader.ReadListEnd(); (* Считывание маркера конца списка *)
end;

procedure TxIntegerList.WriteIntegers(Writer: TWriter);
var
  i: integer;
begin
  Writer.WriteListBegin(); (* Вписываем маркер начала списка *)
  for i := 0 to Count - 1 do
    Writer.WriteInteger(GetItem(I)); (* Запись всех чисел из списка в Writer *)
  Writer.WriteListEnd(); (* Вписываем маркер конца списка *)
end;

procedure TxIntegerList.SetSorted(Value: Boolean);
begin
  if FSorted <> Value then
  begin
    if Value then
      Sort();
    FSorted := Value;
  end;
end;

function TxIntegerList.GetCount(): integer;
begin
  Result := FList.Count;
end;

function TxIntegerList.GetItem(Index: integer): LONGINT;
begin
  Result := PLONGINT(FList.Items[Index])^;
end;

procedure TxIntegerList.SetItem(Index: integer; Value: LONGINT);
begin
  { if ( FMin <> FMax ) and ( ( Value < Fmin ) or ( Value > FMax ) ) then
      raise EOutOfRange.CreateFmt( 'Value must be within %d..%d', [FMin, FMax]);}
  PLONGINT(FList.Items[Index])^ := Value;
end;

procedure TxIntegerList.SetMin(Value: LONGINT);
var
  i: integer;
begin
  if Value <> FMin then
  begin
    for i := 0 to Count - 1 do
      if GetItem(i) < Value then
        raise EOutOfRange.CreateFmt('Unable to set new minimum value. ' + #13 +
          'List contains values below %d', [Value]);
    FMin := Value;
    if FMin > FMax then
      FMax := FMin;
  end;
end;

procedure TxIntegerList.SetMax(Value: LONGINT);
var
  i: integer;
begin
  i := 0;
  if Value <> FMax then
  begin
    for i := 0 to Count - I do
      if GetItem(i) > Value then
        raise EOutOfRange.CreateFmt('Unable to set new maximum value. '#13 +
          'List contains values above %d', [Value]);
    FMax := Value;
    if FMax < FMin then
      FMin := FMax;
  end;
end;

procedure TxIntegerList.AddIntegers(List: TxIntegerList);
var
  i: integer;
begin
  for i := 0 to Pred(List.Count) do
    Add(List[I]);
end;

function TxIntegerList.Add(Value: LONGINT): integer;
begin
  Insert(Count, Value);
  result := _OK_;
end;

procedure TxIntegerList.Clear();
var
  i: integer;
begin
  for i := 0 to Pred(FList.Count) do
    Dispose(PLONGINT(FList.Items[i]));
  FList.Clear();
end;

procedure TxIntegerList.Delete(Index: integer);
begin
  Dispose(PLONGINT(FList.Items[Index]));
  FList.Delete(Index);
end;

function TxIntegerList.Equals(List: TxIntegerList): Boolean;
var
  i, Count: integer;
begin
  Count := GetCount;
  if Count <> List.GetCount then
    Result := False
  else
  begin
    i := 0;
    while (i < Count) and (GetItem(i) = List.GetItem(i)) do
      INC(i);
    Result := i = Count;
  end;
end;

procedure TxIntegerList.Exchange(Index1, Index2: integer);
begin
  FList.Exchange(Index1, Index2);
end;

function TxIntegerList.Find(N: LONGINT; var Index: integer): Boolean;
var
  l, h, i: integer;
begin
  Result := False;
  l := 0;
  h := Count - 1;
  while l <= h do
  begin
    i := (l + h) shr 1;
    if PLONGINT(FList[i])^ < N then
      l := i + 1
    else
    begin
      h := i - 1;
      if PLONGINT(FList[i])^ = N then
      begin
        Result := True;
        if Duplicates <> dupAccept then
          l := i;
      end;
    end;
  end;
  Index := l;
end;

function TxIntegerList.IndexOf(N: LONGINT): integer;
var
  i: integer;
begin
  Result := -1;
  if not Sorted then
  begin
    for i := 0 to Pred(GetCount) do
      if GetItem(i) = N then
      begin
        Result := i;
        exit;
      end;
  end
  else if Find(N, i) then
    Result := i;
end;

procedure TxIntegerList.Insert(Index: integer; Value: LONGINT);
var
  P: PLONGINT;
begin
  if (FMin <> FMax) and ((Value < FMin) or (Value > FMax)) then
    raise EOutOfRange.CreateFmt('Value must be within %d..%d', [FMin, FMax]);
  NEW(p);
  p^ := Value;
  FList.Insert(Index, P);
end;

procedure TxIntegerList.Move(CurIndex, NewIndex: integer);
begin
  FList.Move(CurIndex, NewIndex);
end;

procedure TxIntegerList.QuickSort(L, R: integer);
var
  i, j: integer;
  p: PLONGINT;
begin
  i := L;
  j := R;
  P := PLONGINT(FList[(L + R) shr i]);
  repeat
    while PLONGINT(FList[i])^ < P^ do
      INC(i);
    while PLONGINT(FList[j])^ > P^ do
      DEC(j);
    if i <= j then
    begin
      FList.Exchange(i, j);
      INC(i);
      DEC(j);
    end;
  until i > l;
  if L < j then
    QuickSort(L, j);
  if i < R then
    Quicksort(i, R);
end;

procedure TxIntegerList.Sort();
begin
  if not Sorted and (FList.Count > 1) then
    QuickSort(0, FList.Count - 1);
end;

end.

Статья Класс для манипулирования списком целых чисел раздела Компоненты и Классы Классы может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

:: Главная :: Классы ::