How to let TVirtualStringTree to display an icon in disabled state?

How to let TVirtualStringTree to display an icon in disabled state?

procedure TfrmMain.tvSharesAfterItemPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect);
var
rImage: TRect;
OffsetLeft: Integer;
begin
rImage  := ItemRect;

with TVirtualStringTree(Sender) do begin
if (toShowRoot in TreeOptions.PaintOptions) then
OffsetLeft := Indent * (GetNodeLevel(Node) + 1)
else
OffsetLeft := Indent * GetNodeLevel(Node);

Inc(rImage.Left, Margin + OffsetLeft);
Inc(rImage.Top, (NodeHeight[Node] - Images.Height) div 2);
rImage.Right  := rImage.Left + Images.Width;
rImage.Bottom := rImage.Top + Images.Height;
end;

// draw the "normal" or "disabled" icon here
imageList.Draw(TargetCanvas, rImage.left, rImage.Top, ...);
end;
end;

I've suggested this as a new feature

code from this post

PaintImage

OnCustomDrawImage

DrawOverlay

DrawOverlay

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DateUtils, StdCtrls, VirtualTrees, ImgList, CommCtrl;

type
TCustomDrawImageEvent = procedure(Sender: TBaseVirtualTree; Node: PVirtualNode;
ImageList: TCustomImageList; ImageIndex: Integer; TargetCanvas: TCanvas;
X, Y: Integer; Style: Cardinal; DrawEnabled: Boolean; DrawOverlay: Boolean;
var CustomDraw: Boolean) of object;

TVirtualStringTree = class(VirtualTrees.TVirtualStringTree)
private
FOnCustomDrawImage: TCustomDrawImageEvent;
protected
function DoCustomDrawImage(Node: PVirtualNode; ImageList: TCustomImageList;
ImageIndex: Integer; TargetCanvas: TCanvas; X, Y: Integer; Style: Cardinal;
DrawEnabled: Boolean; DrawOverlay: Boolean): Boolean; virtual;
procedure PaintImage(var PaintInfo: TVTPaintInfo; ImageInfoIndex: TVTImageInfoIndex;
DoOverlay: Boolean); override;
published
property OnCustomDrawImage: TCustomDrawImageEvent read FOnCustomDrawImage write FOnCustomDrawImage;
end;

type
TForm1 = class(TForm)
VirtualStringTree1: TVirtualStringTree;
ImageList1: TImageList;
procedure FormCreate(Sender: TObject);
procedure VirtualStringTree1GetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
private
procedure VirtualTreeCustomDrawImage(Sender: TBaseVirtualTree; Node: PVirtualNode;
ImageList: TCustomImageList; ImageIndex: Integer; TargetCanvas: TCanvas;
X, Y: Integer; Style: Cardinal; DrawEnabled: Boolean; DrawOverlay: Boolean;
var CustomDraw: Boolean);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TVirtualStringTree }

type
TCustomImageListCast = class(TCustomImageList);

function TVirtualStringTree.DoCustomDrawImage(Node: PVirtualNode;
ImageList: TCustomImageList; ImageIndex: Integer; TargetCanvas: TCanvas; X,
Y: Integer; Style: Cardinal; DrawEnabled: Boolean; DrawOverlay: Boolean): Boolean;
begin
Result := False;
if Assigned(FOnCustomDrawImage) then
FOnCustomDrawImage(Self, Node, ImageList, ImageIndex, TargetCanvas, X, Y,
Style, DrawEnabled, DrawOverlay, Result);
end;

