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