TVirtualStringTree - PerformanceProbleme

[karl der große]

Hallo, hab da ein kleines Problem!

Ich hab einen TVirutalStringTree. Versuche damit aus einer Tabelle mit 12 Feldern eine Anzeige mit 4 Ebenen zu basteln.

Die Tabelle hat derzeit ca. 2.400 Einträge, der Aufbau der Anzeige dauert ca. 15 sec, was aber eigentlich nicht sein kann.

Beim Kundeneinsatz wird die Tabelle ca. 200.000 Einträge haben, wenn ich das hochrechne, dann kann ich mit der Software gleich eine
Kaffeemaschine mitliefern.

Arbeite mit Delphi 6, Datenbank ACCESS 2000, Zugriff mit TADOConnection, TADOBetterDataset, TDatasource.

Hole mir die gesamten Daten mit einem SQL-String aus zwei Tabellen und verwende dafür 5 Datasets

Dataset 1 (in diesem Dataset sucht man sich einen Kunden aus, für den dann der TVirtualStringTree aufgebaut wird):

select * from tabelle1 -> ergibt die Kundennummer Dataset 2 (ergibt die Knotenpunkte der ersten Ebene)

Select Kundennummer, Sortierbegriff1 from tabelle2 where kundennummer = :kundennummer group by kundennummer, sortierbegriff1 Dataset 3 (ergibt die Knotenpunkte in der zweiten Ebene)

Select Kundennummer, Sortierbegriff1, Sortierbegriff2, sum(Betrag) as Gesamt from tabelle2 where kundennnummer =: kundennummer and sortierbegriff1 = :Sortierbegriff1 group by kundennummer, sortierbegriff1, sortierbegriff2 Dataset 4 (ergibt die Kontenpunkte in der dritten Ebene)

Select Kundennummer, Sortierbegriff1, Sortierbegriff2, Sortierbegriff3, sum(Betrag) as Gesamt from tabelle2 where kundennnummer =: kundennummer and sortierbegriff1 = :Sortierbegriff1 and sortierbegriff2 = :sortierbegriff2 group by kundennummer, sortierbegriff1, sortierbegriff2, sortierbegriff3 Dataset 5 (zeigt die Daten in der vierten Ebene an)

Select Kundennummer, Sortierbegriff1, Sortierbegriff2, Sortierbegriff3, Daten from tabelle2 where kundennnummer =: kundennummer and sortierbegriff1 = :Sortierbegriff1 and sortierbegriff2 = :sortierbegriff2 and sortierbegriff3 = :sortierbegriff3 Verwende folgenden Code:

Delphi-Quellcode:

  PTreeData = ^TTreeData;
  TTreeData = record
     FTree : TObject;
  end;

  TTreeTreeClass = class
     private
        FFeld1: string;
        FFeld2: string;
        FFeld3: double;
     published
        property Feld1: string read FFeld1 write FFeld1;
        property Feld2: string read FFeld2 write FFeld2;
        property Feld3: double read FFeld3 write FFeld3;
  end;

function Tanzeige.AddVSTTree(avsat: TCustomVirtualStringTree; asNode: PVirtualNode;
   aTree: TObject): PVirtualNode;
var
   Data: PTreeData;
begin
   Result := avsat.Addchild(asNode);
   data := avsat.GetNodeData(Result);
   avsat.ValidateNode(Result, False);
   data^.FTree := aTree;
end;

