Forum > Packages and Libraries

[Resolved] Virtual Treerview - I don't get it running

(1/3) > >>

Nimral:
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  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Buttons,  VirtualTrees; type  { TStudyRec }  TStudyRecType = (srUser, srStudy);  TStudyRec = record    case RecType: TStudyRecType of      srUser: (        UserID: integer;        UserPaCoCode: string[10];        UserStudyCode: string[20];        UserName: string[255];      );      srStudy: (        StudyID: integer;        StudyCode: string[20];        StudyName: string[255];      );  end;  PStudyRec = ^TStudyRec; type   { TForm1 }   TForm1 = class(TForm)    Panel1: TPanel;    SpeedButtonAddStudy: TSpeedButton;    SpeedButtonAddUser: TSpeedButton;    SpeedButtonDelNode: TSpeedButton;    SpeedButtonDelTree: TSpeedButton;    StudyStringTree: TVirtualStringTree;    procedure SpeedButtonAddStudyClick(Sender: TObject);    procedure SpeedButtonAddUserClick(Sender: TObject);    procedure SpeedButtonDelNodeClick(Sender: TObject);    procedure SpeedButtonDelTreeClick(Sender: TObject);    procedure StudyStringTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;      TextType: TVSTTextType; var CellText: string);    procedure StudyStringTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;      var InitialStates: TVirtualNodeInitStates);  private    FNextStudyID: Integer;    FNextUserID: Integer;    function GetNextStudyID: Integer;    function GetNextUserID: Integer;  public    property NextStudyID:Integer read GetNextStudyID default 1;    property NextUserID: Integer read GetNextUserID default 1;    procedure FormCreate(Sender: TObject);  end; var  Form1: TForm1; implementation {$R *.lfm} function SelectText(Condition: boolean; TrueValue, FalseValue: string): string; Overload; begin  if Condition then    Result := TrueValue  else    Result := FalseValue;end; function SelectText(Condition: boolean; TrueValue, FalseValue: integer): string; Overload; begin  if Condition then    Result := IntToStr(TrueValue)  else    Result := IntToStr(FalseValue);end; function RandomString(StringLength:Integer):ShortString; var  i:integer; begin  Result := '';  for i := 1 to StringLength do     Result := Result + chr(ord(' ')+random(ord('z')-ord(' ')+1));end; { TForm1 } function TForm1.GetNextStudyID: Integer;begin  Result := FNextStudyID;  Inc(FNextStudyID);end; function TForm1.GetNextUserID: Integer;begin  Result := FNextUserID;  Inc(FNextUserID);end; procedure TForm1.StudyStringTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;  TextType: TVSTTextType; var CellText: string); var  n: PStudyRec;  rec:TStudyRec; begin  n := StudyStringTree.GetNodeData(Node);  rec := n^;  case Column of    0: CellText := SelectText(rec.RecType = srStudy, rec.StudyID, rec.UserID);    1: Celltext := SelectText(rec.RecType = srStudy, rec.StudyCode, rec.UserPaCoCode);    2: Celltext := SelectText(rec.RecType = srStudy, rec.StudyName, rec.UserName);    else Celltext := SelectText(rec.RecType = srStudy, '', rec.UserStudyCode);  end;end; procedure TForm1.SpeedButtonAddStudyClick(Sender: TObject); begin  StudyStringTree.RootNodeCount := StudyStringTree.RootNodeCount + 1;end; procedure TForm1.SpeedButtonAddUserClick(Sender: TObject); var  node : PVirtualNode; begin  node := StudyStringTree.FocusedNode;  if assigned(node) and (StudyStringTree.GetNodeLevel(node) = 0) then     StudyStringTree.ChildCount[node] := StudyStringTree.ChildCount[node] + 1;end; procedure TForm1.SpeedButtonDelNodeClick(Sender: TObject); var  n : PVirtualNode; begin  for n in StudyStringTree.SelectedNodes do     StudyStringTree.DeleteNode(n);end; procedure TForm1.SpeedButtonDelTreeClick(Sender: TObject);begin  StudyStringTree.RootNodeCount:=0;end; procedure TForm1.StudyStringTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;  var InitialStates: TVirtualNodeInitStates); var  n: PStudyRec;  rec:TStudyRec;  begin  n := StudyStringTree.GetNodeData(Node);  rec := n^;  if StudyStringTree.GetNodeLevel(Node) = 0 then //root  begin    rec.RecType := srStudy;    rec.StudyID := NextStudyID;    rec.StudyCode := 'TS-' + RandomString(3);    rec.StudyName := 'A very interesting topic: ' + rec.StudyCode;  end  else  begin    rec.RecType := srUser;    rec.UserID := NextUserID;    rec.UserPaCoCode := 'PC' + RandomString(4);    rec.UserStudyCode := RandomString(10);    rec.UserName := Format('My valued user #%d',[rec.UserID]);  end;end; procedure TForm1.FormCreate(Sender: TObject); begin  StudyStringTree.NodeDataSize := SizeOf(TStudyRec);end; end.  

egsuh:
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:
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?

Zvoni:
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  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---TStudyRecType = (srUser, srStudy);TStudyRec = record   ID: integer;          Code: string[20];  Description: string[255];  PaCoCode: string[10];  //If srStudy --> blank, if srUser --> something useful  RecType: TStudyRecType;end; 
And then test if your VTV still mangles the entries

El Salvador:
And the method TForm1.FormCreate() must be private and linked to Form1.OnCreate (see objectinspector, tab events). Right now, the method is not fired.

Navigation

[0] Message Index

[#] Next page

Go to full version