Класс для манипулирования списком целых чиселDelphi , Компоненты и Классы , КлассыКласс для манипулирования списком целых чисел
Автор: Vitaly Sergienko { **** 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. Комментарии и вопросыМатериалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |