Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   VST 0tes Item / Node löschen führt nicht zum gewünschten Ergebnis [Fehler gefunden] (https://www.delphipraxis.net/200720-vst-0tes-item-node-loeschen-fuehrt-nicht-zum-gewuenschten-ergebnis-%5Bfehler-gefunden%5D.html)

DieDolly 18. Mai 2019 22:01


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 15:48 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz