{$I SWITCHES.PAS}
UNIT FDBArrays;
{
           FILE: FDBArray.pas
       ABSTRACT: General flat memory array "objects".

                 Copyright (c) 1994- Falcon AS

         SYSTEM: General ("Falcon System IV")
         MODULE: Database related

  RELATED FILES:

        WARNING: Do not add Constructors, Destructors, or Virtual methods to
                 the objects in this unit.  It will break the source by adding
                 a VMT and make it impossible to export/import these objects
                 as flat array data from f.x. DLL's.

  REVISION HISTORY:

  VERSION DATE    COMMENT                                   BY
  ------- ------  ----------------------------------------- -----------
  1.0.000         Initial version                           Lars Fosdal

}

INTERFACE
USES
  TypeDefs;

CONST
  MaxArrayItems = 8000; {Allow upto 8000 doubles in a 64K block}
                        {When 32-bit flat memory arrives, it might be desirable
                         to increase this limit :-) }

TYPE
  IDInfo = RECORD {Block "Header-Header" :-)}
    CASE Integer OF
      0 : (Position : OpenByteTable); {x  x} {Typecast for indexed access}
      1 : (ID       : Word;           {2  2} {Data dependant ID}
           TypeID   : Word;           {2  4} {Type dependant ID}
           Version  : Word;           {2  6} {Type ID dependant version number}
           Format   : Word;           {2  8} {Compression type, etc.}
           Flags    : LongInt);       {4 12} {Dirty, etc}
  END; {Rec IDInfo}

  pBlockHeader = ^TBlockHeader;
  TBlockHeader = OBJECT(TRecord)
    Block    : IDInfo;                {12 12} {Block ID/Version}
    CompSize : LongInt;               { 4 16} {Compressed size (incl.header)}
    TrueSize : LongInt;               { 4 20} {Uncompressed size (incl.header)}
    CompSum  : LongInt;               { 4 24} {Compressed chksum (excl.header)}
    TrueSum  : LongInt;               { 4 28} {Uncompressed chksum (excl.header)}
    Reserved : ARRAY[1..4] OF LongInt;{16 44} {Reserved for future use}
    PROCEDURE AssignID(DataID, TypeID, Version, Format:Word);
    FUNCTION  IsDirty:Boolean;
    PROCEDURE SetDirty;
    PROCEDURE ClearDirty;
    FUNCTION  IsCompressed:Boolean;
    FUNCTION  Size:LongInt;
    FUNCTION Duplicate:Pointer;
    FUNCTION CheckSum(SizeOfHeader:LongInt):LongInt;
    FUNCTION Compress(SizeOfHeader:LongInt; Format:Word):Pointer;
    FUNCTION Uncompress(SizeOfHeader:LongInt):Pointer;
  END; {OBJ TBlockHeader}

TYPE
  pArrayBase = ^TArrayBase;
  TArrayBase = OBJECT(TBlockHeader)     {44 44} {Standard array header}
    ItemSize   : Word;                   { 2 46} {Data item size}
    Rsvd       : Word;                   { 2 48} {Reserved}
    Count      : LongInt;                { 4 52} {Number of Items utilized}
    Limit      : LongInt;                { 4 56} {Max. number of Items}
    Spare      : ARRAY[1..2] OF LongInt; { 8 64} {Reserved}
    PROCEDURE InitArray(_ItemSize:Word; _Limit:LongInt);
    FUNCTION ItemAddress(Index:LongInt):Pointer;
    FUNCTION Append(CONST NewItem):LongInt;
    PROCEDURE Get(Index:LongInt; VAR Item);
    FUNCTION Put(Index:LongInt; CONST Item):LongInt;
    FUNCTION Insert(Index:LongInt; CONST NewItem):LongInt;
    FUNCTION Delete(Index:LongInt):LongInt;
    FUNCTION AppendBlock(CONST NewArrayBase):LongInt;
    FUNCTION InsertBlock(Index:LongInt; CONST NewArrayBase):LongInt;
    FUNCTION DeleteBlock(Index,Items:LongInt):LongInt;
    FUNCTION DuplicateBlock(Index, Items:LongInt):Pointer;
    FUNCTION DeleteAll:LongInt;
    FUNCTION FreeCount:LongInt;
    FUNCTION isEmpty:Boolean;
    FUNCTION isFull:Boolean;
    PROCEDURE Inspect(VAR oFile:Text);
  END; {TArrayBase}

