unit __DBTreeView_FireDac;

interface

Uses
  FireDAC.Comp.Client,
  Variants,
  ActiveX,
  Forms,
  StdCtrls,
  ComCtrls,
  Controls,
  Classes,
  SysUTILS;


Const
   StringEmpty = '[<Empty>]'; //пустая строка

//Функция построения "дерева" по таблице Б.Д. (заполнение TTreeView)
function Tree_CreateFromTableDB(
                                Q:TFDQuery;                              //Query (Connection должен быть корректным)
                                IdParentGuid: string;                    //id_guid строки таб, от которой строится дерево
                                tv:TTreeView;
                                ListIndex:TStrings;                      //Индексный список (ID-строк таблицы БД)
                                tn_db:string;                            //имя таблицы БД
                                fn_IdGuid:string='id_guid';              //ID-строки таблицы БД)
                                fn_ParentIdGuid:string='id_parent_guid'; //ID - родителя
                                fn_Name:string='name_this';              //Наименование узла
                                fn_Npp:string = 'npp';              //факультативно
                                fn_PictIndex:string = 'pict_index'; //факультативно
                                fn_LevelInTree:string='level_this'; //факультативно
                                MaxLevelDelta:integer=0             //факультативно
                               ):integer;

//--------------------------------
//Синхронизация ВЫБРАННОЙ строки TTreeView и TListBox
function ListBox_Synhro_by_TreeView(tv:TTreeView; lbi:TListBox):boolean;
//Синхронизация ВЫБРАННОЙ строки TListBox и TTreeView
function TreeView_Synhro_by_ListBox(lbi:TListBox; tv:TTreeView):boolean;
//--------------------------------

//Получить список ID потомков заданного узла (исключая заданный узел)
function TreeView_Node_Childs_to_TStrings(
                                          tv : TTreeView;
                                          ListIndex:TStrings;       //Индексный список
                                                                    //(ID-строк таблицы БД),
                                                                    //см. Tree_CreateFromTableDB(...)
                                          NodeStart : TTreeNode;    //Заданный узел-родитель
                                          ListResult : TStrings;    //Результат выгрузки
                                          YesWithName:boolean=false //если TRUE, то с текстом узлов
                                         ) : integer;

//--------------------------------
//Выгрузка TreeView в TStrings (с учетом иерархии)
function TreeView_SaveToTStrings(List : TStrings; tv:TTreeView) : integer;
//Сохранить TreeView в текстовый файл(с учетом иерархии)
function TreeView_SaveToTextFile(fn : string; tv:TTreeView; Encoding:TEncoding=nil) : boolean;
//Создать "дерево" (заполнить TreeView) из TStrings
function TreeView_LoadFromTStrings(List : TStrings; tv: TTreeView) : integer;
//Медленный, но простой алгоритм экспорта TreeView в Excel
function TreeView_SaveToExcel(tv:TTreeView; ListExcel : variant; sHead:string=''; StartLine:integer=1; YesDate:boolean=true; Text_EmptyChild:string='') : integer;
//--------------------------------

//--------------------------------
//Рекурсивная процедура заполнения TTreeView (вызывается из Tree_CreateFromTableDB)
procedure TreeCreate(
                     Q:TFDQuery;
                     IdParentGuid: string;
                     tv:TTreeView;
                     var ParentNode: TTreeNode;
                     ListIndex:TStrings;  //Индексный список (ID-строк таблицы БД)
                     tn_db:string;        //имя таблицы БД
                     ListTMP:TStrings;    //буфер TStrings
                     fn_IdGuid:string='id_guid';  //ID-строки таблицы БД)
                     fn_ParentIdGuid:string='id_parent_guid'; //ID - родителя
                     fn_Name:string='name_this';              //Наименование узла
                     fn_Npp:string = 'npp';              //факультативно
                     fn_PictIndex:string = 'pict_index'; //факультативно
                     fn_LevelInTree:string='level_this'; //факультативно
                     MaxLevel:integer=0                  //факультативно
                    );
//--------------------------------


//********************************************
//********************************************
//--------------------------------
//Сформировать уникальный код (на основе GUID)
function IdGuid_Get:string;
//Сформировать GUID (строковое представление)
function GuidString_Greate: String;
//--------------------------------

//--------------------------------
//Получить слово из строки Sx по номеру NumWord. UnChar - множество разделителей
function Get_Word_From_String(
                              Sx : String;
                              NumWord : integer;
                              UnChar: String=' ';
                              YesAllTrim_Before: boolean=true
                             ) : String;
{Дополняет строку S символами CharCode до CountChar}
function BuildString(S:String; CountChar:integer; CharCode:byte=32; Nr:integer=1): string;
//Удалить заданные символы из строки
function Delete_CharsFromString(Sx : String; CharsForDel:string=' ') : String;
//Инвертировать строку
function InversionString(Sx : string) : string;
//Функция удаляет из строки справа все символы, которые входят в UnChar
function RTrimUnChar(UnChar , Sx : string) : string;
//Функция удаляет из строки слева все символы, которые входят в UnChar
function LTrimUnChar(UnChar , Sx : string) : string;
//Функция удаляет из строки слева и справа все символы, которые входят в UnChar
function AllTrimUnChar(UnChar , Sx : string) : string;
//--------------------------------

implementation

function Tree_CreateFromTableDB(
                                Q:TFDQuery;                              //Query (Connection должен быть корректным)
                                IdParentGuid: string;                    //id_guid строки таб, от которой строится дерево
                                tv:TTreeView;
                                ListIndex:TStrings;                      //Индексный список (ID-строк таблицы БД)
                                tn_db:string;                            //имя таблицы БД
                                fn_IdGuid:string='id_guid';              //ID-строки таблицы БД)
                                fn_ParentIdGuid:string='id_parent_guid'; //ID - родителя
                                fn_Name:string='name_this';              //Наименование узла
                                fn_Npp:string = 'npp';              //факультативно
                                fn_PictIndex:string = 'pict_index'; //факультативно
                                fn_LevelInTree:string='level_this'; //факультативно
                                MaxLevelDelta:integer=0             //факультативно
                               ):integer;
//Функция построения "дерева" по таблице БД (заполнение TTreeView)
{
Q - TFDQuery (Connection должен быть корректным)
IdParentGuid     - id_guid строки таблицы Б.Д., от которой строится дерево
tv - визуальный компонент TTreeView
ListIndex - список id_guid строк таблицы БД (порядок сортироки - соответствует значению AbsoluteIndex в tv)
tn_db - имя таблицы БД
fn_IdGuid - имя поля, которое содержит уникальные ID строк в таблице БД (primary key)
fn_ParentIdGuid - имя поля, которое содержит уникальные ID строк "родительей" в таблице БД
fn_Name - имя поля, которое содержит визуализируемое в дереве значение (для каждой строки таблицы БД)
fn_Npp - имя поля, которое содержит порядковый номер строк в рамках "родителя" (факультативно)
fn_PictIndex - имя поля, которое содержит индекс пиктограммы дляч отображения в TreeView (факультативно)
fn_LevelInTree - имя поля, которое содержит уровень иерархии строки в "дереве" (факультативно)
MaxLevelDelta - максимальное значение поля fn_LevelInTree - для ограничения выборки строк таблицы БД (факультативно)
}
Var
  YesNext:boolean;
  ListTMP:TStrings;
  NodePar: TTreeNode;
  MaxLevel:integer;
begin
  Result:=0;
  YesNext:=false;
  if Assigned(tv) then begin
     tv.Items.Clear;
     if Assigned(ListIndex) then begin
        ListIndex.Clear;
        tn_db:=trim(tn_db);
        if tn_db<>'' then begin
           if Assigned(Q) then begin
              YesNext:=true;
           end;
        end;
     end;
  end;

  if YesNext then begin
     NodePar:=nil;
     Q.Close;
     Q.SQL.Clear;

     fn_IdGuid:= trim(fn_IdGuid);
     fn_ParentIdGuid:=trim(fn_ParentIdGuid);
     fn_LevelInTree:=trim(fn_LevelInTree);
     fn_Name:=trim(fn_Name);
     fn_Npp:=trim(fn_Npp);
     fn_PictIndex:=trim(fn_PictIndex);
     if fn_IdGuid='' then fn_IdGuid:='id_guid';
     if fn_ParentIdGuid='' then fn_ParentIdGuid:='id_parent_guid';
     if fn_Name='' then fn_Name:='name_this';
     if fn_LevelInTree='' then MaxLevelDelta:=0;
     if MaxLevelDelta>0 then begin
        if fn_LevelInTree='' then fn_LevelInTree:='level_this';
     end;
     MaxLevel:=0;
     Screen.Cursor:=crHourGlass;
     ListTMP:=TStringList.Create;
     TRY
       if MaxLevelDelta>0 then begin
          Q.Close;
          Q.SQL.Clear;
          Q.SQL.Add('select');
          Q.SQL.Add(fn_LevelInTree);
          Q.SQL.Add('from '+tn_db);
          Q.SQL.Add('where ('+fn_IdGuid+'='+#39+trim(IdParentGuid)+#39+')');
          Q.Open;
          Q.First;
          while not Q.EOF do
           begin
            MaxLevel:=Q.FieldByName(fn_LevelInTree).AsInteger;
            Q.Last;
          end;
          MaxLevel:=MaxLevel+MaxLevelDelta;
       end;
       Q.Close;
       Q.SQL.Clear;
       TreeCreate(
                  Q,
                  IdParentGuid,
                  tv,
                  NodePar,
                  ListIndex,
                  tn_db,
                  ListTMP,
                  fn_IdGuid,
                  fn_ParentIdGuid,
                  fn_Name,
                  fn_Npp,
                  fn_PictIndex,
                  fn_LevelInTree,
                  MaxLevel
                 );
       Result:=ListIndex.Count;
     FINALLY
       FreeAndNil(ListTMP);
       Q.Close;
       Q.SQL.Clear;
       Screen.Cursor:=crDefault;
     END;
  end;
end;


procedure TreeCreate(
                     Q:TFDQuery;
                     IdParentGuid: string;
                     tv:TTreeView;
                     var ParentNode: TTreeNode;
                     ListIndex:TStrings;  //Индексный список (ID-строк таблицы БД)
                     tn_db:string;        //имя таблицы БД
                     ListTMP:TStrings;    //буфер TStrings
                     fn_IdGuid:string='id_guid';  //ID-строки таблицы БД)
                     fn_ParentIdGuid:string='id_parent_guid'; //ID - родителя
                     fn_Name:string='name_this';              //Наименование узла
                     fn_Npp:string = 'npp';              //факультативно
                     fn_PictIndex:string = 'pict_index'; //факультативно
                     fn_LevelInTree:string='level_this'; //факультативно
                     MaxLevel:integer=0                  //факультативно
                    );
//Рекурсивная процедура заполнения TTreeView (вызывается из Tree_CreateFromTableDB)
//Назначение параметров - см функцию Tree_CreateFromTableDB(...)
var
  node: TTreeNode;
  sName,IdGuid:string;
  iPict,
  iIndex,
  nIndexStart,
  nIndexStop:integer;
  ChildsCount:integer;

begin
  //---------------------------------------------------
  if IdParentGuid<>'' then begin
     //Если "дерево" строится НЕ от "корня"
     //.............................
     //SQL-запрос на отбор дочерних узлов для заданного родителя
     Q.Close;
     Q.SQL.Clear;
     Q.SQL.Add('select');
     Q.SQL.Add(fn_IdGuid+', '+fn_ParentIdGuid +', '+fn_Name);
     if fn_PictIndex<>'' then begin
        Q.SQL.Add(', '+fn_PictIndex);
     end;
     if fn_Npp<>'' then begin
        Q.SQL.Add(', '+fn_Npp);
     end;
     if fn_LevelInTree<>'' then begin
        Q.SQL.Add(', '+fn_LevelInTree);
     end;
     Q.SQL.Add('from '+tn_db);
     Q.SQL.Add('where ('+fn_IdGuid+'='+#39+trim(IdParentGuid)+#39+')');
     if fn_Npp<>'' then begin
        Q.SQL.Add('order by '+fn_Npp);
     end;
     //.............................
     Q.Open;
     //.............................
     //"Вносим" "родителя" в дерево и в список id_guid строк таблицы БД
     Q.First;
     while not Q.EOF do
      begin
       IdGuid:=trim(Q.FieldByName(fn_IdGuid).AsString);
       if ListTMP.IndexOfName(IdGuid)<0 then begin
          iPict:=-1;
          if fn_PictIndex<>'' then begin
             iPict:=Q.FieldByName(fn_PictIndex).AsInteger;
          end;
          ListTMP.Values[IdGuid]:=trim(Q.FieldByName(fn_Name).AsString);
          node := tv.Items.AddChild(ParentNode, ListTMP.Values[IdGuid]{+ ' ; '+IdGuid});
          if iPict>=0 then begin
             node.ImageIndex:=iPict;
             node.SelectedIndex:=iPict;
          end;
          ListIndex.Add(IdGuid);
          ParentNode := node;
       end;
       Q.Last;
     end;
     //.............................
  end;
  //---------------------------------------------------

  //---------------------------------------------------
  //Дочерние узлы "родителя"
  //.............................
  nIndexStart:=ListTMP.Count; //номер индекса ,буфера TStrings, с которого "начнутся" "дочерние"
  ChildsCount:=0; //кол-во найденных "дочерних"
  //.............................
  //.............................
  //SQL-запрос на отбор дочерних узлов для заданного родителя
  Q.Close;
  Q.SQL.Clear;
  Q.SQL.Add('select');
  Q.SQL.Add(fn_IdGuid+', '+fn_ParentIdGuid +', '+fn_Name);
  if fn_PictIndex<>'' then begin
     Q.SQL.Add(', '+fn_PictIndex);
  end;
  if fn_Npp<>'' then begin
     Q.SQL.Add(', '+fn_Npp);
  end;
  if fn_LevelInTree<>'' then begin
     Q.SQL.Add(', '+fn_LevelInTree);
  end;
  Q.SQL.Add('from '+tn_db);
  Q.SQL.Add('where ('+fn_ParentIdGuid+'='+#39+trim(IdParentGuid)+#39+')');
  if MaxLevel>0 then begin
     Q.SQL.Add('and');
     Q.SQL.Add('('+fn_LevelInTree+'<='+IntToStr(MaxLevel)+')');
  end;
  if fn_Npp<>'' then begin
     Q.SQL.Add('order by '+fn_Npp);
  end;
  //.............................
  Q.Open;
  //.............................
  //Отбор дочерних и внесение их во временный TStrings
  Q.First;
  while not Q.EOF do
   begin
    IdGuid:=trim(Q.FieldByName(fn_IdGuid).AsString);
    if ListTMP.IndexOfName(IdGuid)<0 then begin
       iPict:=-1;
       if fn_PictIndex<>'' then begin
          iPict:=Q.FieldByName(fn_PictIndex).AsInteger;
       end;
       ListTMP.Values[IdGuid]:=IntToStr(iPict)+'|'+trim(Q.FieldByName(fn_Name).AsString);
       ChildsCount:=ChildsCount+1;
    end;
    Application.ProcessMessages;
    Q.Next;
  end;
  //.............................
  Q.Close;
  //.............................
  if ChildsCount>0 then begin
     //Если дочерние были найдены, то вносим их в "дерево" и в список id_guid строк таблицы БД
     iIndex:=nIndexStart-1;
     nIndexStop:=nIndexStart+ChildsCount-1;
     while iIndex<(nIndexStop) do
      begin
       iIndex:=iIndex+1;
       IdGuid:=trim(ListTMP.Names[iIndex]);
       //-----------------
       //Выделяем индекс картинки и наименование узла
       sName:=trim(ListTMP.Values[IdGuid]);
       sName:=trim(Get_Word_From_String(sName, 1, '|'));
       iPict:=StrToIntDef(sName, -1);
       sName:=trim(ListTMP.Values[IdGuid]);
       sName:=trim(Get_Word_From_String(sName, 2, '|'));
       //-----------------
       //-----------------
       //Вносим в "дерево"
       node := tv.Items.AddChild(ParentNode, sName);
       if iPict>=0 then begin
          node.ImageIndex:=iPict;
          node.SelectedIndex:=iPict;
       end;
       //-----------------
       //-----------------
       //Вносим в список id_guid строк таблицы БД
       ListIndex.Add(IdGuid);
       //-----------------
       //-----------------
       //рекурсивный вызов этой же функции
       TreeCreate(
                  Q,
                  IdGuid,
                  tv,
                  node,
                  ListIndex,
                  tn_db,
                  ListTMP,
                  fn_IdGuid,
                  fn_ParentIdGuid,
                  fn_Name,
                  fn_Npp,
                  fn_PictIndex,
                  fn_LevelInTree,
                  MaxLevel
                 );
       //-----------------
       Application.ProcessMessages;
     end;
  end;
  //.............................
  //---------------------------------------------------
end;

function TreeView_Synhro_by_ListBox(lbi:TListBox; tv:TTreeView):boolean;
//Синхронизация ВЫБРАННОЙ строки TListBox и TTreeView
Var
  Node:TTreeNode;
begin
  Result:=false;
  if Assigned(tv) then begin
     if Assigned(lbi) then begin
        if lbi.Focused then begin
           if lbi.ItemIndex>=0 then begin
              tv.Select(tv.Items[lbi.ItemIndex]);
              if Assigned(tv.Selected) then begin
                 Result:=true;
              end;
           end;
        end;
     end;
  end;
end;

function ListBox_Synhro_by_TreeView(tv:TTreeView; lbi:TListBox):boolean;
//Синхронизация ВЫБРАННОЙ строки TTreeView и TListBox
begin
  Result:=false;
  if Assigned(tv) then begin
     if Assigned(lbi) then begin
        if tv.Focused then begin
           lbi.ItemIndex:=-1;
           if Assigned(tv.Selected) then begin
              if (tv.Selected.AbsoluteIndex>=0) and
                 (tv.Selected.AbsoluteIndex<lbi.Items.Count) then begin
                 lbi.ItemIndex:=tv.Selected.AbsoluteIndex;
                 if lbi.ItemIndex>=0 then begin
                    Result:=true;
                 end;
              end;
           end;
        end;
     end;
  end;
end;

function TreeView_LoadFromTStrings(List : TStrings; tv: TTreeView) : integer;
//Создать "дерево" (заполнить TreeView) из TStrings
Var
  TempStream : TMemoryStream;
begin
  Result:=0;
  if Assigned(tv) then begin
     tv.Items.Clear;
     if Assigned(List) then begin
        if List.Count>0 then begin
           TempStream := TMemoryStream.Create;
           TRY
             List.SaveToStream(TempStream);
             TempStream.Position := 0;
             tv.LoadFromStream(TempStream);
             Result:=tv.Items.Count;
           FINALLY
             TempStream.Free;
           END;
        end;
     end;
  end;
end;

function TreeView_SaveToTStrings(List : TStrings; tv:TTreeView) : integer;
//Выгрузка TreeView в TStrings (с учетом иерархии)
Var
  i : integer;
  Sx : string;
begin
  Result:=0;
  if Assigned(List) then begin
     List.Clear;
     if Assigned(tv) then begin
        for i:=0 to (tv.Items.Count-1) do
         begin
           Sx:=tv.Items[i].Text;
           if tv.Items[i].Level>0 then begin
              Sx:=BuildString(Sx, length(Sx)+tv.Items[i].Level, 9,0);
           end;
           List.Add(Sx);
        end;
     end;
     Result:=List.Count;
  end;
end;

function TreeView_SaveToTextFile(fn : string; tv:TTreeView; Encoding:TEncoding=nil) : boolean;
//Сохранить TreeView в текстовый файл(с учетом иерархии)
Var
  List : TStrings;
begin
  Result:=false;
  fn:=trim(fn);
  if length(fn)>0 then begin
     if Assigned(tv) then begin
        List:=TStringList.Create;
        TRY
          TreeView_SaveToTStrings(List, tv);
          if Encoding=Nil then begin
             List.SaveToFile(fn);
          end
          else begin
             List.SaveToFile(fn,Encoding);
          end;
          Result:=true;
        FINALLY
          List.Free;
        END;
     end;
  end;
end;

function TreeView_SaveToExcel(tv:TTreeView; ListExcel : variant; sHead:string=''; StartLine:integer=1; YesDate:boolean=true; Text_EmptyChild:string='') : integer;
//Медленный, но простой алгоритм экспорта TreeView в Excel
//sHead    - заголовок (произвольный текст)
//Items - "дерево"
//Возвращаемое значение - кол-во выведенных строк (дерева)
Var
  Lev,MaxLevel,iLev,
  NumLine, NumCol,NumLineLast,NumLineFirst,
  i123,j,i,k : integer;
  YesNext:byte;
begin
  Result:=0;
  if Assigned(tv) then begin
     if not VarIsEmpty(ListExcel) then begin
        Text_EmptyChild:=trim(Text_EmptyChild);
        sHead:=trim(sHead);
        MaxLevel:=0;
        NumLine:=StartLine-1;
        if NumLine<1 then NumLine:=1;
        NumCol:=1;

        if YesDate then begin
           ListExcel.Cells[NumLine,NumCol].Value := 'Дата: '+DateTimeToStr(NOW);
           NumLine:=NumLine+1;
        end;

        if Length(sHead)>0 then begin
           NumLine:=NumLine+1;
           ListExcel.Cells[NumLine,NumCol].Value := #39+sHead;
           NumLine:=NumLine+1;
        end;

        Result:=NumLine;
        NumLineFirst:=0;
        NumLineLast:=0;
        MaxLevel:=0;
        if tv.Items.Count>0 then begin
           //--------------------
           //Выводим дерево
           i:=-1;
           while i<(tv.Items.Count-1) do
            begin
              i:=i+1;
              YesNext:=1;
              if length(Text_EmptyChild)>0 then begin
                 if Text_EmptyChild=tv.Items[i].Text then YesNext:=0;
              end;
              if YesNext>0 then begin
                 Lev:=tv.Items[i].Level;
                 NumCol:=Lev+1;
                 if MaxLevel < Lev then MaxLevel := Lev;
                 NumLine:=NumLine+1;
                 if i=0 then NumLineFirst:=NumLine;
                 ListExcel.Cells[NumLine,NumCol].Value := #39+tv.Items[i].Text;
                 ListExcel.Cells[NumLine,NumCol].Borders[4].LineStyle:=3; //1
              end;
              //Application.ProcessMessages;
           end;
           //--------------------

           NumLineLast:=NumLine;
           Result:=NumLine;
           MaxLevel:=MaxLevel+1;

           //--------------------
           //уменьшаем ширину ячеек дерева до 2 (для улучшения читабельности)
           for i:=1 to MaxLevel do
            begin
              ListExcel.Columns[i].ColumnWidth := 2;
           end;
           //--------------------

           //--------------------
           //рисуем соотвествующие линии дерева (медленная часть)
           i123:=0;
           i:=NumLineFirst;
           while i<NumLineLast do
            begin
              i:=i+1;
              i123:=i123+1;
              j:=1;
              while j<MaxLevel do
               begin
                 j:=j+1;
                 if Length(trim(ListExcel.Cells[i,j].Value))>0 then begin
                    k:=i+1;
                    while k>1 do
                     begin
                       k:=k-1;
                       if Length(trim(ListExcel.Cells[k,j-1].Value))<=0 then begin
                          ListExcel.Cells[k,j].Borders[1].LineStyle:=3; //1
                       end
                       else begin
                          k:=-1;
                       end;
                    end;
                    j:=MaxLevel+1;
                 end;
              end;
              //Application.ProcessMessages;
           end;
           //--------------------

        end;
     end;
  end;
end;

function TreeView_Node_Childs_to_TStrings(
                                          tv : TTreeView;
                                          ListIndex:TStrings;       //Индексный список
                                                                    //(ID-строк таблицы БД),
                                                                    //см. Tree_CreateFromTableDB(...)
                                          NodeStart : TTreeNode;    //Заданный узел-родитель
                                          ListResult : TStrings;    //Результат выгрузки
                                          YesWithName:boolean=false //если TRUE, то с текстом узлов
                                         ) : integer;
//Получить список ID потомков заданного узла (исключая заданный узел)
Var
  sName,sId:string;
  i,LevelX,
  iStart,
  LevelStart : integer;
begin
  Result:=0;
  if Assigned(ListResult) then begin
     ListResult.Clear;
     if Assigned(tv) then begin
        if tv.Items.Count>0 then begin
           if Assigned(ListIndex) then begin
              if tv.Items.Count=ListIndex.Count then begin
                 LevelStart:=0;
                 iStart:=0;
                 if Assigned(NodeStart) then begin
                    iStart:=NodeStart.AbsoluteIndex;
                    if iStart>=0 then begin
                       LevelStart:=tv.Items[iStart].Level;
                    end;
                 end;
                 if iStart<0 then iStart:=0;
                 if LevelStart<0 then LevelStart:=0;
                 i:=iStart;
                 while i<(tv.Items.Count-1) do
                  begin
                   i:=i+1;
                   LevelX:=tv.Items[i].Level;
                   if LevelX>LevelStart then begin
                      sId:=trim(ListIndex[tv.Items[i].AbsoluteIndex]);
                      if sId<>'' then begin
                         if YesWithName then begin
                            sName:=trim(tv.Items[i].Text);
                            if sName='' then sName:=StringEmpty;
                            ListResult.Values[sId]:=sName;
                         end
                         else begin
                            ListResult.Add(sId);
                         end;
                      end;
                   end
                   else begin
                      i:=(tv.Items.Count+1);
                   end;
                 end;
              end;
           end;
        end;
     end;
     Result:=ListResult.Count;
  end;
end;


//***************************************************************


function IdGuid_Get:string;
//Сформировать уникальный код (на основе GUID)
begin
  Result:=GuidString_Greate;
  Result:=AllTrimUnChar('{} ',Result);
  Result:=Delete_CharsFromString(Result,'-_ ');
end;

function GuidString_Greate: String;
//Сформировать GUID (строковое представление)
var
  ID: TGUID;
begin
  Result := '';
  if CoCreateGuid(ID) = S_OK then begin
     Result:= trim(WideUpperCase(GUIDToString(ID)));
  end;
end;

function AllTrimUnChar(UnChar , Sx : string) : string;
//Функция удаляет из строки слева и справа все символы, которые входят в UnChar
begin
  Result:=LTrimUnChar(UnChar,Sx);
  Result:=RTrimUnChar(UnChar,Result);
end;

function LTrimUnChar(UnChar , Sx : string) : string;
//Функция удаляет из строки слева все символы, которые входят в UnChar
Var
  YesExit : byte;
begin
  Result:=Sx;
  if (length(Sx)>0) and (length(UnChar)>0) then begin
     YesExit:=0;
     while YesExit<=0 do
      begin
        if POS(Result[1],UnChar)>0 then begin
           Delete(Result,1,1);
        end
        else begin
           YesExit:=2;
        end;
        if length(Result)<=0 then YesExit:=1;
     end;
  end;
end;

function RTrimUnChar(UnChar , Sx : string) : string;
//Функция удаляет из строки справа все символы, которые входят в UnChar
begin
  Result:=InversionString(Sx);
  Result:=LTrimUnChar(UnChar,Result);
  Result:=InversionString(Result);
end;

function InversionString(Sx : string) : string;
//Инвертировать строку
Var
  i : integer;
begin
  Result:=Sx;
  if Length(Sx)>0 then begin
     Result:='';
     for i:=Length(Sx) downto 1 do
      begin
        Result:=Result+Sx[i];
     end;
  end;
end;

function Get_Word_From_String(
                              Sx : String;
                              NumWord : integer;
                              UnChar: String=' ';
                              YesAllTrim_Before: boolean=true
                             ) : String;
//Получить слово из строки Sx по номеру NumWord. UnChar - множество разделителей
//YesAllTrim_Before - если TRUE, то перед анализом удалить из строки левые и правые пробелы
Var
  InWord    : byte;
  NumWordCur, i : integer;
begin
  Result:='';
  if YesAllTrim_Before then Sx:=trim(Sx);
  if length(Sx)>0 then begin
     if NumWord>0 then begin
        InWord := 0;
        NumWordCur:=0;
        i:=0;
        while i<length(Sx) do
         begin
          i:=i+1;
          if POS(Sx[i],UnChar)<=0 then begin //этот символ - НЕ разделитель
             if InWord<=0 then NumWordCur:=NumWordCur+1; //мы - на начале слова
             InWord:=1; //Мы внутри слова
             if NumWordCur=NumWord then begin //Это - наше слово
                Result:=Result+Sx[i];   //и мы его выдираем из строки
             end;
          end
          else begin  //этот символ - разделитель
             InWord:=0; //Мы снаружи слова
             if NumWordCur=NumWord then begin //Это было - наше слово
                i:=length(Sx)+1; //поэтому, выходим из цикла и функции
             end;
          end;
        end;
     end;
  end;
end;

function BuildString(S:String; CountChar:integer; CharCode:byte=32; Nr:integer=1): string;
{Дополняет строку S символами CharCode до CountChar}
{Nr<=0 - слева,  >0 - справа}
begin
  Result:=S;
  while length(Result)<CountChar do
   begin
    if Nr>0 then begin
       Result:=Result+Chr(CharCode);
    end
    else begin
       Result:=Chr(CharCode)+Result;
    end;
  end;
end;

function Delete_CharsFromString(Sx : String; CharsForDel:string=' ') : String;
//Удалить заданные символы из строки
Var
  i : integer;
begin
  Result:='';
  if Sx<>'' then begin
     for i:=1 to length(Sx) do
      begin
        if POS(Sx[i],CharsForDel)<=0 then begin
           Result:=Result+Sx[i];
        end;
     end;
  end;
end;

end.