DBGrid stop current Row moving - delphi

Using d5, TDBGrid, SQLite3 and ZEOS. Database has 2000 items, one Column is an "Active" as Boolean, a second Column is "ItemName" as Text, and IndexFiledNames is "ItemName'
OnDblclick toggles "Active" On/Off and all works as expected for the Data. Active changes from True to False and back again.
But, if I double-click on the last visible Row of the DBGrid, to toggle the Active state -- after the toggle, the DBGrid moves that item Row to the vertical center Row-position of the grid. This is very confusing to a user with the Row they just double-clicked jumping around.
How can I stop the grid from moving that Row to the middle? This happens with all items that are on the last visible Row of the DGBGrid.
{EDIT} The remmed out items are attempts at reducing the issue - didn't work.
procedure TfrmMain.dbgridItemsDblClick(Sender: TObject);
begin
puItemsSelectedClick(Self);
end;
procedure TfrmMain.puItemsSelectedClick(Sender: TObject);
//var
// CurrItem : String;
// CurrIndx : String;
begin
if dm.tblItems.RecordCount = 0 then
begin
myShowMsg('There are no Items in the Items List');
Exit;
end;
// CurrItem:=dm.tblItems.FieldByName(fldItemGroupShop).AsString;
// CurrIndx:=dm.tblItems.IndexFieldNames;
dm.tblItems.DisableControls;
try
// dm.tblItems.IndexFieldNames:='';
dm.tblItems.Edit;
dm.tblItems.FieldByName(fldSelected).AsBoolean:=
not(dm.tblItems.FieldByName(fldSelected).AsBoolean);
dm.tblItems.Post;
// dm.tblItems.IndexFieldNames:=CurrIndx;
// dm.tblItems.Locate(fldItemGroupShop,CurrItem,[]);
finally
dm.tblItems.EnableControls;
end;
end;

