Search code examples
multithreadingdelphivirtualtreeviewtvirtualstringtree

Show file system tree data in TVirtualStringTree


I have such thread safe class for file system objects:

type
  PFSObject = ^TFSObject;
  TFSObject = class
  private
    FMREW: TMREWSync;

    FChildren: TObjectList<TFSObject>;
    FFilesCount: UInt32;
    FFoldersCount: UInt32;
    FName: string;
    FParent: TFSObject;

    function GetFullPath: string;
  public
    constructor Create(const AName: string; AParent: TFSObject; AFilesCount, AFoldersCount: UInt32 = 0);
    destructor Destroy; override;

    property Children: TObjectList<TFSObject> read FChildren write FChildren;
    property FilesCount: UInt32 read FFilesCount write FFilesCount;
    property FoldersCount: UInt32 read FFoldersCount write FFoldersCount;
    property Name: string read FName write FName;
    property Parent: TFSObject read FParent write FParent;

    procedure LockRead;
    procedure LockWrite;
    procedure UnlockRead;
    procedure UnlockWrite;
  end;

Have thread, which scan file system and fill this. On the main form have Timer, which receiving data from this class to show in TVirtualStringTree.

Which is the best method to show such data in TVirtualStringTree without loosing additional memory to store copy of data in Nodes?

Update: Ok, what I have now.

type
  PSizeData = ^TSizeData;
  TSizeData = record
    FSObj: PFSObject;
  end;

// OnTimer reader
procedure TformSize.tmrSizeTimer(Sender: TObject);
begin
  if tvSize.RootNodeCount = 0 then
    tvSize.RootNodeCount := 1
  else begin
    tvSize.Repaint;
    if FSThread.Finished then begin
      // Thread finished, disable timer
      SetTimerEnabled(False);
      // Expant first node
      tvSize.Expanded[tvSize.GetFirst] := True;
    end;
  end;
end;

// GetText of TVirtualStringTree
procedure TformSize.tvSizeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType; var CellText: string);
var
  Data, ParData: PSizeData;
begin
  // Check that children count changed for node
  Data := tvSize.GetNodeData(Node);
  if (Int32(Node.ChildCount) <> Data.FSObj.Children.Count) then begin
    tvSize.ChildCount[Node] := Data.FSObj.Children.Count;
    // Check that children count changed for parent node
    ParData := tvSize.GetNodeData(Node.Parent); 
    if Assigned(ParData) and (Int32(Node.Parent.ChildCount) <> ParData.FSObj.Children.Count) then
      tvSize.ChildCount[Node.Parent] := ParData.FSObj.Children.Count;
  end;
  // Get node text
  CellText := GetSizeDataText(Data, Column);
end;

// InitNode of TVirtualStringTree
procedure TformSize.tvSizeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
  var InitialStates: TVirtualNodeInitStates);
var
  Data, ParData: PSizeData;
  PFSObj: PFSObject;
begin
  Data  := Sender.GetNodeData(Node);
  if not Assigned(ParentNode) then
    PFSObj := @FSThread.FSObject
  else begin
    ParData := Sender.GetNodeData(ParentNode);
    PFSObj := PFSObject(ParData.FSObj.Children[Node.Index]);
  end;
  Data.FSObj := PFSObj;
end;

And now I have out of memory in TVirtualStringTree :( where is my error?


Solution

  • That's for sure a threading issue between the VCL main thread and the file reading / writing thread.

    When using VCL (remember: TVirtualStringTree is a VCL component) you need to synchronize additional threads with the VCL main thread.

    What i've done in the past to avoid these kind of issues:

    1. create a mutex in the VCL main thread (aka your TForm or something)
    2. create the thread and pass the mutex to it
    3. run the thread and when accessing VCL properties do a mutex lock before and a mutex unlock after
    4. in VCL main thread do a mutex lock / unlock also

    Basically you should never access or change VCL properties from additional threads without secure synchronization.