TYPE
  pByteArray = ^TByteArray;
  TByteArray = OBJECT(TArrayBase)
    Item : ARRAY [0..MaxArrayItems-1] OF Byte;
    FUNCTION Append(NewItem:Byte):LongInt;
    FUNCTION Insert(Index:LongInt; NewItem:Byte):LongInt;
  END; {REC TByteArray}

TYPE
  pSmallIntArray = ^TSmallIntArray;
  TSmallIntArray = OBJECT(TArrayBase)
    Item : ARRAY [0..MaxArrayItems-1] OF SmallInt;
    FUNCTION Append(NewItem:SmallInt):LongInt;
    FUNCTION Insert(Index:LongInt; NewItem:SmallInt):LongInt;
  END; {REC TSmallIntArray}

TYPE
  pWordArray = ^TWordArray;
  TWordArray = OBJECT(TArrayBase)
    Item : ARRAY [0..MaxArrayItems-1] OF Word;
    FUNCTION Append(NewItem:Word):LongInt;
    FUNCTION Insert(Index:LongInt; NewItem:Word):LongInt;
  END; {REC TWordArray}

TYPE
  pLongIntArray = ^TLongIntArray;
  TLongIntArray = OBJECT(TArrayBase)
    Item : ARRAY [0..MaxArrayItems-1] OF LongInt;
    FUNCTION Append(NewItem:LongInt):LongInt;
    FUNCTION Insert(Index:LongInt; NewItem:LongInt):LongInt;
  END; {REC TLongIntArray}

TYPE
  pTimeArray = ^TTimeArray;
  TTimeArray = OBJECT(TArrayBase)
    Item : ARRAY [0..MaxArrayItems-1] OF TTime;
    FUNCTION Append(NewItem:TTime):LongInt;
    FUNCTION Insert(Index:LongInt; NewItem:TTime):LongInt;
  END; {REC TTimeArray}

TYPE
  pRealArray = ^TRealArray;
  TRealArray = OBJECT(TArrayBase)
    Item : ARRAY [0..MaxArrayItems-1] OF Real;
    FUNCTION Append(NewItem:Real):LongInt;
    FUNCTION Insert(Index:LongInt; NewItem:Real):LongInt;
    FUNCTION PackToLFD:pRealArray;
    FUNCTION UnpackLFD:pRealArray;
  END; {REC TRealArray}

TYPE
  pDoubleArray = ^TDoubleArray;
  TDoubleArray = OBJECT(TArrayBase)
    Item : ARRAY [0..MaxArrayItems-1] OF Double;
    FUNCTION Append(NewItem:Double):LongInt;
    FUNCTION Insert(Index:LongInt; NewItem:Double):LongInt;
    FUNCTION PackToLFD:pDoubleArray;
    FUNCTION UnpackLFD:pDoubleArray;
  END; {REC TDoubleArray}

FUNCTION BlockNew(BlockSize:LongInt; VAR Block):LongInt;
FUNCTION BlockDuplicate(VAR Block):Pointer;
PROCEDURE BlockDispose(VAR Block);

FUNCTION  ArraySize(ItemSize:Word; Limit:LongInt):LongInt;
FUNCTION  ArrayNew(CONST ItemSize:Word; VAR ArrayBase; ItemLimit:LongInt):LongInt;
PROCEDURE ArrayDispose(VAR ArrayBase);
FUNCTION  ArrayResize(VAR ArrayBase; ItemLimit:LongInt):LongInt;

{$IFNDEF NoLog}
FUNCTION DateTimeStr(PDT:TTime):String;
FUNCTION SplitIDStr(PDT:TTime):String;
{$ENDIF}

IMPLEMENTATION
USES
{$IFNDEF NoLog}
  LFErrLog, WinInfo, LFString,
{$ENDIF}
  FDBMagic,
{$IFNDEF Win32}
  PKWare,
{$ENDIF}
  WinDate;

{$IFNDEF NoLog}
FUNCTION DateTimeStr(PDT:TTime):String;
VAR
  DT : TUnpackedTime;
  sep : String[3];
{$IFNDEF Delphi}
  Result : String;
{$ENDIF}
BEGIN
  UnpackDT(PDT, DT);
  sep := WinIntl^.sDate[0];
  Result:=SwapAll(' ','0',IntStr(DT.Year ,4)+Sep+IntStr(DT.Month,2)+Sep+IntStr(DT.Day,2));
  IF PDT.Time<>0
  THEN Result:=Result+' '+SwapAll(' ','0',IntStr(DT.Hour,2)+Char(WinIntl^.sTime^)
                              +IntStr(DT.Min,2)+Char(WinIntl^.sTime^)
                              +IntStr(DT.Sec,2));
{$IFNDEF Delphi}
  DateTimeStr:=Result;
{$ENDIF}
END; {FUNC DateTimeStr}

FUNCTION SplitIDStr(PDT:TTime):String;
VAR
  DT : TUnpackedTime;
  sep : String[3];
{$IFNDEF Delphi}
  Result : String;
{$ENDIF}
BEGIN
  UnpackDT(PDT, DT);
  sep := WinIntl^.sDate[0];
  Result:=SwapAll(' ','0',IntStr(DT.Year ,4)+Sep+IntStr(DT.Month,2)+Sep+IntStr(DT.Day,2));
  Result:=Result+' '+IntStr(PDT.Time,0);
{$IFNDEF Delphi}
  SplitIDStr:=Result;
{$ENDIF}
END; {FUNC SplitIDStr}

{$ENDIF}


{------------------------------------------------------------ Block Primitives ---}

FUNCTION BlockNew(BlockSize:LongInt; VAR Block):LongInt;
VAR
  ItemPtr : pBlockHeader Absolute Block;
BEGIN
  GetMem(ItemPtr, BlockSize);
  IF Assigned(ItemPtr)
  THEN BEGIN
    BlockNew:=BlockSize;
    FillChar(ItemPtr^, BlockSize, 0);
    ItemPtr^.TrueSize:=BlockSize;
  END
  ELSE BlockNew:=0;
END; {FUNC BlockNew}

PROCEDURE BlockDispose(VAR Block);
VAR
  ItemPtr : pBlockHeader Absolute Block;
BEGIN
  IF Assigned(ItemPtr)
  THEN BEGIN
    FreeMem(ItemPtr, ItemPtr^.Size);
    ItemPtr:=nil;
  END;
END; {PROC BlockDispose}

FUNCTION BlockDuplicate(VAR Block):Pointer;
VAR
  Original : pBlockHeader Absolute Block;
  Replica  : pBlockHeader;
BEGIN
  BlockNew(Original^.Size, Replica);
  IF Assigned(Replica)
  THEN Move(Original^, Replica^, Original^.Size);
  BlockDuplicate:=Replica;
END; {FUNC BlockDuplicate}



{------------------------------------------------------ Array Block Primitives ---}

TYPE
  pDummyArray = ^TDummyArray;
  TDummyArray = OBJECT(TArrayBase) {for manipulation purposes}
    Data  : OpenByteTable;
  END;

FUNCTION ArraySize(ItemSize:Word; Limit:LongInt):LongInt;
{ - Calculate memory needed for an array}
BEGIN
  ArraySize:=SizeOf(TArrayBase)+(ItemSize*Limit);
END; {FUNC ArraySize}

FUNCTION ArrayNew(CONST ItemSize:Word; VAR ArrayBase; ItemLimit:LongInt):LongInt;
{ - Allocate a new array - Returns New Array pointer and size in bytes}
VAR
  Arry : pArrayBase Absolute ArrayBase;
BEGIN
  ArrayNew:=BlockNew( ArraySize(ItemSize, ItemLimit), Arry);
  IF Assigned(Arry)
  THEN Arry^.InitArray(ItemSize, ItemLimit);
END; {FUNC ArrayNew}

PROCEDURE ArrayDispose(VAR ArrayBase);
{ - DeAllocate an existing array}
BEGIN
  BlockDispose(ArrayBase);
END; {PROC ArrayDispose}

FUNCTION ArrayResize(VAR ArrayBase; ItemLimit:LongInt):LongInt;
{ - Shrink or grow an Array - Returns new Array pointer and size in bytes}
VAR
  Size    : LongInt;
  CopyLen : LongInt;
  Old     : pArrayBase Absolute ArrayBase;
  Arry    : pArrayBase;
