Recent

Author Topic: TReeView Multiline again  (Read 434 times)

Weitentaaal

  • Full Member
  • ***
  • Posts: 185
TReeView Multiline again
« on: April 12, 2021, 03:51:41 pm »
Hello Guys ..

So i got a Previous Topic about this Issue : https://forum.lazarus.freepascal.org/index.php/topic,53957.0.html
(Tought it would work because it did in my First Unit but not in my Second i worked on this the whole day and all i found out is how frustrating this is)

But this Time i have 2 Units with some TreeViews but on my First form it works and on my second it doesn't

I cant Figure out what i am doing wrong pls help.

Code :
1 Unit (Works Fine !!!)
Code: Pascal  [Select][+][-]
  1. //Adding Root //Called in FromCreate
  2.  
  3.   dbExecute(dbRegelung, 'SELECT * FROM RegelungAuswahl WHERE Ventilatorregelung = 1 and IsParent = 1 ORDER BY Ordnen');
  4.   If not dbRegelung.IsEmpty then begin
  5.     dbExecute(dbSprachen, 'SELECT * FROM Sprachen WHERE ID = ' + dbRegelung.FieldByName('BezID').AsString);
  6.  
  7.     //Root
  8.     XNode := VST.AddChild(Nil);
  9.     if VST.AbsoluteIndex(XNode) > -1 then begin
  10.        Data := VST.GetNodeData(Xnode);
  11.        Data^.Regelung := dbSprachen.FieldByName(FeldD).AsString;
  12.        Data^.Tag:= dbRegelung.FieldByName('ID').AsString;
  13.        VST.MultiLine[XNode] := True;
  14.     end;
  15.  
  16.     AddChilds(dbRegelung, XNode, VST, 'Ventilatorregelung');
  17.  
  18.     dbRegelung.Next;
  19.   end;
  20.  
  21.  
  22. Procedure AddChilds(var Recordset: TSQLQuery; Root : PVirtualNode; VST : TVirtualStringTree; Regelungsart : String);
  23. var
  24.    Node : PVirtualNode;
  25.    Data : PTreeData;
  26.    Query : TSQLQuery;
  27.    SplitString : Array of String;
  28.    i : Integer;
  29. begin
  30.   Query := TSQLQuery.Create(NIl);
  31.  
  32.   //Childs
  33.   dbExecute(Query, 'SELECT * FROM RegelungAuswahl WHERE '+Regelungsart+' = 1 and IsChild = 1 ORDER BY Ordnen ');
  34.   While not Query.EOF do begin
  35.      //Check if Child is Child of Root
  36.      SplitString := Query.FieldByName('ChildOF').AsString.Split(';');
  37.      For i := 0 to Length(SplitString) - 1 do begin
  38.         IF (SplitString[i] = Recordset.FieldByName('ID').AsString)then begin
  39.            dbExecute(dbSprachen, 'SELECT * FROM Sprachen WHERE ID = ' + Query.FieldByName('BezID').AsString);
  40.            Node := VST.AddChild(Root);
  41.            Data := VST.GetNodeData(Node);
  42.            Data^.Regelung := dbSprachen.FieldByName(FeldD).AsString;
  43.            Data^.Tag:= Query.FieldByName('ID').AsString;
  44.            VST.MultiLine[Node] := True;
  45.  
  46.            AddChilds(Query, Node, VST, Regelungsart);
  47.         end;
  48.      end;
  49.      Query.Next;
  50.   end;
  51.  
  52.   Query.Free;
  53. end;
  54.  
  55. procedure TRegCheckList.VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  56.   Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
  57. var
  58.   Data: PTreeData;
  59. begin
  60.   Data := VST.GetNodeData(Node);
  61.  
  62.   case Column of
  63.     0: CellText := Data^.Regelung;
  64.     1: CellText := Data^.Beschreibung;
  65.   end;
  66. end;
  67.  
  68. procedure TRegCheckList.VSTMeasureItem(Sender: TBaseVirtualTree;
  69.   TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer);
  70. begin
  71.   if Sender.MultiLine[Node] = True then
  72.   begin
  73.     TargetCanvas.Font := Sender.Font;
  74.     NodeHeight := VST.ComputeNodeHeight(TargetCanvas, Node, 0);
  75.   end;
  76. end;
  77.  

2Unit (Does Not Work !!! :( )
Code: Pascal  [Select][+][-]
  1. dbExecute(dbRegelung, 'SELECT * FROM RegelungTitan WHERE Basis = 1 ORDER BY Ordnen');
  2.   while not dbRegelung.EOF do begin
  3.     dbExecute(dbSprachen, 'SELECT * FROM Sprachen WHERE ID = ' + dbRegelung.FieldByName('BezID').AsString);
  4.  
  5.     //Root
  6.     XNode := VSTBasis.AddChild(Nil);
  7.     if VSTBasis.AbsoluteIndex(XNode) > -1 then begin
  8.        Data := VSTBasis.GetNodeData(Xnode);
  9.        Data^.Text := dbSprachen.FieldByName(FeldD).AsString;
  10.        Data^.Tag:= dbRegelung.FieldByName('ID').AsString;
  11.        VSTBasis.MultiLine[XNode] := True;
  12.     end;
  13.  
  14.     //Childs
  15.     IF dbRegelung.FieldByName('Beschreibungen').AsString <> '0'then begin
  16.        SplitString := dbRegelung.FieldByName('Beschreibungen').AsString.Split(';');
  17.  
  18.        For K := 0 to Length(SplitString) - 1 do begin
  19.           dbExecute(dbSprachen, 'SELECT * FROM Sprachen WHERE ID = ' + SplitString[K]);
  20.           Childs := VSTBasis.AddChild(XNode);
  21.           Data := VSTBasis.GetNodeData(Childs);
  22.           Data^.Text := dbSprachen.FieldByName(FeldD).AsString;
  23.           VSTBasis.MultiLine[Childs] := True;
  24.        end;
  25.     end;
  26.     dbRegelung.Next;
  27.   end;
  28.  
  29. procedure TfrmRegelung.VSTBasisGetText(Sender: TBaseVirtualTree;
  30.   Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  31.   var CellText: String);
  32. var
  33.   Data: PTreeData;
  34. begin
  35.   Data := VSTBasis.GetNodeData(Node);
  36.   case Column of
  37.     0: CellText := Data^.Text;
  38.   end;
  39. end;
  40.  
  41. procedure TfrmRegelung.VSTBasisMeasureItem(Sender: TBaseVirtualTree;
  42.   TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer);
  43. begin
  44.   if Sender.MultiLine[Node] = True then
  45.   begin
  46.     TargetCanvas.Font := Sender.Font;
  47.     NodeHeight := VSTBasis.ComputeNodeHeight(TargetCanvas, Node, -1);
  48.   end;
  49. end;
  50.  
  51.  
« Last Edit: April 12, 2021, 03:54:09 pm by Weitentaaal »
Lazarus: 2.0.6 x86_64-win64-win32/win64
FPC-Version: 3.0.4
Compiler Version: 3.2.0

GetMem

  • Hero Member
  • *****
  • Posts: 3355
Re: TReeView Multiline again
« Reply #1 on: April 13, 2021, 06:41:00 am »
Hi Weitentaaal,

It looks like you did not provide the column number in ComputeNodeHeight. In the second unit replace:
Code: Pascal  [Select][+][-]
  1. NodeHeight := VSTBasis.ComputeNodeHeight(TargetCanvas, Node, -1);
with
Code: Pascal  [Select][+][-]
  1. NodeHeight := VSTBasis.ComputeNodeHeight(TargetCanvas, Node, 0);

Weitentaaal

  • Full Member
  • ***
  • Posts: 185
Re: TReeView Multiline again
« Reply #2 on: April 13, 2021, 07:35:38 am »
Thanks GetMem, fixed it ... again  :-[

Should have paid more attention what those params are.
Lazarus: 2.0.6 x86_64-win64-win32/win64
FPC-Version: 3.0.4
Compiler Version: 3.2.0

 

TinyPortal © 2005-2018