procedure TVirtualStringTree.PaintImage(var PaintInfo: TVTPaintInfo;
ImageInfoIndex: TVTImageInfoIndex; DoOverlay: Boolean);
var
CutNode: Boolean;
ExtraStyle: Cardinal;
DrawEnabled: Boolean;
PaintFocused: Boolean;
const
Style: array[TImageType] of Cardinal = (0, ILD_MASK);
begin
with PaintInfo do
begin
CutNode := (vsCutOrCopy in Node.States) and (tsCutPending in TreeStates);
PaintFocused := Focused or (toGhostedIfUnfocused in TreeOptions.PaintOptions);
if DoOverlay then
GetImageIndex(PaintInfo, ikOverlay, iiOverlay, Images)
else
PaintInfo.ImageInfo[iiOverlay].Index := -1;
DrawEnabled := not (vsDisabled in Node.States) and Enabled;
with ImageInfo[ImageInfoIndex] do
begin
if (vsSelected in Node.States) and not (Ghosted or CutNode) then
begin
if PaintFocused or (toPopupMode in TreeOptions.PaintOptions) then
Images.BlendColor := Colors.FocusedSelectionColor
else
Images.BlendColor := Colors.UnfocusedSelectionColor;
end
else
Images.BlendColor := Color;
if (ImageInfo[iiOverlay].Index > -1) and (ImageInfo[iiOverlay].Index < 15) then
ExtraStyle := ILD_TRANSPARENT or ILD_OVERLAYMASK and
IndexToOverlayMask(ImageInfo[iiOverlay].Index + 1)
else
ExtraStyle := ILD_TRANSPARENT;
if (toUseBlendedImages in TreeOptions.PaintOptions) and PaintFocused
and (Ghosted or ((vsSelected in Node.States) and
not (toFullRowSelect in TreeOptions.SelectionOptions) and
not (toGridExtensions in TreeOptions.MiscOptions)) or CutNode)
then
ExtraStyle := ExtraStyle or ILD_BLEND50;
if (vsSelected in Node.States) and not Ghosted then
Images.BlendColor := clDefault;

// in this modified part of code, the new event OnCustomDrawImage
// is fired once before the image is actually drawn and once when
// the overlay is to be drawn; when you keep its CustomDraw param
// in False value (what is, by default), the default drawing will
// be done otherwise you need to take care of drawing by yourself

// draw image default way when the CustomDraw parameter of the new
// OnCustomDrawImage event remains False (what is, by default)
if not DoCustomDrawImage(Node, Images, Index, Canvas, XPos, YPos,
Style[Images.ImageType] or ExtraStyle, DrawEnabled, False)
then
TCustomImageListCast(Images).DoDraw(Index, Canvas, XPos, YPos,
Style[Images.ImageType] or ExtraStyle, DrawEnabled);
// draw overlay default way when the CustomDraw parameter of the new
// OnCustomDrawImage event remains False (what is, by default)
if PaintInfo.ImageInfo[iiOverlay].Index >= 15 then
begin
if not DoCustomDrawImage(Node, ImageInfo[iiOverlay].Images,
ImageInfo[iiOverlay].Index, Canvas, XPos, YPos,
Style[ImageInfo[iiOverlay].Images.ImageType] or ExtraStyle,
DrawEnabled, True)
then
TCustomImageListCast(ImageInfo[iiOverlay].Images).DoDraw(
ImageInfo[iiOverlay].Index, Canvas, XPos, YPos,
Style[ImageInfo[iiOverlay].Images.ImageType] or ExtraStyle,
DrawEnabled);
end;
end;
end;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
VirtualStringTree1.OnCustomDrawImage := VirtualTreeCustomDrawImage;
end;

type
TImageListDrawParams = record
cbSize: DWORD;
himl: HIMAGELIST;
i: Integer;
hdcDst: HDC;
x: Integer;
y: Integer;
cx: Integer;
cy: Integer;
xBitmap: Integer;
yBitmap: Integer;
rgbBk: COLORREF;
rgbFg: COLORREF;
fStyle: UINT;
dwRop: DWORD;
fState: DWORD;
Frame: DWORD;
crEffect: COLORREF;
end;

procedure DrawDisabledImage(DC: HDC; ImageList: TCustomImageList; Index, X,
Y: Integer);
var
Options: TImageListDrawParams;
begin
FillChar(Options, SizeOf(Options), 0);
Options.cbSize := SizeOf(Options);
Options.himl := ImageList.Handle;
Options.i := Index;
Options.hdcDst := DC;
Options.x := X;
Options.y := Y;
Options.fState := ILS_SATURATE;
ImageList_DrawIndirect(@Options);
end;

procedure TForm1.VirtualStringTree1GetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
begin
ImageIndex := 0;
end;

procedure TForm1.VirtualTreeCustomDrawImage(Sender: TBaseVirtualTree;
Node: PVirtualNode; ImageList: TCustomImageList; ImageIndex: Integer;
TargetCanvas: TCanvas; X, Y: Integer; Style: Cardinal; DrawEnabled: Boolean;
DrawOverlay: Boolean; var CustomDraw: Boolean);
begin
CustomDraw := True;
if not DrawOverlay then
DrawDisabledImage(TargetCanvas.Handle, ImageList, ImageIndex, X, Y);
end;

end.