Icons in TVirtualStringTree painted with exception - delphi

Question

This is very small project to reproduce the problem (VirtualStringTree version 6.5):
type
TForm1 = class(TForm)
vstTest: TVirtualStringTree;
Images: TImageList;
procedure FormCreate(Sender: TObject);
procedure vstTestGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: string);
procedure vstTestGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex);
private
{ Private declarations }
public
{ Public declarations }
end;
PTestRec = ^TTestRec;
TTestRec = record
Col1: string;
Col2: string;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
var
Node: PVirtualNode;
Data: PTestRec;
begin
vstTest.Header.Columns.Add;
vstTest.Header.Columns.Add;
vstTest.Header.Options := vstTest.Header.Options + [hoVisible];
vstTest.Images := Images;
vstTest.NodeDataSize := SizeOf(TTestRec);
Node := vstTest.AddChild(nil);
Data := vstTest.GetNodeData(Node);
Data.Col1 := 'Col1';
Data.Col2 := 'Col2';
end;
procedure TForm1.vstTestGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex);
begin
if Column = 0 then
ImageIndex := 0;
end;
procedure TForm1.vstTestGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: string);
var
Data: PTestRec;
begin
Data := vstTest.GetNodeData(Node);
case Column of
0: CellText := Data.Col1;
1: CellText := Data.Col2;
end;
end;
Form contain ImageList, which contain only one icon. Done. Now we can run the program and get exception when moving mouse cursor over Icon:
Exception class EAssertionFailed with message 'An image index was supplied for TVTImageKind.ikState but no image list was supplied. (C:\Program Files\VirtualTreeView\Source\VirtualTrees.pas, line 20248)'. Process Project1.exe (3232)
As you can see I'm not use StateImages and OnGetImageIndexEx. Why this? This is from VirtualTrees code on the line 12635
WithStateImages := Assigned(FStateImages) or Assigned(OnGetImageIndexEx);

Answer 1

procedure TForm1.vstTestGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean;
var ImageIndex: TImageIndex);
begin
if Column = 0 then
ImageIndex := 0;
end;
This code ignores the Kind argument. That argument can have one of the values from this enumeration:
TVTImageKind = (
ikNormal,
ikSelected,
ikState,
ikOverlay
);
If you return a value for ikState then you must have also provided state images. That is what the error message is telling you. I guess that your event handler should discriminate like so:
procedure TForm1.vstTestGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean;
var ImageIndex: TImageIndex);
begin
case Kind of
ikNormal, ikSelected:
if Column = 0 then
ImageIndex := 0;
end;
end;