Well, I would agree that the tree is slow, but it IS NOT 2 minutes slow for this many items. The code you have is extremely ineffecient, and hopefully you will take a few pointers from the code I am posting below. Please note, it is not a drop in replacement for what you have, but you should only have to tweak it slightly to make it work for you.
Key points:
- Drop the group by from your sql statement. Just get all the records (for both queries). You have to walk them all anyways to figure out which ones have parents or not.
- You should hash the GroupID/TreeNode pairs so you don't have to enumerate the tree items to look up records. This will also save you from having to run the second query more than once.
- Load all the items from the second query. It is extremely slow to keep re-querying the system. My code has the final end result as yours, but I just walk all the records from the second query, and use their ID to lookup the treenode from the hash.
End result on my system (600 records in table1, 9000 records in table2, being serviced from an MS Access database) was a time of appx 3 seconds.
Hope this helps.
Russell
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Db, ADODB, ComCtrls, HashUtils;
type
PDataRec1 = ^TDataRec1;
TDataRec1 = packed record
ID: Integer;
PID: Integer;
Name: Array [0..255] of Char;
end;
type
PDataRec2 = ^TDataRec2;
TDataRec2 = packed record
ID: Integer;
Code: Array [0..255] of Char;
Name: Array [0..255] of Char;
end;
type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
qryTable1: TADOQuery;
qryTable2: TADOQuery;
Button1: TButton;
TreeView1: TTreeView;
procedure Button1Click(Sender: TObject);
private
// Private declarations
public
// Public declarations
end;
// Query strings
const
qrySql1 = 'Select * from table1';
qrySql2 = 'Select * from table2';
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender
var listCache1: TList;
hashNodes: TIntHash;
listCache2: TList;
lpData1: PDataRec1;
lpData2: PDataRec2;
lpNode: PHashNode;
tvNode: TTreeNode;
dwMark: LongWord;
dwIndex: Integer;
begin
// Mark time
dwMark:=GetTickCount;
// Lock the tree
TreeView1.Items.BeginUpdat
// Resource protection
try
// Clear items
TreeView1.Items.Clear;
// Create cache
listCache1:=TList.Create;
listCache2:=TList.Create;
hashNodes:=TIntHash.Create
// Resource protection
try
// Open the first query
qryTable1.Close;
qryTable1.SQL.Text:=qrySql
qryTable1.Open;
// Load the cache for the first query
while not(qryTable1.EOF) do
begin
// Allocate record
lpData1:=AllocMem(SizeOf(T
// Fill record
lpData1^.ID:=qryTable1.Fie
lpData1^.PID:=qryTable1.Fi
StrPLCopy(@lpData1^.Name, qryTable1.Fields[2].AsStri
// Add to cache
listCache1.Add(lpData1);
// Move next
qryTable1.Next;
end;
// Open the second query
qryTable2.Close;
qryTable2.SQL.Text:=qrySql
qryTable2.Open;
// Load the cache for the second query
while not(qryTable2.EOF) do
begin
// Allocate record
lpData2:=AllocMem(SizeOf(T
// Fill record
lpData2^.ID:=qryTable2.Fie
StrPLCopy(@lpData2^.Code, qryTable2.Fields[1].AsStri
StrPLCopy(@lpData2^.Name, qryTable2.Fields[2].AsStri
// Add to cache
listCache2.Add(lpData2);
// Move next
qryTable2.Next;
end;
// Walk the first cache and add all top level parents first
for dwIndex:=0 to Pred(listCache1.Count) do
begin
// Get the item
lpData1:=listCache1[dwInde
// Check parent id
if (lpData1^.PID = 0) then
begin
// Add item to the tree
tvNode:=TreeView1.Items.Ad
// Set data to ID
tvNode.Data:=Pointer(lpDat
// Hash the ID and tree node
hashNodes.Add(lpData1^.ID)
end;
end;
// Walk the first cache and add parented items
for dwIndex:=0 to Pred(listCache1.Count) do
begin
// Get the item
lpData1:=listCache1[dwInde
// Check parent id
if (lpData1^.PID <> 0) then
begin
// Lookup the node
lpNode:=hashNodes.Find(lpD
// Did we find it?
if Assigned(lpNode) then
tvNode:=TTreeNode(lpNode^.
else
tvNode:=nil;
// Add child item to the tree
tvNode:=TreeView1.Items.Ad
// Set data to ID
tvNode.Data:=Pointer(lpDat
// Hash the ID and tree node
hashNodes.Add(lpData1^.ID)
end;
end;
// Walk the second data cache
for dwIndex:=0 to Pred(listCache2.Count) do
begin
// Get the item
lpData2:=listCache2[dwInde
// Lookup the node
lpNode:=hashNodes.Find(lpD
// Did we find it?
if Assigned(lpNode) then
tvNode:=TTreeNode(lpNode^.
else
tvNode:=nil;
// Add child item to the tree
TreeView1.Items.AddChild(t
end;
// Free cached data items
for dwIndex:=Pred(listCache1.C
for dwIndex:=Pred(listCache2.C
finally
// Free cache
listCache1.Free;
listCache2.Free;
hashNodes.Free;
end;
finally
// Unlock the tree
TreeView1.Items.EndUpdate;
end;
// End mark time
dwMark:=GetTickCount - dwMark;
// Display time
ShowMessage(Format('Routin
end;
end.
--- Source for HashUtils ---
unit HashUtils;
//////////////////////////
//
// Unit : HashUtils
// Author : rllibby
// Date : 05.29.2007
// Description : Set of extendable hash classes for Delphi. When deriving
// hash classes from the TBaseHash class, it is expected that
// the developer will override AllocNode and FreeNode, in
// order to perform any special handling that is desired. For
// reference, please see the TStrHash and TIntHash classes.
// Classes :
//
// TBaseHash - Base class from which specific hash implementations
// should be derived
// TListHash - Extension of TBaseHash that offers indexed access to the
// hash node elements
// TIntHash - Extension of TBaseHash for Integer based key values
// TStrHash - Extension of TBaseHash for PChar based key values
// TNameIDHash - Extension of TBaseHash for storing String keys with
// Integer data values
// TNameIDHash2 - Extension of TNameIDHash that allows for bi-directional
// item locating (using either ID or Name)
// TNameValueHash - Extension of TBaseHash for storing String keys with
// String data values
//
//////////////////////////
interface
//////////////////////////
// Include units
//////////////////////////
uses
Windows, SysUtils, Classes;
//////////////////////////
// Data types
//////////////////////////
type
PHashNode = ^THashNode;
THashNode = packed record
Key: Pointer;
KeySize: Cardinal;
Data: Pointer;
NextNode: PHashNode;
end;
type
PHashNodeArray = ^THashNodeArray;
THashNodeArray = Array [0..Pred(MaxInt shr 2)] of PHashNode;
type
PByteMapping = ^TByteMapping;
TByteMapping = Array [0..255] of Byte;
type
THashStat = packed record
NodeCount: Integer;
EmptyBuckets: Integer;
AvgDepth: Integer;
Depths: Array [0..15] of Integer;
OverDepth16: Integer;
end;
//////////////////////////
// Function prototypes
//////////////////////////
type
THashEnumerate = function(Sender: TObject; HashNode: PHashNode; Extra: Integer): Boolean of object;
//////////////////////////
// Constants
//////////////////////////
const
HASH_PRIMES: Array [0..18] of LongWord =
(
$0000000D, $0000001D, $00000035, $00000061,
$000000C1, $00000185, $00000301, $00000607,
$00000C07, $00001807, $00003001, $00006001,
$0000C005, $0001800D, $00030005, $00060019,
$000C0001, $00180005, $0030000B
);
//////////////////////////
// TBaseHash
//////////////////////////
type
TBaseHash = class(TObject)
private
// Private declarations
FNodeArray: PHashNodeArray;
FByteMapping: PByteMapping;
FCount: Integer;
FBuckets: LongWord;
function Compare(HashNode: PHashNode; Key: Pointer; KeySize: Cardinal): Boolean;
protected
// Protected declarations
function Add(Key: Pointer; KeySize: Cardinal): PHashNode;
function AddEx(Key: Pointer; KeySize: Cardinal; out Existed: Boolean): PHashNode;
function AllocNode(Key: Pointer; KeySize: Cardinal): PHashNode; virtual;
function Delete(Key: Pointer; KeySize: Cardinal): Boolean;
function Find(Key: Pointer; KeySize: Cardinal): PHashNode;
procedure FreeNode(HashNode: PHashNode); virtual;
function GetBucket(Key: Pointer; KeySize: Cardinal): LongWord; virtual;
function GetCount: Integer; virtual;
function GetDepth: Integer;
public
// Public declarations
constructor Create(BucketCount: LongWord; ByteMapping: PByteMapping = nil);
destructor Destroy; override;
procedure Clear; virtual;
procedure Enumerate(EnumCallback: THashEnumerate; Extra: Integer);
function GetItemList(List: TList): Integer;
procedure Stat(var HashStat: THashStat);
property BucketCount: LongWord read FBuckets;
property ByteMapping: PByteMapping read FByteMapping;
property Count: Integer read GetCount;
property Depth: Integer read GetDepth;
end;
//////////////////////////
// TListHash
//////////////////////////
type
TListHash = class(TBaseHash)
private
// Private declarations
FDestroying: Boolean;
FList: TList;
protected
// Protected declarations
function AllocNode(Key: Pointer; KeySize: Cardinal): PHashNode; override;
procedure FreeNode(HashNode: PHashNode); override;
function GetCount: Integer; override;
function GetItems(Index: Integer): PHashNode;
public
// Public declarations
constructor Create(BucketCount: LongWord; ByteMapping: PByteMapping = nil);
destructor Destroy; override;
procedure Clear; override;
property Items[Index: Integer]: PHashNode read GetItems;
end;
//////////////////////////
// TIntHash
//////////////////////////
type
TIntHash = class(TBaseHash)
public
// Public declarations
function Add(Key: Integer): PHashNode;
function Delete(Key: Integer): Boolean;
function Find(Key: Integer): PHashNode;
end;
//////////////////////////
// TStrHash
//////////////////////////
type
TStrHash = class(TBaseHash)
public
// Public declarations
function Add(Key: PChar): PHashNode;
function Delete(Key: PChar): Boolean;
function Find(Key: PChar): PHashNode;
end;
//////////////////////////
// TNameValueHash
//////////////////////////
type
TNameValueHash = class(TBaseHash)
protected
// Protected declarations
procedure FreeNode(HashNode: PHashNode); override;
public
// Public declarations
constructor Create(BucketCount: LongWord);
procedure Add(Name, Value: String);
function Delete(Name: String): Boolean;
function Find(Name: String; var Value: String): Boolean;
end;
//////////////////////////
// TNameIDHash
//////////////////////////
type
TNameIDHash = class(TBaseHash)
public
// Public declarations
constructor Create(BucketCount: LongWord);
procedure Add(Name: String; ID: Integer);
function Delete(Name: String): Boolean;
function Find(Name: String; var ID: Integer): Boolean;
end;
//////////////////////////
// TNameIDHash2
//////////////////////////
type
TNameIDHash2 = class(TBaseHash)
private
// Private declarations
FIDHash: TIntHash;
protected
// Protected declarations
public
// Public declarations
constructor Create(BucketCount: LongWord);
destructor Destroy; override;
procedure Add(Name: String; ID: Integer);
function Delete(Name: String): Boolean;
function Find(Name: String; var ID: Integer): Boolean;
function FindID(ID: Integer; var Name: String): Boolean;
end;
//////////////////////////
// Utility functions
//////////////////////////
function GetPrimeValue(Value: LongWord): LongWord;
procedure MoveEx(Source, Dest: PChar; Count: Cardinal);
//////////////////////////
// Global variables
//////////////////////////
var
CaseSensitive: TByteMapping;
CaseInsensitive: TByteMapping;
implementation
//// TNameIDHash2 //////////////////////////
function TNameIDHash2.FindID(ID: Integer; var Name: String): Boolean;
var lpNode: PHashNode;
begin
// Attempt to find the name associated with the ID value
lpNode:=FIDHash.Find(ID);
// Check node assignment
if Assigned(lpNode) then
begin
// Found the node
result:=True;
// Return the name associated with the ID
Name:=PChar(PHashNode(lpNo
end
else
// Failed to locate the ID
result:=False;
end;
procedure TNameIDHash2.Add(Name: String; ID: Integer);
var lpIntNode: PHashNode;
lpNode: PHashNode;
begin
// Perform inherited
lpNode:=inherited Add(Pointer(Name), Length(Name));
// Resource protection
try
// Add ID to integer hash
lpIntNode:=FIDHash.Add(ID)
// Set data to the hash node
lpIntNode^.Data:=lpNode;
finally
// Set data value
lpNode^.Data:=Pointer(ID);
end;
end;
function TNameIDHash2.Delete(Name: String): Boolean;
var dwID: Integer;
begin
// Locate the Name value
if Find(Name, dwID) then
begin
// Remove the ID from the integer hash
FIDHash.Delete(dwID);
// Remove from hash
result:=inherited Delete(Pointer(Name), Length(Name));
end
else
// Name not found
result:=False;
end;
function TNameIDHash2.Find(Name: String; var ID: Integer): Boolean;
var lpNode: PHashNode;
begin
// Perform inherited
lpNode:=inherited Find(Pointer(Name), Length(Name));
// Check node assignment
if Assigned(lpNode) then
begin
// Set result ID value
ID:=Integer(lpNode^.Data);
// Success
result:=True;
end
else
// Failed to find name
result:=False;
end;
constructor TNameIDHash2.Create(Bucket
begin
// Perform inherited
inherited Create(BucketCount, @CaseInsensitive);
// Create integer hash
FIDHash:=TIntHash.Create(B
end;
destructor TNameIDHash2.Destroy;
begin
// Resource protection
try
// Free the integer hash
FIDHash.Free;
finally
// Perform inherited
inherited Destroy;
end;
end;
//// TNameIDHash //////////////////////////
procedure TNameIDHash.Add(Name: String; ID: Integer);
var lpNode: PHashNode;
begin
// Perform inherited
lpNode:=inherited Add(Pointer(Name), Length(Name));
// Set data value
lpNode^.Data:=Pointer(ID);
end;
function TNameIDHash.Delete(Name: String): Boolean;
begin
// Perform inherited
result:=inherited Delete(Pointer(Name), Length(Name));
end;
function TNameIDHash.Find(Name: String; var ID: Integer): Boolean;
var lpNode: PHashNode;
begin
// Perform inherited
lpNode:=inherited Find(Pointer(Name), Length(Name));
// Check node assignment
if Assigned(lpNode) then
begin
// Set result ID value
ID:=Integer(lpNode^.Data);
// Success
result:=True;
end
else
// Failed to find name
result:=False;
end;
constructor TNameIDHash.Create(BucketC
begin
// Perform inherited
inherited Create(BucketCount, @CaseInsensitive);
end;
//// TNameValueHash //////////////////////////
procedure TNameValueHash.Add(Name, Value: String);
var lpNode: PHashNode;
dwValue: Integer;
begin
// Add name to hash
lpNode:=inherited Add(Pointer(Name), Length(Name));
// Get value length
dwValue:=Length(Value);
// Alloc / realloc memory for string
ReallocMem(lpNode^.Data, Succ(dwValue));
// Set value into data pointer
if (dwValue > 0) then MoveEx(Pointer(Value), lpNode^.Data, dwValue);
// Null terminate
PChar(lpNode^.Data)[dwValu
end;
function TNameValueHash.Delete(Name
begin
// Perform inherited
result:=inherited Delete(Pointer(Name), Length(Name));
end;
function TNameValueHash.Find(Name: String; var Value: String): Boolean;
var lpNode: PHashNode;
begin
// Perform inherited
lpNode:=inherited Find(Pointer(Name), Length(Name));
// Check node assignment
if Assigned(lpNode) then
begin
// Get value string
Value:=PChar(lpNode^.Data)
// Success
result:=True;
end
else
// Failed to locate a match
result:=False;
end;
procedure TNameValueHash.FreeNode(Ha
begin
// Free data memory
FreeMem(HashNode^.Data);
// Perform inherited
inherited FreeNode(HashNode);
end;
constructor TNameValueHash.Create(Buck
begin
// Perform inherited
inherited Create(BucketCount, @CaseInsensitive);
end;
//// TStrHash //////////////////////////
function TStrHash.Add(Key: PChar): PHashNode;
begin
// Check key
if Assigned(Key) then
// Add key to hash
result:=inherited Add(Key, StrLen(Key))
else
// Add nil key to hash
result:=inherited Add(nil, 0);
end;
function TStrHash.Delete(Key: PChar): Boolean;
begin
// Check key
if Assigned(Key) then
// Remove key
result:=inherited Delete(Key, StrLen(Key))
else
// Remove nil key
result:=inherited Delete(nil, 0);
end;
function TStrHash.Find(Key: PChar): PHashNode;
begin
// Check key
if Assigned(Key) then
// Find key
result:=inherited Find(Key, StrLen(Key))
else
// Find nil key
result:=inherited Find(nil, 0);
end;
//// TIntHash //////////////////////////
function TIntHash.Add(Key: Integer): PHashNode;
begin
// Perform inherited
result:=inherited Add(@Key, SizeOf(Integer));
end;
function TIntHash.Delete(Key: Integer): Boolean;
begin
// Perform inherited
result:=inherited Delete(@Key, SizeOf(Integer));
end;
function TIntHash.Find(Key: Integer): PHashNode;
begin
// Perform inherited
result:=inherited Find(@Key, SizeOf(Integer));
end;
//// TListHash //////////////////////////
function TListHash.AllocNode(Key: Pointer; KeySize: Cardinal): PHashNode;
begin
// Perform inherited
result:=inherited AllocNode(Key, KeySize);
// Add new node to list
FList.Add(result);
end;
procedure TListHash.FreeNode(HashNod
begin
// Check list (may be called during destroy), remove item
if not(FDestroying) and Assigned(FList) and (FList.Count > 0) then FList.Remove(HashNode);
// Perform inherited
inherited FreeNode(HashNode);
end;
function TListHash.GetCount: Integer;
begin
// Return list count
result:=FList.Count;
end;
function TListHash.GetItems(Index: Integer): PHashNode;
begin
// Return hash node from list
result:=PHashNode(FList[In
end;
procedure TlistHash.Clear;
begin
// Resource protection
try
// Clear the list if not in the destructor
if not(FDestroying) and Assigned(FList) then FList.Clear;
finally
// Perform inherited
inherited Clear;
end;
end;
constructor TListHash.Create(BucketCou
begin
// Perform inherited
inherited Create(BucketCount, ByteMapping);
// Set destructor flag
FDestroying:=False;
// Create the list
FList:=TList.Create;
end;
destructor TListHash.Destroy;
begin
// Set destructor flag
FDestroying:=True;
// Resource protection
try
// Free and nil the list
FreeAndNil(FList);
finally
// Perform inherited
inherited Destroy;
end;
end;
//// TBaseHash //////////////////////////
procedure TBaseHash.Stat(var HashStat: THashStat);
var lpNode: PHashNode;
dwAvgDepth: Integer;
dwIndex: Integer;
dwDepth: Integer;
begin
// Clear the stat record structure
FillChar(HashStat, SizeOf(THashStat), 0);
// Clear avg depth counter
dwAvgDepth:=0;
// Enumerate the node array
for dwIndex:=0 to Pred(FBuckets) do
begin
// Set bucket depth
dwDepth:=0;
// Get bucket node
lpNode:=FNodeArray^[dwInde
// Check node assignment
if Assigned(lpNode) then
begin
// Walk the nodes
while Assigned(lpNode) do
begin
// Increment the node count
Inc(HashStat.NodeCount);
// Increment the depth
Inc(dwDepth);
// Update the avg depth counter
Inc(dwAvgDepth, dwDepth);
// Check current depth
if (dwDepth < 16) then
// Update the depth bucket counter
Inc(HashStat.Depths[Pred(d
else
// Update the over 16 depth counter
Inc(HashStat.OverDepth16);
// Get pointer to next item
lpNode:=lpNode^.NextNode;
end;
end
else
// Update the empty bucket count
Inc(HashStat.EmptyBuckets)
end;
// Update the average depth
if (HashStat.NodeCount > 0) then HashStat.AvgDepth:=Round(d
end;
function TBaseHash.GetDepth: Integer;
var lpNode: PHashNode;
dwIndex: Integer;
dwDepth: Integer;
begin
// Set default result
result:=0;
// Enumerate the node array
for dwIndex:=0 to Pred(FBuckets) do
begin
// Set bucket depth
dwDepth:=0;
// Get bucket node
lpNode:=FNodeArray^[dwInde
// Check node assignment
if Assigned(lpNode) then
begin
// Walk the nodes
while Assigned(lpNode) do
begin
// Increment the depth
Inc(dwDepth);
// Get pointer to next item
lpNode:=lpNode^.NextNode;
end;
end;
// Update result is bucket depth is greater
if (dwDepth > result) then result:=dwDepth;
end
end;
function TBaseHash.GetItemList(List
var lpNode: PHashNode;
dwIndex: Integer;
begin
// Check list
if Assigned(List) then
begin
// Clear the list
List.Clear;
// Resource protection
try
// Iterate the node array
for dwIndex:=0 to Pred(FBuckets) do
begin
// Get bucket node
lpNode:=FNodeArray^[dwInde
// Walk the nodes
while Assigned(lpNode) do
begin
// Add node to list
List.Add(lpNode);
// Get pointer to next item
lpNode:=lpNode^.NextNode;
end;
end;
finally
// Return count of items
result:=List.Count;
end;
end
else
// Return count
result:=FCount;
end;
procedure TBaseHash.Enumerate(EnumCa
var lpNode: PHashNode;
dwIndex: Integer;
bCancel: Boolean;
begin
// Check callback
if Assigned(EnumCallback) then
begin
// Set cancel flag
bCancel:=False;
// Enumerate the node array
for dwIndex:=0 to Pred(FBuckets) do
begin
// Get bucket node
lpNode:=FNodeArray^[dwInde
// Walk the nodes
while Assigned(lpNode) do
begin
// Callback with the node
bCancel:=EnumCallback(Self
// Break if cancelled
if bCancel then break;
// Get pointer to next item
lpNode:=lpNode^.NextNode;
end;
// Break if cancelled
if bCancel then break;
end;
end
end;
function TBaseHash.Find(Key: Pointer; KeySize: Cardinal): PHashNode;
begin
// Get the bucket hash node
result:=FNodeArray^[GetBuc
// Loop node bucket chain
while Assigned(result) do
begin
// Compare hash key values
if Compare(result, Key, KeySize) then break;
// Walk the next node
result:=result^.NextNode;
end;
end;
function TBaseHash.Delete(Key: Pointer; KeySize: Cardinal): Boolean;
var lpNode: PHashNode;
lpNext: PHashNode;
dwIndex: LongWord;
begin
// Get the bucket index for the key
dwIndex:=GetBucket(Key, KeySize);
// Get the bucket hash node
lpNode:=FNodeArray^[dwInde
// Check top level node
if Assigned(lpNode) then
begin
// Compare hash key values
if Compare(lpNode, Key, KeySize) then
begin
// Move next node into bucket slot
FNodeArray^[dwIndex]:=lpNo
// Free the node
FreeNode(lpNode);
// Success
result:=True;
end
else
begin
// Get next item
lpNext:=lpNode^.NextNode;
// Walk the item chain
while Assigned(lpNext) do
begin
// Check item
if Compare(lpNext, Key, KeySize) then break;
// Set owner item
lpNode:=lpNext;
// Get next item
lpNext:=lpNext^.NextNode;
end;
// If next is assigned, then we found the item we need to delete
if Assigned(lpNext) then
begin
// Update the link chain
lpNode^.NextNode:=lpNext^.
// Free the node
FreeNode(lpNext);
// Success
result:=True;
end
else
// Failed to locate item
result:=False;
end;
end
else
// No top level item
result:=False;
end;
function TBaseHash.AddEx(Key: Pointer; KeySize: Cardinal; out Existed: Boolean): PHashNode;
var dwIndex: LongWord;
begin
// Get the bucket index for the key
dwIndex:=GetBucket(Key, KeySize);
// Get the bucket hash node
result:=FNodeArray^[dwInde
// Check node chain
while Assigned(result) do
begin
// Check item
if Compare(result, Key, KeySize) then break;
// Set next item
result:=result^.NextNode;
end;
// Set existed flag
Existed:=Assigned(result);
// If node is not assigned, then we need to allocate a new node
if not(Existed) then
begin
// Allocate a new item
result:=AllocNode(Key, KeySize);
// Link existing bucket item
result^.NextNode:=FNodeArr
// Update bucket node
FNodeArray^[dwIndex]:=resu
end;
end;
function TBaseHash.Add(Key: Pointer; KeySize: Cardinal): PHashNode;
var dwIndex: LongWord;
begin
// Get the bucket index for the key
dwIndex:=GetBucket(Key, KeySize);
// Get the bucket hash node
result:=FNodeArray^[dwInde
// Check node chain
while Assigned(result) do
begin
// Check item
if Compare(result, Key, KeySize) then break;
// Set next item
result:=result^.NextNode;
end;
// If node is not assigned, then we need to allocate a new node
if not(Assigned(result)) then
begin
// Allocate a new item
result:=AllocNode(Key, KeySize);
// Link existing bucket item
result^.NextNode:=FNodeArr
// Update bucket node
FNodeArray^[dwIndex]:=resu
end;
end;
function TBaseHash.GetCount: Integer;
begin
// Return private count state
result:=FCount;
end;
function TBaseHash.GetBucket(Key: Pointer; KeySize: Cardinal): LongWord;
var dwIndex: Cardinal;
begin
// Set default result
result:=0;
// Check key size
if not(KeySize = 0) then
begin
// Hash the key value
for dwIndex:=0 to Pred(KeySize) do
begin
// Hash the key byte
Inc(result, (result shl 5) + FByteMapping^[PByteArray(K
end;
// Keep the result in the range of buckets
result:=result mod FBuckets;
end;
end;
function TBaseHash.Compare(HashNode
var dwIndex: Cardinal;
begin
// Check key size first
if (HashNode^.KeySize = KeySize) then
begin
// Set starting index
dwIndex:=0;
// Compare the bytes in the keys using the mapping array
while (dwIndex < KeySize) and (FByteMapping^[PByteArray(
// Determine matched state
result:=(dwIndex = KeySize);
end
else
// Key sizes do not match
result:=False;
end;
function TBaseHash.AllocNode(Key: Pointer; KeySize: Cardinal): PHashNode;
begin
// Allocate result plus space for key
GetMem(result, SizeOf(THashNode) + Succ(KeySize));
// Resource protection
try
// Point the key to end of the fixed structure
result^.Key:=Pointer(PChar
// Copy the key into struct
MoveEx(Key, result^.Key, KeySize);
// Save the key size
result^.KeySize:=KeySize;
// Clear data and next node pointers
result^.Data:=nil;
result^.NextNode:=nil;
finally
// Update the count
Inc(FCount);
end;
end;
procedure TBaseHash.FreeNode(HashNod
begin
// Resource protection
try
// Free the node memory
FreeMem(HashNode);
finally
// Decrement the count
Dec(FCount);
end;
end;
procedure TBaseHash.Clear;
var lpNode: PHashNode;
lpNext: PHashNode;
dwIndex: Integer;
begin
// Resource protection
try
// Iterate the node array and clear the hash nodes
for dwIndex:=0 to Pred(FBuckets) do
begin
// Get bucket node
lpNode:=FNodeArray^[dwInde
// Walk the nodes
while Assigned(lpNode) do
begin
// Get pointer to next item
lpNext:=lpNode^.NextNode;
// Free the node
FreeNode(lpNode);
// Set iterator to next item
lpNode:=lpNext;
end;
end;
finally
// Clear the node array
FillChar(FNodeArray^, FBuckets * SizeOf(PHashNode), 0);
end
end;
constructor TBaseHash.Create(BucketCou
begin
// Perform inherited
inherited Create;
// Set initial count
FCount:=0;
// Check byte mapping
if Assigned(ByteMapping) then
// Save pointer to byte mapping which is used for key hashing
FByteMapping:=ByteMapping
else
// Use case sensitive byte mapping
FByteMapping:=@CaseSensiti
// Get prime value from desired bucket count
FBuckets:=GetPrimeValue(Bu
// Allocate node bucket array
FNodeArray:=AllocMem(FBuck
end;
destructor TBaseHash.Destroy;
begin
// Resource protection
try
// Clear the hash
Clear;
// Free the node hash array
FreeMem(FNodeArray);
finally
// Perform inherited
inherited Destroy;
end;
end;
//// Utility functions //////////////////////////
procedure MoveEx(Source, Dest: PChar; Count: Cardinal);
begin
// Check for null
if (Count > 0) then
begin
// Eight byte data move
while (Count > 7) do
begin
PInt64(Dest)^:=PInt64(Sour
Inc(Dest, 8);
Inc(Source, 8);
Dec(Count, 8);
end;
// Move remaining bytes
case Count of
1 : Dest^:=Source^;
2 : PWord(Dest)^:=PWord(Source
3 :
begin
PWord(Dest)^:=PWord(Source
Dest[2]:=Source[2];
end;
4 : PInteger(Dest)^:=PInteger(
5 :
begin
PInteger(Dest)^:=PInteger(
Dest[4]:=Source[4];
end;
6 :
begin
PInteger(Dest)^:=PInteger(
PWord(@Dest[4])^:=PWord(@S
end;
7 :
begin
PInteger(Dest)^:=PInteger(
PWord(@Dest[4])^:=PWord(@S
Dest[6]:=Source[6];
end;
end;
end;
end;
function GetPrimeValue(Value: LongWord): LongWord;
var dwIndex: Integer;
begin
// Set default result
result:=HASH_PRIMES[High(H
// Get the prime number to use based on the desired bucket count
for dwIndex:=0 to High(HASH_PRIMES) do
begin
// Check against passed value
if (HASH_PRIMES[dwIndex] > Value) then
begin
// Use the prime number at the current index
result:=HASH_PRIMES[dwInde
// Done processing
break;
end;
end;
end;
//// Initialization and finalization routines //////////////////////////
var
dwIndex: Integer;
initialization
// Initialize the byte mapping arrays
for dwIndex:=0 to 255 do
begin
// Case sensitive
CaseSensitive[dwIndex]:=dw
// Case insensitive
CaseInsensitive[dwIndex]:=
end;
end.
Main Topics
Browse All Topics
by: SteveBayPosted on 2009-02-20 at 09:26:13ID: 23694130
There is no quick way to add nodes to a standard TreeView. If speed is what you need then you should try Virtual Treeview
http://www.soft-gems.net/i