dynamicarrays.pas

delphi通过OCI访问ORACLE

unit DynamicArrays;

{
 Dynamic arrays and hashes for storing a various types of data.

 Arrays:
  THArray - Common array. Parent of all dynamic arrays.
  THArrayObjects,  THArrayByte,    THArraySmallInt, THArrayWord,  THArrayInt64,
  THArrayLongWord, THArrayInteger, THArrayPointer,  THArrayBoolean, THArrayDouble,
  THArrayCurrency, THArrayExtended,THArrayString,   THArrayStringFix.

 Hashes:
  THash - Common hash. Parent of all hashes.
  THashExists, THashBoolean, THashInteger, THashPointer,
  THashCurrency, THashDouble, THashString.

 Double Hashes:
  Like a table. Each value has two keys. Keys are always integer values.
  See DynamicArrays.html for detail.
  THash2 - Common double hash. Parent of all double hashes.
  THash2Exists, THash2Currency, THash2Integer, THash2String.

}

interface

uses Classes, Windows;

resourcestring
 SItemNotFound = 'Element with index %d not found !';
 SKeyNotFound  = 'Element with index%d not found in Read-only hash !';

type
  pboolean  = ^boolean;
  ppointer  = ^pointer;

  THarray = class;

  {Compare callback function. Return values must be:
   0 - elements are equal
   1 - arr[i] > arr[j]
  -1 - arr[i] < arr[j] }
  TCompareProc = function(arr : THArray;i,j : integer) : integer of object;

  {Find callback function.
   FindData - pointer to the seaching data. Seaching data can be int, float, string and any other type.
   Return values must be.
   0 - arr[i] = FindData as <needed type>
   1 - arr[i] > FindData as <needed type>
  -1 - arr[i] < FindData as <needed type>
   See example application how to use TFindProc.
  }
  TFindProc = function(arr : THArray;i : integer; FindData:pointer):integer of object;
  TSwapProc = procedure(arr : THArray;i,j : integer) of object;


(***********************************************************)
(*  Arrays                                                 *)
(***********************************************************)

  THArray = class //common class of all dynamic arrays, does not depend on a type of stored data
  private
   FCount:integer;            // number of elements
   FCapacity:integer;         // number of elements on which memory is allocated
   FItemSize:integer;         // size of one element in bytes
   procedure SetItemSize(Size:integer);
  protected
   FValues:pointer;
   procedure Error(Value,min,max:integer);
   function CalcAddr(num:integer):pointer; virtual;
   procedure InternalQuickSort(CompareProc:TCompareProc;SwapProc:TSwapProc;L,R:integer);
  public
   constructor Create; virtual;
   destructor Destroy; override;
   procedure Clear;virtual;
   procedure ClearMem; virtual;
   function Add(pValue:pointer):integer; virtual;
   procedure AddMany(pValue:pointer;Count:integer);
   procedure AddFillValues(ACount:integer);
   procedure Delete(num:integer);virtual;
   procedure Hold;
   procedure Get(num:integer;pValue:pointer); virtual;
   function GetAddr(num:integer):pointer;
   procedure Grow;
   procedure GrowTo(Count:integer);
   function Insert(num:integer;pValue:pointer):integer; virtual;
   procedure InsertMany(num:integer;pValue:pointer;Count:integer);
   function IndexOf(Value:pointer):integer;
   function IndexOfFrom(Value:pointer;Start:integer):integer;
   procedure MoveData(FromPos,Count,Offset:integer);virtual;
   procedure SetCapacity(Value:integer);
   procedure Update(num:integer;pValue:pointer);virtual;
   procedure UpdateMany(num:integer;pValue:pointer;Count:integer);
   procedure Zero;
   procedure LoadFromStream(s:TStream);virtual; // readed values will be added to existing
   procedure SaveToStream(s:TStream);virtual;
   procedure Swap(Index1,Index2:integer);virtual;
   procedure Sort(CompareProc : TCompareProc);
   procedure QuickSort(CompareProc:TCompareProc;SwapProc:TSwapProc=nil);
   function QuickFind(FindProc:TFindProc;FindData:pointer):integer; // Find value in SORTED array!!
   property Capacity:integer read FCapacity;
   property Count:integer read FCount;
   property ItemSize:integer read FItemSize write SetItemSize;
   property Memory:pointer read FValues;
  end;

  THArrayObjects = class(THArray)
  protected
   function GetValue(Index:integer):TObject;
   procedure SetValue(Index:integer;const Value:TObject);
  public
   constructor Create; override;
   procedure ClearMem; override;              // (!) destroyes all saved objects! and deletes all references on them.
   procedure SafeClearMem;                    // deletes only references on all stored objects. Objects are leave safe
   procedure Delete(Index:integer); override; // (!) destroyes object with index Index and deletes reference on it.
   procedure SafeDelete(Index:integer);       // deletes only reference on object with index Index. Object is leaves safe.
   function AddValue(Value:TObject):integer;
   function IndexOf(Value:TObject):integer;
   function IndexOfFrom(Value:TObject;Start:integer):integer;
   property Value[Index:integer]:TObject read GetValue write SetValue; default;
  end;

  THArrayByte = class(THArray)
  protected
   function GetValue(Index:integer):byte;
   procedure SetValue(Index:integer;Value:byte);
  public
   constructor Create; override;
   function AddValue(Value:byte):integer;
   function IndexOf(Value:byte):integer;
   function IndexOfFrom(Value:byte;Start:integer):integer;
   property Value[Index:integer]:byte read GetValue write SetValue; default;
  end;

  THArraySmallInt = class(THArray)
  protected
   function GetValue(Index:integer):smallint;
   procedure SetValue(Index:integer;Value:smallint);
  public
   constructor Create; override;
   function AddValue(Value:smallint):integer;
   function IndexOf(Value:smallint):integer;
   function IndexOfFrom(Value:smallint;Start:integer):integer;
   property Value[Index:integer]:smallint read GetValue write SetValue; default;
  end;

  THArrayWord = class(THArray)
  protected
   function GetValue(Index:integer):word;
   procedure SetValue(Index:integer;Value:word);
  public
   constructor Create; override;
   function AddValue(Value:word):integer;
   function IndexOf(Value:word):integer;
   function IndexOfFrom(Value:word;Start:integer):integer;
   property Value[Index:integer]:word read GetValue write SetValue; default;
  end;

  THArrayInt64 = class(THArray)
  protected
   function GetValue(Index:integer):int64;
   procedure SetValue(Index:integer;Value:int64);
  public
   constructor Create; override;
   function AddValue(Value:int64):integer;
   function IndexOf(Value:int64):integer;
   function IndexOfFrom(Value:int64;Start:integer):integer;
   property Value[Index:integer]:int64 read GetValue write SetValue; default;
  end;

  THArrayLongWord = class(THArray)
  protected
   function GetValue(Index:integer):LongWord;
   procedure SetValue(Index:integer;Value:LongWord);
  public
   constructor Create; override;
   function AddValue(Value:LongWord):integer;
   function IndexOf(Value:LongWord):integer;
   function IndexOfFrom(Value:LongWord;Start:integer):integer;
   property Value[Index:integer]:LongWord read GetValue write SetValue; default;
  end;

  THArrayInteger = class(THArray)
  protected
   function GetValue(Index:integer):integer;
   procedure SetValue(Index:integer;Value:Integer);
  public
   constructor Create; override;
   function IndexOf(Value:integer):integer;
   function IndexOfFrom(Value:integer; Start:integer):integer;
   function AddValue(Value:integer):integer;
   function InsertValue(num:integer; Value:integer):integer;
   function Pop:integer;
   procedure Push(Value:integer);
   property Value[Index:integer]:integer read GetValue write SetValue; default;
   function GetAsString:string;
   procedure AddFromString(InputString,Delimiters:string);
   function CalcMax:integer;
