Objects7      V1.0    Borland's Objects-unit from BP 7.0 ported to DELPHI
-------------------------------------------------------------------------

(C) 1995 Guy Fink, Luxembourg, Europe

No garantees expressed ore implied !

This units are freeware, but are NOT RELEASED TO THE PUBLIC DOMAIN!
So please distribute only unmodified versions!

Included units :

SysTools      V1.0
ExtObjects    V1.0
Objects7      V1.0

This is my port of the Objects-unit from BP 7.0 to DELPHI.

It includes mainly TCollection, TSortedCollection, TStringCollection,
TStrCollection and a TStream-class which is able to write classes derived
from TStreamableObject to a Stream.

The functionalty from the old Borland objects are fully avaible, but I
implemented some new features too.

All objects in this units are derived from a new class - TExtendedObject.
This class defines the basics for the new features.

  TExtendedObject = CLASS(TObject)
    PUBLIC
      DESTRUCTOR Destroy; OVERRIDE;
      PROCEDURE ClearData; VIRTUAL;
      CONSTRUCTOR CloneFrom( Source         : TExtendedObject;
                             DupDynamicData : BOOLEAN);
      FUNCTION Duplicate(DupDynamicData : BOOLEAN) : TExtendedObject;
      FUNCTION CopyData2(Destination : TExtendedObject) : BOOLEAN;
      FUNCTION DupData2(Destination : TExtendedObject) : BOOLEAN; VIRTUAL;
      FUNCTION MoveData2(Destination : TExtendedObject) : BOOLEAN;
  END;

Destroy calls ClearData before it destroys the object. So it is not necessary
to overide this destructor in derived classes. Only ClearData must be
overritten.

ClearData clears the object's data space. Any dynamic fields must be disposed
BEFORE the inherited method is called !!!. It is possible that the instance
has been already cleared when this procedure is called, so carefully check all
pointers ! This procedure has only to be overritten if the child class uses
dynamic fields.

CloneFrom creates an object, and initializes it with the data from Source.
Source has not to be from same type, but may be one of the object's anchestors.
If DupDynamicData is true CloneFrom uses Source.DupData2(Self) to duplicate any
dynamic fields in the object, else it uses Source.CopyData2(Self) and pointers
will point to the same location in both objects.

Duplicate creates a new object of same type and initializes it with the data
from Self. If DupDynamicData is true Duplicate uses DupData2 to duplicate any
dynamic fields in the object, else it uses CopyData2 and dynamic fields will
point to the same location in both objects.

CopyData2 simply copies the dataspace from Self to Destination. Destination
has not to be from same type, but may be a derived class. In this case only
the known dataspace is copied. It is the callers responsibility to garantee
that no dynamic fields in Destination are overritten !!!

DupData2 duplicates the data from Self to Destination. Dynamic fields must
be duplicated. If DupData2 is overitten it must FIRST call the inherited
method !!! The DupData2 method from TExtendedObject uses CopyData2 to produce
a copy of all pointers in the object. These pointers can be used to create
new instances of the dynamic fields. This procedure has only to be overritten
if the child class uses dynamic fields.

MoveData2 uses CopyData2 to copy the data from Self to Destination. Thereafter
it calls InitInstance to clear the object's dataspace and ClearData to make the
object know that it has been cleared.

TStreamableObject is derived from this class. It is the base class for all
classes who may be written to a stream.

  TStreamableObject = CLASS(TExtendedObject)
  PUBLIC
    CLASS FUNCTION GetRegistrationCode : CARDINAL; VIRTUAL; ABSTRACT;
    CONSTRUCTOR Load(S : TObjectStream; RCode : CARDINAL); VIRTUAL; ABSTRACT;
    PROCEDURE Store(S : TObjectStream); VIRTUAL; ABSTRACT;
  END;

  TStreamClass = CLASS OF TStreamableObject;

I've changed the registration mechanism completly. The type TStreamRec is no
longer available. Because DELPHI knows virtual constructors and class methods
it is of no use. The Registration of an object is done by :

  PROCEDURE RegisterNewObject(CType : TStreamClass);

This procedure gets the registration code itself by calling the class method
GetRegistrationCode. It is only necessary to register a class for which you
will write instances to a stream. But every class which writes something to
a stream must have a registration code!

The Load method is implemented as a virtual constructor.

Included is the possibility of an automatic version control. If you changed
the structure of an object under BP you had to change the typenumber too and
give the old typenumber a special processing, or convert existing streams by
some way. This is only acceptable if the object hierarchy is small. Because
the change to one object meant to change ALL the typenumbers for derived
objects!

