VPF::Invalid pointer operation - Форум программистов

csander

Дата 19.10.2009, 15:55 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 47
Регистрация: 13.5.2007

Репутация: нет
Всего: нет

Динамически создаю дерево VirtualTreeView внутри CategoryPanel:

Код


//Создание панели с деревом----------------------------------
procedure TForm1.PanelCreate(title: String; numRec: Integer);
var
  i,j: Integer;
  Panel:  TCategoryPanel;
  Tree:   TVirtualStringTree;
  NewNode, NewNode1 : PVirtualNode;
  NewPhone: PPhoneNode;
begin
  Panel:=PanelGroup.CreatePanel(Self) as TCategoryPanel;
  Panel.Caption:=title;
  PanelGroup.CollapseAll;
  Tree := TVirtualStringTree.Create(Panel);
  Tree.OnGetText := VTGetText; //метод для вывода текста
  Tree.OnFocusChanged := VTFocusChanged;
  Tree.Name := 'Name';
  Tree.Parent := Panel;
  Tree.Align := alClient;
  Tree.NodeDataSize := SizeOf(TPhoneNode);
  for i := 1 to numRec do
  begin
    NewNode := Tree.AddChild(nil);
    NewPhone := Tree.GetNodeData(NewNode);
    if Assigned(NewPhone) then
    with NewPhone^ do
    begin
      Name := Query1.Fields.FieldByNumber(1).Value;
//Заполнение типов расчета -----------------------------------------------------
      Query2.SQL.Clear;
      Query2.SQL.Add('select [Тип] from ['+title+'] group by [Тип]');
      Query2.ExecSQL;
      Query2.Active := true;
      if Query2.RecordCount > 0 then
      begin
        for j := 1 to Query2.RecordCount do
        begin
          NewNode1 := Tree.AddChild(NewNode);
          NewPhone := Tree.GetNodeData(NewNode1);
          if Assigned(NewPhone) then
            with NewPhone^ do
            begin
              Name := Query2.Fields.FieldByNumber(1).Value;
            end;
            if j <> Query2.RecordCount then Query2.FindNext;
        end;
      end;
//------------------------------------------------------------------------------
      if i <> numRec then Query1.FindNext;
    end;
  end;
  Panel.InsertControl(Tree);
end;

все создается как надо, но при закрытии формы, выходит ошибка :

не могу никак понять, где ошибка? может где-то надо освободить память?

kuzyara

Дата 19.10.2009, 16:14 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 215
Регистрация: 13.11.2006

Репутация: нет
Всего: 1

а можно я угадаю?

нигде нет free! smile

--------------------

подпись

csander

Дата 19.10.2009, 19:17 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 47
Регистрация: 13.5.2007

Репутация: нет
Всего: нет

я пробовал в самом конце писать Tree.free; но также не работало и выходила другая ошибка.

csander

Дата 20.10.2009, 19:58 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 47
Регистрация: 13.5.2007

Репутация: нет
Всего: нет

в какой момент надо освобождать дерево из памяти?
p.s. когда дерево полностью создается динамически, надо ли прописывать OnFreeNode???

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, GridsEh, DBGridEh, ToolWin, ActnMan, ActnCtrls, Ribbon,
  RibbonLunaStyleActnCtrls, ExtCtrls, MemTableDataEh, Db, ADODB, DataDriverEh,
  ADODataDriverEh, DBLookupEh, DBCtrlsEh, StdCtrls, Mask, PrnDbgeh, ScreenTips,
  ComCtrls, CategoryButtons, VirtualTrees, jpeg, ActnMenus, RibbonActnMenus,
  ActnList;

