Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit Hashes;
- {** Hash Library
- Original Author: Ciaran McCreesh <keesh@users.sf.net>
- Copyright: Copyright (c) 2002 Ciaran McCreesh
- Date: 20020621
- Purpose: A collection of hash components for Delphi. These are
- similar to arrays, but the index is a string. A hashing
- algorithm is used to provide extremely fast searching.
- Generic Moan: This would be a lot easier if Delphi had template
- classes. If anyone at Borland / Inprise / whatever
- you're calling yourselves this week reads this, let me
- know how much I have to bribe you.
- Changelog:
- v2.6 (20020621)
- * Framework for dynamic bucket sizes. No actual resizing yet.
- * Changed TStringHash, TIntegerHash and TObjectHash slightly, and fixed
- potential bugs in them.
- * General performance improvements
- * Changed how iterators work. In particular, multiple iterators are now
- possible. Thanks to Daniel Trinter for code and Emanuel for
- suggestions.
- + Previous method (goes with Next)
- + AllowCompact property
- v2.5 (20020606)
- * Empty hash keys explicitly forbidden. Thanks to Marco Vink for the
- notice.
- + Clear method
- v2.4 (20020603)
- * Fixed Compact bug. Thanks to Daniel Trinter for the notice. Basically
- I was assuming something about the size of one of the internal arrays
- which wasn't always true.
- v2.3 (20020601)
- + ItemCount property
- + Compact method
- * Hash auto-compacts itself if overly inefficient
- * ItemIndexes are now recycled
- v2.2 (20020529)
- * Fixed iterator bug. Not all items were called under some
- circumstances. Thanks to Tom Walker for the notice.
- v2.1 (20020528, internal release only)
- + TObjectHash
- v2.0 (20020526)
- * Complete rewrite
- + THash
- + TStringHash
- + TIntegerHash
- License:
- This library is Copyright (c) 2002 Ciaran McCreesh.
- Permission is granted to anyone to use this software for any purpose on
- any computer system, and to redistribute it freely, subject to the
- following restrictions:
- 1. This software is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- 2. The origin of this software must not be misrepresented.
- 3. Altered versions must be plainly marked as such, and must not be
- misrepresented as being the original software.
- Documentation:
- Please see:
- * http://www.opensourcepan.co.uk/libraries/hashes/
- * http://www.undu.com/articles/020604.html
- Other notes:
- This unit provides three hashes, TIntegerHash, TStringHash and
- TObjectHash. If you want a more precise kind (eg TComponentHash), it's
- easiest to descend from THash and copy the TObjectHash code. Note that
- TObjectHash is slightly different from TIntegerHash and TStringHash
- because it has to free items -- it cannot just overwrite them.
- Internal data representation:
- Each hash object has an array (potentially dynamically sized, but this
- isn't used yet) of 'buckets' (dynamic arrays). Each bucket is mapped
- to a series of hash values (we take the high order bits of the value
- calculated), so that every possible hash value refers to exactly one
- bucket. This reduces the amount of searching that has to be done to
- find an item, so it's much faster than linear or B-Tree storage.
- Each bucket contains a series of integers. These are indexes into an
- items array, which for type reasons is maintained by the descendant
- classes. These are recycled when the hash detects that it is becoming
- inefficient.
- }
- interface
- uses SysUtils;
- const
- {** This constant controls the initial size of the hash. }
- c_HashInitialItemShift = 7;
- {** How inefficient do we have to be before we automatically Compact? }
- c_HashCompactR = 2; { This many spaces per item. }
- c_HashCompactM = 100; { Never for less than this number of spaces. }
- type
- {** General exception classes. }
- EHashError = class(Exception);
- { EHashErrorClass = class of EHashError;}
- {** Exception for when an item is not found. }
- EHashFindError = class(EHashError);
- {** Exception for invalid Next op. }
- EHashIterateError = class(EHashError);
- {** Exception for invalid keys. }
- EHashInvalidKeyError = class(EHashError);
- {** Record, should really be private but OP won't let us... }
- THashRecord = record
- Hash: Cardinal;
- ItemIndex: integer;
- Key: string;
- end;
- {** Iterator Record. This should also be private. This makes me almost like
- the way Java does things. Almost. Maybe. }
- THashIterator = record
- ck, cx: integer;
- end;
- {** Base Hash class. Don't use this directly. }
- THash = class
- protected
- {** The keys. }
- f_Keys: array of array of THashRecord;
- {** Current bucket shift. }
- f_CurrentItemShift: integer;
- {** These are calculated from f_CurrentItemShift. }
- f_CurrentItemCount: integer;
- f_CurrentItemMask: integer;
- f_CurrentItemMaxIdx: integer;
- {** Spare items. }
- f_SpareItems: array of integer;
- {** Whether Next is allowed. }
- f_NextAllowed: boolean;
- {** Current key. }
- f_CurrentKey: string;
- {** Can we compact? }
- f_AllowCompact: boolean;
- {** Our current iterator. }
- f_CurrentIterator: THashIterator;
- {** Update the masks. }
- procedure FUpdateMasks;
- {** Update the buckets. }
- procedure FUpdateBuckets;
- {** Find a key's location. }
- function FFindKey(const Key: string; var k, x: integer): boolean;
- {** Add a new key, or change an existing one. Don't call this directly. }
- procedure FSetOrAddKey(const Key: string; ItemIndex: integer);
- {** Abstract method, delete value with a given index. Override this. }
- procedure FDeleteIndex(i: integer); virtual; abstract;
- {** Get the number of items. }
- function FGetItemCount: integer;
- {** Allocate an item index. }
- function FAllocItemIndex: integer;
- {** Abstract method, move an item with index OldIndex to NewIndex.
- Override this. }
- procedure FMoveIndex(oldIndex, newIndex: integer); virtual; abstract;
- {** Abstract method, trim the indexes down to count items. Override
- this. }
- procedure FTrimIndexes(count: integer); virtual; abstract;
- {** Abstract method, clear all items. Override this. }
- procedure FClearItems; virtual; abstract;
- {** Tell us where to start our compact count from. Override this. }
- function FIndexMax: integer; virtual; abstract;
- {** Compact, but only if we're inefficient. }
- procedure FAutoCompact;
- public
- {** Our own constructor. }
- constructor Create; reintroduce; virtual;
- {** Does a key exist? }
- function Exists(const Key: string): boolean;
- {** Rename a key. }
- procedure Rename(const Key, NewName: string);
- {** Delete a key. }
- procedure Delete(const Key: string);
- {** Reset iterator. }
- procedure Restart;
- {** Next key. }
- function Next: boolean;
- {** Previous key. }
- function Previous: boolean;
- {** Current key. }
- function CurrentKey: string;
- {** The number of items. }
- property ItemCount: integer read FGetItemCount;
- {** Compact the hash. }
- procedure Compact;
- {** Clear the hash. }
- procedure Clear;
- {** Allow compacting? }
- property AllowCompact: boolean read f_AllowCompact write f_AllowCompact;
- {** Current iterator. }
- property CurrentIterator: THashIterator read f_CurrentIterator write
- f_CurrentIterator;
- {** Create a new iterator. }
- function NewIterator: THashIterator;
- end;
- {** Hash of strings. }
- TStringHash = class(THash)
- protected
- {** The index items. }
- f_Items: array of string;
- {** Override FDeleteIndex abstract method. }
- procedure FDeleteIndex(i: integer); override;
- {** Get an item or raise an exception. }
- function FGetItem(const Key: string): string;
- {** Set or add an item. }
- procedure FSetItem(const Key, Value: string);
- {** Move an index. }
- procedure FMoveIndex(oldIndex, newIndex: integer); override;
- {** Trim. }
- procedure FTrimIndexes(count: integer); override;
- {** Clear all items. }
- procedure FClearItems; override;
- {** Where to start our compact count from. }
- function FIndexMax: integer; override;
- public
- {** Items property. }
- property Items[const Key: string]: string read FGetItem
- write FSetItem; default;
- end;
- {** Hash of integers. }
- TIntegerHash = class(THash)
- protected
- {** The index items. }
- f_Items: array of integer;
- {** Override FDeleteIndex abstract method. }
- procedure FDeleteIndex(i: integer); override;
- {** Get an item or raise an exception. }
- function FGetItem(const Key: string): integer;
- {** Set or add an item. }
- procedure FSetItem(const Key: string; Value: integer);
- {** Move an index. }
- procedure FMoveIndex(oldIndex, newIndex: integer); override;
- {** Trim. }
- procedure FTrimIndexes(count: integer); override;
- {** Clear all items. }
- procedure FClearItems; override;
- {** Where to start our compact count from. }
- function FIndexMax: integer; override;
- public
- {** Items property. }
- property Items[const Key: string]: integer read FGetItem
- write FSetItem; default;
- end;
- {** Hash of objects. }
- TObjectHash = class(THash)
- protected
- {** The index items. }
- f_Items: array of TObject;
- {** Override FDeleteIndex abstract method. }
- procedure FDeleteIndex(i: integer); override;
- {** Get an item or raise an exception. }
- function FGetItem(const Key: string): TObject;
- {** Set or add an item. }
- procedure FSetItem(const Key: string; Value: TObject);
- {** Move an index. }
- procedure FMoveIndex(oldIndex, newIndex: integer); override;
- {** Trim. }
- procedure FTrimIndexes(count: integer); override;
- {** Clear all items. }
- procedure FClearItems; override;
- {** Where to start our compact count from. }
- function FIndexMax: integer; override;
- public
- {** Items property. }
- property Items[const Key: string]: TObject read FGetItem
- write FSetItem; default;
- {** Destructor must destroy all items. }
- destructor Destroy; override;
- end;
- implementation
- {** A basic hash function. This is pretty fast, and fairly good general
- purpose, but you may want to swap in a specialised version. }
- function HashThis(const s: string): cardinal;
- var
- h, g, i: cardinal;
- begin
- if (s = '') then
- raise EHashInvalidKeyError.Create('Key cannot be an empty string');
- h := $12345670;
- for i := 1 to Length(s) do begin
- h := (h shl 4) + ord(s[i]);
- g := h and $f0000000;
- if (g > 0) then
- h := h or (g shr 24) or g;
- end;
- result := h;
- end;
- { THash }
- constructor THash.Create;
- begin
- inherited Create;
- self.f_CurrentIterator.ck := -1;
- self.f_CurrentIterator.cx := 0;
- self.f_CurrentItemShift := c_HashInitialItemShift;
- self.FUpdateMasks;
- self.FUpdateBuckets;
- self.f_AllowCompact := true;
- end;
- procedure THash.Delete(const Key: string);
- var
- k, x, i: integer;
- begin
- { Hash has been modified, so disallow Next. }
- self.f_NextAllowed := false;
- if (self.FFindKey(Key, k, x)) then begin
- { Delete the Index entry. }
- i := self.f_Keys[k][x].ItemIndex;
- self.FDeleteIndex(i);
- { Add the index to the Spares list. }
- SetLength(self.f_SpareItems, Length(self.f_SpareItems) + 1);
- self.f_SpareItems[High(self.f_SpareItems)] := i;
- { Overwrite key with the last in the list. }
- self.f_Keys[k][x] := self.f_Keys[k][High(self.f_Keys[k])];
- { Delete the last in the list. }
- SetLength(self.f_Keys[k], Length(self.f_Keys[k]) - 1);
- end else
- raise EHashFindError.CreateFmt('Key "%s" not found', [Key]);
- self.FAutoCompact;
- end;
- function THash.Exists(const Key: string): boolean;
- var
- dummy1, dummy2: integer;
- begin
- result := FFindKey(Key, dummy1, dummy2);
- end;
- procedure THash.FSetOrAddKey(const Key: string; ItemIndex: integer);
- var
- k, x, i: integer;
- begin
- { Exists already? }
- if (self.FFindKey(Key, k, x)) then begin
- { Yep. Delete the old stuff and set the new value. }
- i := self.f_Keys[k][x].ItemIndex;
- self.FDeleteIndex(i);
- self.f_Keys[k][x].ItemIndex := ItemIndex;
- { Add the index to the spares list. }
- SetLength(self.f_SpareItems, Length(self.f_SpareItems) + 1);
- self.f_SpareItems[High(self.f_SpareItems)] := i;
- end else begin
- { No, create a new one. }
- SetLength(self.f_Keys[k], Length(self.f_Keys[k]) + 1);
- self.f_Keys[k][High(self.f_Keys[k])].Key := Key;
- self.f_Keys[k][High(self.f_Keys[k])].ItemIndex := ItemIndex;
- self.f_Keys[k][High(self.f_Keys[k])].Hash := HashThis(Key);
- end;
- end;
- function THash.FFindKey(const Key: string; var k, x: integer): boolean;
- var
- i: integer;
- h: cardinal;
- begin
- { Which bucket? }
- h := HashThis(Key);
- k := h and f_CurrentItemMask;
- result := false;
- { Look for it. }
- for i := 0 to High(self.f_Keys[k]) do
- if (self.f_Keys[k][i].Hash = h) or true then
- if (self.f_Keys[k][i].Key = Key) then begin
- { Found it! }
- result := true;
- x := i;
- break;
- end;
- end;
- procedure THash.Rename(const Key, NewName: string);
- var
- k, x, i: integer;
- begin
- { Hash has been modified, so disallow Next. }
- self.f_NextAllowed := false;
- if (self.FFindKey(Key, k, x)) then begin
- { Remember the ItemIndex. }
- i := self.f_Keys[k][x].ItemIndex;
- { Overwrite key with the last in the list. }
- self.f_Keys[k][x] := self.f_Keys[k][High(self.f_Keys[k])];
- { Delete the last in the list. }
- SetLength(self.f_Keys[k], Length(self.f_Keys[k]) - 1);
- { Create the new item. }
- self.FSetOrAddKey(NewName, i);
- end else
- raise EHashFindError.CreateFmt('Key "%s" not found', [Key]);
- self.FAutoCompact;
- end;
- function THash.CurrentKey: string;
- begin
- if (not (self.f_NextAllowed)) then
- raise EHashIterateError.Create('Cannot find CurrentKey as the hash has '
- + 'been modified since Restart was called')
- else if (self.f_CurrentKey = '') then
- raise EHashIterateError.Create('Cannot find CurrentKey as Next has not yet '
- + 'been called after Restart')
- else
- result := self.f_CurrentKey;
- end;
- function THash.Next: boolean;
- begin
- if (not (self.f_NextAllowed)) then
- raise EHashIterateError.Create('Cannot get Next as the hash has '
- + 'been modified since Restart was called');
- result := false;
- if (self.f_CurrentIterator.ck = -1) then begin
- self.f_CurrentIterator.ck := 0;
- self.f_CurrentIterator.cx := 0;
- end;
- while ((not result) and (self.f_CurrentIterator.ck <= f_CurrentItemMaxIdx)) do begin
- if (self.f_CurrentIterator.cx < Length(self.f_Keys[self.f_CurrentIterator.ck])) then begin
- result := true;
- self.f_CurrentKey := self.f_Keys[self.f_CurrentIterator.ck][self.f_CurrentIterator.cx].Key;
- inc(self.f_CurrentIterator.cx);
- end else begin
- inc(self.f_CurrentIterator.ck);
- self.f_CurrentIterator.cx := 0;
- end;
- end;
- end;
- procedure THash.Restart;
- begin
- self.f_CurrentIterator.ck := -1;
- self.f_CurrentIterator.cx := 0;
- self.f_NextAllowed := true;
- end;
- function THash.FGetItemCount: integer;
- var
- i: integer;
- begin
- { Calculate our item count. }
- result := 0;
- for i := 0 to f_CurrentItemMaxIdx do
- inc(result, Length(self.f_Keys[i]));
- end;
- function THash.FAllocItemIndex: integer;
- begin
- if (Length(self.f_SpareItems) > 0) then begin
- { Use the top SpareItem. }
- result := self.f_SpareItems[High(self.f_SpareItems)];
- SetLength(self.f_SpareItems, Length(self.f_SpareItems) - 1);
- end else begin
- result := self.FIndexMax + 1;
- end;
- end;
- procedure THash.Compact;
- var
- aSpaces: array of boolean;
- aMapping: array of integer;
- i, j: integer;
- begin
- { Find out where the gaps are. We could do this by sorting, but that's at
- least O(n log n), and sometimes O(n^2), so we'll go for the O(n) method,
- even though it involves multiple passes. Note that this is a lot faster
- than it looks. Disabling this saves about 3% in my benchmarks, but uses a
- lot more memory. }
- if (self.AllowCompact) then begin
- SetLength(aSpaces, self.FIndexMax + 1);
- SetLength(aMapping, self.FIndexMax + 1);
- for i := 0 to High(aSpaces) do
- aSpaces[i] := false;
- for i := 0 to High(aMapping) do
- aMapping[i] := i;
- for i := 0 to High(self.f_SpareItems) do
- aSpaces[self.f_SpareItems[i]] := true;
- { Starting at the low indexes, fill empty ones from the high indexes. }
- i := 0;
- j := self.FIndexMax;
- while (i < j) do begin
- if (aSpaces[i]) then begin
- while ((i < j) and (aSpaces[j])) do
- dec(j);
- if (i < j) then begin
- aSpaces[i] := false;
- aSpaces[j] := true;
- self.FMoveIndex(j, i);
- aMapping[j] := i
- end;
- end else
- inc(i);
- end;
- j := self.FIndexMax;
- while (aSpaces[j]) do
- dec(j);
- { Trim the items array down to size. }
- self.FTrimIndexes(j + 1);
- { Clear the spaces. }
- SetLength(self.f_SpareItems, 0);
- { Update our buckets. }
- for i := 0 to f_CurrentItemMaxIdx do
- for j := 0 to High(self.f_Keys[i]) do
- self.f_Keys[i][j].ItemIndex := aMapping[self.f_Keys[i][j].ItemIndex];
- end;
- end;
- procedure THash.FAutoCompact;
- begin
- if (self.AllowCompact) then
- if (Length(self.f_SpareItems) >= c_HashCompactM) then
- if (self.FIndexMax * c_HashCompactR > Length(self.f_SpareItems)) then
- self.Compact;
- end;
- procedure THash.Clear;
- var
- i: integer;
- begin
- self.FClearItems;
- SetLength(self.f_SpareItems, 0);
- for i := 0 to f_CurrentItemMaxIdx do
- SetLength(self.f_Keys[i], 0);
- end;
- procedure THash.FUpdateMasks;
- begin
- f_CurrentItemMask := (1 shl f_CurrentItemShift) - 1;
- f_CurrentItemMaxIdx := (1 shl f_CurrentItemShift) - 1;
- f_CurrentItemCount := (1 shl f_CurrentItemShift);
- end;
- procedure THash.FUpdateBuckets;
- begin
- { This is just a temporary thing. }
- SetLength(self.f_Keys, self.f_CurrentItemCount);
- end;
- function THash.NewIterator: THashIterator;
- begin
- result.ck := -1;
- result.cx := 0;
- end;
- function THash.Previous: boolean;
- begin
- if (not (self.f_NextAllowed)) then
- raise EHashIterateError.Create('Cannot get Next as the hash has '
- + 'been modified since Restart was called');
- result := false;
- if (self.f_CurrentIterator.ck >= 0) then begin
- while ((not result) and (self.f_CurrentIterator.ck >= 0)) do begin
- dec(self.f_CurrentIterator.cx);
- if (self.f_CurrentIterator.cx >= 0) then begin
- result := true;
- self.f_CurrentKey := self.f_Keys[self.f_CurrentIterator.ck][self.f_CurrentIterator.cx].Key;
- end else begin
- dec(self.f_CurrentIterator.ck);
- if (self.f_CurrentIterator.ck >= 0) then
- self.f_CurrentIterator.cx := Length(self.f_Keys[self.f_CurrentIterator.ck]);
- end;
- end;
- end;
- end;
- { TStringHash }
- procedure TStringHash.FDeleteIndex(i: integer);
- begin
- self.f_Items[i] := '';
- end;
- function TStringHash.FGetItem(const Key: string): string;
- var
- k, x: integer;
- begin
- if (self.FFindKey(Key, k, x)) then
- result := self.f_Items[self.f_Keys[k][x].ItemIndex]
- else
- raise EHashFindError.CreateFmt('Key "%s" not found', [Key]);
- end;
- procedure TStringHash.FMoveIndex(oldIndex, newIndex: integer);
- begin
- self.f_Items[newIndex] := self.f_Items[oldIndex];
- end;
- procedure TStringHash.FSetItem(const Key, Value: string);
- var
- k, x, i: integer;
- begin
- if (self.FFindKey(Key, k, x)) then
- self.f_Items[self.f_Keys[k][x].ItemIndex] := Value
- else begin
- { New index entry, or recycle an old one. }
- i := self.FAllocItemIndex;
- if (i > High(self.f_Items)) then
- SetLength(self.f_Items, i + 1);
- self.f_Items[i] := Value;
- { Add it to the hash. }
- SetLength(self.f_Keys[k], Length(self.f_Keys[k]) + 1);
- self.f_Keys[k][High(self.f_Keys[k])].Key := Key;
- self.f_Keys[k][High(self.f_Keys[k])].ItemIndex := i;
- self.f_Keys[k][High(self.f_Keys[k])].Hash := HashThis(Key);
- { Hash has been modified, so disallow Next. }
- self.f_NextAllowed := false;
- end;
- end;
- function TStringHash.FIndexMax: integer;
- begin
- result := High(self.f_Items);
- end;
- procedure TStringHash.FTrimIndexes(count: integer);
- begin
- SetLength(self.f_Items, count);
- end;
- procedure TStringHash.FClearItems;
- begin
- SetLength(self.f_Items, 0);
- end;
- { TIntegerHash }
- procedure TIntegerHash.FDeleteIndex(i: integer);
- begin
- self.f_Items[i] := 0;
- end;
- function TIntegerHash.FGetItem(const Key: string): integer;
- var
- k, x: integer;
- begin
- if (self.FFindKey(Key, k, x)) then
- result := self.f_Items[self.f_Keys[k][x].ItemIndex]
- else
- raise EHashFindError.CreateFmt('Key "%s" not found', [Key]);
- end;
- procedure TIntegerHash.FMoveIndex(oldIndex, newIndex: integer);
- begin
- self.f_Items[newIndex] := self.f_Items[oldIndex];
- end;
- procedure TIntegerHash.FSetItem(const Key: string; Value: integer);
- var
- k, x, i: integer;
- begin
- if (self.FFindKey(Key, k, x)) then
- self.f_Items[self.f_Keys[k][x].ItemIndex] := Value
- else begin
- { New index entry, or recycle an old one. }
- i := self.FAllocItemIndex;
- if (i > High(self.f_Items)) then
- SetLength(self.f_Items, i + 1);
- self.f_Items[i] := Value;
- { Add it to the hash. }
- SetLength(self.f_Keys[k], Length(self.f_Keys[k]) + 1);
- self.f_Keys[k][High(self.f_Keys[k])].Key := Key;
- self.f_Keys[k][High(self.f_Keys[k])].ItemIndex := i;
- self.f_Keys[k][High(self.f_Keys[k])].Hash := HashThis(Key);
- { Hash has been modified, so disallow Next. }
- self.f_NextAllowed := false;
- end;
- end;
- function TIntegerHash.FIndexMax: integer;
- begin
- result := High(self.f_Items);
- end;
- procedure TIntegerHash.FTrimIndexes(count: integer);
- begin
- SetLength(self.f_Items, count);
- end;
- procedure TIntegerHash.FClearItems;
- begin
- SetLength(self.f_Items, 0);
- end;
- { TObjectHash }
- procedure TObjectHash.FDeleteIndex(i: integer);
- begin
- self.f_Items[i].Free;
- self.f_Items[i] := nil;
- end;
- function TObjectHash.FGetItem(const Key: string): TObject;
- var
- k, x: integer;
- begin
- if (self.FFindKey(Key, k, x)) then
- result := self.f_Items[self.f_Keys[k][x].ItemIndex]
- else
- raise EHashFindError.CreateFmt('Key "%s" not found', [Key]);
- end;
- procedure TObjectHash.FMoveIndex(oldIndex, newIndex: integer);
- begin
- self.f_Items[newIndex] := self.f_Items[oldIndex];
- end;
- procedure TObjectHash.FSetItem(const Key: string; Value: TObject);
- var
- k, x, i: integer;
- begin
- if (self.FFindKey(Key, k, x)) then begin
- self.f_Items[self.f_Keys[k][x].ItemIndex].Free;
- self.f_Items[self.f_Keys[k][x].ItemIndex] := Value;
- end else begin
- { New index entry, or recycle an old one. }
- i := self.FAllocItemIndex;
- if (i > High(self.f_Items)) then
- SetLength(self.f_Items, i + 1);
- self.f_Items[i] := Value;
- { Add it to the hash. }
- SetLength(self.f_Keys[k], Length(self.f_Keys[k]) + 1);
- self.f_Keys[k][High(self.f_Keys[k])].Key := Key;
- self.f_Keys[k][High(self.f_Keys[k])].ItemIndex := i;
- self.f_Keys[k][High(self.f_Keys[k])].Hash := HashThis(Key);
- { Hash has been modified, so disallow Next. }
- self.f_NextAllowed := false;
- end;
- end;
- function TObjectHash.FIndexMax: integer;
- begin
- result := High(self.f_Items);
- end;
- procedure TObjectHash.FTrimIndexes(count: integer);
- begin
- SetLength(self.f_Items, count);
- end;
- procedure TObjectHash.FClearItems;
- var
- i: integer;
- begin
- for i := 0 to High(self.f_Items) do
- if (Assigned(self.f_Items[i])) then
- self.f_Items[i].Free;
- SetLength(self.f_Items, 0);
- end;
- destructor TObjectHash.Destroy;
- var
- i: integer;
- begin
- for i := 0 to High(self.f_Items) do
- if (Assigned(self.f_Items[i])) then
- self.f_Items[i].Free;
- inherited;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement