home *** CD-ROM | disk | FTP | other *** search
- unit DynamicArrays;
-
- {
- τΣσ±ⁿ ±ΦΣ ≥ Ωε∞∩εφσφ≥√, ε≥Γσ≈α■∙Φσ τα ΣΦφα∞Φ≈σ±Ωεσ ≡α±∩≡σΣσδσφΦσ ∩α∞ ≥Φ,
- Φ Γ±σ, ≈≥ε ± ²≥Φ∞ ±Γ ταφε
-
- -------------- ΣΦφα∞Φ≈σ±ΩΦσ ∞α±±ΦΓ√ ----------------------
- THArray - ΣΦφα∞Φ≈σ±ΩΦΘ ∞α±±ΦΓ ²δσ∞σφ≥εΓ(ΩαµΣ√Θ ²δσ∞σφ≥ ≡ατ∞σ≡α ItemSize)
- ╬≥ εß√≈φ√⌡ ∞α±±ΦΓεΓ ε≥δΦ≈α■≥± ≥σ∞, ≈≥ε ∩α∞ ≥ⁿ τα⌡Γα≥√Γασ≥± αΓ≥ε∞α≥Φ≈σ±ΩΦ
- ╬≥ φσπε φα±δσΣ≤■≥± :
- THArrayInteger, THArrayPointer, THArrayBoolean, THArrayInt64,
- THArrayCurrency, THArrayString, THArrayObjects, THArraySmallInt,
- THArrayWord, THArrayExtended,THArrayDouble, THArrayStringFix.
-
- THArrayString Γδ σ≥± ∩≡ε±≥ε φαΣ±≥≡εΘΩεΘ φαΣ THArray Σδ ≡αßε≥√ ± TStrings
- THArrayStringFix ≡αßε≥ασ≥ ±ε ±≥≡εΩα∞Φ ±≥≡επε ⌠ΦΩ±Φ≡εΓαφεΘ ΣδΦφ√ (φα∩≡Φ∞σ≡ ±≥≡εΩεΓ√σ ∩εδ Γ ßατσ)
-
- THArray :
- Property:
- ItemSize - ≡ατ∞σ≡ ΩαµΣεπε ²δσ∞σφ≥α. ╧≡Φ Φτ∞σφσφΦΦ ItemSize τφα≈σφΦ Γ√∩εδφ σ≥± ClearMem ≥.σ. Γ±σ Σαφφ√σ ≥σ≡ ■≥±
- Count - ΩεδΦ≈σ±≥Γε ²δσ∞σφ≥εΓ
- Memory - ≤Ωατα≥σδⁿ φα φα≈αδε ∞α±±ΦΓα
-
- ╠σ≥εΣ√ :
- procedure Clear;
- ╫Φ±≥Φ≥ ∞α±±ΦΓ, φε ∩α∞ ≥ⁿ φσ ε±ΓεßεµΣασ≥(ε±≥α≥σ≥± Σδ ⌡≡αφσφΦ φεΓ√⌡ Σαφφ√⌡)
- ┼±δΦ ≈α±≥ε ≈Φ±≥Φ≥± ∩σ≡στα∩Φ±√Γασ≥± ∞α±±ΦΓ, φε ≡ατ∞σ≡ ∩≡Φ∞σ≡φε εΣΦφαΩεΓ,
- ∩α∞ ≥ⁿ ≈Φ±≥Φ≥ⁿ φσ εß τα≥σδⁿφε - ±δσΣ≤■∙ΦΘ ≡ατ φσ ß≤Σσ≥ τα⌡Γα≥√Γα≥ⁿ± ∩α∞ ≥ⁿ,
- Ωε≥ε≡α ≤µσ Φ±∩εδⁿτεΓαδα±ⁿ
- procedure ClearMem;
- ╫Φ±≥Φ≥ ∞α±±ΦΓ, ∩≡Φ ²≥ε∞ ε±ΓεßεµΣα Γ±■ ∩α∞ ≥ⁿ
- function Add(pValue:pointer):integer;
- ─εß√Γδ σ≥ Γ Ωεφσ÷ ∞α±±ΦΓα τφα≈σφΦσ ∩ε αΣ≡σ±≤ pValue. ╨ατ∞σ≡ ßσ≡σ≥± Φτ ItemSize
- ┬ετΓ≡α∙ασ≥ φε∞σ≡ ∩ετΦ÷ΦΦ, Ω≤Σα ß√δε ΣεßαΓδσφε τφα≈σφΦσ.
- procedure AddMany();
- ─εßαΓδ σ≥ φσ±ΩεδⁿΩε τφα≈σφΦΘ Γ ∞α±±ΦΓ. ╠εµφε Φ±∩εδⁿτεΓα≥ⁿ Σδ Ωε∩Φ≡εΓαφΦ
- εΣφεπε ∞α±±ΦΓα Γ Σ≡≤πεΘ.
- function Insert(num:integer;pValue:pointer):integer;
- ─εßαΓδ σ≥ τφα≈σφΦσ, φε φσ Γ Ωεφσ÷, α Γ ∩ετΦ÷Φ■ num. ┬±σ ±δσΣ≤■∙Φσ ²δσ∞σφ≥√
- ±ΣΓΦπα■≥± .
- ┬ετΓ≡α∙ασ≥ φε∞σ≡ ∩ετΦ÷ΦΦ, Ω≤Σα ßεδε ΣεßαΓδσφε τφα≈σφΦσ.
- procedure InsertMany(num:integer;pValue:pointer;Count:integer);
- ╥ε µσ ±α∞εσ, φε φσ±ΩεδⁿΩε τφα≈σφΦΘ
- procedure Delete(num:integer);
- ╙Σαδ σ≥ ²δσ∞σφ≥ Γ ∩ετΦ÷ΦΦ num. ┬±σ ±δσΣ≤■∙Φσ τφα≈σφΦ ±ΣΓΦπα■≥± Ω
- φα≈αδ≤. ╧α∞ ≥ⁿ ∩≡Φ ²≥ε∞ φσ ε±ΓεßεµΣασ≥±
- procedure Update(num:integer;pValue:pointer);
- ╙±≥αφαΓδΦΓασ≥ τφα≈σφΦσ µδσ∞σφ≥α num
- procedure UpdateMany(num:integer;pValue:pointer;Count:integer);
- ╥ε µσ Σδ φσ±ΩεδⁿΩΦ⌡ τφα≈σφΦΘ
- procedure Get(num:integer;pValue:pointer);
- ╧εδ≤≈Φ≥ⁿ τφα≈σφΦσ ²δσ∞σφ≥α num. ═≤µφε ∩σ≡σΣα≥ⁿ ±■Σα αΣ≡σ± Ω≤±Ωα ∩α∞ ≥Φ,
- α ⌠≤φΩ÷Φ ±Ωε∩Φ≡≤σ≥ ≥≤Σα τφα≈σφΦσ.
- function GetAddr(num:integer):pointer;
- ╧εδ≤≈Φ≥ⁿ αΣ≡σ± ²δσ∞σφ≥α num
- procedure SetCapacity(Value:integer);
- ╟α⌡Γα≥Φ≥ⁿ ∩α∞ ≥ⁿ ∩εΣ Value τφα≈σφΦΘ. ┼±δΦ τφα≈σφΦΘ Γ ∞α±±ΦΓσ ß√δε ßεδⁿ°σ,
- δΦ°φΦσ ≤Σαδ ■≥± .
- procedure Hold;
- ╬≥Σα≥ⁿ δΦ°φ■■ ∩α∞ ≥ⁿ ±Φ±≥σ∞σ. ╬±≥ασ≥± ∩α∞ ≥ⁿ ≥εδⁿΩε Σδ ≥σ⌡ τφα≈σφΦΘ,
- Ωε≥ε≡√σ σ±≥ⁿ Γ ∞α±±ΦΓσ. ═ε Γ ΣαδⁿφσΘ°σ∞ ΣεßαΓδ ≥ⁿ τφα≈σφΦ ∞εµφε ßστ
- ∩≡εßδσ∞, ∩≡ε±≥ε ²≥ε Γ√τεΓσ≥ τα⌡Γα≥ φεΓεΘ ∩α∞ ≥Φ ∩≡Φ ΣεßαΓδσφΦΦ ∩σ≡Γεπε
- µσ τφα≈σφΦ
- procedure MoveData(FromPos,Count,Offset);
- ∩σ≡σ∞σ±≥Φ≥ⁿ τα∩Φ±Φ Γ ∞α±±ΦΓσ, φα≈Φφα ± FromPos ΩεδΦ≈σ±≥Γε∞ Count φα ±∞σ∙σφΦσ Offset
-
-
- ─ε∩εδφσφΦ Σδ
- THArrayInteger, THArrayPointer, THArrayBoolean, THArrayInt64,
- THArrayCurrency, THArrayString, THArrayObjects, THArraySmallInt,
- THArrayWord, THArrayExtended,THArrayDouble, THArrayStringFix :
- function AddValue(Value:φ≤µφ√Θ ≥Φ∩):integer;
- ─εßαΓδ σ≥ ∩σ≡σΣαφφεσ τφα≈σφΦσ Γ ∞α±±ΦΓ
- property Value[Index:integer]:φ≤µφ√Θ ≥Φ∩; default;
- ─ε±≥≤∩ Ω τφα≈σφΦ■ ± ≤Ωαταφ√∞ ΦφΣσΩ±ε∞. ╥εδⁿΩε Ω ≥σ∞, Ωε≥ε≡√σ ≤µσ
- ±≤∙σ±≥Γ≤■≥ Γ ∞α±±ΦΓσ
- ─δ THArrayInteger Φ THArrayPointer, THArrayString:
- function IndexOf(Value:integer):integer;
- ╧εΦ±Ω ≤Ωαταφφεπε τφα≈σφΦ Γ ∞α±±ΦΓσ. ┼±δΦ φσ φαΘΣσφε - ΓετΓ≡α∙ασ≥ -1
-
-
- -------------- ⌡²°Φ ----------------------
-
- ╒²°Φ - ΣΦφα∞Φ≈σ±ΩΦσ ±≥≡≤Ω≥≤≡√, πΣσ ⌡≡αφ ≥± ²φα≈σφΦ ∩ε ΦφΣσΩ±≤
- ╬≥ ΣΦφα∞Φ≈σ±ΩΦ⌡ ∞α±±ΦΓεΓ ε≥δΦ≈α■≥± ≥σ∞, ≈≥ε
- 1) ⌡≡αφ ≥± ≥εδⁿΩε ≥σ τφα≈σφΦ , Ωε≥ε≡√σ ≤±≥αφεΓδσφ√,≥.σ. ∞εµφε ταφσ±≥Φ
- τφα≈σφΦσ ± ΦφΣσΩ±εΓ 1 Φ ± ΦφΣσΩ±ε∞ 1000000, ∩≡Φ ²≥ε∞ ß≤Σσ≥ ταφ ≥α ∩α∞ ≥ⁿ
- ≥εδⁿΩε Σδ ΣΓ≤⌡ τφα≈σφΦΘ. ╙Σεßφε Σδ τα∩ε∞ΦφαφΦ τφα≈σφΦΘ, ΦφΣσΩ±√ Ωε≥ε≡√⌡
- φσ ≤∩ε≡ Σε≈σφ√ Φ φσ δΦφσΘφ√
- 2) ΦφΣσΩ±ε∞ ∞εµσ≥ ±δ≤µΦ≥ⁿ φσ ≥εδⁿΩε integer (⌡ε≥ Γ φα±≥ε ∙σΘ ≡σαδΦτα÷ΦΦ
- Φ±∩εδⁿτ≤σ≥± ≥εδⁿΩε integer ΦφΣσΩ±√)
-
- THash :
- Property:
- property Count;
- ΩεδΦ≈σ±≥Γε τφα≈σφΦΘ Γ ⌡²°σ
- property Keys[Index:integer]:integer;
- ┬ετΓ≡α∙ασ≥ Ωδ■≈ ²δσ∞σφ≥α, ⌡≡αφ ∙σπε± Γ Index ∩ετΦ÷ΦΦ(Index: 0..Count-1)
-
- ╠σ≥εΣ√ :
- procedure Clear;
- ╬≈Φ±≥Ωα ßστ ε±ΓεßεµΣσφΦ ∩α∞ ≥Φ
- procedure ClearMem;
- ╬≈Φ±≥Ωα ⌡²°α ± ε±ΓεßεµΣσφΦσ∞ ∩α∞ ≥Φ
- function IfExist(Key:integer):boolean;
- ╧≡εΓσ≡Ωα - ±≤∙σ±≥Γ≤σ≥ δΦ ²δσ∞σφ≥ ± Ωδ■≈σ∞ Key
- procedure Delete(Key:integer);
- ╙Σαδ σ≥ τφα≈σφΦσ Σδ Ωδ■≈α Key
-
- ─δ THashExists,THashBoolean, THashInteger, THashPointer, THashCurrency, THashDouble, THashString :
- property Value[Index:integer]:φ≤µφ√Θ ≥Φ∩;
- ─ε±≥≤∩ Ω τφα≈σφΦ■ ± Ωδ■≈ε∞ Index. ┬ ε≥δΦ≈Φσ ε≥ THArray ∞εµφε ≤±≥αφαΓδΦΓα≥ⁿ
- Φ φσ ±≤∙σ±≥Γ≤■∙Φσ Σε ²≥επε ∞ε∞σφ≥α τφα≈σφΦ .
-
- ┬±σ ⌡²°Φ ∩≡Φ ≈≥σφΦΦ φσ±≤∙σ±≥Γ≤■∙σπε ²δσ∞σφ≥α Γ√Σα■≥ Φ±Ωδ■≈σφΦσ. ╧≡εΓσ≡Φ≥ⁿ
- ±≤∙σ±≥ΓεΓαφΦσ ∞εµφε ± ∩ε∞ε∙ⁿ■ IfExists
- THashExists Γδ σ≥± Φ±Ωδ■≈σφΦσ∞. ┬ φσ∞ ⌡≡αφ ≥± ≥εδⁿΩε τφα≈σφΦ True.
- ╤εε≥Γσ≥±≥Γσφφε, IfExists ß≤Σσ≥ Γ√ΣαΓα≥ⁿ ≥εδⁿΩε φα φΦ⌡ True, Φ φΦΩεπΣα
- φσ ß≤Σσ≥ ΓετφΦΩα≥ⁿ Φ±Ωδ■≈σφΦ . ═α τα∩≡ε± φσ±≤∙σ±≥Γ≤■∙σπε ²δσ∞σφ≥α
- ß≤Σσ≥ ΓετΓ≡α∙α≥ⁿ± τφα≈σφΦσ False, α ∩≡Φ ≤±≥αφεΓΩσ τφα≈σφΦ Γ False εφε ß≤Σσ≥
- ∩≡ε±≥ε ≤Σαδ ≥± .
-
- -------------- ΣΓεΘφ√σ ⌡²°Φ ----------------------
- ─ΓεΘφ√σ ⌡²°Φ ±δ≤µα≥ Σδ τα∩ε∞ΦφαφΦ ≥αßδΦ÷, πΣσ ±≥≡εΩΦ Φ ±≥εδß÷√ - integer
- ─ε±≥≤∩ Ω ΩαµΣε∞≤ ²δσ∞σφ≥≤ ε±≤∙σ±≥Γδ σ≥± ∩ε ΣΓ≤∞ ΦφΣσΩ±α∞ - πδαΓφε∞≤ Φ
- εß√≈φε∞≤. ╘ΦτΦ≈σ±ΩΦ ΣΓεΘφεΘ ⌡²° ∩≡σΣ±≥αΓδ σ≥ ±εßεΘ φαßε≡ εß√≈φ√⌡ ⌡²°σΘ
-
- THash2 :
- ╠σ≥εΣ√:
- procedure Clear;
- ╬≈Φ±≥Ωα ⌡²°α (ßστ ε±ΓεßεµΣσφΦ Γ√ΣσδσφφεΘ ∩α∞ ≥Φ)
- procedure ClearMem;
- ╬≈Φ±≥Ωα ⌡²°α ± ε±ΓεßεµΣσφΦσ∞ ∩α∞ ≥Φ
- procedure Delete(MainIndex,Index:integer);
- ╙Σαδ σ≥ ≤Ωαταφ√Θ ²δσ∞σφ≥
-
- ─δ THash2Exists,THash2Integer,THash2Currency,THash2String :
- ╠σ≥εΣ√:
- procedure SetValue(MainIndex,Index:integer;Value:φ≤µφ√Θ ≥Φ∩);
- ╙±≥αφαΓδΦΓασ≥ τφα≈σφΦσ Σδ ²≥Φ⌡ Ωδ■≈σΘ
- function GetValue(MainIndex,Index:integer):φ≤µφ√Θ ≥Φ∩;
- ╧εδ≤≈σφΦσ τφα≈σφΦ ∩ε Ωδ■≈α∞
- function CreateMainHash(MainIndex:integer):THash<φ≤µφ√Θ ≥Φ∩>;
- function CreateHash(Index:integer):THash<φ≤µφ√Θ ≥Φ∩>;
- ┬ετΓ≡α∙ασ≥ εß√≈φ√Θ ⌡²° Σδ εΣφεπε Φτ ≤Ωαταφ√⌡ ΦφΣσΩ±εΓ. ┼±δΦ τφα≈σφΦΘ φσ≥,
- Γ±σπΣα ΓετΓ≡α∙ασ≥ nil, Φ φΦΩεπΣα φσ ΓετΓ≡α∙ασ≥ ∩≤±≥εΘ ⌡²°.
- }
-
- interface
-
- uses Classes, Windows;
-
- resourcestring
- SItemNotFound = '═σ≥ ²δσ∞σφ≥α ± ΦφΣσΩ±ε∞ %d !';
- SKeyNotFound = '═σ≥ ²δσ∞σφ≥α ± Ωδ■≈σ∞ %d Γ Read-only ⌡σ°σ !';
-
- type
- dword=cardinal;
- pboolean = ^boolean;
- ppointer = ^pointer;
- pword = ^word;
- pextended = ^extended;
-
- THarray = class;
-
- {⌠-÷Φ ±≡αΓφσφΦ . ─εδµφα ΓετΓ≡α∙α≥ⁿ:
- 0 - ²δσ∞σφ≥√ ≡αΓφ√
- 1 - i-≥√Θ ²δσ∞σφ≥ > j-≥επε ²δσ∞σφ≥α
- -1 - j-≥√Θ ²δσ∞σφ≥ > i-≥επε ²δσ∞σφ≥α }
- TCompProc = function(arr : THArray;i,j : integer) : integer;
-
- THArray = class // εß∙ΦΘ Ωδα±± ∩≡α≡εΣΦ≥σδⁿ Γ±σ⌡ ΣΦφα∞Φ≈σ±ΩΦ⌡ ∞α±±ΦΓεΓ φσ ταΓΦ±Φ≥ ε≥ ≥Φ∩α ⌡≡αφΦ∞√⌡ Σαφφ√⌡
- private
- FCount:integer; // ΩεδΦ≈σ±≥Γε ²δσ∞σφ≥εΓ
- FCapacity:integer; // φα ±ΩεδⁿΩε ²δσ∞σφ≥εΓ τα⌡Γα≈σφε ∩α∞ ≥Φ
- FItemSize:integer; // ≡ατ∞σ≡ εΣφεπε ²δσ∞σφ≥α Γ ßαΘ≥α⌡
- procedure SetItemSize(Size:integer);
- protected
- FValues:pointer;
- procedure Error(Value,min,max:integer);
- function CalcAddr(num:integer):pointer; virtual;
- public
- constructor Create; virtual;
- destructor Destroy; override;
- procedure Clear;
- procedure ClearMem; virtual;
- function Add(pValue:pointer):integer; virtual;
- procedure AddMany(pValue:pointer;Count:integer);
- function Insert(num:integer;pValue:pointer):integer; virtual;
- procedure InsertMany(num:integer;pValue:pointer;Count:integer);
- procedure Delete(num:integer);virtual;
- procedure Update(num:integer;pValue:pointer);virtual;
- procedure UpdateMany(num:integer;pValue:pointer;Count:integer);
- procedure Get(num:integer;pValue:pointer); virtual;
- function GetAddr(num:integer):pointer;
- procedure SetCapacity(Value:integer);
- procedure AddFillValues(Value:integer);
- procedure Hold;
- procedure Grow;
- procedure GrowTo(Count:integer);
- procedure MoveData(FromPos,Count,Offset:integer);virtual;
- property Count:integer read FCount;
- property Capacity:integer read FCapacity;
- property Memory:pointer read FValues;
- property ItemSize:integer read FItemSize write SetItemSize;
- procedure Zero;
- procedure LoadFromStream(s:TStream);
- procedure Swap(Index1,Index2:integer);virtual;
- //±ε≡≥Φ≡εΓΩα HArray'α. ╤∞. ≥Φ∩ TCompProc
- procedure Sort(proc : TCompProc);
- published
- end;
-
- THArrayObjects = class(THArray)
- protected
- function GetValue(Index:integer):TObject;
- procedure SetValue(Index:integer;const Value:TObject);
- public
- constructor Create; override;
- procedure ClearMem; override; // (!) ≡ατ≡≤°ασ≥ Γ±σ ⌡≡αφΦ∞√σ εßⁿσΩ≥√ Φ ≤Σαδ σ≥ ±±√δΩΦ φα φΦ⌡
- procedure SafeClearMem; // ≤Σαδ σ≥ Γ±σ ±±√δΩΦ φα Γ±σ εßⁿσΩ≥√ _φσ_ ≡ατ≡≤°α Φ⌡
- procedure Delete(Index:integer); override; // (!) ≤Σαδ σ∞√Θ εßⁿσΩ≥ ≡ατ≡≤°ασ≥±
- procedure SafeDelete(Index:integer); // ≤Σαδ σ≥ ±±√δΩ≤ φα εßⁿσΩ≥ _φσ_ ≡ατ≡≤°α σπε
- function AddValue(Value:TObject):integer;
- property Value[Index:integer]:TObject read GetValue write SetValue; default;
- end;
-
- THArraySmallInt = class(THArray)
- private
- protected
- function GetValue(Index:integer):smallint;
- procedure SetValue(Index:integer;Value:smallint);
- public
- constructor Create; override;
- function AddValue(Value:smallint):integer;
- property Value[Index:integer]:smallint read GetValue write SetValue; default;
- published
- end;
-
- THArrayWord = class(THArray)
- private
- protected
- function GetValue(Index:integer):word;
- procedure SetValue(Index:integer;Value:word);
- public
- constructor Create; override;
- function AddValue(Value:word):integer;
- property Value[Index:integer]:word read GetValue write SetValue; default;
- published
- end;
-
- THArrayInt64 = class(THArray)
- private
- protected
- function GetValue(Index:integer):int64;
- procedure SetValue(Index:integer;Value:int64);
- public
- constructor Create; override;
- function AddValue(Value:int64):integer;
- property Value[Index:integer]:int64 read GetValue write SetValue; default;
- published
- end;
-
- THArrayLongWord = class(THArray)
- protected
- function GetValue(Index:integer):LongWord;
- procedure SetValue(Index:integer;Value:LongWord);
- public
- constructor Create; override;
- function IndexOf(Value:LongWord):integer;
- function IndexOfFrom(Value:LongWord;Start:integer):integer;
- function AddValue(Value:LongWord):integer;
- property Value[Index:integer]:LongWord read GetValue write SetValue; default;
- end;
-
- THArrayInteger = class(THArray)
- private
- 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 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;
- published
- end;
-
- THArrayPointer = class(THArray)
- private
- protected
- function GetValue(Index:integer):Pointer;
- procedure SetValue(Index:integer;Value:Pointer);
- public
- constructor Create; override;
- function IndexOf(Value:pointer):integer;
- function AddValue(Value:pointer):integer;
- property Value[Index:integer]:pointer read GetValue write SetValue; default;
- published
- end;
-
- THArrayBoolean = class(THArray)
- private
- protected
- function GetValue(Index:integer):Boolean;
- procedure SetValue(Index:integer;Value:Boolean);
- public
- constructor Create; override;
- function AddValue(Value:Boolean):integer;
- property Value[Index:integer]:Boolean read GetValue write SetValue; default;
- published
- end;
-
- THArrayDouble = class(THArray)
- private
- protected
- function GetValue(Index:integer):Double;
- procedure SetValue(Index:integer;Value:Double);
- public
- constructor Create; override;
- function AddValue(Value:double):integer;
- property Value[Index:integer]:double read GetValue write SetValue; default;
- published
- end;
-
- THArrayCurrency = class(THArray)
- private
- protected
- function GetValue(Index:integer):Currency;
- procedure SetValue(Index:integer;Value:Currency);
- public
- constructor Create; override;
- function AddValue(Value:currency):integer;
- property Value[Index:integer]:currency read GetValue write SetValue; default;
- published
- end;
-
- THArrayExtended = class(THArray)
- private
- protected
- function GetValue(Index:integer):Extended;
- procedure SetValue(Index:integer;Value:Extended);
- public
- constructor Create; override;
- function AddValue(Value:Extended):integer;
- property Value[Index:integer]:Extended read GetValue write SetValue; default;
- published
- 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;
- procedure Clear;
- procedure ClearMem;override;
- function AddValue(Value:string):integer;
- function Add(pValue:pointer):integer; override;
- procedure Delete(num:integer);override;
- function Insert(num:integer;pValue:pointer):integer; override;
- procedure Get(num:integer;pValue:pointer); override;
- procedure Update(num:integer;pValue:pointer);override;
- procedure MoveData(FromPos,Count,Offset:integer); override;
- function IndexOf(Value:string):integer;
- property Value[Index:integer]:string read GetValue write SetValue; default;
- published
- end;
-
- THArrayStringFix = class(THArray)
- private
- 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;
- property Value[Index:integer]:string read GetValue write SetValue; default;
- published
- end;
-
- 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; // ╧≡εΓσ≡Ωα ±≤∙σ±≥ΓεΓαφΦ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
- procedure Delete(Key:integer); virtual; abstract;
- 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;
- protected
- public
- constructor Create; override;
- destructor Destroy; override;
- procedure Delete(Key:integer); override;
- property Value[Index:integer]:boolean read GetValue write SetValue; default;
- published
- end;
-
- THashBoolean = class (THash)
- private
- FAValues:THArrayBoolean;
- procedure SetValue(Key:integer;Value:boolean);
- function GetValue(Key:integer):boolean;
- protected
- public
- constructor Create; override;
- constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayBoolean);
- destructor Destroy; override;
- procedure Delete(Key:integer); override;
- procedure Clear; override;
- procedure ClearMem; override;
- property Value[Index:integer]:boolean read GetValue write SetValue; default;
- published
- end;
-
- THashInteger = class (THash)
- private
- FAValues:THArrayInteger;
- procedure SetValue(Key:integer;Value:integer);
- function GetValue(Key:integer):integer;
- protected
- public
- constructor Create; override;
- constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayInteger);
- destructor Destroy; override;
- procedure Delete(Key:integer); override;
- procedure Clear; override;
- procedure ClearMem; override;
- property Value[Index:integer]:integer read GetValue write SetValue; default;
- property AValues:THArrayInteger read FAValues;
- published
- end;
-
- THashPointer = class (THash)
- private
- FAValues:THArrayPointer;
- procedure SetValue(Key:integer;Value:pointer);// ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
- function GetValue(Key:integer):pointer;// ╧εδ≤≈σφΦσ τφα≈σφΦ ∩ε Ωδ■≈≤
- protected
- public
- constructor Create; override;
- constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayPointer);
- destructor Destroy; override;
- procedure Delete(Key:integer); override;// ╙ΣαδσφΦσ τα∩Φ±Φ Key
- procedure Clear; override;
- procedure ClearMem; override;
- property Value[Index:integer]:pointer read GetValue write SetValue; default;
- property AValues:THArrayPointer read FAValues;
- published
- end;
-
- THashCurrency = class (THash)
- private
- FAValues:THArrayCurrency;
- procedure SetValue(Key:integer;Value:currency);// ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
- function GetValue(Key:integer):currency;// ╧εδ≤≈σφΦσ τφα≈σφΦ ∩ε Ωδ■≈≤
- protected
- public
- constructor Create; override;
- constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayCurrency);
- destructor Destroy; override;
- procedure Inc(Key:integer;Value:currency); // ╙ΓσδΦ≈σφΦσ τα∩Φ±Φ Key φα ΓσδΦ≈Φφ≤ Value (∩≡Φ ε≥±≤≥±≥ΓΦΦ τα∩Φ±Φ - ±ετΣασ≥)
- procedure Delete(Key:integer); override;// ╙ΣαδσφΦσ τα∩Φ±Φ Key
- procedure Clear; override;
- procedure ClearMem; override;
- property Value[Index:integer]:currency read GetValue write SetValue; default;
- published
- end;
-
- THashDouble = class (THash)
- private
- FAValues:THArrayDouble;
- procedure SetValue(Key:integer;Value:Double);// ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
- function GetValue(Key:integer):Double;// ╧εδ≤≈σφΦσ τφα≈σφΦ ∩ε Ωδ■≈≤
- protected
- public
- constructor Create; override;
- constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayDouble);
- destructor Destroy; override;
- procedure Inc(Key:integer;Value:Double); // ╙ΓσδΦ≈σφΦσ τα∩Φ±Φ Key φα ΓσδΦ≈Φφ≤ Value (∩≡Φ ε≥±≤≥±≥ΓΦΦ τα∩Φ±Φ - ±ετΣασ≥)
- procedure Delete(Key:integer); override;// ╙ΣαδσφΦσ τα∩Φ±Φ Key
- procedure Clear; override;
- procedure ClearMem; override;
- property Value[Index:integer]:Double read GetValue write SetValue; default;
- published
- end;
-
- THashString = class (THash)
- private
- FAllowEmptyStr:boolean;
- FAValues:TStrings;
- procedure SetValue(Key:integer;Value:string);
- function GetValue(Key:integer):string;
- protected
- public
- constructor Create; override;
- destructor Destroy; override;
- procedure Delete(Key:integer); override;
- procedure Clear; override;
- procedure ClearMem; override;
- property Value[Index:integer]:string read GetValue write SetValue; default;
- property AllowEmptyStr:boolean read FAllowEmptyStr write FAllowEmptyStr;
- 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; // ╬≈Φ±≥Ωα ⌡²°α (ßστ ε±ΓεßεµΣσφΦ Γ√ΣσδσφφεΘ ∩α∞ ≥Φ)
- procedure ClearMem; // ╬≈Φ±≥Ωα ⌡²°α ± ε±ΓεßεµΣσφΦσ∞ ∩α∞ ≥Φ
- 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)
- private
- protected
- public
- procedure SetValue(MainIndex,Index:integer;Value:boolean); // ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
- procedure Clear; override; // ╬≈Φ±≥Ωα ⌡²°α (ßστ ε±ΓεßεµΣσφΦ Γ√ΣσδσφφεΘ ∩α∞ ≥Φ)
- function GetValue(MainIndex,Index:integer):boolean; // ╧εδ≤≈σφΦσ τφα≈σφΦ ∩ε Ωδ■≈≤
- function CreateMainHash(MainIndex:integer):THashExists;
- function CreateHash(Index:integer):THashExists;
- // procedure ExportChildHash(Hash:THashBoolean);
- // procedure DeleteMainIndex(MainIndex:integer);
- // procedure DeleteIndex(Index:integer);
- published
- end;
-
- THash2Currency = class (THash2)
- private
- protected
- public
- procedure SetValue(MainIndex,Index:integer;Value:currency);// ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
- procedure Inc(MainIndex,Index:integer;Value:currency); // ≤ΓσδΦ≈σφΦσ ±≤∙σ±≥Γ≤■∙σΘ/±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
- procedure Clear; override; // ╬≈Φ±≥Ωα ⌡²°α (ßστ ε±ΓεßεµΣσφΦ Γ√ΣσδσφφεΘ ∩α∞ ≥Φ)
- function GetValue(MainIndex,Index:integer):currency; // ╧εδ≤≈σφΦσ τφα≈σφΦ ∩ε Ωδ■≈≤
- function CreateMainHash(MainIndex:integer):THashCurrency;
- function CreateHash(Index:integer):THashCurrency;
- // procedure ExportChildHash(Hash:THashCurrency);
- published
- end;
-
- THash2Integer = class (THash2)
- private
- protected
- public
- procedure SetValue(MainIndex,Index:integer;Value:Integer); // ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
- procedure Clear; override; // ╬≈Φ±≥Ωα ⌡²°α (ßστ ε±ΓεßεµΣσφΦ Γ√ΣσδσφφεΘ ∩α∞ ≥Φ)
- function GetValue(MainIndex,Index:integer):Integer; // ╧εδ≤≈σφΦσ τφα≈σφΦ ∩ε Ωδ■≈≤
- function CreateMainHash(MainIndex:integer):THashInteger;
- function CreateHash(Index:integer):THashInteger;
- // procedure ExportChildHash(Hash:THashInteger);
- published
- end;
-
- THash2String = class (THash2)
- private
- protected
- procedure SetValue(MainIndex,Index:integer;Value:String); // ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
- function GetValue(MainIndex,Index:integer):String; // ╧εδ≤≈σφΦσ τφα≈σφΦ ∩ε Ωδ■≈≤
- 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;
- published
- end;
-
- procedure memcpy(pi,po:pointer;Count:integer); stdcall;
- procedure memclr(po:pointer;Count:integer); stdcall;
- procedure memset(po:pointer;Value:byte;Count:integer); stdcall;
- function memfind(pi:pointer;Value:dword;Count:integer):integer; stdcall;
-
- implementation
-
- uses SysUtils;
-
- const
- BLOCK=1024;
-
- function HGetToken(InputString:string; Delimiters:string; OnlyOneDelimiter:boolean; Index:integer):string;
- var i,p:integer;
- begin
- Result:='';
- p:=1;
- while (p<=length(InputString)) and (pos(InputString[p],Delimiters)<>0) do
- inc(p);
- for i:=1 to index do begin
- while (p<=length(InputString)) and (pos(InputString[p],Delimiters)=0)
- do inc(p);
-
- if OnlyOneDelimiter
- then inc(p)
- else while (p<=length(InputString)) and (pos(InputString[p],Delimiters)<>0) do inc(p);
- end;
- while (p<=length(InputString)) and (pos(InputString[p],Delimiters)=0)
- do begin Result:=Result+InputString[p]; inc(p); end;
- end;
-
- function HGetTokenCount(InputString:string; Delimiters:string; OnlyOneDelimiter:boolean):integer;
- var p:integer;
- begin
- Result:=0;
- if InputString='' then exit;
- p:=1;
- while (p<=length(InputString)) and (pos(InputString[p],Delimiters)<>0) do
- inc(p);
- while (p<=length(InputString)) do begin
- while (p<=length(InputString)) and (pos(InputString[p],Delimiters)=0)
- do inc(p);
-
- if OnlyOneDelimiter
- then inc(p)
- else while (p<=length(InputString)) and (pos(InputString[p],Delimiters)<>0) do inc(p);
- Result:=Result+1;
- end;
- Result:=Result;
- end;
-
- procedure memcpy(pi,po:pointer;Count:integer); stdcall;
- begin
- if ((dword(pi)+dword(Count))>dword(po)) and (dword(pi)<dword(po)) then // Ωε∩Φ≡εΓαφΦσ ± Ωεφ÷α
- asm
- pushad
- pushfd
- mov ECX,Count
- mov EDI,po
- mov ESI,pi
- add ESI,ECX
- add EDI,ECX
- dec ESI
- dec EDI
- std
- repne MOVSB
- popfd
- popad
- end else // Ωε∩Φ≡εΓαφΦσ ± φα≈αδα
- asm
- pushad
- pushfd
- mov ECX,Count
- mov EDI,po
- mov ESI,pi
- cld
- repne MOVSB
- popfd
- popad
- end;
- end;
-
- procedure memclr(po:pointer;Count:integer); stdcall;
- begin
- asm
- pushad
- pushfd
- mov ECX,Count
- mov EDI,po
- xor AL,AL
- cld
- repne STOSB
- popfd
- popad
- end;
- end;
-
- procedure memset(po:pointer;Value:byte;Count:integer); stdcall;
- begin
- asm
- pushad
- pushfd
- mov ECX,Count
- mov EDI,po
- mov AL,Value
- cld
- repne STOSB
- popfd
- popad
- end;
- end;
-
- function memfind(pi:pointer;Value:dword;Count:integer):integer; stdcall;
- label ex;
- begin
- asm
- pushad
- pushfd
- mov Result,0
- mov ECX,Count
- cmp ECX,0
- jz ex
- mov EAX,Value
- mov EDI,pi
- cld
- repne SCASD
- jne ex
- mov EAX,Count
- sub EAX,ECX
- mov Result,EAX
- ex:
- dec Result
- popfd
- popad
- end;
- end;
-
- { THArray }
-
- constructor THArray.Create;
- begin
- inherited Create;
-
- FCount:=0;
- FCapacity:=0;
- FItemSize:=1;
- FValues:=nil;
- end;
-
- destructor THArray.Destroy;
- begin
- ClearMem;
- FItemSize:=0;
- inherited Destroy;
- end;
-
- procedure THArray.Delete(num:integer);
- begin
- if num>=FCount then raise ERangeError.Create(Format(SItemNotFound,[num]));
- if num<(FCount-1) then memcpy(GetAddr(num+1),GetAddr(num),(FCount-num-1)*FItemSize);
- Dec(FCount);
- end;
-
- procedure THArray.Clear;
- begin
- FCount:=0;
- end;
-
- procedure THArray.ClearMem;
- begin
- FCount:=0;
- FCapacity:=0;
- FreeMem(FValues);
- FValues:=nil;
- end;
-
- function THArray.Add(pValue:pointer):integer;
- begin
- Result:=Insert(FCount,pValue);
- end;
-
- procedure THArray.AddMany(pValue:pointer;Count:integer);
- begin
- if Count<=0 then exit;
- InsertMany(FCount,pValue,Count);
- end;
-
- procedure THarray.Hold;
- // ∩α∞ ≥ⁿ ε≥ΓεΣΦ∞ ≥εδⁿΩε φα Count ²δσ∞σφ≥εΓ
- begin
- SetCapacity(FCount);
- end;
-
- procedure THArray.SetCapacity(Value:integer);
- begin
- ReAllocMem(FValues,Value*FItemSize);
- FCapacity:=Value;
- if FCount>FCapacity then FCount:=FCapacity;
- end;
-
- procedure THArray.AddFillValues(Value:integer);
- begin
- if Count+Value>Capacity then GrowTo(Count+Value);
- memclr(CalcAddr(FCount),Value*ItemSize);
- FCount:=FCount+Value;
- end;
-
- procedure THArray.Zero;
- begin
- if FCount=0 then exit;
- memclr(Memory,FCount*ItemSize);
- end;
-
- procedure THArray.Grow;
- // τα⌡Γα≥√Γασ≥ ∩α∞ ≥ⁿ Σδ ßεδⁿ°σπε ΩεδΦ≈σ±≥Γε ²δσ∞σφ≥εΓ
- // ≡ατ∞σ≡ τα⌡Γα≈σφεΘ ∩α∞ ≥Φ ≤ΓσδΦ≈ΦΓασ≥± φα 25% σ±δΦ ⌡≡αφΦ≥± ßεδσσ 64 ²δσ∞σφ≥εΓ
- // ≡ατ∞σ≡ τα⌡Γα≈σφεΘ ∩α∞ ≥Φ ≤ΓσδΦ≈ΦΓασ≥± φα 16 ²δσ∞σφ≥εΓ σ±δΦ ⌡≡αφΦ≥± ε≥ 8 Σε 64 ²δσ∞σφ≥εΓ
- // ≡ατ∞σ≡ τα⌡Γα≈σφεΘ ∩α∞ ≥Φ ≤ΓσδΦ≈ΦΓασ≥± φα 4 ²δσ∞σφ≥α σ±δΦ ⌡≡αφΦ≥± ∞σφσσ 8 ²δσ∞σφ≥εΓ
- var Delta:integer;
- begin
- if FCapacity > 64 then Delta := FCapacity div 4 else
- if FCapacity > 8 then Delta := 16 else Delta := 4;
- SetCapacity(FCapacity + Delta);
- end;
-
- procedure THArray.GrowTo(Count:integer);
- // ≡α±≥σ∞ δΦßε Σε ╤ount ²δσ∞σφ≥εΓ (σ±δΦ εφε Σε±≥α≥ε≈φε ΓσδΦΩε) δΦßε ±ΩεδⁿΩε φ≤µφε ∩ε Grow
- var Delta:integer;
- begin
- if Count<=FCapacity then exit;
-
- if FCapacity > 64 then Delta := FCapacity div 4 else
- if FCapacity > 8 then Delta := 16 else Delta := 4;
- if (FCapacity+Delta)<Count then Delta:=Count-FCapacity;
- SetCapacity(FCapacity + Delta);
- end;
-
- function THArray.Insert(num:integer;pValue:pointer):integer;
- begin
- Error(num,0,FCount);
- if FCount>=FCapacity then begin
- Grow;
- end;
-
- inc(FCount);
- memcpy(CalcAddr(num),CalcAddr(num+1),(FCount-num-1)*FItemSize); // ≡ατΣΓΦπασ∞ ²δσ∞σφ≥√ Σδ Γ±≥αΓΩΦ
- Update(num,pValue); // τα∩Φ±√Γασ∞ ²δσ∞σφ≥
- Result:=num;
- end;
-
- procedure THArray.InsertMany(num:integer;pValue:pointer;Count:integer);
- begin
- Error(num,0,FCount);
- if FCount+Count>FCapacity then GrowTo(FCount+Count);
-
- FCount:=FCount+Count;
- memcpy(CalcAddr(num),CalcAddr(num+Count),(FCount-num-Count)*FItemSize);
- UpdateMany(num,pValue,Count);
- end;
-
- procedure THArray.Update(num:integer;pValue:pointer);
- begin
- if pValue=nil
- then memclr(GetAddr(num),FItemSize)
- else memcpy(pValue,GetAddr(num),FItemSize);
- end;
-
- procedure THArray.UpdateMany(num:integer;pValue:pointer;Count:integer);
- begin
- Error(num+Count,0,FCount);
- memcpy(pValue,GetAddr(num),FItemSize*Count);
- end;
-
- procedure THArray.Get(num:integer;pValue:pointer);
- begin
- memcpy(GetAddr(num),pValue,FItemSize);
- end;
-
- function THArray.GetAddr(num:integer):pointer;
- begin
- Error(num,0,FCount-1);
- Result:=CalcAddr(num);
- end;
-
- function THArray.CalcAddr(num:integer):pointer;
- begin
- Result:=pointer(dword(FValues)+dword(num)*dword(FItemSize));
- end;
-
- procedure THArray.Error(Value,min,max:integer);
- begin
- if (Value<min) or (Value>max) then raise ERangeError.Create(Format(SItemNotFound,[Value]));
- end;
-
- procedure THArray.SetItemSize(Size:integer);
- begin
- ClearMem;
- if (FCount=0) and (Size>0) then FItemSize:=Size;
- end;
-
- procedure THArray.MoveData(FromPos,Count,Offset:integer);
- var mem:pointer;
- begin
- Error(FromPos,0,FCount-1);
- Error(FromPos+Count,0,FCount);
- Error(FromPos+Offset,0,FCount-1);
- Error(FromPos+Offset+Count,0,FCount);
- mem:=AllocMem(Count*FItemSize);
- memcpy(CalcAddr(FromPos),mem,Count*FItemSize);
- if Offset<0 then memcpy(CalcAddr(FromPos+Offset),CalcAddr(FromPos+Offset+Count),(-Offset)*FItemSize);
- if Offset>0 then memcpy(CalcAddr(FromPos+Count),CalcAddr(FromPos),Offset*FItemSize);
- memcpy(mem,CalcAddr(FromPos+Offset),Count*FItemSize);
- FreeMem(mem);
- end;
-
- procedure THArray.Sort(proc : TCompProc);
- var
- maxEl : integer;
- i,j : integer;
- begin
- if Count<2 then exit;
-
- for i:=0 to Count-2 do
- begin
- maxEl:=i;
- for j:=i+1 to Count-1 do
- if proc(self,maxEl,j)<0 then maxEl:=j;
- if maxEl<>i then
- begin
- MoveData(i,1,maxEl-i);
- MoveData(maxEl-1,1,i-maxEl+1);
- end;
- end;
- end;
-
- procedure THArray.LoadFromStream(s: TStream);
- var i,oc:integer;
- begin
- s.Read(i,sizeof(i));
- oc:=FCount;
- AddFillValues(i);
- s.Read(CalcAddr(oc)^,i*FItemSize);
- end;
-
- procedure THArray.Swap(Index1, Index2: integer);
- var p:pointer;
- begin
- p:=AllocMem(FItemSize);
- memcpy(GetAddr(Index1),p,FItemSize);
- memcpy(GetAddr(Index2),GetAddr(Index1),FItemSize);
- memcpy(p,GetAddr(Index2),FItemSize);
- end;
-
- { THArraySmallInt }
-
- constructor THArraySmallInt.Create;
- begin
- inherited Create;
- FItemSize:=sizeof(smallint);
- end;
-
- function THArraySmallInt.AddValue(Value:smallint):integer;
- begin
- Result:=inherited Add(@Value);
- end;
-
- function THArraySmallInt.GetValue(Index:integer):smallint;
- begin
- Result:=psmallint(GetAddr(Index))^;
- end;
-
- procedure THArraySmallInt.SetValue(Index:integer;Value:smallint);
- begin
- Update(Index,@Value);
- end;
-
- { THArrayWord }
-
- constructor THArrayWord.Create;
- begin
- inherited Create;
- FItemSize:=sizeof(Word);
- end;
-
- function THArrayWord.AddValue(Value:Word):integer;
- begin
- Result:=inherited Add(@Value);
- end;
-
- function THArrayWord.GetValue(Index:integer):Word;
- begin
- Result:=pword(GetAddr(Index))^;
- end;
-
- procedure THArrayWord.SetValue(Index:integer;Value:Word);
- begin
- Update(Index,@Value);
- end;
-
- { THArrayLongWord }
-
- constructor THArrayLongWord.Create;
- begin
- inherited Create;
- FItemSize:=sizeof(LongWord);
- end;
-
- function THArrayLongWord.AddValue(Value:LongWord):integer;
- begin
- Result:=inherited Add(@Value);
- end;
-
- function THArrayLongWord.GetValue(Index:integer):LongWord;
- begin
- Result:=pLongWord(GetAddr(Index))^;
- end;
-
- procedure THArrayLongWord.SetValue(Index:integer;Value:LongWord);
- begin
- Update(Index,@Value);
- end;
-
- function THArrayLongWord.IndexOf(Value: LongWord): integer;
- begin
- Result:=IndexOfFrom(Value,0);
- end;
-
- function THArrayLongWord.IndexOfFrom(Value: LongWord; Start: integer): integer;
- var i:integer;
- begin
- if Count=0 then begin
- Result:=-1;
- exit;
- end;
- Error(Start,0,Count-1);
- if Assigned(FValues) then
- for i:=Start to Count-1 do
- if self.Value[i]=Value then begin
- Result:=i;
- exit;
- end;
- Result:=-1;
- end;
-
- { THArrayInt64 }
-
- constructor THArrayInt64.Create;
- begin
- inherited Create;
- FItemSize:=sizeof(Int64);
- end;
-
- function THArrayInt64.AddValue(Value:Int64):integer;
- begin
- Result:=inherited Add(@Value);
- end;
-
- function THArrayInt64.GetValue(Index:integer):Int64;
- begin
- Result:=pint64(GetAddr(Index))^;
- end;
-
- procedure THArrayInt64.SetValue(Index:integer;Value:Int64);
- begin
- Update(Index,@Value);
- end;
-
- { THArrayInteger }
-
- constructor THArrayInteger.Create;
- begin
- inherited Create;
- FItemSize:=sizeof(integer);
- end;
-
- function THArrayInteger.AddValue(Value:integer):integer;
- begin
- Result:=inherited Add(@Value);
- end;
-
- function THArrayInteger.IndexOf(Value:integer):integer;
- begin
- Result:=IndexOfFrom(Value,0);
- end;
-
- function THArrayInteger.IndexOfFrom(Value:integer;Start:integer):integer;
- begin
- if Start=Count then begin
- Result:=-1;
- exit;
- end;
- Error(Start,0,Count-1);
- if FValues=nil
- then Result:=-1
- else begin
- Result:=memfind(GetAddr(Start),dword(Value),Count-Start);
- if Result<>-1 then Result:=Result+Start;
- end;
- end;
-
- function THArrayInteger.GetValue(Index:integer):integer;
- begin
- Result:=pinteger(GetAddr(Index))^;
- end;
-
- procedure THArrayInteger.SetValue(Index:integer;Value:Integer);
- begin
- Update(Index,@Value);
- end;
-
- procedure THArrayInteger.Push(Value:Integer);
- begin
- AddValue(Value);
- end;
-
- function THArrayInteger.Pop:integer;
- begin
- Result:=Value[Count-1];
- Delete(Count-1);
- end;
-
- procedure THArrayInteger.AddFromString(InputString,Delimiters:string);
- var i,c:integer;
- begin
- c:=HGetTokenCount(InputString,Delimiters,False);
- for i:=0 to c-1 do
- AddValue(StrToInt(HGetToken(InputString,Delimiters,False,i)));
- end;
-
- function THArrayInteger.GetAsString:string;
- var i:integer;
- begin
- Result:=' ';
- for i:=0 to Count-1 do
- Result:=Result+IntToStr(Value[i])+' ';
- end;
-
- function THArrayInteger.CalcMax: integer;
- var i:integer;
- begin
- if Count=0 then begin Result:=-1; exit; end;
- Result:=Value[0];
- for i:=1 to Count-1 do
- if Value[i]>Result then Result:=Value[i];
- end;
-
- { THArrayPointer }
-
- constructor THArrayPointer.Create;
- begin
- inherited Create;
- FItemSize:=sizeof(pointer);
- end;
-
- function THArrayPointer.AddValue(Value:pointer):integer;
- begin
- Result:=inherited Add(@Value);
- end;
-
- function THArrayPointer.IndexOf(Value:pointer):integer;
- begin
- Result:=memfind(FValues,dword(Value),Count);
- end;
-
- function THArrayPointer.GetValue(Index:integer):Pointer;
- begin
- Result:=ppointer(GetAddr(Index))^;
- end;
-
- procedure THArrayPointer.SetValue(Index:integer;Value:Pointer);
- begin
- Update(Index,@Value);
- end;
-
- { THArrayBoolean }
-
- constructor THArrayBoolean.Create;
- begin
- inherited Create;
- FItemSize:=sizeof(boolean);
- end;
-
- function THArrayBoolean.AddValue(Value:boolean):integer;
- begin
- Result:=inherited Add(@Value);
- end;
-
- function THArrayBoolean.GetValue(Index:integer):Boolean;
- begin
- Result:=pboolean(GetAddr(Index))^;
- end;
-
- procedure THArrayBoolean.SetValue(Index:integer;Value:Boolean);
- begin
- Update(Index,@Value);
- end;
-
- { THArrayDouble }
-
- constructor THArrayDouble.Create;
- begin
- inherited Create;
- FItemSize:=sizeof(Double);
- end;
-
- function THArrayDouble.AddValue(Value:Double):integer;
- begin
- Result:=inherited Add(@Value);
- end;
-
- function THArrayDouble.GetValue(Index:integer):Double;
- begin
- Result:=pdouble(GetAddr(Index))^;
- end;
-
- procedure THArrayDouble.SetValue(Index:integer;Value:Double);
- begin
- Update(Index,@Value);
- end;
-
- { THArrayExtended }
-
- constructor THArrayExtended.Create;
- begin
- inherited Create;
- FItemSize:=sizeof(Extended);
- end;
-
- function THArrayExtended.GetValue(Index: integer): Extended;
- begin
- Result:=pextended(GetAddr(Index))^;
- end;
-
- function THArrayExtended.AddValue(Value: Extended): integer;
- begin
- Result:=inherited Add(@Value);
- end;
-
- procedure THArrayExtended.SetValue(Index: integer; Value: Extended);
- begin
- Update(Index,@Value);
- end;
-
- { THArrayCurrency }
-
- constructor THArrayCurrency.Create;
- begin
- inherited Create;
- FItemSize:=sizeof(currency);
- end;
-
- function THArrayCurrency.AddValue(Value:Currency):integer;
- begin
- Result:=inherited Add(@Value);
- end;
-
- function THArrayCurrency.GetValue(Index:integer):Currency;
- begin
- Result:=pcurrency(GetAddr(Index))^;
- end;
-
- procedure THArrayCurrency.SetValue(Index:integer;Value:Currency);
- begin
- Update(Index,@Value);
- end;
-
- { THArrayString }
-
- constructor THArrayString.Create;
- begin
- str_ptr:=THArrayPointer.Create;
- FCount:=0;
- FCapacity:=0;
- FItemSize:=0;
- FValues:=nil;
- end;
-
- destructor THArrayString.Destroy;
- var
- i : integer;
- pStr : PChar;
- begin
- for i:=0 to str_ptr.Count-1 do
- begin
- pStr:=PChar(str_ptr.Value[i]);
- StrDispose(pStr);
- end;
- str_ptr.Free;
- end;
-
- function THArrayString.CalcAddr(num:integer):pointer;
- begin
- Result:=pointer(dword(str_ptr.FValues)+dword(num)*dword(FItemSize));
- end;
-
- function THArrayString.AddValue(Value:String):integer;
- begin
- result:=self.Add(PChar(Value));
- end;
-
- function THArrayString.Add(pValue:pointer):integer;
- begin
- Result:=Insert(FCount,pValue);
- end;
-
- function THArrayString.Insert(num:integer;pValue:pointer):integer;
- var
- pStr : PChar;
- l : integer;
- begin
- l:=StrLen(PChar(pValue));
- pStr:=StrAlloc(l+1);
- memcpy(pValue,pStr,l+1);
- str_ptr.Insert(num,@pStr);
- FCount:=str_ptr.Count;
- FCapacity:=str_ptr.Capacity;
- Result:=FCount;
- end;
-
- procedure THArrayString.Update(num:integer;pValue:pointer);
- var
- pStr : PChar;
- l : integer;
- begin
- pStr:=PChar(str_ptr.Value[num]);
- if pStr<>nil then StrDispose(pStr);
-
- if pValue<>nil then begin
- l:=StrLen(PChar(pValue));
- pStr:=StrAlloc(l+1);
- memcpy(pValue,pStr,l+1);
- str_ptr.Value[num]:=pStr;
- end else
- str_ptr.Value[num]:=nil;
- end;
-
- procedure THArrayString.MoveData(FromPos,Count,Offset:integer);
- begin
- str_ptr.MoveData(FromPos, Count, Offset);
- end;
-
- procedure THArrayString.Delete(num:integer);
- var pStr:PChar;
- begin
- pStr:=PChar(str_ptr.Value[num]);
- StrDispose(pStr);
- str_ptr.Delete(num);
- FCount:=str_ptr.Count;
- end;
-
- procedure THArrayString.Get(num:integer;pValue:pointer);
- var
- pStr : PChar;
- l : integer;
- begin
- pStr:=PChar(str_ptr.Value[num]);
- l:=StrLen(pStr);
- memcpy(pointer(pStr),pValue,l+1);
- end;
-
- function THArrayString.GetValue(Index:integer):String;
- var
- pStr : PChar;
- begin
- pStr:=PChar(str_ptr.Value[Index]);
- result:=pStr;
- end;
-
- procedure THArrayString.SetValue(Index:integer;Value:String);
- begin
- self.Update(Index,pointer(Value));
- end;
-
- procedure THArrayString.Clear;
- var i:integer;
- pStr:PChar;
- begin
- for i:=0 to str_ptr.Count-1 do
- begin
- pStr:=PChar(str_ptr.Value[i]);
- StrDispose(pStr);
- end;
- str_ptr.Clear;
- FCount:=0;
- FCapacity:=0;
- end;
-
- procedure THArrayString.ClearMem;
- var
- i : integer;
- pStr : PChar;
- begin
- for i:=0 to str_ptr.Count-1 do
- begin
- pStr:=PChar(str_ptr.Value[i]);
- StrDispose(pStr);
- end;
- str_ptr.ClearMem;
- inherited ClearMem;
- end;
-
- function THArrayString.IndexOf(Value:string):integer;
- var i : integer;
- PVal : PChar;
- begin
- PVal := PChar(Value);
- for i := 0 to Count-1 do
- begin
- if (StrComp(PVal,PChar(str_ptr.Value[i])) = 0) then
- begin
- Result:=i;
- exit;
- end;
- end;
- Result := -1;
- end;
-
- { THArrayStringFix }
-
- function THArrayStringFix.AddValue(Value: string): integer;
- var buf:pointer;
- begin
- buf:=AllocMem(FItemSize+1);
- memclr(buf,FItemSize+1);
- try
- strplcopy(buf,Value,FItemSize);
- Result:=inherited Add(buf);
- finally
- FreeMem(buf);
- end;
- end;
-
- constructor THArrayStringFix.Create;
- begin
- raise Exception.Create('Use CreateSize !');
- end;
-
- constructor THArrayStringFix.CreateSize(Size: integer);
- begin
- inherited Create;
- FItemSize:=Size;
- end;
-
- function THArrayStringFix.GetValue(Index: integer): string;
- var buf:pointer;
- begin
- buf:=AllocMem(FItemSize+1);
- memclr(buf,FItemSize+1);
- try
- memcpy(GetAddr(Index),buf,FItemSize);
- Result:=strpas(buf);
- finally
- FreeMem(buf);
- end;
- end;
-
- procedure THArrayStringFix.SetValue(Index: integer; Value: string);
- var buf:pointer;
- begin
- buf:=AllocMem(FItemSize+1);
- memclr(buf,FItemSize+1);
- try
- strplcopy(buf,Value,FItemSize);
- inherited Update(Index,buf);
- finally
- FreeMem(buf);
- end;
- end;
-
- { THArrayObjects }
-
- function THArrayObjects.AddValue(Value: TObject): integer;
- begin
- Result:=inherited Add(@Value);
- end;
-
- procedure THArrayObjects.ClearMem;
- var i:integer;
- begin
- for i:=0 to Count-1 do GetValue(i).Free;
- inherited;
- end;
-
- procedure THArrayObjects.SafeClearMem;
- begin
- inherited ClearMem;
- end;
-
- constructor THArrayObjects.Create;
- begin
- inherited;
- FItemSize:=sizeof(TObject);
- end;
-
- procedure THArrayObjects.Delete(Index: integer);
- var o:TObject;
- begin
- o:=GetValue(Index);
- inherited;
- if Assigned(o) then o.Free;
- end;
-
- procedure THArrayObjects.SafeDelete(Index: integer);
- begin
- inherited Delete(Index);
- end;
-
- function THArrayObjects.GetValue(Index: integer): TObject;
- begin
- Result:=TObject(GetAddr(Index)^);
- end;
-
-
- procedure THArrayObjects.SetValue(Index: integer;const Value: TObject);
- begin
- Update(Index,@Value);
- end;
-
- { THash }
-
- constructor THash.Create;
- begin
- FReadOnly:=False;
- FAIndex:=THArrayInteger.Create;
- end;
-
- destructor THash.Destroy;
- begin
- if not FReadOnly then FAIndex.Free;
- inherited Destroy;
- end;
-
- procedure THash.Clear;
- begin
- FAIndex.Clear;
- end;
-
- procedure THash.ClearMem;
- begin
- FAIndex.ClearMem;
- end;
-
- function THash.GetCount:integer;
- begin
- Result:=FAIndex.Count;
- end;
-
- function THash.GetKey(Index:integer):integer;
- begin
- Result:=FAIndex[Index];
- end;
-
- function THash.IfExist(Key:integer):boolean;
- begin
- Result:=FAIndex.IndexOf(Key)<>-1;
- end;
-
- { THashExists }
-
- constructor THashExists.Create;
- begin
- inherited Create;
- end;
-
- destructor THashExists.Destroy;
- begin
- inherited Destroy;
- end;
-
- procedure THashExists.SetValue(Index:integer;Value:boolean);
- var r:integer;
- begin
- r:=FAIndex.IndexOf(Index);
- if (r=-1) and Value then FAIndex.AddValue(Index);
- if (r<>-1) and (not Value) then FAIndex.Delete(r);
- end;
-
- procedure THashExists.Delete(Key:integer);
- var r:integer;
- begin
- r:=FAIndex.IndexOf(Key);
- if (r<>-1) then FAIndex.Delete(r);
- end;
-
- function THashExists.GetValue(Index:integer):boolean;
- var r:integer;
- begin
- r:=FAIndex.IndexOf(Index);
- Result:=(r<>-1);
- end;
-
- { THashBoolean }
-
- constructor THashBoolean.Create;
- begin
- inherited Create;
- FAValues:=THArrayBoolean.Create;
- end;
-
- constructor THashBoolean.CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayBoolean);
- begin
- FAIndex:=IndexHArray;
- FAValues:=ValueHArray;
- FReadOnly:=True;
- end;
-
- destructor THashBoolean.Destroy;
- begin
- if not FReadOnly then FAValues.Free;
- inherited Destroy;
- end;
-
- procedure THashBoolean.SetValue(Key:integer;Value:boolean);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAValues[n]:=Value;
- exit;
- end;
- if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
- FAIndex.AddValue(Key);
- FAValues.AddValue(Value);
- end;
-
- function THashBoolean.GetValue(Key:integer):boolean;
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- Result:=FAValues[n];
- end else begin
- Result:=False;
- end;
- end;
-
- procedure THashBoolean.Clear;
- begin
- inherited Clear;
- FAValues.Clear;
- end;
-
- procedure THashBoolean.ClearMem;
- begin
- inherited ClearMem;
- FAValues.ClearMem;
- end;
-
- procedure THashBoolean.Delete(Key:integer);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAIndex.Delete(n);
- FAValues.Delete(n);
- end;
- end;
-
- { THashInteger }
-
- constructor THashInteger.Create;
- begin
- inherited Create;
- FAValues:=THArrayInteger.Create;
- end;
-
- constructor THashInteger.CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayInteger);
- begin
- FAIndex:=IndexHArray;
- FAValues:=ValueHArray;
- FReadOnly:=True;
- end;
-
- destructor THashInteger.Destroy;
- begin
- if not FReadOnly then FAValues.Free;
- inherited Destroy;
- end;
-
- procedure THashInteger.SetValue(Key:integer;Value:integer);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAValues[n]:=Value;
- exit;
- end;
- if FReadOnly then raise Exception.Create(Format(SKeyNotFound,[Key]));
- FAIndex.AddValue(Key);
- FAValues.AddValue(Value);
- end;
-
- function THashInteger.GetValue(Key:integer):integer;
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- Result:=FAValues[n];
- end else begin
- Result:=0;
- end;
- end;
-
- procedure THashInteger.Clear;
- begin
- inherited Clear;
- FAValues.Clear;
- end;
-
- procedure THashInteger.ClearMem;
- begin
- inherited ClearMem;
- FAValues.ClearMem;
- end;
-
- procedure THashInteger.Delete(Key:integer);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAIndex.Delete(n);
- FAValues.Delete(n);
- end;
- end;
-
- { THashPointer }
-
- constructor THashPointer.Create;
- begin
- inherited Create;
- FAValues:=THArrayPointer.Create;
- end;
-
- constructor THashPointer.CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayPointer);
- begin
- FAIndex:=IndexHArray;
- FAValues:=ValueHArray;
- FReadOnly:=True;
- end;
-
- destructor THashPointer.Destroy;
- begin
- if not FReadOnly then FAValues.Free;
- inherited Destroy;
- end;
-
- procedure THashPointer.SetValue(Key:integer;Value:Pointer);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAValues[n]:=Value;
- exit;
- end;
- if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
- FAIndex.AddValue(Key);
- FAValues.AddValue(Value);
- end;
-
- function THashPointer.GetValue(Key:integer):Pointer;
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- Result:=FAValues[n];
- end else begin
- Result:=nil;
- end;
- end;
-
- procedure THashPointer.Clear;
- begin
- inherited Clear;
- FAValues.Clear;
- end;
-
- procedure THashPointer.ClearMem;
- begin
- inherited ClearMem;
- FAValues.ClearMem;
- end;
-
- procedure THashPointer.Delete(Key:integer);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAIndex.Delete(n);
- FAValues.Delete(n);
- end;
- end;
-
- { THashCurrency }
-
- constructor THashCurrency.Create;
- begin
- inherited Create;
- FAValues:=THArrayCurrency.Create;
- end;
-
- constructor THashCurrency.CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayCurrency);
- begin
- FAIndex:=IndexHArray;
- FAValues:=ValueHArray;
- FReadOnly:=True;
- end;
-
- destructor THashCurrency.Destroy;
- begin
- if not FReadOnly then FAValues.Free;
- inherited Destroy;
- end;
-
- procedure THashCurrency.SetValue(Key:integer;Value:currency);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAValues[n]:=Value;
- exit;
- end;
- if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
- FAIndex.AddValue(Key);
- FAValues.AddValue(Value);
- end;
-
- procedure THashCurrency.Inc(Key:integer;Value:currency);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAValues[n]:=FAValues[n]+Value;
- end else begin
- if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
- SetValue(Key,Value);
- end;
- end;
-
- function THashCurrency.GetValue(Key:integer):currency;
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- Result:=FAValues[n];
- end else begin
- Result:=0;
- end;
- end;
-
- procedure THashCurrency.Clear;
- begin
- inherited Clear;
- FAValues.Clear;
- end;
-
- procedure THashCurrency.ClearMem;
- begin
- inherited ClearMem;
- FAValues.ClearMem;
- end;
-
- procedure THashCurrency.Delete(Key:integer);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAIndex.Delete(n);
- FAValues.Delete(n);
- end;
- end;
-
- { THashDouble }
-
- constructor THashDouble.Create;
- begin
- inherited Create;
- FAValues:=THArrayDouble.Create;
- end;
-
- constructor THashDouble.CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayDouble);
- begin
- FAIndex:=IndexHArray;
- FAValues:=ValueHArray;
- FReadOnly:=True;
- end;
-
- destructor THashDouble.Destroy;
- begin
- if not FReadOnly then FAValues.Free;
- inherited Destroy;
- end;
-
- procedure THashDouble.SetValue(Key:integer;Value:Double);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAValues[n]:=Value;
- exit;
- end;
- if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
- FAIndex.AddValue(Key);
- FAValues.AddValue(Value);
- end;
-
- procedure THashDouble.Inc(Key:integer;Value:Double);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAValues[n]:=FAValues[n]+Value;
- end else begin
- if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
- SetValue(Key,Value);
- end;
- end;
-
- function THashDouble.GetValue(Key:integer):Double;
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- Result:=FAValues[n];
- end else begin
- Result:=0;
- end;
- end;
-
- procedure THashDouble.Clear;
- begin
- inherited Clear;
- FAValues.Clear;
- end;
-
- procedure THashDouble.ClearMem;
- begin
- inherited ClearMem;
- FAValues.ClearMem;
- end;
-
- procedure THashDouble.Delete(Key:integer);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAIndex.Delete(n);
- FAValues.Delete(n);
- end;
- end;
-
- { THashString }
-
- constructor THashString.Create;
- begin
- inherited Create;
- FAValues:=TStringList.Create;
- FAllowEmptyStr:=True;
- end;
-
- destructor THashString.Destroy;
- begin
- FAValues.Free;
- inherited Destroy;
- end;
-
- procedure THashString.SetValue(Key:integer;Value:String);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- if not FAllowEmptyStr and (Value='')
- then begin FAValues.Delete(n); FAIndex.Delete(n); end
- else FAValues[n]:=Value;
- end else
- if FAllowEmptyStr or (Value<>'') then begin
- FAIndex.AddValue(Key);
- FAValues.Add(Value);
- end;
- end;
-
- function THashString.GetValue(Key:integer):String;
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- Result:=FAValues[n];
- end else begin
- Result:='';
- end;
- end;
-
- procedure THashString.Clear;
- begin
- inherited Clear;
- FAValues.Clear;
- end;
-
- procedure THashString.ClearMem;
- begin
- inherited ClearMem;
- FAValues.Clear;
- end;
-
- procedure THashString.Delete(Key:integer);
- var n:integer;
- begin
- n:=FAIndex.IndexOf(Key);
- if n>=0 then begin
- FAIndex.Delete(n);
- FAValues.Delete(n);
- end;
- end;
-
- { THash2 }
-
- constructor THash2.Create;
- begin
- MainListIndex:=THArrayInteger.Create;
- MainListValue:=THArrayPointer.Create;
- end;
-
- destructor THash2.Destroy;
- begin
- Clear;
- MainListValue.Free;
- MainListIndex.Free;
- inherited Destroy;
- end;
-
- {function THash2.GetKey(Index:integer):integer;
- begin
- Result:=MainListIndex[Index];
- end;}
-
- procedure THash2.ClearMem;
- begin
- Clear;
- MainListValue.ClearMem;
- MainListIndex.ClearMem;
- end;
-
- function THash2.GetChildHash(Key:integer):THash;
- var n:integer;
- begin
- n:=MainListIndex.IndexOf(Key);
- if n=-1
- then Result:=nil
- else Result:=MainListValue[n];
- end;
-
- procedure THash2.Delete(MainIndex,Index:integer);
- var n:integer;
- arr:THashBoolean;
- begin
- n:=MainListIndex.IndexOf(MainIndex);
- if n=-1 then exit;
- arr:=MainListValue[n];
- THash(arr).Delete(Index);
- if arr.Count=0 then begin
- arr.Free;
- MainListValue.Delete(n);
- MainListIndex.Delete(n);
- end;
- end;
-
- {function THash2.ExistMainHash(MainIndex:integer):boolean;
- var n:integer;
- begin
- n:=MainListIndex.IndexOf(MainIndex);
- Result:=n<>-1;
- end;}
-
- { THash2Exists }
-
- procedure THash2Exists.Clear;
- var i:integer;
- begin
- for i:=0 to MainListValue.Count-1 do begin
- THashExists(MainListValue[i]).Free;
- end;
- MainListValue.Clear;
- MainListIndex.Clear;
- end;
-
- procedure THash2Exists.SetValue(MainIndex,Index:integer;Value:boolean);
- var arr:THashExists;
- begin
- arr:=THashExists(GetChildHash(MainIndex));
- if arr=nil then begin
- arr:=THashExists.Create;
- MainListIndex.AddValue(MainIndex);
- MainListValue.AddValue(arr);
- end;
- arr[Index]:=Value;
- end;
-
- function THash2Exists.GetValue(MainIndex,Index:integer):boolean;
- var arr:THashExists;
- begin
- Result:=False;
- arr:=THashExists(GetChildHash(MainIndex));
- if arr=nil then exit;
- Result:=arr[Index];
- end;
-
- function THash2Exists.CreateMainHash(MainIndex:integer):THashExists;
- var Co:integer;
- n:integer;
- arr:THashExists;
- begin
- Result:=nil;
- n:=MainListIndex.IndexOf(MainIndex);
- if n=-1 then exit;
- Result:=THashExists.Create;
- arr:=MainListValue[n];
- Co:=arr.Count;
- if Co>0 then begin
- Result.FAIndex.SetCapacity(Co);
- Result.FAIndex.FCount:=Co;
- memcpy(arr.FAIndex.FValues,Result.FAIndex.FValues,Co*Result.FAIndex.FItemSize);
- end else begin
- Result.Free;
- Result:=nil;
- end;
- end;
-
- function THash2Exists.CreateHash(Index:integer):THashExists;
- var i:integer;
- begin
- Result:=THashExists.Create;
- for i:=0 to MainListIndex.Count-1 do begin
- if THashExists(MainListValue[i])[Index] then Result.FAIndex.AddValue(MainListIndex[i]);
- end;
- if Result.Count=0 then begin
- Result.Free;
- Result:=nil;
- end;
- end;
-
- { THash2Currency }
-
- procedure THash2Currency.Clear;
- var i:integer;
- begin
- for i:=0 to MainListValue.Count-1 do begin
- THashCurrency(MainListValue[i]).Free;
- end;
- MainListValue.Clear;
- MainListIndex.Clear;
- end;
-
- procedure THash2Currency.SetValue(MainIndex,Index:integer;Value:Currency);
- var arr:THashCurrency;
- begin
- arr:=THashCurrency(GetChildHash(MainIndex));
- if arr=nil then begin
- arr:=THashCurrency.Create;
- MainListIndex.AddValue(MainIndex);
- MainListValue.AddValue(arr);
- end;
- arr[Index]:=Value;
- end;
-
- procedure THash2Currency.Inc(MainIndex,Index:integer;Value:Currency);
- var c: currency;
- begin
- c:=GetValue(MainIndex,Index);
- SetValue(MainIndex,Index,Value+c);
- end;
-
- function THash2Currency.GetValue(MainIndex,Index:integer):Currency;
- var arr:THashCurrency;
- begin
- Result:=0;
- arr:=THashCurrency(GetChildHash(MainIndex));
- if arr=nil then exit;
- Result:=arr[Index];
- end;
-
- function THash2Currency.CreateMainHash(MainIndex:integer):THashCurrency;
- var arr:THashCurrency;
- Co:integer;
- n:integer;
- begin
- Result:=nil;
- n:=MainListIndex.IndexOf(MainIndex);
- if n=-1 then exit;
- Result:=THashCurrency.Create;
- arr:=MainListValue[n];
- Co:=arr.Count;
- if Co>0 then begin
- Result.FAIndex.SetCapacity(Co);
- Result.FAIndex.FCount:=Co;
- Result.FAValues.SetCapacity(Co);
- Result.FAValues.FCount:=Co;
- memcpy(arr.FAIndex.FValues,Result.FAIndex.FValues,Co*Result.FAIndex.FItemSize);
- memcpy(arr.FAValues.FValues,Result.FAValues.FValues,Co*Result.FAValues.FItemSize);
- end else begin
- Result.Free;
- Result:=nil;
- end;
- end;
-
- function THash2Currency.CreateHash(Index:integer):THashCurrency;
- var i:integer;
- begin
- Result:=THashCurrency.Create;
- for i:=0 to MainListIndex.Count-1 do begin
- if THashCurrency(MainListValue[i]).FAIndex.IndexOf(Index)<>-1 then begin
- Result.FAIndex.AddValue(i);
- Result.FAValues.AddValue(THashCurrency(MainListValue[i])[Index]);
- end;
- end;
- if Result.Count=0 then begin
- Result.Free;
- Result:=nil;
- end;
- end;
-
- { THash2Integer }
-
- procedure THash2Integer.Clear;
- var i:integer;
- begin
- for i:=0 to MainListValue.Count-1 do begin
- THashInteger(MainListValue[i]).Free;
- end;
- MainListValue.Clear;
- MainListIndex.Clear;
- end;
-
- procedure THash2Integer.SetValue(MainIndex,Index:integer;Value:Integer);
- var arr:THashInteger;
- begin
- arr:=THashInteger(GetChildHash(MainIndex));
- if arr=nil then begin
- arr:=THashInteger.Create;
- MainListIndex.AddValue(MainIndex);
- MainListValue.AddValue(arr);
- end;
- arr[Index]:=Value;
- end;
-
- function THash2Integer.GetValue(MainIndex,Index:integer):Integer;
- var arr:THashInteger;
- begin
- Result:=0;
- arr:=THashInteger(GetChildHash(MainIndex));
- if arr=nil then exit;
- Result:=arr[Index];
- end;
-
- function THash2Integer.CreateMainHash(MainIndex:integer):THashInteger;
- var arr:THashInteger;
- Co:integer;
- n:integer;
- begin
- Result:=nil;
- n:=MainListIndex.IndexOf(MainIndex);
- if n=-1 then exit;
- Result:=THashInteger.Create;
- arr:=MainListValue[n];
- Co:=arr.Count;
- if Co>0 then begin
- Result.FAIndex.SetCapacity(Co);
- Result.FAIndex.FCount:=Co;
- Result.FAValues.SetCapacity(Co);
- Result.FAValues.FCount:=Co;
- memcpy(arr.FAIndex.FValues,Result.FAIndex.FValues,Co*Result.FAIndex.FItemSize);
- memcpy(arr.FAValues.FValues,Result.FAValues.FValues,Co*Result.FAValues.FItemSize);
- end else begin
- Result.Free;
- Result:=nil;
- end;
- end;
-
- function THash2Integer.CreateHash(Index:integer):THashInteger;
- var i:integer;
- begin
- Result:=THashInteger.Create;
- for i:=0 to MainListIndex.Count-1 do begin
- if THashInteger(MainListValue[i]).FAIndex.IndexOf(Index)<>-1 then begin
- Result.FAIndex.AddValue(i);
- Result.FAValues.AddValue(THashInteger(MainListValue[i])[Index]);
- end;
- end;
- if Result.Count=0 then begin
- Result.Free;
- Result:=nil;
- end;
- end;
-
- { THash2String }
-
- procedure THash2String.Clear;
- var i:integer;
- begin
- for i:=0 to MainListValue.Count-1 do begin
- THashString(MainListValue[i]).Free;
- end;
- MainListValue.Clear;
- MainListIndex.Clear;
- end;
-
- procedure THash2String.SetValue(MainIndex,Index:integer;Value:String);
- var arr:THashString;
- begin
- arr:=THashString(GetChildHash(MainIndex));
- if arr=nil then begin
- arr:=THashString.Create;
- MainListIndex.AddValue(MainIndex);
- MainListValue.AddValue(arr);
- end;
- arr[Index]:=Value;
- end;
-
- function THash2String.GetValue(MainIndex,Index:integer):String;
- var arr:THashString;
- begin
- Result:='';
- arr:=THashString(GetChildHash(MainIndex));
- if arr=nil then exit;
- Result:=arr[Index];
- end;
-
- function THash2String.CreateMainHash(MainIndex:integer):THashString;
- var arr:THashString;
- Co:integer;
- n,i:integer;
- begin
- Result:=nil;
- n:=MainListIndex.IndexOf(MainIndex);
- if n=-1 then exit;
- Result:=THashString.Create;
- arr:=MainListValue[n];
- Co:=arr.Count;
- if Co>0 then begin
- Result.FAIndex.SetCapacity(Co);
- for i:=0 to arr.Count-1 do begin
- Result[arr.Keys[i]]:=arr[arr.Keys[i]];
- end;
- end else begin
- Result.Free;
- Result:=nil;
- end;
- end;
-
- function THash2String.CreateHash(Index:integer):THashString;
- var i:integer;
- begin
- Result:=THashString.Create;
- for i:=0 to MainListIndex.Count-1 do begin
- if THashString(MainListValue[i]).FAIndex.IndexOf(Index)<>-1 then begin
- Result.FAIndex.AddValue(i);
- Result.FAValues.Add(THashString(MainListValue[i])[Index]);
- end;
- end;
- if Result.Count=0 then begin
- Result.Free;
- Result:=nil;
- end;
- end;
-
- end.
-