I am not yet very experienced with the TVirtualStringTree component, therefore maybe I overlooked something trivial.
My app gathers File Information into a record (FileName, Path, Size) and displays the data in a Virtual String Tree.
Now when there are lots of Nodes (200K+) I experience a heavy slow down, the whole Tree basically lags. I am aware that the memory footprint is quite large with just the record data alone, but I found out that the lag is caused by the OnGetText method of the VST.
Hereby it doesn't matter if the method reads actual data or sets the CellText to an static string (e.g. CellText := 'Test';) the slow down is significant.
If I exit OnGetText without setting CellText, it works fine - even with as much as 1,000,000 Nodes in my Tree.
Also, If I collapse the Tree (FullCollapse) hiding this way 90% of my Nodes, OnGetText behaves ok as well or at least much better.
As far as I understand it, the OnGetText is only called for actually visible On Screen Nodes, therefore I don't get why this is such an issue with large amounts of Nodes in the Tree.
Anybody has any hints for me to point me in a direction?
EDIT:
Delphi Version: D2010
VST Version: 4.8.6
My code in its simplest test form is basically as follows:
var
SkipGetText : boolean;
procedure TXForm.VSTGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
begin
if SkipGetText then exit;
CellText := 'TEST';
// actual code commented out to reduce complications
end;
If I set CellText, it lags, if I exit, it doesn't.
Strange enough, it gets worse the further I scroll down.
Here's what's assigned as NodeData:
type
PVSData = ^Fi;
Fi = Packed Record
Name, Dir, Ext: String;
Size: Int64;
end;
procedure TXForm.AddFile( const RootFolder:string; const SR: TSearchRec );
var
FileInfo: PVSData;
FileSize: Int64;
Node: PVirtualNode;
begin
Node := VST.AddChild(nil);
INC(AllFiles);
FileInfo := VST.GetNodeData(Node);
FileInfo^.Name := SR.Name;
FileInfo^.Dir := RootFolder;
Int64Rec(FileSize).Hi := SR.FindData.nFileSizeHigh;
Int64Rec(FileSize).Lo := SR.FindData.nFileSizeLow;
FileInfo^.Size := FileSize;
end;
procedure TXForm.VSTPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);
begin
if SkipPaintText then exit;
case ListView.GetNodeLevel(Node) of
0: TargetCanvas.Font.Color := Color1;
else TargetCanvas.Font.Color := Color2;
end;
end;
procedure TXForm.VSTBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
begin
case ListView.GetNodeLevel(Node) of
0: TargetCanvas.Font.Color := Color1;
else TargetCanvas.Font.Color := Color2;
end;
end;
I noticed, that expanding / collapsing and re-expanding somehow seems to improve the situation, but it's beyond me to tell why this could actually have any impact.
If any of your columns are auto-sized, then the control needs to know the widths of all the nodes' values in order to determine the maximum.
Strange, I thought it was the whole design of VST to only load cellnodes for the nodes in the active view, not the entire tree. Are you sure it isn't some other factor in the code that you don't show, like doing a fileexists or so for every node?
Problem solved. It turns out, there might have been a complication while deleting nodes. Instead of deleting all children of a parent node, only the parent node has been removed. I expected the childnodes to be removed automatically as well, but when I changed the code to first delete children then the parent node, the lagging vanished. Now I can load a million file names to the tree without lag.
You did not say which version of Delphi you are using. In versions prior to D2009, TVirtualTreeView uses the WideString string type, which is inherently slow in general as it does not have the reference-counting, copy-on-write semantics that AnsiString has, so try to minimize your string operations as much as possible. In D2009 and later, TVirtualTreeView uses the newer UnicodeString string type instead of WideString.
Related
At positive offsets the VMT stores pointers to all user defined virtual methods.
I need to write some code to hook the VMT.
The way I do this is to get a pointer to a virtual method in an ancestor class.
Let's say: TCustomForm.ShowModal. I then look up the offset in the VMT of TCustomForm. With this offset in hand I go to TMyForm and alter its VMT to point to the function I need.
I would like to generalize the approach and in order to do so I would like to know the total number of entries the VMT holds so I don't search past the end.
How do I obtain the size of the (user definable part of) the VMT?
Digging through the RTL source I think this is the way to get the count:
function GetVMTCount(AClass: TClass): integer;
var
p: pointer;
VirtualMethodCount: word;
begin
p := PPointer(PByte(AClass) + vmtMethodTable)^;
VirtualMethodCount:= PWord(p)^;
//Size of the VMT in bytes
Result:= VirtualMethodCount * SizeOf(Pointer) - vmtSelfPtr;
//Number of entries in the VMT
Result:= Result div SizeOf(Pointer);
end;
Feel free to correct me if needed.
A way to do this without much actual knowledge of the VMT structure, and hence less prone to breaking when the VMT structure changes again, is using the Rtti for this. TRttiInstanceType knows the VmtSize of the associated class.
So using VmtSize and a VMT entry being a Pointer
function GetVirtualMethodCount(AClass: TClass): Integer;
var
AContext: TRttiContext;
AType: TRttiType;
begin
AType := AContext.GetType(AClass);
Result := (AType as TRttiInstanceType).VmtSize div SizeOf(Pointer);
end;
This will however include all entries inherited from the base class(es) too. Including the ones from TObject at negative offsets. But it is possible to subtract all entries from a given base class, e.g. TObject. Here is an approach with a variable base class provided:
function GetVirtualMethodCountMinusBase(AClass: TClass; ABaseClass: TClass): Integer;
var
AContext: TRttiContext;
AType, ABaseType: TRttiType;
begin
AType := AContext.GetType(AClass);
ABaseType := AContext.GetType(ABaseClass);
Result := ((AType as TRttiInstanceType).VmtSize - (ABaseType as TRttiInstanceType).VmtSize) div SizeOf(Pointer);
end;
And: When using Jedi there is a function in JclSysUtils called GetVirtualMethodCount. Although I'm not sure if this is up-to-date and correct.
It's easy to check that node is visible. But I don't know how to rightly define that node is presented on screen. I can find out only so:
BottomNode := Tree.BottomNode;
Node := Tree.TopNode;
IdBottomNode := Tree.AbsoluteIndex(BottomNode);
while Tree.AbsoluteIndex(Node) <> IdBottomNode do
begin
Node := Node.NextSibling;
if not Assigned(Node) then
Break;
end;
(code without checking)
But I think it is rather rough way. May be is there more accurate way?
You may write a function like follows. The Tree parameter there specifies the virtual tree, the Node is the node for which you want to check if it's visible, and the Column optional parameter is the index of a column if you would need to determine whether the node and even column is visible in client rect:
function IsNodeVisibleInClientRect(Tree: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex = NoColumn): Boolean;
begin
Result := Tree.IsVisible[Node] and
Tree.GetDisplayRect(Node, Column, False).IntersectsWith(Tree.ClientRect);
end;
But maybe there's a more straightforward way...
I use Delphi 10.1 Berlin in Windows 10.
I have two records of different sizes. I wrote code to loop through two TList<T> of these records to test elapsed times. Looping through the list of the larger record runs much slower.
Can anyone explain the reason, and provide a solution to make the loop run faster?
type
tTestRecord1 = record
Field1: array[0..4] of Integer;
Field2: array[0..4] of Extended;
Field3: string;
end;
tTestRecord2 = record
Field1: array[0..4999] of Integer;
Field2: array[0..4999] of Extended;
Field3: string;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
_List: TList<tTestRecord1>;
_Record: tTestRecord1;
_Time: TTime;
i: Integer;
begin
_List := TList<tTestRecord1>.Create;
for i := 0 to 4999 do
begin
_List.Add(_Record);
end;
_Time := Time;
for i := 0 to 4999 do
begin
if _List[i].Field3 = 'abcde' then
begin
Break;
end;
end;
Button1.Caption := FormatDateTime('s.zzz', Time - _Time); // 0.000
_List.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
_List: TList<tTestRecord2>;
_Record: tTestRecord2;
_Time: TTime;
i: Integer;
begin
_List := TList<tTestRecord2>.Create;
for i := 0 to 4999 do
begin
_List.Add(_Record);
end;
_Time := Time;
for i := 0 to 4999 do
begin
if _List[i].Field3 = 'abcde' then
begin
Break;
end;
end;
Button2.Caption := FormatDateTime('s.zzz', Time - _Time); // 0.045
_List.Free;
end;
First of all, I want to consider the entire code, even the code that populates the list which I do realise you have not timed. Because the second record is larger in size more memory needs to be copied when you make an assignment of that record type. Further when you read from the list the larger record is less cache friendly than the smaller record which impacts performance. This latter effect is likely less significant than the former.
Related to this is that as you add items the list's internal array of records has to be resized. Sometimes the resizing leads to a reallocation that cannot be performed in-place. When that happens a new block of memory is allocated and the previous content is copied to this new block. That copy is clearly ore expensive for the larger record. You can mitigate this by allocating the array once up front if you know it's length. The list Capacity is the mechanism to use. Of course, not always will you know the length ahead of time.
Your program does very little beyond memory allocation and memory access. Hence the performance of these memory operations dominates.
Now, your timing is only of the code that reads from the lists. So the memory copy performance difference on population is not part of the benchmarking that you performed. Your timing differences are mainly down to excessive memory copy when reading, as I will explain below.
Consider this code:
if _List[i].Field3 = 'abcde' then
Because _List[i] is a record, a value type, the entire record is copied to an implicit hidden local variable. The code is actually equivalent to:
var
tmp: tTestRecord2;
...
tmp := _List[i]; // copy of entire record
if tmp.Field3 = 'abcde' then
There are a few ways to avoid this copy:
Change the underlying type to be a reference type. This changes the memory management requirements. And you may have good reason to want to use a value type.
Use a container class that can return the address of an item rather than a copy of an item.
Switch from TList<T> to dynamic array TArray<T>. That simple change will allow the compiler to access individual fields directly without copying entire records.
Use the TList<T>.List to obtain access to the list object's underlying array holding the data. That would have the same effect as the previous item.
Item 4 above is the simplest change you could make to see a large difference. You would replace
if _List[i].Field3 = 'abcde' then
with
if _List.List[i].Field3 = 'abcde' then
and that should yield a very significant change in performance.
Consider this program:
{$APPTYPE CONSOLE}
uses
System.Diagnostics,
System.Generics.Collections;
type
tTestRecord2 = record
Field1: array[0..4999] of Integer;
Field2: array[0..4999] of Extended;
Field3: string;
end;
procedure Main;
const
N = 100000;
var
i: Integer;
Stopwatch: TStopwatch;
List: TList<tTestRecord2>;
Rec: tTestRecord2;
begin
List := TList<tTestRecord2>.Create;
List.Capacity := N;
for i := 0 to N-1 do
begin
List.Add(Rec);
end;
Stopwatch := TStopwatch.StartNew;
for i := 0 to N-1 do
begin
if List[i].Field3 = 'abcde' then
begin
Break;
end;
end;
Writeln(Stopwatch.ElapsedMilliseconds);
end;
begin
Main;
Readln;
end.
I had to compile it for 64 bit to avoid an out of memory condition. The output on my machine is around 700. Change List[i].Field3 to List.List[i].Field3 and the output is in single figures. The timing is rather crude, but I think this demonstrates the point.
The issue of the large record not being cache friendly remains. That is more complicated to deal with and would require a detailed analysis of how the real world code operated on its data.
As an aside, if you care about performance then you won't use Extended. Because it has size 10, not a power of two, memory access is frequently mis-aligned. Use Double or Real which is an alias to Double.
I have several versions of my data in record stored on the disk:
TRec_v1 = record
Type: UInt32;
DT1: TDateTime;
end;
TRec_v2 = record
Type: UInt32;
DT1: TDateTime;
DT2: TDateTime;
end;
TRec_v3 = record
Type: UInt32;
DT1: TDateTime;
DT2: TDateTime;
DT3: TDateTime;
end;
Which is the fasted method to read it?
Currently I use this method:
var
Rec: TRec_v3;
Rec1: TRec_v1;
Rec2: TRec_v2;
FStream := TFileStream.Create(RecPath, fmOpenRead);
try
if FStream.Size = SizeOf(TRec_v1) then
// read to Rec1, assignt to Rec
else
if FStream.Size = SizeOf(TRec_v2) then
// read to Rec2, assigne to Rec
else
if FStream.Size = SizeOf(TRec_v3) then
// read to Rec
finally
FStream.Free;
end;
Note: every newer version contain all fields from previous version + new fields
If there is only one record stored in the file, you can use a case statement instead of a series of if statements. And since your newer records contain the same fields as your older records, you don't need separate variables, either:
var
Rec: TRec_v3;
RecSize: Integer;
FStream := TFileStream.Create(RecPath, fmOpenRead);
try
RecSize := FStream.Size;
case RecSize of
SizeOf(TRec_v1),
SizeOf(TRec_v2),
SizeOf(TRec_v3):
begin
FStream.ReadBuffer(Rec, RecSize);
end;
else
raise Exception.Create('Unsupported record size detected');
end;
finally
FStream.Free;
end;
// use Rec fields depending on RecSize...
Alternatively:
type
TRec_v1 = record
Type: UInt32;
DT1: TDateTime;
end;
TRec_v2 = record
Type: UInt32;
DT1: TDateTime;
DT2: TDateTime;
end;
TRec_v3 = record
Type: UInt32;
DT1: TDateTime;
DT2: TDateTime;
DT3: TDateTime;
end;
TRec = record
case Integer of
0: (v1: TRec_v1);
1: (v2: TRec_v2);
2: (v3: TRec_v3);
end;
var
Rec: TRec;
RecSize: Integer;
FStream := TFileStream.Create(RecPath, fmOpenRead);
try
RecSize := FStream.Size;
case RecSize of
SizeOf(TRec_v1),
SizeOf(TRec_v2),
SizeOf(TRec_v3):
begin
FStream.ReadBuffer(Rec, RecSize);
end;
else
raise Exception.Create('Unsupported record size detected');
end;
finally
FStream.Free;
end;
// use Rec.v1, Rec.v2, or Rec.v3 depending on RecSize...
Which is the fastest method to read it?
The performance of the code to read the record will be completely dominated by the file access. The majority of the time is spent opening the file, as written in the question.
Using a case statement or if statements is simply a matter of preference and will not lead to observable performance changes.
If this code is buried in a greater whole, then I don't think anyone can advise on the performance without a clear sight of that greater code.
Given the code in the question, the only scope for improving the performance in a measurable way is to evaluate the stream size one time only rather than multiple times.
var
Size: Int64;
....
Size := Stream.Size;
// test Size
Even here I doubt you will see a discernible performance impact. However, it is better not to repeat yourself, as a general rule, and this change results in better factored code.
You must measure performance to assess a proposed optimization.
Finally, your entire approach is brittle. If you add an integer to the v3 structure the record size is increased by 8, with padding due to alignment. Add another integer and the size doesn't change, that second integer fitting in the padding. Discriminating based on the type field would be more robust and extendable.
I would recommend creating, reading and writing a variant record, then differentiating between them with a tag:
type recordTypeName = record
fieldList1: type1;
...
fieldListn: typen;
case tag: ordinalType of
constantList1: (variant1);
...
constantListn: (variantn);
end;
When I need to find the first node in a TTreeView, I call TTreeNodes.GetFirstNode. However, I sometimes need to locate the last node in a tree and there is no corresponding TTreeNodes.GetLastNode function.
I don't want to use Items[Count-1] since that results in the entire tree being walked with Result := Result.GetNext. Naturally this only matters if the tree views have a lot of nodes. I fully appreciate the virtues of virtual container controls but I am not going to switch to Virtual TreeView just yet.
So far I have come up with the following:
function TTreeNodes.GetLastNode: TTreeNode;
var
Node: TTreeNode;
begin
Result := GetFirstNode;
if not Assigned(Result) then begin
exit;
end;
while True do begin
Node := Result.GetNextSibling;
if not Assigned(Node) then begin
Node := Result.GetFirstChild;
if not Assigned(Node) then begin
exit;
end;
end;
Result := Node;
end;
end;
Can anyone:
Find a flaw in my logic?
Suggest improvements?
Edit 1
I'm reluctant to keep my own cache of the nodes. I have been doing just that until recently but have discovered some hard to track very intermittent AVs which I believe must be due to my cache getting out of synch. Clearly one solution would be to get my cache synchronisation code to work correctly but I have an aversion to caches because of the hard to track bugs that arise when you get it wrong.
Although I am not a non-Exit purist, I think that when it is doable without Exit while keeping readability intact, one might prefer that option.
So here is exactly the same code, for I don't think you can get any other way (faster) to the end node, but without Exit and slightly more compact:
function TTreeNodes.GetLastNode: TTreeNode;
var
Node: TTreeNode;
begin
Node := GetFirstNode;
Result := Node;
if Result <> nil then
repeat
Result := Node;
if Node <> nil then
Node := Result.GetNextSibling;
if Node = nil then
Node := Result.GetFirstChild;
until Node = nil;
end;
The method I've used before is the maintain a TList using List.Add on the OnAddition event and List.Remove on the OnDeletion event (OnRemove?). You've access to List.Count-1 (or whatever you need) pretty much instantly then.
Post edit - I have to say that although this worked fine, I then grew up and moved to Virtual Tree View :-)
If I was to implement it, this would probably be my first draft.
function TTreeNodes.GetLastNode: TTreeNode;
var
Node: TTreeNode;
function GetLastSibling(aNode : TTreeNode) : TTreeNode;
begin
if not Assigned(aNode) then
EXIT(nil);
repeat
Result := aNode;
aNode := Result.GetNextSibling;
until not Assigned(aNode) ;
end;
begin
Node := GetFirstNode;
if not Assigned(Node) then begin
exit;
end;
repeat
Result := GetLastSibling(Node);
Node := Result.GetFirstChild;
until not Assigned(Node);
end;
I find this slightly more readable. It might be slightly slower though.
I'm unsure about whether or not this approach would be faster than items[Count-1], in some cases, it could be slower, as the TTreeNodes actually caches the last node accessed through the items property.