unit SimListC;
//*******************************************************
// Klasa implementująca listę opartą o tablicę dynamiczną
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//
// Revised (C) 1999 Andrzej Grażyński, HELION Publishing
//*******************************************************

interface

uses
    Dialogs, SysUtils, Classes;

type
    String10     = String[10];

    TSimpleList = class(TObject)
        private
            List        : array of String10;
            NumItems     : Longint;      // Liczba zajętych elementów
            NumAllocated : Longint;      // Liczba przydzielonych elementów
            ShrinkWhen   : Longint;      // Granica usuwania bez kompresji
            procedure ResizeList;

        public
            destructor Destroy; override;
            procedure Add(value : String10);
            function Count : Longint;
            function Item(index : Longint) : String10;
            procedure RemoveLast;
            constructor Create;
    end;

implementation

constructor TSimpleList.Create;
begin
  Inherited Create;
  List := NIL;
  NumItems     := 0;
  NumAllocated := 0;
end;



destructor TSimpleList.Destroy;
begin
  List := NIL;
  inherited Destroy;
end;





// Dodaj element do tablicy.
procedure TSimpleList.Add(value : String10);
begin
    // Zapewnij miejsce dla nowego elementu.
    if (NumItems >= NumAllocated)
    then
      ResizeList;
    NumItems := NumItems + 1;
    List[NumItems-1] := value;
end;

// Podaj liczbę elementów w liście.
function TSimpleList.Count : Longint;
begin
  Count := NumItems;
end;


// podaj wartość określonego elementu
function TSimpleList.Item(index : Longint) : String10;
begin
    if ((index < 1) or (index > NumItems)) then
        raise ERangeError.CreateFmt(
            'Index %d poza zakresem %d..%d',
            [index, 1, NumItems]);

    Item := List[index-1];
end;




// usuń ostatni element z listy
procedure TSimpleList.RemoveLast;
begin
    if (NumItems < 1) then
        raise EInvalidOperation.Create(
            'Lista jest pusta.');

    NumItems := NumItems - 1;
    if (NumItems < ShrinkWhen) then ResizeList;
end;


// Zmień rozmiar tablicy jeżeli  udział wolnych
// elementów przekracza WANT_FREE_PERCENT.

// Normalnie wartości WANT_FREE_PERCENT i MIN_FREE powinny wynosić
// (odpowiednio)  0.1 i 10. Wartości 0.5 i 1 pozwolą lepiej prześledzić
// pracę algorytmu. MIN_FREE musi wynosić co najmniej 1

procedure TSimpleList.ResizeList;
const
    WANT_FREE_PERCENT = 0.5; // udział wolnych elementów.
    MIN_FREE = 1;            // min. liczba wolnych elementów.
    CR = #13#10;
    CRCR = #13#10#13#10;
var
    want_free, new_size: Longint;

begin
    // Określenie nowego rozmiaru tablicy.
    want_free := Round(WANT_FREE_PERCENT * NumItems);
    if (want_free < MIN_FREE)
    then
      want_free := MIN_FREE;
    new_size := NumItems + want_free;

    // zmiana rozmiaru tablicy z zachowaniem zawartości
    SetLength(List, new_size);

    NumAllocated := new_size;


    // Oblicz graniczną liczbę wykorzystanych elementów, poniżej której
    // należy wykonać kompresję
    ShrinkWhen := NumItems - want_free;


    ShowMessage('Zmiana rozmiaru:' + CRCR +
        'Przydzielonych: ' + IntToStr(NumAllocated) + CR +
        'Używanych: ' + IntToStr(NumItems) + CR +
        'Wolnych: ' + IntToStr(want_free) + CR +
        'Granica kompresji: ' + IntToStr(ShrinkWhen));
end;







end.
