Recent

Author Topic: [Resolved] Virtual Treerview - I don't get it running  (Read 1622 times)

Nimral

  • Full Member
  • ***
  • Posts: 178
  • Keep it simple.
[Resolved] Virtual Treerview - I don't get it running
« on: April 30, 2021, 10:58:35 am »
Help, please.

I have been struggling with this component for almost 4 days now, my nerves are down to 0 as my teeth are from gritting, I cannot get even the basic things running. Please, anyone, look at the attached rather small test project source whether you find anything I could not find in 4 days.

The demos encluded in the TreeView package sources are running.

Environment: Lazarus 2.0.12 x32, Windows 10x64, VirtualTreeView from https://github.com/blikblum/VirtualTreeView-Lazarus/releases/tag/lazarus-5.5.3-R2.

Source may look a bit strange, I added some code for debugging and did tests with and without columns. The results are always desastrous: adding nodes seems to work in the tree, but the payload record gets mangled, adding children or deleting a node leads to SIGSEV, IMHO the heap gets corrupted.

Thanks, Armin.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Buttons,
  9.   VirtualTrees;
  10.  
  11. type
  12.   { TStudyRec }
  13.   TStudyRecType = (srUser, srStudy);
  14.   TStudyRec = record
  15.     case RecType: TStudyRecType of
  16.       srUser: (
  17.         UserID: integer;
  18.         UserPaCoCode: string[10];
  19.         UserStudyCode: string[20];
  20.         UserName: string[255];
  21.       );
  22.       srStudy: (
  23.         StudyID: integer;
  24.         StudyCode: string[20];
  25.         StudyName: string[255];
  26.       );
  27.   end;
  28.   PStudyRec = ^TStudyRec;
  29.  
  30. type
  31.  
  32.   { TForm1 }
  33.  
  34.   TForm1 = class(TForm)
  35.     Panel1: TPanel;
  36.     SpeedButtonAddStudy: TSpeedButton;
  37.     SpeedButtonAddUser: TSpeedButton;
  38.     SpeedButtonDelNode: TSpeedButton;
  39.     SpeedButtonDelTree: TSpeedButton;
  40.     StudyStringTree: TVirtualStringTree;
  41.     procedure SpeedButtonAddStudyClick(Sender: TObject);
  42.     procedure SpeedButtonAddUserClick(Sender: TObject);
  43.     procedure SpeedButtonDelNodeClick(Sender: TObject);
  44.     procedure SpeedButtonDelTreeClick(Sender: TObject);
  45.     procedure StudyStringTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
  46.       TextType: TVSTTextType; var CellText: string);
  47.     procedure StudyStringTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
  48.       var InitialStates: TVirtualNodeInitStates);
  49.   private
  50.     FNextStudyID: Integer;
  51.     FNextUserID: Integer;
  52.     function GetNextStudyID: Integer;
  53.     function GetNextUserID: Integer;
  54.   public
  55.     property NextStudyID:Integer read GetNextStudyID default 1;
  56.     property NextUserID: Integer read GetNextUserID default 1;
  57.     procedure FormCreate(Sender: TObject);
  58.   end;
  59.  
  60. var
  61.   Form1: TForm1;
  62.  
  63. implementation
  64.  
  65. {$R *.lfm}
  66.  
  67. function SelectText(Condition: boolean; TrueValue, FalseValue: string): string; Overload;
  68.  
  69. begin
  70.   if Condition then
  71.     Result := TrueValue
  72.   else
  73.     Result := FalseValue;
  74. end;
  75.  
  76. function SelectText(Condition: boolean; TrueValue, FalseValue: integer): string; Overload;
  77.  
  78. begin
  79.   if Condition then
  80.     Result := IntToStr(TrueValue)
  81.   else
  82.     Result := IntToStr(FalseValue);
  83. end;
  84.  
  85. function RandomString(StringLength:Integer):ShortString;
  86.  
  87. var
  88.   i:integer;
  89.  
  90. begin
  91.   Result := '';
  92.   for i := 1 to StringLength do
  93.      Result := Result + chr(ord(' ')+random(ord('z')-ord(' ')+1));
  94. end;
  95.  
  96. { TForm1 }
  97.  
  98. function TForm1.GetNextStudyID: Integer;
  99. begin
  100.   Result := FNextStudyID;
  101.   Inc(FNextStudyID);
  102. end;
  103.  
  104. function TForm1.GetNextUserID: Integer;
  105. begin
  106.   Result := FNextUserID;
  107.   Inc(FNextUserID);
  108. end;
  109.  
  110. procedure TForm1.StudyStringTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
  111.   TextType: TVSTTextType; var CellText: string);
  112.  
  113. var
  114.   n: PStudyRec;
  115.   rec:TStudyRec;
  116.  
  117. begin
  118.   n := StudyStringTree.GetNodeData(Node);
  119.   rec := n^;
  120.   case Column of
  121.     0: CellText := SelectText(rec.RecType = srStudy, rec.StudyID, rec.UserID);
  122.     1: Celltext := SelectText(rec.RecType = srStudy, rec.StudyCode, rec.UserPaCoCode);
  123.     2: Celltext := SelectText(rec.RecType = srStudy, rec.StudyName, rec.UserName);
  124.     else Celltext := SelectText(rec.RecType = srStudy, '', rec.UserStudyCode);
  125.   end;
  126. end;
  127.  
  128. procedure TForm1.SpeedButtonAddStudyClick(Sender: TObject);
  129.  
  130. begin
  131.   StudyStringTree.RootNodeCount := StudyStringTree.RootNodeCount + 1;
  132. end;
  133.  
  134. procedure TForm1.SpeedButtonAddUserClick(Sender: TObject);
  135.  
  136. var
  137.   node : PVirtualNode;
  138.  
  139. begin
  140.   node := StudyStringTree.FocusedNode;
  141.   if assigned(node) and (StudyStringTree.GetNodeLevel(node) = 0) then
  142.      StudyStringTree.ChildCount[node] := StudyStringTree.ChildCount[node] + 1;
  143. end;
  144.  
  145. procedure TForm1.SpeedButtonDelNodeClick(Sender: TObject);
  146.  
  147. var
  148.   n : PVirtualNode;
  149.  
  150. begin
  151.   for n in StudyStringTree.SelectedNodes do
  152.      StudyStringTree.DeleteNode(n);
  153. end;
  154.  
  155. procedure TForm1.SpeedButtonDelTreeClick(Sender: TObject);
  156. begin
  157.   StudyStringTree.RootNodeCount:=0;
  158. end;
  159.  
  160. procedure TForm1.StudyStringTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
  161.   var InitialStates: TVirtualNodeInitStates);
  162.  
  163. var
  164.   n: PStudyRec;
  165.   rec:TStudyRec;
  166.  
  167.  
  168. begin
  169.   n := StudyStringTree.GetNodeData(Node);
  170.   rec := n^;
  171.   if StudyStringTree.GetNodeLevel(Node) = 0 then //root
  172.   begin
  173.     rec.RecType := srStudy;
  174.     rec.StudyID := NextStudyID;
  175.     rec.StudyCode := 'TS-' + RandomString(3);
  176.     rec.StudyName := 'A very interesting topic: ' + rec.StudyCode;
  177.   end
  178.   else
  179.   begin
  180.     rec.RecType := srUser;
  181.     rec.UserID := NextUserID;
  182.     rec.UserPaCoCode := 'PC' + RandomString(4);
  183.     rec.UserStudyCode := RandomString(10);
  184.     rec.UserName := Format('My valued user #%d',[rec.UserID]);
  185.   end;
  186. end;
  187.  
  188. procedure TForm1.FormCreate(Sender: TObject);
  189.  
  190. begin
  191.   StudyStringTree.NodeDataSize := SizeOf(TStudyRec);
  192. end;
  193.  
  194. end.
  195.  
  196.  
