typedlist_template.pas

Delphi, typed list generator code snippled, wonderfull delphi sample code

{+------------------------------------------------------------
 | Unit <!UNITNAME>
 |
 | Version: 1.0  Created: <!DATE>
 |               Last Modified: <!DATE>
 | Author : GenTypedLists Version <!VERSION>
 | Project: General utilities
 | Description:
 |   
 +------------------------------------------------------------}
Unit <!UNITNAME>;
Interface

Uses Classes, AbstractTypedList <!USESCLAUSE>;

<!DEFINES>
Type
  <!DATATYPE>SortCompare = Function( Const item1, item2: <!DATATYPE> ): Integer;

  <!LISTCLASSNAME> = Class( TAbstractTypedList )
  Private
    Procedure Put( index: Integer; Const Item: <!DATATYPE> );
    Function  Get( index: Integer ): <!DATATYPE>;
    Procedure FreeItem( index: Integer );
    Procedure QuickSort(L, R: Integer; Compare: <!DATATYPE>SortCompare );

  Public
    Function Clone: <!LISTCLASSNAME>;

    Procedure Assign( source: TPersistent ); override;
    Function  Add(Const Item: <!DATATYPE>): Integer;
    Procedure Insert(Index: Integer; Const Item: <!DATATYPE>);

    Procedure Clear; override;
    Procedure Delete(Index: Integer); override;
    Function  Detach(Index: Integer): <!DATATYPE>; 

    Function LinearSearch( Const Item: <!DATATYPE>; 
                           Compare: <!DATATYPE>SortCompare): Integer;
    Function BinarySearch( Const Item: <!DATATYPE>; 
                           Compare: <!DATATYPE>SortCompare): Integer;
    Procedure Sort(Compare: <!DATATYPE>SortCompare);

    Property Items[Index: Integer]: <!DATATYPE> read Get write Put; default;
  End;

{$IFDEF GTL_USECOMPAREPROC} 
Function <!DATATYPE>Compare( Const item1, item2: <!DATATYPE> ): Integer;
{$ENDIF} 

Implementation

{$IFDEF GTL_USEPOINTERS} 
Type
    <!DATATYPE>_Ptr = ^<!DATATYPE>;
{$ENDIF} 

{$IFDEF GTL_USECOMPAREPROC} 
{+------------------------------------------------------------
 | Function <!DATATYPE>Compare
 |
 | Parameters :
 |   item1, item2: the two <!DATATYPE> items to compare
 | Returns    : 
 |   0 if both items are equal, < 0 if item1 is smaller than item2,
 |   > 0 if item1 is larger than item2
 | Error Conditions: none
 | Created: <!DATE> by GenTypedLists Version <!VERSION>
 +------------------------------------------------------------}
Function <!DATATYPE>Compare( Const item1, item2: <!DATATYPE> ): Integer;
  Begin 
    {  MODIFY THIS IMPLEMENTATION AS APPROPRIATE!  }
    If item1 < item2 Then 
      Result := -1
    Else If item1 > item2 Then 
      Result := 1
    Else
      Result := 0;
  End; { <!DATATYPE>Compare }
{$ENDIF} 

{+-----------------------------
 | Methods of <!LISTCLASSNAME> 
 +----------------------------}

{+------------------------------------------------------------
 | Function <!LISTCLASSNAME>.Clone: <!LISTCLASSNAME>;
 |
 | Returns : a deep copy of this list instance.
 | Call method: static
 | Visibility : public
 | Description:
 |   Returns a new instance of the list class and copies the 
 |   data from this list into it. 
 | Error Conditions: none
 | Created: <!DATE> by GenTypedLists Version <!VERSION>
 +------------------------------------------------------------}
Function <!LISTCLASSNAME>.Clone: <!LISTCLASSNAME>;
  Begin
    Result := <!LISTCLASSNAME>.Create;
    Result.Assign( self );
  End; { <!LISTCLASSNAME>.Clone }

{+------------------------------------------------------------
 | Procedure <!LISTCLASSNAME>.Assign
 |
 | Parameters :
 |   source: list instance to copy
 | Call method: virtual, overriden
 | Visibility : public
 | Description:
 |   Copies the data from the source into this instance, which
 |   is cleared first. This is a deep copy, unless the
 |   list contains a pointer type other than an object. If the
 |   list contains objects and owns
 |   the objects (GTL_OWNSOBJECTS defined) then the object 
 |   class MUST have a public Clone method, or a compiler error
 |   will result! If the list does not own the objects the copy
 |   is shallow, the new list stores references to the same objects
 |   as aList.
 | Error Conditions: 
 |   If source is not of this list class the inherited Assign is
 |   called and that will raise an exception!
 | Created: <!DATE> by GenTypedLists Version <!VERSION>
 +------------------------------------------------------------}
