How to paint the background color in special level in TVirtualStringTree

Question

I try to paint a hightline text using backgroundcolor in all sepecial level of VirtualStringTree. It look like a selected nodes for all same level. The code below doesn't work. Please someone give a direction.

procedure TMainForm.Tree1PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);
var  Data: PNodeData;LEVEL:INTEGER;  tree1node,tree4Node: PVirtualNode;
begin 
    Data := Tree1.GetNodeData(Node);
    Level := tree1.GetNodeLevel(node);

 case column of
     0:begin
        if Level = 0 then BEGIN
               TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
               TargetCanvas.Font.Color :=CLyellow;
               targetcanvas.Brush.Color :=clgreen;//don't work
               targetcanvas.Brush.Style :=bssolid;     

             END;
            if  Level = 1 then BEGIN
                  TargetCanvas.Font.Color :=CLaqua; 
                  targetcanvas.Brush.Color :=clgreen;
            end;
       end;

Victoria · Accepted Answer · 2018-04-01T13:13:25.217

5

VT fills the cell background sooner, in the PrepareCell method to be more specific. So it's too late for attempts to setup the canvas brush. Try to fill the node rectangle from the OnBeforeCellPaint event instead:

procedure TForm1.VirtualStringTree1BeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
  R: TRect;
begin
  if CellPaintMode = cpmPaint then
  begin
    R := Sender.GetDisplayRect(Node, Column, True, False, True);
    R.Offset(0, -R.Top);
    case Sender.GetNodeLevel(Node) of
      0: TargetCanvas.Brush.Color := $0000F9FF;
      1: TargetCanvas.Brush.Color := $0000BFFF;
      2: TargetCanvas.Brush.Color := $000086FF;
    end;
    TargetCanvas.FillRect(R);
  end;
end;

Preview:

edited Apr 01 '18 at 13:13

answered Apr 01 '18 at 03:12

Victoria

7,822
2
21
44

1

Congratulations on reaching 5k rep! :) – Andreas Rejbrand Apr 01 '18 at 13:35
@Victoria Thanks, just found the answer, couple of questions though: 1) Why to use an extra TRect? ContentRect is not good enough? 2) Ah no, need to check first – Molochnik Aug 01 '22 at 09:20
@Victoria Yes found, 'toFullRowSelect' completely clears all what has been drawn in OnBeforeCellPaint – Molochnik Aug 01 '22 at 10:29

score 2 · Answer 2 · answered Apr 01 '18 at 07:50

2

One way is to use eaColor as erase action in OnBeforeItemErase event:

procedure TMainForm.Tree1BeforeItemErase(Sender: TBaseVirtualTree; TargetCanvas: TCanvas;
          Node: PVirtualNode; ItemRect: TRect; var ItemColor: TColor; var EraseAction: TItemEraseAction);
begin
   if not Sender.Selected[Node] then begin
      case Sender.GetNodeLevel(Node) of
        0: ItemColor := clgreen;
        1: ItemColor := clAgua;
      end;
      EraseAction := eaColor;
   end;
end;

answered Apr 01 '18 at 07:50

ain

22,394
3
54
74

hi, i test the code.it can show the background color in different column. "itemcolor "seem only for fillrect all item . if fillrect only in text of item (exclude the space) ,how to improve?.thanks – u950321 Apr 01 '18 at 09:35
1

Yes, the ItemErase is for whole row (ie all columns), if you need more control you probably have to use custom draw. – ain Apr 01 '18 at 11:03

How to paint the background color in special level in TVirtualStringTree

2 Answers2