uses
  Winapi.ShlObj, Vcl.Themes, Winapi.UxTheme, VirtualTrees, VirtualTrees.Utils;

type
  TVirtualStringTree = class(VirtualTrees.TVirtualStringTree)
  end;

procedure ColorBlend(Canvas: TCanvas; const Rect: TRect; BlendColor: TColor; BlendValue: Integer);
var
  Bitmap: TBitmap;
begin
  if VirtualTrees.MMXAvailable then
    VirtualTrees.Utils.AlphaBlend(0, Canvas.Handle, Rect, Rect.TopLeft, bmConstantAlphaAndColor,
      BlendValue, ColorToRGB(BlendColor))
  else
  begin
    Bitmap := TBitmap.Create;
    try
      Bitmap.Canvas.Brush.Color := BlendColor;
      Bitmap.SetSize(Rect.Width, Rect.Height);
      Bitmap.Canvas.FillRect(Rect);
      Canvas.Draw(Rect.Left, Rect.Top, Bitmap, BlendValue);
    finally
      Bitmap.Free;
    end;
  end;
end;

procedure TForm1.VirtualStringTree1AdvancedHeaderDraw(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements);
var
  R: TRect;
  Tree: TVirtualStringTree;
  Theme: HTHEME;
  Alpha: Integer;
  Color: TColor;
  State: Integer;
  Details: TThemedElementDetails;
  RightBorderFlag: Cardinal;
  NormalButtonStyle: Cardinal;
  NormalButtonFlags: Cardinal;
  PressedButtonStyle: Cardinal;
  PressedButtonFlags: Cardinal;
  RaisedButtonStyle: Cardinal;
  RaisedButtonFlags: Cardinal;

  procedure PrepareButtonStyles;
  begin
    RaisedButtonStyle := 0;
    RaisedButtonFlags := 0;
    case Sender.Style of
      hsThickButtons:
      begin
        NormalButtonStyle := BDR_RAISEDINNER or BDR_RAISEDOUTER;
        NormalButtonFlags := BF_LEFT or BF_TOP or BF_BOTTOM or BF_MIDDLE or BF_SOFT or BF_ADJUST;
        PressedButtonStyle := BDR_RAISEDINNER or BDR_RAISEDOUTER;
        PressedButtonFlags := NormalButtonFlags or BF_RIGHT or BF_FLAT or BF_ADJUST;
      end;
      hsFlatButtons:
      begin
        NormalButtonStyle := BDR_RAISEDINNER;
        NormalButtonFlags := BF_LEFT or BF_TOP or BF_BOTTOM or BF_MIDDLE or BF_ADJUST;
        PressedButtonStyle := BDR_SUNKENOUTER;
        PressedButtonFlags := BF_RECT or BF_MIDDLE or BF_ADJUST;
      end;
    else
      begin
        NormalButtonStyle := BDR_RAISEDINNER;
        NormalButtonFlags := BF_RECT or BF_MIDDLE or BF_SOFT or BF_ADJUST;
        PressedButtonStyle := BDR_SUNKENOUTER;
        PressedButtonFlags := BF_RECT or BF_MIDDLE or BF_ADJUST;
        RaisedButtonStyle := BDR_RAISEDINNER;
        RaisedButtonFlags := BF_LEFT or BF_TOP or BF_BOTTOM or BF_MIDDLE or BF_ADJUST;
      end;
    end;
  end;

begin
  if hpeBackground in Elements then
  begin
    R := PaintInfo.PaintRectangle;
    Tree := TVirtualStringTree(Sender.Treeview);

    // if there is no column assigned, the header background is painted
    if not Assigned(PaintInfo.Column) then
    begin
      Alpha := 40;
      Color := clLime;

      // let VCL Styles draw the stuff by themselves
      if (Tree.VclStyleEnabled and (seClient in Tree.StyleElements)) then
      begin
        Details := StyleServices.GetElementDetails(thHeaderItemRightNormal);
        StyleServices.DrawElement(PaintInfo.TargetCanvas.Handle, Details, R, @R);
      end
      else
      // otherwise, if themes are enabled for the tree, then...
      if tsUseThemes in Tree.TreeStates then
      begin
        // paint the themed header background
        Theme := OpenThemeData(Tree.Handle, 'HEADER');
        DrawThemeBackground(Theme, PaintInfo.TargetCanvas.Handle, HP_HEADERITEM, HIS_NORMAL, R, nil);
        CloseThemeData(Theme);
        // and alpha blend a colored rectangle over it
        ColorBlend(PaintInfo.TargetCanvas, R, Color, Alpha);
      end
      else
      // otherwise just fill the rectangle
      begin
        PaintInfo.TargetCanvas.Brush.Color := Sender.Background;
        PaintInfo.TargetCanvas.FillRect(R);
      end;
    end
    else
    // header plate is painted
    begin
      Alpha := 80;
      Color := $000080FF;

      // let VCL Styles draw the stuff by themselves
      if Tree.VclStyleEnabled and (seClient in Tree.StyleElements) then
      begin
        if PaintInfo.IsDownIndex then
          Details := StyleServices.GetElementDetails(thHeaderItemPressed)
        else
        if PaintInfo.IsHoverIndex then
          Details := StyleServices.GetElementDetails(thHeaderItemHot)
        else
          Details := StyleServices.GetElementDetails(thHeaderItemNormal);
        StyleServices.DrawElement(PaintInfo.TargetCanvas.Handle, Details, R, @R);
      end
      else
      begin
        // themes are enabled for the tree, so...
        if tsUseThemes in Tree.TreeStates then
        begin
          // paint the themed header plate
          Theme := OpenThemeData(Tree.Handle, 'HEADER');
          if PaintInfo.IsDownIndex then
            State := HIS_PRESSED
          else
          if PaintInfo.IsHoverIndex then
            State := HIS_HOT
          else
            State := HIS_NORMAL;
          DrawThemeBackground(Theme, PaintInfo.TargetCanvas.Handle, HP_HEADERITEM, State, R, nil);
          CloseThemeData(Theme);
          // and alpha blend a colored rectangle over it
          ColorBlend(PaintInfo.TargetCanvas, R, Color, Alpha);
        end
        else
        begin
          // draw non-themed plate
          PrepareButtonStyles;

          if PaintInfo.ShowRightBorder or (PaintInfo.Column.Index < Sender.Columns.Count - 1) then
            RightBorderFlag := BF_RIGHT
          else
            RightBorderFlag := 0;

          if PaintInfo.IsDownIndex then
            DrawEdge(PaintInfo.TargetCanvas.Handle, R, PressedButtonStyle, PressedButtonFlags)
          else
          if (Sender.Style = hsPlates) and PaintInfo.IsHoverIndex and (coAllowClick in PaintInfo.Column.Options) and
            (coEnabled in PaintInfo.Column.Options)
          then
            DrawEdge(PaintInfo.TargetCanvas.Handle, R, RaisedButtonStyle, RaisedButtonFlags or RightBorderFlag)
          else
            DrawEdge(PaintInfo.TargetCanvas.Handle, R, NormalButtonStyle, NormalButtonFlags or RightBorderFlag);
        end;
      end;
    end;
  end;
end;

procedure TForm1.VirtualStringTree1HeaderDrawQueryElements(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements);
begin
  Elements := [hpeBackground];
end;