Procedure <!LISTCLASSNAME>.Assign( source: TPersistent ); 
  Var
    i: Integer;
    aList : <!LISTCLASSNAME>;
  Begin
    If Assigned( source ) Then Begin 
      If source Is <!LISTCLASSNAME> Then Begin 
        aList := <!LISTCLASSNAME>( source );
        Clear;
        Capacity := aList.Count;
        For i := 0 To aList.LastIndex Do Begin 
          {$IFDEF GTL_OWNSOBJECTS}
          Insert( count, aList.Items[ i ].Clone );
          {$ELSE}
          Insert( count, aList.Items[ i ] );
          {$ENDIF}
        End; { For }
      End { If }
      Else
        inherited Assign( source );
    End; { If }
  End; { <!LISTCLASSNAME>.Assign }

{+------------------------------------------------------------
 | Function <!LISTCLASSNAME>.Add
 |
 | Parameters :
 |   Item to add. If this is a pointer type the list will store
 |   the pointer as is!
 | Returns    : the index of the item
 | Call method: static
 | Visibility : public
 | Description:
 |   Adds the passed item to the end of the list and returns the
 |   index of the item.
 | Error Conditions: 
 |   We may run out of memory here, which will cause an exception.
 | Created: <!DATE> by GenTypedLists Version <!VERSION>
 +------------------------------------------------------------}
Function <!LISTCLASSNAME>.Add(Const Item: <!DATATYPE>): Integer;
  Begin
    Result := Count;
    Insert( Result, Item );
  End; { <!LISTCLASSNAME>.Add }

{+------------------------------------------------------------
 | Procedure <!LISTCLASSNAME>.Insert
 |
 | Parameters :
 |   Index: index of the item before which to insert the new item. 
 |          If Index >= Count the item will be appended to the list.
 |   Item : item to insert
 | Call method: static
 | Visibility : public
 | Description:
 |   Inserts the passed item into the list. If the data type is 
 |   larger than 4 bytes memory for the Item is allocated on the 
 |   heap, the item is copied into it and the pointer is stored
 |   in the list, otherwise the data is stored directly, typecast
 |   to a pointer.
 | Error Conditions: 
 |   We may run out of memory here, which will cause an exception.
 | Created: <!DATE> by GenTypedLists Version <!VERSION>
 +------------------------------------------------------------}
Procedure <!LISTCLASSNAME>.Insert(Index: Integer; Const Item: <!DATATYPE>);
  Begin
    If Index > Count Then 
      Index := Count;
    Storage.Insert( index, Nil );
    Put( index, Item );
  End; { <!LISTCLASSNAME>.Insert }

{+------------------------------------------------------------
 | Procedure <!LISTCLASSNAME>.Clear
 |
 | Parameters : none
 | Call method: virtual, overriden
 | Visibility : public
 | Description:
 |   Clears the list, freeing memory for the items if necessary.
 | Error Conditions: none
 | Created: <!DATE> by GenTypedLists Version <!VERSION>
 +------------------------------------------------------------}
Procedure <!LISTCLASSNAME>.Clear; 
  {$IFDEF GTL_OWNSOBJECTS} {$DEFINE GTL_MUSTFREE} {$ENDIF}
  {$IFDEF GTL_USEPOINTERS} {$DEFINE GTL_MUSTFREE} {$ENDIF}
  {$IFDEF GTL_MUSTFREE} 
  Var
    i: Integer;
 {$ENDIF} 
  Begin
    {$IFDEF GTL_MUSTFREE} 
      For i := LastIndex Downto 0 Do  
        FreeItem( i );
      {$UNDEF GTL_MUSTFREE }
    {$ENDIF} 
    inherited Clear;
  End; { <!LISTCLASSNAME>.Clear }

{+------------------------------------------------------------
 | Procedure <!LISTCLASSNAME>.FreeItem
 |
 | Parameters : index of item to free
 | Call method: static
 | Visibility : private
 | Description:
 |   Frees the memory for the item at index, if required.
 | Error Conditions: 
 |   A invalid index will raise a EListError exception!
 | Created: <!DATE> by GenTypedLists Version <!VERSION>
 +------------------------------------------------------------}
Procedure <!LISTCLASSNAME>.FreeItem( index: Integer );
  {$IFDEF GTL_USEPOINTERS} 
  Var
    pitem: <!DATATYPE>_Ptr;
  {$ENDIF}
  Begin
    {$IFDEF GTL_OWNSOBJECTS}
      Items[ Index ].Free;