Search code examples
delphidelphi-10.1-berlinvirtualtreeviewtvirtualstringtree

Icons in TVirtualStringTree painted with exception


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);

Solution

  • 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;