[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 677
  • Last Modified:

fill treeview fast from two tables with 10000 records

hw can a put the data from a two tables in a treeview fast.
the first tables have a 600 records , secon 9000 recors
first one have fields group_id , parent_id,Name
second - group_id ,group_kod,Name
I loock some code and its work but veri slow,about two min.
h>w can this code work fast
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, DB, ZAbstractRODataset, ZAbstractDataset,
  ZDataset, ZConnection,  ExtCtrls;
 
 
type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    Button1: TButton;
    ZConnection1: TZConnection;
    ZQuery1: TZQuery;
    ZQuery2: TZQuery;
    procedure Button1Click(Sender: TObject);
  private
  Procedure  Load_Tree ;
      { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
Type
  PDataRec = ^TData;
  TData = Record
                       ID  : Integer;
                       PID : Integer;
                       Text: String[150];
                      end;
 
function FindParent(ATreeView : TTreeView; ID : Integer) : TTreeNode;
var i : integer;
begin
  result := nil;
  i := 0;
  while (i < ATreeView.Items.Count) and
        (assigned(ATreeView.Items[i].Data)) and
        (PDataRec(ATreeView.Items[i].Data)^.ID <> ID) do
    inc(i);
  if i < ATreeView.Items.Count then
    result := ATreeView.Items[i];
end;
 
 
Procedure TForm1.Load_Tree;
var
  ANode : TTreeNode;
  RecordCache : PDataRec;
  RecordCacheList : TList;
  I, PreviousCount : Integer;
begin
  TreeView1.Items.Clear ;
  ZQuery1.Close;
  ZQuery1.SQL.Text := 'Select * from NGroups order by group_id';
  RecordCacheList := TList.Create;
  try
    ZQuery1.Open;
      while not ZQuery1.Eof do
    begin
      RecordCache := New(PDataRec);
      RecordCache^.ID := ZQuery1.FieldByName('GROUP_ID').AsInteger;
      RecordCache^.PID := ZQuery1.FieldByName('Parent_ID').AsInteger;
      RecordCache^.Text := ZQuery1.FieldByName('Name').AsString;
      RecordCacheList.Add(RecordCache);
      ZQuery1.Next;
    end;
    ZQuery1.Close;
    PreviousCount := RecordCacheList.Count;
    i := 0;
    While i < RecordCacheList.Count do
    begin
      If PDataRec(RecordCacheList.Items[i])^.PID = 0 then
      begin
        ANode := TreeView1.Items.AddChild(NIL,PDataRec(RecordCacheList.Items[i])^.Text);
        ANode.Data := RecordCacheList.Items[i];
        RecordCacheList.Delete(i);
      end
      else inc(i);
    end;
    While (RecordCacheList.Count > 0) and (PreviousCount <> RecordCacheList.Count) do
    begin
      i := 0;
      PreviousCount := RecordCacheList.Count;
      while i < RecordCacheList.Count do
      begin
        ANode := FindParent(TreeView1,PDataRec(RecordCacheList.Items[i])^.PID);
        if Anode <> NIL then
        begin
          ANode := TreeView1.Items.AddChild(ANode,PDataRec(RecordCacheList.Items[i])^.Text);
          ANode.Data := RecordCacheList.Items[i];
          RecordCacheList.Delete(i);
        end
        else inc(i);
      end;
    end;
    if RecordCacheList.Count > 0 then
      raise exception.Create('XXXX!');
  finally
    RecordCacheList.Free;
  end;
  Form1.Caption := Inttostr(TreeView1.Items.Count) ;
I := 0 ;
TreeView1.DoubleBuffered := true;
 
  ZQuery2.SQL.Clear ;
  ZQuery2.SQL.Text := 'Select group_kod,group_id,name from NGRP where group_id = :n';
    TreeView1.Items.BeginUpdate ;
  while i < TreeView1.Items.Count do
  begin
    begin
      ZQuery2.ParamByName('n').AsInteger := PDataRec(TreeView1.Items[i].Data)^.ID;
      ZQuery2.Open;
      While Not ZQuery2.Eof do
       begin
        New(RecordCache);
        RecordCache^.ID := ZQuery2.FieldByName('group_kod').AsInteger;
        RecordCache^.PID := 0;
        RecordCache^.Text := ZQuery2.FieldByName('group_kod').AsString +' - '+ZQuery2.FieldByName('Name').AsString;
        ANode := TreeView1.Items.AddChild(TreeView1.Items[i],RecordCache^.Text);
        ANode.Data := RecordCache;
        ANode.ImageIndex := 2;
        ANode.SelectedIndex := 3;
        ZQuery2.Next;
       end;
      ZQuery2.Close;
    end;
    inc(i);
    TreeView1.Items.EndUpdate ;
  end;
 
end;

Open in new window

0
Peev711
Asked:
Peev711
1 Solution
 
SteveBayCommented:
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/index.php?option=com_content&task=view&id=12&Itemid=33
0
 
Russell LibbySoftware Engineer, Advisory Commented:
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: TObject);
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.BeginUpdate;

  // Resource protection
  try
     // Clear items
     TreeView1.Items.Clear;

     // Create cache
     listCache1:=TList.Create;
     listCache2:=TList.Create;
     hashNodes:=TIntHash.Create(HASH_PRIMES[9], nil);

     // Resource protection
     try

        // Open the first query
        qryTable1.Close;
        qryTable1.SQL.Text:=qrySql1;
        qryTable1.Open;

        // Load the cache for the first query
        while not(qryTable1.EOF) do
        begin
           // Allocate record
           lpData1:=AllocMem(SizeOf(TDataRec1));
           // Fill record
           lpData1^.ID:=qryTable1.Fields[0].AsInteger;
           lpData1^.PID:=qryTable1.Fields[1].AsInteger;
           StrPLCopy(@lpData1^.Name, qryTable1.Fields[2].AsString, 255);
           // Add to cache
           listCache1.Add(lpData1);
           // Move next
           qryTable1.Next;
        end;

        // Open the second query
        qryTable2.Close;
        qryTable2.SQL.Text:=qrySql2;
        qryTable2.Open;

        // Load the cache for the second query
        while not(qryTable2.EOF) do
        begin
           // Allocate record
           lpData2:=AllocMem(SizeOf(TDataRec2));
           // Fill record
           lpData2^.ID:=qryTable2.Fields[0].AsInteger;
           StrPLCopy(@lpData2^.Code, qryTable2.Fields[1].AsString, 255);
           StrPLCopy(@lpData2^.Name, qryTable2.Fields[2].AsString, 255);
           // 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[dwIndex];
           // Check parent id
           if (lpData1^.PID = 0) then
           begin
              // Add item to the tree
              tvNode:=TreeView1.Items.AddChild(nil, lpData1^.Name);
              // Set data to ID
              tvNode.Data:=Pointer(lpData1^.ID);
              // Hash the ID and tree node
              hashNodes.Add(lpData1^.ID)^.Data:=tvNode;
           end;
        end;

        // Walk the first cache and add parented items
        for dwIndex:=0 to Pred(listCache1.Count) do
        begin
           // Get the item
           lpData1:=listCache1[dwIndex];
           // Check parent id
           if (lpData1^.PID <> 0) then
           begin
              // Lookup the node
              lpNode:=hashNodes.Find(lpData1^.PID);
              // Did we find it?
              if Assigned(lpNode) then
                 tvNode:=TTreeNode(lpNode^.Data)
              else
                 tvNode:=nil;
              // Add child item to the tree
              tvNode:=TreeView1.Items.AddChild(tvNode, lpData1^.Name);
              // Set data to ID
              tvNode.Data:=Pointer(lpData1^.ID);
              // Hash the ID and tree node
              hashNodes.Add(lpData1^.ID)^.Data:=tvNode;
           end;
        end;

        // Walk the second data cache
        for dwIndex:=0 to Pred(listCache2.Count) do
        begin
           // Get the item
           lpData2:=listCache2[dwIndex];
           // Lookup the node
           lpNode:=hashNodes.Find(lpData2^.ID);
           // Did we find it?
           if Assigned(lpNode) then
              tvNode:=TTreeNode(lpNode^.Data)
           else
              tvNode:=nil;
           // Add child item to the tree
           TreeView1.Items.AddChild(tvNode, lpData2^.Code + ' - ' + lpData2^.Name);
        end;

        // Free cached data items
        for dwIndex:=Pred(listCache1.Count) downto 0 do FreeMem(listCache1[dwIndex]);
        for dwIndex:=Pred(listCache2.Count) downto 0 do FreeMem(listCache2[dwIndex]);

     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('Routine took %d ms', [dwMark]));
 
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(lpNode^.Data)^.Key);
  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(BucketCount: LongWord);
begin

  // Perform inherited
  inherited Create(BucketCount, @CaseInsensitive);

  // Create integer hash
  FIDHash:=TIntHash.Create(BucketCount);

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(BucketCount: LongWord);
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)[dwValue]:=#0;

end;

function TNameValueHash.Delete(Name: String): Boolean;
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(HashNode: PHashNode);
begin

  // Free data memory
  FreeMem(HashNode^.Data);

  // Perform inherited
  inherited FreeNode(HashNode);

end;

constructor TNameValueHash.Create(BucketCount: LongWord);
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(HashNode: PHashNode);
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[Index]);

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(BucketCount: LongWord; ByteMapping: PByteMapping = nil);
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^[dwIndex];
     // 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(dwDepth)])
           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(dwAvgDepth / HashStat.NodeCount);

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^[dwIndex];
     // 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: TList): Integer;
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^[dwIndex];
           // 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(EnumCallback: THashEnumerate; Extra: Integer);
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^[dwIndex];
        // Walk the nodes
        while Assigned(lpNode) do
        begin
           // Callback with the node
           bCancel:=EnumCallback(Self, lpNode, Extra);
           // 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^[GetBucket(Key, KeySize)];

  // 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^[dwIndex];

  // 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]:=lpNode^.NextNode;
        // 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^.NextNode;
           // 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^[dwIndex];

  // 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:=FNodeArray^[dwIndex];
     // Update bucket node
     FNodeArray^[dwIndex]:=result;
  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^[dwIndex];

  // 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:=FNodeArray^[dwIndex];
     // Update bucket node
     FNodeArray^[dwIndex]:=result;
  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(Key)^[dwIndex]]);
     end;
     // Keep the result in the range of buckets
     result:=result mod FBuckets;
  end;

end;

function TBaseHash.Compare(HashNode: PHashNode; Key: Pointer; KeySize: Cardinal): Boolean;
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(HashNode^.Key)^[dwIndex]] = FByteMapping^[PByteArray(Key)^[dwIndex]]) do Inc(dwIndex);
     // 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(result) + SizeOf(THashNode));
     // 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(HashNode: PHashNode);
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^[dwIndex];
        // 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(BucketCount: LongWord; ByteMapping: PByteMapping = nil);
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:=@CaseSensitive;

  // Get prime value from desired bucket count
  FBuckets:=GetPrimeValue(BucketCount);

  // Allocate node bucket array
  FNodeArray:=AllocMem(FBuckets * SizeOf(PHashNode));

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(Source)^;
        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(Source)^;
        5  :
        begin
           PInteger(Dest)^:=PInteger(Source)^;
           Dest[4]:=Source[4];
        end;
        6  :
        begin
           PInteger(Dest)^:=PInteger(Source)^;
           PWord(@Dest[4])^:=PWord(@Source[4])^;
        end;
        7  :
        begin
           PInteger(Dest)^:=PInteger(Source)^;
           PWord(@Dest[4])^:=PWord(@Source[4])^;
           Dest[6]:=Source[6];
        end;
     end;
  end;

end;

function GetPrimeValue(Value: LongWord): LongWord;
var  dwIndex:       Integer;
begin

  // Set default result
  result:=HASH_PRIMES[High(HASH_PRIMES)];

  // 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[dwIndex];
        // 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]:=dwIndex;
     // Case insensitive
     CaseInsensitive[dwIndex]:=Byte(UpCase(Char(dwIndex)));
  end;

end.
0
 
Peev711Author Commented:
thanks for the information(code). its work very fast .thanks again.
0
 
bokistCommented:
I agree with rllibby, your code is very confused.
assuming that I have understand your problem, I would suggest :
   - improve your SQL code
   - fill Treeview simplier
var
   show_first_time : boolean = True;
 
type
     TData = Record
           ID : integer;
           PID : integer;
           Text : string[150];
end;
 
procedure TForm1.FormShow(Sender: TObject);
begin
   if show_first_time  then
      begin
      show_first_time := False;
      Prepare_data;
      Load_Tree;
   end; 
end;
 
procedure TForm1.Prepare_data;
begin
   with zQuery1 do
      begin
      Close;
      SQL.Clear;
      SQL.Add('alter table NGRP add  NGroups_parent_id     integer null,');
      SQL.Add('                                         NGroups_name    varchar(150) null,');
      SQL.Add('                                         items_count    integer null');
      Execsql;
      SQL.Clear;
      SQL.Add('update NGRP set NGroups_parent_id = g.parent_id, NGroups_name = g.name, items_count = 0');
      SQL.Add('    from NGROUPS g');
      SQL.Add(' where NGRP.group_id = g.group_id');
      Execsql;
      SQL.Clear;
      SQL.Add('update NGRP set  items_count = isnull((select count(*) from NGRP g');
      SQL.Add('                                                                        where NGRP.group_id = g.group_id');
      SQL.Add('                                                                         group by group_id),0)');
      Execsql;
      Close;
   end;
end;
 
procedure TForm1.Load_Tree;
var
  NodeRec : ^Rec;
  group_id, group_kod : integer;
  MainNode, FirstNode : TTreeNode;
begin
  group_id := 0;
  group_kod := 0;
  NodeRec := nil;
  with TreeView1 do
     begin
     Items.Clear;
     Items.BeginUpdate;
     with zQuery1 do
        begin
        SQL.Clear;
        SQL.Add('Select group_id, group_kod, name, NGroups_parent_id, NGroups_name, items_count');
        SQL.Add('  from NGRP');
        SQL.Add(' order by group_id desc, group_kod');
        Open;
        while (not EOF) do
           begin
           New(NodeRec);
           NodeRec^.ID := fieldByName('group_id').asinteger;
           NodeRec^.PID := fieldByName('group_kod').asinteger;
           NodeRec^.Text := fieldByName('name').asstring;
           if group_id <> fieldbyname('group_id').asinteger  then
              begin
	      MainNode := TreeView1.Items.AddFirst(nil, inttostr(FieldByName('group_id).asinteger));
              group_id := fieldbyname('group_id').asinteger;
              MainNode.Data := NodeRec;
              group_kod := 0;
           end;
           if fieldByName('items_count').asinteger > 1 then
              begin
              if group_kod <> FieldByName('group_kod').asinteger then
                 begin
                 FirstNode := TreeView1.Items.AddChild(MainNode, inttostr(FieldByName('group_kod').asinteger));
                 FirstNode.Data := NodeRec;
              end;
              group_kod := FieldByName('group_kod').asinteger;
           end;
           Next;
        end;
     end;
     Close;
     Items.EndUpdate;
  end;
end;

Open in new window

0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now