home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1997 May / Pcwk0597.iso / delphi / dnarrays.lzh / ARRAYS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-07-15  |  95.3 KB  |  2,847 lines
  1. {+------------------------------------------------------------
  2.  | Unit Arrays
  3.  |
  4.  | Version: 1.0  Last modified: 04/18/95, 11:47:00
  5.  | Author : P. Below
  6.  | Project: Delphi common objects
  7.  | Description:
  8.  |   This Unit implements a base class for resizeable array types
  9.  |   and a few specific derivatives for the common numeric types.
  10.  |
  11.  |   The array classes in this unit are all limited to a maximum
  12.  |   of 64Kbytes of data. The size of the stored items determines
  13.  |   the maximal number of items. Errors will raise exceptions,
  14.  |   index overflow is only reported if range checking is on. The
  15.  |   index range of each class is 0..MaxIndex, MaxIndex is a property
  16.  |   of all class types.
  17.  |
  18.  |   The classes have iterator methods similar to BP collections.
  19.  |   These iterators can optionally call Application.ProcessMessages
  20.  |   between rounds. This requires usage of the Forms Unit. Since
  21.  |   this would involve a tremendous overhead for non-VCL projects
  22.  |   the correspondig USes clause and the iterator code calling
  23.  |   Application.ProcessMessages is enclosed in $IFDEF DOEVENTS
  24.  |   blocks. If DOEVENTS is defined, the Forms unit will be used.
  25.  |   DOEVENTS IS UNDEFINED BY DEFAULT! You need to define this
  26.  |   symbol in your project to make use of the ability to process
  27.  |   messages inside iterator loops and recompile this unit!
  28.  |   The unit does not make any other use of VCL window objects.
  29.  +------------------------------------------------------------}
  30. Unit Arrays;
  31.  
  32. Interface
  33.  
  34. Uses SysUtils, Classes;
  35.  
  36. Const
  37.   (* the following value is returned by the Find method if the passed
  38.      value could not be found in the array *)
  39.   NOT_FOUND = High( Cardinal );
  40. Type
  41.  
  42.   (* Our virtual array need a function of this type to sort themselves
  43.      and search items. As usual the return type should be < 0 if
  44.      item1 < item2,  > 0 if item1 > item2 and 0 if both are equal. 
  45.      Note that the result is not limited to -1, 0, +1! This allows
  46.      faster comparison. *)
  47.   TCompareProc = Function ( Var item1, item2  ): Integer;
  48.  
  49.   (* these procedural types represent functions that can be called
  50.      from one of the iterator method, like ForEach. Version for stand-
  51.      alone procedure and for object methods are provided. *)
  52.   TIterator          = Procedure( Var Element; index: Cardinal );
  53.   TLocator           = Function( Var Element; index: Cardinal ): Boolean;
  54.   TIteratorMethod    = Procedure( Var Element; index: Cardinal ) of Object;
  55.   TLocatorMethod     = Function( Var Element;
  56.                                  index: Cardinal ): Boolean of Object;
  57.  
  58.   (* This error is raised when Sort or Find are called and a compare proc
  59.      has not been assigned *)
  60.   ECompUndefined = Class( Exception );
  61.   (* This error is raised when two class instances are not comaptible
  62.      for an operation *)
  63.   ETypeMismatch  = Class( Exception );
  64.   (* This error is raised if a textfile is too large to be loaded into
  65.      a TPCharArray or TPStringArray *)
  66.   EFileTooLarge  = Class( Exception );
  67.  
  68.   TSortOrder = ( TS_NONE, TS_ASCENDING, TS_DESCENDING );
  69.  
  70.   (* these flags covern some of the behaviour of array methods *)
  71.   TArrayFlags = ( AF_OwnsData, AF_AutoSize, AF_CanCompare,
  72.                   AF_User1, AF_User2, AF_User3, AF_User4, AF_User5,
  73.                   AF_User6, AF_User7, AF_User8, AF_User9, AF_User10,
  74.                   AF_User11, AF_User12 );
  75.   TArrayFlagSet = Set of TArrayFlags;
  76.  
  77.   (* this notification is used by the store/load from textfile methods
  78.      of the string/pchar array classes *)
  79.   TProgressReporter = Function( pos, max: LongInt; 
  80.                                 Var retain: Boolean ): Boolean of Object;
  81.  
  82.   (* T64KArray is our base array class. It is limited to a single 64K 
  83.      segment for all items. *)
  84.   T64KArray = Class( TPersistent )
  85.     private
  86.       FMemory: Pointer;              (* pointer to item buffer *)
  87.       FMemSize,                      (* allocated size of buffer in bytes *)
  88.       FItemSize,                     (* size of individual item in bytes *)
  89.       FMaxIndex: Cardinal;           (* max valid index, zero-based *)
  90.       FSortOrder   : TSortOrder;     (* true if array is considered sorted *)
  91.       FCompareProc : TCompareProc;   (* pointer to compare proc *)
  92.       FFlags   : TArrayFlagSet;      (* ability flags *)
  93.  
  94.       Procedure DefineProperties(Filer: TFiler);
  95.         override;
  96.       Procedure AssignTo( Dest: TPersistent );
  97.         override;
  98.       Function GetMaxCapacity: Cardinal;
  99.       Function GetCapacity: Cardinal;
  100.  
  101.     public
  102.       Procedure SaveToFile( Const Filename: String );
  103.         virtual;
  104.       Procedure LoadFromFile( Const Filename: String );
  105.         virtual;
  106.       Procedure SaveToStream( Stream: TStream );
  107.         virtual;
  108.       Procedure LoadFromStream( Stream: TStream );
  109.         virtual;
  110.       Function GetItemPtr( index: Cardinal ): Pointer;
  111.       Procedure PutItem( index: Cardinal; Var data );
  112.       Procedure GetItem( index: Cardinal; Var data );
  113.       Procedure InvalidateItems( atIndex, numItems: Cardinal );
  114.         virtual;
  115.       Function ValidIndex( index: Cardinal ): Boolean;
  116.       Function ValidateBounds( atIndex: Cardinal;
  117.                                Var numItems: Cardinal): Boolean;
  118.       Constructor Create( itemcount, itemsize: Cardinal ); virtual;
  119.       Destructor  Destroy; override;
  120.       Procedure Zap; virtual;
  121.       Function  Clone: T64KArray; 
  122.         virtual;
  123.       Procedure ReDim( newcount: Cardinal );
  124.         virtual;
  125.       Procedure Insert( Var Source; atIndex, numItems: Cardinal );
  126.         virtual;
  127.       Procedure Delete( atIndex, numItems: Cardinal );
  128.         virtual;
  129.       Procedure Append( Var Source; numItems: Cardinal );
  130.         virtual;
  131.       Procedure CopyFrom( Var Source; toIndex, numItems: Cardinal );
  132.         virtual;
  133.       Procedure CopyTo( Var Dest; fromIndex, numItems: Cardinal );
  134.         virtual;
  135.       Procedure BlockCopy( Source: T64KArray; 
  136.                            fromIndex, toIndex, numitems: Cardinal );
  137.         virtual;
  138.       Procedure Sort( ascending: Boolean );
  139.         virtual;
  140.       Function  Find( Var value ): Cardinal;
  141.         virtual;
  142.       Procedure ForEach( iterator: TIteratorMethod; processMsg: Boolean;
  143.                          intervall: Cardinal );
  144.       Function  FirstThat( locator: TLocatorMethod; 
  145.                            processMsg: Boolean;
  146.                            intervall: Cardinal ): Pointer;
  147.       Function  LastThat(locator: TLocatorMethod;
  148.                          processMsg: Boolean;
  149.                          intervall: Cardinal ): Pointer;
  150.       Procedure ForEachProc( iterator: TIterator; processMsg: Boolean;
  151.                              intervall: Cardinal );
  152.       Function  FirstThatProc( locator: TLocator;
  153.                                processMsg: Boolean;
  154.                                intervall: Cardinal ): Pointer;
  155.       Function  LastThatProc(locator: TLocator;
  156.                              processMsg: Boolean;
  157.                              intervall: Cardinal ): Pointer;
  158.       Function GetCount: Cardinal; virtual;
  159.       Procedure SetCompareProc( proc: TCompareProc );
  160.  
  161.       Function HasFlag( aFlag: TArrayFlags ): Boolean;
  162.       Procedure SetFlag( aFlag: TArrayFlags ); 
  163.       Procedure ClearFlag( aFlag: TArrayFlags ); 
  164.  
  165.       property Memory: Pointer read FMemory;
  166.       property MemSize: Cardinal read FMemSize;
  167.       property ItemSize: Cardinal read FItemSize;
  168.       property MaxIndex: Cardinal read FMaxIndex;
  169.       property Count: Cardinal read GetCount;
  170.       property ItemPtr[ Index:Cardinal ]: Pointer read GetItemPtr;
  171.       property SortOrder: TSortOrder read FSortOrder write FSortOrder;
  172.       property CompareProc: TCompareProc read FCompareProc write SetCompareProc;
  173.       property Capacity: Cardinal read GetCapacity;
  174.       property MaxCapacity: Cardinal read GetMaxCapacity;
  175.       property Flags: TArrayFlagSet read FFlags write FFlags;
  176.   End;
  177.   C64KArray= Class of T64KArray;
  178.  
  179.   (* Following are a couple of derived classes for the common numeric types.
  180.      Access to items can be done via normal array syntax on the instance
  181.      via the default array property. *)
  182.   TIntegerArray = Class( T64KArray )
  183.     public
  184.       Constructor Create( itemcount, dummy: Cardinal ); override;
  185.       Procedure PutData( index: Cardinal; value: Integer );
  186.       Function GetData(index: Cardinal): Integer;
  187.  
  188.       property Data[ Index:Cardinal ]: Integer
  189.          read GetData write PutData; default;
  190.   End;
  191.  
  192.   TCardinalArray = Class( T64KArray )
  193.     public
  194.       Constructor Create( itemcount, dummy: Cardinal ); override;
  195.       Procedure PutData( index: Cardinal; value: Cardinal );
  196.       Function GetData(index: Cardinal): Cardinal;
  197.  
  198.       property Data[ Index:Cardinal ]: Cardinal
  199.          read GetData write PutData; default;
  200.   End;
  201.  
  202.   TLongIntArray = Class( T64KArray )
  203.     public
  204.       Constructor Create( itemcount, dummy: Cardinal ); override;
  205.       Procedure PutData( index: Cardinal; value: LongInt );
  206.       Function GetData(index: Cardinal): LongInt;
  207.  
  208.       property Data[ Index:Cardinal ]: LongInt
  209.          read GetData write PutData; default;
  210.   End;
  211.  
  212.   TRealArray = Class( T64KArray )
  213.     public
  214.       Constructor Create( itemcount, dummy: Cardinal ); override;
  215.       Procedure PutData( index: Cardinal; value: Real );
  216.       Function GetData(index: Cardinal): Real;
  217.  
  218.       property Data[ Index:Cardinal ]: Real
  219.          read GetData write PutData; default;
  220.   End;
  221.  
  222.   TSingleArray = Class( T64KArray )
  223.     public
  224.       Constructor Create( itemcount, dummy: Cardinal ); override;
  225.       Procedure PutData( index: Cardinal; value: Single );
  226.       Function GetData(index: Cardinal): Single;
  227.  
  228.       property Data[ Index: Cardinal ]: Single
  229.          read GetData write PutData; default;
  230.   End;
  231.  
  232.   TDoubleArray = Class( T64KArray )
  233.     public
  234.       Constructor Create( itemcount, dummy: Cardinal ); override;
  235.       Procedure PutData( index: Cardinal; value: Double );
  236.       Function GetData(index: Cardinal): Double;
  237.  
  238.       property Data[ Index: Cardinal ]: Double
  239.          read GetData write PutData; default;
  240.   End;
  241.  
  242.   TExtendedArray = Class( T64KArray )
  243.     public
  244.       Constructor Create( itemcount, dummy: Cardinal ); override;
  245.       Procedure PutData( index: Cardinal; value: Extended );
  246.       Function GetData(index: Cardinal): Extended;
  247.  
  248.       property Data[ Index:Cardinal ]: Extended
  249.          read GetData write PutData; default;
  250.   End;
  251.  
  252.   TPointerArray = Class( T64KArray )
  253.     public
  254.       Constructor Create( itemcount, dummy: Cardinal ); override;
  255.       Procedure PutData( index: Cardinal; value: Pointer );
  256.       Function GetData(index: Cardinal): Pointer;
  257.       Procedure CopyFrom( Var Source; toIndex, numItems: Cardinal );
  258.         override;
  259.       Procedure CopyTo( Var Dest; fromIndex, numItems: Cardinal );
  260.         override;
  261.       Procedure InvalidateItems(atIndex, numItems: Cardinal);
  262.         override;
  263.       Function CloneItem( item: Pointer ): Pointer; virtual;
  264.       Procedure FreeItem( item: Pointer ); virtual;
  265.       Procedure SaveToFile( Const Filename: String );
  266.         override;
  267.       Procedure LoadFromFile( Const Filename: String );
  268.         override;
  269.       Procedure SaveToStream( Stream: TStream );
  270.         override;
  271.       Procedure LoadFromStream( Stream: TStream );
  272.         override;
  273.       Procedure SaveItemToStream( S: TStream; Item: Pointer );
  274.         virtual;
  275.       Procedure LoadItemFromStream( S: TStream; Var Item: Pointer );
  276.         virtual;
  277.  
  278.       property AsPtr[ Index: Cardinal ]: Pointer
  279.          read GetData write PutData;
  280.       property Data[ Index: Cardinal ]: Pointer
  281.          read GetData write PutData;   (* NOT default here! *)
  282.   End;
  283.  
  284.   TPCharArray = Class( TPointerArray )
  285.     public
  286.       Constructor Create( itemcount, dummy: Cardinal ); override;
  287.       Procedure PutData( index: Cardinal; value: PChar );
  288.       Function GetData(index: Cardinal): PChar;
  289.  
  290.       Function CloneItem( item: Pointer ): Pointer;
  291.         override;
  292.       Procedure FreeItem( item: Pointer );
  293.         override;
  294.       Procedure SaveItemToStream( S: TStream; Item: Pointer );
  295.         override;
  296.       Procedure LoadItemFromStream( S: TStream; Var Item: Pointer );
  297.         override;
  298.  
  299.       Procedure PutAsString( index: Cardinal; Const value: String );
  300.       Function GetAsString(index: Cardinal): String;
  301.       Procedure PutAsInteger( index: Cardinal; value: LongInt );
  302.       Function GetAsInteger(index: Cardinal): LongInt;
  303.       Procedure PutAsReal( index: Cardinal; value: Extended );
  304.       Function GetAsReal(index: Cardinal): Extended;
  305.  
  306.       Procedure LoadFromTextfile( Const Filename: String;
  307.                                   appendData: Boolean;
  308.                                   reporter: TProgressReporter );
  309.       Procedure SaveToTextfile( Const Filename: String;
  310.                                   appendData: Boolean;
  311.                                   reporter: TProgressReporter );
  312.  
  313.       property Data[ Index: Cardinal ]: PChar
  314.          read GetData write PutData; Default;
  315.       property AsString[ Index: Cardinal ]: String
  316.          read GetAsString write PutAsString;
  317.       property AsInteger[ Index: Cardinal ]: LongInt
  318.          read GetAsInteger write PutAsInteger;
  319.       property AsReal[ Index: Cardinal ]: Extended
  320.          read GetAsReal write PutAsReal;
  321.  
  322.   End;
  323.  
  324.   TPStringArray = Class( TPointerArray )
  325.     public
  326.       Constructor Create( itemcount, dummy: Cardinal ); override;
  327.       Procedure PutData( index: Cardinal; Const value: String );
  328.       Function GetData(index: Cardinal): String;
  329.  
  330.       Function CloneItem( item: Pointer ): Pointer;
  331.         override;
  332.       Procedure FreeItem( item: Pointer );
  333.         override;
  334.       Procedure SaveItemToStream( S: TStream; Item: Pointer );
  335.         override;
  336.       Procedure LoadItemFromStream( S: TStream; Var Item: Pointer );
  337.         override;
  338.       Function GetAsPtr(index: Cardinal): PString;
  339.       Procedure PutAsPChar( index: Cardinal; value: PChar );
  340.       Function GetAsPChar(index: Cardinal): PChar;
  341.       Procedure PutAsInteger( index: Cardinal; value: LongInt );
  342.       Function GetAsInteger(index: Cardinal): LongInt;
  343.       Procedure PutAsReal( index: Cardinal; value: Extended );
  344.       Function GetAsReal(index: Cardinal): Extended;
  345.       Procedure LoadFromTextfile( Const Filename: String;
  346.                                   appendData: Boolean;
  347.                                   reporter: TProgressReporter );
  348.       Procedure SaveToTextfile( Const Filename: String;
  349.                                   appendData: Boolean;
  350.                                   reporter: TProgressReporter );
  351.  
  352.       property Data[ Index: Cardinal ]: String
  353.          read GetData write PutData; Default;
  354.       property AsPChar[ Index: Cardinal ]: Pchar
  355.          read GetAsPChar write PutAsPChar;
  356.       property AsInteger[ Index: Cardinal ]: LongInt
  357.          read GetAsInteger write PutAsInteger;
  358.       property AsReal[ Index: Cardinal ]: Extended
  359.          read GetAsReal write PutAsReal;
  360.       property AsPString[ Index: Cardinal ]: PString
  361.          read GetAsPtr;
  362.   End;
  363.  
  364.   (* a couple of compare procedures as used by the numeric array classes *)
  365.  
  366.   Function CmpIntegers( Var item1, item2 ): Integer;
  367.   Function CmpCardinals( Var item1, item2  ): Integer;
  368.   Function CmpLongs( Var item1, item2 ): Integer;
  369.   Function CmpReals( Var item1, item2 ): Integer;
  370.   Function CmpSingles( Var item1, item2 ): Integer;
  371.   Function CmpDoubles( Var item1, item2 ): Integer;
  372.   Function CmpExtendeds( Var item1, item2 ): Integer;
  373.   Function CmpPChars( Var item1, item2 ): Integer;
  374.   Function CmpPStrings( Var item1, item2 ): Integer;
  375.  
  376. Implementation
  377.  
  378. {$IFDEF DOEVENTS}
  379. Uses Forms, FastMem, WinProcs;
  380. {$ELSE}
  381. Uses FastMem, WinProcs;
  382. {$ENDIF}
  383.  
  384. Const
  385.   (* This section defines the error messages for exceptions specific to
  386.      the objects in this Unit. Translate as necessary. *)
  387.  
  388.   ErrAssign =
  389.     'T64KArray.AssignTo: Destination object does not match this array.';
  390.   ErrLoad = 
  391.     'T64KArray.LoadFromStream: The stored items have different size than'+
  392.     ' this arrays items.';
  393.   ErrCompare =
  394.     'T64KArray.Sort/Find: No comparision function has been assigned '+
  395.     'for this array object.';
  396.   ErrIndex =
  397.     'T64KArray: Index %u out of bounds, maximum allowed is %u';
  398.   ErrSegmentOverflow =
  399.     'T64KArray.ReDim: requested size > 64Kbyte!';
  400.   ErrFileTooLarge =
  401.     'LoadFromTextfile: File %s has too many lines to load completely!';
  402.  
  403. {+----------------------
  404.  | Methods of T64KArray 
  405.  +----------------------}
  406. {************************************************************
  407.  * T64KArray.DefineProperties
  408.  *
  409.  * Parameters:
  410.  *  Filer: a storage handler object
  411.  * Description:
  412.  *  This methods prepares the object for streaming by telling the
  413.  *  Filer which methods to call for loading and storing the array
  414.  *  data.
  415.  * Error Conditions:
  416.  *  none
  417.  *
  418.  *Created: 04/18/95 14:33:53 by P. Below
  419.  ************************************************************}
  420. Procedure T64KArray.DefineProperties(Filer: TFiler); 
  421.   Begin
  422.     inherited DefineProperties( Filer );
  423.     Filer.DefineBinaryProperty( 'ArrayData', LoadFromStream, 
  424.                                 SaveToStream, FMemory <> Nil );
  425.   End; { T64KArray.DefineProperties }
  426.  
  427. {************************************************************
  428.  * T64KArray.AssignTo
  429.  *
  430.  * Parameters:
  431.  *  Dest: the target object 
  432.  * Description:
  433.  *  This method copies the contents of this array to the destination
  434.  *  array, provided the destination is a descendant of T64KArray and
  435.  *  has the same component size. The destination array is redim'ed to 
  436.  *  the same size as this array.  The actual copy is performed by
  437.  *  the BlockCopy method, which a descendant class can override to
  438.  *  realize a deep copy, for instance, if the items stored in the 
  439.  *  array are pointers.
  440.  * Error Conditions:
  441.  *  This method will raise a EConvertError exception, if the type of
  442.  *  the destination does not match that of Self. It may also cause 
  443.  *  a protection fault, if Dest ist Nil ( really stupid! ) or an out
  444.  *  of memory exception in ReDim.
  445.  *
  446.  *Created: 04/18/95 15:01:29 by P. Below
  447.  ************************************************************}
  448. Procedure T64KArray.AssignTo( Dest: TPersistent );
  449.   Var
  450.     D: T64KArray absolute Dest;
  451.   Begin
  452.     If ( Dest Is ClassType ) and ( ItemSize = D.ItemSize ) Then Begin
  453.       If D.MaxIndex < MaxIndex Then
  454.         D.Redim( Succ( MaxIndex ) );
  455.       D.BlockCopy( Self, 0, 0, Succ( maxIndex ));
  456.       D.SortOrder := SortOrder;
  457.       D.Flags := Flags;
  458.       D.CompareProc := CompareProc;
  459.     End { If }
  460.     Else
  461.       raise ETypeMismatch.Create( errAssign );
  462.   End; { T64KArray.AssignTo }
  463.  
  464. Function T64KArray.GetMaxCapacity: Cardinal;
  465.   Begin
  466.     Result := High( Cardinal ) div ItemSize;
  467.   End; { T64KArray.GetMaxCapacity }
  468.  
  469. Function T64KArray.GetCapacity: Cardinal;
  470.   Begin
  471.     Result := Succ( MaxIndex );
  472.   End; { T64KArray.GetCapacity }
  473.  
  474. {************************************************************
  475.  * T64KArray.SaveToFile
  476.  *
  477.  * Parameters:
  478.  *  Filename: name of file to write
  479.  * Description:
  480.  *  Saves the data in this array to a file. Only the array data
  481.  *  itself is written, neither the component size not the number 
  482.  *  of items are stored! This makes it possible to access the file
  483.  *  as a File Of Component ( where Component is the type stored in
  484.  *  this array, not a Delphi Component!).
  485.  * Error Conditions:
  486.  *  May raise a EInOutError exception if a file-related error occurs.
  487.  *
  488.  *Created: 05/01/95 16:09:08 by P. Below
  489.  ************************************************************}
  490. Procedure T64KArray.SaveToFile( Const Filename: String );
  491.   Var
  492.     F: File;
  493.   Begin
  494.     AssignFile( F, Filename );
  495.     Rewrite( F, ItemSize );
  496.     try
  497.       BlockWrite( F, FMemory^, Succ( MaxIndex ));
  498.     finally
  499.       CloseFile( F );
  500.     end;
  501.   End; { T64KArray.SaveToFile }
  502.  
  503. {************************************************************
  504.  * T64KArray.LoadFromFile
  505.  *
  506.  * Parameters:
  507.  *  Filename: name of file to load
  508.  * Description:
  509.  *  Loads the contents of the requested file into the array, which
  510.  *  is redimensioned to fit the data.
  511.  *  For this to work smoothly the file should have been created
  512.  *  by the SaveToFile method of an array object of the same type
  513.  *  as this one and it must be < 64KBytes in size! If it is larger
  514.  *  only part of it will be read. If the items in the file do have
  515.  *  a different item size that this array assumes (a fact we cannot
  516.  *  check), the loaded data will propably come out as garbage!
  517.  * Error Conditions:
  518.  *  May raise a EInOutError exception if a file-related error occurs.
  519.  *
  520.  *Created: 05/01/95 16:28:50 by P. Below
  521.  ************************************************************}
  522. Procedure T64KArray.LoadFromFile( Const Filename: String );
  523.   Var
  524.     F: File;
  525.     N: LongInt;
  526.   Begin
  527.     AssignFile( F, Filename );
  528.     FileMode := fmOpenRead or fmShareDenyWrite;
  529.     try
  530.       Reset( F, ItemSize );
  531.       N := FileSize( F );
  532.       If (N*ItemSize) > LongInt( High( Cardinal )) Then
  533.         N := High( Cardinal ) div ItemSize;
  534.       Redim( N );
  535.       BlockRead( F, FMemory^, Succ( MaxIndex ));
  536.     finally
  537.       FileMode := 2;
  538.       CloseFile( F );
  539.     end;
  540.   End; { T64KArray.LoadFromFile }
  541.  
  542. {************************************************************
  543.  * T64KArray.SaveToStream
  544.  *
  545.  * Parameters:
  546.  *  Stream: an opened stream that takes the array data
  547.  * Description:
  548.  *  This method stores the arrays item size and max index
  549.  *  (NOT the number of items!) followed by the array data into
  550.  *  the passed stream. NOTE that this is different from SaveToFile,
  551.  *  which only writes the array data! 
  552.  *  You can use this method to append the array data to an open 
  553.  *  stream that can already contain other data in front and receive
  554.  *  additional data after we are done here.
  555.  *  We do not stream the array object itself, only its data!
  556.  * Error Conditions:
  557.  *  The stream may raise an exception if it runs into problems.
  558.  *
  559.  *Created: 05/01/95 16:53:49 by P. Below
  560.  ************************************************************}
  561. Procedure T64KArray.SaveToStream( Stream: TStream );
  562.   Var
  563. {$IFDEF WIN32}
  564.     TempSize, TempIndex: Cardinal;
  565. {$ELSE}
  566.     TempSize, TempIndex: LongInt;
  567. {$ENDIF}
  568.   Begin
  569.     TempSize := FItemSize;
  570.     TempIndex := FMaxIndex;
  571.     With Stream Do Begin
  572.       Write( TempSize, Sizeof( TempSize ));
  573.       Write( TempIndex, Sizeof( TempIndex ));
  574.       Write( FMemory^, FMemSize );
  575.     End; { With }
  576.   End; { T64KArray.SaveToStream }
  577.  
  578. {************************************************************
  579.  * T64KArray.LoadFromStream
  580.  *
  581.  * Parameters:
  582.  *  Stream: an opened stream that holds the array data to read
  583.  * Description:
  584.  *  This method reads the stored arrays item size and max index
  585.  *  and checks the item size vs. our own item size. If these two
  586.  *  do match, the array is redimensioned according to the needed
  587.  *  size and the array data are read from the passed stream. 
  588.  *  NOTE that this is different from LoadFromFile, which only 
  589.  *  reads the array data and assumes they have the right item size!
  590.  *  You can use this method to get the array data from an open 
  591.  *  stream that can already contain other data in front and
  592.  *  additional data after. However, it is your responsibility
  593.  *  to position the stream pointer correctly.
  594.  * Error Conditions:
  595.  *  The stream may raise an exception if it runs into problems.
  596.  *  We will raise an ETypeMismatch exception if the item size read
  597.  *  from the stream does not match our own item size. 
  598.  *
  599.  *Created: 05/01/95 16:53:49 by P. Below
  600.  ************************************************************}
  601. Procedure T64KArray.LoadFromStream( Stream: TStream );
  602.   Var
  603. {$IFDEF WIN32}
  604.     TempSize, TempIndex: Cardinal;
  605. {$ELSE}
  606.     TempSize, TempIndex: LongInt;
  607. {$ENDIF}
  608.   Begin
  609.     Zap;
  610.     With Stream Do Begin
  611.       Read( TempSize, Sizeof( TempSize ));
  612.       Read( TempIndex, Sizeof( TempIndex ));
  613.       If TempSize = ItemSize Then Begin
  614.         Redim( Succ( TempIndex ));
  615.         Read( FMemory^, FMemSize );
  616.       End { If }
  617.       Else
  618.         raise ETypeMismatch.Create( errLoad );
  619.     End; { With }
  620.   End; { T64KArray.LoadFromStream }
  621.  
  622. {************************************************************
  623.  * T64KArray.GetItemPtr
  624.  *
  625.  * Parameters:
  626.  *  index: index ( zero-based ) of the item to access
  627.  * Returns:
  628.  *  a pointer to the requested item in this array
  629.  * Description:
  630.  *  Does brute-force pointer arithmetic to calculate the
  631.  *  items address from index and size. 
  632.  *  WARNING! Does no checks for FMemory=Nil! 
  633.  * Error Conditions:
  634.  *  If the passed index is out of range, the method will raise
  635.  *  an ERangeError exception, if range checking is enabled,
  636.  *  otherwise it returns a pointer to the first item in the 
  637.  *  array.
  638.  *
  639.  *Created: 04/18/95 15:56:08 by P. Below
  640.  ************************************************************}
  641. Function T64KArray.GetItemPtr( index: Cardinal ): Pointer; 
  642.   Begin
  643.     Result := FMemory;
  644.     If ValidIndex( index ) Then
  645.       Inc( PtrRec( Result ).ofs, index*FItemSize )
  646.   End; { T64KArray.GetItemPtr }
  647.  
  648. {************************************************************
  649.  * T64KArray.GetCount
  650.  *
  651.  * Parameters:
  652.  *  none
  653.  * Returns:
  654.  *  the number of used items in the array
  655.  * Description:
  656.  *  This method is used to implement the Count property. For
  657.  *  this class it acts like Capacity, because all items of the
  658.  *  array are considered in use. But for a descendant class that
  659.  *  works more like a BP collection, only part of the items
  660.  *  may be actually used. These classes can override GetCount to
  661.  *  return the actually used number. The Count property is used
  662.  *  by Sort, Find and the iterator methods to get the upper bound
  663.  *  of the range to operate on; these methods will thus work
  664.  *  without changes in collection-like descendants.
  665.  * Error Conditions:
  666.  *  none
  667.  *
  668.  *Created: 05/20/95 18:07:46 by P. Below
  669.  ************************************************************}
  670. Function T64KArray.GetCount: Cardinal;
  671.   Begin
  672.     Result := Succ( FMaxIndex )
  673.   End;
  674.  
  675. {************************************************************
  676.  * T64KArray.PutItem
  677.  *
  678.  * Parameters:
  679.  *  data: a data item to put into the array, must have same 
  680.  *        size as the arrays components.
  681.  *  index: index of array slot to put the data into ( zero-based )
  682.  * Description:
  683.  *  Uses a direct mem copy to put the data into the array. No
  684.  *  error checks on type of the passed data are possible here!
  685.  *  NOTE:
  686.  *  The method obviously overwrites the old contents of the index
  687.  *  slot but it does _not_ invalidate the old entry! Thus this 
  688.  *  method can be used by an InvalidateItems handler to set a
  689.  *  pointer to Nil.
  690.  * Error Conditions:
  691.  *  If the index is out ouf bounds, does nothing.
  692.  *
  693.  *Created: 04/18/95 16:10:14 by P. Below
  694.  ************************************************************}
  695. Procedure T64KArray.PutItem(index: Cardinal; Var data );
  696.   Begin
  697.     If ValidIndex( index ) Then Begin
  698.       MemMove( @data, GetItemPtr( index ), FItemSize );
  699.       SortOrder := TS_NONE;
  700.     End;
  701.   End; { T64KArray.PutItem }
  702.  
  703. { Same as above, only on reverse gear }
  704. Procedure T64KArray.GetItem( index: Cardinal; Var data );
  705.   Begin
  706.     If ValidIndex( index ) Then
  707.       MemMove( GetItemPtr( index ), @data, FItemSize );
  708.   End; { T64KArray.GetItem }
  709.  
  710. {************************************************************
  711.  * T64KArray.Create
  712.  *
  713.  * Parameters:
  714.  *  itemcount: number of items the array should hold, cannot be
  715.  *             0! 0 is mapped to 1.
  716.  *  itemsize : size in bytes of an individual item
  717.  * Description:
  718.  *  Allocates the memory for the array and sets the fields
  719.  *  according to the passed data. In the Win16 version the
  720.  *  product of itemcount and itemsize has to be < 64Kbyte. 
  721.  *  We reduce the itemcount to an allowed value, if necessary,
  722.  *  without raising any error if it is to large.
  723.  * Error Conditions:
  724.  *  If GetMem fails we rely on the default exception handling to
  725.  *  fail the constructor.
  726.  *
  727.  *Created: 04/18/95 16:30:08 by P. Below
  728.  ************************************************************}
  729. Constructor T64KArray.Create( itemcount, itemsize: Cardinal );
  730. {$IFNDEF WIN32}
  731.   Var
  732.     s: LongInt;
  733. {$ENDIF}
  734.   Begin
  735.     inherited Create;
  736.     If itemcount = 0 Then Inc( itemcount );
  737. {$IFNDEF WIN32}
  738.     s := LongInt( itemcount ) * itemsize;
  739.     If s >= $10000 Then Begin
  740.       (* user has math problems, be gracious and reduce itemcount
  741.          to allowed value *)
  742.       itemcount := $FFFF div itemsize;
  743.     End; { If }
  744. {$ENDIF}
  745.     FMemSize := itemcount * itemsize;
  746.     GetMem( FMemory, FMemSize );
  747.     MemFill( FMemory, FMemSize, 0 );
  748.     FItemSize := itemsize;
  749.     FMaxIndex := Pred( itemcount );
  750.     FFlags    := [ AF_OwnsData, AF_AutoSize ];
  751.   End; { T64KArray.Create }
  752.  
  753. {************************************************************
  754.  * T64KArray.Destroy
  755.  *
  756.  * Parameters:
  757.  *  none
  758.  * Description:
  759.  *  Standard destructor, frees the memory allocated for the array
  760.  *  and then calls the inherited destructor. We invalidate all used
  761.  *  items first.
  762.  * Error Conditions:
  763.  *  none
  764.  *
  765.  *Created: 04/18/95 16:34:35 by P. Below
  766.  ************************************************************}
  767. Destructor  T64KArray.Destroy; 
  768.   Begin
  769.     If FMemory <> Nil Then Begin
  770.       InvalidateItems( 0, Count );
  771.       FreeMem( FMemory, FMemSize );
  772.       FMemSize := 0;
  773.       FMaxIndex := 0;
  774.       FItemSize := 0;
  775.     End; { If }
  776.     inherited Destroy;
  777.   End; { T64KArray.Destroy }
  778.  
  779. (* Invalidate all used items and fill the memory with 0 *)
  780. Procedure T64KArray.Zap;
  781.   Begin
  782.     InvalidateItems( 0, Count );
  783.     MemFill( Memory, Capacity*ItemSize, 0 );
  784.   End; { T64KArray.Zap }
  785.  
  786. {************************************************************
  787.  * T64KArray.Clone
  788.  *
  789.  * Parameters:
  790.  *  none
  791.  * Returns:
  792.  *  Pointer to a freshly minted exact copy of this object
  793.  * Description:
  794.  *  Creates a new object of the same type as this one is and
  795.  *  copies the arrays contents to the new object via AssignTo.
  796.  *  If the actual class type stores pointers to other stuff it
  797.  *  is the responsibility of that class to override the BlockCopy
  798.  *  method used by AssignTo to implement a deep copy.
  799.  * Error Conditions:
  800.  *  Construction of the new object may fail due to out of memory.
  801.  *  The assign process may conceivably also fail, if it involves
  802.  *  a deep copy. If that happens, the raised exception is trapped,
  803.  *  the new object destroyed and the exception is reraised for
  804.  *  handling at an upper level.
  805.  *
  806.  *Created: 04/18/95 16:46:35 by P. Below
  807.  ************************************************************}
  808. Function  T64KArray.Clone: T64KArray;
  809.   Var
  810.     cI : C64KArray;
  811.   Begin
  812.     cI := C64KArray(Self.ClassType);
  813.     Result := cI.Create( Succ( FMaxIndex ), FItemSize );
  814.     try
  815.       AssignTo( Result );
  816.     except
  817.       on EOutOfMemory Do Begin
  818.         Result.Free;
  819.         Result := Nil;
  820.         raise
  821.       end;
  822.     end;
  823.   End; { T64KArray.Clone }
  824.  
  825. {************************************************************
  826.  * T64KArray.ReDim
  827.  *
  828.  * Parameters:
  829.  *  newcount: number of items the new array should hold, cannot
  830.  *            be 0! 0 is mapped to 1.
  831.  * Description:
  832.  *  Reallocates the array to a new size. The old items are
  833.  *  copied over, as far as possible. New slots are nulled out.
  834.  *  If the new array is smaller than the old one the extra 
  835.  *  items are invalidated so a derived class can do cleanup
  836.  *  on them.
  837.  * Error Conditions:
  838.  *  ReAllocMem, the RTL function used, may raise an out of memory
  839.  *  exception.
  840.  *  If compiled with debugging on ($D+) we will raise an ERangeError
  841.  *  exception, if the requested size is > 64K and we are compiling
  842.  *  for Win16.
  843.  *
  844.  *Created: 04/18/95 17:12:12 by P. Below
  845.  ************************************************************}
  846. Procedure T64KArray.ReDim( newcount: Cardinal );
  847. {$IFNDEF WIN32}
  848.   Var
  849.     s: LongInt;
  850. {$ENDIF}
  851.   Begin
  852.     If newcount = 0 Then Inc( newcount );
  853.     If newcount <> Succ( FMaxIndex ) Then Begin
  854.       If newcount < Succ( FMaxIndex ) Then
  855.         InvalidateItems( newcount, FMaxIndex-newcount+1 )
  856. {$IFNDEF WIN32}
  857.       Else Begin
  858.         s := LongInt( newcount ) * itemsize;
  859.         If s >= $10000 Then Begin
  860.           (* user has math problems, be gracious and reduce newcount
  861.              to allowed value *)
  862.           newcount := GetMaxCapacity;
  863. {$IFOPT D+}
  864.           (* raise an exception, if compiled for debugging *)
  865.           raise 
  866.             ERangeError.Create( ErrSegmentOverflow );
  867. {$ENDIF}
  868.         End; { If }
  869.       End
  870. {$ENDIF}
  871.       ;
  872.       FMemory := ReAllocMem( FMemory,
  873.                              Succ( FMaxIndex )*FItemSize,
  874.                              newcount * FItemSize );
  875.       FMemSize  := newcount* FItemSize;
  876.       FMaxIndex := Pred( newcount );
  877.       SortOrder := TS_NONE;
  878.     End; { If }
  879.   End; { T64KArray.ReDim }
  880.  
  881. {************************************************************
  882.  * T64KArray.InvalidateItems
  883.  *
  884.  * Parameters:
  885.  *  atIndex: index of first item about to be nuked
  886.  *  numItems: number of items effected
  887.  * Description:
  888.  *  This method is called is items are about to be deleted from
  889.  *  the array. It does nothing for this class but descendants 
  890.  *  storing pointers or objects may use it to perform cleanup
  891.  *  tasks for the items about to be deleted.
  892.  * Error Conditions:
  893.  *  none
  894.  *
  895.  *Created: 04/19/95 16:48:42 by P. Below
  896.  ************************************************************}
  897. Procedure T64KArray.InvalidateItems( atIndex, numItems: Cardinal );
  898.   Begin
  899.     { This is a NOP for this class }
  900.   End; (* T64KArray.InvalidateItems *)
  901.  
  902. {************************************************************
  903.  * T64KArray.ValidIndex
  904.  *
  905.  * Parameters:
  906.  *  atIndex: an index value
  907.  * Returns:
  908.  *  true if the index is in range, false otherwise
  909.  * Description:
  910.  *  This method is used by a couple of others to validate an
  911.  *  index.
  912.  * Error Conditions:
  913.  *  If Index is > MaxIndex the method will raise a ERangeError 
  914.  *  exception, if range checking is on, or return false if range
  915.  *  checking is off.
  916.  *
  917.  *Created: 04/19/95 16:58:57 by P. Below
  918.  ************************************************************}
  919. Function T64KArray.ValidIndex( Index: Cardinal ): Boolean;
  920.   Begin
  921.     Result := True;
  922.     If Index > FMaxIndex Then Begin
  923. {$IFOPT R+}
  924.       raise ERangeError.CreateFmt( ErrIndex, [ index, FMaxIndex ] );
  925. {$ENDIF}
  926.       Result := False;
  927.     End { If }
  928.   End;
  929.  
  930. {************************************************************
  931.  * T64KArray.ValidateBounds
  932.  *
  933.  * Parameters:
  934.  *  atIndex: an index value
  935.  *  numItems: a item count value
  936.  * Returns:
  937.  *  true if the index is in range, false otherwise
  938.  * Description:
  939.  *  This method is used by a couple of others to validate an
  940.  *  index and make sure that numItems is not higher than the
  941.  *  number of items from position atIndex on to the end of array.
  942.  * Error Conditions:
  943.  *  If atIndex is > MaxIndex the method will raise a ERangeError 
  944.  *  exception, if range checking is on, or return false if range
  945.  *  checking is off.
  946.  *
  947.  *  If the numItem parameter is larger than the number of items
  948.  *  present after position atIndex (inclusive) it is adjusted to 
  949.  *  the maximal number of items possible.
  950.  *  
  951.  *
  952.  *Created: 04/19/95 16:58:57 by P. Below
  953.  ************************************************************}
  954. Function T64KArray.ValidateBounds( atIndex: Cardinal;
  955.                                   Var numItems: Cardinal): Boolean;
  956.   Begin
  957.     Result := ValidIndex( atIndex );
  958.     If Result Then
  959.       If ( numItems > Succ( FMaxIndex )) or 
  960.          (( maxIndex-numItems+1 ) < atIndex ) Then 
  961.         numItems := FMaxIndex - atIndex + 1;
  962.   End; (* T64KArray.ValidateBounds *)
  963.  
  964.  
  965. {************************************************************
  966.  * T64KArray.Insert
  967.  *
  968.  * Parameters:
  969.  *  Source : the source of the new items to insert
  970.  *  atIndex: index to insert the new items at
  971.  *  numItems: number of items to insert
  972.  * Description:
  973.  *  This method inserts the passed items, moving all items from
  974.  *  position atIndex and up numItems positions upwards. The array
  975.  *  grows as needed, if the ability flag AF_AutoSize is set. 
  976.  *  If it cannot grow ( enough ), items may fall off
  977.  *  the end! If atIndex is beyond the end of array, Append is used.
  978.  * Error Conditions:
  979.  *  If the method is asked to insert more items than can fit, the
  980.  *  numItems parameter is adjusted to the maximal number of items 
  981.  *  possible without an exception beeing raised. Redim is used to 
  982.  *  grow the array, to EOutOfMemory is a distinct posibility.
  983.  *
  984.  *Created: 04/19/95 16:03:29 by P. Below
  985.  ************************************************************}
  986. Procedure T64KArray.Insert( Var Source; atIndex, numItems: Cardinal );
  987.   Var
  988.     oldCapacity, itemsToMove, moveTargetIndex, lostItems: Cardinal;
  989.   Begin
  990.     If numItems = 0 Then
  991.       Exit;
  992.  
  993.     (* check 1: if AtIndex is beyond the end of array, we effectively
  994.                 do an append! *)
  995.     If atIndex > MaxIndex Then Begin
  996.       Append( Source, numItems );
  997.       Exit;
  998.     End; { If }
  999.  
  1000.     oldCapacity := Capacity;
  1001.  
  1002.     (* resize the array, this may not succeed completely if the array
  1003.        would need to grow > 64K in Win16! In that case it will grow 
  1004.        to the maximal possible size. *)
  1005.     If HasFlag( AF_AutoSize ) Then
  1006.       Redim( oldCapacity+numItems );
  1007.  
  1008.     (* check2: correct numItems downwards, if the array could not been
  1009.        grown to the required size. Note one pathological case here: if
  1010.        the original atIndex was > MaxIndex AND the array was already 
  1011.        at maximal size, we will run into an invalid index error on the
  1012.        next statement and end up doing nothing! *)
  1013.     If ValidateBounds( atIndex, numItems ) Then Begin
  1014.       
  1015.       (* move the items after the insertion point up to make room for
  1016.          the new items. *)
  1017.       itemsToMove := oldCapacity - atIndex;
  1018.       If itemsToMove > 0 Then Begin
  1019.         moveTargetIndex := atIndex + numItems;
  1020.         (* Note: ValidateBounds makes sure that moveTargetIndex is at
  1021.                  max MaxIndex+1 ( =Capacity )! *)
  1022.  
  1023.         (* check 3: if any items fall off at the end, invalidate them
  1024.                     and reduce the number to move accordingly. *)
  1025.         If ( Capacity - moveTargetIndex ) < itemsToMove Then Begin
  1026.           lostItems := itemsToMove + moveTargetIndex - Capacity;
  1027.           InvalidateItems( atIndex + itemsToMove-lostItems, lostItems );
  1028.           itemsToMove := itemsToMove - lostItems;
  1029.         End; { If }
  1030.  
  1031.         (* move the items beyond the end of insertion range up *)
  1032.         MemMove( GetItemPtr( atIndex ),
  1033.                  GetItemPtr( moveTargetIndex ),
  1034.                  itemsToMove * ItemSize );
  1035.         (* now null out the places where we will put the new items.
  1036.            this is necessary to prevent the InvalidateItems call for
  1037.            these items CopyFrom will do from barfing, if the items
  1038.            are pointers, for example. *)
  1039.         MemFill( GetItemPtr( atIndex ), numItems*ItemSize, 0 );
  1040.       End; { If }
  1041.       (* move the items to insert into the array *)
  1042.       CopyFrom( Source, atIndex, numItems );
  1043.     End; { If }
  1044.   End; { T64KArray.Insert }
  1045.  
  1046. {************************************************************
  1047.  * T64KArray.Delete
  1048.  *
  1049.  * Parameters:
  1050.  *  atIndex: index to start deleting items
  1051.  *  numItems: number of items to delete
  1052.  * Description:
  1053.  *  This method deletes items by moving all items above the
  1054.  *  requested range down numItems slots and redims the array
  1055.  *  to the smaller size, if the ability flag AF_AutoSize is set. 
  1056.  *  The deleted items are invalidated first,
  1057.  *  so descendant class storing pointers or objects can free the storage 
  1058.  *  for the deleted items or do other cleanup tasks, as appropriate.
  1059.  * Error Conditions:
  1060.  *  If atIndex is > MaxIndex the method will raise a ERangeError 
  1061.  *  exception, if range checking is on, or do nothing if range
  1062.  *  checking is off.
  1063.  *
  1064.  *  If the method is asked to delete more items than there are, the
  1065.  *  numItems parameter is adjusted to the maximal number of items 
  1066.  *  possible without an exception beeing raised.
  1067.  *
  1068.  *Created: 04/19/95 16:37:34 by P. Below
  1069.  ************************************************************}
  1070. Procedure T64KArray.Delete( atIndex, numItems: Cardinal );
  1071.   Begin
  1072.     If numItems = 0 Then 
  1073.       Exit;
  1074.     If ValidateBounds( atIndex, numItems ) Then Begin
  1075.       (* invalidate the items about to be deleted so a derived class 
  1076.          can do cleanup on them. *)
  1077.       InvalidateItems( atIndex, numItems );
  1078.  
  1079.       (* move the items above those we delete down, if there are any *)
  1080.       If ( atIndex+numItems ) <= MaxIndex Then
  1081.         MemMove( GetItemPtr( atIndex+numItems ), 
  1082.                  GetItemPtr( atIndex ),
  1083.                  ( maxIndex-atIndex-numItems+1 )*ItemSize );
  1084.       (* null out the now free slots *)
  1085.       MemFill( GetItemPtr( MaxIndex-numItems+1 ),
  1086.                numItems*ItemSize, 0 ); 
  1087.       If HasFlag( AF_AutoSize ) Then 
  1088.         Redim( Capacity - numItems );
  1089.     End; { If }
  1090.   End; { T64KArray.Delete }
  1091.  
  1092. {************************************************************
  1093.  * T64KArray.Append
  1094.  *
  1095.  * Parameters:
  1096.  *  Source : the source of the new items to append
  1097.  *  numItems: number of items to append
  1098.  * Description:
  1099.  *  This method appends the passed items. The array
  1100.  *  grows as needed. If it cannot grow enough, not all items may be
  1101.  *  copied! Note that this method is independant of the settings
  1102.  *  of the AF_AutoSize ability flag!
  1103.  * Error Conditions:
  1104.  *  If the method is asked to append more items than can fit, the
  1105.  *  numItems parameter is adjusted to the maximal number of items 
  1106.  *  possible without an exception beeing raised. Redim may raise
  1107.  *  an EOutOfMemory exception.
  1108.  *
  1109.  *Created: 04/19/95 16:03:29 by P. Below
  1110.  ************************************************************}
  1111. Procedure T64KArray.Append( Var Source; numItems: Cardinal );
  1112.   Var
  1113.     n: Cardinal;
  1114.   Begin
  1115.     n := Capacity;
  1116.     Redim( n+numItems );
  1117.     CopyFrom( Source, n, numItems );
  1118.   End; { T64KArray.Append }
  1119.  
  1120. {************************************************************
  1121.  * T64KArray.CopyFrom
  1122.  *
  1123.  * Parameters:
  1124.  *  Source: source of the items to be copied
  1125.  *  toIndex: index for the first copied item
  1126.  *  numItems: number of items to copy
  1127.  * Description:
  1128.  *  This methods overwrites the next numItems items in this array
  1129.  *  starting at position toIndex with items from the Source. The
  1130.  *  overwritten items are invalidated first.
  1131.  * Error Conditions:
  1132.  *  If toIndex is > MaxIndex the method will raise a ERangeError 
  1133.  *  exception, if range checking is on, or do nothing if range
  1134.  *  checking is off. If the Source memory contains less than the
  1135.  *  specified number of items to copy a protection fault may result.
  1136.  *
  1137.  *  If the method is asked to copy more items than will fit, the
  1138.  *  numItems parameter is adjusted to the maximal number of items 
  1139.  *  possible without an exception beeing raised.
  1140.  *  
  1141.  *
  1142.  *Created: 04/19/95 17:14:49 by P. Below
  1143.  ************************************************************}
  1144. Procedure T64KArray.CopyFrom( Var Source; toIndex, numItems: Cardinal );
  1145.   Begin
  1146.     If numItems = 0 Then 
  1147.       Exit;
  1148.     If ValidateBounds( toIndex, numItems ) Then Begin
  1149.       (* invalidate the items about to be overwritten so a derived class 
  1150.          can do cleanup on them. *)
  1151.       InvalidateItems( toIndex, numItems );
  1152.  
  1153.       (* do the copy *)
  1154.       MemMove( @Source,
  1155.                GetItemPtr(toIndex ),
  1156.                numItems*ItemSize );
  1157.       SortOrder := TS_NONE;
  1158.     End; { If }
  1159.   End; { T64KArray.CopyFrom }
  1160.  
  1161. {************************************************************
  1162.  * T64KArray.CopyTo
  1163.  *
  1164.  * Parameters:
  1165.  *  Dest: memory to copy items to
  1166.  *  fromIndex: index of first item to copy
  1167.  *  numItems: number of items to copy
  1168.  * Description:
  1169.  *  This method copies items from this array to a memory target.
  1170.  *  WARNING!
  1171.  *  This may be a problem if the copied items are pointers or
  1172.  *  objects, since this is a shallow copy and the result will
  1173.  *  be several references to the same memory locations! A derived
  1174.  *  class may have to override this method to deal with this problem.
  1175.  * Error Conditions:
  1176.  *  If fromIndex is > MaxIndex the method will raise a ERangeError 
  1177.  *  exception, if range checking is on, or do nothing if range
  1178.  *  checking is off. If the Dest memory can hold less than the
  1179.  *  specified number of items to copy a protection fault may result.
  1180.  *
  1181.  *  If the method is asked to copy more items than there are, the
  1182.  *  numItems parameter is adjusted to the maximal number of items 
  1183.  *  possible without an exception beeing raised.
  1184.  *
  1185.  *Created: 04/19/95 17:19:07 by P. Below
  1186.  ************************************************************}
  1187. Procedure T64KArray.CopyTo( Var Dest; fromIndex, numItems: Cardinal );
  1188.   Begin
  1189.     If numItems = 0 Then 
  1190.       Exit;
  1191.     If ValidateBounds( fromIndex, numItems ) Then Begin
  1192.       MemMove( GetItemPtr( fromIndex ), @Dest, 
  1193.                numItems*ItemSize );
  1194.     End; { If }
  1195.   End; { T64KArray.CopyTo }
  1196.  
  1197. {************************************************************
  1198.  * T64KArray.BlockCopy
  1199.  *
  1200.  * Parameters:
  1201.  *  Source: an array object instance to copy items from
  1202.  *  fromIndex: index in source of first item to copy
  1203.  *  toIndex: index in self to copy the first item to
  1204.  *  numitems: number of items to copy
  1205.  * Description:
  1206.  *  Uses CopyFrom to do the actual copy process after doing a
  1207.  *  few sanity checks on the source. CopyFrom does the checks
  1208.  *  on the target. The numitems count may be reduced if either
  1209.  *  the source does not have that many items or Self cannot take
  1210.  *  them. 
  1211.  * Error Conditions:
  1212.  *  Will raise a ETypeMismatch exception if the Source object is
  1213.  *  not of the same or a derived type as Self and also if it has
  1214.  *  a different item size. ERangeError exceptions may be raised
  1215.  *  by called methods.
  1216.  *
  1217.  *Created: 04/19/95 17:57:41 by P. Below
  1218.  ************************************************************}
  1219. Procedure T64KArray.BlockCopy( Source: T64KArray; 
  1220.                          fromIndex, toIndex, numitems: Cardinal ); 
  1221.   Begin
  1222.     If numitems = 0 Then
  1223.       Exit;
  1224.     If ( Source Is ClassType ) and ( ItemSize = Source.ItemSize ) Then
  1225.     Begin
  1226.       If Source.ValidateBounds( fromIndex, numItems ) Then 
  1227.         CopyFrom( Source.GetItemPtr( fromIndex )^, toIndex, numItems )
  1228.     End
  1229.     Else
  1230.       raise ETypeMismatch.Create( ErrAssign );
  1231.   End; { T64KArray.BlockCopy }
  1232.  
  1233. {************************************************************
  1234.  * T64KArray.Sort
  1235.  *
  1236.  * Parameters:
  1237.  *  ascending: defines whether to sort in ascending or descending 
  1238.  *             order
  1239.  * Description:
  1240.  *  This method implements a recursive QuickSort. It can only 
  1241.  *  do its work if a comparison function has been assigned to
  1242.  *  the FCompareProc field. Since this is a generic procedure
  1243.  *  to sort any kind of data, it is possible to get a much 
  1244.  *  better performance for specific data types by reimplementing
  1245.  *  the Sort for this type.
  1246.  * Error Conditions:
  1247.  *  Will raise a ECompUndefined exception if no comparison function
  1248.  *  has been defined. Them method may also run out of memory
  1249.  *  in GetMem while allocating the pivot data buffer.
  1250.  *
  1251.  *Created: 04/22/95 16:02:24 by P. Below
  1252.  ************************************************************}
  1253. Procedure T64KArray.Sort( ascending: Boolean );
  1254.   Procedure QSort( L, R: Cardinal );
  1255.     Var
  1256.       i, j: Cardinal;
  1257.       pPivot: Pointer;
  1258.     Begin
  1259.       i:= L;
  1260.       j:= R;
  1261.       GetMem( pPivot, ItemSize );
  1262.       try
  1263.         GetItem( ( L+R ) div 2, pPivot^ );
  1264.         Repeat
  1265.           If ascending Then Begin
  1266.             While FCompareProc( GetItemPtr( i )^, pPivot^ ) < 0 Do
  1267.               Inc( i );
  1268.             While FCompareProc( pPivot^, GetItemPtr( j )^ ) < 0 Do
  1269.               Dec( j );
  1270.           End { If }
  1271.           Else Begin
  1272.             While FCompareProc( GetItemPtr( i )^, pPivot^ ) > 0 Do
  1273.               Inc( i );
  1274.             While FCompareProc( pPivot^, GetItemPtr( j )^ ) > 0 Do
  1275.               Dec( j );
  1276.           End; { Else }
  1277.           If i <= j Then Begin
  1278.             MemSwap( GetItemPtr( i ), GetItemPtr( j ), ItemSize );
  1279.             Inc( i );
  1280.             If j > 0 Then Dec( j );
  1281.           End; { If }
  1282.         Until i > j ;
  1283.         If L < j Then QSort( L, j );
  1284.         If i < R Then QSort( i, R );
  1285.       finally
  1286.         FreeMem( pPivot, ItemSize );
  1287.       end;
  1288.     End; { QSort }
  1289.   Begin { Sort }
  1290.     (* do we have anything to do? *)
  1291.     If ( Count = 0 ) or not HasFlag( AF_CanCompare ) Then 
  1292.       Exit;
  1293.     If ascending Then
  1294.       If ( SortOrder = TS_ASCENDING ) Then Exit
  1295.       Else
  1296.     Else 
  1297.       If ( SortOrder = TS_DESCENDING ) Then Exit;
  1298.  
  1299.     (* ok, _can_ we do it? *)
  1300.     If @FCompareProc <> Nil Then Begin
  1301.       QSort( 0, Pred( Count ));
  1302.       If ascending Then
  1303.         SortOrder := TS_ASCENDING
  1304.       Else
  1305.         SortOrder := TS_DESCENDING;
  1306.     End
  1307.     Else
  1308.       raise ECompUndefined.Create( ErrCompare );
  1309.   End; { T64KArray.Sort }
  1310.  
  1311. {************************************************************
  1312.  * T64KArray.Find
  1313.  *
  1314.  * Parameters:
  1315.  *  value: item to search for in the array
  1316.  * Returns:
  1317.  *  index of found item or NOT_FOUND when the value is not in array.
  1318.  * Description:
  1319.  *  Depending on the sort state of the array this Function will do
  1320.  *  a binary or sequential search thru the array, using the 
  1321.  *  comparison function supplied in FCompareProc to compare value
  1322.  *  to the current item.
  1323.  *  WARNING! 
  1324.  *  If the list is sorted and contains multiple instances of the same
  1325.  *  value, the search will not necessarily find the _first_ instance
  1326.  *  of this value! This is a general shortcome of binary search; set
  1327.  *  SortOrder to TS_NONE before the search to force sequential search
  1328.  *  if the array contains multiple copies of the same value.
  1329.  *
  1330.  *  Like for the Sort method descendants may gain a considerable 
  1331.  *  improvement in performance if they reimplement this method with
  1332.  *  optimized data access and comparison.
  1333.  * Error Conditions:
  1334.  *  Will raise a ECompUndefined exception if no comparison function
  1335.  *  has been defined.
  1336.  *  
  1337.  *
  1338.  *Created: 04/22/95 16:31:13 by P. Below
  1339.  ************************************************************}
  1340. Function  T64KArray.Find( Var value ): Cardinal;
  1341.   Function LinearSearch: Cardinal;
  1342.     Var
  1343.       i: Cardinal;
  1344.       p: Pointer;
  1345.     Begin
  1346.       Result := NOT_FOUND;
  1347.       p := FMemory;
  1348.       For i:= 0 To Pred( Count )  Do Begin
  1349.         If FCompareProc( value, p^ ) = 0 Then Begin
  1350.           Result := i;
  1351.           Break;
  1352.         End; { If }
  1353.         Inc( PtrRec( p ).ofs, ItemSize );
  1354.       End; { For }
  1355.     End; { LinearSearch }
  1356.     Function BinarySearch: Cardinal;
  1357.       Var
  1358.         u,l,i: Cardinal; 
  1359.         n    : Integer;
  1360.         asc  : Boolean;
  1361.       Begin
  1362.         Result := NOT_FOUND;
  1363.         l := 0;
  1364.         u := Pred( Count );
  1365.         asc := SortOrder = TS_ASCENDING;
  1366.         While l <= u Do Begin
  1367.           i := ( l+u ) div 2;
  1368.           n := FCompareProc( value, GetItemPtr( i )^);
  1369.           If n = 0 Then Begin
  1370.             Result := i;
  1371.             Break;
  1372.           End;
  1373.           If l = u Then 
  1374.             Break;
  1375.           If asc xor ( n < 0 )Then 
  1376.             l := i
  1377.           Else
  1378.             u := i;
  1379.         End; { While }  
  1380.       End; { BinarySearch }
  1381.       
  1382.   Begin { Find }
  1383.     Result := NOT_FOUND;
  1384.     If ( Count = 0 ) or not HasFlag( AF_CanCompare ) Then 
  1385.       Exit;
  1386.     If @FCompareProc <> Nil Then Begin
  1387.       If SortOrder = TS_NONE Then
  1388.         Result := LinearSearch
  1389.       Else
  1390.         Result := BinarySearch;
  1391.     End
  1392.     Else
  1393.       raise ECompUndefined.Create( ErrCompare );
  1394.   End; { T64KArray.Find }
  1395.  
  1396. {************************************************************
  1397.  * T64KArray.ForEach
  1398.  *
  1399.  * Parameters:
  1400.  *  iterator: an object method adhering to the TIteratorMethod
  1401.  *            prototype defined in the Interface. 
  1402.  *  processMsg: this flag deterimines whether the method will
  1403.  *            call Application.ProcessMessages inside the iterator
  1404.  *            loop
  1405.  *  intervall: determines how often ProcessMessages is called, a
  1406.  *             higher number means messages will be processed less
  1407.  *             often since the method uses (index mod intervall)=0
  1408.  *             as trigger to call ProcessMessages.
  1409.  * Description:
  1410.  *  The method loops over all entries of the array and passes the 
  1411.  *  address of each with its index to the iterator method. 
  1412.  *  If processMsg = True, the method will call ProcessMessages on each 
  1413.  *  intervall'th round of the loop. Note that this only happens when 
  1414.  *  this Unit has been compiled with the symbol DOEVENTS defined!
  1415.  * Error Conditions:
  1416.  *  The method has no error conditions per se but horrible things will
  1417.  *  happen if you call it with a Nil iterator since we do not check
  1418.  *  for this condition!
  1419.  *
  1420.  *Created: 04/22/95 17:07:27 by P. Below
  1421.  ************************************************************}
  1422. Procedure T64KArray.ForEach( iterator: TIteratorMethod; processMsg: Boolean;
  1423.                              intervall: Cardinal );
  1424.   Var
  1425.     i: Cardinal;
  1426.     p: Pointer;
  1427.   Begin
  1428.     p := FMemory;
  1429.     For i:= 0 To Pred( Count )  Do Begin
  1430.       Iterator( p^, i );
  1431.       Inc( PtrRec( p ).ofs, ItemSize );
  1432. {$IFDEF DOEVENTS}
  1433.       If processMsg and (( i mod intervall ) = 0) Then
  1434.         Application.ProcessMessages;
  1435. {$ENDIF}
  1436.     End; { For }
  1437.   End; { T64KArray.ForEach }
  1438.  
  1439. {************************************************************
  1440.  * T64KArray.FirstThat
  1441.  *
  1442.  * Parameters:
  1443.  *  locator:  an object method adhering to the TLocatorMethod
  1444.  *            prototype defined in the Interface. 
  1445.  *  processMsg: this flag determines whether the method will
  1446.  *            call Application.ProcessMessages inside the iterator
  1447.  *            loop
  1448.  *  intervall: determines how often ProcessMessages is called, a
  1449.  *             higher number means messages will be processed less
  1450.  *             often since the method uses (index mod intervall)=0
  1451.  *             as trigger to call ProcessMessages.
  1452.  * Returns:
  1453.  *  The address of the item for which the locator returned True, or
  1454.  *  Nil if it returned False for all items.
  1455.  * Description:
  1456.  *  The method loops over all entries of the array and passes the 
  1457.  *  address of each with its index to the locator method. The loop
  1458.  *  terminates immediately when the locator method returns True.
  1459.  *  If processMsg = True, the method will call ProcessMessages on each 
  1460.  *  intervall'th round of the loop. Note that this only happens when 
  1461.  *  this Unit has been compiled with the symbol DOEVENTS defined!
  1462.  * Error Conditions:
  1463.  *  The method has no error conditions per se but horrible things will
  1464.  *  happen if you call it with a Nil locator since we do not check
  1465.  *  for this condition!
  1466.  *
  1467.  *Created: 04/22/95 17:07:27 by P. Below
  1468.  ************************************************************}
  1469. Function  T64KArray.FirstThat( locator: TLocatorMethod; 
  1470.                                processMsg: Boolean;
  1471.                                intervall: Cardinal ): Pointer;
  1472.   Var
  1473.     i: Cardinal;
  1474.     p: Pointer;
  1475.   Begin
  1476.     Result := Nil;
  1477.     p := FMemory;
  1478.     For i:= 0 To Pred( Count )  Do Begin
  1479.       If Locator( p^, i ) Then Begin
  1480.         Result := p;
  1481.         Break
  1482.       End;
  1483.       Inc( PtrRec( p ).ofs, ItemSize );
  1484. {$IFDEF DOEVENTS}
  1485.       If processMsg and (( i mod intervall ) = 0) Then
  1486.         Application.ProcessMessages;
  1487. {$ENDIF}
  1488.     End; { For }
  1489.   End; { T64KArray.FirstThat }
  1490.  
  1491. {************************************************************
  1492.  * T64KArray.LastThat
  1493.  *
  1494.  * Parameters:
  1495.  *  locator:  an object method adhering to the TLocatorMethod
  1496.  *            prototype defined in the Interface. 
  1497.  *  processMsg: this flag determines whether the method will
  1498.  *            call Application.ProcessMessages inside the iterator
  1499.  *            loop
  1500.  *  intervall: determines how often ProcessMessages is called, a
  1501.  *             higher number means messages will be processed less
  1502.  *             often since the method uses (index mod intervall)=0
  1503.  *             as trigger to call ProcessMessages.
  1504.  * Returns:
  1505.  *  The address of the item for which the locator returned True, or
  1506.  *  Nil if it returned False for all items.
  1507.  * Description:
  1508.  *  The method loops over all entries of the array, starting with the
  1509.  *  last item working backwards, and passes the 
  1510.  *  address of each with its index to the locator method. The loop
  1511.  *  terminates immediately when the locator method returns True.
  1512.  *  If processMsg = True, the method will call ProcessMessages on each 
  1513.  *  intervall'th round of the loop. Note that this only happens when 
  1514.  *  this Unit has been compiled with the symbol DOEVENTS defined!
  1515.  * Error Conditions:
  1516.  *  The method has no error conditions per se but horrible things will
  1517.  *  happen if you call it with a Nil locator since we do not check
  1518.  *  for this condition!
  1519.  *
  1520.  *Created: 04/22/95 17:07:27 by P. Below
  1521.  ************************************************************}
  1522. Function  T64KArray.LastThat(locator: TLocatorMethod; 
  1523.                      processMsg: Boolean;
  1524.                          intervall: Cardinal ): Pointer;
  1525.   Var
  1526.     i: Cardinal;
  1527.     p: Pointer;
  1528.   Begin
  1529.     Result := Nil;
  1530.     p := GetItemPtr( Pred( Count ) );
  1531.     For i:= Pred( Count ) DownTo 0 Do Begin
  1532.       If Locator( p^, i ) Then Begin
  1533.         Result := p;
  1534.         Break
  1535.       End;
  1536.       Dec( PtrRec( p ).ofs, ItemSize );
  1537. {$IFDEF DOEVENTS}
  1538.       If processMsg and (( i mod intervall ) = 0) Then
  1539.         Application.ProcessMessages;
  1540. {$ENDIF}
  1541.     End; { For }
  1542.   End; { T64KArray.LastThat }
  1543.  
  1544. {************************************************************
  1545.  * T64KArray.ForEachProc
  1546.  *
  1547.  * Parameters:
  1548.  *  iterator: a Procedure adhering to the TIterator
  1549.  *            prototype defined in the Interface. 
  1550.  *  processMsg: this flag deterimines whether the method will
  1551.  *            call Application.ProcessMessages inside the iterator
  1552.  *            loop
  1553.  *  intervall: determines how often ProcessMessages is called, a
  1554.  *             higher number means messages will be processed less
  1555.  *             often since the method uses (index mod intervall)=0
  1556.  *             as trigger to call ProcessMessages.
  1557.  * Description:
  1558.  *  The method loops over all entries of the array and passes the 
  1559.  *  address of each with its index to the iterator method. 
  1560.  *  If processMsg = True, the method will call ProcessMessages on each 
  1561.  *  intervall'th round of the loop. Note that this only happens when 
  1562.  *  this Unit has been compiled with the symbol DOEVENTS defined!
  1563.  * Error Conditions:
  1564.  *  The method has no error conditions per se but horrible things will
  1565.  *  happen if you call it with a Nil iterator since we do not check
  1566.  *  for this condition!
  1567.  *
  1568.  *Created: 04/22/95 17:07:27 by P. Below
  1569.  ************************************************************}
  1570. Procedure T64KArray.ForEachProc( iterator: TIterator; processMsg: Boolean;
  1571.                          intervall: Cardinal );
  1572.   Var
  1573.     i: Cardinal;
  1574.     p: Pointer;
  1575.   Begin
  1576.     p := FMemory;
  1577.     For i:= 0 To Pred( Count )  Do Begin
  1578.       Iterator( p^, i );
  1579.       Inc( PtrRec( p ).ofs, ItemSize );
  1580. {$IFDEF DOEVENTS}
  1581.       If processMsg and (( i mod intervall ) = 0) Then
  1582.         Application.ProcessMessages;
  1583. {$ENDIF}
  1584.     End; { For }
  1585.   End; { T64KArray.ForEachProc }
  1586.  
  1587. {************************************************************
  1588.  * T64KArray.FirstThatProc
  1589.  *
  1590.  * Parameters:
  1591.  *  locator:  a Function adhering to the TLocator
  1592.  *            prototype defined in the Interface. 
  1593.  *  processMsg: this flag determines whether the method will
  1594.  *            call Application.ProcessMessages inside the iterator
  1595.  *            loop
  1596.  *  intervall: determines how often ProcessMessages is called, a
  1597.  *             higher number means messages will be processed less
  1598.  *             often since the method uses (index mod intervall)=0
  1599.  *             as trigger to call ProcessMessages.
  1600.  * Returns:
  1601.  *  The address of the item for which the locator returned True, or
  1602.  *  Nil if it returned False for all items.
  1603.  * Description:
  1604.  *  The method loops over all entries of the array and passes the 
  1605.  *  address of each with its index to the locator method. The loop
  1606.  *  terminates immediately when the locator method returns True.
  1607.  *  If processMsg = True, the method will call ProcessMessages on each 
  1608.  *  intervall'th round of the loop. Note that this only happens when 
  1609.  *  this Unit has been compiled with the symbol DOEVENTS defined!
  1610.  * Error Conditions:
  1611.  *  The method has no error conditions per se but horrible things will
  1612.  *  happen if you call it with a Nil locator since we do not check
  1613.  *  for this condition!
  1614.  *
  1615.  *Created: 04/22/95 17:07:27 by P. Below
  1616.  ************************************************************}
  1617. Function  T64KArray.FirstThatProc( locator: TLocator; 
  1618.                          processMsg: Boolean;
  1619.                          intervall: Cardinal ): Pointer;
  1620.   Var
  1621.     i: Cardinal;
  1622.     p: Pointer;
  1623.   Begin
  1624.     Result := Nil;
  1625.     p := FMemory;
  1626.     For i:= 0 To Pred( Count )  Do Begin
  1627.       If Locator( p^, i ) Then Begin
  1628.         Result := p;
  1629.         Break
  1630.       End;
  1631.       Inc( PtrRec( p ).ofs, ItemSize );
  1632. {$IFDEF DOEVENTS}
  1633.       If processMsg and (( i mod intervall ) = 0) Then
  1634.         Application.ProcessMessages;
  1635. {$ENDIF}
  1636.     End; { For }
  1637.   End; { T64KArray.FirstThatProc }
  1638.  
  1639. {************************************************************
  1640.  * T64KArray.LastThatProc
  1641.  *
  1642.  * Parameters:
  1643.  *  locator:  a Function adhering to the TLocator
  1644.  *            prototype defined in the Interface. 
  1645.  *  processMsg: this flag determines whether the method will
  1646.  *            call Application.ProcessMessages inside the iterator
  1647.  *            loop
  1648.  *  intervall: determines how often ProcessMessages is called, a
  1649.  *             higher number means messages will be processed less
  1650.  *             often since the method uses (index mod intervall)=0
  1651.  *             as trigger to call ProcessMessages.
  1652.  * Returns:
  1653.  *  The address of the item for which the locator returned True, or
  1654.  *  Nil if it returned False for all items.
  1655.  * Description:
  1656.  *  The method loops over all entries of the array, starting with the
  1657.  *  last item working backwards, and passes the 
  1658.  *  address of each with its index to the locator method. The loop
  1659.  *  terminates immediately when the locator method returns True.
  1660.  *  If processMsg = True, the method will call ProcessMessages on each 
  1661.  *  intervall'th round of the loop. Note that this only happens when 
  1662.  *  this Unit has been compiled with the symbol DOEVENTS defined!
  1663.  * Error Conditions:
  1664.  *  The method has no error conditions per se but horrible things will
  1665.  *  happen if you call it with a Nil locator since we do not check
  1666.  *  for this condition!
  1667.  *
  1668.  *Created: 04/22/95 17:07:27 by P. Below
  1669.  ************************************************************}
  1670. Function  T64KArray.LastThatProc(locator: TLocator; 
  1671.                        processMsg: Boolean;
  1672.                          intervall: Cardinal ): Pointer;
  1673.   Var
  1674.     i: Cardinal;
  1675.     p: Pointer;
  1676.   Begin
  1677.     Result := Nil;
  1678.     p := GetItemPtr( Pred( Count ) );
  1679.     For i:= Pred( Count ) DownTo 0 Do Begin
  1680.       If Locator( p^, i ) Then Begin
  1681.         Result := p;
  1682.         Break
  1683.       End;
  1684.       Dec( PtrRec( p ).ofs, ItemSize );
  1685. {$IFDEF DOEVENTS}
  1686.       If processMsg and (( i mod intervall ) = 0) Then
  1687.         Application.ProcessMessages;
  1688. {$ENDIF}
  1689.     End; { For }
  1690.   End; { T64KArray.LastThatProc }
  1691.  
  1692. Procedure T64KArray.SetCompareProc( proc: TCompareProc );
  1693.   Begin
  1694.     FCompareProc := proc;
  1695.     If @proc = Nil Then
  1696.       ClearFlag( AF_CanCompare )
  1697.     Else
  1698.       SetFlag( AF_CanCompare );
  1699.   End; { T64KArray.SetCompareProc }
  1700.  
  1701. (* The following methods manipulate the FFlags set of array 
  1702.    'abilites'.  *)
  1703. Function T64KArray.HasFlag( aFlag: TArrayFlags ): Boolean;
  1704.   Begin
  1705.     Result := aFlag In Flags;
  1706.   End; { T64KArray.HasFlag }
  1707.  
  1708. Procedure T64KArray.SetFlag( aFlag: TArrayFlags ); 
  1709.   Begin
  1710.     Include( FFLags, aFlag );
  1711.   End; { T64KArray.SetFlag }
  1712.  
  1713. Procedure T64KArray.ClearFlag( aFlag: TArrayFlags ); 
  1714.   Begin
  1715.     Exclude( FFLags, aFlag );
  1716.   End; { T64KArray.ClearFlag }
  1717.  
  1718.  
  1719.  
  1720. {+--------------------------
  1721.  | Methods of TIntegerArray 
  1722.  +-------------------------}
  1723. Type
  1724.   TIArray =Array[ 0..High( Cardinal ) div Sizeof( Integer )-1 ] of Integer;
  1725.   PIArray = ^TIArray;
  1726. Constructor TIntegerArray.Create( itemcount, dummy: Cardinal );
  1727.   Begin
  1728.     inherited Create( itemcount, Sizeof( integer ));
  1729.     CompareProc := CmpIntegers;
  1730.   End; { TIntegerArray.Create }
  1731.  
  1732. Procedure TIntegerArray.PutData( index: Cardinal ; value: Integer );
  1733.   Begin
  1734. {$IFOPT R+}
  1735.     If ValidIndex( index ) Then Begin
  1736. {$ENDIF}
  1737.       PIArray( FMemory )^[ index ] := value;
  1738.       SortOrder := TS_NONE;
  1739. {$IFOPT R+}
  1740.     End;
  1741. {$ENDIF}
  1742.   End; { TIntegerArray.PutData }
  1743.  
  1744. Function TIntegerArray.GetData(index: Cardinal): Integer;
  1745.   Begin
  1746. {$IFOPT R+}
  1747.     If ValidIndex( index ) Then
  1748. {$ENDIF}
  1749.       Result := PIArray( FMemory )^[ index ];
  1750.   End; { TIntegerArray.GetData }
  1751.  
  1752. {+---------------------------
  1753.  | Methods of TCardinalArray
  1754.  +--------------------------}
  1755. Type
  1756.   TCArray =Array[ 0..High( Cardinal ) div Sizeof( Cardinal )-1 ] of Cardinal;
  1757.   PCArray = ^TCArray;
  1758. Constructor TCardinalArray.Create( itemcount, dummy: Cardinal );
  1759.   Begin
  1760.     inherited Create( itemcount, Sizeof( Cardinal ));
  1761.     CompareProc := CmpCardinals;
  1762.   End; { TCardinalArray.Create }
  1763.  
  1764. Procedure TCardinalArray.PutData( index: Cardinal ; value: Cardinal );
  1765.   Begin
  1766. {$IFOPT R+}
  1767.     If ValidIndex( index ) Then Begin
  1768. {$ENDIF}
  1769.       PCArray( FMemory )^[ index ] := value;
  1770.       SortOrder := TS_NONE;
  1771. {$IFOPT R+}
  1772.     End;
  1773. {$ENDIF}
  1774.   End; { TCardinalArray.PutData }
  1775.  
  1776. Function TCardinalArray.GetData(index: Cardinal): Cardinal;
  1777.   Begin
  1778. {$IFOPT R+}
  1779.     If ValidIndex( index ) Then
  1780. {$ENDIF}
  1781.       Result := PCArray( FMemory )^[ index ];
  1782.   End; { TCardinalArray.GetData }
  1783.  
  1784. {+---------------------------
  1785.  | Methods of TLongIntArray
  1786.  +--------------------------}
  1787. Type
  1788.   TLArray = Array[ 0..High( Cardinal ) div Sizeof( LongInt )-1 ] of LongInt;
  1789.   PLArray = ^TLArray;
  1790. Constructor TLongIntArray.Create( itemcount, dummy: Cardinal );
  1791.   Begin
  1792.     inherited Create( itemcount, Sizeof( LongInt ));
  1793.     CompareProc := CmpLongs;
  1794.   End; { TLongIntArray.Create }
  1795.  
  1796. Procedure TLongIntArray.PutData( index: Cardinal ; value: LongInt );
  1797.   Begin
  1798. {$IFOPT R+}
  1799.     If ValidIndex( index ) Then Begin
  1800. {$ENDIF}
  1801.       PLArray( FMemory )^[ index ] := value;
  1802.       SortOrder := TS_NONE;
  1803. {$IFOPT R+}
  1804.     End;
  1805. {$ENDIF}
  1806.   End; { TLongIntArray.PutData }
  1807.  
  1808. Function TLongIntArray.GetData(index: Cardinal): LongInt;
  1809.   Begin
  1810. {$IFOPT R+}
  1811.     If ValidIndex( index ) Then
  1812. {$ENDIF}
  1813.       Result := PLArray( FMemory )^[ index ];
  1814.   End; { TLongIntArray.GetData }
  1815.  
  1816. {+-----------------------
  1817.  | Methods of TRealArray
  1818.  +----------------------}
  1819. Type
  1820.   TRArray = Array[ 0..High( Cardinal ) div Sizeof( Real )-1 ] of Real;
  1821.   PRArray = ^TRArray;
  1822. Constructor TRealArray.Create( itemcount, dummy: Cardinal );
  1823.   Begin
  1824.     inherited Create( itemcount, Sizeof( Real ));
  1825.     CompareProc := CmpReals;
  1826.   End; { TRealArray.Create }
  1827.  
  1828. Procedure TRealArray.PutData( index: Cardinal ; value: Real );
  1829.   Begin
  1830. {$IFOPT R+}
  1831.     If ValidIndex( index ) Then Begin
  1832. {$ENDIF}
  1833.       PRArray( FMemory )^[ index ] := value;
  1834.       SortOrder := TS_NONE;
  1835. {$IFOPT R+}
  1836.     End;
  1837. {$ENDIF}
  1838.   End; { TRealArray.PutData }
  1839.  
  1840. Function TRealArray.GetData(index: Cardinal): Real;
  1841.   Begin
  1842. {$IFOPT R+}
  1843.     If ValidIndex( index ) Then
  1844. {$ENDIF}
  1845.       Result := PRArray( FMemory )^[ index ];
  1846.   End; { TRealArray.GetData }
  1847.  
  1848. {+-------------------------
  1849.  | Methods of TSingleArray
  1850.  +------------------------}
  1851. Type
  1852.   TSArray = Array[ 0..High( Cardinal ) div Sizeof( Single )-1 ] of Single;
  1853.   PSArray = ^TSArray;
  1854. Constructor TSingleArray.Create( itemcount, dummy: Cardinal );
  1855.   Begin
  1856.     inherited Create( itemcount, Sizeof( Single ));
  1857.     CompareProc := CmpSingles;
  1858.   End; { TSingleArray.Create }
  1859.  
  1860. Procedure TSingleArray.PutData( index: Cardinal ; value: Single );
  1861.   Begin
  1862. {$IFOPT R+}
  1863.     If ValidIndex( index ) Then Begin
  1864. {$ENDIF}
  1865.       PSArray( FMemory )^[ index ] := value;
  1866.       SortOrder := TS_NONE;
  1867. {$IFOPT R+}
  1868.     End;
  1869. {$ENDIF}
  1870.   End; { TSingleArray.PutData }
  1871.  
  1872. Function TSingleArray.GetData(index: Cardinal): Single;
  1873.   Begin
  1874. {$IFOPT R+}
  1875.     If ValidIndex( index ) Then
  1876. {$ENDIF}
  1877.       Result := PSArray( FMemory )^[ index ];
  1878.   End; { TSingleArray.GetData }
  1879.  
  1880. {+-------------------------
  1881.  | Methods of TDoubleArray
  1882.  +------------------------}
  1883. Type
  1884.   TDArray = Array[ 0..High( Cardinal ) div Sizeof( Double )-1 ] of Double;
  1885.   PDArray = ^TDArray;
  1886. Constructor TDoubleArray.Create( itemcount, dummy: Cardinal );
  1887.   Begin
  1888.     inherited Create( itemcount, Sizeof( Double ));
  1889.     CompareProc := CmpDoubles;
  1890.   End; { TDoubleArray.Create }
  1891.  
  1892. Procedure TDoubleArray.PutData( index: Cardinal ; value: Double );
  1893.   Begin
  1894. {$IFOPT R+}
  1895.     If ValidIndex( index ) Then Begin
  1896. {$ENDIF}
  1897.       PDArray( FMemory )^[ index ] := value;
  1898.       SortOrder := TS_NONE;
  1899. {$IFOPT R+}
  1900.     End;
  1901. {$ENDIF}
  1902.   End; { TDoubleArray.PutData }
  1903.  
  1904. Function TDoubleArray.GetData(index: Cardinal): Double;
  1905.   Begin
  1906. {$IFOPT R+}
  1907.     If ValidIndex( index ) Then
  1908. {$ENDIF}
  1909.       Result := PDArray( FMemory )^[ index ];
  1910.   End; { TDoubleArray.GetData }
  1911.  
  1912. {+---------------------------
  1913.  | Methods of TExtendedArray
  1914.  +--------------------------}
  1915. Type
  1916.   TEArray = Array[ 0..High( Cardinal ) div Sizeof( Extended )-1 ] of Extended;
  1917.   PEArray = ^TEArray;
  1918. Constructor TExtendedArray.Create( itemcount, dummy: Cardinal );
  1919.   Begin
  1920.     inherited Create( itemcount, Sizeof( Extended ));
  1921.     CompareProc := CmpExtendeds;
  1922.   End; { TExtendedArray.Create }
  1923.  
  1924. Procedure TExtendedArray.PutData( index: Cardinal ; value: Extended );
  1925.   Begin
  1926. {$IFOPT R+}
  1927.     If ValidIndex( index ) Then Begin
  1928. {$ENDIF}
  1929.       PEArray( FMemory )^[ index ] := value;
  1930.       SortOrder := TS_NONE;
  1931. {$IFOPT R+}
  1932.     End;
  1933. {$ENDIF}
  1934.   End; { TExtendedArray.PutData }
  1935.  
  1936. Function TExtendedArray.GetData(index: Cardinal): Extended;
  1937.   Begin
  1938. {$IFOPT R+}
  1939.     If ValidIndex( index ) Then
  1940. {$ENDIF}
  1941.       Result := PEArray( FMemory )^[ index ];
  1942.   End; { TExtendedArray.GetData }
  1943.  
  1944. {+--------------------------
  1945.  | Methods of TPointerArray  
  1946.  +-------------------------}
  1947. Type
  1948.   TPArray = Array [ 0..High( Cardinal ) div Sizeof( Pointer )-1 ] Of Pointer;
  1949.   PPArray = ^TPArray;
  1950.  
  1951. Constructor TPointerArray.Create( itemcount, dummy: Cardinal );
  1952.   Begin
  1953.     inherited Create( itemcount, Sizeof( Pointer ));
  1954.     Flags := [ AF_AutoSize ];
  1955.     (* no comparison function can be assigned here since we do not
  1956.        even know how large the memory areas are our pointers point to. 
  1957.        by default the array will also not own the data it collects. *)
  1958.   End; { TPointerArray.Create }
  1959.  
  1960. {************************************************************
  1961.  * TPointerArray.CopyFrom
  1962.  *
  1963.  * Parameters:
  1964.  *  Source: source of the items to be copied
  1965.  *  toIndex: index for the first copied item
  1966.  *  numItems: number of items to copy
  1967.  * Description:
  1968.  *  This methods overwrites the next numItems items in this array
  1969.  *  starting at position toIndex with _copies_ (hopefully) of items 
  1970.  *  from the Source. The overwritten items are invalidated first.
  1971.  *  The actual copy is done item by item with calls to the CloneItem
  1972.  *  method. The version provided with this calls will only do a shallow
  1973.  *  copy ( it has no idea about what the pointer point to ), so you
  1974.  *  should derive your own class with an overriden CloneItem method 
  1975.  *  to get a deep copy.
  1976.  * Error Conditions:
  1977.  *  If toIndex is > MaxIndex the method will raise a ERangeError 
  1978.  *  exception, if range checking is on, or do nothing if range
  1979.  *  checking is off. If the Source memory contains less than the
  1980.  *  specified number of items to copy a protection fault may result.
  1981.  *
  1982.  *  If the method is asked to copy more items than will fit, the
  1983.  *  numItems parameter is adjusted to the maximal number of items 
  1984.  *  possible without an exception beeing raised.
  1985.  *  
  1986.  *
  1987.  *Created: 05/28/95 21:14:49 by P. Below
  1988.  ************************************************************}
  1989. Procedure TPointerArray.CopyFrom( Var Source; toIndex, numItems: Cardinal );
  1990.   Var
  1991.     i: Cardinal;
  1992.     p: PPArray;
  1993.     arr: TPArray absolute Source;
  1994.   Begin
  1995.     If numItems = 0 Then 
  1996.       Exit;
  1997.     If ValidateBounds( toIndex, numItems ) Then Begin
  1998.       (* invalidate the items about to be overwritten so a derived class 
  1999.          can do cleanup on them. *)
  2000.       InvalidateItems( toIndex, numItems );
  2001.  
  2002.       p := PPArray( Memory );
  2003.       For i:= 0 To Pred( numItems ) Do 
  2004.         p^[ toIndex+i ] := CloneItem( arr[ i ] );
  2005.       SortOrder := TS_NONE;
  2006.     End; { If }
  2007.   End; { TPointerArray.CopyFrom }
  2008.  
  2009. {************************************************************
  2010.  * TPointerArray.CopyTo
  2011.  *
  2012.  * Parameters:
  2013.  *  Dest: memory to copy items to
  2014.  *  fromIndex: index of first item to copy
  2015.  *  numItems: number of items to copy
  2016.  * Description:
  2017.  *  This method copies items from this array to a memory target.
  2018.  *  The items are copied one after the other using the CloneItem
  2019.  *  method. The version in this class does only a shallow copy
  2020.  *  (copies the pointer), since it has no idea what the pointers
  2021.  *   point to. You should override CloneItem in derived classes to
  2022.  *   get a deep copy.
  2023.  * Error Conditions:
  2024.  *  If fromIndex is > MaxIndex the method will raise a ERangeError 
  2025.  *  exception, if range checking is on, or do nothing if range
  2026.  *  checking is off. If the Dest memory can hold less than the
  2027.  *  specified number of items to copy a protection fault may result.
  2028.  *
  2029.  *  If the method is asked to copy more items than there are, the
  2030.  *  numItems parameter is adjusted to the maximal number of items 
  2031.  *  possible without an exception beeing raised.
  2032.  *
  2033.  *Created: 05/28/95 21:19:07 by P. Below
  2034.  ************************************************************}
  2035. Procedure TPointerArray.CopyTo( Var Dest; fromIndex, numItems: Cardinal );
  2036.   Var
  2037.     i: Cardinal;
  2038.     p: PPArray;
  2039.     arr: TPArray absolute Dest;
  2040.   Begin
  2041.     If numItems = 0 Then 
  2042.       Exit;
  2043.     If ValidateBounds( fromIndex, numItems ) Then Begin
  2044.       p := PPArray( Memory );
  2045.       For i:= 0 To Pred( numItems ) Do 
  2046.         arr[ i ] := CloneItem( p^[ fromIndex+i ] );
  2047.     End; { If }
  2048.   End; { TPointerArray.CopyTo }
  2049.  
  2050. (* PutData implements the write access via the default Data property.
  2051.    It first frees the pointer at index and then stores a pointer to
  2052.    a _copy_ of the passed data into that slot. *)
  2053. Procedure TPointerArray.PutData( index: Cardinal ; value: Pointer );
  2054.   Begin
  2055.     If ValidIndex( index ) Then Begin
  2056.       If ( PPArray( Memory )^[ index ] <> Nil ) and HasFlag( AF_OwnsData ) 
  2057.       Then
  2058.         FreeItem( PPArray( Memory )^[ index ] );
  2059.       PPArray( Memory )^[ index ] := CloneItem( value );
  2060.       SortOrder := TS_NONE;
  2061.     End;
  2062.   End; { TPointerArray.PutData }
  2063.  
  2064. (* returns pointer in slot index, or Nil, if the index is invalid. *)
  2065. Function TPointerArray.GetData(index: Cardinal): Pointer;
  2066.   Begin
  2067.     If ValidIndex( index ) Then
  2068.       Result := PPArray( Memory )^[ index ]
  2069.     Else
  2070.       Result := Nil;
  2071.   End; { TPointerArray.GetData }
  2072.  
  2073. Procedure TPointerArray.FreeItem( item: Pointer );
  2074.   Begin
  2075.     (* this is a nop for this class since we do not know what item
  2076.        points to *)
  2077.   End; { TPointerArray.FreeItem }
  2078.  
  2079. (* calls FreeItem of each of the items in range and sets the item
  2080.    to nil *)
  2081. Procedure TPointerArray.InvalidateItems(atIndex, numItems: Cardinal);
  2082.   Var 
  2083.     n: Cardinal;
  2084.     p: Pointer;
  2085.   Begin
  2086.     If (numItems > 0) and HasFlag( AF_OwnsData ) Then
  2087.     If ValidateBounds( atIndex, numItems ) Then 
  2088.       For n := atIndex To Pred( numItems+atIndex ) Do Begin
  2089.         p:= AsPtr[ n ];
  2090.         If p <> Nil Then Begin
  2091.           FreeItem( p );
  2092.           p := Nil;
  2093.           PutItem(n, p);
  2094.         End;
  2095.       End; { For }
  2096.   End; { TPointerArray.InvalidateItems }
  2097.  
  2098. (* this version of CloneItem does nothing since we have no info on 
  2099.    the memory item points to. A descendent class would override this
  2100.    method to provide a deep copy of item *)
  2101. Function TPointerArray.CloneItem( item: Pointer ): Pointer; 
  2102.   Begin
  2103.     Result := item;
  2104.   End; { TPointerArray.CloneItem }
  2105.   
  2106. (* since we need to save at least the number of items in the array in
  2107.    addition to the data we take the easy way out and realize file
  2108.    save via stream. *)
  2109. Procedure TPointerArray.SaveToFile( Const Filename: String );
  2110.   Var
  2111.     S: TFileStream;
  2112.   Begin
  2113.     S:= TFileStream.Create( Filename, fmCreate );
  2114.     try
  2115.       SaveToStream( S );
  2116.     finally
  2117.       S.Free
  2118.     end;
  2119.   End; { TPointerArray.SaveToFile }
  2120.  
  2121. Procedure TPointerArray.LoadFromFile( Const Filename: String );
  2122.   Var
  2123.     S: TFileStream;
  2124.   Begin
  2125.     S:= TFileStream.Create( Filename, fmOpenRead or fmShareDenyWrite );
  2126.     try
  2127.       LoadFromStream( S );
  2128.     finally
  2129.       S.Free
  2130.     end;
  2131.   End; { TPointerArray.LoadFromFile }
  2132.  
  2133. (* write first the size of the array then call SaveItemToStream for
  2134.    each item *)
  2135. Procedure TPointerArray.SaveToStream( Stream: TStream );
  2136.   Var
  2137. {$IFDEF WIN32}
  2138.     temp: Cardinal;
  2139. {$ELSE}
  2140.     temp: LongInt;
  2141. {$ENDIF}
  2142.     n: Cardinal;
  2143.   Begin
  2144.     temp := Count;
  2145.     With Stream Do Begin
  2146.       Write( temp, Sizeof( temp ));
  2147.       For n := 0 To MaxIndex Do Begin
  2148.         SaveItemToStream( Stream, AsPtr[ n ] );
  2149.       End; { For }
  2150.     End; { With }
  2151.   End; { TPointerArray.SaveToStream }
  2152.  
  2153. Procedure TPointerArray.LoadFromStream( Stream: TStream );
  2154.   Var
  2155. {$IFDEF WIN32}
  2156.     temp: Cardinal;
  2157. {$ELSE}
  2158.     temp: LongInt;
  2159. {$ENDIF}
  2160.     n: Cardinal;
  2161.     P: Pointer;
  2162.   Begin
  2163.     With Stream Do Begin
  2164.       Read( temp, Sizeof( temp ));
  2165.       InvalidateItems( 0, Count );
  2166.       Redim( temp );
  2167.       For n := 0 To MaxIndex Do Begin
  2168.         LoadItemfromStream( Stream, P );
  2169.         (* we use PutItem here because otherwise we would end up
  2170.            with a _copy_ of the data in P^ beeing stored, if
  2171.            CopyItem implements deep copy! *)
  2172.         PutItem( n, P );
  2173.       End; { For }
  2174.     End; { With }
  2175.   End; { TPointerArray.LoadFromStream }
  2176.  
  2177. Procedure TPointerArray.SaveItemToStream( S: TStream; Item: Pointer ); 
  2178.   Begin
  2179.     raise
  2180.       Exception.Create(
  2181.         'Call to abstract method: TPointerArray.SaveItemToStream');
  2182.       (* depends on data stored *)
  2183.   End; { TPointerArray.SaveItemToStream }
  2184.  
  2185. Procedure TPointerArray.LoadItemFromStream( S: TStream; Var Item: Pointer );
  2186.   Begin
  2187.     raise
  2188.       Exception.Create(
  2189.         'Call to abstract method: TPointerArray.LoadItemFromStream');
  2190.   End; { TPointerArray.LoadItemFromStream }
  2191.  
  2192. {+--------------------------
  2193.  | Methods of TPcharArray  
  2194.  +-------------------------}
  2195. Constructor TPcharArray.Create( itemcount, dummy: Cardinal );
  2196.   Begin
  2197.     inherited Create( itemcount, Sizeof( Pointer ));
  2198.     Flags := [ AF_OwnsData, AF_AutoSize, AF_CanCompare ];
  2199.     CompareProc := CmpPChars;
  2200.   End; { TPcharArray.Create }
  2201.  
  2202. Procedure TPcharArray.PutData( index: Cardinal; value: PChar );
  2203.   Begin
  2204.     inherited PutData( index, Pointer( value ));
  2205.   End; { TPcharArray.PutData }
  2206.  
  2207. Function TPcharArray.GetData(index: Cardinal): PChar;
  2208.   Begin
  2209.     Result := inherited GetData( index );
  2210.   End; { TPcharArray.GetData }
  2211.  
  2212. Function TPcharArray.CloneItem( item: Pointer ): Pointer;
  2213.   Begin
  2214.     If HasFlag( AF_OwnsData ) Then
  2215.       If item <> Nil Then
  2216.         Result := StrNew( item )
  2217.       Else
  2218.         Result := Nil
  2219.     Else
  2220.       Result := item;
  2221.   End; { TPcharArray.CloneItem }
  2222.  
  2223. Procedure TPcharArray.FreeItem( item: Pointer );
  2224.   Begin
  2225.     If HasFlag(  AF_OwnsData ) Then 
  2226.       StrDispose( item );
  2227.   End; { TPcharArray.FreeItem }
  2228.  
  2229. Procedure TPcharArray.SaveItemToStream( S: TStream; Item: Pointer );
  2230.   Var
  2231.     pStr: PChar absolute Item;
  2232.     len: Cardinal;
  2233.   Begin
  2234.     (* we write the pchar with length in front and including the
  2235.        terminating zero! *)
  2236.     If item = Nil Then
  2237.       len := 0
  2238.     else
  2239.       len := StrLen( pStr );
  2240.     S.Write( len, Sizeof( Len ));
  2241.     If len > 0 Then
  2242.       S.Write( pStr^, len+1 );
  2243.   End; { TPcharArray.SaveItemToStream }
  2244.  
  2245. Procedure TPcharArray.LoadItemFromStream( S: TStream; Var Item: Pointer );
  2246.   Var
  2247.     len: Cardinal;
  2248.   Begin
  2249.     S.Read( len, Sizeof( len ));
  2250.     If len > 0 Then Begin
  2251.       Item := StrAlloc( len+1 );
  2252.       S.Read( Item^, len+1 );
  2253.     End { If }
  2254.     Else
  2255.       Item := Nil;
  2256.   End; { TPcharArray.LoadItemFromStream }
  2257.  
  2258. Procedure TPcharArray.PutAsString( index: Cardinal; Const value: String );
  2259.   Var 
  2260.     pStr: PChar;
  2261.   Begin
  2262.     pStr := StrAlloc( Length( value )+1 );
  2263.     try
  2264.       StrPCopy( pStr, value );
  2265.       FreeItem( GetData( index ));
  2266.       PutItem( index, pStr );
  2267.     except
  2268.       StrDispose( pStr );
  2269.       raise
  2270.     end;
  2271.   End; { TPcharArray.PutAsString }
  2272.  
  2273. Function TPcharArray.GetAsString(index: Cardinal): String;
  2274.   Var
  2275.     pStr: PChar;
  2276.   Begin
  2277.     pStr := GetData( index );
  2278.     If pStr <> Nil Then 
  2279.       Result := StrPas( pStr )
  2280.     Else
  2281.       Result := EmptyStr;
  2282.   End; { TPcharArray.GetAsString }
  2283.  
  2284. Procedure TPcharArray.PutAsInteger( index: Cardinal; value: LongInt );
  2285.   Begin
  2286.     PutAsString( index, IntToStr( value ));
  2287.   End; { TPcharArray.PutAsInteger }
  2288.  
  2289. Function TPcharArray.GetAsInteger(index: Cardinal): LongInt;
  2290.   Begin
  2291.     try
  2292.       Result := StrToInt( GetAsString( index ));
  2293.     except
  2294.       Result := 0
  2295.     end;
  2296.   End; { TPcharArray.GetAsInteger }
  2297.  
  2298. Procedure TPcharArray.PutAsReal( index: Cardinal; value: Extended );
  2299.   Begin
  2300.     PutAsString( index, FloatToStr( value ));
  2301.   End; { TPcharArray.PutAsReal }
  2302.  
  2303. Function TPcharArray.GetAsReal(index: Cardinal): Extended;
  2304.   Begin
  2305.     try
  2306.       Result := StrToFloat( GetAsString( index ));
  2307.     except
  2308.       Result := 0.0
  2309.     end;
  2310.   End; { TPcharArray.GetAsReal }
  2311.  
  2312. Function GetFileSize( Const Filename: String): LongInt;
  2313.   Var
  2314.     SRec: TSearchRec;
  2315.   Begin
  2316.     If FindFirst( Filename, faAnyfile, SRec ) = 0 Then
  2317.       Result := SRec.Size
  2318.     Else
  2319.       Result := 0;
  2320.     FindClose(SRec);
  2321.   End;
  2322.  
  2323. Procedure TPcharArray.LoadFromTextfile( Const Filename: String;
  2324.                                         appendData: Boolean;
  2325.                                         reporter: TProgressReporter );
  2326.   Type
  2327.     TLine = Array [ 0..$8000 ] Of Char;
  2328.     TBuf  = Array [ 0..$3fff ] of Char;
  2329.   Var
  2330.     pBuf: ^TBuf;
  2331.     F: TextFile;
  2332.     lines, currpos: Cardinal;
  2333.     line: ^TLine;
  2334.     fsize, sum: LongInt;
  2335.     retain: Boolean;
  2336.   Begin
  2337.     (* open file for read *)
  2338.     fsize := GetFilesize(Filename);
  2339.     If fsize = 0 Then Exit;
  2340.  
  2341.     AssignFile( F, Filename );
  2342.     pBuf := Nil;
  2343.     New(pBuf);
  2344.     try
  2345.       System.SetTextBuf( F, pBuf^, Sizeof( pBuf^ ));
  2346.       Reset( F );
  2347.       line := Nil;
  2348.       try
  2349.         New( line );
  2350.         (* prepare array by blasting all items in it if we are not
  2351.            asked to append the new data, set currpos to the first
  2352.            index we put new data in *)
  2353.         If not appendData Then Begin
  2354.           Zap;
  2355.           currpos := 0;
  2356.         End { If }
  2357.         Else
  2358.           currpos := Count;
  2359.         (* get a very rough estimate of the number of lines in the file *)
  2360.         If (LongInt(MaxCapacity)*20) < FSize Then
  2361.           lines := MaxCapacity
  2362.         Else
  2363.           lines := FSize div 20;
  2364.  
  2365.         (* resize the array so the new lines will ( hopefully ) fit without
  2366.            to many redims in between *)
  2367.         If appendData Then
  2368.           Redim( Count+lines )
  2369.         Else
  2370.           Redim( lines );
  2371.  
  2372.         (* now start reading lines *)
  2373.         sum := 0;
  2374.         While not Eof( F ) Do Begin
  2375.           ReadLn( F, line^ );
  2376.           If currpos = Capacity Then
  2377.             If currpos = MaxCapacity Then
  2378.               raise EFileTooLarge.CreateFmt( ErrFileTooLarge, [filename]  )
  2379.             Else
  2380.               Redim( Capacity+100 );
  2381.           PutData( currpos, PChar(line) );
  2382.           If @reporter <> Nil Then Begin
  2383.             sum := sum+StrLen( PChar(line) )+2;
  2384.             If not reporter( sum, fsize, retain ) Then Begin
  2385.               If not retain Then
  2386.                 Delete( 0, currpos+1 );
  2387.               Break;
  2388.             End;
  2389.           End;
  2390.           Inc( currpos );
  2391.         End; { While }
  2392.         If currpos < Capacity Then
  2393.           Redim( currpos );
  2394.       finally
  2395.         CloseFile( F );
  2396.         If line <> Nil Then
  2397.           Dispose( line );
  2398.       end;
  2399.     finally
  2400.       Dispose( pBuf );
  2401.     end;
  2402.   End; { TPcharArray.LoadFromTextfile }
  2403.  
  2404. Procedure TPcharArray.SaveToTextfile( Const Filename: String;
  2405.                                        appendData: Boolean;
  2406.                                        reporter: TProgressReporter );
  2407.   Type
  2408.     TBuf  = Array [ 0..$3fff ] of Char;
  2409.   Var
  2410.     pBuf: ^TBuf;
  2411.     F: TextFile;
  2412.     n: Cardinal;
  2413.     total, sum: LongInt;
  2414.     retain: Boolean;
  2415.     p: PChar;
  2416.   Begin
  2417.     (* calculate total size of text to save, including CR-LF lineends *)
  2418.     total := 0;
  2419.     For n := 0 To Count-1 Do Begin
  2420.       p := Data[ n ];
  2421.       If p <> Nil Then
  2422.         total := total + StrLen( p ) + 2
  2423.       Else
  2424.         Inc( total, 2 );  (* nil strings produce an empty line in the file *)
  2425.     End; { For }
  2426.     (* assign the file and give it a text buffer to speed up file I/O *)
  2427.     AssignFile( F, Filename );
  2428.     pBuf := Nil;
  2429.     New(pBuf);
  2430.     try
  2431.       System.SetTextBuf( F, pBuf^, Sizeof( pBuf^ ));
  2432.       (* open the file *)
  2433.       If appendData Then
  2434.         System.Append( F )
  2435.       Else
  2436.         System.Rewrite( F );
  2437.       try
  2438.         (* write the text *)
  2439.         sum := 0;
  2440.         retain := True;
  2441.         For n := 0 To Count-1 Do Begin
  2442.           p := Data[ n ];
  2443.           If p <> Nil Then
  2444.             WriteLn( F, p )
  2445.           Else
  2446.             WriteLn( F );
  2447.           (* report progress if someone is listening *)
  2448.           If @reporter <> Nil Then Begin
  2449.             If p <> Nil Then
  2450.               sum := sum+StrLen( p )+2
  2451.             Else
  2452.               Inc( sum, 2 );
  2453.             If not reporter( sum, total, retain ) Then
  2454.               break;
  2455.           End; { If }
  2456.         End; { For }
  2457.       finally
  2458.         CloseFile( F );
  2459.         If not retain Then
  2460.           Erase( F );
  2461.       end;
  2462.     finally
  2463.       Dispose( pBuf );
  2464.     end;
  2465.   End; { TPcharArray.SaveToTextfile }
  2466.  
  2467. {+--------------------------
  2468.  | Methods of TPStringArray
  2469.  +-------------------------}
  2470. Constructor TPStringArray.Create( itemcount, dummy: Cardinal );
  2471.   Begin
  2472.     inherited Create( itemcount, Sizeof( Pointer ));
  2473.     Flags := [ AF_OwnsData, AF_AutoSize, AF_CanCompare ];
  2474.     CompareProc := CmpPStrings;
  2475.   End; { TPStringArray.Create }
  2476.  
  2477. Procedure TPStringArray.PutData( index: Cardinal; Const value: String );
  2478.   Begin
  2479.     inherited PutData( index, @value )
  2480.   End; { TPStringArray.PutData }
  2481.  
  2482. Function TPStringArray.GetData(index: Cardinal): String;
  2483.   Var
  2484.     p: Pointer;
  2485.   Begin
  2486.     p := inherited GetData( index );
  2487.     If p = Nil Then
  2488.       Result := EmptyStr
  2489.     Else
  2490.       Result := PString( p )^;
  2491.   End; { TPStringArray.GetData }
  2492.  
  2493. Function TPStringArray.GetAsPtr(index: Cardinal): PString;
  2494.   Begin
  2495.     Result := PString( inherited GetData( index ));
  2496.   End; { TPStringArray.GetAsPtr }
  2497.  
  2498.  
  2499. Function TPStringArray.CloneItem( item: Pointer ): Pointer;
  2500.   Begin
  2501.     If HasFlag( AF_OwnsData ) Then
  2502.       If item <> Nil Then
  2503.         Result := NewStr( PString( item )^ )
  2504.       Else
  2505.         Result := Nil
  2506.     Else
  2507.       Result := item;
  2508.   End; { TPStringArray.CloneItem }
  2509.  
  2510. Procedure TPStringArray.FreeItem( item: Pointer );
  2511.   Begin
  2512.     If HasFlag(  AF_OwnsData ) Then 
  2513.       DisposeStr( PString( item ));
  2514.   End; { TPStringArray.FreeItem }
  2515.  
  2516. Procedure TPStringArray.SaveItemToStream( S: TStream; Item: Pointer );
  2517.   Var
  2518.     len: Cardinal;
  2519.   Begin
  2520.     If  item = Nil Then 
  2521.       len := 0
  2522.     else
  2523.       len := Length( PString( item )^ );
  2524.     If len > 0 Then
  2525.       S.Write( Item^, len+1 )
  2526.     Else
  2527.       S.Write( len, 1 );
  2528.   End; { TPStringArray.SaveItemToStream }
  2529.  
  2530. Procedure TPStringArray.LoadItemFromStream( S: TStream; Var Item: Pointer );
  2531.   Var
  2532.     Str  : String;
  2533.   Begin
  2534.     S.Read( Str, 1 );
  2535.     If Length( Str ) > 0 Then
  2536.       S.Read( Str[ 1 ], Length( Str ));
  2537.     Item := NewStr( Str );
  2538.   End; { TPStringArray.LoadItemFromStream }
  2539.  
  2540. Procedure TPStringArray.PutAsPChar( index: Cardinal; value: PChar );
  2541.   Begin
  2542.     If value = Nil Then 
  2543.       PutData( index, EmptyStr )
  2544.     Else
  2545.       PutData( index, StrPas( value ));
  2546.   End; { TPStringArray.PutAsPChar }
  2547.  
  2548. Function TPStringArray.GetAsPChar(index: Cardinal): PChar;
  2549.   Var
  2550.     pStr: PString;
  2551.   Begin
  2552.     pStr := GetAsPtr( index );
  2553.     If pStr = Nil Then
  2554.       Result := Nil
  2555.     Else Begin
  2556.       Result := StrAlloc( Length( pStr^ )+1 );
  2557.       StrPCopy( Result, pStr^ );
  2558.     End;
  2559.   End; { TPStringArray.GetAsPChar }
  2560.  
  2561. Procedure TPStringArray.PutAsInteger( index: Cardinal; value: LongInt );
  2562.   Begin
  2563.     PutData( index, IntToStr( value ));
  2564.   End; { TPStringArray.PutAsInteger }
  2565.  
  2566. Function TPStringArray.GetAsInteger(index: Cardinal): LongInt;
  2567.   Begin
  2568.     try
  2569.       Result := StrToInt( GetData( index ));
  2570.     except
  2571.       Result := 0;
  2572.     end;
  2573.   End; { TPStringArray.GetAsInteger }
  2574.  
  2575. Procedure TPStringArray.PutAsReal( index: Cardinal; value: Extended );
  2576.   Begin
  2577.     PutData( index, FloatToStr( value ));
  2578.   End; { TPStringArray.PutAsReal }
  2579.  
  2580. Function TPStringArray.GetAsReal(index: Cardinal): Extended;
  2581.   Begin
  2582.     try
  2583.       Result := StrToFloat( GetData( index ));
  2584.     except
  2585.       Result := 0.0;
  2586.     end;
  2587.   End; { TPStringArray.GetAsReal }
  2588.  
  2589. Procedure TPStringArray.LoadFromTextfile( Const Filename: String;
  2590.                                         appendData: Boolean;
  2591.                                         reporter: TProgressReporter );
  2592.   Type
  2593.     TBuf  = Array [ 0..$3fff ] of Char;
  2594.   Var
  2595.     pBuf: ^TBuf;
  2596.     F: TextFile;
  2597.     lines, currpos: Cardinal;
  2598.     line: String;
  2599.     fsize: LongInt;
  2600.     sum: LongInt;
  2601.     retain: Boolean;
  2602.   Begin
  2603.     (* open file for read *)
  2604.     fsize := GetFilesize(Filename);
  2605.     If fsize = 0 Then Exit;
  2606.  
  2607.     AssignFile( F, Filename );
  2608.     pBuf := Nil;
  2609.     New(pBuf);
  2610.     try
  2611.       System.SetTextBuf( F, pBuf^, Sizeof( pBuf^ ));
  2612.       Reset( F );
  2613.       try
  2614.         (* prepare array by blasting all items in it if we are not
  2615.            asked to append the new data, set currpos to the first
  2616.            index we put new data in *)
  2617.         If not appendData Then Begin
  2618.           Zap;
  2619.           currpos := 0;
  2620.         End { If }
  2621.         Else
  2622.           currpos := Count;
  2623.  
  2624.         (* get a very rough estimate of the number of lines in the file. *)
  2625.         If (LongInt(MaxCapacity)*20) < FSize Then
  2626.           lines := MaxCapacity
  2627.         Else
  2628.           lines := FSize div 20;
  2629.  
  2630.         (* resize the array so the new lines will ( hopefully ) fit without
  2631.            to many redims in between *)
  2632.         If appendData Then
  2633.           Redim( Count+lines )
  2634.         Else
  2635.           Redim( lines );
  2636.  
  2637.         (* now start reading lines *)
  2638.         sum := 0;
  2639.         While not Eof( F ) Do Begin
  2640.           ReadLn( F, line );
  2641.           If currpos = Capacity Then
  2642.             If currpos = MaxCapacity Then
  2643.               raise EFileTooLarge.CreateFmt( ErrFileTooLarge, [filename]  )
  2644.             Else
  2645.               Redim( Capacity+100 );
  2646.           PutData( currpos, line );
  2647.           If @reporter <> Nil Then Begin
  2648.             sum := sum+Length( line )+2;
  2649.             If not reporter( sum, fsize, retain ) Then Begin
  2650.               If not retain Then
  2651.                 Delete( 0, currpos+1 );
  2652.               Break;
  2653.             End;
  2654.           End;
  2655.           Inc( currpos );
  2656.         End; { While }
  2657.         If currpos < Capacity Then
  2658.           Redim( currpos );
  2659.       finally
  2660.         CloseFile( F );
  2661.       end;
  2662.     finally
  2663.       Dispose(pBuf);
  2664.     end;
  2665.   End; { TPStringArray.LoadFromTextfile }
  2666.  
  2667. Procedure TPStringArray.SaveToTextfile( Const Filename: String;
  2668.                                        appendData: Boolean;
  2669.                                        reporter: TProgressReporter );
  2670.   Type
  2671.     TBuf  = Array [ 0..$3fff ] of Char;
  2672.   Var
  2673.     pBuf: ^TBuf;
  2674.     F: TextFile;
  2675.     n: Cardinal;
  2676.     total, sum: LongInt;
  2677.     retain: Boolean;
  2678.     p: PString;
  2679.   Begin
  2680.     (* calculate total size of text to save, including CR-LF lineends *)
  2681.     total := 0;
  2682.     For n := 0 To Count-1 Do Begin
  2683.       p := AsPString[n];
  2684.       If p <> Nil Then
  2685.         total := total + Length( p^ ) + 2
  2686.       Else
  2687.         Inc( total, 2 );  (* nil strings produce an empty line in the file *)
  2688.     End; { For }
  2689.     AssignFile( F, Filename );
  2690.     pBuf := Nil;
  2691.     New(pBuf);
  2692.     try
  2693.       System.SetTextBuf( F, pBuf^, Sizeof( pBuf^ ));
  2694.       If appendData Then
  2695.         System.Append( F )
  2696.       Else
  2697.         System.Rewrite( F );
  2698.       try
  2699.         (* write the text *)
  2700.         sum := 0;
  2701.         retain := True;
  2702.         For n := 0 To Count-1 Do Begin
  2703.           p := AsPString[n];
  2704.           If p <> Nil Then
  2705.             WriteLn( F, p^ )
  2706.           Else
  2707.             WriteLn( F );
  2708.           (* report progress if someone is listening *)
  2709.           If @reporter <> Nil Then Begin
  2710.             If p <> Nil Then
  2711.               sum := sum+Length( p^ )+2
  2712.             Else
  2713.               Inc( sum, 2 );
  2714.             If not reporter( sum, total, retain ) Then
  2715.               break;
  2716.           End; { If }
  2717.         End; { For }
  2718.       finally
  2719.         CloseFile( F );
  2720.         If not retain Then
  2721.           Erase( F );
  2722.       end;
  2723.     finally
  2724.       Dispose( pBuf );
  2725.     end;
  2726.   End; { TPStringArray.SaveToTextfile }
  2727. {+----------------------
  2728.  | Auxillary procedures
  2729.  +----------------------}
  2730. Function CmpIntegers( Var item1, item2 ): Integer; 
  2731.   Var
  2732.     i1: Integer absolute item1;
  2733.     i2: Integer absolute item2;
  2734.   Begin
  2735.     Result := i1-i2;
  2736.   End;
  2737.  
  2738. Function CmpCardinals( Var item1, item2  ): Integer; 
  2739.   Var
  2740.     i1: Cardinal absolute item1;
  2741.     i2: Cardinal absolute item2;
  2742.   Begin
  2743.     If i1 < i2 Then 
  2744.       Result := -1
  2745.     Else
  2746.       If i1 > i2 Then
  2747.         Result := 1
  2748.       Else
  2749.         Result := 0;
  2750.   End;
  2751.  
  2752. Function CmpLongs( Var item1, item2 ): Integer;
  2753.   Var
  2754.     i1: LongInt absolute item1;
  2755.     i2: LongInt absolute item2;
  2756.   Begin
  2757.     If i1 < i2 Then 
  2758.       Result := -1
  2759.     Else
  2760.       If i1 > i2 Then
  2761.         Result := 1
  2762.       Else
  2763.         Result := 0;
  2764.   End;
  2765.  
  2766. Function CmpReals( Var item1, item2 ): Integer;
  2767.   Var
  2768.     i1: Real absolute item1;
  2769.     i2: Real absolute item2;
  2770.     r: Real;
  2771.   Begin
  2772.     r := i1-i2;
  2773.     If Abs( r ) < 1.0E-30 Then
  2774.       result := 0
  2775.     Else
  2776.       If r < 0 Then
  2777.         result := -1
  2778.       Else
  2779.         result := 1;
  2780.   End;
  2781.  
  2782. Function CmpSingles(Var item1, item2 ): Integer;
  2783.   Var
  2784.     i1: Single absolute item1;
  2785.     i2: Single absolute item2;
  2786.     r: Single;
  2787.   Begin
  2788.     r := i1-i2;
  2789.     If Abs( r ) < 1.0E-30 Then
  2790.       result := 0
  2791.     Else
  2792.       If r < 0 Then
  2793.         result := -1
  2794.       Else
  2795.         result := 1;
  2796.   End;
  2797.  
  2798. Function CmpDoubles(Var item1, item2 ): Integer;
  2799.   Var
  2800.     i1: Double absolute item1;
  2801.     i2: Double absolute item2;
  2802.     r: Double;
  2803.   Begin
  2804.     r := i1-i2;
  2805.     If Abs( r ) < 1.0E-100 Then
  2806.       result := 0
  2807.     Else
  2808.       If r < 0 Then
  2809.         result := -1
  2810.       Else
  2811.         result := 1;
  2812.   End;
  2813.  
  2814. Function CmpExtendeds( Var item1, item2 ): Integer;
  2815.   Var
  2816.     i1: Extended absolute item1;
  2817.     i2: Extended absolute item2;
  2818.     r: Extended;
  2819.   Begin
  2820.     r := i1-i2;
  2821.     If Abs( r ) < 1.0E-3000 Then
  2822.       result := 0
  2823.     Else
  2824.       If r < 0 Then 
  2825.         result := -1
  2826.       Else
  2827.         result := 1;
  2828.   End;
  2829.  
  2830. Function CmpPChars( Var item1, item2 ): Integer;
  2831.   Var
  2832.     p1: PChar absolute item1;
  2833.     p2: PChar absolute item2;
  2834.   Begin
  2835.     Result := lstrcmp( p1, p2 );
  2836.   End;
  2837.  
  2838. Function CmpPStrings( Var item1, item2 ): Integer;
  2839.   Var
  2840.     p1: PString absolute item1;
  2841.     p2: PString absolute item2;
  2842.   Begin
  2843.     Result := AnsiCompareStr( p1^, p2^ );
  2844.   End;
  2845.  
  2846. End.
  2847.