procedure Tanzeige.vstHeaderClick(Sender: TVTHeader; Column: TColumnIndex;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   if Button = mbLeft then
   begin
      with Sender, TreeView do
      begin
         if SortColumn > NoColumn then
            Columns[SortColumn].Options := Columns[SortColumn].Options + [coParentColor];
            if (SortColumn = NoColumn) or (SortColumn <> Column) then
            begin
               SortColumn := Column;
               SortDirection := sdAscending;
            end
            else
               if SortDirection = sdAscending then
                  SortDirection := sdDescending
               else
                  SortDirection := sdAscending;
            SortTree(SortColumn, SortDirection, False);
         end;
   end;
end;


procedure Tanzeige.vstTreeCompareNodes(Sender: TBaseVirtualTree; Node1,
  Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
   Data1, Data2: PTreeData;
begin
   Data1 := Sender.GetNodeData(Node1);
   Data2 := Sender.GetNodeData(Node2);
   case Column of
      0:
         Result := CompareText(TtreeDataClass(Data1.FTree).FFeld1,
            TtreeMassenClass(Data2.FTree).FFeld2);
   end;
end;

procedure Tanzeige.vstTreeFreeNode(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
   Data: PTreeData;
begin
   Data := vstTree.GetNodeData(Node);
   if not Assigned(Data) then
      exit;
   Data.FTree.Free;
end;

procedure Tanzeige.vstTreeGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var
   Data: PTreeData;
begin
   Data := Sender.GetNodeData(Node);
   if data.FTree <> nil then
   begin
      case Column of
         0:
            begin
                  celltext := TTreeDataClass(Data.FData).FFeld1
            end;
         1:
            begin
                  celltext := floattoStrF(TTreeDataClass(Data.FData).FFeld3,ffnumber,15,2)
            end;
         2:
            begin
                  celltext := TTreeDataClass(Data.FData).FFeld2
            end;
      end;
   end;
end;


procedure Tanzeige.FormCreate(Sender: TObject);
var
   TreeData: TTreeDataClass;
   DataWurzel: PVirtualNode;
   DataWurzel1: PVirtualNode;
   DataWurzel2: PVirtualNode;
begin
      vstTree.visible := false;
      db_Tabelle2.first;
      vstTree.BeginUpdate;
      vstTree.NodeDataSize := SizeOf(TTreeMassenClass);
      vstTree.DeleteChildren(vstTree.RootNode, true);
      while not db_Dataset2.Eof do
         begin
         TreeData := TTreeDataClass.Create;
         TreeData.Feld1 := db_Dataset2.fieldByName('Sortierbegriff1').AsString;
         DataWurzel := AddVSTTree(vstTree, Nil, TreeData);
         while not db_Dataset3.eof do
         begin
            TreeData := TTreeDataclass.Create;
            TreeData.Feld1 := db_Dataset3.fieldByName('Sortierbegriff2').AsString;
            TreeData.Feld3 := db_Dataset3.fieldByName('Gesamt').AsFloat;
            TreeData.Feld2 := db_Dataset5.fieldbyName('Feld5').AsString;
            DataWurzel1 := addvstTree(vstTree, DataWurzel, TreeData);
            while not db_Dataset4.eof do
            begin
               TreeData := TTreeDataClass.Create;
               TreeData.Feld1 := db_Dataset4.fieldbyName('Sortierbegriff3').AsString;
               TreeData.Feld3 := db_Dataset4.fieldbyName('Gesamt').AsFloat;
               TreeData.Feld2 := db_Dataset5.fieldbyName('Feld5').AsString;
               DataWurzel2 := addvstTree(vstTree, DataWurzel1, TreeData);
               while not db_Dataset5.eof do
               begin
                  TreeData := TTreeDataClass.Create;
                  TreeData.Feld1 := db_Dataset5.fieldbyName('Feld3').AsString;
                  TreeData.Feld3 := db_Dataset5.fieldbyName('Feld4').AsFloat;
                  TreeData.Feld2 := db_Dataset5.fieldbyName('Feld5').AsString;
                  addvstTree(vstTree, DataWurzel2, TreeData);
                  db_Dataset5.next;
               end;
               db_Dataset4.next;
            end;
            db_Dataset3.next;
         end;
         db_Dataset2.next;
      end;
      vstTree.EndUpdate;
      vstTree.visible := true;
   end;
end;


procedure Tanzeige.vstTreeBeforeItemErase(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
  var ItemColor: TColor; var EraseAction: TItemEraseAction);
begin
   case Sender.GetNodeLevel(Node) of
   0:
      begin
         ItemColor   := clMoneyGreen;
         EraseAction := eaColor;
      end;
   1:
      begin
         ItemColor   := clSkyBlue;
         EraseAction := eaColor;
      end;
    2:
      begin
         ItemColor   := clFuchsia;
         EraseAction := eaColor;
      end;
    end;
end;

Wie schon oben gesagt, dauert der Aufbau des TVirtualStringTrees ca. 15 sec, was lt. allen Beschreibungen in den Foren und auch auf der Homepage selbst sowie in der Dokumentation eingentlich nicht sein dürfte.

Hab auch schon versucht, eine Progressbar und eine Anzeige einzubauen, der einzige Ort, an dem mir das aber sinnvoll schien, ist im Create selbst.

Wenn ich aber an dieser Stelle den Progressbar einbaue, dann zischt er von 0 auf 100 und dann ist warten angesagt. Der Zeitverlust kann also eigentlich nicht im Create auftreten.

Hat jemand eine Idee. Ich hab im Moment keine mehr.

Danke für Eure Hilfe.

Gruss Karl