type
  PPhoneNode = ^TPhoneNode;
  TPhoneNode = record
    Name: String;
  end;
  TForm1 = class(TForm)
    Ribbon1: TRibbon;
    PanelGroup: TCategoryPanelGroup;
    Panel1: TPanel;
    StatusBar1: TStatusBar;
    Splitter1: TSplitter;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    ActionManager1: TActionManager;
    RibbonApplicationMenuBar1: TRibbonApplicationMenuBar;
    Button1: TButton;
    Button2: TButton;
    Connection: TADOConnection;
    Query: TADOQuery;
    DataSet: TADODataSet;
    DataSource: TDataSource;
    Query1: TADOQuery;
    DataSet1: TADODataSet;
    DataSource1: TDataSource;
    Query2: TADOQuery;
    DataSet2: TADODataSet;
    DataSource2: TDataSource;
    Label1: TLabel;
    CategoryPanel1: TCategoryPanel;
    procedure FormCreate(Sender: TObject);
    procedure PanelCreate(title: String; numRec: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure VTFocusChanged(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex);
    procedure VirtualStringTree1FreeNode(Sender: TBaseVirtualTree;
      Node: PVirtualNode);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  activeVT : TVirtualStringTree;
  k: Integer;
implementation

{$R *.dfm}
//Создание панели с деревом----------------------------------
procedure TForm1.PanelCreate(title: String; numRec: Integer);
var
  i,j: Integer;
  Panel:  TCategoryPanel;
  Tree:   TVirtualStringTree;
  NewNode, NewNode1 : PVirtualNode;
  NewPhone: PPhoneNode;
begin
  Panel:=PanelGroup.CreatePanel(Self) as TCategoryPanel;
  Panel.Caption:=title;
  PanelGroup.CollapseAll;
  Tree := TVirtualStringTree.Create(Panel);
  Tree.OnGetText := VTGetText; //метод для вывода текста
  Tree.OnFocusChanged := VTFocusChanged;
  Tree.OnFreeNode := VirtualStringTree1FreeNode;
  Tree.Name := 'Name';
  Tree.Parent := Panel;
  Tree.Align := alClient;
  Tree.NodeDataSize := SizeOf(TPhoneNode);
  for i := 1 to numRec do
  begin
    NewNode := Tree.AddChild(Tree.RootNode);
    NewPhone := Tree.GetNodeData(NewNode);
    if Assigned(NewPhone) then
    with NewPhone^ do
    begin
      Name := Query1.Fields.FieldByNumber(1).Value;
//Заполнение типов расчета -----------------------------------------------------
      Query2.SQL.Clear;
      Query2.SQL.Add('select [Тип] from ['+title+'] group by [Тип]');
      Query2.ExecSQL;
      Query2.Active := true;
      if Query2.RecordCount > 0 then
      begin
        for j := 1 to Query2.RecordCount do
        begin
          NewNode1 := Tree.AddChild(NewNode);
          NewPhone := Tree.GetNodeData(NewNode1);
          if Assigned(NewPhone) then
            with NewPhone^ do
            begin
              Name := Query2.Fields.FieldByNumber(1).Value;
            end;
            if j <> Query2.RecordCount then Query2.FindNext;
        end;
      end;
//------------------------------------------------------------------------------

      if i <> numRec then Query1.FindNext;
    end;
  end;
  Panel.InsertControl(Tree);
  k:=k+1;
end;
//-----------------------------------------------------------------------------
//Определяем активное дерево
procedure TForm1.VirtualStringTree1FreeNode(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var
 Data: PPhoneNode;
begin
 Data := Sender.GetNodeData(Node);
 if Assigned(Data) then
  Finalize(Data^);
end;

procedure TForm1.VTFocusChanged(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex);
begin
  activeVT := Sender as TVirtualStringTree;
  Label1.Caption := activeVT.Text[activeVT.FocusedNode,0];
end;
//-----------------------------------------------------------------------------
procedure TForm1.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
  PhoneNode: PPhoneNode;
begin
  PhoneNode := Sender.GetNodeData(Node);
  if Assigned(PhoneNode) then
    CellText := PhoneNode.Name;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//activeVT.DeleteNode(activeVT.FocusedNode);
activeVT.DeleteSelectedNodes;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  NewNode: PVirtualNode;
  NewPhone: PPhoneNode;
begin
  NewNode := activeVT.AddChild(activeVT.FocusedNode);
  NewPhone := activeVT.GetNodeData(NewNode);
  if Assigned(NewPhone) then
    with NewPhone^ do
    begin
      Name := 'b';
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i:Integer;
  name: string;
begin
k:=0;
Query.SQL.Clear;
Query.SQL.Add('select [Name] from [Организации]');
Query.ExecSQL;
Query.Active := true;
if Query.RecordCount > 0 then
begin
  Query.First;
  for i := 1 to Query.RecordCount do
  begin
    name := Query.Fields.FieldByNumber(1).Value;
    Query1.SQL.Clear;
    Query1.SQL.Add('select [Год] from ['+name+'] group by [Год]');
    Query1.ExecSQL;
    Query1.Active := true;
    PanelCreate(name,Query1.RecordCount);
    if i <> Query.RecordCount then Query.FindNext;
  end;
end;
end;

end.

Это сообщение отредактировал(а) csander - 20.10.2009, 21:19

Quartz

Дата 22.10.2009, 17:44 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 40
Регистрация: 28.6.2008

Репутация: 3
Всего: 4

Цитата(csander @ 19.10.2009, 15:55

)

при закрытии формы, выходит ошибка

Если не секрет, зачем делаешь Panel.InsertControl(Tree)? smile

csander

Дата 22.10.2009, 21:57 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 47
Регистрация: 13.5.2007

Репутация: нет
Всего: нет

уже разобрался)) не надо его писать ))) т.к. уже присвоил ему родителя.

может кто-нибудь сталкивался с такими вещами???

при клике на первый элемент в дереве, фокус устанавливается. а при клике на других элементах, фокус не фиксируется. причем дочерние элементы раскрываются и на всех из них фокус работает. НО... если ткнуть в другие, кроме первого, элементы в нижний левый угол, то фокус...устанавливается (!) и потом работает как обычно (т.е. фиксируется в любой другой "области элемента дерева") Как так?

Исходники:

Это сообщение отредактировал(а) csander - 22.10.2009, 21:58

Присоединённый файл ( Кол-во скачиваний: 13 )

VTV.rar 965,93 Kb

Quartz

Дата 23.10.2009, 09:49 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 40
Регистрация: 28.6.2008

Репутация: 3
Всего: 4

csander, сдаётся мне, что ты переписываешь с неудачного примера...

На оф. сайте VirtualTreeview есть VT Addons (готовые компоненты для работы с деревом в БД); также можно посмотреть Virtual Treeview and databases.

bems

Дата 23.10.2009, 12:27 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 31
Всего: 88

M
bems

Один топик — один вопрос!

Пожалуйста, ознакомьтесь с правилами форума.

Тема закрыта. Создайте по одной теме для каждого интересующего вас вопроса и не забывайте указывать язык программирования в заголовке.

--------------------

Обижено школьников: 8

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »