TVirtualStringTree - сброс невидимых узлов и потребления памяти

Попробуйте "DeleteChildren". Вот что говорится в комментарии к этой процедуре:

// Removes all children and their children from memory without changing the vsHasChildren style by default.

Никогда не использовал его, но, когда я прочитал его, вы можете использовать его в событии OnCollapsed, чтобы освободить память, выделенную узлам, которые только что стали невидимыми. А затем повторно сгенерируйте эти узлы в OnExpading, чтобы пользователь никогда не знал, что узел ушел из памяти.

Но я не могу быть уверен, у меня никогда не было необходимости в таком поведении.

Если я правильно понимаю, требования к памяти для TVirtualStringTree должны быть:

nodecount * (SizeOf (TVirtualNode) + YourNodeDataSize + DWORD-align-padding)

Чтобы минимизировать объем памяти , возможно, вы могли бы инициализировать узлы только указателями на смещения в файл с отображением в память. Сброс узлов, которые уже были инициализированы, в этом случае не кажется необходимым - объем памяти должен быть nodecount * (44 + 4 + 0) - для 5 миллионов записей это около 230 МБ.

IMHO, вы не можете улучшить дерево, но использование отображенного в память файла позволит вам читать данные прямо из файла, не выделяя еще больше памяти и не копируя данные в него.

Вы также можете рассмотреть возможность использования древовидной структуры вместо плоского представления для представления данных. Таким образом, вы можете инициализировать дочерние узлы родительского узла по запросу (когда родительский узел расширен) и сбросить родительский узел, когда он свернут (таким образом, освободив все его дочерние узлы). Другими словами, старайтесь не иметь слишком много узлов на одном уровне.

Вы не должны использовать ResetNode, потому что этот метод вызывает InvalidateNode и снова инициализирует узел, что приводит к противоположному эффекту, чем ожидалось. Я не знаю, можно ли заставить VST освободить размер памяти, указанный в NodeDataSize, без фактически удаляя узел. Но почему бы не установить для NodeDataSize размер указателя ( Delphi, VirtualStringTree - классы (объекты) вместо записей ) и не управлять данными самостоятельно? Просто идея ...

Чтобы выполнить ваше требование «разворачивать / сворачивать записи, охватывающие несколько строк» ​​, я бы просто использовал drawgrid. Чтобы проверить это, перетащите сетку на форму, а затем вставьте следующий код Delphi 6. Вы можете свернуть и развернуть 5 000 000 многострочных записей (или любое другое количество, которое вам нужно) практически без накладных расходов. Это простой метод, не требует большого количества кода и работает на удивление хорошо.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, StdCtrls;

type
  TForm1 = class(TForm)
    DrawGrid1: TDrawGrid;
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
    procedure DrawGrid1TopLeftChanged(Sender: TObject);
    procedure DrawGrid1DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure AdjustGrid;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// Display a large number of multi-line records that can be expanded or collapsed, using minimal overhead.
// LinesInThisRecord() and RecordContents() are faked; change them to return actual data.

const TOTALRECORDS = 5000000; // arbitrary; a production implementation would probably determine this at run time

// keep track of whether each record is expanded or collapsed
var isExpanded: packed array[1..TOTALRECORDS] of boolean; // initially all FALSE

function LinesInThisRecord(const RecNum: integer): integer;
begin // how many lines (rows) does the record need to display when expanded?
result := (RecNum mod 10) + 1; // make something up, so we don't have to use real data just for this demo
end;

function LinesDisplayedForRecord(const RecNum: integer): integer;
begin // how many lines (rows) of info are we currently displaying for the given record?
if isExpanded[RecNum] then result := LinesInThisRecord(RecNum) // all lines show when expanded
else result := 1; // show only 1 row when collapsed
end;

