[SOLVED] VirtualTreeview - row colour when row is checked

[JD]

Hi there everyone,

I'm have a virtualtreeview with nodes having checkboxes. I want to paint the font of the entire row red when the node is checked and black when it is unchecked. I put the code below in the virtualtreeview's OnChecking event but it does not seem to work.

Code: Pascal  [Select][+][-]

1. procedure TfrmMain.VST1Checking(
2.   Sender: TBaseVirtualTree; Node: PVirtualNode; var NewState: TCheckState;
3.   var Allowed: Boolean);
4. begin
5.   if (NewState = csCheckedNormal) or (NewState = csCheckedPressed) then
6.     (Sender as TBaseVirtualTree).Canvas.Font.Color :=  clRed
7.   else
8.     (Sender as TBaseVirtualTree).Canvas.Font.Color :=  clBlack;
9.   //
10.   VST1.Refresh;
11. end;
12.  

It works if I use a listview and put the code into the listview's AdvancedCustomDrawItem event.

Since I'm in the process of replacing ListView with VirtualTreeView, I would appreciate your assistance.


Thanks a lot,

JD

[balazsszekely]

Use the OnPaintText event.

[JD]

Use the OnPaintText event.

Thanks for your reply GetMem. I added the following code (in the OnInitNode and OnPaintText events) to your last example to add checkboxes to the nodes in the tree.

Code: Pascal  [Select][+][-]

1. procedure TForm1.ATreeInitNode(Sender: TBaseVirtualTree; ParentNode,
2.   Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
3. var
4.   Level: integer;
5. begin
6.   Level := ATree.GetNodeLevel(Node);
7.  
8.   if Level = 0 then
9.     Node^.CheckType := ctCheckBox;
10. end;
11.  
12. procedure TForm1.ATreePaintText(Sender: TBaseVirtualTree;
13.   const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
14.   TextType: TVSTTextType);
15. begin
16.   if Sender.CheckState[Node] = csCheckedNormal then
17.         Sender.Canvas.Font.Color := clRed
18.   else
19.         Sender.Canvas.Font.Color := clBlack;
20.   Sender.Refresh;
21. end;
22.  

Unfortunately, it still does not seem to work. I tested it in Linux Mint 18.3 just to be sure (see screenshot)

JD

[taazz]

Code: Pascal  [Select][+][-]

1. procedure TEvsTaskListFrame.vstTaskTreePaintText(Sender : TBaseVirtualTree;
2.   const TargetCanvas : TCanvas; Node : PVirtualNode; Column : TColumnIndex;
3.   TextType : TVSTTextType);
4. var
5.   vTask : TEvsTask;
6.   //vTmp  : TProgressBar;
7. begin
8.   if TextType = ttStatic then TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsBold]
9.   else begin
10.     vTask := TaskFromNode(Node);
11.     TargetCanvas.Font.Color := clWindowText;
12.     TargetCanvas.Font.Style := [];
13.     if TVirtualStringTree(Sender).Header.Columns[Column].Tag = clmTitle then begin
14.       if {(vTask.SubTasks.Count > 0) and} (Sender.GetNodeLevel(Node) < 1 ) then TargetCanvas.Font.Style := [fsBold];
15.       if Assigned(vTask) and vTask.Completed then begin
16.         TargetCanvas.Font.Color := clGrayText;
17.         if vTask.Checked then TargetCanvas.Font.Style := TargetCanvas.font.Style +[fsStrikeOut]-[fsBold];
18.       end
19.     end
20.   end;
21. end;
22.  

[balazsszekely]

Code: Pascal  [Select][+][-]

1. procedure TForm1.ATreePaintText(Sender: TBaseVirtualTree;
2.   const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
3.   TextType: TVSTTextType);
4. begin
5.   if TextType = ttNormal then
6.   begin
7.     if (TBaseVirtualTree(Sender).CheckState[Node] = csCheckedNormal) or (TBaseVirtualTree(Sender).CheckState[Node] = csMixedNormal) then
8.     begin
9.       TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
10.       TargetCanvas.Font.Color := TBaseVirtualTree(Sender).Font.Color;
11.     end
12.     else if TBaseVirtualTree(Sender).CheckState[Node] = csUncheckedNormal then
13.     begin
14.       TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsBold];
15.       TargetCanvas.Font.Color := TBaseVirtualTree(Sender).Font.Color;
16.     end;
17.   end;
18. end;

csMixedNormal is for nodes that has multiple child and only a subset is checked. I use Node^.CheckType := ctTriStateCheckBox .

[JD]

Prefect! Thanks a lot you both of you (taazz & GetMem).

@taazz Your code actually solves a problem I was having elsewhere. Both of you helped me to kill 2 birds with one stone! 

I have to confess, for me, VirtualTreeView has to be the best free control in Lazarus. The BGRA control set comes next. Users demand lots of GUI special effects these days so they really come in handy for me.

Cheers,

JD