Ошибка в работе VirtualTrees

[BadBoyAlex]

Имеется тип:

Код: Выделить всё

type PFCFileInfo = packed record
fcFileName: string;
fc_isFolder: boolean;
fcFileType: string;
fcDOfC: string;
fcDOfLW: string;
fcFileSize: Int64;
end;
type TFCFileInfo = ^PFCFileInfo;


В VST имеем 5 колонок.

При создании формы

Код: Выделить всё

VST.NodeDataSize:= SizeOf(TFCFileInfo);

При освобождении НОДА:

Код: Выделить всё

var Data: TFCFileInfo;
begin
Data:= Sender.GetNodeData(Node);
if Assigned(Data) then
Finalize(Data^);

Ну и GetText:

Код: Выделить всё

var Data: TFCFileInfo;
begin
Data:= Sender.GetNodeData(Node);
if Assigned(Data) then
case Column of
  0: CellText:= ChangeFileExt(ExtractFileName(Data.fcFileName), '');
  1: if Data.fc_isFolder then
      CellText:= '[Dir]'
      else
      CellText:= Data.fcFileType;
  2: if Data.fc_isFolder then
      CellText:= ''
      else
      CellText:= IntToStr(Data.fcFileSize);
  3: CellText:= Data.fcDOfC;
  4: CellText:= Data.fcDOfLW;
end;

Само заполнение:

Код: Выделить всё

procedure UpdateFileViewer (const ADir: string; var VFileViewer: TVirtualStringTree);
function GetAnyFileType(const Filename: string): string;
var FileInfo: TSHFileInfo;
begin
Result:= '';
FillChar(FileInfo, sizeof(FileInfo), 0);
if (SHGetFileInfo(PChar(ExtractFileExt(Filename)), FILE_ATTRIBUTE_NORMAL, FileInfo, sizeof(FileInfo), SHGFI_TYPENAME or SHGFI_USEFILEATTRIBUTES) <> 0) then
  Result:= UTF8Encode(FileInfo.szTypeName);
end;
var SR: TSearchRec;
    Node: PVirtualNode;
    Data: TFCFileInfo;
    ST: TSYSTEMTIME;
begin
VFileViewer.Enabled:= false;
VFileViewer.BeginUpdate;
VFileViewer.Clear;
if FindFirst(IncludeTrailingBackslash(ADir) + '*.*', faAnyFile, SR) = 0 then
repeat
  if not ((SR.Name = '.') or (SR.Name = '..')) then
   begin
   Node:= VFileViewer.AddChild(VFileViewer.RootNode);
   if not (vsInitialized in Node.States) then
    VFileViewer.ReinitNode(Node, false);
   Node.CheckType:= ctNone;
   Data:= VFileViewer.GetNodeData(Node);
   Data.fcFileName:= SR.Name;
   if ((SR.Attr and faDirectory) = faDirectory) then
    Data.fc_isFolder:= true
    else
    begin
    Data.fc_isFolder:= false;
    Data.fcFileType:= GetAnyFileType(SR.Name);
    try
     FileTimeToSystemTime(SR.FindData.ftCreationTime, ST);
     Data.fcDOfC:= (IntToStr(ST.Day) + '.' + IntToStr(ST.Month) + '.' + IntToStr(ST.Year) + ' ' + IntToStr(ST.Hour) + '.' + IntToStr(ST.Minute) + '.' + IntToStr(ST.Second));
     except
     Data.fcDOfC:= '[UNDEFINE]';
     end;
    try
     FileTimeToSystemTime(SR.FindData.ftLastWriteTime, ST);
     Data.fcDOfLW:= IntToStr(ST.Day) + '.' + IntToStr(ST.Month) + '.' + IntToStr(ST.Year) + ' ' + IntToStr(ST.Hour) + '.' + IntToStr(ST.Minute) + '.' + IntToStr(ST.Second);;
     except
     Data.fcDOfLW:= '[UNDEFINE]';
     end;
    end;
   end;
  until FindNext(SR) <> 0;
FindClose(SR.FindHandle);
VFileViewer.EndUpdate;
VFileViewer.Enabled:= true;
end;

При вызове процедуры выдаёт ошибку:



Причём, если закомментировать всё, что связанно с fcDOfC и fcDOfLW ( с колонками 4 и 5 VST, соответственно), то всё работает на ура. Если же придать им какие либо (даже '123') значения - ошибка.

Что это и как её лечить?

[stikriz]

Код: Выделить всё

var Data: TFCFileInfo;

Это шедеврально. Вот смотрите. Вы на стеке выделяете кусок памяти пот структуру в которой есть такая вещь, как string. Что такое стринг? Это указатель на память - 4 байта. Куда указывает указатель, если Вы не распределили память? Хрен знает куда... А Вы еще его нулями забили... Либо сделайте string[256], например, либо сами распределите память и присвойте указателю. Лучше со структурами работать через указатели, если Вы их создаете в процедурах, самостоятельно распределять память и удалять. Я еще не уверен что будет с Вашей структурой, когда Вы выйдите из области видимости процедуры, где она объявлена? Стек-то где будет?

Код: Выделить всё

var Data: TFCFileInfo;
begin
Data:= Sender.GetNodeData(Node);

Вот смотрите, вот здесь, делается move... А если бы был указатель, то просто присвоение. Просто вот тут можно было бы сделать так:

Код: Выделить всё

0: CellText:= ChangeFileExt(ExtractFileName(Data^.fcFileName), '');

В общем, надо курить указатели. Что такое память на стеке, что такое в куче и чем отличается структура от класса. Кстати, объявите свою структуру классом и все пойдет как по маслу.

[BadBoyAlex]

Либо сделайте string[256]

К сожалению, та же байда, если всё переделать в

Код: Выделить всё

string[255]

.

Основной алгоритм взят из примера к компоненту. Правда, из Делфей...

[stikriz]

Основной алгоритм взят из примера к компоненту. Правда, из Делфей...

В Дельфи будет все то же самое. Если из Дельфи, то посмотрите внимательно там не указатель-ли на структуру? Вы в разные ветки должны присваивать указатель, ведь Data в ноде - это указатель? Вы его создаете в делегированном методе. Память распределяете на стеке в области видимости процедуры. Вы уходите из процедуры... Где все Ваши переменные? В области видимости процедуры... Из которой Вы уже вышли и память не существует - стек переместили.

К сожалению, та же байда, если всё переделать

Ну, а переменная на стеке?
Объявите PFCFileInfo = ^TFCFileInfo; Затем, когда Data ноды присваиваете, то распределяйте память через GetMem в куче. При удалении ноды делайте FreeMem(Node.Data).

Добавлено спустя 3 минуты 26 секунд:
Ох уж эти паскалисты - ну, нихрена с указателями не понимают Вам бы на сях пописать Все паскаль виноват. Про Дельфи - молчу. FPC хоть заставляет немного вдумчивее работать с указателями, особенно бесит указатели на методы

[zub]

Вот смотрите. Вы на стеке выделяете кусок памяти пот структуру в которой есть такая вещь, как string. Что такое стринг? Это указатель на память - 4 байта. Куда указывает указатель, если Вы не распределили память? Хрен знает куда... А Вы еще его нулями забили... Либо сделайте string[256], например, либо сами распределите память и присвойте указателю. Лучше со структурами работать через указатели, если Вы их создаете в процедурах, самостоятельно распределять память и удалять. Я еще не уверен что будет с Вашей структурой, когда Вы выйдите из области видимости процедуры, где она объявлена? Стек-то где будет?

Стринги всегда инициализируются компилятором (за исключением вызовов GetMem), такчто можно ничего в этом объявлении страшного нет. Забить стринг нулями, тоже можно при желании - это равносильно присвоению '' и потери одной ссылки на текущее значение, т.е. максимум небольшой мемлик. А при выходе из области видимости стринги всегда финализируются компилятором.

type TFCFileInfo = ^PFCFileInfo;

обычно принято наоборот

Код: Выделить всё

type PFCFileInfo = ^TFCFileInfo;

P - указатель, Т - тип

Код: Выделить всё

var Data: TFCFileInfo;
begin
Data:= Sender.GetNodeData(Node);

а что возвращает GetNodeData, покажите объявление? при работе с указателями (темболее когда это указатели на структуры со стрингами) нужно строго соблюдать типы, компилятор их не контролирует. Судя по всему вы пытаетесь через указатель преобразовать чужую структуру данных в свою, так делать нельзя! даже если структуры имеют идентичное описание (что наврятли), изза разных опций компиляции в модулях эти структуры могут оказаться несовместимы.

[BadBoyAlex]

а что возвращает GetNodeData, покажите объявление?

Код: Выделить всё

function GetNodeData(Node: PVirtualNode): Pointer;

