Правильная ссылка на эту страницу
http://az-design.ru/Support/DataBase/DBTree2/4100.shtml

Таблица Goods(Товары) на двух таблицах

Архангельский Андрей

Общая идея

       Конечно, пять деревьев в таблице Goods это хорошо, но
       — во-первых это создает некоторые проблемы, о которых говорилось выше,
       — во-вторых, при большой таблице для каждого менеджера хотелось бы построить свое подмножество товаров, в котором он бы мог искать быстрее. Кроме того, у бухгалтерии может быть другой взгляд на классификацию, чем у директора.
       Таким образом необходим какой-то механизм, который позволит создавать неограниченное число деревьев. Для получения этого механизма можно провести радикальную операцию — отделить описание структуры от описания товаров и положить его в отдельную таблицу.
       Вот как это делается:

Create table GOODSNew2
      (GOODSNO    AZInt32 NOT NULL PRIMARY KEY,
       GDNames    AZTitle not null,    -- наименование товара в сокращенном виде
       GOODNAMR   AZLEGEND,   -- наименование товара на русском языке
       GOODNAME   AZLEGEND,   -- наименование товара на английском языке
       GDTradMrk  AZNames,    -- торговая марка
       GDTNVED    AZNOTXT,    -- Код товара по ТН ВЭД
       GDEANCODE  AZNOTXT,    -- Код товара по EAN-13
       GDUPCCODE  AZNOTXT,    -- Код товара по UPC
       GDFIRMCOD  AZNOTXT not null, -- Каталожный код товара
       GDINTCODE  AZNOTXT not null, -- Внутрифирменный код товара
       GDVINCODE  AZNames,    -- VIN-код или его подобие товара / или ТУ;ГОСТ
       GDDESCRPT  AZNotes,
       GdStruct   AZInt32D0,  -- Признак 1- структура, 0- товар
Unique(GdIntCode,GdNames),
Unique(GdFirmCod,GdNames));   -- описание – текст
Commit;
Insert into GoodsNew2(GoodsNo,GdNames,GdFirmCod,GdIntCode) values(0,'','','');
Commit;

       Эта таблица в точности повторяет предыдущий вариант, но без столбцов для построения дерева. Единственный столбец, который появился — это GdStruct — признак, позволяющий определить относится запись к структуре или к описанию товара. Столбец никак не участвует в построении дерева и введен только из практических целей для уменьшения объема данных, которые приходится просматривать при построении первого дерева.
       Кроме того, необходимо сразу вставить строку с нулевыми значениями.
       Список деревьев или классификаций создается в отдельной таблице:

Create table GOODSClass
      (ClassNO    AZInt32 NOT NULL PRIMARY KEY,
       Code       AZNOTXT not null unique,    -- Код классификации
       CName      AZTitle not null unique,    -- Наименование классификации
       CNumb      AZInt32D0, -- номер кодового поля
       Notes      AZNotes);   -- описание – текст
Commit;

       Единственное что отличает эту таблицу от простого списка — это столбец CNumb, который указывает на номер столбца кодового поля — GDINTCODE (1), GDTNVED (2), GDEANCODE (3), GDUPCCODE (4), GDFIRMCOD (5) — что требуется для правильного отображения на дереве.
       И теперь можно создавать таблицу для деревьев:

Create table GOODSTree2
      (CTree    AZInt32 default 0 not null references GoodsClass on update cascade,
       Parnt        AZInt32 default 0 not null references GoodsNew2 on update cascade,
       Child        AZInt32 default 0 not null references GoodsNew2 on update cascade,
       PCnt         AZInt32D0,
       GdOrd        AZInt32D0,
       CLev         AZInt32D0,
Primary key(CTree,Parnt,Child));
Commit;

       Столбец CTree — для обозначения номера дерева (классификации).
       Столбец Parnt — указывает на товар (категорию), который является родителем.
       Столбец Child — указывает на товар (категорию), который является ребенком.
       Столбец PCnt — также как и раньше показывает количество детей у узла-родителя.
       Столбец GdOrd — показывает порядок сортировки детей у узла-родителя.
       Также несколько изменились и тригера для таблицы GoodsTree2. Теперь нужно учитывать не только родителя, но и номер дерева:

SET TERM !! ;
CREATE TRIGGER GOODSTree2_Insert FOR GOODSTree2
ACTIVE BEFORE INSERT POSITION 0
AS
BEGIN
   Update GOODSTree2 g SET g.PCnt=g.PCnt+1
          where g.Child=new.Parnt and g.CTree=new.CTree;
END !!
SET TERM ; !!
Commit;
SET TERM !! ;
CREATE TRIGGER GOODSTree2_Update FOR GOODSTree2
ACTIVE BEFORE UPDATE POSITION 0
AS
BEGIN
If (old.Parnt<>new.Parnt) then
    begin
      Update GOODSTree2 g SET g.PCnt=g.PCnt-1
             where g.Child=old.Parnt and g.CTree=old.CTree;
      Update GOODSTree2 g SET g.PCnt=g.PCnt+1
             where g.Child=new.Parnt and g.CTree=new.CTree;
    End
END !!
SET TERM ; !!
Commit;
SET TERM !! ;
CREATE TRIGGER GOODSTree2_Delete FOR GOODSTree2
ACTIVE BEFORE DELETE POSITION 0
AS 
BEGIN Update GOODSTree2 g SET g.PCnt=g.PCnt-1 where g.Child=old.Parnt and g.CTree=old.CTree; END !! SET TERM ; !! Commit;

       После построения таблиц можно начинать строить приложение, которое с ними работает. Это приложение лежит в каталоге Example12.
       Для начала положим на форму ComboBox, в котором будет список деревьев. Заполнение его можно выполнить в процедуре CreateForm:

   cbxGoodsClass.Items.Clear;
   qrExeTemp.Close;   qrExeTemp.SQL.Clear;
   qrExeTemp.SQL.Add('Select CName,ClassNo from GoodsClass');
   qrExeTemp.SQL.Add(' order by ClassNo');
   qrExeTemp.Open;  qrExeTemp.First;
   while not qrExeTemp.Eof do begin
      cbxGoodsClass.Items.Add(qrExeTemp.FieldValues['cName']);
      qrExeTemp.Next;
   end;
   qrExeTemp.Close;

       После этого можно написать процедуру, которая сохранит структуру таблицы GoodsNew в скрипте используя формат заполнения таблицы GoodsTree2. При этом сами описания товаров можно сохранить любым способом — либо используя инструменты IBExpert, EMS IBManager, либо просто скопировать, используя запрос:

Insert into GoodsNew2(GDNames,GOODNAMR,GOODNAME,GDTradMrk,GDTNVED,GDEANCODE,
                      GDUPCCODE,GDFIRMCOD,GDINTCODE,GDVINCODE,GDDESCRPT,)
             select   GDNames,GOODNAMR,GOODNAME,GDTradMrk,GDTNVED,GDEANCODE,
                      GDUPCCODE,GDFIRMCOD,GDINTCODE,GDVINCODE,GDDESCRPT
             from GoodsNew;

       Процедуру преобразования структуры деревьев привяжем к какой-нибудь кнопке, например, btnGoodsOldToSQL:

procedure TForm1.btnGoodsOldToSQLClick(Sender: TObject);
Var
   SvCursor : TCursor;
   Br,GdCode,sFld : String;
   Str1,Str2,Str3,Str4,Str1A,Str2A : String;
   TrNo : Integer;
begin
  inherited;
SvCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
 if not DirectoryExists(ExtractFilePath(Application.ExeName)+'\DtSave') then
    if not CreateDir(ExtractFilePath(Application.ExeName)+'\DtSave') then
    raise Exception.Create('Cannot create '+ExtractFilePath(Application.ExeName)+'\DtSave');
   TrNo := cbxGoodsClass.tag;
   Br := Char(Ord('A')+TrNo-1);
   AssignFile(flReprt,ExtractFilePath(Application.ExeName)+'\DtSave\GoodsTree2'+Br+'.txt');
   ReWrite(flReprt);

Сначала нужно удалить все, что было в таблице GoodsNewLev:

   qrExeProc.Close;    qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Delete from GoodsNewLev');
   qrExeProc.ExecSQL;

       Затем выполнить процедуру GoodsNewChildLev, которая ищет всех детей указанного узла, в данном случае корня одного из деревьев:

   qrExeProc.Close;    qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Execute procedure GoodsNewChildLev('+IntToStr(TrNo)+','+IntToStr(TrNo)+',0)');
   qrExeProc.ExecSQL;

       Затем строится запрос для выборки необходимых данных. Так как поиск детей происходит только для одного дерева, то и выборка происходит с учетом номера дерева. Как следствие — продедура должна быть выполнена для каждого дерева в отдельности. В строковых переменных Str1A, STr2A строятся заготовки для запросов, которые будут выводится в скрипт.

   qrExeProc.Close;    qrExeProc.SQL.Clear;
   Str1A := 'Insert into GoodsTree2(CTree,Parnt,Child)';
   case cbxGoodsClass.tag of
      1 : begin
          qrExeProc.SQL.Add('Select gp.GDNames as gp_GDNames, gp.GDIntCode as gp_GDCode,');
          qrExeProc.SQL.Add('       gd.GDNames as gd_GdNames, gd.GDIntCode as gd_GDCode');
          Str2A := 'Select 1,p.GoodsNo,c.GoodsNo from GoodsNew2 p, GoodsNew2 c';
          GdCode := 'GdIntCode';
          end;
      2 : begin
          qrExeProc.SQL.Add('Select gp.GDNames as gp_GDNames, gp.GDTNVED as gp_GDCode,');
          qrExeProc.SQL.Add('       gd.GDNames as gd_GdNames, gd.GDTNVED as gd_GDCode');
          Str2A := 'Select 2,p.GoodsNo,c.GoodsNo from GoodsNew2 p, GoodsNew2 c';
          GdCode := 'GdTNVED';
          end;
      3 : begin
          qrExeProc.SQL.Add('Select gp.GDNames as gp_GDNames, gp.GDEANCode as gp_GDCode,');
          qrExeProc.SQL.Add('       gd.GDNames as gd_GdNames, gd.GDEANCode as gd_GDCode');
          Str2A := 'Select 3,p.GoodsNo,c.GoodsNo from GoodsNew2 p, GoodsNew2 c';
          GdCode := 'GdEANCode';
          end;
      4 : begin
          qrExeProc.SQL.Add('Select gp.GDNames as gp_GDNames, gp.GDFirmCod as gp_GDCode,');
          qrExeProc.SQL.Add('       gd.GDNames as gd_GdNames, gd.GDFirmCod as gd_GDCode');
          Str2A := 'Select 4,p.GoodsNo,c.GoodsNo from GoodsNew2 p, GoodsNew2 c';
          GdCode := 'GdFirmCod';
          end;
      5 : begin
          qrExeProc.SQL.Add('Select gp.GDNames as gp_GDNames, gp.GDIntCode as gp_GDCode,');
          qrExeProc.SQL.Add('       gd.GDNames as gd_GdNames, gd.GDIntCode as gd_GDCode');
          Str2A := 'Select 5,p.GoodsNo,c.GoodsNo from GoodsNew2 p, GoodsNew2 c';
          GdCode := 'GdIntCode';
         end;
   end;
   qrExeProc.SQL.Add('from GoodsNewLev gl');
   qrExeProc.SQL.Add('  join GoodsNew gp on gl.GdParent=gp.GoodsNo');
   qrExeProc.SQL.Add('  join GoodsNew gd on gl.GoodsNo=gd.GoodsNo');
   qrExeProc.SQL.Add(' and gd.GdTreeNo<>0');
   qrExeProc.SQL.Add('order by gl.GdsLevel');
   qrExeProc.Open;  qrExeProc.First;

       После открытия запроса и получения данных в цикле строятся и выводятся запросы в скрипт.

   While not qrExeProc.Eof do begin
      Str1 := Str1A;   Str2 := Str2A;
      if Trim(qrExeProc.FieldValues['gp_GdCode'])<>'.' then begin
         sFld := qrExeProc.FieldValues['gp_GdNames'];
         Str3 := ' where (p.GdNames='''+sFld+'''';
         sFld := Trim(qrExeProc.FieldValues['gp_GdCode']);
         Str4 := '              and p.'+GdCode+'='''+sFld+''')';
         WriteLn(flReprt,Str1);  WriteLn(flReprt,Str2);
         WriteLn(flReprt,Str3);  WriteLn(flReprt,Str4);
         sFld := qrExeProc.FieldValues['gd_GdNames'];
         Str3 := '   and (c.GdNames='''+sFld+'''';
         sFld := Trim(qrExeProc.FieldValues['gd_GdCode']);
         Str4 := '              and c.'+GdCode+'='''+sFld+''');';
         WriteLn(flReprt,Str3);  WriteLn(flReprt,Str4);
         WriteLn(flReprt,'');
         end;
      qrExeProc.Next;
   end; //   if not qrExeProc.Eof then
CloseFile(flReprt);
Screen.Cursor := SvCursor;
ShowMessage('Ветка сохранена');
{$IFDEF AZDEBUG} WriteReprtText('-btnGoodsOldToSQLClick');{$ENDIF}
end;

       Как результат получаем SQL-скрипт следующего вида:

Insert into GoodsTree2(CTree,Parnt,Child)
Select 1,p.GoodsNo,c.GoodsNo from GoodsNew2 p, GoodsNew2 c
 where (p.GdNames='Внутрифирменные коды продавца'
              and p.GdIntCode='Коды внутренние')
   and (c.GdNames='Бытовая техника'
              and c.GdIntCode='Быт.Техника');
Insert into GoodsTree2(CTree,Parnt,Child)
Select 1,p.GoodsNo,c.GoodsNo from GoodsNew2 p, GoodsNew2 c
 where (p.GdNames='Внутрифирменные коды продавца'
              and p.GdIntCode='Коды внутренние')
   and (c.GdNames='Компьютерная техника (Компьютеры, периферия и комплектующие)'
              and c.GdIntCode='Комп.Техника');
Insert into GoodsTree2(CTree,Parnt,Child)
Select 1,p.GoodsNo,c.GoodsNo from GoodsNew2 p, GoodsNew2 c
 where (p.GdNames='Внутрифирменные коды продавца'
              and p.GdIntCode='Коды внутренние')
   and (c.GdNames='Книги, журналы и другие средства массовой информации'
              and c.GdIntCode='Книги');

       который правильным образом построит дерево по новому принципу.

 

Отображение дерева на экране

       Принцип отображения дерева очень похож на отображение дерева из одной таблицы. Это не удивительно, так как вторая таблица по сути — это часть первой таблицы.
       Как всегда построение начинается с процедуры GoodsDatasetOpen:

procedure TForm1.GoodsDatasetOpen();
Var
   RowChild : Integer;
   z : Integer;
   sFld,sCod: String;
   NewNode : TTreeNode;
begin
  inherited;
  If qrGoodsTree.Database.Connected then begin
     tvGoods.Items.Clear;
     tvGoods.Items.BeginUpdate;
     trGoodsTree.Active := True;
     qrGoodsTree.Close;  qrGoodsTree.SQL.Clear;
     qrGoodsTree.SQL.Add('Select g.GoodsNo, g.'+xGdCode+', g.GdNames,');
     qrGoodsTree.SQL.Add('t.PCnt,t.GdOrd from GoodsTree2 t');
     qrGoodsTree.SQL.Add('  join GoodsNew2 g on t.Child=g.GoodsNo');
     qrGoodsTree.SQL.Add(' where t.Parnt=0');
     qrGoodsTree.SQL.Add('   and t.CTree='+IntToStr(cbxGoodsClass.Tag));
     qrGoodsTree.SQL.Add(' order by t.GdOrd');
     qrGoodsTree.Open;
     qrGoodsTree.First;

       Разница только в том, что теперь данные извлекаются из двух таблиц. Из таблицы GoodsNew2 извлекаются номер товара и столбцы по которым его можно идентифицировать — GdIntCode и GdNames. Вместо столбца GdIntCode может быть другой — GdTNVED, GdEANCode, GdFirmCode. Текущее значение определяется в описании квалификации и, соответственно, присваивается переменной xGdCode при выборе дерева. Так как по определению ID родительского узла при построении корня равно 0, то выбираются только дети корневого узла.
       Из таблицы GoodsTreew2 выбираются количество детей у конкретного узла и его порядок на дереве. В отображении дерева напрямую столбец GdOrd не используется, но по нему осуществляется сортировка результатов запроса и, следовательно, в данном порядке заполняются ветви дерева.

     While not qrGoodsTree.Eof do begin
        sCod := '';
        If not VarIsNull(qrGoodsTree.FieldValues[xGdCode]) then begin
           sCod := qrGoodsTree.FieldValues[xGdCode];
           sCod := sCod + ' - ';
           end;
        sFld := qrGoodsTree.FieldValues['GdNames'];
        z := qrGoodsTree.FieldValues['GoodsNo'];
        RowChild := qrGoodsTree.FieldValues['PCnt'];
        NewNode := tvGoods.Items.Add(tvGoods.TopItem,sCod+sFld);
        NewNode.ImageIndex := z;
        If RowChild>0 then tvGoods.Items.AddChild(NewNode,IntToStr(RowChild));
        qrGoodsTree.Next;
     end; // While
     trGoodsTree.Active := False;
     tvGoods.Items.EndUpdate;
     tvGoods.Update;
  end;
end;

       Отображение ветвей на самом дереве не отличается от предыдущих вариантов.
       Вторая процедура tvGoodsExpanding выполняется при раскрытии выбранного узла:

procedure TForm1.tvGoodsExpanding(Sender: TObject; Node: TTreeNode;
                                         var AllowExpansion: Boolean);
Var
   RowChild : Integer;
   x,z : Integer;
   sFld,sCod: String;
   NewNode : TTreeNode;
begin
  inherited;
  If Node.HasChildren then begin
     x := Node.ImageIndex;
     Node.DeleteChildren;
     tvGoods.Items.BeginUpdate;
     trGoodsTree.Active := True;
     qrGoodsTree.Close;  qrGoodsTree.SQL.Clear;
     qrGoodsTree.SQL.Add('Select g.GoodsNo, g.'+xGdCode+', g.GdNames,t.PCnt,');
     qrGoodsTree.SQL.Add('t.PCnt,t.GdOrd from GoodsTree2 t');
     qrGoodsTree.SQL.Add('join GoodsNew2 g on t.Child=g.GoodsNo');
     qrGoodsTree.SQL.Add('where t.Parnt='+IntToStr(x));
     qrGoodsTree.SQL.Add('  and t.CTree='+IntToStr(cbxGoodsClass.Tag));
     qrGoodsTree.SQL.Add('order by t.GdOrd');
     qrGoodsTree.Open;     qrGoodsTree.First;

       Запрос повторяет предыдущий, но дети выбираются для узла, ID которого указано в свойстве ImageIndex выбранного узла на отображаемом дереве.

     While not qrGoodsTree.Eof do begin
        sCod := '';
        If not VarIsNull(qrGoodsTree.FieldValues[xGdCode]) then begin
           sCod := qrGoodsTree.FieldValues[xGdCode];
           sCod := sCod + ' - ';
           end;
        sFld := qrGoodsTree.FieldValues['GdNames'];
        z := qrGoodsTree.FieldValues['GoodsNo'];
        RowChild := qrGoodsTree.FieldValues['PCnt'];
        NewNode := tvGoods.Items.AddChild(Node,sCod+sFld);
        NewNode.ImageIndex := z;
        If RowChild>0 then tvGoods.Items.AddChild(NewNode,IntToStr(RowChild));
        qrGoodsTree.Next;
     end; // While
     trGoodsTree.Active := False;
     tvGoods.Items.EndUpdate;
     tvGoods.Update;
  end;
end;

       И точно также добавим ветви для выбранного узла.
       То что у нас получилось показано на рисунке:


Рис.3-1 Отображение дерева на двух таблицах

       Операции по переносу узлов внутри одного дерева реализованы также как и в случае одной таблицы, за исключением процедуры, которая размещает узел на новом месте:

procedure TForm1.tvGoodsEndDrag(Sender, Target: TObject; X, Y: Integer);
Var
   iTRGIndex, iSRCIndex : Integer;
   iSrcParnt : Integer;
begin
  inherited;
  iTRGIndex := TRGNode.ImageIndex;
  iSRCIndex := SRCNode.ImageIndex;
  iSrcParnt := SRCNode.Parent.ImageIndex;
  If iTRGIndex<>iSRCIndex then begin
     if trExeProc.Active then trExeProc.Commit;
     qrExeProc.Close;
     qrExeProc.SQL.Clear;
     qrExeProc.SQL.Add('Update GoodsTree2 set Parnt='+IntToStr(iTRGIndex));
     qrExeProc.SQL.Add(' where Child='+IntToStr(iSRCIndex));
     qrExeProc.SQL.Add('   and Parnt='+IntToStr(iSRcParnt));
     qrExeProc.SQL.Add('   and CTree='+IntToStr(cbxGoodsClass.Tag));
     qrExeProc.ExecSQL;  trExeProc.Commit;
     qrExeProc.Close;
     TRGNode.Parent.Collapse(True);
     SRCNode.Parent.Collapse(True);
  end;
end;

       Главное отличие здесь в том, что узел, для которого изменяется родитель, определяется полностью полями CTree, Parnt,Child. Это позволяет разместить один и тот же товар в различных ветках одного и того же дерева, что невозможно было сделать в случае одной таблицы.
       Кроме того, упрощено редактирование положение текущего узла относительно других с этим же родителем. Для этого сделано две простые функции, которые вызываются из контекстного меню.

procedure TForm1.pmnNodeDown1Click(Sender: TObject);
var
 x,y : Integer;
begin
   x := tvGoods.Selected.ImageIndex;
   y := tvGoods.Selected.Parent.ImageIndex;
   if trExeTemp.Active then trExeTemp.Commit;
   qrExeTemp.Close;  qrExeTemp.SQL.Clear;
   qrExeTemp.SQL.Add('Update GoodsTree2 set GdOrd=GdOrd+1');
   qrExeTemp.SQL.Add(' where CTree='+IntToStr(cbxGoodsClass.Tag));
   qrExeTemp.SQL.Add('   and Parnt='+IntToStr(y));
   qrExeTemp.SQL.Add('   and Child='+IntToStr(x));
   trExeTemp.Active := True;
   qrExeTemp.ExecSQL;  qrExeTemp.Close;
   trExeTemp.Commit;
   if tvGoods.Selected.Parent<>nil 
        then tvGoods.Selected.Parent.Collapse(true)
        else GoodsDatasetOpen();
end;

       Простота способа заключается в том, что так как по умолчанию значение поля GdOrd=0, то для перемещения узла вниз на одну позицию достаточно это значение увеличить на единицу. А для перемещения узла вверх на одну позицию достаточно это значение уменьшить на единицу. Последовательно перемещая все узла у одного родителя достаточно легко выстроить их в нужном порядке. Обратите внимание, что узел определяется полностью.
       Подобная процедура для поднятия узла называется pmnNodeUp1Click.
       И, наконец, редактирование детей в узле происходит также как описано в разделе "Второй вариант заполнения таблицы Goods" подраздел "Отображение записи на форме".

 

Удаление узла из дерева

       На этом радости закончились и начались проблемы. Если в однотабличной древовидной структуре удаление узла содержащем детей ограничивалось связями, в которых было достаточным запретить каскадное удаление, то в древовидной структуре на двух таблицах это невозможно. Т.е. каскадное удаление конечно же запрещено, так как это бы удаляло описание элементов. Но сам узел находится в другой таблице и ничего не мешает его удалить. Однако, если узел с дочерними элементами будет удален, то дочерние элементы повиснут в пустоте и, следовательно, станут недоступными, что создает множество проблем. Дж.Селко предлагает находить все дочерние узлы и удалять их вместе с текущим. Это не очень хорошее решение, так как пользователь должен либо помнить, что содержит ВСЯ ветвь от текущего узла, либо каждый раз проверять это содержимое. В противном случае по ошибке может быть уничтожено большое количество информации.
       Разумное решение заключается в том, чтобы запретить удаление узла, у которого есть дочерние элементы, и добавить операцию, которая переносит дочерние элементы к родителю удаляемого узла. И пользователь сможет в каждом конкретном случае решить куда поместить освободившиеся элементы.
       Запрет на удаление узла с дочерними элементами легко решается с помощью исключений в самой базе данных. Для этого нужно сначала создать исключение:

Create Exception NoDeleteNode 'Этот узел не пустой - удаление невозможно';
Commit;

       После этого нужно исправить триггер на удаление для таблицы GoodsTree2:

SET TERM !! ;
CREATE TRIGGER GOODSTree2_Delete FOR GOODSTree2
ACTIVE BEFORE DELETE POSITION 0
AS BEGIN
  If (old.PCnt>0) then Exception NoDeleteNode;
  If (old.PCnt=0) then
     Begin
        Update GOODSTree2 g SET g.PCnt=g.PCnt-1
         where g.Child=old.Parnt and g.CTree=old.CTree;
     End
END !!
SET TERM ; !!
Commit;

       Так как количество дочерних элементов всегда подсчитывается в поле PCnt, то перед удалением узла можно проверить значение old.PCnt — если оно больше 0, то вызывается исключение, если оно равно 0, то триггер срабатывает в обычном режиме уменьшая счетчик узлов для родительского узла. Как это работает показано на рисунке ниже:


Рис.3-2 Удаление узла с дочерними элементами

       Для удаления узла в контекстное меню добавлена функция "Удаление узла", которая реализована в процедуре pmnNodeDeleteClick:

procedure TForm1.pmnNodeDeleteClick(Sender: TObject);
Var
 x,y : Integer;
begin
   x := tvGoods.Selected.ImageIndex;
   y := tvGoods.Selected.Parent.ImageIndex;
   if trExeTemp.Active then trExeTemp.Commit;
   qrExeTemp.Close;  qrExeTemp.SQL.Clear;
   qrExeTemp.SQL.Add('Delete from GoodsTree2');
   qrExeTemp.SQL.Add(' where CTree='+IntToStr(cbxGoodsClass.Tag));
   qrExeTemp.SQL.Add('   and Parnt='+IntToStr(y));
   qrExeTemp.SQL.Add('   and Child='+IntToStr(x));
   trExeTemp.Active := True;
   qrExeTemp.ExecSQL;  qrExeTemp.Close;
   trExeTemp.Commit;
   if tvGoods.Selected.Parent<>nil 
      then tvGoods.Selected.Parent.Collapse(true)
      else GoodsDatasetOpen();
end;

       Чтобы облегчить пользователю освобождение узла от дочерних элементов, в это же меню добавлена функция "Поднять дочерние узла", которая реализована в процедуре pmnChildUpClick:

procedure TForm1.pmnChildUpClick(Sender: TObject);
Var
 x,y : Integer;
begin
   x := tvGoods.Selected.ImageIndex;
   y := tvGoods.Selected.Parent.ImageIndex;
   if trExeTemp.Active then trExeTemp.Commit;
   qrExeTemp.Close;  qrExeTemp.SQL.Clear;
   qrExeTemp.SQL.Add('Update GoodsTree2 set Parnt='+IntToStr(y));
   qrExeTemp.SQL.Add(' where CTree='+IntToStr(cbxGoodsClass.Tag));
   qrExeTemp.SQL.Add('   and Parnt='+IntToStr(x));
   trExeTemp.Active := True;
   qrExeTemp.ExecSQL;  qrExeTemp.Close;
   trExeTemp.Commit;
   if tvGoods.Selected.Parent<>nil 
      then tvGoods.Selected.Parent.Collapse(true)
      else GoodsDatasetOpen();
end;

Наполнение дерева из таблицы GoodsNew2

       Если в однотабличной древовидной структуре невозможно включить элемент, так чтобы он не принадлежал ни одному родительскому узлу, то в данном случае "мухи отдельно, котлеты отдельно". Можно заполнить таблицу GoodsNew2 необходимым количеством (оно может быть достаточно большим) описаний как товаров, так и структур, и при этом они не будут связаны с каким либо узлом. Как говорится за что боролись на то и напоролись. Для заполнения таблицы GoodsNew2 описаниями товаров воспользуйтесь вкладкой "Новый элемент", которая описана в разделе "Вставка нового элемента".
       Таким образом необходимо отобразить таблицу GoodsNew2 и организовать какой-либо поиск, не основанный на дереве. Решение можно найти на вкладке GoodsTree2 Edit:


Рис.3-3 Таблица для редактирования дерева GoodsTree2

       Для удобства работы добавлено несколько кнопок и полей:
       — третья кнопка в верхнем ряду запоминает текущую ветку дерева, в которую будут переносится выбранные элементы;
       — вторая кнопка в верхнем ряду отменяет запомненную ветку дерева и запоминает корень дерева;
       — последняя кнопка во втором ряду (рядом с навигатором) переносит выбранный элемент в текущую ветку дерева;
       — рядом с ней поле для образца по кодовому полю в соответствиии с выбранным деревом — GdIntCode, GdTNVED, GdEANCode, GdFirmCode — конкретное поле выбирается при выборе дерева;
       — следующее поле служит для образца по полю GdNames;
       — и, наконец, CheckBox позволяет выбирать записи относящиеся к структуре или товару.
       Так как можно искать по нескольким условиям, то запрос для редактирования этой таблицы формируется в отдельной процедуре, которая привязана к событиям onChange полей с образцами:

procedure TForm1.SearchGoods(Sender: TObject);
begin
   If trGoodsTree2.Active then trGoodsTree2.Commit;
   qrGoodsTree2.Close;  qrGoodsTree2.SQL.Clear;
   qrGoodsTree2.SQL.Add('Select g.* from GoodsNew2 g');
   qrGoodsTree2.SQL.Add('Where not exists (select distinct t.Child from GoodsTree2 t');
   qrGoodsTree2.SQL.Add(' where t.Child=g.GoodsNo and t.CTree='+IntToStr(cbxGoodsClass.Tag)+')');
   qrGoodsTree2.SQL.Add(' and g.GoodsNo<>0 and GdNames like ''%'+edSearchNames.Text+'%''');
   qrGoodsTree2.SQL.Add(' and '+xGdCode+' like '''+edSearchCode.Text+'%''');
   if chkStruct.Checked then qrGoodsTree2.SQL.Add(' and g.GdStruct=1');
   if not chkStruct.Checked then qrGoodsTree2.SQL.Add(' and g.GdStruct=0');
   qrGoodsTree2.SQL.Add(' order by g.GdNames');
   trGoodsTree2.Active := True;
   qrGoodsTree2.Open;   qrGoodsTree2.First;
end;

       Запрос отбирает из элементы по следующим условиям:
       Во-первых, выбираются все столбцы из таблицы GoodsNew2;
       Во-вторых, выбираются только те записи таблицы GoodsNew2, которые не перечислены в текущем дереве;
       В-третьих, выбираются только те записи, значения столбца, указанного в переменной xGdCode, начинается с символов введенных в поле edSearchCode;
       В-четвертых, выбираются только те записи, значения столбца GdNames включают символы введенные в поле edSearchNames;
       И, наконец, в зависимости от значения chkStruct выбираются записи с признаком "Структура" или "Товар".
       Все эти условия позволяют существенно уменьшить массив для поиска.
       Выбранные записи показываются в сетке, а на форме отображается текущая запись.
       Для переноса выбранной записи в дерево достаточно нажать на кнопку "Перенос элемента в дерево" для которой реализована весьма простая функция:

procedure TForm1.btnMoveToTreeClick(Sender: TObject);
Var
  x : integer;
begin
   x := qrGoodsTree2.FieldValues['GoodsNo'];
   qrExeProc.Close;   qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Insert into GoodsTree2(CTree,Parnt,Child)');
   qrExeProc.SQL.Add(' Values('+IntToStr(cbxGoodsClass.Tag)+',');
   qrExeProc.SQL.Add(IntToStr(iPrntNode)+','+IntToStr(x)+');');
   qrExeproc.ExecSQL;  qrExeProc.Close;
   trExeProc.Commit;   qrGoodsTree2.Refresh;
end;

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

 

Окончательное формирование дерева

       И все-таки наполнять дерево из таблицы GoodsNew2 не очень удобно. Поэтому желательно чтобы товар входил в какую-либо классификацию. Например, товары одной фирмы записаны как каталог этой фирмы в древовидном виде. Тогда для формирования своей классификации достаточно будет перенести товар из одной классификации в другу. Так как, например, это происходит в программе FAR по клавише F5. Для этого достаточно построить два одинаковых дерева, как это показано на рисунке:


Рис.3-4 Перенос из одного дерева в другое

       Дерево слева определено как tvGoodsA, а дерево справа как tvGoodsB. Товар переносится из текущего дерева в противоположное. Для того чтобы знать куда переносить товар для каждого дерева в событии onEnter определена процедура:

procedure TForm1.tvGoodsAEnter(Sender: TObject);
begin
  btnTree2Tree.Caption := 'Дерево A ==>> Дерево B';
  btnTree2Tree.Tag := 12;  // для дерева B = 21
end;

       Тогда кнопка btnTree2Tree будет знать и показывать направление переноса. А при нажатии на кнопку будет вызываться процедура:

procedure TForm1.btnTree2TreeClick(Sender: TObject);
Var
 SelNodeA,SelNodeB : TTreeNode;
 x,y : Integer;
begin
   SelNodeA := tvGoodsA.Selected;
   SelNodeB := tvGoodsB.Selected;

       Для начала нужно запомнить выбранные узлы одного и другого дерева. При этом считается, что узел назначения будет родительским для переносимого узла.

      if trExeTemp.Active then trExeTemp.Commit;
      qrExeTemp.Close;  qrExeTemp.SQL.Clear;
      qrExeTemp.SQL.Add('Insert into GoodsTree2(CTree,Parnt,Child)');
   if btnTree2Tree.Tag=12 then begin
      qrExeTemp.SQL.Add(' Values('+IntToStr(cbxGoodsTreeB.Tag)+',');
      qrExeTemp.SQL.Add(IntToStr(SelNodeB.ImageIndex)+',');
      qrExeTemp.SQL.Add(IntToStr(SelNodeA.ImageIndex)+');');
   end;
   if btnTree2Tree.Tag=21 then begin
      qrExeTemp.SQL.Add(' Values('+IntToStr(cbxGoodsTreeA.Tag)+',');
      qrExeTemp.SQL.Add(IntToStr(SelNodeA.ImageIndex)+',');
      qrExeTemp.SQL.Add(IntToStr(SelNodeB.ImageIndex)+');');
   end;
      trExeTemp.Active := True;
      qrExeTemp.ExecSQL;  qrExeTemp.Close;
      trExeTemp.Commit;

       Формирование и выполнение запроса для вставки в таблицу GoodsTree2 записи о новом узле.

   if btnTree2Tree.Tag=12 then begin
      tvGoodsB.Selected.Collapse(True);
      tvGoodsB.Selected.Expand(False);
   end;
   if btnTree2Tree.Tag=21 then begin
      tvGoodsA.Selected.Collapse(True);
      tvGoodsA.Selected.Expand(False);
   end;
end;

       И, наконец, узел назначения сворачивается и вновь раскрывается, для того чтобы показать новый узел.
       При переносе узла из дерева в дерево можно один и тот же узел разместить в двух разных родительских узлах. Эта необходимость возникает, например, для книг, которые выпущены давно, указан издательством указан один код УДК, а в настоящее время используется другой. В таких случаях одна и та же книга указывается в двух разделах и, следовательно, может быть найдена двумя способами.

 

Вставка нового элемента

       С одной стороны есть возможность вносить в таблицу GoodsNew2 новые товары и элементы структуры никак не связанные с таблицей GoodsTree2. С другой стороны, при большом количестве элементов достаточно сложновыбрать конкретный элемент для включения его в конкретное дерево.
       Для добавления нового элемента используется вкладка "Новый элемент":


Рис.3-5 Вставка нового элемента

       Это наверное самый простой способ заполнения дерева. Форма включает в себя все кодовые поля для всех деревьев и все поля, которые отвечают за уникальность элемента в таблице GoodsNew2. При этом заполненная запись записывается сразу в две таблицы — GoodsNew2, как описание элемента, и — GoodsTree2, в выбранное дерево и в запомненную ветку дерева.

 

Вспомогательные процедуры и скрипты

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

set term !! ;

Create procedure GoodsNew2GetChild (GdsPrnt Integer, Tree SmallInt, ItLev SmallInt) returns (GdsChld Integer, GdsLev SmallInt) as begin for select Child from GoodsTree2 where CTree=:Tree and Parnt=:GdsPrnt into :GdsChld do begin GdsLev = ItLev + 1; suspend; for select GdsChld,GdsLev from GoodsNew2GetChild(:GdsChld,:Tree,:GdsLev) into :GdsChld,:GdsLev do begin suspend; end end end !! set term ; !! Commit;

       В данном случае поиск детей происходит по таблице GoodsTree2, а не по таблице GoodsNew2. Кроме того, номер дерева указывается в запросе, а не в условиях построения запроса, как это было в процедуре GoodsNewGetChild. Для сохранения результатов также используется вспомогательная таблица GoodsNew2Lev.
       Однако если присмотрется в к таблице GoodsTree2, то можно увидеть, что она повторяет таблицу GoodsNew2Lev, за исключением столбца CLev. Этот столбец и нужно добавить в таблицу GoodsTree2. Список детей любого узла уже есть в этой таблице — необходимо добавить только уровень узла в текущем дереве. Для чего можно использовать новую процедуру GoodsNew2SetLevel:

set term !! ;
Create procedure GoodsNew2SetLevel (GdsPrnt Integer, Tree SmallInt, ItLev SmallInt)
       returns (GdsChld Integer, GdsLev SmallInt) as
begin
   for select Child from GoodsTree2
        where CTree=:Tree and Parnt=:GdsPrnt into :GdsChld
       do begin
          GdsLev = ItLev + 1; 
          Update GoodsTree2 set CLev=:GdsLev 
             where CTree=:Tree and Parnt=:GdsPrnt and Child=:GdsChld;
          suspend;
          for select GdsChld,GdsLev
                from GoodsNew2SetLevel(:GdsChld,:Tree,:GdsLev)
               into :GdsChld,:GdsLev
            do begin 
               Update GoodsTree2 set CLev=:GdsLev 
                  where CTree=:Tree and Parnt=:GdsPrnt and Child=:GdsChld;
               suspend;
               end
          end
end !!
set term ; !!
Commit;

       Она повторяет процедуру GoodsNew2GetChild, добавляя при этом оператор устанавливающий значения поля CLev для соответствующего узла, который определен как CTree,Parnt,Child. Результатом работы этой процедуры можно воспользоваться при сохранении структуры таблицы GoodsTree2 как SQL-скрипт. Эта процедура связана с соответствующей кнопкой на вкладке "Скрипты" примера Example12:


Рис.3-6 Вспомогательные процедуры для обслуживания дерева

       Процедура создает SQL-скрипт для заполнения таблицы GoodsTree2:

procedure TForm1.btnSaveGoodsTree2ToSQLClick(Sender: TObject);
Var
   SvCursor : TCursor;
   Br,GdCode,sFld : String;
   sTree,sLev,sOrd : String;
   Str1,Str2,Str3,Str4,Str1A,Str2A : String;
   TrNo,iPrnt : Integer;
begin
{$IFDEF AZDEBUG} WriteReprtText('+btnSaveGoodsTree2ToSQLClick');{$ENDIF}
SvCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
 if not DirectoryExists(ExtractFilePath(Application.ExeName)+'\DtSave') then
    if not CreateDir(ExtractFilePath(Application.ExeName)+'\DtSave') then
    raise Exception.Create('Cannot create '+ExtractFilePath(Application.ExeName)+'\DtSave');
{Сохранение таблиц для построения Goods }
{$IFDEF AZDEBUG} WriteReprtText('\DtSave\GoodsTree2.txt');{$ENDIF}
   AssignFile(flReprt,ExtractFilePath(Application.ExeName)+'\DtSave\GoodsTree2.txt');
   ReWrite(flReprt);
   if qrEXeproc.Active then trExeProc.Commit;
   qrExeProc.Close;     qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select * from GoodsNew2SetLevel (0, 1, 0)');
   qrExeProc.Open;   trExeProc.Commit;
   qrExeProc.Close;     qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select * from GoodsNew2SetLevel (0, 2, 0)');
   qrExeProc.Open;   trExeProc.Commit;
   qrExeProc.Close;     qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select * from GoodsNew2SetLevel (0, 3, 0)');
   qrExeProc.Open;   trExeProc.Commit;
   qrExeProc.Close;     qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select * from GoodsNew2SetLevel (0, 4, 0)');
   qrExeProc.Open;   trExeProc.Commit;

       Вызов хранимой процедуры GoodsNew2SetLevel последовательно для всех деревьев устанавливает уровень каждого узла (элемента) относительно корня дерева.

   qrExeProc.Close;     qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select t.*,g1.GdIntCode as PrIntCode,g1.GdNames as PrNames,');
   qrExeProc.SQL.Add('           g2.GdIntCode as ChIntCode,g2.GdNames as ChNames');
   qrExeProc.SQL.Add('  from GoodsTree2 t');
   qrExeProc.SQL.Add('  join GoodsNew2 g1 on t.Parnt=g1.GoodsNo');
   qrExeProc.SQL.Add('  join GoodsNew2 g2 on t.Child=g2.GoodsNo');
   qrExeProc.SQL.Add('order by t.CTree,t.CLev');

       Дальше выполняется запрос, который дает всю информацию для построения SQL-скрипта.

{$IFDEF AZDEBUG} WriteReprtStrings('qrExeProc.SQL - GoodsNew2',qrExeProc.SQL); {$ENDIF}
   qrExeProc.Open;  qrExeProc.First;
   While not qrExeProc.Eof do begin
      sTree := IntToStr(qrExeProc.FieldValues['CTree']);
      sLev := IntToStr(qrExeProc.FieldValues['CLev']);
      sOrd := IntToStr(qrExeProc.FieldValues['GdOrd']);
      iPrnt := qrExeProc.FieldValues['Parnt'];
      if iPrnt=0 then begin
         Str1 := 'Insert into GoodsTree2(CTree,Parnt,Child,GdOrd,CLev)';
         Str2 := ' select '+sTree+',0,g2.GoodsNo,'+sOrd+','+sLev+' from GoodsNew2 g2';
         Str4 := ' where (g2.GdIntCode='''+Trim(qrExeProc.FieldValues['ChIntCode'])+'''';
         Str4 := Str4 + ' and g2.GdNames='''+qrExeProc.FieldValues['ChNames']+''');';
         WriteLn(flReprt,Str1);  WriteLn(flReprt,Str2);  WriteLn(flReprt,Str4);
      end else begin
         Str1 := 'Insert into GoodsTree2(CTree,Parnt,Child,GdOrd,CLev)';
         Str2 := ' select '+sTree+',g1.GoodsNo,g2.GoodsNo,'+sOrd+','+sLev
                +' from GoodsNew2 g1, GoodsNew2 g2';
         Str3 := ' where (g1.GdIntCode='''+Trim(qrExeProc.FieldValues['PrIntCode'])+'''';
         Str3 := Str3 + ' and g1.GdNames='''+qrExeProc.FieldValues['PrNames']+''')';
         Str4 := '   and (g2.GdIntCode='''+Trim(qrExeProc.FieldValues['ChIntCode'])+'''';
         Str4 := Str4 + ' and g2.GdNames='''+qrExeProc.FieldValues['ChNames']+''');';
         WriteLn(flReprt,Str1);  WriteLn(flReprt,Str2);
         WriteLn(flReprt,Str3);  WriteLn(flReprt,Str4);
      end;

       Запрос на заполнение таблицы GoodsTree2 строится на 3 строках, в случае корневых узлов, и на 4 строках, в случае остальных узлов.

      WriteLn(flReprt,'');
      qrExeProc.Next;
   end;
      WriteLn(flReprt,'Commit;');
CloseFile(flReprt);
Screen.Cursor := SvCursor;
ShowMessage('Таблица сохранена');
{$IFDEF AZDEBUG} WriteReprtText('-btnSaveGoodsTree2ToSQLClick');{$ENDIF}
end;

 

Тестирование дерева на циклы

       Так как один товар может определяться в нескольких категориях, то нужно обеспечить отсутствие циклов как при поиске детей, так и родителей. При этом проверку можно делать только в одном направлении — если при поиске детей циклы необнаружены, то и в обратном направлени (при поиске родителей) их также не будет.
       Для тестирования на циклы можно использовать ту же процедуру GoodsNew2GetChild, указав признак наличия цикла, в качестве которого может выступать тот факт, что текущий уровень узла не может превышать количество связей между категориями, т.е. количества записей в таблице GoodsTree2, связанных с текущим деревом.

© 01.08.2009, Архангельский А.Г.

<<Пред. Оглавление
Начало раздела
След.>>




Дата последнего изменения:
Thursday, 21-Aug-2014 09:10:44 MSK


Постоянный адрес статьи:
http://az-design.ru/Support/DataBase/DBTree2/4100.shtml