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