TVirtualStringTree 中的图标异常绘制

Question

这是一个非常小的重现问题的项目（VirtualStringTree 版本 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包含ImageList，里面只有一个图标。完毕。现在我们可以运行程序并在将鼠标光标移动到图标上时出现异常：

异常 class EAssertionFailed 消息 'An image index was supplied for TVTImageKind.ikState but no image list was supplied. (C:\Program Files\VirtualTreeView\Source\VirtualTrees.pas, line 20248)'。进程 Project1.exe (3232)

如您所见，我没有使用 StateImages 和 OnGetImageIndexEx。为什么这个？这是来自第 12635

行的 VirtualTrees 代码

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;

此代码忽略 Kind 参数。该参数可以具有此枚举中的值之一：

TVTImageKind = (
  ikNormal,
  ikSelected,
  ikState,
  ikOverlay
);

如果您return ikState 的值，那么您必须还提供了状态图像。这就是错误消息告诉您的内容。我猜你的事件处理程序应该像这样区分：

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;

TVirtualStringTree 中的图标异常绘制

Icons in TVirtualStringTree painted with exception

delphi

virtualtreeview

tvirtualstringtree

delphi-10.1-berlin