![]() |
VST 0tes Item / Node löschen führt nicht zum gewünschten Ergebnis [Fehler gefunden]
Ich baue auf einem Code aus dem Forum auf. Der Code ist zu 99% von hier. Was ich hinzugefügt habe ist das Löschen eines Eintrags in der FMyDataClasses Liste.
Sobald ich den Eintrag 0 löschen möchte, gehen im VST scheinbar alle Daten verloren. Eintrag 1 kann ich löschen. Child Items werden scheinbar auch nicht gelöscht. Also ganz komisch irgendwie. Fehler gefunden! Vor dem List Delete() muss vst1.Clear; aufgerufen werden. Wenn man das 0te Item nicht so löschen kann, wie dann?
Delphi-Quellcode:
unit Unit1;
interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Generics.Collections, VirtualTrees, Vcl.StdCtrls; type TMyDataClass = class(TObject) ID: Integer; Name: string; HasChildren: Boolean; NodeColor: TColor; end; PMyDataClass = ^TMyDataClass; TMyDataClasses = TObjectList<TMyDataClass>; TForm1 = class(TForm) vst1: TVirtualStringTree; btnCreate1MioObjects: TButton; btnCreate100TObjects: TButton; lblObjectDuration: TLabel; lblNodeDuration: TLabel; Button1: TButton; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure vst1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure vst1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); procedure vst1InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); procedure vst1PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); procedure btnCreate100TObjectsClick(Sender: TObject); procedure btnCreate1MioObjectsClick(Sender: TObject); procedure Button1Click(Sender: TObject); private {Private-Deklarationen} FMyDataClasses: TMyDataClasses; procedure CreateSomeObjects(const ACount: Integer); public {Public-Deklarationen} end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.btnCreate1MioObjectsClick(Sender: TObject); begin CreateSomeObjects(1000000); end; procedure TForm1.btnCreate100TObjectsClick(Sender: TObject); begin CreateSomeObjects(2); end; procedure TForm1.Button1Click(Sender: TObject); begin FMyDataClasses.Delete(0); // LÖSCHE DEN ERSTEN EINTRAG - SCHLÄGT FEHL vst1.RootNodeCount := FMyDataClasses.Count; end; procedure TForm1.CreateSomeObjects(const ACount: Integer); var i: Integer; Data: TMyDataClass; Start: Cardinal; begin Start := GetTickCount; vst1.Clear; FMyDataClasses.Clear; for i := 0 to ACount - 1 do begin Data := TMyDataClass.Create; Data.ID := i + 1; Data.Name := 'DataObject ' + IntToStr(i + 1); Data.HasChildren := True; Data.NodeColor := Random($FFFFFF); FMyDataClasses.Add(Data); // Hier die erzeugten Objekte zwischenspeichern end; lblObjectDuration.Caption := 'Dauer Object Erstellung: ' + IntToStr(GetTickCount - Start) + 'ms'; Start := GetTickCount; vst1.RootNodeCount := ACount; lblNodeDuration.Caption := 'Dauer Node Erstellung: ' + IntToStr(GetTickCount - Start) + 'ms'; end; procedure TForm1.FormCreate(Sender: TObject); begin Randomize; FMyDataClasses := TMyDataClasses.Create(True); // Owns Objects auf true, damit beim Freigeben der Liste auch die darin enthaltenen Objekte automatisch freigegeben werden end; procedure TForm1.FormDestroy(Sender: TObject); begin FMyDataClasses.Free; end; procedure TForm1.vst1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); var NodeData: TMyDataClass; begin if (vst1.GetNodeLevel(Node) = 0) then begin NodeData := Node.GetData<TMyDataClass>; CellText := NodeData.Name; end else CellText := 'SubItem ' + IntToStr(Node^.Index + 1); end; procedure TForm1.vst1InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); begin ChildCount := 2; end; procedure TForm1.vst1InitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); var NodeData: TMyDataClass; begin Node.SetData<TMyDataClass>(FMyDataClasses[Node.Index]); NodeData := Node.GetData<TMyDataClass>; if (vst1.GetNodeLevel(Node) = 0) then begin // Nur auf dem ersten NodeLevel Children zulassen if (NodeData.HasChildren) then begin Include(InitialStates, ivsHasChildren); // Hier wird im Status der Node vermerkt, dass die Node mindestens 1 ChildNode hat und das + Symbol angezeigt werden soll end; end; end; procedure TForm1.vst1PaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); var NodeData: TMyDataClass; begin NodeData := Node.GetData<TMyDataClass>; if (vst1.GetNodeLevel(Node) = 0) then begin TargetCanvas.Font.Color := NodeData.NodeColor; end; end; end. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:12 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz