unit SimListC;
//*******************************************************
// Class implementing a resizable array-based list.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
    Dialogs, SysUtils, Classes;

type
    String10     = String[10];
    TStringArray = array [1..1000000] of String10;
    PStringArray = ^TStringArray;

    TSimpleList = class(TObject)
        private
            List         : PStringArray; // The array we will resize.
            NumItems     : Longint;      // The number of items used.
            NumAllocated : Longint;      // The number of items allocated.
            ShrinkWhen   : Longint;      // Shrink if NumItems < ShrinkWhen.
            procedure ResizeList;

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

implementation

// Free any allocated memory.
destructor TSimpleList.Destroy;
begin
    if (NumAllocated > 0) then FreeMem(List);
    inherited Destroy;
end;

// Add an item to the list.
procedure TSimpleList.Add(value : String10);
begin
    // Make sure there's room for the new item.
    if (NumItems >= NumAllocated) then ResizeList;
    NumItems := NumItems + 1;
    List^[NumItems] := value;
end;

// Return the number of items in the list.
function TSimpleList.Count : Longint;
begin
    Count := NumItems;
end;

// Return the value of an item in the list.
function TSimpleList.Item(index : Longint) : String10;
begin
    if ((index < 1) or (index > NumItems)) then
        raise ERangeError.CreateFmt(
            'Index %d out of bounds %d..%d',
            [index, 1, NumItems]);

    Item := List^[index];
end;

// Remove the last item from the list.
procedure TSimpleList.RemoveLast;
begin
    if (NumItems < 1) then
        raise EInvalidOperation.Create(
            'No items to remove.');

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

// Resize the list to have WANT_FREE_PERCENT unused
// entries. Set m_ShrinkWhen so we know to resize the
// array when the number of used entries is too small.
// Set this value to resize the array when there is more
// than twice the desired amount of memory free.
//
// Normally WANT_FREE_PERCENT and MIN_FREE would have
// values like .1 and 10. They are set to .5 and 1 to make
// it easy to see how the algorithm works. MIN_FREE must
// be at least 1.
procedure TSimpleList.ResizeList;
const
    WANT_FREE_PERCENT = 0.5; // Try for 50% free space.
    MIN_FREE = 1;            // Min unused space when resizing.
    CR = #13#10;
    CRCR = #13#10#13#10;
var
    want_free, new_size, i : Longint;
    new_array              : PStringArray;
begin
    // See how big the array should be.
    want_free := Round(WANT_FREE_PERCENT * NumItems);
    if (want_free < MIN_FREE) then want_free := MIN_FREE;
    new_size := NumItems + want_free;

    // Resize the array preserving the old values.
    // Create a new array.
    GetMem(new_array, new_size * SizeOf(String10));

    // Copy the existing items into the new array.
    for i := 1 to NumItems do
        new_array^[i] := List^[i];

    // Free the previously allocated memory.
    if (NumAllocated > 0) then FreeMem(List);
    NumAllocated := new_size;

    // Make List point to the new memory.
    List := new_array;

    // Calculate ShrinkWhen. We resize the array if it
    // shrinks until NumItems < ShrinkWhen.
    ShrinkWhen := NumItems - want_free;

    // Comment the following when not testing.
    ShowMessage('Resizing.' + CRCR +
        'Allocated: ' + IntToStr(NumAllocated) + CR +
        'Used: ' + IntToStr(NumItems) + CR +
        'Unused: ' + IntToStr(want_free) + CR +
        'ShrinkWhen: ' + IntToStr(ShrinkWhen));
end;

end.
