VirtualTree, record и указатели.

[Человек_Борща]

Доброго времени!

В программе есть много VirtualTree(TVirtualStringTree) которые отображают разные данные.

Чтобы привести все в более нормальный вид, и минимальный размер памяти занимаемый данными в Node'ах, написал такое:

type
type
  TNodeDataType = (dtRouter,
    dtRouterItem,
    dtLocalItem,
    dtPrintTemplate
    );

  pNodeData = ^TNodeData;
  TNodeData = record
    DataType: TNodeDataType;
    Data: Pointer; // Ptr to data
  end;

DataType - указывает на какой тип данных указывает Ptr.

Вот так получаю содержимое ветки:

function NodeHaveObject(aTree: TVirtualStringTree; aNode: PVirtualNode;
  out Obj: TNodeData): Boolean;
var
  pData: pNodeData;
begin
  Result := False;
  if aNode = nil then
    Exit;
  pData := aTree.GetNodeData(aNode);
  Result := (pData <> nil) { and (pData^ is TNodeData) };
  if Result then
    Obj := pData^;
end;

Все получается, только как достать объект из

 Data: Pointer; // Ptr to data?

Что-то не фига не получается....

procedure TRoutersMgrForm.TreeGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var
  R: pRouter;
  ND: TNodeData;
begin
  If NodeHaveObject(Tree, Node, ND) then
  begin
    R := pRouter(ND.data); //pRouter => pRouter = ^TRouter;
    Case Column of
      0:
        CellText := R.DisplayName; //Access Violation
      1:
        CellText := R.Address;
      2:
        CellText := R.Username;
      3:
        CellText := R.Password;
    End;
  end;
end;

[Slym]

procedure TRoutersMgrForm.TreeGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var
  R: pRouter;
  ND: TNodeData;
begin
  If NodeHaveObject(Tree, Node, ND) then
  begin
    if ND.DataType<>dtRouter theb exit; //?
    R := pRouter(ND.data); //pRouter => pRouter = ^TRouter;
    Case Column of
      0:
        CellText := R^.DisplayName; //Access Violation
      1:
        CellText := R^.Address;
      2:
        CellText := R^.Username;
      3:
        CellText := R^.Password;
    End;
  end;
end;

[Человек_Борща]

Неа, указывает вообще на мусор..

procedure TRoutersMgrForm.TreeGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var
  Data: pNodeData;
  R: pRouter;
begin
  Data := Tree.GetNodeData(Node); //GetNodeData returns Pointer
   if Data^.Kind <> dkRouter then  //Почему-то всегда dkPrintTemplate
    Exit;
  R := Data^.P;
  Case Column of
    0:
      CellText := R^.DisplayName;   // Access Violation HERE
    1:
      CellText := R^.IP;
    2:
      begin
        If R.IsOnline then
          CellText := DM.GetTC(TC_ROUTER_STATUSSTR_ONLINE)
        else
          CellText := DM.GetTC(TC_ROUTER_STATUSSTR_OFFLINE);
      end;
    3:
      CellText := R.Username;
    4:
      CellText := R.Password;
  End;
end;

Вот так добавляю ветки:

var
  i: Integer;
  Data: TNodeData;
begin
  if Assigned(fTree) then
  begin
    try
      fTree.BeginUpdate;
      fTree.Clear;
      for i := 0 to Count - 1 do
      begin
        ZeroMemory(@Data, SizeOf(TNodeData));
        Data.Kind := dkRouter;
        Data.P := Items[i].Ptr;
        {
         Items[i].Ptr:
          Возвращает @Self от лица Items[i]
        }
        fTree.AddChild(nil, @Data);
      end;
    finally
      fTree.EndUpdate;
    end;
  end;
end;

Что не так?
1. Почему в Kind - не то, что над
2. Данные по указателю не читабельны...

[Аватар]

Манипуляции с Pointer на примере ListView

type TNodeDataType = (dtRouter,dtRouterItem,dtLocalItem,dtPrintTemplate);

     TNodeData = record
       DataType: TNodeDataType;
       Data: Pointer; // Ptr to data
     end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  tt:=0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var p: ^TNodeData;
    xStringList: TStringList;
    xItem: TListItem;
begin
  Inc(tt);
  {добавить строку в ListView с данными в Pointer}
  GetMem(p,SizeOf(TNodeData));
  p^.DataType:=TNodeDataType(tt mod 4);
  xStringList:=TStringList.Create; //какой-то объект для Data, например StringList
  xStringList.Text:=IntToStr(tt*100);
  p^.Data:=xStringList;
  xItem:=ListView1.Items.Add;
  xItem.Caption:=IntToStr(tt*10);
  xItem.Data:=p;
end;

procedure TForm1.ListView1Change(Sender: TObject; Item: TListItem; Change: TItemChange);
var p: ^TNodeData;
begin
  {Чтение данных из Pointer}
  if Item=nil then Exit;
  Label1.Caption:=Item.Caption;
  p:=Item.Data;
  if p=nil then Exit;
  Label2.Caption:=IntToStr(Integer(p^.DataType));
  Label3.Caption:=TStringList(p^.Data).Text;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var i: Integer;
    p: ^TNodeData;
begin
  {Освободить память}
  ListView1.OnChange:=nil;
  for i:=0 to ListView1.Items.Count-1 do begin
    p:=ListView1.Items[i].Data;
    if p<>nil then begin
      if p^.Data<>nil then TStringList(p^.Data).Free;
      FreeMem(p);
    end;
  end;
end;

[eval]