BEGIN
  Size:=ArrayNew(Old^.ItemSize, Arry, ItemLimit);
  IF Size>Old^.Size
  THEN CopyLen:=Old^.Size
  ELSE CopyLen:=Size;
  Move(Old^, Arry^, CopyLen);
  Arry^.TrueSize:=Size;
  Arry^.Limit:=ItemLimit;
  IF Arry^.Count>ItemLimit
  THEN Arry^.Count:=ItemLimit;
  ArrayDispose(Old);
  Old:=Arry;
  ArrayResize:=Size;
END; {FUNC ArrayResize}


{------------------------------------------------------------- TBlockHeader ---}

FUNCTION TBlockHeader.IsDirty:Boolean;
BEGIN
  IsDirty:=Block.Flags and $0001 = $0001;
END; {FUNC TBlockHeader.IsDirty}

PROCEDURE TBlockHeader.SetDirty;
BEGIN
  Block.Flags:=Block.Flags or $0001;
END; {PROC TBlockHeader.SetDirty}

PROCEDURE TBlockHeader.ClearDirty;
BEGIN
  Block.Flags:=Block.Flags and $FFFE;
END; {PROC TBlockHeader.ClearDirty}

FUNCTION TBlockHeader.IsCompressed:Boolean;
BEGIN
  IsCompressed:=Block.Format<>0;
END; {FUNC TBlockHeader.IsCompressed}

FUNCTION TBlockHeader.Size:LongInt;
BEGIN
  IF IsCompressed
  THEN Size:=CompSize
  ELSE Size:=TrueSize;
END; {FUNC TBlockHeader.Size}

FUNCTION TBlockHeader.Duplicate:Pointer;
{ - Duplicate a block - Returns pointer to new block}
VAR
  ptr : Pointer;
BEGIN
  ptr:=@Self;
  Duplicate:=BlockDuplicate(ptr);
END; {FUNC TBlockHeader.Duplicate}

FUNCTION TBlockHeader.CheckSum(SizeOfHeader:LongInt):LongInt;
BEGIN
  CheckSum:=0;
END; {FUNC TBlockHeader.CheckSum}

FUNCTION TBlockHeader.Compress(SizeOfHeader:LongInt; Format:Word):Pointer;
VAR
  NewBlock : pBlockHeader;
  Original : pBlockHeader;
BEGIN
  NewBlock:=nil;
  Original:=pBlockHeader(@Self);
  {$IFNDEF Win32}
  IF Original^.TrueSize > SizeOfHeader
  THEN BEGIN

    IF (Format and icp_LZW = icp_LZW)
    THEN BEGIN
    {$IFOPT R+}{$R-}{$DEFINE RPlus}{$ENDIF}
      ImplodeInit(Original^.TrueSize - SizeOfHeader,
                  @Original^.Block.Position[SizeOfHeader]);
    {$IFDef Rplus}{$R+}{$UNDEF RPlus}{$ENDIF}
      IF ImplodeData
      THEN BEGIN
        WITH PKZ
        DO BEGIN
          BlockNew(TargetPos + SizeOfHeader, NewBlock);
          Move(Original^, NewBlock^, SizeOfHeader);
      {$IFOPT R+}{$R-}{$DEFINE RPlus}{$ENDIF}
          Move(Target^, NewBlock^.Block.Position[SizeOfHeader], TargetPos);
      {$IFDef Rplus}{$R+}{$UNDEF RPlus}{$ENDIF}
          NewBlock^.CompSize:=TargetPos + SizeOfHeader;
          NewBlock^.Block.Format:=NewBlock^.Block.Format or icp_LZW;
        END;
        Format:=Format and not icp_LZW;
      END
    {$IFNDEF NoLog}
      ELSE LogError('PKZ compression failed - Leaving data uncompressed!')
    {$ENDIF};
      ImplodeDone;
     END; {icp_LZW}
  END;
  {$ENDIF}
  IF not Assigned(NewBlock)
  THEN NewBlock:=Original^.Duplicate;
  IF Assigned(Original)  and (Original<>NewBlock) and (Original<>@Self)
  THEN BlockDispose(Original);
  Compress:=NewBlock;
END; {FUNC TBlockHeader.Compress}

FUNCTION TBlockHeader.Uncompress(SizeOfHeader:LongInt):Pointer;
VAR
  NewBlock : pBlockHeader;
  Original : pBlockHeader;
