Forum > Packages and Libraries
[Resolved] Virtual Treerview - I don't get it running
ArminLinder:
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.
ArminLinder:
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