Доброго времени суток, Во время выполнения программы создаю список VirtualStringTree. И пытаюсь его заполнить. Все процедуры вроде бы не раз использовал в других программа, но тут бред какой то непонятный для меня. Собственно, есть Action "actShowEditFormAccessoriesLayingList" если я его вызываю через кнопку popupmenu у VST, вот код кнопки | Код |
procedure TForm1.actALAddExecute(Sender: TObject);
var
NewItem:TAccessoriesLayingInUseItem;
begin
if ProgramData.AccessoriesLayingList.Count>0 then
begin
NewItem:=TAccessoriesLayingInUseItem.Create;
NewItem.AccessoriesLaying:=ProgramData.AccessoriesLayingList.Items[0];
NewItem.Guid:=CreateGUID;
if NewItem.AccessoriesLaying.ShapeType=astCircle then
NewItem.LabelName:='Труба1'
else
NewItem.LabelName:='Короб1';
ProgramData.AccessoriesLayingInUseList.Add(NewItem);
LoadDataToMainTree;
end
else begin
ShowMessage('В списке арматуры нет позиций');
actShowEditFormAccessoriesLayingList.Execute;
end;
end;
|
то программа мне предлагает добавить хоть одну запись в AccessoriesLayingList и потом при повторном нажатии на эту кнопку добавит запись в дерево, перед этим сгенерирова сообщение об ошибки. Если я вызову actShowEditFormAccessoriesLayingList через MainMenu а потом щелкну на кнопку popupmenu то все добавится нормально. Это первый бред, второй бред, что при заполнении списка до 8 штук, все норм, а потом ошибка вылазит, в списке остается только 4 записи и все... Пока не разобрался почему так себя ведет VST, проблема именно в нем помоему. Если убрать строчку LoadDataToMainTree в выше приведенном коде, и вызывать ее самостоятельно, то ряд ошибок пропадает. Кто может поковыряться в программе, могу скинуть исходники на почту. | Код |
type
PTrubokRecord = ^TTrubokRecord;
PProgramData = ^TProgramDataRecord;
TTrubokRecord = record
Item :TObject;
AccessoriesLaying :Boolean;
Cable :Boolean;
end;
TProgramDataRecord = record
AccessoriesLayingList : TAccessoriesLayingList;
CableList : TCableList;
AccessoriesLayingInUseList : TAccessoriesLayingInUseList;
CableInUseList : TCableInUseList;
end;
//*****************************
{start TVirtualStringTree}
procedure TFTrubok.VSTCreate(Sender: TObject);
var
Column:TVirtualTreeColumn;
begin
//Create
vstTrubokMainTree:=TVirtualStringTree.Create(pnlTrubokMainTree);
vstTrubokMainTree.NodeDataSize := SizeOf(PTrubokRecord);
vstTrubokMainTree.OnGetText:=vstTrubokMainTreeGetText;
vstTrubokMainTree.OnFreeNode:=VSTFreeNode;
vstTrubokMainTree.OnColumnResize:=vstTrubokMainTreeColumnResize;
//vstTrubokMainTree.OnDblClick:=actShowNoteExecute;
//vstTrubokMainTree.OnGetImageIndexEx:=vstTrubokMainTreeGetImageIndexEx;
//vstTrubokMainTree.OnBeforeCellPaint:=vstTrubokMainTreeBeforeCellPaint;
//vstTrubokMainTree.OnDrawText:=vstTrubokMainTreeDrawText;
vstTrubokMainTree.LineStyle:=lsCustomStyle;
//vstJournal.TreeOptions.MiscOptions:=vstJournal.TreeOptions.MiscOptions+[toEditable]; +[toShowButtons]
vstTrubokMainTree.TreeOptions.PaintOptions:=vstTrubokMainTree.TreeOptions.PaintOptions+[toShowHorzGridLines]+[toShowVertGridLines];
vstTrubokMainTree.TreeOptions.SelectionOptions:=vstTrubokMainTree.TreeOptions.SelectionOptions+[toFullRowSelect];
//vstTrubokMainTree.Images:=imgdata;
vstTrubokMainTree.PopupMenu:=pmMainTree;
// Headers
Column:=vstTrubokMainTree.Header.Columns.Add;
Column.Text:='Наименование';
Column.Width:=200;
Column:=vstTrubokMainTree.Header.Columns.Add;
Column.Text:='Маркировка';
Column.Width:=200;
Column:=vstTrubokMainTree.Header.Columns.Add;
Column.Text:='Размер, мм';
Column.Width:=100;
Column:=vstTrubokMainTree.Header.Columns.Add;
Column.Text:='Зав.наименование';
Column.Width:=150;
vstTrubokMainTree.Header.Options:=vstTrubokMainTree.Header.Options+[hoVisible];
vstTrubokMainTree.Header.Style:=hsPlates;
// Show in window
vstTrubokMainTree.Parent:=pnlTrubokMainTree;
vstTrubokMainTree.Align:=alClient;
vstTrubokMainTree.Show;
end;
procedure TFTrubok.VSTFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
Data: PTrubokRecord;
begin
Data := Sender.GetNodeData(Node);
if Assigned(Data) then
Finalize(Data^);
end;
procedure TFTrubok.vstTrubokMainTreeGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
var
Data: PTrubokRecord;
tmp:string;
begin
try
Data := Sender.GetNodeData(Node);
CellText := '';
if (Node<>sender.RootNode)and(Assigned(Data))and(Assigned(Data.Item)) then
begin
if Column=0 then
begin
if Data.Cable then // Assigned(TCableInUseItem(Data.Item).Cable)
tmp:=TCableInUseItem(Data.Item).LabelName;
if Data.AccessoriesLaying then // Assigned(TAccessoriesLayingInUseItem(Data.Item).AccessoriesLaying)
tmp:=TAccessoriesLayingInUseItem(Data.Item).LabelName;
end
else if Column=1 then
begin
if Assigned(TCableInUseItem(Data.Item).Cable) then
begin
if Assigned(TCableInUseItem(Data.Item).Cable) then
tmp:=TCableInUseItem(Data.Item).Cable.LabelName;
end;
if Data.AccessoriesLaying then
begin
if Assigned(TAccessoriesLayingInUseItem(Data.Item).AccessoriesLaying) then
tmp:=TAccessoriesLayingInUseItem(Data.Item).AccessoriesLaying.LabelName;
end;
end;
CellText := tmp;
end;
except
end;
end;
{end TVirtualStringTree}
procedure TFTrubok.actCableAddExecute(Sender: TObject);
var
Data: PTrubokRecord;
Node: PVirtualNode;
NewCable:TCableInUseItem;
begin
if ProgramData.CableList.Count>0 then
begin
{
if not Assigned(FSelectCableForUse) then
begin
FSelectCableForUse:=TFSelectCableForUse.Create(Application);
FSelectCableForUse.SetParams(@ProgramData);
end;
FSelectCableForUse.ShowModal;
}
Node := vstTrubokMainTree.GetFirstSelected;
Data := vstTrubokMainTree.GetNodeData(Node);
if Assigned(Data.Item) then
begin
NewCable:=TCableInUseItem.Create;
NewCable.Guid:=CreateGUID;
NewCable.LabelName:='Кабель-н1';
NewCable.Cable:=ProgramData.CableList.Items[0];
ProgramData.CableInUseList.Add(NewCable);
TAccessoriesLayingInUseItem(Data.Item).Cables.Add(NewCable);
LoadDataToMainTree;
end;
end
else begin
ShowMessage('В списке кабелей нет позиций');
end;
end;
procedure TFTrubok.FormCreate(Sender: TObject);
begin
VSTCreate(Self);
ProgramData.AccessoriesLayingList := TAccessoriesLayingList.Create;
ProgramData.CableList := TCableList.Create;
ProgramData.AccessoriesLayingInUseList := TAccessoriesLayingInUseList.Create;
ProgramData.CableInUseList := TCableInUseList.Create;
end;
procedure TFTrubok.FormDestroy(Sender: TObject);
begin
vstTrubokMainTree.Destroy;
ProgramData.AccessoriesLayingInUseList.Destroy;
ProgramData.CableInUseList.Destroy;
ProgramData.AccessoriesLayingList.Destroy;
ProgramData.CableList.Destroy;
end;
// загружает проектных записей в список gui
procedure TFTrubok.LoadDataToMainTree;
var
Node,Node1:PVirtualNode;
Data:PTrubokRecord;
i,k:integer;
TNode1:TTreeNode;
begin
vstTrubokMainTree.Clear;
TreeView1.Items.Clear;
vstTrubokMainTree.BeginUpdate;
for I := 0 to ProgramData.AccessoriesLayingInUseList.Count - 1 do
begin
Node1:=vstTrubokMainTree.AddChild(vstTrubokMainTree.RootNode);
if not (vsInitialized in Node1.States) then
vstTrubokMainTree.ReinitNode(Node1, False);
Data := vstTrubokMainTree.GetNodeData(Node1);
Data.AccessoriesLaying:=True;
Data.Cable:=False;
Data.Item:=ProgramData.AccessoriesLayingInUseList.Items[i];
TNode1:=TreeView1.Items.Add(nil,ProgramData.AccessoriesLayingInUseList.Items[i].LabelName);
TNode1.Data:=ProgramData.AccessoriesLayingInUseList.Items[i];
for k := 0 to ProgramData.AccessoriesLayingInUseList.Items[i].Cables.Count - 1 do
begin
Node:=vstTrubokMainTree.AddChild(Node1);
if not (vsInitialized in Node.States) then
vstTrubokMainTree.ReinitNode(Node, False);
Data := vstTrubokMainTree.GetNodeData(Node);
Data.AccessoriesLaying:=False;
Data.Cable:=True;
Data.Item:=ProgramData.AccessoriesLayingInUseList.Items[i].Cables.Items[k];
TreeView1.Items.Add(TNode1,ProgramData.AccessoriesLayingInUseList.Items[i].Cables.Items[k].LabelName);
end;
end;
//DeleteNodeIfNoLinkToList(vstTrubokMainTree.RootNode,ProgramData.AccessoriesLayingInUseList);
//AddNodeIfNoLinkToList(vstTrubokMainTree.RootNode,ProgramData.AccessoriesLayingInUseList);
vstTrubokMainTree.EndUpdate;
end;
|
--------------------
...И приколется обломившийся и oбломится приколовшийся... |
Invalid Pointer operation в VirtualStringTree, Проблема с заполнением списка 
Загрузка ...