To avoid this, I've introduced the parameter RCode to Load. Under BP only the
typenumber for the instance to store was written to the stream. My model uses
a registration code for all classes in the hierarchy.

An example:

PROCEDURE TSortedCollection.Store(S: TObjectStream);

BEGIN
  S.WriteParentCode(TSortedCollection);
  INHERITED Store(S);
  S.Write(FDuplicates, SizeOf(FDuplicates)*2);
END;

The method S.WriteParentCode gets the registration code for the parent class
and writes it to the stream. It is not necessary for the parent class to be
registered. Then the parent fields are written.

TSortedCollection has the registration code 250. When you load the class from
the stream you do the following :

CONSTRUCTOR TSortedCollection.Load(S: TObjectStream; RCode : CARDINAL);

BEGIN
  IF RCode <> 250 THEN
    INHERITED Load(S, 0)
  ELSE
    INHERITED Load(S, S.ReadParentCode(TSortedCollection));
  S.Read(FDuplicates, SizeOf(FDuplicates)*2);
END;

If RCode = 0 then the stream was written with BP 7.0 and TCollection.Load is
called with RCode:=0 also, otherwise we read the parent code and call
TCollection.Load.

If you change the fields of a class, you give this class a new registration
code, and the old code is registered with (only if there will be instances of
the class):

  PROCEDURE RegisterObject( CType : TStreamClass; RCode : CARDINAL);

In the Load constructor it is now possible to check against the old code and
load the appropriate fields :

CONSTRUCTOR TSortedCollection.Load(S: TObjectStream; RCode : CARDINAL);

BEGIN
  CASE RCode OF
    0   : INHERITED Load(S, 0)          { BP 7.0 Stream }
    250 : BEGIN                         { the old code }
            INHERITED Load(S, S.ReadParentCode(TSortedCollection));
            S.Read(FDuplicates, SizeOf(FDuplicates)*2);
*******     initialze the new fields to their defaults
          END;
    251 : BEGIN                         { the new code }
            INHERITED Load(S, S.ReadParentCode(TSortedCollection));
*******     load the new fields
          END;
END;

This is fully compatible with BP 7.0 and you can read all your old streams.

Here is the interface part of TObjectStream :

  TObjectStream = CLASS(TExtendedObject)
  PRIVATE
    FStream	: TStream;
    FCloseFile	: BOOLEAN;
  PROTECTED
    FUNCTION GetPosition : LONGINT;
    PROCEDURE SetPosition(Pos : LONGINT);
    FUNCTION GetSize : LONGINT;
    FUNCTION GetHandle : INTEGER;
    FUNCTION GetMemory : POINTER;
  PUBLIC
    CONSTRUCTOR Create;
    CONSTRUCTOR InitHandleStream(AHandle : INTEGER);
    CONSTRUCTOR InitFileStream(CONST FileName : STRING; Mode : Word);

    PROCEDURE ClearData; OVERRIDE;
    FUNCTION DupData2(Destination	: TExtendedObject) : BOOLEAN; OVERRIDE;
    FUNCTION DuplicateStream(Destination: TExtendedObject) : BOOLEAN; VIRTUAL;

    FUNCTION Get : TStreamableObject;
    PROCEDURE Put(P : TStreamableObject);
    FUNCTION ReadParentCode(P : TStreamClass) : CARDINAL;
    PROCEDURE WriteParentCode(P : TStreamClass);
    PROCEDURE Flush; VIRTUAL;
    PROCEDURE Truncate; VIRTUAL;

    FUNCTION ReadStr : PSTRING;
    FUNCTION StrRead : PCHAR;

    PROCEDURE WriteStr(P : PSTRING);
    PROCEDURE StrWrite(P : PCHAR);

    FUNCTION Read(VAR Buffer; Count : LONGINT): LONGINT;
    FUNCTION Write(CONST Buffer; Count : LONGINT): LONGINT;
    FUNCTION Seek(Offset : LONGINT; Origin : Word): LONGINT;
    FUNCTION CopyFrom(Source : TStream; Count : LONGINT): LONGINT;
    PROPERTY Position : LONGINT READ GetPosition WRITE SetPosition;
    PROPERTY Size : LONGINT READ GetSize;
    PROPERTY Stream :TStream READ FStream;

    PROPERTY Handle : INTEGER READ GetHandle;
    PROPERTY CloseFile : BOOLEAN READ FCloseFile WRITE FCloseFile;

    PROCEDURE LoadFromStream(Stream : TStream);
    PROCEDURE LoadFromFile(CONST FileName : STRING);
    PROCEDURE SaveToStream(Stream : TStream);
    PROCEDURE SaveToFile(CONST FileName : STRING);
    PROCEDURE SetSize(Size : LONGINT);
    PROCEDURE Clear;
    PROPERTY Memory : POINTER READ GetMemory;
  END;


TCollection :

The main changes to BP 7.0 :

Insert is no longer virtual and therefore it is not necessary to override it.
Manipulations to the item to be inserted can be made in InsertItem which is
called by Insert, AtInsert, AtPut and AtReplace.

Because Free is used by DELPHI it has been replaced by Remove.

New are ClearData, DupData2 and DuplicateItem.

I implemented functions to use TCollection as an array, a stack (LIFO) or a
queue (FIFO).

{ TCollection object }

  TCollection = CLASS(TStreamableObject)
  PRIVATE
    FList	: TList;
  PROTECTED
    PROCEDURE CheckList;
    FUNCTION Get(Index: INTEGER): POINTER;
    PROCEDURE Put(Index: INTEGER; Item: POINTER);
  PUBLIC
    CONSTRUCTOR Create(ALimit : INTEGER);
    PROCEDURE ClearData; OVERRIDE;
    FUNCTION DupData2(Destination	: TExtendedObject) : BOOLEAN; OVERRIDE;

    CLASS FUNCTION GetRegistrationCode : CARDINAL; OVERRIDE;
    CONSTRUCTOR Load(S : TObjectStream; RCode : CARDINAL); OVERRIDE;
    PROCEDURE Store(S : TObjectStream); OVERRIDE;
    FUNCTION GetItem(S : TObjectStream): POINTER; VIRTUAL;
    PROCEDURE PutItem(S : TObjectStream; Item: POINTER); VIRTUAL;

    FUNCTION DuplicateItem(Item	: POINTER) : POINTER; VIRTUAL;

    FUNCTION InsertItem(Item : POINTER) : POINTER; VIRTUAL;
    PROCEDURE Insert(Item : POINTER); VIRTUAL;
    PROCEDURE AtInsert(Index : INTEGER; Item: POINTER);
    PROCEDURE AtPut(Index : INTEGER; Item: POINTER);
    PROCEDURE AtReplace(Index: INTEGER; Item: POINTER);

    FUNCTION At(Index : INTEGER): POINTER;
    FUNCTION IndexOf(Item : POINTER): INTEGER; VIRTUAL;

    PROCEDURE AtDelete(Index : INTEGER);
    PROCEDURE Delete(Item : POINTER);
    PROCEDURE DeleteAll;

    PROCEDURE FreeItem(Item : POINTER); VIRTUAL;
    PROCEDURE AtFree(Index : INTEGER);
    PROCEDURE Remove(Item : POINTER);
    PROCEDURE FreeAll;

    FUNCTION FirstThat(Test : POINTER): POINTER;
    PROCEDURE ForEach(Action : POINTER);
    FUNCTION LastThat(Test : POINTER): POINTER;

    PROCEDURE Pack;
    PROCEDURE SetLimit(ALimit : INTEGER);

    PROPERTY List  : TList READ FList;
{ Use TCollection as an array }
    PROPERTY Items[INDEX : INTEGER]: POINTER READ Get WRITE Put; DEFAULT;
{ Use TCollection as a Stack e.g. LIFO }
    PROCEDURE Push(Item : POINTER);
    FUNCTION Pop : POINTER;
    FUNCTION PeekTOS : POINTER;			{ TOS = Top of Stack }
    PROCEDURE ReplaceTOS(Item : POINTER);
    PROCEDURE SwapTOS;
    PROCEDURE PopFree;
{ Use TCollection as a Queue e.g. FIFO }
    PROCEDURE Write(Item : POINTER);
    FUNCTION Read : POINTER;
    FUNCTION Peek : POINTER;
    PROCEDURE Drop;
  END;


TSortedCollection :

Because TStringCollection and TStrCollection are derived from TSortedCollection
I added the property Sorted. By default this property is TRUE. You can change
this property to FALSE to handle unsorted Stringcollections. If one inserts
intems while this property is FALSE and then changes it to TRUE the collection
is sorted. Same procedure with the property Duplicates, if it is changed from
FALSE to TRUE, duplicates will be removed.

The original function IndexOf has a somewhat strange behaviour if duplicates
are allowed and you search for an item. In this case it is possible that
IndexOf does not find an item, even if it is there.
Example : You want to find the index of a string. Search will find the string
          if it is there, but IndexOf only returns a match if the memory
          address of the two strings are the same. If Duplicates are not
          allowed you always get a correct result.

