{$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.
Comments
0 B
|👍
/👎
0 B
|👍
/👎