//   procedure QuickSort(l,r:integer);overload;
  end;

  THArrayPointer = class(THArray)
  protected
   function GetValue(Index:integer):Pointer;
   procedure SetValue(Index:integer;Value:Pointer);
  public
   constructor Create; override;
   function IndexOf(Value:pointer):integer;
   function IndexOfFrom(Value:pointer;Start:integer):integer;
   function AddValue(Value:pointer):integer;
   property Value[Index:integer]:pointer read GetValue write SetValue; default;
  end;

  THArrayBoolean = class(THArray)
  protected
   function GetValue(Index:integer):Boolean;
   procedure SetValue(Index:integer;Value:Boolean);
  public
   constructor Create; override;
   function AddValue(Value:Boolean):integer;
   function IndexOf(Value:Boolean):integer;
   function IndexOfFrom(Value:Boolean;Start:integer):integer;
   property Value[Index:integer]:Boolean read GetValue write SetValue; default;
  end;

  THArrayDouble = class(THArray)
  protected
   function GetValue(Index:integer):Double;
   procedure SetValue(Index:integer;Value:Double);
  public
   constructor Create; override;
   function AddValue(Value:double):integer;
   function IndexOf(Value:double):integer;
   function IndexOfFrom(Value:double;Start:integer):integer;
   property Value[Index:integer]:double read GetValue write SetValue; default;
  end;

  THArrayCurrency = class(THArray)
  protected
   function GetValue(Index:integer):Currency;
   procedure SetValue(Index:integer;Value:Currency);
  public
   constructor Create; override;
   function AddValue(Value:currency):integer;
   function IndexOf(Value:currency):integer;
   function IndexOfFrom(Value:currency;Start:integer):integer;
   property Value[Index:integer]:currency read GetValue write SetValue; default;
  end;

  THArrayExtended = class(THArray)
  protected
   function GetValue(Index:integer):Extended;
   procedure SetValue(Index:integer;Value:Extended);
  public
   constructor Create; override;
   function AddValue(Value:Extended):integer;
   function IndexOf(Value:Extended):integer;
   function IndexOfFrom(Value:Extended;Start:integer):integer;
   property Value[Index:integer]:Extended read GetValue write SetValue; default;
  end;

  TWideString = class
   Str:WideString;
  public
   constructor Create(Value:WideString);
  end;

  THArrayWideStrings = class(THArrayObjects)
  protected
   function GetValue(Index:integer):WideString;
   procedure SetValue(Index:integer;Value:WideString);
  public
   function AddValue(Value:WideString):integer;
   function IndexOf(Value:WideString):integer;
   function IndexOfFrom(Value:WideString;Start:integer):integer;
   property Value[Index:integer]:WideString read GetValue write SetValue; default;
  end;

  THArrayString = class(THArray)
  private
   str_ptr:THArrayPointer;
  protected
   function GetValue(Index:integer):string;
   procedure SetValue(Index:integer;Value:string);
   function CalcAddr(num:integer):pointer; override;
  public
   constructor Create; override;
   destructor Destroy; override;
   function AddValue(Value:string):integer;
   function Add(pValue:pointer):integer; override;
   procedure Clear;override;
   procedure ClearMem;override;
   procedure Delete(num:integer);override;
   procedure Get(num:integer;pValue:pointer); override;
   function Insert(num:integer;pValue:pointer):integer; override;
   function IndexOf(Value:string):integer;
   function IndexOfFrom(Value:string;Start:integer):integer;
   procedure MoveData(FromPos,Count,Offset:integer); override;
   procedure Swap(Index1,Index2:integer);override;
   procedure Update(num:integer;pValue:pointer);override;
   property Value[Index:integer]:string read GetValue write SetValue; default;
  end;