[zub]

Pointer на что? Там всеравно какието данные. Нельзя через указатели приводить типы данных, заисключением случаев типа наследования.

[stikriz]

Вот смотрите. Вы в методе объявляете var Data: TFCFileInfo; Что происходит? Сразу после вызова метода стек перемещается вниз на Sizeof(TFCFileInfo). И там будет Ваша структура. Это значит, что из других методов этот кусок памяти недоступен, т.к. при возврате из метода стек вернется в состояние до вызова. Это проще понять, если обхявить, например, var MyInteger: Integer; Это то же самое. Как только Вы вышли из метода про MyInteger можно забыть. Если Вам этот кусок памяти нужен еще где-то, то надо выделять его в куче, а это, например, GetMem - очень хорошая вещь, т.к. она помнит в - Sizeof(Pointer) размер выделенной памяти, потом в FreeMem не надо указывать сколько памяти удалить. По старинке, в структуре с длинными строками тоже работать боязно. Вот, если просто строку присвоить, то, вроде как должен копироваться указатель на строку, а у строки сейчас, как у интерфейсов есть счетчик ссылок. Но, не знаю что будет, если строку структуры надо будет перераспределить. Раньше в Дельфи это было фатально. Сейчас не пробовал. Лучше всего создавать не структуру, а класс - там все будет работать со строками как надо. Хотя, говорят, что разницы больше нет, что структура, что класс.

Добавлено спустя 1 минуту 13 секунд:

обычно принято наоборот

Очепятка.

Добавлено спустя 1 минуту 14 секунд:

а что возвращает GetNodeData

Указатель. Node.Data. И этот указатель, и что за ним, т.е. мусор копируется в переменную на стеке

[zub]

Код: Выделить всё

var Data: TFCFileInfo;
Data:= VFileViewer.GetNodeData(Node);

т.е. ТС настраивает ноду через указатель на данные ноды (T и P у него перепутаны), а не передает данные на стеке процедуры в ноду

Добавлено спустя 2 минуты 34 секунды:
Data у него тоже указатель... Выходит работа с данными какогото типа чечез указатель на данные другого типа

Добавлено спустя 2 минуты 44 секунды:

Имеется тип:

Код: Выделить всё

type PFCFileInfo = packed record
......

это тип из VirtualTrees или определен в вашей программе?

[BadBoyAlex]

это тип из VirtualTrees или определен в вашей программе?

В моей программе.

[stikriz]

Забить стринг нулями, тоже можно при желании - это равносильно присвоению '' и потери одной ссылки на текущее значение,

Не понял. Что значит потеря одной ссылки на текущее значение? Если компилятор в структурах теперь что-то делает сам, то там не должно быть значение - это пустая строка. Тогда зачем обнулять память? Раньше-то там был мусор, тем более на стеке.

[zub]

>>Не понял. Что значит потеря одной ссылки на текущее значение?
Стринг - это кусок выделенной памяти и счетчик ссылок на нее, вот после такого действа счетчик будет врать на одну ссылку. Если в переменной есть значение. А если там '' то ничего не изменится.
>>Раньше-то там был мусор
В стринге никогда мусора быть не может. Она всегда инициализируется и финализируется на стеке, в куче (при создании с помощью New, через GetMem мусор таки будет), глобальная, локальная - без разницы.
>> Тогда зачем обнулять память?
Иногда приходится обхитрять компилятор... А потом ловить подобные ошибки))

Добавлено спустя 12 минут 32 секунды:
BadBoyAlex
>>В моей программе.
Вот и я про это. нужно глядеть тип данных которые подсовываются через этот Pointer и делать Data указателем на этот тип, а не пользоваться своим TFCFileInfo
Грубый пример того что ИМХО происходит:

Код: Выделить всё

var
d:double;
pi:pinteger;
begin
d:=3.1415
pi:=@d;
writeln(pi^);


от того что мы через указатели "обманули" компилятор и присвоили интежеру значенье из double, число в integer не преобразовалось

[BadBoyAlex]

Вот как делается в примере:

Код: Выделить всё

{

This example shows how to manipulate with imagse for each cell.
Also support sorting by column clicking and
way to drawing in a cell

The initial developer of this code is Sasa Zeman.
Mailto: public@szutils.net or sasaz72@mail.ru
Web site: www.szutils.net

Created: 7 Jun 2004
Modified: 10 March 2005

This example is distributed "AS IS", WITHOUT
WARRANTY OF ANY KIND, either express or implied.

You use it at your own risk!

Adapted for LCL by Luiz Amйrico
}

