home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d45 / ARDOCI.ZIP / DynamicArrays.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-04-05  |  58.5 KB  |  2,367 lines
  1. unit DynamicArrays;
  2.  
  3. {
  4.  τΣσ±ⁿ ±ΦΣ ≥ Ωε∞∩εφσφ≥√, ε≥Γσ≈α■∙Φσ τα ΣΦφα∞Φ≈σ±Ωεσ ≡α±∩≡σΣσδσφΦσ ∩α∞ ≥Φ,
  5.  Φ Γ±σ, ≈≥ε ± ²≥Φ∞ ±Γ ταφε
  6.  
  7.  -------------- ΣΦφα∞Φ≈σ±ΩΦσ  ∞α±±ΦΓ√ ----------------------
  8.  THArray - ΣΦφα∞Φ≈σ±ΩΦΘ ∞α±±ΦΓ ²δσ∞σφ≥εΓ(ΩαµΣ√Θ ²δσ∞σφ≥ ≡ατ∞σ≡α ItemSize)
  9.  ╬≥ εß√≈φ√⌡ ∞α±±ΦΓεΓ ε≥δΦ≈α■≥±  ≥σ∞, ≈≥ε ∩α∞ ≥ⁿ τα⌡Γα≥√Γασ≥±  αΓ≥ε∞α≥Φ≈σ±ΩΦ
  10.  ╬≥ φσπε φα±δσΣ≤■≥±  :
  11.    THArrayInteger,  THArrayPointer, THArrayBoolean,  THArrayInt64,
  12.    THArrayCurrency, THArrayString,  THArrayObjects,  THArraySmallInt,
  13.    THArrayWord,     THArrayExtended,THArrayDouble,  THArrayStringFix.
  14.  
  15.  THArrayString  Γδ σ≥±  ∩≡ε±≥ε φαΣ±≥≡εΘΩεΘ φαΣ THArray Σδ  ≡αßε≥√ ± TStrings
  16.  THArrayStringFix ≡αßε≥ασ≥ ±ε ±≥≡εΩα∞Φ ±≥≡επε ⌠ΦΩ±Φ≡εΓαφεΘ ΣδΦφ√ (φα∩≡Φ∞σ≡ ±≥≡εΩεΓ√σ ∩εδ  Γ ßατσ)
  17.  
  18.  THArray :
  19.  Property:
  20.   ItemSize - ≡ατ∞σ≡ ΩαµΣεπε ²δσ∞σφ≥α. ╧≡Φ Φτ∞σφσφΦΦ ItemSize τφα≈σφΦ  Γ√∩εδφ σ≥±  ClearMem ≥.σ. Γ±σ Σαφφ√σ ≥σ≡ ■≥± 
  21.   Count - ΩεδΦ≈σ±≥Γε ²δσ∞σφ≥εΓ
  22.   Memory - ≤Ωατα≥σδⁿ φα φα≈αδε ∞α±±ΦΓα
  23.  
  24.  ╠σ≥εΣ√ :
  25.   procedure Clear;
  26.     ╫Φ±≥Φ≥ ∞α±±ΦΓ, φε ∩α∞ ≥ⁿ φσ ε±ΓεßεµΣασ≥(ε±≥α≥σ≥±  Σδ  ⌡≡αφσφΦ  φεΓ√⌡ Σαφφ√⌡)
  27.     ┼±δΦ ≈α±≥ε ≈Φ±≥Φ≥±  ∩σ≡στα∩Φ±√Γασ≥±  ∞α±±ΦΓ, φε ≡ατ∞σ≡ ∩≡Φ∞σ≡φε εΣΦφαΩεΓ,
  28.     ∩α∞ ≥ⁿ ≈Φ±≥Φ≥ⁿ φσ εß τα≥σδⁿφε - ±δσΣ≤■∙ΦΘ ≡ατ φσ ß≤Σσ≥ τα⌡Γα≥√Γα≥ⁿ±  ∩α∞ ≥ⁿ,
  29.     Ωε≥ε≡α  ≤µσ Φ±∩εδⁿτεΓαδα±ⁿ
  30.   procedure ClearMem;
  31.     ╫Φ±≥Φ≥ ∞α±±ΦΓ, ∩≡Φ ²≥ε∞ ε±ΓεßεµΣα  Γ±■ ∩α∞ ≥ⁿ
  32.   function Add(pValue:pointer):integer;
  33.     ─εß√Γδ σ≥ Γ Ωεφσ÷ ∞α±±ΦΓα τφα≈σφΦσ ∩ε αΣ≡σ±≤ pValue. ╨ατ∞σ≡ ßσ≡σ≥±  Φτ ItemSize
  34.     ┬ετΓ≡α∙ασ≥ φε∞σ≡ ∩ετΦ÷ΦΦ, Ω≤Σα ß√δε ΣεßαΓδσφε τφα≈σφΦσ.
  35.   procedure AddMany();
  36.     ─εßαΓδ σ≥ φσ±ΩεδⁿΩε τφα≈σφΦΘ Γ ∞α±±ΦΓ. ╠εµφε Φ±∩εδⁿτεΓα≥ⁿ Σδ  Ωε∩Φ≡εΓαφΦ 
  37.     εΣφεπε ∞α±±ΦΓα Γ Σ≡≤πεΘ.
  38.   function Insert(num:integer;pValue:pointer):integer;
  39.     ─εßαΓδ σ≥ τφα≈σφΦσ, φε φσ Γ Ωεφσ÷, α Γ ∩ετΦ÷Φ■ num. ┬±σ ±δσΣ≤■∙Φσ ²δσ∞σφ≥√
  40.     ±ΣΓΦπα■≥± .
  41.     ┬ετΓ≡α∙ασ≥ φε∞σ≡ ∩ετΦ÷ΦΦ, Ω≤Σα ßεδε ΣεßαΓδσφε τφα≈σφΦσ.
  42.   procedure InsertMany(num:integer;pValue:pointer;Count:integer);
  43.     ╥ε µσ ±α∞εσ, φε φσ±ΩεδⁿΩε τφα≈σφΦΘ
  44.   procedure Delete(num:integer);
  45.     ╙Σαδ σ≥ ²δσ∞σφ≥ Γ ∩ετΦ÷ΦΦ num. ┬±σ ±δσΣ≤■∙Φσ τφα≈σφΦ  ±ΣΓΦπα■≥±  Ω
  46.     φα≈αδ≤. ╧α∞ ≥ⁿ ∩≡Φ ²≥ε∞ φσ ε±ΓεßεµΣασ≥± 
  47.   procedure Update(num:integer;pValue:pointer);
  48.     ╙±≥αφαΓδΦΓασ≥ τφα≈σφΦσ µδσ∞σφ≥α num
  49.   procedure UpdateMany(num:integer;pValue:pointer;Count:integer);
  50.     ╥ε µσ Σδ  φσ±ΩεδⁿΩΦ⌡ τφα≈σφΦΘ
  51.   procedure Get(num:integer;pValue:pointer);
  52.     ╧εδ≤≈Φ≥ⁿ τφα≈σφΦσ ²δσ∞σφ≥α num. ═≤µφε ∩σ≡σΣα≥ⁿ ±■Σα αΣ≡σ± Ω≤±Ωα ∩α∞ ≥Φ,
  53.     α ⌠≤φΩ÷Φ  ±Ωε∩Φ≡≤σ≥ ≥≤Σα τφα≈σφΦσ.
  54.   function GetAddr(num:integer):pointer;
  55.     ╧εδ≤≈Φ≥ⁿ αΣ≡σ± ²δσ∞σφ≥α num
  56.   procedure SetCapacity(Value:integer);
  57.     ╟α⌡Γα≥Φ≥ⁿ ∩α∞ ≥ⁿ ∩εΣ Value τφα≈σφΦΘ. ┼±δΦ τφα≈σφΦΘ Γ ∞α±±ΦΓσ ß√δε ßεδⁿ°σ,
  58.     δΦ°φΦσ ≤Σαδ ■≥± .
  59.   procedure Hold;
  60.     ╬≥Σα≥ⁿ δΦ°φ■■ ∩α∞ ≥ⁿ ±Φ±≥σ∞σ. ╬±≥ασ≥±  ∩α∞ ≥ⁿ ≥εδⁿΩε Σδ  ≥σ⌡ τφα≈σφΦΘ,
  61.     Ωε≥ε≡√σ σ±≥ⁿ Γ ∞α±±ΦΓσ. ═ε Γ ΣαδⁿφσΘ°σ∞ ΣεßαΓδ ≥ⁿ τφα≈σφΦ  ∞εµφε ßστ
  62.     ∩≡εßδσ∞, ∩≡ε±≥ε ²≥ε Γ√τεΓσ≥ τα⌡Γα≥ φεΓεΘ ∩α∞ ≥Φ ∩≡Φ ΣεßαΓδσφΦΦ ∩σ≡Γεπε
  63.     µσ τφα≈σφΦ 
  64.   procedure MoveData(FromPos,Count,Offset);
  65.     ∩σ≡σ∞σ±≥Φ≥ⁿ τα∩Φ±Φ Γ ∞α±±ΦΓσ, φα≈Φφα  ± FromPos ΩεδΦ≈σ±≥Γε∞ Count φα ±∞σ∙σφΦσ Offset
  66.  
  67.  
  68.  ─ε∩εδφσφΦ  Σδ 
  69.    THArrayInteger,  THArrayPointer, THArrayBoolean,  THArrayInt64,
  70.    THArrayCurrency, THArrayString,  THArrayObjects,  THArraySmallInt,
  71.    THArrayWord,     THArrayExtended,THArrayDouble,  THArrayStringFix :
  72.    function AddValue(Value:φ≤µφ√Θ ≥Φ∩):integer;
  73.     ─εßαΓδ σ≥ ∩σ≡σΣαφφεσ τφα≈σφΦσ Γ ∞α±±ΦΓ
  74.    property Value[Index:integer]:φ≤µφ√Θ ≥Φ∩; default;
  75.     ─ε±≥≤∩ Ω τφα≈σφΦ■ ± ≤Ωαταφ√∞ ΦφΣσΩ±ε∞. ╥εδⁿΩε Ω ≥σ∞, Ωε≥ε≡√σ ≤µσ
  76.     ±≤∙σ±≥Γ≤■≥ Γ ∞α±±ΦΓσ
  77.  ─δ  THArrayInteger Φ THArrayPointer, THArrayString:
  78.    function IndexOf(Value:integer):integer;
  79.     ╧εΦ±Ω ≤Ωαταφφεπε τφα≈σφΦ  Γ ∞α±±ΦΓσ. ┼±δΦ φσ φαΘΣσφε - ΓετΓ≡α∙ασ≥ -1
  80.  
  81.  
  82.  -------------- ⌡²°Φ ----------------------
  83.  
  84.  ╒²°Φ - ΣΦφα∞Φ≈σ±ΩΦσ ±≥≡≤Ω≥≤≡√, πΣσ ⌡≡αφ ≥±  ²φα≈σφΦ  ∩ε ΦφΣσΩ±≤
  85.  ╬≥ ΣΦφα∞Φ≈σ±ΩΦ⌡ ∞α±±ΦΓεΓ ε≥δΦ≈α■≥±  ≥σ∞, ≈≥ε
  86.  1) ⌡≡αφ ≥±  ≥εδⁿΩε ≥σ τφα≈σφΦ , Ωε≥ε≡√σ ≤±≥αφεΓδσφ√,≥.σ. ∞εµφε ταφσ±≥Φ
  87.     τφα≈σφΦσ ± ΦφΣσΩ±εΓ 1 Φ ± ΦφΣσΩ±ε∞ 1000000, ∩≡Φ ²≥ε∞ ß≤Σσ≥ ταφ ≥α ∩α∞ ≥ⁿ
  88.     ≥εδⁿΩε Σδ  ΣΓ≤⌡ τφα≈σφΦΘ. ╙Σεßφε Σδ  τα∩ε∞ΦφαφΦ  τφα≈σφΦΘ, ΦφΣσΩ±√ Ωε≥ε≡√⌡
  89.     φσ ≤∩ε≡ Σε≈σφ√ Φ φσ δΦφσΘφ√
  90.  2) ΦφΣσΩ±ε∞ ∞εµσ≥ ±δ≤µΦ≥ⁿ φσ ≥εδⁿΩε integer (⌡ε≥  Γ φα±≥ε ∙σΘ ≡σαδΦτα÷ΦΦ
  91.     Φ±∩εδⁿτ≤σ≥±  ≥εδⁿΩε integer ΦφΣσΩ±√)
  92.  
  93.  THash :
  94.  Property:
  95.   property Count;
  96.     ΩεδΦ≈σ±≥Γε τφα≈σφΦΘ Γ ⌡²°σ
  97.   property Keys[Index:integer]:integer;
  98.     ┬ετΓ≡α∙ασ≥ Ωδ■≈ ²δσ∞σφ≥α, ⌡≡αφ ∙σπε±  Γ Index ∩ετΦ÷ΦΦ(Index: 0..Count-1)
  99.  
  100.  ╠σ≥εΣ√ :
  101.    procedure Clear;
  102.      ╬≈Φ±≥Ωα ßστ ε±ΓεßεµΣσφΦ  ∩α∞ ≥Φ
  103.    procedure ClearMem;
  104.      ╬≈Φ±≥Ωα ⌡²°α ± ε±ΓεßεµΣσφΦσ∞ ∩α∞ ≥Φ
  105.    function IfExist(Key:integer):boolean;
  106.      ╧≡εΓσ≡Ωα - ±≤∙σ±≥Γ≤σ≥ δΦ ²δσ∞σφ≥ ± Ωδ■≈σ∞ Key
  107.    procedure Delete(Key:integer);
  108.      ╙Σαδ σ≥ τφα≈σφΦσ Σδ  Ωδ■≈α Key
  109.  
  110.  ─δ  THashExists,THashBoolean, THashInteger, THashPointer, THashCurrency, THashDouble, THashString :
  111.    property Value[Index:integer]:φ≤µφ√Θ ≥Φ∩;
  112.      ─ε±≥≤∩ Ω τφα≈σφΦ■ ± Ωδ■≈ε∞ Index. ┬ ε≥δΦ≈Φσ ε≥ THArray ∞εµφε ≤±≥αφαΓδΦΓα≥ⁿ
  113.      Φ φσ ±≤∙σ±≥Γ≤■∙Φσ Σε ²≥επε ∞ε∞σφ≥α τφα≈σφΦ .
  114.  
  115.  ┬±σ ⌡²°Φ ∩≡Φ ≈≥σφΦΦ φσ±≤∙σ±≥Γ≤■∙σπε ²δσ∞σφ≥α Γ√Σα■≥ Φ±Ωδ■≈σφΦσ. ╧≡εΓσ≡Φ≥ⁿ
  116.  ±≤∙σ±≥ΓεΓαφΦσ ∞εµφε ± ∩ε∞ε∙ⁿ■ IfExists
  117.  THashExists  Γδ σ≥±  Φ±Ωδ■≈σφΦσ∞. ┬ φσ∞ ⌡≡αφ ≥±  ≥εδⁿΩε τφα≈σφΦ  True.
  118.  ╤εε≥Γσ≥±≥Γσφφε, IfExists ß≤Σσ≥ Γ√ΣαΓα≥ⁿ ≥εδⁿΩε φα φΦ⌡ True, Φ φΦΩεπΣα
  119.  φσ ß≤Σσ≥ ΓετφΦΩα≥ⁿ Φ±Ωδ■≈σφΦ . ═α τα∩≡ε± φσ±≤∙σ±≥Γ≤■∙σπε ²δσ∞σφ≥α
  120.  ß≤Σσ≥ ΓετΓ≡α∙α≥ⁿ±  τφα≈σφΦσ False, α ∩≡Φ ≤±≥αφεΓΩσ τφα≈σφΦ  Γ False εφε ß≤Σσ≥
  121.  ∩≡ε±≥ε ≤Σαδ ≥± .
  122.  
  123.  -------------- ΣΓεΘφ√σ ⌡²°Φ ----------------------
  124.  ─ΓεΘφ√σ ⌡²°Φ ±δ≤µα≥ Σδ  τα∩ε∞ΦφαφΦ  ≥αßδΦ÷, πΣσ ±≥≡εΩΦ Φ ±≥εδß÷√ - integer
  125.  ─ε±≥≤∩ Ω ΩαµΣε∞≤ ²δσ∞σφ≥≤ ε±≤∙σ±≥Γδ σ≥±  ∩ε ΣΓ≤∞ ΦφΣσΩ±α∞ - πδαΓφε∞≤ Φ
  126.  εß√≈φε∞≤. ╘ΦτΦ≈σ±ΩΦ ΣΓεΘφεΘ ⌡²° ∩≡σΣ±≥αΓδ σ≥ ±εßεΘ φαßε≡ εß√≈φ√⌡ ⌡²°σΘ
  127.  
  128.  THash2 :
  129.   ╠σ≥εΣ√:
  130.    procedure Clear;
  131.      ╬≈Φ±≥Ωα ⌡²°α (ßστ ε±ΓεßεµΣσφΦ  Γ√ΣσδσφφεΘ ∩α∞ ≥Φ)
  132.    procedure ClearMem;
  133.      ╬≈Φ±≥Ωα ⌡²°α ± ε±ΓεßεµΣσφΦσ∞ ∩α∞ ≥Φ
  134.    procedure Delete(MainIndex,Index:integer);
  135.      ╙Σαδ σ≥ ≤Ωαταφ√Θ ²δσ∞σφ≥
  136.  
  137.  ─δ  THash2Exists,THash2Integer,THash2Currency,THash2String :
  138.   ╠σ≥εΣ√:
  139.    procedure SetValue(MainIndex,Index:integer;Value:φ≤µφ√Θ ≥Φ∩);
  140.      ╙±≥αφαΓδΦΓασ≥ τφα≈σφΦσ Σδ  ²≥Φ⌡ Ωδ■≈σΘ
  141.    function GetValue(MainIndex,Index:integer):φ≤µφ√Θ ≥Φ∩;
  142.      ╧εδ≤≈σφΦσ τφα≈σφΦ  ∩ε Ωδ■≈α∞
  143.    function CreateMainHash(MainIndex:integer):THash<φ≤µφ√Θ ≥Φ∩>;
  144.    function CreateHash(Index:integer):THash<φ≤µφ√Θ ≥Φ∩>;
  145.      ┬ετΓ≡α∙ασ≥ εß√≈φ√Θ ⌡²° Σδ  εΣφεπε Φτ ≤Ωαταφ√⌡ ΦφΣσΩ±εΓ. ┼±δΦ τφα≈σφΦΘ φσ≥,
  146.      Γ±σπΣα ΓετΓ≡α∙ασ≥ nil, Φ φΦΩεπΣα φσ ΓετΓ≡α∙ασ≥ ∩≤±≥εΘ ⌡²°.
  147. }
  148.  
  149. interface
  150.  
  151. uses Classes, Windows;
  152.  
  153. resourcestring
  154.  SItemNotFound = '═σ≥ ²δσ∞σφ≥α ± ΦφΣσΩ±ε∞ %d !';
  155.  SKeyNotFound  = '═σ≥ ²δσ∞σφ≥α ± Ωδ■≈σ∞ %d Γ Read-only ⌡σ°σ !';
  156.  
  157. type
  158.   dword=cardinal;
  159.   pboolean  = ^boolean;
  160.   ppointer  = ^pointer;
  161.   pword     = ^word;
  162.   pextended = ^extended;
  163.  
  164.   THarray = class;
  165.  
  166.   {⌠-÷Φ  ±≡αΓφσφΦ . ─εδµφα ΓετΓ≡α∙α≥ⁿ:
  167.    0 - ²δσ∞σφ≥√ ≡αΓφ√
  168.    1 - i-≥√Θ ²δσ∞σφ≥ > j-≥επε ²δσ∞σφ≥α
  169.   -1 - j-≥√Θ ²δσ∞σφ≥ > i-≥επε ²δσ∞σφ≥α }
  170.   TCompProc = function(arr : THArray;i,j : integer) : integer;
  171.  
  172.   THArray = class // εß∙ΦΘ Ωδα±± ∩≡α≡εΣΦ≥σδⁿ Γ±σ⌡ ΣΦφα∞Φ≈σ±ΩΦ⌡ ∞α±±ΦΓεΓ φσ ταΓΦ±Φ≥ ε≥ ≥Φ∩α ⌡≡αφΦ∞√⌡ Σαφφ√⌡
  173.   private
  174.    FCount:integer;            // ΩεδΦ≈σ±≥Γε ²δσ∞σφ≥εΓ
  175.    FCapacity:integer;         // φα ±ΩεδⁿΩε ²δσ∞σφ≥εΓ τα⌡Γα≈σφε ∩α∞ ≥Φ
  176.    FItemSize:integer;         // ≡ατ∞σ≡ εΣφεπε ²δσ∞σφ≥α Γ ßαΘ≥α⌡
  177.    procedure SetItemSize(Size:integer);
  178.   protected
  179.    FValues:pointer;
  180.    procedure Error(Value,min,max:integer);
  181.    function CalcAddr(num:integer):pointer; virtual;
  182.   public
  183.    constructor Create; virtual;
  184.    destructor Destroy; override;
  185.    procedure Clear;
  186.    procedure ClearMem; virtual;
  187.    function Add(pValue:pointer):integer; virtual;
  188.    procedure AddMany(pValue:pointer;Count:integer);
  189.    function Insert(num:integer;pValue:pointer):integer; virtual;
  190.    procedure InsertMany(num:integer;pValue:pointer;Count:integer);
  191.    procedure Delete(num:integer);virtual;
  192.    procedure Update(num:integer;pValue:pointer);virtual;
  193.    procedure UpdateMany(num:integer;pValue:pointer;Count:integer);
  194.    procedure Get(num:integer;pValue:pointer); virtual;
  195.    function GetAddr(num:integer):pointer;
  196.    procedure SetCapacity(Value:integer);
  197.    procedure AddFillValues(Value:integer);
  198.    procedure Hold;
  199.    procedure Grow;
  200.    procedure GrowTo(Count:integer);
  201.    procedure MoveData(FromPos,Count,Offset:integer);virtual;
  202.    property Count:integer read FCount;
  203.    property Capacity:integer read FCapacity;
  204.    property Memory:pointer read FValues;
  205.    property ItemSize:integer read FItemSize write SetItemSize;
  206.    procedure Zero;
  207.    procedure LoadFromStream(s:TStream);
  208.    procedure Swap(Index1,Index2:integer);virtual;
  209.    //±ε≡≥Φ≡εΓΩα HArray'α. ╤∞. ≥Φ∩ TCompProc
  210.    procedure Sort(proc : TCompProc);
  211.   published
  212.   end;
  213.  
  214.   THArrayObjects = class(THArray)
  215.   protected
  216.    function GetValue(Index:integer):TObject;
  217.    procedure SetValue(Index:integer;const Value:TObject);
  218.   public
  219.    constructor Create; override;
  220.    procedure ClearMem; override;              // (!) ≡ατ≡≤°ασ≥ Γ±σ ⌡≡αφΦ∞√σ εßⁿσΩ≥√ Φ ≤Σαδ σ≥ ±±√δΩΦ φα φΦ⌡
  221.    procedure SafeClearMem;                    // ≤Σαδ σ≥ Γ±σ ±±√δΩΦ φα Γ±σ εßⁿσΩ≥√ _φσ_ ≡ατ≡≤°α  Φ⌡
  222.    procedure Delete(Index:integer); override; // (!) ≤Σαδ σ∞√Θ εßⁿσΩ≥ ≡ατ≡≤°ασ≥± 
  223.    procedure SafeDelete(Index:integer);       // ≤Σαδ σ≥ ±±√δΩ≤ φα εßⁿσΩ≥ _φσ_ ≡ατ≡≤°α  σπε
  224.    function AddValue(Value:TObject):integer;
  225.    property Value[Index:integer]:TObject read GetValue write SetValue; default;
  226.   end;
  227.  
  228.   THArraySmallInt = class(THArray)
  229.   private
  230.   protected
  231.    function GetValue(Index:integer):smallint;
  232.    procedure SetValue(Index:integer;Value:smallint);
  233.   public
  234.    constructor Create; override;
  235.    function AddValue(Value:smallint):integer;
  236.    property Value[Index:integer]:smallint read GetValue write SetValue; default;
  237.   published
  238.   end;
  239.  
  240.   THArrayWord = class(THArray)
  241.   private
  242.   protected
  243.    function GetValue(Index:integer):word;
  244.    procedure SetValue(Index:integer;Value:word);
  245.   public
  246.    constructor Create; override;
  247.    function AddValue(Value:word):integer;
  248.    property Value[Index:integer]:word read GetValue write SetValue; default;
  249.   published
  250.   end;
  251.  
  252.   THArrayInt64 = class(THArray)
  253.   private
  254.   protected
  255.    function GetValue(Index:integer):int64;
  256.    procedure SetValue(Index:integer;Value:int64);
  257.   public
  258.    constructor Create; override;
  259.    function AddValue(Value:int64):integer;
  260.    property Value[Index:integer]:int64 read GetValue write SetValue; default;
  261.   published
  262.   end;
  263.  
  264.   THArrayLongWord = class(THArray)
  265.   protected
  266.    function GetValue(Index:integer):LongWord;
  267.    procedure SetValue(Index:integer;Value:LongWord);
  268.   public
  269.    constructor Create; override;
  270.    function IndexOf(Value:LongWord):integer;
  271.    function IndexOfFrom(Value:LongWord;Start:integer):integer;
  272.    function AddValue(Value:LongWord):integer;
  273.    property Value[Index:integer]:LongWord read GetValue write SetValue; default;
  274.   end;
  275.  
  276.   THArrayInteger = class(THArray)
  277.   private
  278.   protected
  279.    function GetValue(Index:integer):integer;
  280.    procedure SetValue(Index:integer;Value:Integer);
  281.   public
  282.    constructor Create; override;
  283.    function IndexOf(Value:integer):integer;
  284.    function IndexOfFrom(Value:integer;Start:integer):integer;
  285.    function AddValue(Value:integer):integer;
  286.    function Pop:integer;
  287.    procedure Push(Value:integer);
  288.    property Value[Index:integer]:integer read GetValue write SetValue; default;
  289.    function GetAsString:string;
  290.    procedure AddFromString(InputString,Delimiters:string);
  291.    function CalcMax:integer;
  292.   published
  293.   end;
  294.  
  295.   THArrayPointer = class(THArray)
  296.   private
  297.   protected
  298.    function GetValue(Index:integer):Pointer;
  299.    procedure SetValue(Index:integer;Value:Pointer);
  300.   public
  301.    constructor Create; override;
  302.    function IndexOf(Value:pointer):integer;
  303.    function AddValue(Value:pointer):integer;
  304.    property Value[Index:integer]:pointer read GetValue write SetValue; default;
  305.   published
  306.   end;
  307.  
  308.   THArrayBoolean = class(THArray)
  309.   private
  310.   protected
  311.    function GetValue(Index:integer):Boolean;
  312.    procedure SetValue(Index:integer;Value:Boolean);
  313.   public
  314.    constructor Create; override;
  315.    function AddValue(Value:Boolean):integer;
  316.    property Value[Index:integer]:Boolean read GetValue write SetValue; default;
  317.   published
  318.   end;
  319.  
  320.   THArrayDouble = class(THArray)
  321.   private
  322.   protected
  323.    function GetValue(Index:integer):Double;
  324.    procedure SetValue(Index:integer;Value:Double);
  325.   public
  326.    constructor Create; override;
  327.    function AddValue(Value:double):integer;
  328.    property Value[Index:integer]:double read GetValue write SetValue; default;
  329.   published
  330.   end;
  331.  
  332.   THArrayCurrency = class(THArray)
  333.   private
  334.   protected
  335.    function GetValue(Index:integer):Currency;
  336.    procedure SetValue(Index:integer;Value:Currency);
  337.   public
  338.    constructor Create; override;
  339.    function AddValue(Value:currency):integer;
  340.    property Value[Index:integer]:currency read GetValue write SetValue; default;
  341.   published
  342.   end;
  343.  
  344.   THArrayExtended = class(THArray)
  345.   private
  346.   protected
  347.    function GetValue(Index:integer):Extended;
  348.    procedure SetValue(Index:integer;Value:Extended);
  349.   public
  350.    constructor Create; override;
  351.    function AddValue(Value:Extended):integer;
  352.    property Value[Index:integer]:Extended read GetValue write SetValue; default;
  353.   published
  354.   end;
  355.  
  356.   THArrayString = class(THArray)
  357.   private
  358.    str_ptr:THArrayPointer;
  359.   protected
  360.    function GetValue(Index:integer):string;
  361.    procedure SetValue(Index:integer;Value:string);
  362.    function CalcAddr(num:integer):pointer; override;
  363.   public
  364.    constructor Create; override;
  365.    destructor Destroy; override;
  366.    procedure Clear;
  367.    procedure ClearMem;override;
  368.    function AddValue(Value:string):integer;
  369.    function Add(pValue:pointer):integer; override;
  370.    procedure Delete(num:integer);override;
  371.    function Insert(num:integer;pValue:pointer):integer; override;
  372.    procedure Get(num:integer;pValue:pointer); override;
  373.    procedure Update(num:integer;pValue:pointer);override;
  374.    procedure MoveData(FromPos,Count,Offset:integer); override;
  375.    function IndexOf(Value:string):integer;
  376.    property Value[Index:integer]:string read GetValue write SetValue; default;
  377.   published
  378.   end;
  379.  
  380.   THArrayStringFix = class(THArray)
  381.   private
  382.   protected
  383.    function GetValue(Index:integer):string;
  384.    procedure SetValue(Index:integer;Value:string);
  385.   public
  386.    constructor Create; override;
  387.    constructor CreateSize(Size:integer);
  388.    function AddValue(Value:string):integer;
  389.    property Value[Index:integer]:string read GetValue write SetValue; default;
  390.   published
  391.   end;
  392.  
  393.   THash = class
  394.   private
  395.    FReadOnly:boolean;
  396.    FAIndex:THArrayInteger;
  397.    function GetKey(Index:integer):integer;
  398.    function GetCount:integer;
  399.   public
  400.    constructor Create; virtual;
  401.    destructor Destroy; override;
  402.    procedure Clear; virtual;
  403.    procedure ClearMem; virtual;
  404.    function IfExist(Key:integer):boolean;  // ╧≡εΓσ≡Ωα ±≤∙σ±≥ΓεΓαφΦ  τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
  405.    procedure Delete(Key:integer); virtual; abstract;
  406.    property Count:integer read GetCount;
  407.    property Keys[Index:integer]:integer read GetKey;
  408.    property AIndexes:THArrayInteger read FAIndex;
  409.   end;
  410.  
  411.   THashExists = class (THash)
  412.   private
  413.    procedure SetValue(Index:integer;Value:boolean);
  414.    function GetValue(Index:integer):boolean;
  415.   protected
  416.   public
  417.    constructor Create; override;
  418.    destructor Destroy; override;
  419.    procedure Delete(Key:integer); override;
  420.    property Value[Index:integer]:boolean read GetValue write SetValue; default;
  421.   published
  422.   end;
  423.  
  424.   THashBoolean = class (THash)
  425.   private
  426.    FAValues:THArrayBoolean;
  427.    procedure SetValue(Key:integer;Value:boolean);
  428.    function GetValue(Key:integer):boolean;
  429.   protected
  430.   public
  431.    constructor Create; override;
  432.    constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayBoolean);
  433.    destructor Destroy; override;
  434.    procedure Delete(Key:integer); override;
  435.    procedure Clear; override;
  436.    procedure ClearMem; override;
  437.    property Value[Index:integer]:boolean read GetValue write SetValue; default;
  438.   published
  439.   end;
  440.  
  441.   THashInteger = class (THash)
  442.   private
  443.    FAValues:THArrayInteger;
  444.    procedure SetValue(Key:integer;Value:integer);
  445.    function GetValue(Key:integer):integer;
  446.   protected
  447.   public
  448.    constructor Create; override;
  449.    constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayInteger);
  450.    destructor Destroy; override;
  451.    procedure Delete(Key:integer); override;
  452.    procedure Clear; override;
  453.    procedure ClearMem; override;
  454.    property Value[Index:integer]:integer read GetValue write SetValue; default;
  455.    property AValues:THArrayInteger read FAValues;
  456.   published
  457.   end;
  458.  
  459.   THashPointer = class (THash)
  460.   private
  461.    FAValues:THArrayPointer;
  462.    procedure SetValue(Key:integer;Value:pointer);// ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
  463.    function GetValue(Key:integer):pointer;// ╧εδ≤≈σφΦσ τφα≈σφΦ  ∩ε Ωδ■≈≤
  464.   protected
  465.   public
  466.    constructor Create; override;
  467.    constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayPointer);
  468.    destructor Destroy; override;
  469.    procedure Delete(Key:integer); override;// ╙ΣαδσφΦσ τα∩Φ±Φ Key
  470.    procedure Clear; override;
  471.    procedure ClearMem; override;
  472.    property Value[Index:integer]:pointer read GetValue write SetValue; default;
  473.    property AValues:THArrayPointer read FAValues;
  474.   published
  475.   end;
  476.  
  477.   THashCurrency = class (THash)
  478.   private
  479.    FAValues:THArrayCurrency;
  480.    procedure SetValue(Key:integer;Value:currency);// ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
  481.    function GetValue(Key:integer):currency;// ╧εδ≤≈σφΦσ τφα≈σφΦ  ∩ε Ωδ■≈≤
  482.   protected
  483.   public
  484.    constructor Create; override;
  485.    constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayCurrency);
  486.    destructor Destroy; override;
  487.    procedure Inc(Key:integer;Value:currency); // ╙ΓσδΦ≈σφΦσ τα∩Φ±Φ Key φα ΓσδΦ≈Φφ≤ Value (∩≡Φ ε≥±≤≥±≥ΓΦΦ τα∩Φ±Φ - ±ετΣασ≥)
  488.    procedure Delete(Key:integer); override;// ╙ΣαδσφΦσ τα∩Φ±Φ Key
  489.    procedure Clear; override;
  490.    procedure ClearMem; override;
  491.    property Value[Index:integer]:currency read GetValue write SetValue; default;
  492.   published
  493.   end;
  494.  
  495.   THashDouble = class (THash)
  496.   private
  497.    FAValues:THArrayDouble;
  498.    procedure SetValue(Key:integer;Value:Double);// ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
  499.    function GetValue(Key:integer):Double;// ╧εδ≤≈σφΦσ τφα≈σφΦ  ∩ε Ωδ■≈≤
  500.   protected
  501.   public
  502.    constructor Create; override;
  503.    constructor CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayDouble);
  504.    destructor Destroy; override;
  505.    procedure Inc(Key:integer;Value:Double); // ╙ΓσδΦ≈σφΦσ τα∩Φ±Φ Key φα ΓσδΦ≈Φφ≤ Value (∩≡Φ ε≥±≤≥±≥ΓΦΦ τα∩Φ±Φ - ±ετΣασ≥)
  506.    procedure Delete(Key:integer); override;// ╙ΣαδσφΦσ τα∩Φ±Φ Key
  507.    procedure Clear; override;
  508.    procedure ClearMem; override;
  509.    property Value[Index:integer]:Double read GetValue write SetValue; default;
  510.   published
  511.   end;
  512.  
  513.   THashString = class (THash)
  514.   private
  515.    FAllowEmptyStr:boolean;
  516.    FAValues:TStrings;
  517.    procedure SetValue(Key:integer;Value:string);
  518.    function GetValue(Key:integer):string;
  519.   protected
  520.   public
  521.    constructor Create; override;
  522.    destructor Destroy; override;
  523.    procedure Delete(Key:integer); override;
  524.    procedure Clear; override;
  525.    procedure ClearMem; override;
  526.    property Value[Index:integer]:string read GetValue write SetValue; default;
  527.    property AllowEmptyStr:boolean read FAllowEmptyStr write FAllowEmptyStr;
  528.   end;
  529.  
  530.   THash2 = class
  531.   private
  532.    MainListIndex:THArrayInteger;
  533.    MainListValue:THArrayPointer;
  534. //   function GetKey(Index:integer):integer;
  535.    function GetChildHash(Key:integer):THash;
  536.   public
  537.    constructor Create; virtual;
  538.    destructor Destroy; override;
  539. //   function Count:integer;
  540.    procedure Clear; virtual; abstract;  // ╬≈Φ±≥Ωα ⌡²°α (ßστ ε±ΓεßεµΣσφΦ  Γ√ΣσδσφφεΘ ∩α∞ ≥Φ)
  541.    procedure ClearMem;                  // ╬≈Φ±≥Ωα ⌡²°α ± ε±ΓεßεµΣσφΦσ∞ ∩α∞ ≥Φ
  542.    procedure Delete(MainIndex,Index:integer);
  543. //   function ExistMainHash(MainIndex:integer):boolean;
  544. //   function ExistIndex(Index:integer):boolean;
  545. //   property Keys[Index:integer]:integer read GetKey;
  546.    property MainIndexes:THArrayInteger read MainListIndex;
  547.   end;
  548.  
  549.   THash2Exists = class (THash2)
  550.   private
  551.   protected
  552.   public
  553.    procedure SetValue(MainIndex,Index:integer;Value:boolean); // ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
  554.    procedure Clear; override;                                 // ╬≈Φ±≥Ωα ⌡²°α (ßστ ε±ΓεßεµΣσφΦ  Γ√ΣσδσφφεΘ ∩α∞ ≥Φ)
  555.    function GetValue(MainIndex,Index:integer):boolean;        // ╧εδ≤≈σφΦσ τφα≈σφΦ  ∩ε Ωδ■≈≤
  556.    function CreateMainHash(MainIndex:integer):THashExists;
  557.    function CreateHash(Index:integer):THashExists;
  558. //   procedure ExportChildHash(Hash:THashBoolean);
  559. //   procedure DeleteMainIndex(MainIndex:integer);
  560. //   procedure DeleteIndex(Index:integer);
  561.   published
  562.   end;
  563.  
  564.   THash2Currency = class (THash2)
  565.   private
  566.   protected
  567.   public
  568.    procedure SetValue(MainIndex,Index:integer;Value:currency);// ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
  569.    procedure Inc(MainIndex,Index:integer;Value:currency);     // ≤ΓσδΦ≈σφΦσ ±≤∙σ±≥Γ≤■∙σΘ/±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
  570.    procedure Clear; override;                                 // ╬≈Φ±≥Ωα ⌡²°α (ßστ ε±ΓεßεµΣσφΦ  Γ√ΣσδσφφεΘ ∩α∞ ≥Φ)
  571.    function GetValue(MainIndex,Index:integer):currency;       // ╧εδ≤≈σφΦσ τφα≈σφΦ  ∩ε Ωδ■≈≤
  572.    function CreateMainHash(MainIndex:integer):THashCurrency;
  573.    function CreateHash(Index:integer):THashCurrency;
  574. //   procedure ExportChildHash(Hash:THashCurrency);
  575.   published
  576.   end;
  577.  
  578.   THash2Integer = class (THash2)
  579.   private
  580.   protected
  581.   public
  582.    procedure SetValue(MainIndex,Index:integer;Value:Integer); // ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
  583.    procedure Clear; override;                                 // ╬≈Φ±≥Ωα ⌡²°α (ßστ ε±ΓεßεµΣσφΦ  Γ√ΣσδσφφεΘ ∩α∞ ≥Φ)
  584.    function GetValue(MainIndex,Index:integer):Integer;        // ╧εδ≤≈σφΦσ τφα≈σφΦ  ∩ε Ωδ■≈≤
  585.    function CreateMainHash(MainIndex:integer):THashInteger;
  586.    function CreateHash(Index:integer):THashInteger;
  587. //   procedure ExportChildHash(Hash:THashInteger);
  588.   published
  589.   end;
  590.  
  591.   THash2String = class (THash2)
  592.   private
  593.   protected
  594.    procedure SetValue(MainIndex,Index:integer;Value:String); // ±ετΣαφΦσ φεΓεΘ τα∩Φ±Φ ± ταΣαφφ√∞ Ωδ■≈σ∞
  595.    function GetValue(MainIndex,Index:integer):String;        // ╧εδ≤≈σφΦσ τφα≈σφΦ  ∩ε Ωδ■≈≤
  596.   public
  597.    procedure Clear; override;                                // ╬≈Φ±≥Ωα ⌡²°α (ßστ ε±ΓεßεµΣσφΦ  Γ√ΣσδσφφεΘ ∩α∞ ≥Φ)
  598.    function CreateMainHash(MainIndex:integer):THashString;
  599.    function CreateHash(Index:integer):THashString;
  600. //   procedure ExportChildHash(Hash:THashCurrency);
  601.    property Value[MainIndex,Index:integer]:string read GetValue write SetValue; default;
  602.   published
  603.   end;
  604.  
  605. procedure memcpy(pi,po:pointer;Count:integer); stdcall;
  606. procedure memclr(po:pointer;Count:integer); stdcall;
  607. procedure memset(po:pointer;Value:byte;Count:integer); stdcall;
  608. function memfind(pi:pointer;Value:dword;Count:integer):integer; stdcall;
  609.  
  610. implementation
  611.  
  612. uses SysUtils;
  613.  
  614. const
  615.  BLOCK=1024;
  616.  
  617. function HGetToken(InputString:string; Delimiters:string; OnlyOneDelimiter:boolean; Index:integer):string;
  618. var i,p:integer;
  619. begin
  620.  Result:='';
  621.  p:=1;
  622.  while (p<=length(InputString)) and (pos(InputString[p],Delimiters)<>0) do
  623.   inc(p);
  624.  for i:=1 to index do begin
  625.   while (p<=length(InputString)) and (pos(InputString[p],Delimiters)=0)
  626.    do inc(p);
  627.  
  628.   if OnlyOneDelimiter
  629.    then  inc(p)
  630.    else  while (p<=length(InputString)) and (pos(InputString[p],Delimiters)<>0) do inc(p);
  631.  end;
  632.  while (p<=length(InputString)) and (pos(InputString[p],Delimiters)=0)
  633.   do begin Result:=Result+InputString[p]; inc(p); end;
  634. end;
  635.  
  636. function HGetTokenCount(InputString:string; Delimiters:string; OnlyOneDelimiter:boolean):integer;
  637. var p:integer;
  638. begin
  639.  Result:=0;
  640.  if InputString='' then exit;
  641.  p:=1;
  642.  while (p<=length(InputString)) and (pos(InputString[p],Delimiters)<>0) do
  643.   inc(p);
  644.  while (p<=length(InputString)) do begin
  645.   while (p<=length(InputString)) and (pos(InputString[p],Delimiters)=0)
  646.     do inc(p);
  647.  
  648.   if OnlyOneDelimiter
  649.    then  inc(p)
  650.    else  while (p<=length(InputString)) and (pos(InputString[p],Delimiters)<>0) do inc(p);
  651.   Result:=Result+1;
  652.  end;
  653.  Result:=Result;
  654. end;
  655.  
  656. procedure memcpy(pi,po:pointer;Count:integer); stdcall;
  657. begin
  658.  if ((dword(pi)+dword(Count))>dword(po)) and (dword(pi)<dword(po)) then // Ωε∩Φ≡εΓαφΦσ ± Ωεφ÷α
  659.  asm
  660.   pushad
  661.   pushfd
  662.   mov ECX,Count
  663.   mov EDI,po
  664.   mov ESI,pi
  665.   add ESI,ECX
  666.   add EDI,ECX
  667.   dec ESI
  668.   dec EDI
  669.   std
  670.   repne MOVSB
  671.   popfd
  672.   popad
  673.  end else // Ωε∩Φ≡εΓαφΦσ ± φα≈αδα
  674.  asm
  675.   pushad
  676.   pushfd
  677.   mov ECX,Count
  678.   mov EDI,po
  679.   mov ESI,pi
  680.   cld
  681.   repne MOVSB
  682.   popfd
  683.   popad
  684.  end;
  685. end;
  686.  
  687. procedure memclr(po:pointer;Count:integer); stdcall;
  688. begin
  689.  asm
  690.   pushad
  691.   pushfd
  692.   mov ECX,Count
  693.   mov EDI,po
  694.   xor AL,AL
  695.   cld
  696.   repne STOSB
  697.   popfd
  698.   popad
  699.  end;
  700. end;
  701.  
  702. procedure memset(po:pointer;Value:byte;Count:integer); stdcall;
  703. begin
  704.  asm
  705.   pushad
  706.   pushfd
  707.   mov ECX,Count
  708.   mov EDI,po
  709.   mov AL,Value
  710.   cld
  711.   repne STOSB
  712.   popfd
  713.   popad
  714.  end;
  715. end;
  716.  
  717. function memfind(pi:pointer;Value:dword;Count:integer):integer; stdcall;
  718. label ex;
  719. begin
  720.  asm
  721.   pushad
  722.   pushfd
  723.   mov Result,0
  724.   mov ECX,Count
  725.   cmp ECX,0
  726.   jz ex
  727.   mov EAX,Value
  728.   mov EDI,pi
  729.   cld
  730.   repne SCASD
  731.   jne ex
  732.   mov EAX,Count
  733.   sub EAX,ECX
  734.   mov Result,EAX
  735. ex:
  736.   dec Result
  737.   popfd
  738.   popad
  739.  end;
  740. end;
  741.  
  742.  { THArray }
  743.  
  744. constructor THArray.Create;
  745. begin
  746.  inherited Create;
  747.  
  748.  FCount:=0;
  749.  FCapacity:=0;
  750.  FItemSize:=1;
  751.  FValues:=nil;
  752. end;
  753.  
  754. destructor THArray.Destroy;
  755. begin
  756.  ClearMem;
  757.  FItemSize:=0;
  758.  inherited Destroy;
  759. end;
  760.  
  761. procedure THArray.Delete(num:integer);
  762. begin
  763.  if num>=FCount then raise ERangeError.Create(Format(SItemNotFound,[num]));
  764.  if num<(FCount-1) then memcpy(GetAddr(num+1),GetAddr(num),(FCount-num-1)*FItemSize);
  765.  Dec(FCount);
  766. end;
  767.  
  768. procedure THArray.Clear;
  769. begin
  770.  FCount:=0;
  771. end;
  772.  
  773. procedure THArray.ClearMem;
  774. begin
  775.  FCount:=0;
  776.  FCapacity:=0;
  777.  FreeMem(FValues);
  778.  FValues:=nil;
  779. end;
  780.  
  781. function THArray.Add(pValue:pointer):integer;
  782. begin
  783.  Result:=Insert(FCount,pValue);
  784. end;
  785.  
  786. procedure THArray.AddMany(pValue:pointer;Count:integer);
  787. begin
  788.  if Count<=0 then exit;
  789.  InsertMany(FCount,pValue,Count);
  790. end;
  791.  
  792. procedure THarray.Hold;
  793. // ∩α∞ ≥ⁿ ε≥ΓεΣΦ∞ ≥εδⁿΩε φα Count ²δσ∞σφ≥εΓ
  794. begin
  795.  SetCapacity(FCount);
  796. end;
  797.  
  798. procedure THArray.SetCapacity(Value:integer);
  799. begin
  800.   ReAllocMem(FValues,Value*FItemSize);
  801.   FCapacity:=Value;
  802.   if FCount>FCapacity then FCount:=FCapacity;
  803. end;
  804.  
  805. procedure THArray.AddFillValues(Value:integer);
  806. begin
  807.  if Count+Value>Capacity then GrowTo(Count+Value);
  808.  memclr(CalcAddr(FCount),Value*ItemSize);
  809.  FCount:=FCount+Value;
  810. end;
  811.  
  812. procedure THArray.Zero;
  813. begin
  814.  if FCount=0 then exit;
  815.  memclr(Memory,FCount*ItemSize);
  816. end;
  817.  
  818. procedure THArray.Grow;
  819. // τα⌡Γα≥√Γασ≥ ∩α∞ ≥ⁿ Σδ  ßεδⁿ°σπε ΩεδΦ≈σ±≥Γε ²δσ∞σφ≥εΓ
  820. //     ≡ατ∞σ≡ τα⌡Γα≈σφεΘ ∩α∞ ≥Φ ≤ΓσδΦ≈ΦΓασ≥±  φα 25% σ±δΦ ⌡≡αφΦ≥±  ßεδσσ 64 ²δσ∞σφ≥εΓ
  821. //     ≡ατ∞σ≡ τα⌡Γα≈σφεΘ ∩α∞ ≥Φ ≤ΓσδΦ≈ΦΓασ≥±  φα 16 ²δσ∞σφ≥εΓ σ±δΦ ⌡≡αφΦ≥±  ε≥ 8 Σε 64 ²δσ∞σφ≥εΓ
  822. //     ≡ατ∞σ≡ τα⌡Γα≈σφεΘ ∩α∞ ≥Φ ≤ΓσδΦ≈ΦΓασ≥±  φα 4 ²δσ∞σφ≥α σ±δΦ ⌡≡αφΦ≥±  ∞σφσσ 8 ²δσ∞σφ≥εΓ
  823. var Delta:integer;
  824. begin
  825.  if FCapacity > 64 then Delta := FCapacity div 4 else
  826.    if FCapacity > 8 then Delta := 16 else Delta := 4;
  827.  SetCapacity(FCapacity + Delta);
  828. end;
  829.  
  830. procedure THArray.GrowTo(Count:integer);
  831. // ≡α±≥σ∞ δΦßε Σε ╤ount ²δσ∞σφ≥εΓ (σ±δΦ εφε Σε±≥α≥ε≈φε ΓσδΦΩε) δΦßε ±ΩεδⁿΩε φ≤µφε ∩ε Grow
  832. var Delta:integer;
  833. begin
  834.  if Count<=FCapacity then exit;
  835.  
  836.  if FCapacity > 64 then Delta := FCapacity div 4 else
  837.    if FCapacity > 8 then Delta := 16 else Delta := 4;
  838.  if (FCapacity+Delta)<Count then Delta:=Count-FCapacity;
  839.  SetCapacity(FCapacity + Delta);
  840. end;
  841.  
  842. function THArray.Insert(num:integer;pValue:pointer):integer;
  843. begin
  844.  Error(num,0,FCount);
  845.  if FCount>=FCapacity then begin
  846.   Grow;
  847.  end;
  848.  
  849.  inc(FCount);
  850.  memcpy(CalcAddr(num),CalcAddr(num+1),(FCount-num-1)*FItemSize); // ≡ατΣΓΦπασ∞ ²δσ∞σφ≥√ Σδ  Γ±≥αΓΩΦ
  851.  Update(num,pValue); // τα∩Φ±√Γασ∞ ²δσ∞σφ≥
  852.  Result:=num;
  853. end;
  854.  
  855. procedure THArray.InsertMany(num:integer;pValue:pointer;Count:integer);
  856. begin
  857.  Error(num,0,FCount);
  858.  if FCount+Count>FCapacity then GrowTo(FCount+Count);
  859.  
  860.  FCount:=FCount+Count;
  861.  memcpy(CalcAddr(num),CalcAddr(num+Count),(FCount-num-Count)*FItemSize);
  862.  UpdateMany(num,pValue,Count);
  863. end;
  864.  
  865. procedure THArray.Update(num:integer;pValue:pointer);
  866. begin
  867.  if pValue=nil
  868.   then memclr(GetAddr(num),FItemSize)
  869.   else memcpy(pValue,GetAddr(num),FItemSize);
  870. end;
  871.  
  872. procedure THArray.UpdateMany(num:integer;pValue:pointer;Count:integer);
  873. begin
  874.  Error(num+Count,0,FCount);
  875.  memcpy(pValue,GetAddr(num),FItemSize*Count);
  876. end;
  877.  
  878. procedure THArray.Get(num:integer;pValue:pointer);
  879. begin
  880.  memcpy(GetAddr(num),pValue,FItemSize);
  881. end;
  882.  
  883. function THArray.GetAddr(num:integer):pointer;
  884. begin
  885.  Error(num,0,FCount-1);
  886.  Result:=CalcAddr(num);
  887. end;
  888.  
  889. function THArray.CalcAddr(num:integer):pointer;
  890. begin
  891.  Result:=pointer(dword(FValues)+dword(num)*dword(FItemSize));
  892. end;
  893.  
  894. procedure THArray.Error(Value,min,max:integer);
  895. begin
  896.   if (Value<min) or (Value>max) then raise ERangeError.Create(Format(SItemNotFound,[Value]));
  897. end;
  898.  
  899. procedure THArray.SetItemSize(Size:integer);
  900. begin
  901.  ClearMem;
  902.  if (FCount=0) and (Size>0) then FItemSize:=Size;
  903. end;
  904.  
  905. procedure THArray.MoveData(FromPos,Count,Offset:integer);
  906. var mem:pointer;
  907. begin
  908.  Error(FromPos,0,FCount-1);
  909.  Error(FromPos+Count,0,FCount);
  910.  Error(FromPos+Offset,0,FCount-1);
  911.  Error(FromPos+Offset+Count,0,FCount);
  912.  mem:=AllocMem(Count*FItemSize);
  913.  memcpy(CalcAddr(FromPos),mem,Count*FItemSize);
  914.  if Offset<0 then memcpy(CalcAddr(FromPos+Offset),CalcAddr(FromPos+Offset+Count),(-Offset)*FItemSize);
  915.  if Offset>0 then memcpy(CalcAddr(FromPos+Count),CalcAddr(FromPos),Offset*FItemSize);
  916.  memcpy(mem,CalcAddr(FromPos+Offset),Count*FItemSize);
  917.  FreeMem(mem);
  918. end;
  919.  
  920. procedure THArray.Sort(proc : TCompProc);
  921. var
  922.   maxEl : integer;
  923.   i,j   : integer;
  924. begin
  925.   if Count<2 then exit;
  926.  
  927.   for i:=0 to Count-2 do
  928.   begin
  929.     maxEl:=i;
  930.     for j:=i+1 to Count-1 do
  931.       if proc(self,maxEl,j)<0 then maxEl:=j;
  932.     if maxEl<>i then
  933.     begin
  934.       MoveData(i,1,maxEl-i);
  935.       MoveData(maxEl-1,1,i-maxEl+1);
  936.     end;
  937.   end;
  938. end;
  939.  
  940. procedure THArray.LoadFromStream(s: TStream);
  941. var i,oc:integer;
  942. begin
  943.  s.Read(i,sizeof(i));
  944.  oc:=FCount;
  945.  AddFillValues(i);
  946.  s.Read(CalcAddr(oc)^,i*FItemSize);
  947. end;
  948.  
  949. procedure THArray.Swap(Index1, Index2: integer);
  950. var p:pointer;
  951. begin
  952.   p:=AllocMem(FItemSize);
  953.   memcpy(GetAddr(Index1),p,FItemSize);
  954.   memcpy(GetAddr(Index2),GetAddr(Index1),FItemSize);
  955.   memcpy(p,GetAddr(Index2),FItemSize);
  956. end;
  957.  
  958. { THArraySmallInt }
  959.  
  960. constructor THArraySmallInt.Create;
  961. begin
  962.  inherited Create;
  963.  FItemSize:=sizeof(smallint);
  964. end;
  965.  
  966. function THArraySmallInt.AddValue(Value:smallint):integer;
  967. begin
  968.  Result:=inherited Add(@Value);
  969. end;
  970.  
  971. function THArraySmallInt.GetValue(Index:integer):smallint;
  972. begin
  973.  Result:=psmallint(GetAddr(Index))^;
  974. end;
  975.  
  976. procedure THArraySmallInt.SetValue(Index:integer;Value:smallint);
  977. begin
  978.  Update(Index,@Value);
  979. end;
  980.  
  981.  { THArrayWord }
  982.  
  983. constructor THArrayWord.Create;
  984. begin
  985.  inherited Create;
  986.  FItemSize:=sizeof(Word);
  987. end;
  988.  
  989. function THArrayWord.AddValue(Value:Word):integer;
  990. begin
  991.  Result:=inherited Add(@Value);
  992. end;
  993.  
  994. function THArrayWord.GetValue(Index:integer):Word;
  995. begin
  996.  Result:=pword(GetAddr(Index))^;
  997. end;
  998.  
  999. procedure THArrayWord.SetValue(Index:integer;Value:Word);
  1000. begin
  1001.  Update(Index,@Value);
  1002. end;
  1003.  
  1004.  { THArrayLongWord }
  1005.  
  1006. constructor THArrayLongWord.Create;
  1007. begin
  1008.  inherited Create;
  1009.  FItemSize:=sizeof(LongWord);
  1010. end;
  1011.  
  1012. function THArrayLongWord.AddValue(Value:LongWord):integer;
  1013. begin
  1014.  Result:=inherited Add(@Value);
  1015. end;
  1016.  
  1017. function THArrayLongWord.GetValue(Index:integer):LongWord;
  1018. begin
  1019.  Result:=pLongWord(GetAddr(Index))^;
  1020. end;
  1021.  
  1022. procedure THArrayLongWord.SetValue(Index:integer;Value:LongWord);
  1023. begin
  1024.  Update(Index,@Value);
  1025. end;
  1026.  
  1027. function THArrayLongWord.IndexOf(Value: LongWord): integer;
  1028. begin
  1029.  Result:=IndexOfFrom(Value,0);
  1030. end;
  1031.  
  1032. function THArrayLongWord.IndexOfFrom(Value: LongWord; Start: integer): integer;
  1033. var i:integer;
  1034. begin
  1035.  if Count=0 then begin
  1036.   Result:=-1;
  1037.   exit;
  1038.  end;
  1039.  Error(Start,0,Count-1);
  1040.  if Assigned(FValues) then
  1041.   for i:=Start to Count-1 do
  1042.    if self.Value[i]=Value then begin
  1043.     Result:=i;
  1044.     exit;
  1045.    end;
  1046.  Result:=-1;
  1047. end;
  1048.  
  1049.  { THArrayInt64 }
  1050.  
  1051. constructor THArrayInt64.Create;
  1052. begin
  1053.  inherited Create;
  1054.  FItemSize:=sizeof(Int64);
  1055. end;
  1056.  
  1057. function THArrayInt64.AddValue(Value:Int64):integer;
  1058. begin
  1059.  Result:=inherited Add(@Value);
  1060. end;
  1061.  
  1062. function THArrayInt64.GetValue(Index:integer):Int64;
  1063. begin
  1064.  Result:=pint64(GetAddr(Index))^;
  1065. end;
  1066.  
  1067. procedure THArrayInt64.SetValue(Index:integer;Value:Int64);
  1068. begin
  1069.  Update(Index,@Value);
  1070. end;
  1071.  
  1072.  { THArrayInteger }
  1073.  
  1074. constructor THArrayInteger.Create;
  1075. begin
  1076.  inherited Create;
  1077.  FItemSize:=sizeof(integer);
  1078. end;
  1079.  
  1080. function THArrayInteger.AddValue(Value:integer):integer;
  1081. begin
  1082.  Result:=inherited Add(@Value);
  1083. end;
  1084.  
  1085. function THArrayInteger.IndexOf(Value:integer):integer;
  1086. begin
  1087.  Result:=IndexOfFrom(Value,0);
  1088. end;
  1089.  
  1090. function THArrayInteger.IndexOfFrom(Value:integer;Start:integer):integer;
  1091. begin
  1092.  if Start=Count then begin
  1093.   Result:=-1;
  1094.   exit;
  1095.  end;
  1096.  Error(Start,0,Count-1);
  1097.  if FValues=nil
  1098.   then Result:=-1
  1099.   else begin
  1100.    Result:=memfind(GetAddr(Start),dword(Value),Count-Start);
  1101.    if Result<>-1 then Result:=Result+Start;
  1102.   end;
  1103. end;
  1104.  
  1105. function THArrayInteger.GetValue(Index:integer):integer;
  1106. begin
  1107.  Result:=pinteger(GetAddr(Index))^;
  1108. end;
  1109.  
  1110. procedure THArrayInteger.SetValue(Index:integer;Value:Integer);
  1111. begin
  1112.  Update(Index,@Value);
  1113. end;
  1114.  
  1115. procedure THArrayInteger.Push(Value:Integer);
  1116. begin
  1117.  AddValue(Value);
  1118. end;
  1119.  
  1120. function THArrayInteger.Pop:integer;
  1121. begin
  1122.  Result:=Value[Count-1];
  1123.  Delete(Count-1);
  1124. end;
  1125.  
  1126. procedure THArrayInteger.AddFromString(InputString,Delimiters:string);
  1127. var i,c:integer;
  1128. begin
  1129.  c:=HGetTokenCount(InputString,Delimiters,False);
  1130.  for i:=0 to c-1 do
  1131.   AddValue(StrToInt(HGetToken(InputString,Delimiters,False,i)));
  1132. end;
  1133.  
  1134. function THArrayInteger.GetAsString:string;
  1135. var i:integer;
  1136. begin
  1137.  Result:=' ';
  1138.  for i:=0 to Count-1 do
  1139.   Result:=Result+IntToStr(Value[i])+' ';
  1140. end;
  1141.  
  1142. function THArrayInteger.CalcMax: integer;
  1143. var i:integer;
  1144. begin
  1145.  if Count=0 then begin Result:=-1; exit; end;
  1146.  Result:=Value[0];
  1147.  for i:=1 to Count-1 do
  1148.   if Value[i]>Result then Result:=Value[i];
  1149. end;
  1150.  
  1151.  { THArrayPointer }
  1152.  
  1153. constructor THArrayPointer.Create;
  1154. begin
  1155.  inherited Create;
  1156.  FItemSize:=sizeof(pointer);
  1157. end;
  1158.  
  1159. function THArrayPointer.AddValue(Value:pointer):integer;
  1160. begin
  1161.  Result:=inherited Add(@Value);
  1162. end;
  1163.  
  1164. function THArrayPointer.IndexOf(Value:pointer):integer;
  1165. begin
  1166.  Result:=memfind(FValues,dword(Value),Count);
  1167. end;
  1168.  
  1169. function THArrayPointer.GetValue(Index:integer):Pointer;
  1170. begin
  1171.  Result:=ppointer(GetAddr(Index))^;
  1172. end;
  1173.  
  1174. procedure THArrayPointer.SetValue(Index:integer;Value:Pointer);
  1175. begin
  1176.  Update(Index,@Value);
  1177. end;
  1178.  
  1179.  { THArrayBoolean }
  1180.  
  1181. constructor THArrayBoolean.Create;
  1182. begin
  1183.  inherited Create;
  1184.  FItemSize:=sizeof(boolean);
  1185. end;
  1186.  
  1187. function THArrayBoolean.AddValue(Value:boolean):integer;
  1188. begin
  1189.  Result:=inherited Add(@Value);
  1190. end;
  1191.  
  1192. function THArrayBoolean.GetValue(Index:integer):Boolean;
  1193. begin
  1194.  Result:=pboolean(GetAddr(Index))^;
  1195. end;
  1196.  
  1197. procedure THArrayBoolean.SetValue(Index:integer;Value:Boolean);
  1198. begin
  1199.  Update(Index,@Value);
  1200. end;
  1201.  
  1202.  { THArrayDouble }
  1203.  
  1204. constructor THArrayDouble.Create;
  1205. begin
  1206.  inherited Create;
  1207.  FItemSize:=sizeof(Double);
  1208. end;
  1209.  
  1210. function THArrayDouble.AddValue(Value:Double):integer;
  1211. begin
  1212.  Result:=inherited Add(@Value);
  1213. end;
  1214.  
  1215. function THArrayDouble.GetValue(Index:integer):Double;
  1216. begin
  1217.  Result:=pdouble(GetAddr(Index))^;
  1218. end;
  1219.  
  1220. procedure THArrayDouble.SetValue(Index:integer;Value:Double);
  1221. begin
  1222.  Update(Index,@Value);
  1223. end;
  1224.  
  1225.  { THArrayExtended }
  1226.  
  1227. constructor THArrayExtended.Create;
  1228. begin
  1229.  inherited Create;
  1230.  FItemSize:=sizeof(Extended);
  1231. end;
  1232.  
  1233. function THArrayExtended.GetValue(Index: integer): Extended;
  1234. begin
  1235.  Result:=pextended(GetAddr(Index))^;
  1236. end;
  1237.  
  1238. function THArrayExtended.AddValue(Value: Extended): integer;
  1239. begin
  1240.  Result:=inherited Add(@Value);
  1241. end;
  1242.  
  1243. procedure THArrayExtended.SetValue(Index: integer; Value: Extended);
  1244. begin
  1245.  Update(Index,@Value);
  1246. end;
  1247.  
  1248.  { THArrayCurrency }
  1249.  
  1250. constructor THArrayCurrency.Create;
  1251. begin
  1252.  inherited Create;
  1253.  FItemSize:=sizeof(currency);
  1254. end;
  1255.  
  1256. function THArrayCurrency.AddValue(Value:Currency):integer;
  1257. begin
  1258.  Result:=inherited Add(@Value);
  1259. end;
  1260.  
  1261. function THArrayCurrency.GetValue(Index:integer):Currency;
  1262. begin
  1263.  Result:=pcurrency(GetAddr(Index))^;
  1264. end;
  1265.  
  1266. procedure THArrayCurrency.SetValue(Index:integer;Value:Currency);
  1267. begin
  1268.  Update(Index,@Value);
  1269. end;
  1270.  
  1271.   { THArrayString }
  1272.  
  1273. constructor THArrayString.Create;
  1274. begin
  1275.   str_ptr:=THArrayPointer.Create;
  1276.   FCount:=0;
  1277.   FCapacity:=0;
  1278.   FItemSize:=0;
  1279.   FValues:=nil;
  1280. end;
  1281.  
  1282. destructor THArrayString.Destroy;
  1283. var
  1284.   i    : integer;
  1285.   pStr : PChar;
  1286. begin
  1287.   for i:=0 to str_ptr.Count-1 do
  1288.   begin
  1289.     pStr:=PChar(str_ptr.Value[i]);
  1290.     StrDispose(pStr);
  1291.   end;
  1292.   str_ptr.Free;
  1293. end;
  1294.  
  1295. function THArrayString.CalcAddr(num:integer):pointer;
  1296. begin
  1297.   Result:=pointer(dword(str_ptr.FValues)+dword(num)*dword(FItemSize));
  1298. end;
  1299.  
  1300. function THArrayString.AddValue(Value:String):integer;
  1301. begin
  1302.   result:=self.Add(PChar(Value));
  1303. end;
  1304.  
  1305. function THArrayString.Add(pValue:pointer):integer;
  1306. begin
  1307.   Result:=Insert(FCount,pValue);
  1308. end;
  1309.  
  1310. function THArrayString.Insert(num:integer;pValue:pointer):integer;
  1311. var
  1312.   pStr : PChar;
  1313.   l    : integer;
  1314. begin
  1315.   l:=StrLen(PChar(pValue));
  1316.   pStr:=StrAlloc(l+1);
  1317.   memcpy(pValue,pStr,l+1);
  1318.   str_ptr.Insert(num,@pStr);
  1319.   FCount:=str_ptr.Count;
  1320.   FCapacity:=str_ptr.Capacity;
  1321.   Result:=FCount;
  1322. end;
  1323.  
  1324. procedure THArrayString.Update(num:integer;pValue:pointer);
  1325. var
  1326.   pStr : PChar;
  1327.   l    : integer;
  1328. begin
  1329.   pStr:=PChar(str_ptr.Value[num]);
  1330.   if pStr<>nil then StrDispose(pStr);
  1331.  
  1332.   if pValue<>nil then begin
  1333.    l:=StrLen(PChar(pValue));
  1334.    pStr:=StrAlloc(l+1);
  1335.    memcpy(pValue,pStr,l+1);
  1336.    str_ptr.Value[num]:=pStr;
  1337.   end else
  1338.    str_ptr.Value[num]:=nil;
  1339. end;
  1340.  
  1341. procedure THArrayString.MoveData(FromPos,Count,Offset:integer);
  1342. begin
  1343.   str_ptr.MoveData(FromPos, Count, Offset);
  1344. end;
  1345.  
  1346. procedure THArrayString.Delete(num:integer);
  1347. var pStr:PChar;
  1348. begin
  1349.   pStr:=PChar(str_ptr.Value[num]);
  1350.   StrDispose(pStr);
  1351.   str_ptr.Delete(num);
  1352.   FCount:=str_ptr.Count;
  1353. end;
  1354.  
  1355. procedure THArrayString.Get(num:integer;pValue:pointer);
  1356. var
  1357.   pStr : PChar;
  1358.   l    : integer;
  1359. begin
  1360.   pStr:=PChar(str_ptr.Value[num]);
  1361.   l:=StrLen(pStr);
  1362.   memcpy(pointer(pStr),pValue,l+1);
  1363. end;
  1364.  
  1365. function THArrayString.GetValue(Index:integer):String;
  1366. var
  1367.   pStr : PChar;
  1368. begin
  1369.   pStr:=PChar(str_ptr.Value[Index]);
  1370.   result:=pStr;
  1371. end;
  1372.  
  1373. procedure THArrayString.SetValue(Index:integer;Value:String);
  1374. begin
  1375.   self.Update(Index,pointer(Value));
  1376. end;
  1377.  
  1378. procedure THArrayString.Clear;
  1379. var i:integer;
  1380.     pStr:PChar;
  1381. begin
  1382.   for i:=0 to str_ptr.Count-1 do
  1383.   begin
  1384.     pStr:=PChar(str_ptr.Value[i]);
  1385.     StrDispose(pStr);
  1386.   end;
  1387.   str_ptr.Clear;
  1388.   FCount:=0;
  1389.   FCapacity:=0;
  1390. end;
  1391.  
  1392. procedure THArrayString.ClearMem;
  1393. var
  1394.   i    : integer;
  1395.   pStr : PChar;
  1396. begin
  1397.   for i:=0 to str_ptr.Count-1 do
  1398.   begin
  1399.     pStr:=PChar(str_ptr.Value[i]);
  1400.     StrDispose(pStr);
  1401.   end;
  1402.  str_ptr.ClearMem;
  1403.  inherited ClearMem;
  1404. end;
  1405.  
  1406. function THArrayString.IndexOf(Value:string):integer;
  1407. var i : integer;
  1408.     PVal : PChar;
  1409. begin
  1410. PVal := PChar(Value);
  1411.   for i := 0 to Count-1 do
  1412.   begin
  1413.     if (StrComp(PVal,PChar(str_ptr.Value[i])) = 0) then
  1414.     begin
  1415.       Result:=i;
  1416.       exit;
  1417.     end;
  1418.   end;
  1419.   Result := -1;
  1420. end;
  1421.  
  1422. { THArrayStringFix }
  1423.  
  1424. function THArrayStringFix.AddValue(Value: string): integer;
  1425. var buf:pointer;
  1426. begin
  1427.  buf:=AllocMem(FItemSize+1);
  1428.  memclr(buf,FItemSize+1);
  1429.  try
  1430.   strplcopy(buf,Value,FItemSize);
  1431.   Result:=inherited Add(buf);
  1432.  finally
  1433.   FreeMem(buf);
  1434.  end;
  1435. end;
  1436.  
  1437. constructor THArrayStringFix.Create;
  1438. begin
  1439.  raise Exception.Create('Use CreateSize !');
  1440. end;
  1441.  
  1442. constructor THArrayStringFix.CreateSize(Size: integer);
  1443. begin
  1444.  inherited Create;
  1445.  FItemSize:=Size;
  1446. end;
  1447.  
  1448. function THArrayStringFix.GetValue(Index: integer): string;
  1449. var buf:pointer;
  1450. begin
  1451.  buf:=AllocMem(FItemSize+1);
  1452.  memclr(buf,FItemSize+1);
  1453.  try
  1454.   memcpy(GetAddr(Index),buf,FItemSize);
  1455.   Result:=strpas(buf);
  1456.  finally
  1457.   FreeMem(buf);
  1458.  end;
  1459. end;
  1460.  
  1461. procedure THArrayStringFix.SetValue(Index: integer; Value: string);
  1462. var buf:pointer;
  1463. begin
  1464.  buf:=AllocMem(FItemSize+1);
  1465.  memclr(buf,FItemSize+1);
  1466.  try
  1467.   strplcopy(buf,Value,FItemSize);
  1468.   inherited Update(Index,buf);
  1469.  finally
  1470.   FreeMem(buf);
  1471.  end;
  1472. end;
  1473.  
  1474. { THArrayObjects }
  1475.  
  1476. function THArrayObjects.AddValue(Value: TObject): integer;
  1477. begin
  1478.  Result:=inherited Add(@Value);
  1479. end;
  1480.  
  1481. procedure THArrayObjects.ClearMem;
  1482. var i:integer;
  1483. begin
  1484.  for i:=0 to Count-1 do GetValue(i).Free;
  1485.  inherited;
  1486. end;
  1487.  
  1488. procedure THArrayObjects.SafeClearMem;
  1489. begin
  1490.  inherited ClearMem;
  1491. end;
  1492.  
  1493. constructor THArrayObjects.Create;
  1494. begin
  1495.  inherited;
  1496.  FItemSize:=sizeof(TObject);
  1497. end;
  1498.  
  1499. procedure THArrayObjects.Delete(Index: integer);
  1500. var o:TObject;
  1501. begin
  1502.  o:=GetValue(Index);
  1503.  inherited;
  1504.  if Assigned(o) then o.Free;
  1505. end;
  1506.  
  1507. procedure THArrayObjects.SafeDelete(Index: integer);
  1508. begin
  1509.  inherited Delete(Index);
  1510. end;
  1511.  
  1512. function THArrayObjects.GetValue(Index: integer): TObject;
  1513. begin
  1514.  Result:=TObject(GetAddr(Index)^);
  1515. end;
  1516.  
  1517.  
  1518. procedure THArrayObjects.SetValue(Index: integer;const Value: TObject);
  1519. begin
  1520.  Update(Index,@Value);
  1521. end;
  1522.  
  1523. { THash }
  1524.  
  1525. constructor THash.Create;
  1526. begin
  1527.  FReadOnly:=False;
  1528.  FAIndex:=THArrayInteger.Create;
  1529. end;
  1530.  
  1531. destructor THash.Destroy;
  1532. begin
  1533.  if not FReadOnly then FAIndex.Free;
  1534.  inherited Destroy;
  1535. end;
  1536.  
  1537. procedure THash.Clear;
  1538. begin
  1539.  FAIndex.Clear;
  1540. end;
  1541.  
  1542. procedure THash.ClearMem;
  1543. begin
  1544.  FAIndex.ClearMem;
  1545. end;
  1546.  
  1547. function THash.GetCount:integer;
  1548. begin
  1549.  Result:=FAIndex.Count;
  1550. end;
  1551.  
  1552. function THash.GetKey(Index:integer):integer;
  1553. begin
  1554.  Result:=FAIndex[Index];
  1555. end;
  1556.  
  1557. function THash.IfExist(Key:integer):boolean;
  1558. begin
  1559.  Result:=FAIndex.IndexOf(Key)<>-1;
  1560. end;
  1561.  
  1562.  { THashExists }
  1563.  
  1564. constructor THashExists.Create;
  1565. begin
  1566.  inherited Create;
  1567. end;
  1568.  
  1569. destructor THashExists.Destroy;
  1570. begin
  1571.  inherited Destroy;
  1572. end;
  1573.  
  1574. procedure THashExists.SetValue(Index:integer;Value:boolean);
  1575. var r:integer;
  1576. begin
  1577.  r:=FAIndex.IndexOf(Index);
  1578.  if (r=-1) and Value then FAIndex.AddValue(Index);
  1579.  if (r<>-1) and (not Value) then FAIndex.Delete(r);
  1580. end;
  1581.  
  1582. procedure THashExists.Delete(Key:integer);
  1583. var r:integer;
  1584. begin
  1585.  r:=FAIndex.IndexOf(Key);
  1586.  if (r<>-1) then FAIndex.Delete(r);
  1587. end;
  1588.  
  1589. function THashExists.GetValue(Index:integer):boolean;
  1590. var r:integer;
  1591. begin
  1592.  r:=FAIndex.IndexOf(Index);
  1593.  Result:=(r<>-1);
  1594. end;
  1595.  
  1596.  { THashBoolean }
  1597.  
  1598. constructor THashBoolean.Create;
  1599. begin
  1600.  inherited Create;
  1601.  FAValues:=THArrayBoolean.Create;
  1602. end;
  1603.  
  1604. constructor THashBoolean.CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayBoolean);
  1605. begin
  1606.  FAIndex:=IndexHArray;
  1607.  FAValues:=ValueHArray;
  1608.  FReadOnly:=True;
  1609. end;
  1610.  
  1611. destructor THashBoolean.Destroy;
  1612. begin
  1613.  if not FReadOnly then  FAValues.Free;
  1614.  inherited Destroy;
  1615. end;
  1616.  
  1617. procedure THashBoolean.SetValue(Key:integer;Value:boolean);
  1618. var n:integer;
  1619. begin
  1620.  n:=FAIndex.IndexOf(Key);
  1621.  if n>=0 then begin
  1622.   FAValues[n]:=Value;
  1623.   exit;
  1624.  end;
  1625.  if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
  1626.  FAIndex.AddValue(Key);
  1627.  FAValues.AddValue(Value);
  1628. end;
  1629.  
  1630. function THashBoolean.GetValue(Key:integer):boolean;
  1631. var n:integer;
  1632. begin
  1633.  n:=FAIndex.IndexOf(Key);
  1634.  if n>=0 then begin
  1635.   Result:=FAValues[n];
  1636.  end else begin
  1637.   Result:=False;
  1638.  end;
  1639. end;
  1640.  
  1641. procedure THashBoolean.Clear;
  1642. begin
  1643.  inherited Clear;
  1644.  FAValues.Clear;
  1645. end;
  1646.  
  1647. procedure THashBoolean.ClearMem;
  1648. begin
  1649.  inherited ClearMem;
  1650.  FAValues.ClearMem;
  1651. end;
  1652.  
  1653. procedure THashBoolean.Delete(Key:integer);
  1654. var n:integer;
  1655. begin
  1656.  n:=FAIndex.IndexOf(Key);
  1657.  if n>=0 then begin
  1658.   FAIndex.Delete(n);
  1659.   FAValues.Delete(n);
  1660.  end;
  1661. end;
  1662.  
  1663.  { THashInteger }
  1664.  
  1665. constructor THashInteger.Create;
  1666. begin
  1667.  inherited Create;
  1668.  FAValues:=THArrayInteger.Create;
  1669. end;
  1670.  
  1671. constructor THashInteger.CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayInteger);
  1672. begin
  1673.  FAIndex:=IndexHArray;
  1674.  FAValues:=ValueHArray;
  1675.  FReadOnly:=True;
  1676. end;
  1677.  
  1678. destructor THashInteger.Destroy;
  1679. begin
  1680.  if not FReadOnly then  FAValues.Free;
  1681.  inherited Destroy;
  1682. end;
  1683.  
  1684. procedure THashInteger.SetValue(Key:integer;Value:integer);
  1685. var n:integer;
  1686. begin
  1687.  n:=FAIndex.IndexOf(Key);
  1688.  if n>=0 then begin
  1689.   FAValues[n]:=Value;
  1690.   exit;
  1691.  end;
  1692.  if FReadOnly then raise Exception.Create(Format(SKeyNotFound,[Key]));
  1693.  FAIndex.AddValue(Key);
  1694.  FAValues.AddValue(Value);
  1695. end;
  1696.  
  1697. function THashInteger.GetValue(Key:integer):integer;
  1698. var n:integer;
  1699. begin
  1700.  n:=FAIndex.IndexOf(Key);
  1701.  if n>=0 then begin
  1702.   Result:=FAValues[n];
  1703.  end else begin
  1704.   Result:=0;
  1705.  end;
  1706. end;
  1707.  
  1708. procedure THashInteger.Clear;
  1709. begin
  1710.  inherited Clear;
  1711.  FAValues.Clear;
  1712. end;
  1713.  
  1714. procedure THashInteger.ClearMem;
  1715. begin
  1716.  inherited ClearMem;
  1717.  FAValues.ClearMem;
  1718. end;
  1719.  
  1720. procedure THashInteger.Delete(Key:integer);
  1721. var n:integer;
  1722. begin
  1723.  n:=FAIndex.IndexOf(Key);
  1724.  if n>=0 then begin
  1725.   FAIndex.Delete(n);
  1726.   FAValues.Delete(n);
  1727.  end;
  1728. end;
  1729.  
  1730.  { THashPointer }
  1731.  
  1732. constructor THashPointer.Create;
  1733. begin
  1734.  inherited Create;
  1735.  FAValues:=THArrayPointer.Create;
  1736. end;
  1737.  
  1738. constructor THashPointer.CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayPointer);
  1739. begin
  1740.  FAIndex:=IndexHArray;
  1741.  FAValues:=ValueHArray;
  1742.  FReadOnly:=True;
  1743. end;
  1744.  
  1745. destructor THashPointer.Destroy;
  1746. begin
  1747.  if not FReadOnly then  FAValues.Free;
  1748.  inherited Destroy;
  1749. end;
  1750.  
  1751. procedure THashPointer.SetValue(Key:integer;Value:Pointer);
  1752. var n:integer;
  1753. begin
  1754.  n:=FAIndex.IndexOf(Key);
  1755.  if n>=0 then begin
  1756.   FAValues[n]:=Value;
  1757.   exit;
  1758.  end;
  1759.  if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
  1760.  FAIndex.AddValue(Key);
  1761.  FAValues.AddValue(Value);
  1762. end;
  1763.  
  1764. function THashPointer.GetValue(Key:integer):Pointer;
  1765. var n:integer;
  1766. begin
  1767.  n:=FAIndex.IndexOf(Key);
  1768.  if n>=0 then begin
  1769.   Result:=FAValues[n];
  1770.  end else begin
  1771.   Result:=nil;
  1772.  end;
  1773. end;
  1774.  
  1775. procedure THashPointer.Clear;
  1776. begin
  1777.  inherited Clear;
  1778.  FAValues.Clear;
  1779. end;
  1780.  
  1781. procedure THashPointer.ClearMem;
  1782. begin
  1783.  inherited ClearMem;
  1784.  FAValues.ClearMem;
  1785. end;
  1786.  
  1787. procedure THashPointer.Delete(Key:integer);
  1788. var n:integer;
  1789. begin
  1790.  n:=FAIndex.IndexOf(Key);
  1791.  if n>=0 then begin
  1792.   FAIndex.Delete(n);
  1793.   FAValues.Delete(n);
  1794.  end;
  1795. end;
  1796.  
  1797.  { THashCurrency }
  1798.  
  1799. constructor THashCurrency.Create;
  1800. begin
  1801.  inherited Create;
  1802.  FAValues:=THArrayCurrency.Create;
  1803. end;
  1804.  
  1805. constructor THashCurrency.CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayCurrency);
  1806. begin
  1807.  FAIndex:=IndexHArray;
  1808.  FAValues:=ValueHArray;
  1809.  FReadOnly:=True;
  1810. end;
  1811.  
  1812. destructor THashCurrency.Destroy;
  1813. begin
  1814.  if not FReadOnly then  FAValues.Free;
  1815.  inherited Destroy;
  1816. end;
  1817.  
  1818. procedure THashCurrency.SetValue(Key:integer;Value:currency);
  1819. var n:integer;
  1820. begin
  1821.  n:=FAIndex.IndexOf(Key);
  1822.  if n>=0 then begin
  1823.   FAValues[n]:=Value;
  1824.   exit;
  1825.  end;
  1826.  if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
  1827.  FAIndex.AddValue(Key);
  1828.  FAValues.AddValue(Value);
  1829. end;
  1830.  
  1831. procedure THashCurrency.Inc(Key:integer;Value:currency);
  1832. var n:integer;
  1833. begin
  1834.  n:=FAIndex.IndexOf(Key);
  1835.  if n>=0 then begin
  1836.   FAValues[n]:=FAValues[n]+Value;
  1837.  end else begin
  1838.   if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
  1839.   SetValue(Key,Value);
  1840.  end;
  1841. end;
  1842.  
  1843. function THashCurrency.GetValue(Key:integer):currency;
  1844. var n:integer;
  1845. begin
  1846.  n:=FAIndex.IndexOf(Key);
  1847.  if n>=0 then begin
  1848.   Result:=FAValues[n];
  1849.  end else begin
  1850.   Result:=0;
  1851.  end;
  1852. end;
  1853.  
  1854. procedure THashCurrency.Clear;
  1855. begin
  1856.  inherited Clear;
  1857.  FAValues.Clear;
  1858. end;
  1859.  
  1860. procedure THashCurrency.ClearMem;
  1861. begin
  1862.  inherited ClearMem;
  1863.  FAValues.ClearMem;
  1864. end;
  1865.  
  1866. procedure THashCurrency.Delete(Key:integer);
  1867. var n:integer;
  1868. begin
  1869.  n:=FAIndex.IndexOf(Key);
  1870.  if n>=0 then begin
  1871.   FAIndex.Delete(n);
  1872.   FAValues.Delete(n);
  1873.  end;
  1874. end;
  1875.  
  1876.  { THashDouble }
  1877.  
  1878. constructor THashDouble.Create;
  1879. begin
  1880.  inherited Create;
  1881.  FAValues:=THArrayDouble.Create;
  1882. end;
  1883.  
  1884. constructor THashDouble.CreateFromHArrays(IndexHArray:THArrayInteger;ValueHArray:THArrayDouble);
  1885. begin
  1886.  FAIndex:=IndexHArray;
  1887.  FAValues:=ValueHArray;
  1888.  FReadOnly:=True;
  1889. end;
  1890.  
  1891. destructor THashDouble.Destroy;
  1892. begin
  1893.  if not FReadOnly then  FAValues.Free;
  1894.  inherited Destroy;
  1895. end;
  1896.  
  1897. procedure THashDouble.SetValue(Key:integer;Value:Double);
  1898. var n:integer;
  1899. begin
  1900.  n:=FAIndex.IndexOf(Key);
  1901.  if n>=0 then begin
  1902.   FAValues[n]:=Value;
  1903.   exit;
  1904.  end;
  1905.  if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
  1906.  FAIndex.AddValue(Key);
  1907.  FAValues.AddValue(Value);
  1908. end;
  1909.  
  1910. procedure THashDouble.Inc(Key:integer;Value:Double);
  1911. var n:integer;
  1912. begin
  1913.  n:=FAIndex.IndexOf(Key);
  1914.  if n>=0 then begin
  1915.   FAValues[n]:=FAValues[n]+Value;
  1916.  end else begin
  1917.   if FReadOnly then raise ERangeError.Create(Format(SKeyNotFound,[Key]));
  1918.   SetValue(Key,Value);
  1919.  end;
  1920. end;
  1921.  
  1922. function THashDouble.GetValue(Key:integer):Double;
  1923. var n:integer;
  1924. begin
  1925.  n:=FAIndex.IndexOf(Key);
  1926.  if n>=0 then begin
  1927.   Result:=FAValues[n];
  1928.  end else begin
  1929.   Result:=0;
  1930.  end;
  1931. end;
  1932.  
  1933. procedure THashDouble.Clear;
  1934. begin
  1935.  inherited Clear;
  1936.  FAValues.Clear;
  1937. end;
  1938.  
  1939. procedure THashDouble.ClearMem;
  1940. begin
  1941.  inherited ClearMem;
  1942.  FAValues.ClearMem;
  1943. end;
  1944.  
  1945. procedure THashDouble.Delete(Key:integer);
  1946. var n:integer;
  1947. begin
  1948.  n:=FAIndex.IndexOf(Key);
  1949.  if n>=0 then begin
  1950.   FAIndex.Delete(n);
  1951.   FAValues.Delete(n);
  1952.  end;
  1953. end;
  1954.  
  1955.  { THashString }
  1956.  
  1957. constructor THashString.Create;
  1958. begin
  1959.  inherited Create;
  1960.  FAValues:=TStringList.Create;
  1961.  FAllowEmptyStr:=True;
  1962. end;
  1963.  
  1964. destructor THashString.Destroy;
  1965. begin
  1966.  FAValues.Free;
  1967.  inherited Destroy;
  1968. end;
  1969.  
  1970. procedure THashString.SetValue(Key:integer;Value:String);
  1971. var n:integer;
  1972. begin
  1973.  n:=FAIndex.IndexOf(Key);
  1974.  if n>=0 then begin
  1975.   if not FAllowEmptyStr and (Value='')
  1976.    then begin FAValues.Delete(n); FAIndex.Delete(n); end
  1977.    else FAValues[n]:=Value;
  1978.  end else
  1979.   if FAllowEmptyStr or (Value<>'') then begin
  1980.    FAIndex.AddValue(Key);
  1981.    FAValues.Add(Value);
  1982.   end;
  1983. end;
  1984.  
  1985. function THashString.GetValue(Key:integer):String;
  1986. var n:integer;
  1987. begin
  1988.  n:=FAIndex.IndexOf(Key);
  1989.  if n>=0 then begin
  1990.   Result:=FAValues[n];
  1991.  end else begin
  1992.   Result:='';
  1993.  end;
  1994. end;
  1995.  
  1996. procedure THashString.Clear;
  1997. begin
  1998.  inherited Clear;
  1999.  FAValues.Clear;
  2000. end;
  2001.  
  2002. procedure THashString.ClearMem;
  2003. begin
  2004.  inherited ClearMem;
  2005.  FAValues.Clear;
  2006. end;
  2007.  
  2008. procedure THashString.Delete(Key:integer);
  2009. var n:integer;
  2010. begin
  2011.  n:=FAIndex.IndexOf(Key);
  2012.  if n>=0 then begin
  2013.   FAIndex.Delete(n);
  2014.   FAValues.Delete(n);
  2015.  end;
  2016. end;
  2017.  
  2018.  { THash2 }
  2019.  
  2020. constructor THash2.Create;
  2021. begin
  2022.  MainListIndex:=THArrayInteger.Create;
  2023.  MainListValue:=THArrayPointer.Create;
  2024. end;
  2025.  
  2026. destructor THash2.Destroy;
  2027. begin
  2028.  Clear;
  2029.  MainListValue.Free;
  2030.  MainListIndex.Free;
  2031.  inherited Destroy;
  2032. end;
  2033.  
  2034. {function THash2.GetKey(Index:integer):integer;
  2035. begin
  2036.  Result:=MainListIndex[Index];
  2037. end;}
  2038.  
  2039. procedure THash2.ClearMem;
  2040. begin
  2041.  Clear;
  2042.  MainListValue.ClearMem;
  2043.  MainListIndex.ClearMem;
  2044. end;
  2045.  
  2046. function THash2.GetChildHash(Key:integer):THash;
  2047. var n:integer;
  2048. begin
  2049.  n:=MainListIndex.IndexOf(Key);
  2050.  if n=-1
  2051.   then Result:=nil
  2052.   else Result:=MainListValue[n];
  2053. end;
  2054.  
  2055. procedure THash2.Delete(MainIndex,Index:integer);
  2056. var n:integer;
  2057.     arr:THashBoolean;
  2058. begin
  2059.  n:=MainListIndex.IndexOf(MainIndex);
  2060.  if n=-1 then exit;
  2061.  arr:=MainListValue[n];
  2062.  THash(arr).Delete(Index);
  2063.  if arr.Count=0 then begin
  2064.   arr.Free;
  2065.   MainListValue.Delete(n);
  2066.   MainListIndex.Delete(n);
  2067.  end;
  2068. end;
  2069.  
  2070. {function THash2.ExistMainHash(MainIndex:integer):boolean;
  2071. var n:integer;
  2072. begin
  2073.  n:=MainListIndex.IndexOf(MainIndex);
  2074.  Result:=n<>-1;
  2075. end;}
  2076.  
  2077.  { THash2Exists }
  2078.  
  2079. procedure THash2Exists.Clear;
  2080. var i:integer;
  2081. begin
  2082.  for i:=0 to MainListValue.Count-1 do begin
  2083.   THashExists(MainListValue[i]).Free;
  2084.  end;
  2085.  MainListValue.Clear;
  2086.  MainListIndex.Clear;
  2087. end;
  2088.  
  2089. procedure THash2Exists.SetValue(MainIndex,Index:integer;Value:boolean);
  2090. var arr:THashExists;
  2091. begin
  2092.  arr:=THashExists(GetChildHash(MainIndex));
  2093.  if arr=nil then begin
  2094.   arr:=THashExists.Create;
  2095.   MainListIndex.AddValue(MainIndex);
  2096.   MainListValue.AddValue(arr);
  2097.  end;
  2098.  arr[Index]:=Value;
  2099. end;
  2100.  
  2101. function THash2Exists.GetValue(MainIndex,Index:integer):boolean;
  2102. var arr:THashExists;
  2103. begin
  2104.  Result:=False;
  2105.  arr:=THashExists(GetChildHash(MainIndex));
  2106.  if arr=nil then exit;
  2107.  Result:=arr[Index];
  2108. end;
  2109.  
  2110. function THash2Exists.CreateMainHash(MainIndex:integer):THashExists;
  2111. var Co:integer;
  2112.     n:integer;
  2113.     arr:THashExists;
  2114. begin
  2115.  Result:=nil;
  2116.  n:=MainListIndex.IndexOf(MainIndex);
  2117.  if n=-1 then exit;
  2118.  Result:=THashExists.Create;
  2119.  arr:=MainListValue[n];
  2120.  Co:=arr.Count;
  2121.  if Co>0 then begin
  2122.   Result.FAIndex.SetCapacity(Co);
  2123.   Result.FAIndex.FCount:=Co;
  2124.   memcpy(arr.FAIndex.FValues,Result.FAIndex.FValues,Co*Result.FAIndex.FItemSize);
  2125.  end else begin
  2126.   Result.Free;
  2127.   Result:=nil;
  2128.  end;
  2129. end;
  2130.  
  2131. function THash2Exists.CreateHash(Index:integer):THashExists;
  2132. var i:integer;
  2133. begin
  2134.  Result:=THashExists.Create;
  2135.  for i:=0 to MainListIndex.Count-1 do begin
  2136.   if THashExists(MainListValue[i])[Index] then Result.FAIndex.AddValue(MainListIndex[i]);
  2137.  end;
  2138.  if Result.Count=0 then begin
  2139.   Result.Free;
  2140.   Result:=nil;
  2141.  end;
  2142. end;
  2143.  
  2144.  { THash2Currency }
  2145.  
  2146. procedure THash2Currency.Clear;
  2147. var i:integer;
  2148. begin
  2149.  for i:=0 to MainListValue.Count-1 do begin
  2150.   THashCurrency(MainListValue[i]).Free;
  2151.  end;
  2152.  MainListValue.Clear;
  2153.  MainListIndex.Clear;
  2154. end;
  2155.  
  2156. procedure THash2Currency.SetValue(MainIndex,Index:integer;Value:Currency);
  2157. var arr:THashCurrency;
  2158. begin
  2159.  arr:=THashCurrency(GetChildHash(MainIndex));
  2160.  if arr=nil then begin
  2161.   arr:=THashCurrency.Create;
  2162.   MainListIndex.AddValue(MainIndex);
  2163.   MainListValue.AddValue(arr);
  2164.  end;
  2165.  arr[Index]:=Value;
  2166. end;
  2167.  
  2168. procedure THash2Currency.Inc(MainIndex,Index:integer;Value:Currency);
  2169. var c: currency;
  2170. begin
  2171.  c:=GetValue(MainIndex,Index);
  2172.  SetValue(MainIndex,Index,Value+c);
  2173. end;
  2174.  
  2175. function THash2Currency.GetValue(MainIndex,Index:integer):Currency;
  2176. var arr:THashCurrency;
  2177. begin
  2178.  Result:=0;
  2179.  arr:=THashCurrency(GetChildHash(MainIndex));
  2180.  if arr=nil then exit;
  2181.  Result:=arr[Index];
  2182. end;
  2183.  
  2184. function THash2Currency.CreateMainHash(MainIndex:integer):THashCurrency;
  2185. var arr:THashCurrency;
  2186.     Co:integer;
  2187.     n:integer;
  2188. begin
  2189.  Result:=nil;
  2190.  n:=MainListIndex.IndexOf(MainIndex);
  2191.  if n=-1 then exit;
  2192.  Result:=THashCurrency.Create;
  2193.  arr:=MainListValue[n];
  2194.  Co:=arr.Count;
  2195.  if Co>0 then begin
  2196.   Result.FAIndex.SetCapacity(Co);
  2197.   Result.FAIndex.FCount:=Co;
  2198.   Result.FAValues.SetCapacity(Co);
  2199.   Result.FAValues.FCount:=Co;
  2200.   memcpy(arr.FAIndex.FValues,Result.FAIndex.FValues,Co*Result.FAIndex.FItemSize);
  2201.   memcpy(arr.FAValues.FValues,Result.FAValues.FValues,Co*Result.FAValues.FItemSize);
  2202.  end else begin
  2203.   Result.Free;
  2204.   Result:=nil;
  2205.  end;
  2206. end;
  2207.  
  2208. function THash2Currency.CreateHash(Index:integer):THashCurrency;
  2209. var i:integer;
  2210. begin
  2211.  Result:=THashCurrency.Create;
  2212.  for i:=0 to MainListIndex.Count-1 do begin
  2213.   if THashCurrency(MainListValue[i]).FAIndex.IndexOf(Index)<>-1 then begin
  2214.    Result.FAIndex.AddValue(i);
  2215.    Result.FAValues.AddValue(THashCurrency(MainListValue[i])[Index]);
  2216.   end;
  2217.  end;
  2218.  if Result.Count=0 then begin
  2219.   Result.Free;
  2220.   Result:=nil;
  2221.  end;
  2222. end;
  2223.  
  2224.  { THash2Integer }
  2225.  
  2226. procedure THash2Integer.Clear;
  2227. var i:integer;
  2228. begin
  2229.  for i:=0 to MainListValue.Count-1 do begin
  2230.   THashInteger(MainListValue[i]).Free;
  2231.  end;
  2232.  MainListValue.Clear;
  2233.  MainListIndex.Clear;
  2234. end;
  2235.  
  2236. procedure THash2Integer.SetValue(MainIndex,Index:integer;Value:Integer);
  2237. var arr:THashInteger;
  2238. begin
  2239.  arr:=THashInteger(GetChildHash(MainIndex));
  2240.  if arr=nil then begin
  2241.   arr:=THashInteger.Create;
  2242.   MainListIndex.AddValue(MainIndex);
  2243.   MainListValue.AddValue(arr);
  2244.  end;
  2245.  arr[Index]:=Value;
  2246. end;
  2247.  
  2248. function THash2Integer.GetValue(MainIndex,Index:integer):Integer;
  2249. var arr:THashInteger;
  2250. begin
  2251.  Result:=0;
  2252.  arr:=THashInteger(GetChildHash(MainIndex));
  2253.  if arr=nil then exit;
  2254.  Result:=arr[Index];
  2255. end;
  2256.  
  2257. function THash2Integer.CreateMainHash(MainIndex:integer):THashInteger;
  2258. var arr:THashInteger;
  2259.     Co:integer;
  2260.     n:integer;
  2261. begin
  2262.  Result:=nil;
  2263.  n:=MainListIndex.IndexOf(MainIndex);
  2264.  if n=-1 then exit;
  2265.  Result:=THashInteger.Create;
  2266.  arr:=MainListValue[n];
  2267.  Co:=arr.Count;
  2268.  if Co>0 then begin
  2269.   Result.FAIndex.SetCapacity(Co);
  2270.   Result.FAIndex.FCount:=Co;
  2271.   Result.FAValues.SetCapacity(Co);
  2272.   Result.FAValues.FCount:=Co;
  2273.   memcpy(arr.FAIndex.FValues,Result.FAIndex.FValues,Co*Result.FAIndex.FItemSize);
  2274.   memcpy(arr.FAValues.FValues,Result.FAValues.FValues,Co*Result.FAValues.FItemSize);
  2275.  end else begin
  2276.   Result.Free;
  2277.   Result:=nil;
  2278.  end;
  2279. end;
  2280.  
  2281. function THash2Integer.CreateHash(Index:integer):THashInteger;
  2282. var i:integer;
  2283. begin
  2284.  Result:=THashInteger.Create;
  2285.  for i:=0 to MainListIndex.Count-1 do begin
  2286.   if THashInteger(MainListValue[i]).FAIndex.IndexOf(Index)<>-1 then begin
  2287.    Result.FAIndex.AddValue(i);
  2288.    Result.FAValues.AddValue(THashInteger(MainListValue[i])[Index]);
  2289.   end;
  2290.  end;
  2291.  if Result.Count=0 then begin
  2292.   Result.Free;
  2293.   Result:=nil;
  2294.  end;
  2295. end;
  2296.  
  2297.  { THash2String }
  2298.  
  2299. procedure THash2String.Clear;
  2300. var i:integer;
  2301. begin
  2302.  for i:=0 to MainListValue.Count-1 do begin
  2303.   THashString(MainListValue[i]).Free;
  2304.  end;
  2305.  MainListValue.Clear;
  2306.  MainListIndex.Clear;
  2307. end;
  2308.  
  2309. procedure THash2String.SetValue(MainIndex,Index:integer;Value:String);
  2310. var arr:THashString;
  2311. begin
  2312.  arr:=THashString(GetChildHash(MainIndex));
  2313.  if arr=nil then begin
  2314.   arr:=THashString.Create;
  2315.   MainListIndex.AddValue(MainIndex);
  2316.   MainListValue.AddValue(arr);
  2317.  end;
  2318.  arr[Index]:=Value;
  2319. end;
  2320.  
  2321. function THash2String.GetValue(MainIndex,Index:integer):String;
  2322. var arr:THashString;
  2323. begin
  2324.  Result:='';
  2325.  arr:=THashString(GetChildHash(MainIndex));
  2326.  if arr=nil then exit;
  2327.  Result:=arr[Index];
  2328. end;
  2329.  
  2330. function THash2String.CreateMainHash(MainIndex:integer):THashString;
  2331. var arr:THashString;
  2332.     Co:integer;
  2333.     n,i:integer;
  2334. begin
  2335.  Result:=nil;
  2336.  n:=MainListIndex.IndexOf(MainIndex);
  2337.  if n=-1 then exit;
  2338.  Result:=THashString.Create;
  2339.  arr:=MainListValue[n];
  2340.  Co:=arr.Count;
  2341.  if Co>0 then begin
  2342.   Result.FAIndex.SetCapacity(Co);
  2343.   for i:=0 to arr.Count-1 do begin
  2344.    Result[arr.Keys[i]]:=arr[arr.Keys[i]];
  2345.   end;
  2346.  end else begin
  2347.   Result.Free;
  2348.   Result:=nil;
  2349.  end;
  2350. end;
  2351.  
  2352. function THash2String.CreateHash(Index:integer):THashString;
  2353. var i:integer;
  2354. begin
  2355.  Result:=THashString.Create;
  2356.  for i:=0 to MainListIndex.Count-1 do begin
  2357.   if THashString(MainListValue[i]).FAIndex.IndexOf(Index)<>-1 then begin
  2358.    Result.FAIndex.AddValue(i);
  2359.    Result.FAValues.Add(THashString(MainListValue[i])[Index]);
  2360.   end;
  2361.  end;
  2362.  if Result.Count=0 then begin
  2363.   Result.Free;
  2364.   Result:=nil;
  2365.  end;
  2366. end;
  2367.  
  2368. end.
  2369.