Therefore I added FirstIndexOf which returns the first match from Search, and
LastIndexOf which returns the last match if Duplicates are allowed. Attention :
LastIndexOf will not return correct results if the collection is unsorted !

  TSortedCollection = CLASS(TCollection)
  PRIVATE
    FDuplicates,
    FNotSorted	: BOOLEAN;
  PROTECTED
    PROCEDURE AllowDuplicates(D : BOOLEAN);
    FUNCTION IsSorted : BOOLEAN;
    PROCEDURE SetSorted(S : BOOLEAN);
    PROCEDURE Sort;
  PUBLIC
    CLASS FUNCTION GetRegistrationCode : CARDINAL; OVERRIDE;
    CONSTRUCTOR Load(S : TObjectStream; RCode : CARDINAL); OVERRIDE;
    PROCEDURE Store(S : TObjectStream); OVERRIDE;

    FUNCTION IndexOf(Item : POINTER): INTEGER; OVERRIDE;
    FUNCTION FirstIndexOf(Item : POINTER): INTEGER;
    FUNCTION LastIndexOf(Item : POINTER): INTEGER;
    PROCEDURE Insert(Item : POINTER); OVERRIDE;
    FUNCTION Compare(Key1, Key2 : POINTER): INTEGER; VIRTUAL; ABSTRACT;
    FUNCTION KeyOf(Item : POINTER) : POINTER; VIRTUAL;
    FUNCTION Search(Key : POINTER; VAR Index: INTEGER) : BOOLEAN; VIRTUAL;
    PROPERTY Duplicates : BOOLEAN READ FDuplicates WRITE AllowDuplicates;
    PROPERTY Sorted : BOOLEAN READ IsSorted WRITE SetSorted;
  END;

TStringCollection :

Two new properties CaseSensitive and AnsiCharSet. By default this properties
are FALSE and the object behaves as under BP 7.0. If you change one or both of
this properties the collection is resorted to reflect these changes.

  TStringCollection = CLASS(TSortedCollection)
  PRIVATE
    FNotCaseSensitive,
    FAnsiCharSet       : BOOLEAN;
  PROTECTED
    FUNCTION IsCaseSensitive : BOOLEAN;
    PROCEDURE SetCaseSensitive(CS : BOOLEAN);
    PROCEDURE SetAnsiCharSet(ACS : BOOLEAN);
  PUBLIC
    CLASS FUNCTION GetRegistrationCode : CARDINAL; OVERRIDE;
    CONSTRUCTOR Load(S : TObjectStream; RCode : CARDINAL); OVERRIDE;
    PROCEDURE Store(S : TObjectStream); OVERRIDE;

    FUNCTION DuplicateItem(Item : POINTER) : POINTER; OVERRIDE;

    FUNCTION Compare(Key1, Key2 : POINTER) : INTEGER; OVERRIDE;
    PROCEDURE FreeItem(Item : POINTER); OVERRIDE;
    FUNCTION GetItem(S : TObjectStream): POINTER; OVERRIDE;
    PROCEDURE PutItem(S : TObjectStream; Item: POINTER); OVERRIDE;
    PROPERTY CaseSensitive: BOOLEAN READ IsCaseSensitive WRITE SetCaseSensitive;
    PROPERTY AnsiCharSet : BOOLEAN READ FAnsiCharSet WRITE SetAnsiCharSet;
  END;

TStrCollection :

To use the properties CaseSensitive and AnsiCharSet TStrCollection is derived
from TStringCollection and not from TSortedCollection.

  TStrCollection = CLASS(TStringCollection)
  PUBLIC
    CLASS FUNCTION GetRegistrationCode : CARDINAL; OVERRIDE;
    CONSTRUCTOR Load(S : TObjectStream; RCode : CARDINAL); OVERRIDE;
    PROCEDURE Store(S : TObjectStream); OVERRIDE;

    FUNCTION DuplicateItem(Item : POINTER) : POINTER; OVERRIDE;

    FUNCTION Compare(Key1, Key2 : POINTER) : INTEGER; OVERRIDE;
    PROCEDURE FreeItem(Item : POINTER); OVERRIDE;
    FUNCTION GetItem(S : TObjectStream) : POINTER; OVERRIDE;
    PROCEDURE PutItem(S : TObjectStream; Item : POINTER); OVERRIDE;
  END;

Because I do not yet have an own e-mail address please send suggestions
and/or bug reports to :

  Alain.Rassel@restena.lu

If you are member of the BorlandNet in Europe, my Pointnumber is :

  100:494/310.4

Best regards

