不确定它是否完全正确，但它给出了良好的结果：

procedure VSTBeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
  R: TRect;
  RectArr:Array of TRect;
  NodeLevel,i,k:Integer;
  ArrayColors:Array[0..6] of Tcolor ;
begin
 NodeLevel:=Sender.GetNodeLevel(Node);
  if CellPaintMode = cpmPaint then
  begin
  if Column=0 then
   begin
    R := CellRect;

    setlength(RectArr,NodeLevel+2);
    RectArr[Length(RectArr)-1]:=Rect(r.Left+node.NodeHeight*(NodeLevel+1)-Node.NodeHeight,r.Top,r.Right,r.Bottom);
    for i := 0 to Length(RectArr)-2 do
    RectArr[i]:=Rect(r.Left+Node.NodeHeight*(i-1),r.Top,r.Left+Node.NodeHeight*i+Node.NodeHeight,r.Bottom);
      ArrayColors[0]:= $0000F9FF;
      ArrayColors[1] := $0000BFFF;
      ArrayColors[2]:= $000086FF;
      ArrayColors[3] := ClLime;
      ArrayColors[4] := Clred;
      ArrayColors[5] := clSkyBlue;
      ArrayColors[6]:= clGrayText;

    for I := 0 to Length(RectArr)-1 do
    begin
    K:=i-1;
    if k<0 then    k:=0;

    TargetCanvas.Brush.Color:=ArrayColors[k];
    TargetCanvas.FillRect(RectArr[i]);
    end;
   end else
       begin
       case Sender.GetNodeLevel(Node) of
       0: TargetCanvas.Brush.Color := $0000F9FF;
       1: TargetCanvas.Brush.Color := $0000BFFF;
       2: TargetCanvas.Brush.Color := $000086FF;
       3:TargetCanvas.Brush.Color := ClLime;
       4:TargetCanvas.Brush.Color := Clred;
       5:TargetCanvas.Brush.Color := clSkyBlue ;
       6:TargetCanvas.Brush.Color := clGrayText ;
       end;
       TargetCanvas.FillRect(CellRect);
       end;
  end;

end;

结果：