ZeroMemory(@Data, SizeOf(TNodeData));

что делает?

[Человек_Борща]

что делает?

Обнуляет.

Намек я понял. Но вот в чем фокус: Как в этом цикле сделать так чтобы Data всегда было в разных местах, т.е. каждый раз новый Data с, соответственно, новыми данными.

[eval]

ну либо через указатель, как у Аватар, или помнить что рекорд это валью тайп и сделать копирование, но оно бедет не красиво т.к. не явное.

[phomm]

Data в данном случае - кусок данных со стека, по факту указатель, в его значении лежит мусор, указывающий в бездну. Вы затираете что-то, что лежит по указателю, тупо нулями, так-то это могла быть и нужная инфа ) Ну или ав получали бы. Обращаясь в любом методе к этому сохранённому указателю, мы имеем обращение к некой памяти, на которую указывает мусорное число со стека в момент вызова метода, где сохраняем указатель. Одинаковый мусор чисто по стечению обстоятельств, главное из которых - одна и та же последовательность вызовов методов, ведь Вы тестируете по идее вызывая одну и ту же цепочку методов. А обнуление вообще не даёт ничего, кроме вероятности получить ав при записи нулей неизвестно куда. Вроде гетмем кстати даже сам инициализирует поля , исходя из типипизированного указателя.
Ка предложил Аватар, память надо выделить гетмемом, при этом в переменную-указатель data запишется указатель на созданную в куче структуру. Этот указатель Вы сохраните в ноде (грубо говоря это же обычное число, только Вы и знаете, что это число адрес памяти где лежит Ваша структура). На новом шаге цикла надо ровно также вызвать гетмем - в переменную просто запишется новое число-указатель на вновь созданную ещё где-то в куче нужную структуру, а старый указатель уже сохранён в ноде, беспокоиться о нём не надо.
С кучи структуры никуда не денутся, как и должно быть, и впоследствии на Вас лежит задача убиения этих данных, ориентируясь по сохранённому в ноде указателю, об этом также расписано в коде у Аватар

[Человек_Борща]

Нет, хоть убей - не заработает.

У меня есть TreeView(TVirtualStringTree, если быть точным).
При добавлении Node:
Tree.AddChild(ParentNode, UserData:Pointer).
Вторым параметром идет указатель на данные.

Обычно я делаю так:

for i:=0 to Count -1 do
Tree.AddChild(nil, Items[i]);

Где Items[i] - TObject.

Когда надо получить данные из Node делаю так:

var
  pObj:^TObject;
  Data:TObject;
begin
  pObj:=Tree.GetNodeData(Node);
  Data:=pObj^;
  <Работа с Data идет успешно>
end;

Сейчас это уже не подходит. У меня есть дерево, которое отображает сразу несколько различных типов данных.
Потому, я при думал это:

  pNodeData = ^TNodeData;

  TNodeData = class(TObject)
  public
    Kind: TNodeDataKind; // See above
    P: Pointer; // Ptr to object
    constructor Create(aKind: TNodeDataKind; aPtr: Pointer); overload;
    destructor Destroy; override;
  end;

function NodeHaveObject(aTree: TVirtualStringTree; aNode: PVirtualNode;
  out Obj: TNodeData): Boolean;

implementation

function NodeHaveObject(aTree: TVirtualStringTree; aNode: PVirtualNode;
  out Obj: TNodeData): Boolean;
var
  pData: pNodeData;
begin
  Result := False;
  Obj := nil;
  if aNode = nil then
    Exit;
  pData := aTree.GetNodeData(aNode);
  Result := (pData <> nil) and (pData^ is TNodeData);
  if Result then
    Obj := TNodeData(pData^);
end;

{ TNodeData }

constructor TNodeData.Create(aKind: TNodeDataKind; aPtr: Pointer);
begin
  New(P); //Надо ли это?
  Kind := aKind;
  P := aPtr;
end;

destructor TNodeData.Destroy;
begin
  if P <> nil then
    Dispose(P); //Надо ли это?
  inherited;
end;

Все что мне надо, это определить нужный тип данных по содержимому kind и в зависимости от него, правильно прочитать указатель.

Добавляю так:

for i:=0 to Count -1 do
Tree.AddChild(nil, TNodeData.Create(dkType1,Items[i]));

TNodeData я спокойно считываю. А вот как из указателя забрать то, что я хочу?

procedure TRoutersMgrForm.TreeGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var
  Data: TNodeData;
  R: TRouter;
begin
  if NodeHaveObject(Tree, Node, Data) then
  begin
    R := pRouter(Data.P)^; //type pRouter = ^TRouter;
   R.<...>  //Тут Access Violation

Пробовал так:

 
  begin
    R := pRouter(Data.P^)^; //type pRouter = ^TRouter;
   R.<...>  //Тут опять Access Violation

и так:

  begin
    R := pRouter(Data.P^); //type pRouter = ^TRouter;
   R.<...>  //Тут Access Violation снова

Даже пользуясь New, Dispose - ошибки повторяются..
Как быть?

Уже дыру в этой статье прожёг.

[Аватар]

function NodeHaveObject(aTree: TVirtualStringTree; aNode: PVirtualNode;
  out Obj: TNodeData): Boolean;
var
  pData: pNodeData;
begin
  Result := False;
  Obj := nil;
  if aNode = nil then
    Exit;
  pData := aTree.GetNodeData(aNode);
  Result := (pData <> nil) and (pData^ is TNodeData);
  if Result then
    Obj := TNodeData(pData);
end;

New(P) и Dispose(P) не надо