BEGIN
  NewBlock:=nil;
  Original:=pBlockHeader(@Self);
{$IFDEF Win32}
  {//Incomplete}
{$ELSE}
  IF (Original^.Block.Format and icp_LZW = icp_LZW)
  THEN BEGIN
    BlockNew(Original^.TrueSize, NewBlock);
    Move(Original^, NewBlock^, SizeOfHeader);
  {$IFOPT R+}{$R-}{$DEFINE RPlus}{$ENDIF}
    ExplodeInit(Original^.CompSize - SizeOfHeader,
               @Original^.Block.Position[SizeOfHeader],
               Original^.TrueSize - SizeOfHeader,
               @NewBlock^.Block.Position[SizeOfHeader]);
  {$IFDef Rplus}{$R+}{$UNDEF RPlus}{$ENDIF}
    IF ExplodeData
    THEN BEGIN
      NewBlock^.CompSize:=0;
      NewBlock^.Block.Format:=NewBlock^.Block.Format and not icp_LZW;
    END
    ELSE BEGIN
    {$IFNDEF NoLog}
      LogError('PKZ decompression failed - Leaving data compressed!');
    {$ENDIF}
      BlockDispose(NewBlock);
    END;
    ExplodeDone;
  END; {icp_LZW}
{$ENDIF}

  IF not Assigned(NewBlock)
  THEN NewBlock:=Original^.Duplicate;
  IF Assigned(Original)  and (Original<>NewBlock) and (Original<>@Self)
  THEN BlockDispose(Original);
  Uncompress:=NewBlock;
END; {FUNC TBlockHeader.Uncompress}

PROCEDURE TBlockHeader.AssignID(DataID, TypeID, Version, Format:Word);
BEGIN
  Block.ID:=DataID;
  Block.TypeID:=TypeID;
  Block.Version:=Version;
  Block.Format:=Format;
END; {PROC TBlockHeader.AssignID}


{------------------------------------------------------------ TArrayBase ---}
{$IFOPT R+} {$DEFINE RPlus} {$R-} {$ENDIF}

PROCEDURE TArrayBase.InitArray(_ItemSize:Word; _Limit:LongInt);
BEGIN
  ItemSize:=_ItemSize;
  Limit:=_Limit;
END; {PROC TArrayBase.Init}

FUNCTION TArrayBase.DuplicateBlock(Index,Items:LongInt):Pointer;
{ - Copy a partial Array - Returns pointer to new array}
VAR
  Original : TDummyArray Absolute Self;
  Arry     : pDummyArray;
BEGIN
  Arry:=nil;
  WITH Original
  DO BEGIN
    IF (Count>0) and (Index<Count)
    THEN BEGIN
      IF Index+Items>Count
      THEN Items:=Count-Index+1;
      ArrayNew(ItemSize, Arry, Items);
      IF Assigned(Arry)
      THEN BEGIN
        Arry^.Block:=Original.Block;
        Move(Data[Index*ItemSize], Arry^.Data[0], Items*ItemSize);
        Arry^.Count:=Items;
      END;
    END
    ELSE Arry:=nil;
  END;
  DuplicateBlock:=Arry;
END; {FUNC TArrayBase.DuplicateBlock}

FUNCTION TArrayBase.ItemAddress(Index:LongInt):Pointer;
VAR
  Original : TDummyArray Absolute Self;
BEGIN
  IF (Index<Count) and (Index>-1)
  THEN ItemAddress:=@Original.Data[Index*ItemSize]
  ELSE ItemAddress:=nil;
END; {FUNC TArrayBase.ItemAddress}

FUNCTION TArrayBase.Append(CONST NewItem):LongInt;
{ - Append an item to the array - return number of items or -1 if failure}
VAR
  Original : TDummyArray Absolute Self;
BEGIN
  IF Count<Limit
  THEN BEGIN
    Move(NewItem, Original.Data[Count*ItemSize], ItemSize);
    SetDirty;
    Inc(Count);
    Append:=Count;
  END
  ELSE Append:=-1;
END; {FUNC TArrayBase.Append}

PROCEDURE TArrayBase.Get(Index:LongInt; VAR Item);
VAR
  Original : TDummyArray Absolute Self;
BEGIN
  IF (Index<Count)
  THEN BEGIN
    Move(Original.Data[Index*ItemSize], Item, ItemSize);
  END;
END; {PROC TArrayBase.Get}

FUNCTION TArrayBase.Put(Index:LongInt; CONST Item):LongInt;
VAR
  Original : TDummyArray Absolute Self;
BEGIN
  IF (Index<Count)
  THEN BEGIN
    Move(Item, Original.Data[Index*ItemSize], ItemSize);
    SetDirty;
    Put:=Index;
  END
  ELSE Put:=-1;
END; {FUNC TArrayBase.Put}

FUNCTION TArrayBase.Insert(Index:LongInt; CONST NewItem):LongInt;
{ - Insert an item in the array - Return number of items or -1 if failure}
VAR
  Original : TDummyArray Absolute Self;
BEGIN
  IF Count<Limit
  THEN BEGIN
    IF Index>Count
    THEN Index:=Count;
    IF Index<>Count
    THEN Move(Original.Data[Index*ItemSize],
              Original.Data[(Index+1)*ItemSize], (Count-Index)*ItemSize);
    Move(NewItem, Original.Data[Index*ItemSize], ItemSize);
    Inc(Count);
    Insert:=Count;
    SetDirty;
  END
  ELSE Insert:=-1;
END; {FUNC TArrayBase.Insert}

FUNCTION TArrayBase.Delete(Index:LongInt):LongInt;
{ - Delete an item from the array - return number of items or -1 if failure}
VAR
  Original : TDummyArray Absolute Self;
BEGIN
  IF Count>0
  THEN BEGIN
    IF Index<=Count
    THEN BEGIN
      IF Index<>Count-1
      THEN Move(Original.Data[(Index+1)*ItemSize],
                Original.Data[Index*ItemSize], ((Count-Index)-1)*ItemSize);
      Dec(Count);
      FillChar(Original.Data[Count*ItemSize], ItemSize, 0);
      SetDirty;
    END;
    Delete:=Count;
  END
  ELSE Delete:=-1;
END; {FUNC TArrayBase.Delete}

FUNCTION TArrayBase.AppendBlock(CONST NewArrayBase):LongInt;
{ - Append another array, return number of items or -1 if failure}
VAR
  Original : TDummyArray Absolute Self;
  Apnd : pDummyArray Absolute NewArrayBase;
BEGIN
  IF Count+Apnd^.Count <= Limit
  THEN BEGIN
    Move(Apnd^.Data, Original.Data[Count*ItemSize], Apnd^.Count*ItemSize);
    Count:=Count+Apnd^.Count;
    AppendBlock:=Count;
    SetDirty;
  END
  ELSE AppendBlock:=-1;
END; {FUNC TArrayBase.AppendBlock}

FUNCTION TArrayBase.InsertBlock(Index:LongInt; CONST NewArrayBase):LongInt;
{ - Insert another array - return number of items or -1 if failure}
VAR
  Original : TDummyArray Absolute Self;
  Apnd : pDummyArray Absolute NewArrayBase;
BEGIN
  IF (Count+Apnd^.Count <= Limit) and (Apnd^.Count>0)
  THEN BEGIN
    IF Index>Count
    THEN Index:=Count;
    IF Index<>Count
    THEN Move(Original.Data[(Index)*ItemSize],
              Original.Data[(Index+Apnd^.Count)*ItemSize],
              (Count-Index)*ItemSize);
    Move(Apnd^.Data, Original.Data[Index*ItemSize], Apnd^.Count*ItemSize);
    Count:=Count+Apnd^.Count;
    InsertBlock:=Count;
    SetDirty;
  END
  ELSE InsertBlock:=-1;
END; {FUNC TArrayBase.InsertBlock}

FUNCTION TArrayBase.DeleteBlock(Index,Items:LongInt):LongInt;
{ - Delete a section of an array, return number of items or -1 if failure}
VAR
  Original : TDummyArray Absolute Self;
BEGIN
  IF (Count>0) and (Items>0)
  THEN BEGIN
    IF Index<Count
    THEN BEGIN
      IF (Index+Items)>Count
      THEN Items:=Count-Index
      ELSE IF (Index+Items) < Count
      THEN Move(Original.Data[(Index+Items)*ItemSize],
           Original.Data[Index*ItemSize], ((Count-Index)-Items)*ItemSize);
      Count:=Count-Items;
      FillChar(Original.Data[Count*ItemSize], Items*ItemSize, 0);
      SetDirty;
    END;
    DeleteBlock:=Count;
  END
  ELSE DeleteBlock:=-1;
END; {FUNC TArrayBase.DeleteBlock}

{$IFDEF Rplus} {$UNDEF RPlus} {$R+} {$ENDIF}


FUNCTION TArrayBase.DeleteAll:LongInt;
{ - Resets array count and clears contents - always returns 0}
VAR
  Original : TDummyArray Absolute Self;
BEGIN
  FillChar(Original.Data, Limit*ItemSize, 0);
  Count:=0;
  DeleteAll:=0;
  SetDirty;
END; {PROC TArrayBase.DeleteAll}

FUNCTION TArrayBase.FreeCount:LongInt;
{ - Returns the number of free positions}
BEGIN
  FreeCount:=Count-Limit;
END; {FUNC TArrayBase.FreeCount}

FUNCTION TArrayBase.IsEmpty:Boolean;
BEGIN
  IsEmpty:=Count=0;
END; {FUNC TArrayBase.IsEmpty:Boolean}

FUNCTION TArrayBase.isFull:Boolean;
{ - Returns TRUE if the array is full}
BEGIN
  isFull:=FreeCount=0;
END; {FUNC TArrayBase.isFull}

PROCEDURE TArrayBase.Inspect(VAR oFile:Text);
BEGIN
  Writeln(oFile, ' IS=', ItemSize, '  Max=',Limit,'  n=',Count);
END; {PROC TArrayBase.Inspect}

{---------------------------------------------------------------- TByteArray ---}

FUNCTION TByteArray.Append(NewItem:Byte):LongInt;
BEGIN
  Append:=Inherited Append(NewItem);
END; {FUNC TByteArray.Append}

FUNCTION TByteArray.Insert(Index:LongInt; NewItem:Byte):LongInt;
BEGIN
  Insert:=Inherited Insert(Index, NewItem);
END; {FUNC TByteArray.Insert}

{---------------------------------------------------------------- TSmallIntArray ---}

FUNCTION TSmallIntArray.Append(NewItem:SmallInt):LongInt;
BEGIN
  Append:=Inherited Append(NewItem);
END; {FUNC TSmallIntArray.Append}

FUNCTION TSmallIntArray.Insert(Index:LongInt; NewItem:SmallInt):LongInt;
BEGIN
  Insert:=Inherited Insert(Index, NewItem);
END; {FUNC TSmallIntArray.Insert}

{---------------------------------------------------------------- TWordArray ---}

FUNCTION TWordArray.Append(NewItem:Word):LongInt;
BEGIN
  Append:=Inherited Append(NewItem);
END; {FUNC TWordArray.Append}

FUNCTION TWordArray.Insert(Index:LongInt; NewItem:Word):LongInt;
BEGIN
  Insert:=Inherited Insert(Index, NewItem);
END; {FUNC TWordArray.Insert}

{---------------------------------------------------------------- TLongIntArray ---}

FUNCTION TLongIntArray.Append(NewItem:LongInt):LongInt;
BEGIN
  Append:=Inherited Append(NewItem);
END; {FUNC TLongIntArray.Append}

FUNCTION TLongIntArray.Insert(Index:LongInt; NewItem:LongInt):LongInt;
BEGIN
  Insert:=Inherited Insert(Index, NewItem);
END; {FUNC TLongIntArray.Insert}

{---------------------------------------------------------------- TTimeArray ---}

FUNCTION TTimeArray.Append(NewItem:TTime):LongInt;
BEGIN
  Append:=Inherited Append(NewItem);
END; {FUNC TTimeArray.Append}

FUNCTION TTimeArray.Insert(Index:LongInt; NewItem:TTime):LongInt;
BEGIN
  Insert:=Inherited Insert(Index, NewItem);
END; {FUNC TTimeArray.Insert}

{---------------------------------------------------------------- TRealArray ---}

FUNCTION TRealArray.Append(NewItem:Real):LongInt;
BEGIN
  Append:=Inherited Append(NewItem);
END; {FUNC TRealArray.Append}

FUNCTION TRealArray.Insert(Index:LongInt; NewItem:Real):LongInt;
BEGIN
  Insert:=Inherited Insert(Index, NewItem);
END; {FUNC TRealArray.Insert}

FUNCTION TRealArray.PackToLFD:pRealArray;
BEGIN
  PackToLFD:=@Self; {/// Incomplete}
END; {FUNC TRealArray.PackToLFD}

FUNCTION TRealArray.UnpackLFD:pRealArray;
BEGIN
  UnpackLFD:=@Self; {/// Incomplete}
END; {FUNC TRealArray.UnpackLFD}


{---------------------------------------------------------------- TDoubleArray ---}

FUNCTION TDoubleArray.Append(NewItem:Double):LongInt;
BEGIN
  Append:=Inherited Append(NewItem);
END; {FUNC TDoubleArray.Append}

FUNCTION TDoubleArray.Insert(Index:LongInt; NewItem:Double):LongInt;
BEGIN
  Insert:=Inherited Insert(Index, NewItem);
END; {FUNC TDoubleArray.Insert}

FUNCTION TDoubleArray.PackToLFD:pDoubleArray;
VAR
  LFDArray : pDummyArray;
  LFDLimit,
  iDouble,
  iLFD     : LongInt;
  iLen     : Integer;
BEGIN
  LFDArray:=Duplicate;
(*  LFDLimit:=(Limit*ItemSize) - (11+SizeOf(Count)+SizeOf(Limit));
  iDouble:=0;
  iLFD:=0;
{$IFOPT R+} {$DEFINE Rplus} {$R-} {$ENDIF}
  Move(Count, LFDArray^.Data[iLFD], SizeOf(Count));   iLFD:=iLFD+SizeOf(Count);
  Move(Limit, LFDArray^.Data[iLFD], SizeOf(Limit));   iLFD:=iLFD+SizeOf(Limit);
  WHILE (iDouble<Count) and (iLFD<LFDLimit)
  DO BEGIN
    iLen:=DoubleToLFD(Item[iDouble], LFDArray^.Data[iLFD]);
    iLFD:=iLFD+iLen;
    Inc(iDouble);
  END;
{$IFDEF Rplus} {$R-} {$UNDEF Rplus} {$ENDIF}
  IF iDouble<Count
  THEN BEGIN
    ArrayDispose(LFDArray);
    LFDArray:=@Self;
  END
  ELSE BEGIN
    iLen:=((iLFD+SizeOf(Count)+SizeOf(Limit)) DIV ItemSize)+1;
    ArrayResize(LFDArray, iLen);
    LFDArray^.Block.Format:=LFDArray^.Block.Format or icp_LFD;
    LFDArray^.CompSize:=LFDArray^.TrueSize;
  END;
*)
  PackToLFD:=pDoubleArray(LFDArray);
END; {FUNC TDoubleArray.PackToLFD}

FUNCTION TDoubleArray.UnpackLFD:pDoubleArray;
VAR
  DoubleArray : pDoubleArray;
  LFDArray    : TDummyArray Absolute Self;
  LFDLimit,
  iDouble,
  iLFD     : LongInt;
  iLen     : Integer;
  nLimit,
  nCount   : LongInt;
BEGIN
  iLFD:=0;
{$IFOPT R+} {$DEFINE Rplus} {$R-} {$ENDIF}
  Move(LFDArray.Data[iLFD], nCount, SizeOf(Count));   iLFD:=iLFD+SizeOf(Count);
  Move(LFDArray.Data[iLFD], nLimit, SizeOf(Limit));   iLFD:=iLFD+SizeOf(Limit);
  iDouble:=0;
  LFDLimit:=Limit*ItemSize - (SizeOf(Count)+SizeOf(Limit));
  ArrayNew(ItemSize, DoubleArray, nLimit);
(*
  WHILE (iDouble<nCount) and (iLFD<LFDLimit)
  DO BEGIN
    iLen:=LFDtoDouble(LFDArray.Data[iLFD], DoubleArray^.Item[iDouble]);
    iLFD:=iLFD+iLen;
    Inc(iDouble);
  END;
  DoubleArray^.Count:=iDouble;
*)
{$IFDEF Rplus} {$R-} {$UNDEF Rplus} {$ENDIF}
  UnpackLFD:=DoubleArray; {/// Incomplete}
END; {FUNC TDoubleArray.UnpackLFD}


END.