{  THArrayString_ = class(THArrayPointer)
  private
   procedure ClearStrings;
   function DublicateStr(pValue:pointer):PChar;
  protected
   function GetValue(Index:integer):string;
   procedure SetValue(Index:integer;Value:string);
  public
   destructor Destroy; override;
   procedure Clear;override;
   procedure ClearMem;override;
   function Add(pValue:pointer):integer;override;
   function AddValue(Value:string):integer;
   procedure Delete(num:integer);override;
   function Insert(num:integer;Value:string):integer;overload;
   function Insert(num:integer;pValue:pointer):integer;overload;override;
   procedure Update(num:integer;pValue:pointer);override;
   function IndexOf(Value:string):integer;
   function IndexOfFrom(Value:string;Start:integer):integer;
   procedure LoadFromStream(s:TStream);virtual; // readed values will be added to existing
   procedure SaveToStream(s:TStream);virtual;

   property Value[Index:integer]:string read GetValue write SetValue; default;
  end;}

  THArrayStringFix = class(THArray)
  protected
   function GetValue(Index:integer):string;
   procedure SetValue(Index:integer;Value:string);
  public
   constructor Create; override;
   constructor CreateSize(Size:integer);
   function AddValue(Value:string):integer;
   function IndexOf(Value:string):integer;
   function IndexOfFrom(Value:string;Start:integer):integer;
   property Value[Index:integer]:string read GetValue write SetValue; default;
  end;

(***********************************************************)
(*  Hashes                                                 *)
(***********************************************************)

  THash = class
  private
   FReadOnly:boolean;
   FAIndex:THArrayInteger;
   function GetKey(Index:integer):integer;
   function GetCount:integer;
  public
   constructor Create; virtual;
   destructor Destroy; override;
   procedure Clear; virtual;
   procedure ClearMem; virtual;
   function IfExist(Key:integer):boolean;  // check if values with key Key is exists in hash
   procedure Delete(Key:integer); virtual; abstract;// deletes value with key=Key
   property Count:integer read GetCount;
   property Keys[Index:integer]:integer read GetKey;
   property AIndexes:THArrayInteger read FAIndex;
  end;

  THashExists = class (THash)
  private
   procedure SetValue(Index:integer;Value:boolean);
   function GetValue(Index:integer):boolean;
  public
   constructor Create; override;
   destructor Destroy; override;
   procedure Delete(Key:integer); override;
   property Value[Index:integer]:boolean read GetValue write SetValue; default;
  end;

  THashBoolean = class (THash)
  private
   FAValues:THArrayBoolean;
   procedure SetValue(Key:integer;Value:boolean);
   function GetValue(Key:integer):boolean;
  public
   constructor Create; override;
   constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayBoolean);
   destructor Destroy; override;
   procedure Clear; override;
   procedure ClearMem; override;
   procedure Delete(Key:integer); override;
   property Value[Index:integer]:boolean read GetValue write SetValue; default;
  end;

  THashInteger = class (THash)
  private
   FAValues:THArrayInteger;
   procedure SetValue(Key:integer;Value:integer);
   function GetValue(Key:integer):integer;
  public
   constructor Create; override;
   constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayInteger);
   destructor Destroy; override;
   procedure Clear; override;
   procedure ClearMem; override;
   procedure Delete(Key:integer); override;
   property AValues:THArrayInteger read FAValues;
   property Value[Index:integer]:integer read GetValue write SetValue; default;
  end;

  THashPointer = class (THash)
  private
   FAValues:THArrayPointer;
   procedure SetValue(Key:integer;Value:pointer);
   function GetValue(Key:integer):pointer;
  public
   constructor Create; override;
   constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayPointer);
   destructor Destroy; override;
   procedure Clear; override;
   procedure ClearMem; override;
   procedure Delete(Key:integer); override;
   property AValues:THArrayPointer read FAValues;
   property Value[Index:integer]:pointer read GetValue write SetValue; default;
  end;

  THashCurrency = class (THash)
  private
   FAValues:THArrayCurrency;
   procedure SetValue(Key:integer;Value:currency);
   function GetValue(Key:integer):currency;
  public
   constructor Create; override;
   constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayCurrency);
   destructor Destroy; override;
   procedure Clear; override;
   procedure ClearMem; override;
   procedure Delete(Key:integer); override;
   procedure Inc(Key:integer;Value:currency); // increases stored value with key=Key on a Value. If value with key=Key does not exists then it will be created with value=Value.
   property Value[Index:integer]:currency read GetValue write SetValue; default;
  end;

  THashDouble = class (THash)
  private
   FAValues:THArrayDouble;
   procedure SetValue(Key:integer;Value:Double);
   function GetValue(Key:integer):Double;
  public
   constructor Create; override;
   constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayDouble);
   destructor Destroy; override;
   procedure Clear; override;
   procedure ClearMem; override;
   procedure Delete(Key:integer); override;
   procedure Inc(Key:integer;Value:Double); // increases stored value with key=Key on a Value. If value with key=Key does not exists then it will be created with value=Value.
   property Value[Index:integer]:Double read GetValue write SetValue; default;
  end;

  THashString = class (THash)
  private
   FAllowEmptyStr:boolean;
   FAValues:TStrings;
   procedure SetValue(Key:integer;Value:string);
   function GetValue(Key:integer):string;
  public
   constructor Create; override;
   destructor Destroy; override;
   procedure Clear; override;
   procedure ClearMem; override;
   procedure Delete(Key:integer); override;
   property AllowEmptyStr:boolean read FAllowEmptyStr write FAllowEmptyStr;
   property Value[Index:integer]:string read GetValue write SetValue; default;
  end;

  THash2 = class
  private
   MainListIndex:THArrayInteger;
   MainListValue:THArrayPointer;