procedure GridRowToRecordAndLine(const RowNum: integer; var RecNum, LineNum: integer);
var LinesAbove: integer;
begin // for a given row number in the drawgrid, return the record and line numbers that appear in that row
RecNum := Form1.DrawGrid1.TopRow; // for simplicity, TopRow always displays the record with that same number
if RecNum > TOTALRECORDS then RecNum := 0; // avoid overflow
LinesAbove := 0;
while (RecNum > 0) and ((LinesDisplayedForRecord(RecNum) + LinesAbove) < (RowNum - Form1.DrawGrid1.TopRow + 1)) do
  begin // accumulate the tally of lines in expanded or collapsed records until we reach the row of interest
  inc(LinesAbove, LinesDisplayedForRecord(RecNum));
  inc(RecNum); if RecNum > TOTALRECORDS then RecNum := 0; // avoid overflow
  end;
LineNum := RowNum - Form1.DrawGrid1.TopRow + 1 - LinesAbove;
end;

function RecordContents(const RowNum: integer): string;
var RecNum, LineNum: integer;
begin // display the data that goes in the grid row.  for now, fake it
GridRowToRecordAndLine(RowNum, RecNum, LineNum); // convert row number to record and line numbers
if RecNum = 0 then result := '' // out of range
else
  begin
  result := 'Record ' + IntToStr(RecNum);
  if isExpanded[RecNum] then // show line counts too
    result := result + ' line ' + IntToStr(LineNum) + ' of ' + IntToStr(LinesInThisRecord(RecNum));
  end;
end;

procedure TForm1.AdjustGrid;
begin // don't allow scrolling past last record
if DrawGrid1.TopRow > TOTALRECORDS then DrawGrid1.TopRow := TOTALRECORDS;
if RecordContents(DrawGrid1.Selection.Top) = '' then // move selection back on to a valid cell
  DrawGrid1.Selection := TGridRect(Rect(0, TOTALRECORDS, 0, TOTALRECORDS));
DrawGrid1.Refresh;
end;

procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var s: string;
begin // time to draw one of the grid cells
if ARow = 0 then s := 'Data' // we're in the top row, get the heading for the column
else s := RecordContents(ARow); // painting a record, get the data for this cell from the appropriate record
// draw the data in the cell
ExtTextOut(DrawGrid1.Canvas.Handle, Rect.Left, Rect.Top, ETO_CLIPPED or ETO_OPAQUE, @Rect, pchar(s), length(s), nil);
end;

procedure TForm1.DrawGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
var RecNum, ignore: integer;
begin
GridRowToRecordAndLine(ARow, RecNum, ignore); // convert selected row number to record number
CanSelect := RecNum <> 0; // don't select unoccupied rows
end;

procedure TForm1.DrawGrid1TopLeftChanged(Sender: TObject);
begin
AdjustGrid; // keep last page looking good
end;

procedure TForm1.DrawGrid1DblClick(Sender: TObject);
var RecNum, ignore, delta: integer;
begin // expand or collapse the currently selected record
GridRowToRecordAndLine(DrawGrid1.Selection.Top, RecNum, ignore); // convert selected row number to record number
isExpanded[RecNum] := not isExpanded[RecNum]; // mark record as expanded or collapsed; subsequent records might change their position in the grid
delta := LinesInThisRecord(RecNum) - 1; // amount we grew or shrank (-1 since record already occupied 1 line)
if isExpanded[RecNum] then // just grew
else delta := -delta; // just shrank
DrawGrid1.RowCount := DrawGrid1.RowCount + delta; // keep rowcount in sync
AdjustGrid; // keep last page looking good
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := FormatFloat('#,##0 records', TOTALRECORDS);
DrawGrid1.RowCount := TOTALRECORDS + 1; // +1 for column heading
DrawGrid1.ColCount := 1;
DrawGrid1.DefaultColWidth := 300; // arbitrary
DrawGrid1.DefaultRowHeight := 12; // arbitrary
DrawGrid1.Options := DrawGrid1.Options - [goVertLine, goHorzLine, goRangeSelect] + [goDrawFocusSelected, goThumbTracking]; // change some defaults
end;

end.