The current row number and number of display rows of a DBGrid are protected properties,
so you need a "class cracker" type declaration in your code, like so:
type
TMyDBGrid = Class(TDBGrid);
function TForm1.GetGridRow: Integer;
begin
Result := TmyDBGrid(DBGrid1).Row;
end;
function TForm1.GridRowCount : Integer;
begin
Result := TmyDBGrid(DBGrid1).RowCount;
end;
Having done that, place a TEdit and TButton on your form to input a new grid row number that's less than the current one. Then try out the following routine:
procedure TForm1.SetGridRow(NewRow : Integer);
var
GridRows,
OldRow,
MoveDataSetBy,
MovedBy : Integer;
DataSet : TDataSet;
Possible : Boolean;
ScrollUp : Boolean;
begin
OldRow := GetGridRow;
if NewRow = OldRow then
Exit;
ScrollUp := NewRow < OldRow;
DataSet := dBGrid1.DataSource.DataSet;
GridRows := TmyDBGrid(DBGrid1).RowCount;
{ TODO : Test the case where the DataSet doesn't have enough rows to fill the grid}
{ TODO : Check why grid reports one more row than it displays.
Meanwhile ... }
GridRows := GridRows - 1;
// First check whether the NewRow value is sensible
Possible := (NewRow >= 1) and (NewRow <= GridRows);
if not Possible then exit;
try
if ScrollUp then begin
// First scroll the dataset forwards enough to bring
// a number of new records into view
MoveDataSetBy := GridRows - NewRow;
MovedBy := DataSet.MoveBy(MoveDataSetBy);
Shortfall := MoveDataSetBy - MovedBy;
if Shortfall = 0 then begin
// Now scroll the dataset backwards to get back
// to the record we were on
MoveDataSetBy := -GridRows + NewRow;
MovedBy := DataSet.MoveBy(MoveDataSetBy);
end
else
MovedBy := DataSet.MoveBy(-MovedBy);
end
else begin
MoveDataSetBy := -(NewRow - 1);
MovedBy := DataSet.MoveBy(MoveDataSetBy);
// We need to know if the DS cursor was able to move far enough
// back as we've asked or was prevented by reaching BOF
Shortfall := MoveDataSetBy - MovedBy;
if Shortfall = 0 then begin
// The DS cursor succeeded on moving the requested distance
MoveDataSetBy := NewRow - 1;
MovedBy := DataSet.MoveBy(MoveDataSetBy);
end
else
// it failed, so we need to return to the record we started on
// but this won't necessarily return us the same grid row number
MovedBy := DataSet.MoveBy(-MovedBy);
finally
DBGrid1.Invalidate;
end;
My earlier suggestion, to do a direct assignment to the grid row by "TmyDBGrid(DBGrid1).Row := NewRow;" was based on a mis-recollection, because in fact that seems to do nothing very useful.
The algorithm following "if ScrollUp" is made complicated by the fact that we're not depending on a meaningful RecNo. What this involves is checking whether the dataset cursor can be moved by a sufficient amount in the direction opposite the one we want to move the grid row in, to scroll the DS cursor relative to the rows in the grid, without hitting EOF or BOF - if either of thiose happens, we just move the DS cursor back to where it was and give up trying to scroll the grid.
For ScrollUp, the logic is:
First move the dataset cursor to the last row in the grid
Then move it forwards some more, by the difference between the old and new Row values.
Then move it back by an amount equal to the number of rows in the grid less the new row value.
If all that succeeds, the current row will move to the grid position requested by the NewRow value.
Of course, the code combines the first two of these steps. At first, I thought this code was nonsense, because the algebraic sum of the values used for the DataSet.MoveBy()s is zero. In fact,
it's not nonsense, just a bit counter-intuitive. Of course the distances add up do zero, because we want to get back to the record we were one; the point of doing the DataSet.MoveBy()s at all is to shake loose, as it were, the grid's grip on the current record and then return to it. This is incidentally why there's no point in doing what I usually when moving off the current record and then returning to it, namely DataSet.GetBookmark/GotBookmark/FreeBookmark and indeed using those will defeat the code's intended effect.
I'm using a ClientDataSet, btw, not a ZEOS one, but that shouldn't make any difference.
Btw, the local DataSet variable is to access the grid's dataset without using Delphi's infernal "With ..." construct.
Incidentally, your comment about "Rows div 2" reminded me: I don't think it's the grid that tells the dataset, ISTR it's the Datalink associated with the grid which tells the dataset how many records it should allocate buffers for. Then, in TDataSet.Resync, you'll notice
if rmCenter in Mode then
Count := (FBufferCount - 1) div 2 else
Count := FActiveRecord;
and then take a look how Count is used later in the routine; your theory may be spot on. Maybe put a breakpoint on "if cmCenter in Mode" and see if it gets called from where your grid acts up.
Btw#2, even if this code hasn't helped, this article might http://delphi.about.com/od/usedbvcl/l/aa011004a.htm

I am not sure that my situation is like yours, but if you want to fix annoying grid centering (for example, if you react on user click and need to get to the record before or record below and then correctly get back), use this:
var oldActiverecord:=FDataLink.ActiveRecord;
DataSet.DisableControls;
oldrecno:=Dataset.RecNo;//remember current recno
Dataset.RecNo:=SomeAnotherRecNoWhichYouNeedToGoTo;
//do what you like with this record
...
//then return to current
Dataset.RecNo:=oldrecno;//in this moment grid will center
var MoveDataSetBy:=oldActiverecord-FDataLink.ActiveRecord;//how much?
if MoveDataSetBy<>0 then begin
DataSet.MoveBy(-MoveDataSetBy); //get back
DataSet.Resync([rmCenter]); //center there
DataSet.MoveBy(+MoveDataSetBy);//move cursor where we was initially
end;
DataSet.EnableControls;

Related

How to search a FMX.TListView header as well as items

I have a LiveBindings databound FMX.TListView with the FieldName being Stage and the FillHeaderFieldName being Production. When the app is running, I see a list of Productions using the HeaderAppearance, and within each Production, there is a list of Stages using the ItemAppearance. I've turned on SearchVisible to get the components search panel to show at the top of the list.
Currently, typing into the search box only filters on the Stage, and not the Production.
I'd like to be able to do both, and I'd like to be able to do it without making another REST call with filter parameters. I understand I would probably need to write an event handler for the OnSearchChange event, and I have this bit of code to get the search text entered:
List := Sender as TListView;
for I := 0 to List.Controls.Count-1 do
if List.Controls[I].ClassType = TSearchBox then
begin
SearchBox := TSearchBox(List.Controls[I]);
break;
end;
And I think I need to set the Items.Filter property, and I used this bit of code:
Lower := LowerCase(SearchBox.Text.Trim);
List.Items.Filter :=
function(X: string): Boolean
begin
Result:= (Lower = EmptyStr) or LowerCase(X).Contains(Lower);
end;
One of the problems is that the ListView component is applying its filtering as soon as a character is typed, while the OnSearchChange event only fires when the searchbox loses focus.
The second problem is that, even after the event is fired and the new filter function set, nothing happens to the list.
I've confirmed that the List.Items collection in my "36" example does actually contain all 6 items - the 3 header items and the 3 detail items - so I'm unsure why the filter is not applying to the header items as it does the detail items.
I tried this out and found a solution. Keep in mind I don't have access to Delphi 10.3 Rio. I'm using 10.1 Berlin. Also keep in mind that what I usually do is bind in the code and not visually. But for this I stuck to visual binding.
As a dataset I have used a TFDMemoryTable (mt1) with 2 data fields (fmt1Prod and fmt1Stage) and 1 calculated field (fmt1Search). I have the following handler to calculate the Search field:
Procedure TForm2.mt1CalcFields(DataSet: TDataSet);
Begin
fmt1Search.AsString := fmt1Prod.AsString + '|' + fmt1Stage.AsString;
End;
I put some random data in the memory table OnFormCreate:
Procedure TForm2.FormCreate(Sender: TObject);
Var
i1, i2: Integer;
s1, s2: String;
Begin
mt1.CreateDataSet;
For i1 := 1 To 13 Do Begin
s1 := 'Prod' + FormatFloat('00', i1);
For i2 := Random(6) To Random(14) Do Begin
s2 := 'Stage' + FormatFloat('00', i2);
mt1.Append;
fmt1Prod.AsString := s1;
fmt1Stage.AsString := s2;
mt1.Post;
End;
End;
End;
I have put on Form2 a TGrid and a TListView. Both are bound to the dataset. Data and calculated fields show up properly in the TGrid (just to check).
The TListView is bound to the dataset as follows:
Synch <-> *
ItemHeader.Text <- Prod
ItemHeader.Break <- Prod
Item.Text <- Search
Item.Detail <- Stage
I did this because I cannot find a way to have the TListView searchbox work on anything but the Text of the items. Ok then... but this can be worked around though:
Set TListView.ItemAppeance to Custom
Find the TListView/ItemAppearance/Item/Text object in the structure and set Visible to False
Find the TListView/ItemAppearance/Item/Detail object in the structure and set Visible to True
I'm not sure all of the above is necessary, but it works. If your TListView is editable then you will probably need to fiddle with the ItemEditAppearance too.
Remember that with custom item appearance you can actually set the list view items to look just about anyway you want. You can add and remove labels, images and other things. It's not as powerful as designing a form, but you can do a lot with it. But all you really need here is to hide the search text and show the stage text somewhere in the item.
And... for more sophisticated item appearance you may have to do some code binding (non sure of this though).
If use bind visually and ItemAppearance (Dynamic Appearance) you can one column from data source assign to header and text item (visible = false). In this situation in header and item we have the same value and search work fine.

How to fix 'Unable to find record. No key specified'?

I'am using a firebird 2.5 server to write in a Database file(BD.fbd). My delphi XE8 project has a Data module(DMDados) with:
SQLConnection (conexao)
TSQLQUery1 (QueryBDPortico_Inicial) + TDataSetProvider1 (DSP_BDPortico_Inicial) + TClientDataSet1 (cdsBDPortico_Inicial)
TSQLQUery2 (QueryConsulta) (just for use SQL strings)
My database file has this table:
PORTICO_INICIAL
The table has these fields (all integer):
NPORTICO
ELEMENTO
ID
None of those fields are primary keys because I will have repeated values in some cases. The connection with the file is ok. The client data set is open when I run the code. The TSQLQUery2 (QueryConsulta) is open when needed.
My code, when triggered by a button, has to delete all tables' records (if exist) then full the table with integer numbers created by a LOOP.
In the first try the code just work fine, but when I press the button the second time i get the error 'Unable to find record. No key specified' then when I check the records the table is empty.
I tried to change the ProviderFlags of my query but this make no difference. I checked the field names, the table name or some SQL text error but find nothing.
My suspect is that when my code delete the records the old values stay in memory then when try apply updates with the new values the database use the old values to find the new record's place therefore causing this error.
procedure monta_portico ();
var
I,K,L,M, : integer;
begin
with DMDados do
begin
QUeryCOnsulta.SQL.Text := 'DELETE FROM PORTICO_INICIAL;';
QueryConsulta.ExecSQL();
K := 1;
for I := 1 to 10 do
begin
L := I*100;
for M := 1 to 3 do
begin
cdsBDPortico_Inicial.Insert;
cdsBDPortico_Inicial.FieldbyName('NPORTICO').AsInteger :=
M+L;
cdsBDPortico_Inicial.FieldbyName('ELEMENTO').AsInteger := M;
cdsBDPortico_Inicial.ApplyUpdates(0);
K := K +1;
end;
end;
end;
end;
I want that every time I use the code above it first delete all records in the table then fill it again with the loop.
When I use the code for the first time it do what I want but in the second time it just delete the records and can not fill the table with the values.
Update I've added some example code below. Also, when I wrote the original version of this answer, I'd forgotten that one of the TDataSetProvider Options is
poAllowMultiRecordUpdates, but I'm not sure that's involved in your problem.
The error message Unable to find record. No key specified is generated by the DataSetProvider, so isn't directly connected to your
QUeryCOnsulta.SQL.Text := 'DELETE FROM PORTICO_INICIAL;'
because that bypasses the DataSetProvider. The error is coming from an failed attempt to ApplyUpdates on the CDS. Try changing your call to it to
Assert(cdsBDPortico_Inicial.ApplyUpdates(0) = 0);
That will show you when the error occurs because the return result of ApplyUpdates gives the number of errors that occurred when calling it.
You say
will have repeated values in some cases
If that's true when the problem occurs, it's because you are hitting a fundamental limitation in the way a DataSetProvider works. To apply the updates on the source dataset, it has to generate SQL to send back to the source dataset (TSqlQuery1) which uniquely identifies the row to update in the source data, which is impossible if the source dataset contains duplicated rows.
Basically, you need to re-think your code so that the source dataset rows are all unique. Once you've done that, setting the DSP's UpdateMode to upWhereAll should avoid the problem. It would be best for the source dataset to have a primary key, of course.
A quick work-around would be to use CDS.Locate in the loop where you insert the records, to see if it can locate an already-existing record with the values you're about to add.
Btw, sorry for raising the point about the ProviderFlags. It's irrelevant if there are duplicated rows, because whatever they are set to, the DSP will still fail to update a single record.
In case it helps, here is some code which might help populating your table
in a way which avoids getting duplicates. It only populates the first two
columns, as in the code you show in your q.
function RowExists(ADataset : TDataSet; FieldNames : String; Values : Variant) : Boolean;
begin
Result := ADataSet.Locate(FieldNames, Values, []);
end;
procedure TForm1.PopulateTable;
var
Int1,
Int2,
Int3 : Integer;
i : Integer;
RowData : Variant;
begin
CDS1.IndexFieldNames := 'Int1;Int2';
for i := 1 to 100 do begin
Int1 := Round(Random(100));
Int2 := Round(Random(100));
RowData := VarArrayOf([Int1, Int2]);
if not RowExists(CDS1, 'Int1;Int2', RowData) then
CDS1.InsertRecord([Int1, Int2]);
end;
CDS1.First;
Assert(CDS1.ApplyUpdates(0) = 0);
end;
Splite the problem into small parties using functions and procedures
create an instance of TSqlQuery Execute the SQL statment's and destroy the instance when you finish with it...
procedure DeleteAll;
var
Qry: TSqlQuery;
begin
Qry := TSqlQuery.Create(nil);
try
Qry.SqlConnection := DMDados.conexao;
Qry.Sql.Text := 'DELETE FROM PORTICO_INICIAL;';
Qry.ExecSql;
finally
Qry.Free;
end;
end;
your can even execute directly from TSQlConnection with one line...
DMDados.conexao.ExecuteDirect('DELETE FROM PORTICO_INICIAL;')
procedure monta_portico ();
var
I,K,L,M, : integer;
begin
with DMDados do
begin
DeleteAll;
K := 1;
for I := 1 to 10 do
begin
L := I*100;
for M := 1 to 3 do
begin
cdsBDPortico_Inicial.Insert;
cdsBDPortico_Inicial.FieldbyName('NPORTICO').AsInteger :=
M+L;
cdsBDPortico_Inicial.FieldbyName('ELEMENTO').AsInteger := M;
cdsBDPortico_Inicial.ApplyUpdates(0);
K := K +1;
end;
end;
end;
end;
Just few obvervations, cause the primary answers were given, but they not deal with the secondary problems.
cdsBDPortico_Inicial.FieldbyName('NPORTICO').AsInteger :=
FieldByName is slow function - it is linear search over objects array with uppercased string comparison over each one. You better only call it once for every field, not do it again in again in the loop.
cdsBDPortico_Inicial.ApplyUpdates(0);
Again, applying updates is relatively slow - it requires roundtrip to the server all through internal guts of DataSnap library, why so often?
BTW, you delete rows from SQL table - but where do you delete rows from cdsBDPortico_Inicial ??? I do not see that code.
Was I in your shows I would write something like that (granted I am not big fan of Datasnap and CDS):
procedure monta_portico ();
var
Qry: TSqlQuery;
_p_EL, _p_NP: TParam;
Tra: TDBXTransaction;
var
I,K,L,M, : integer;
begin
Tra := nil;
Qry := TSqlQuery.Create(DMDados.conexao); // this way the query would have owner
try // thus even if I screw and forget to free it - someone eventually would
Qry.SqlConnection := DMDados.conexao;
Tra := Qry.SqlConnection.BeginTransaction;
// think about making a special function that would create query
// and set some its properties - like connection, transaction, preparation, etc
// so you would not repeat yourself again and again, risking mistyping
Qry.Sql.Text := 'DELETE FROM PORTICO_INICIAL'; // you do not need ';' for one statement, it is not script, not a PSQL block here
Qry.ExecSql;
Qry.Sql.Text := 'INSERT INTO PORTICO_INICIAL(NPORTICO,ELEMENTO) '
+ 'VALUES (:NP,:EL)';
Qry.Prepared := True;
_p_EL := Qry.ParamByName('EL'); // cache objects, do not repeat linear searches
_p_NP := Qry.ParamByName('NP'); // for simple queries you can even do ... := Qry.Params[0]
K := 1;
for I := 1 to 10 do
begin
L := I*100;
for M := 1 to 3 do
begin
_p_NP.AsInteger := M+L;
_p_EL.AsInteger := M;
Qry.ExecSQL;
Inc(K); // why? you seem to never use it
end;
end;
Qry.SqlConnection.CommitFreeAndNil(tra);
finally
if nil <> tra then Qry.SqlConnection.RollbackFreeAndNil(tra);
Qry.Destroy;
end;
end;
This procedure does not populate cdsBDPortico_Inicial - but do you really need it?
If you do - maybe you can re-read it from the database: there could be other programs that added rows into the table too.
Or you can insert many rows and then apply them all in one command, before committing the transaction (often abreviated tx), but even then, do not call FieldByName more than once.
Also, think about logical blocks of your program work in advance, those very transactions, temporary TSQLQuery objects etc.
However boring and tedious it is now, you would bring yourself many more spaghetti trouble if you don't. Adding this logic retroactively after you have many small functions calling one another in unpredictable order is very hard.
Also, if you make Firebird server auto-assigning the ID field (and your program does not need any special values in ID and will be ok with Firebird-made values) then the following command might server yet better for you: INSERT INTO PORTICO_INICIAL(NPORTICO,ELEMENTO) VALUES (:NP,:EL) RETURNING ID

Changing steps in a graph made with cxGrid

I have a graph made with cxGrid from DevExpress and on the X axis I have a date
But when there is a lot of data in the graph these dates are cut to just 2 or 4 digits
How can I change it so the X axis only show text at every 5 or 10 values?
You should implement paging into your application. You can do that by overriding OnDataChanged and OnFilterRecord of your grid's ChartView.DataController:
aChartView.DataController.OnDataChanged := cvChartDataControllerDataChanged;
aChartView.DataController.OnFilterRecord := cvChartDataControllerFilterRecord;
The point is to use OnFilterRecord to display just a limited amount of records at a time. That makes your chart presentable, otherwise you get too many data points. The most important one is OnFilterRecord. Here's an example:
procedure TSomeGrid.cvChartDataControllerFilterRecord(ADataController: TcxCustomDataController; ARecordIndex: Integer; var Accept: Boolean);
begin
// inspect the number of all records
FNoOfRecords := ADataController.RecordCount;
//FStartRecordNo and FEndRecordNo are relative to the FCurrentPageNo
//calculated elsewhere OnDataChanged
if FCurrentPageNo > 0 then
Accept := (ARecordIndex >= FStartRecordNo) and (ARecordIndex <= FEndRecordNo)
else
Accept := ARecordIndex < FMaxChartRecords;
end;

How not to add duplicate into TVirtualStringTree?

I have two VirtualStringTrees, first VST has been populated with data and I want to check the second VST and add nodes that are not already in the first VST. Or I want to add those nodes from second VST that are not duplicates of first VST.
procedure Tcreatevtform.copy2tosimvt(vt: Tvirtualstringtree);
var
data: PMyRec;
simvtdata: PMyRectF;
rootnode, simvtnode: PVirtualNode;
ty: string;
begin
rootnode := vt.GetFirst; //vt is second virtualstringtree
while Assigned(rootnode) do
begin
data := vt.GetNodeData(rootnode);
ty := data^.caption;
if checksimduplicate(ty)=false then
begin
simvtnode := similarvt.AddChild(nil); //similarvt is the first virtualstringtree
simvtdata := similarvt.GetNodeData(simvtnode);
simvtdata^.caption := data^.caption;
end;
rootnode := vt.GetNext(rootnode,false);
end;
end;
function Tcreatevtform.checksimduplicate(t: string): boolean;
var
data: PMyRectf;
rootnode: PVirtualNode;
typew: string;
begin
Result := False;
rootnode := similarvt.GetFirst;
while Assigned(rootnode) do
begin
data := similarvt.GetNodeData(rootnode);
typew := data^.caption; // problem here, typew is always a constant or it is always the first
if t=typew then
begin
// node's caption of vt (letter 'a' is the first node's caption in my
// app. So this function is always false.
Result := True;
Break;
end;
similarvt.GetNext(rootnode, False);
end;
end;
I am using D7.
Finding all items that are in one list but not a second can be done easily with a list comparison algorithm. Here's the basic idea:
Sort both lists
Take 2 index variables, one for each list, and start at the start of each list
Compare the two indexed items from each list according to the sort order.
If they're equal, then the same item is in both lists. Increment both indexes.
If the first item is less than the second one, then it's not in the second list. Increment the first index.
If the second item is less than the first one, then it's not in the first list. Increment the second index.
Repeat until you reach the end of one of the lists. All remaining items in the other list are not in the first list.
You can add actions to the equals case or either the first-unique or second-unique case to determine what to do in these cases. In your specific case, you'll want to make the second-unique case add an item to the VST. It might get more complicated if you have to preserve tree structure, but that's the basic idea.

TVirtualStringTree - resetting non-visual nodes and memory consumption

I have an app that loads records from a binary log file and displays them in a virtual TListView. There are potentially millions of records in a file, and the display can be filtered by the user, so I do not load all of the records in memory at one time, and the ListView item indexes are not a 1-to-1 relation with the file record offsets (List item 1 may be file record 100, for instance). I use the ListView's OnDataHint event to load records for just the items the ListView is actually interested in. As the user scrolls around, the range specified by OnDataHint changes, allowing me to free records that are not in the new range, and allocate new records as needed.
This works fine, speed is tolerable, and the memory footprint is very low.
I am currently evaluating TVirtualStringTree as a replacement for the TListView, mainly because I want to add the ability to expand/collapse records that span multiple lines (I can fudge it with the TListView by incrementing/decrementing the item count dynamically, but this is not as straight forward as using a real tree).
For the most part, I have been able to port the TListView logic and have everything work as I need. I notice that TVirtualStringTree's virtual paradigm is vastly different, though. It does not have the same kind of OnDataHint functionality that TListView does (I can use the OnScroll event to fake it, which allows my memory buffer logic to continue working), and I can use the OnInitializeNode event to associate nodes with records that are allocated.
However, once a tree node is initialized, it sees that it remains initialized for the lifetime of the tree. That is not good for me. As the user scrolls around and I remove records from memory, I need to reset those non-visual nodes without removing them from the tree completely, or losing their expand/collapse states. When the user scrolls them back into view, I can re-allocate the records and re-initialize the nodes. Basically, I want to make TVirtualStringTree act as much like TListView as possible, as far as its virtualization is concerned.
I have seen that TVirtualStringTree has a ResetNode() method, but I encounter various errors whenever I try to use it. I must be using it wrong. I also thought of just storing a data pointer inside each node to my record buffers, and I allocate and free memory, update those pointers accordingly. The end effect does not work so well, either.
Worse, my largest test log file has ~5 million records in it. If I initialize the TVirtualStringTree with that many nodes at one time (when the log display is unfiltered), the tree's internal overhead for its nodes takes up a whopping 260MB of memory (without any records being allocated yet). Whereas with the TListView, loading the same log file and all the memory logic behind it, I can get away with using just a few MBs.
Any ideas?
You probably shouldn't switch to VST unless you have a use for at least some of the nice features of VST that a standard listbox / listview don't have. But there is of course a large memory overhead compared to a flat list of items.
I don't see a real benefit in using TVirtualStringTree only to be able to expand and collapse items that span multiple lines. You write
mainly because I want to add the ability to expand/collapse records that span multiple lines (I can fudge it with the TListView by incrementing/decrementing the item count dynamically, but this is not as straight forward as using a real tree).
but you can implement that easily without changing the item count. If you set the Style of the listbox to lbOwnerDrawVariable and implement the OnMeasureItem event you can adjust the height as required to draw either only the first or all lines. Drawing the expander triangle or the little plus symbol of a tree view manually should be easy. The Windows API functions DrawText() or DrawTextEx() can be used both to measure and draw the (optionally word-wrapped) text.
Edit:
Sorry, I completely missed the fact that you are using a listview right now, not a listbox. Indeed, there is no way to have rows with different heights in a listview, so that's no option. You could still use a listbox with a standard header control on top, but that may not support everything you are using now from listview functionality, and it may itself be as much or even more work to get right than dynamically showing and hiding listview rows to simulate collapsing and expanding.
If I understand it correctly, the memory requirement of TVirtualStringTree should be:
nodecount * (SizeOf(TVirtualNode) + YourNodeDataSize + DWORD-align-padding)
To minimize the memory footprint, you could perhaps initialize the nodes with only pointers to offsets to a memory-mapped file. Resetting nodes which have already been initialized doesn't seem necessary in this case - the memory footprint should be nodecount * (44 + 4 + 0) - for 5 million records, about 230 MB.
IMHO you can't get any better with the tree but using a memory-mapped file would allow you to read the data directly from the file without allocating even more memory and copying the data to it.
You could also consider using a tree structure instead of a flat view to present the data. That way you could initialize child nodes of a parent node on demand (when the parent node is expanded) and resetting the parent node when it's collapsed (therefore freeing all its child nodes). In other words, try not to have too many nodes at the same level.
To meet your requirement "to expand/collapse records that span multiple lines", I'd simply use a drawgrid. To check it out, drag a drawgrid onto a form, then plug in the following Delphi 6 code. You can collapse and expand 5,000,000 multiline records (or whatever quantity you want) with essentially no overhead. It's a simple technique, doesn't require much code, and works surprisingly well.
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) &lt (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 &lt> 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.
You shouldn't use ResetNode because this method invokes InvalidateNode and initializes node again, leading to opposite effect than expected.
I don't know if it's possible to induce VST to free memory size specified in NodeDataSize without actually removing node. But why not set NodeDataSize to size of Pointer ( Delphi, VirtualStringTree - classes (objects) instead of records ) and manage data yourself? Just an idea...
Give "DeleteChildren" a try. Here's what this procedure's comment says:
// Removes all children and their children from memory without changing the vsHasChildren style by default.
Never used it, but as I read it, you can use that in the OnCollapsed event to free the memory allocated to nodes that just became invisible. And then re-generate those nodes in OnExpading so the user never knows the node went away from memory.
But I can't be sure, I never had a need for such behaviour.

Resources