//   function GetKey(Index:integer):integer;
   function GetChildHash(Key:integer):THash;
  public
   constructor Create; virtual;
   destructor Destroy; override;
//   function Count:integer;
   procedure Clear; virtual; abstract;  // Creares hash. Allocated memory do not frees.
   procedure ClearMem;                  // Cleares hash. Allocated memory frees too.
   procedure Delete(MainIndex,Index:integer);
//   function ExistMainHash(MainIndex:integer):boolean;
//   function ExistIndex(Index:integer):boolean;
//   property Keys[Index:integer]:integer read GetKey;
   property MainIndexes:THArrayInteger read MainListIndex;
  end;

  THash2Exists = class (THash2)
  public
   procedure SetValue(MainIndex,Index:integer;Value:boolean); // creates new record with keys MainIndex, Index
   procedure Clear; override;
   function GetValue(MainIndex,Index:integer):boolean;        // Gets Value by keys MainIndex, Index
   function CreateMainHash(MainIndex:integer):THashExists;
   function CreateHash(Index:integer):THashExists;
//   procedure ExportChildHash(Hash:THashBoolean);
//   procedure DeleteMainIndex(MainIndex:integer);
//   procedure DeleteIndex(Index:integer);
  end;

  THash2Currency = class (THash2)
  public
   procedure SetValue(MainIndex,Index:integer;Value:currency);// creates new record with keys MainIndex, Index
   procedure Inc(MainIndex,Index:integer;Value:currency);     // increases exists/create new record with keys MainIndex, Index
   procedure Clear; override;
   function GetValue(MainIndex,Index:integer):currency;       // Gets Value by keys MainIndex, Index
   function CreateMainHash(MainIndex:integer):THashCurrency;
   function CreateHash(Index:integer):THashCurrency;
//   procedure ExportChildHash(Hash:THashCurrency);
  end;

  THash2Integer = class (THash2)
  public
   procedure SetValue(MainIndex,Index:integer;Value:Integer); // creates new record with keys MainIndex, Index
   procedure Clear; override;
   function GetValue(MainIndex,Index:integer):Integer;        // Gets Value by keys MainIndex, Index
   function CreateMainHash(MainIndex:integer):THashInteger;
   function CreateHash(Index:integer):THashInteger;
//   procedure ExportChildHash(Hash:THashInteger);
  end;

  THash2String = class (THash2)
  protected
   procedure SetValue(MainIndex,Index:integer;Value:String); // creates new record with keys MainIndex, Index
   function GetValue(MainIndex,Index:integer):String;        // Gets Value by keys MainIndex, Index
  public
   procedure Clear; override;
   function CreateMainHash(MainIndex:integer):THashString;
   function CreateHash(Index:integer):THashString;
//   procedure ExportChildHash(Hash:THashCurrency);
   property Value[MainIndex,Index:integer]:string read GetValue write SetValue; default;