Icons in TVirtualStringTree mit Ausnahme gemalt

Question

Das ist sehr kleines Projekt, das Problem (VirtualStringTree Version 6.5) zu reproduzieren:

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; 

Formular Abbildungsliste, die nur ein Symbol enthalten enthält. Erledigt. Jetzt können wir das Programm ausführen und eine Exception erhalten, wenn wir den Mauscursor über das Icon bewegen:

Exception-Klasse EAssertionFailed mit Nachricht 'Ein Image-Index wurde für TVTImageKind.ikState bereitgestellt, aber es wurde keine Image-Liste bereitgestellt. (C: \ Programme \ VirtualTreeView \ Source \ VirtualTrees.pas, Zeile 20248) '. Prozess Project1.exe (3232)

Wie Sie sehen können, verwende ich nicht StateImages und OnGetImageIndexEx. Warum das? Dies ist von VirtualTrees Code auf der Linie 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; 

Dieser Code ignoriert das Kind Argument. Dieses Argument kann einen der Werte aus dieser Aufzählung haben:

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

Wenn Sie einen Wert für ikState dann zurückkehren müssen Sie auch zur Verfügung gestellt Zustand Bilder haben. Das sagt Ihnen die Fehlermeldung. Ich schätze, dass Ihr Event-Handler so diskriminieren sollte:

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;