« Last Edit: May 03, 2021, 01:47:26 pm by Nimral »
Lazarus 2.0.12 & 2.3.0  (trunk) on Windows 10, Raspberry Pi OS "Buster", macOS Catalina, macOS BigSur, VMWare Workstation 15

egsuh

  • Hero Member
  • *****
  • Posts: 791
Re: Virtual Treerview - I don't get it running
« Reply #1 on: April 30, 2021, 11:19:41 am »
Your program runs on my PC without any problem, except the title or texts are not fully shown. There are too many blank strings. Other than that, it runs OK and there are no memory leakages.  Windows 10 --- Lazarus version 2.0.12.

Nimral

  • Full Member
  • ***
  • Posts: 178
  • Keep it simple.
Re: Virtual Treerview - I don't get it running
« Reply #2 on: April 30, 2021, 11:41:00 am »
This is what it does on mine, whenever I make a new Treeview project. If I do, however, modify the "Minimal" demo, it works.

WTF?
« Last Edit: April 30, 2021, 11:54:53 am by Nimral »
Lazarus 2.0.12 & 2.3.0  (trunk) on Windows 10, Raspberry Pi OS "Buster", macOS Catalina, macOS BigSur, VMWare Workstation 15

Zvoni

  • Hero Member
  • *****
  • Posts: 627