unit Unit1;

{$MODE Delphi}

interface

uses
  DelphiCompat, LCLIntf, LCLType, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, VirtualTrees, LResources;

type

  { TForm1 }

  TForm1 = class(TForm)
    VST1: TVirtualStringTree;
    ImageList1: TImageList;
    ImageList2: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure VST1BeforeCellPaint(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
      CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
    procedure VST1InitNode(Sender: TBaseVirtualTree; ParentNode,
      Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
    procedure VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: String);
    procedure VST1GetImageIndex(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
      var Ghosted: Boolean; var ImageIndex: Integer);
    procedure VST1Checking(Sender: TBaseVirtualTree; Node: PVirtualNode;
      var NewState: TCheckState; var Allowed: Boolean);
    procedure VST1HeaderClick(Sender: TVTHeader; Column: TColumnIndex;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure VST1CompareNodes(Sender: TBaseVirtualTree; Node1,
      Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  PMyRec = ^TMyRec;
  TMyRec = record
    Main: String;
    One, Two: integer;
    Percent : integer;
    Index: Integer;
  end;

var
  Form1: TForm1;

implementation

uses Math;

procedure TForm1.FormCreate(Sender: TObject);
begin

  // Link images in ImageList2 to VST1.StateImages if it
  // not set already in Oject Inspector
  // It is important to link to VST1.StateImages
  // since we need to use images to all cells
  // (in all columns, not only for main column)
  // Otherwise it will not work properly with VST1.Images
  // VST1.StateImages:= ImageList2;

  // Set data size of data record used for each tree
  VST1.NodeDataSize := SizeOf(TMyRec);

  // Number of initial nodes
  VST1.RootNodeCount := 20;

  // Set XP syle for CheckImage
  VST1.CheckImageKind:=ckXP;
 
  //Start random number generator
  Randomize
end;

procedure TForm1.VST1BeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
  I, PercentageSize, RndPercent: integer;
  ColorStart: Word;
  Data: PMyRec;
  R,G,B: byte;
begin
  if (Column = 3) then
  begin

    Data := Sender.GetNodeData(Node);
    RndPercent:=Data.Percent;

    InflateRect(CellRect, -1, -1);
    DrawEdge(TargetCanvas.Handle, CellRect, EDGE_SUNKEN, BF_ADJUST or BF_RECT);
    PercentageSize := (CellRect.Right - CellRect.Left) * RndPercent div 100;

    if True then
    //Multi color approach
    begin
      ColorStart :=clYellow;

      R:= GetRValue(ColorStart);
      G:= GetGValue(ColorStart);
      B:= GetBValue(ColorStart);

      for I := CellRect.Right downto CellRect.Left do
      begin
        TargetCanvas.Brush.Color := RGB(R,G,B);

        if CellRect.Right - CellRect.Left <= PercentageSize then
          TargetCanvas.FillRect(CellRect);
        Dec(CellRect.Right);

        Dec(G);
      end;
    end else
    //One color approach
    begin
      CellRect.Right := CellRect.Left + PercentageSize;
      if RndPercent = 100 then
        TargetCanvas.Brush.Color := clRed
      else
        TargetCanvas.Brush.Color := clLime;
      TargetCanvas.FillRect(CellRect);
    end;
  end;
end;

procedure TForm1.VST1InitNode(Sender: TBaseVirtualTree; ParentNode,
  Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
  Data: PMyRec;
  s: string;
begin
  Data:=Sender.GetNodeData(Node);

  // Data nitialization during node initialization

  s:= Format('Level %3d, Index %3d', [Sender.GetNodeLevel(Node), Node.Index]);
  Data.Main:='Main ' + s;

  Data.One := Random(ImageList2.Count);
  Data.Two := Random(ImageList2.Count);
  Data.Percent :=  Random (101);
  //fpc does not has RandomRange
  //Data.Percent := RandomRange(0,100);
  Data.Index:= Node.Index;

  // Following code can be coded much efficiantly,
  // but than again it works for now
  // and determinate CheckType for each node

  if Data.Index>=0 then
    // Set RadioButton
     Node.CheckType := ctRadioButton;

  if Data.Index>=4 then
    // Set CheckBox
    Node.CheckType:= ctCheckBox;

  if Data.Index>=8 then
    // Set Button
    Node.CheckType:= ctButton;

  if Data.Index>=12 then
    // Set ctTriStateCheckBox
    Node.CheckType:= ctTriStateCheckBox;

  if Data.Index>=16 then
    // Set nothing
    Node.CheckType:= ctNone;

end;

procedure TForm1.VST1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
var
  Data: PMyRec;
begin
  Data:=Sender.GetNodeData(Node);

  case column of
    0: CellText:=Data.Main;
    1: CellText:=IntToStr(Data.One);
    2: CellText:=IntToStr(Data.Two);
    3: CellText:=IntToStr(Data.Percent)+'%';
  end
end;

procedure TForm1.VST1GetImageIndex(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
  var Ghosted: Boolean; var ImageIndex: Integer);
var
  Data: PMyRec;
begin
  Data := Sender.GetNodeData(Node);

  {

  Kind:=ikNormal;
    ikNormal,
    ikSelected,
    ikState,
    ikOverlay
  }

  // Conditional image index setting for each cell (node and column)
  case Column of
    0: if Data.Index<12 then
          ImageIndex:=3
        else
          ImageIndex:=25;
    1: ImageIndex:=Data.One;
    2: ImageIndex:=Data.Two;
  end;
end;

procedure TForm1.VST1Checking(Sender: TBaseVirtualTree; Node: PVirtualNode;
  var NewState: TCheckState; var Allowed: Boolean);
var
  Data: PMyRec;
  s: string;
begin
  Data := Sender.GetNodeData(Node);

  // Determinate which CheckType is pressed
  // Instead of this, here can be some real action
  case Node.CheckType of
    ctTriStateCheckBox: s:='TriStateCheckBox';
    ctCheckBox        : s:='CheckBox';
    ctRadioButton     : s:='RadioButton';
    ctButton          : s:='Button';
  end;

  caption:=s+' '+Data.Main;
  Allowed:=true
end;

procedure TForm1.VST1HeaderClick(Sender: TVTHeader; Column: TColumnIndex;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin

  // Determinate sorting direction
  if Button=mbLeft then
  with Sender do
  begin
    if SortColumn <> Column then
       SortColumn := Column
    else begin
      if SortDirection = sdAscending then
        SortDirection := sdDescending
      else
        SortDirection := sdAscending
    end;

    // Initiate sorting
    VST1.SortTree(Column, Sender.SortDirection, False);
  end;
end;

procedure TForm1.VST1CompareNodes(Sender: TBaseVirtualTree; Node1,
  Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
  Data1, Data2: PMyRec;
begin
  Data1:=Sender.GetNodeData(Node1);
  Data2:=Sender.GetNodeData(Node2);

  // Depending on column in VST1.SortTree(...)
  // returns comparing result to internal sorting procedure

  Result:=0;
  case column of
     0: Result:=CompareStr(Data1.Main,Data2.Main);
     1: begin
          Result:=CompareValue(Data1.One,Data2.One);
          // If numbers are equal, compare value from next column
          // On this way we product more complex sorting
          if Result=0 then
             Result:=CompareValue(Data1.Two,Data2.Two);
        end;
     2: Result:=CompareValue(Data1.Two,Data2.Two);
     3: Result:=CompareValue(Data1.Percent,Data2.Percent);

  end
end;

initialization
  {$i Unit1.lrs}

end.

Вроде бы также, как и у меня, но...

[zub]

TMyRec = record
....
VST1.NodeDataSize := SizeOf(TMyRec);

а мы имеем

Код: Выделить всё

VST.NodeDataSize:= SizeOf(TFCFileInfo);

а type TFCFileInfo = ^PFCFileInfo;
Дошло до меня наконецто, т.е. про разные типы это я прогнал изза незнания как работает VirtualTrees, извиняюсь.

в примере присваивается реальный размер данных, а у тебя размер указателя на данные, т.е. либо 4 либо 8 байт в зависимости от платформы...
Устраняй путаницу с T и P и присваивай реальный размер данных

[BadBoyAlex]

а type TFCFileInfo = ^PFCFileInfo;
Дошло до меня наконецто, т.е. про разные типы это я прогнал изза незнания как работает VirtualTrees, извиняюсь.

в примере присваивается реальный размер данных, а у тебя размер указателя на данные, т.е. либо 4 либо 8 байт в зависимости от платформы...
Устраняй путаницу с T и P и присваивай реальный размер данных

Спасибо. Вопрос решён...