Re: Virtual Treerview - I don't get it running
« Reply #3 on: April 30, 2021, 01:21:58 pm »
At a guess? It's your variant record

sidenote: i try to avoid variant records whereever possible

In your case: Why not just this way?
Code: Pascal  [Select][+][-]
  1. TStudyRecType = (srUser, srStudy);
  2. TStudyRec = record
  3.   ID: integer;        
  4.   Code: string[20];
  5.   Description: string[255];
  6.   PaCoCode: string[10];  //If srStudy --> blank, if srUser --> something useful
  7.   RecType: TStudyRecType;
  8. end;
  9.  

And then test if your VTV still mangles the entries
One System to rule them all, One IDE to find them,
One Code to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------
People call me crazy, because i'm jumping out of perfectly fine aircraft

El Salvador

  • Jr. Member
  • **
  • Posts: 58
Re: Virtual Treerview - I don't get it running
« Reply #4 on: April 30, 2021, 01:23:47 pm »
And the method TForm1.FormCreate() must be private and linked to Form1.OnCreate (see objectinspector, tab events). Right now, the method is not fired.

eny

  • Hero Member
  • *****
  • Posts: 1625
Re: Virtual Treerview - I don't get it running
« Reply #5 on: April 30, 2021, 02:54:53 pm »
The design paradigm behind VTV is that (ideally) you separate the data from its presentation.
In your example you build a data structure (TStudyRec) to hold the data that needs to be presented.
Effectively mixing the two.

What I always do is build a separate data structure that holds the data (an array, an object list etc.) and only put a reference/pointer/index-number to the data in the VTV node data record. That makes populating the VTV much easier and cleaner and makes it easier to manage your data properly.
Something like:
Code: Pascal  [Select][+][-]
  1.   TStudyData = class(TObject)
  2.     userid: integer;
  3.     name: string;
  4.     ....
  5.   end;
  6.   // Some data collection object
  7.   TStudyDataList = <array of TStudyData> or <TFPObjectList of TStudyData> etc...  
  8.  
  9.   // And then for the VTV node: only a reference to the source data
  10.   TNodeData = record
  11.     data: TStudyData;
  12.   end;
  13.   PNodeData = ^TNodeData;
  14.  
All posts based on: Win10 (Win64); Lazarus 2.0.10 'stable' (x64) unless specified otherwise...

BasicOne

  • New Member
  • *
  • Posts: 10
Re: Virtual Treerview - I don't get it running
« Reply #6 on: April 30, 2021, 05:07:56 pm »
I think the lines

  n := StudyStringTree.GetNodeData(Node);
  rec := n^;

are not good in the StudyStringTreeInitNode() procedure:

  • in the first line, you get a pointer to a memory managed by the VirtualTreeView with  GetNodeData(Node)
  • in the second line, you copy the content of this memory to the local memory of rec that is not under control of the TreeView
  • in the following code, you fill the local variable rec
  • this local variable memory will be lost when you leave the procedure
  • the VirtualTreeView will still use it's own memory that was not modified by your code and likely contains some random data

I think that for assigning the node values, you have to modify the memory managed by TreeView directly, e.g. by assigning

n^.RecType:=srStudy

instead of

rec.RecType:=srStudy

As already mentioned earlier by eny, the best usage of VirtualTreeView would be to manage and store the data independently and only write some kind of index to the pointer given with GetNodeData(). This also facilitates e.g. the display of the same data set at several nodes of the same VirtualTreeView or even several VirtualTreeViews.
« Last Edit: April 30, 2021, 05:14:40 pm by BasicOne »

egsuh

  • Hero Member
  • *****
  • Posts: 791
Re: Virtual Treerview - I don't get it running
« Reply #7 on: April 30, 2021, 05:45:57 pm »
I agree with BasicOne's opinion. Record type is different from object/class.  In rec := n^, rec has separate memory block in the function's stack memory and copies the content of n^ to rec's memory position. The tree may be still pointing to n^ memory.

Nimral

  • Full Member
  • ***
  • Posts: 178
  • Keep it simple.
Re: Virtual Treerview - I don't get it running
« Reply #8 on: May 03, 2021, 01:45:52 pm »
My bad, I didn't pay enough attention to what El Salavdor's keen eyes have detected :-)

The sole problem is that, somehow, the form create method slipped into the public part, and thus got never called, so NodeDataSize was never properly set, which caused the heap corruption problems later.

I found the problem this morning, had I payed more attention to El Salvador's statement ...

The variant record is not related to the problem in any way.

Sorry for the distraction regarding the "rec" variable, I introduced it during troubleshooting, and forgot to remove it, it made things worse, but was not related to the original problem too.

Thank for your help,

Armin.
« Last Edit: May 03, 2021, 02:16:41 pm by Nimral »
Lazarus 2.0.12 & 2.3.0  (trunk) on Windows 10, Raspberry Pi OS "Buster", macOS Catalina, macOS BigSur, VMWare Workstation 15

lucamar

  • Hero Member
  • *****
  • Posts: 4176
Re: Virtual Treerview - I don't get it running
« Reply #9 on: May 03, 2021, 03:03:20 pm »
The sole problem is that, somehow, the form create method slipped into the public part, and thus got never called, so NodeDataSize was never properly set, which caused the heap corruption problems later.

I found the problem this morning, had I payed more attention to El Salvador's statement ...

Actually he's also wrong: FormCreate() should be up with the other event handlers in what is to all effects a published section; if you used the Object Inspector to add it, it should be there and assigned to OnCreate through the form's persistence mechanism.
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus/FPC 2.0.8/3.0.4 & 2.0.12/3.2.0 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

Nimral

  • Full Member
  • ***
  • Posts: 178
  • Keep it simple.
Re: [Resolved] Virtual Treerview - I don't get it running
« Reply #10 on: May 05, 2021, 11:48:11 am »
I am pretty sure, when I created the test project FormCreate *was* in the published section, and I accidentially did something which moved it into public. Point is that it was existing, but never called, and I failed to notice this for days (!), beeing preoccupied that the problem must be elsewhere.
Lazarus 2.0.12 & 2.3.0  (trunk) on Windows 10, Raspberry Pi OS "Buster", macOS Catalina, macOS BigSur, VMWare Workstation 15

 

TinyPortal © 2005-2018