FAQ VCL
Компоненты\TreeView

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как выделить некоторые строчки TTreeView бледным (аналогично Ctrl+X в проводнике)?

uses
  {...,} CommCtrl;

// Способ первый
procedure SetNodeState( node: TTreeNode; Flags: Integer );
var
  tvi: TTVItem;
begin
   FillChar( tvi, SizeOf( tvi ), 0 );
   tvi.hItem := node.ItemID;
   tvi.mask := TVIF_STATE;
   tvi.stateMask := TVIS_CUT;
   tvi.state := Flags;
   TreeView_SetItem( node.Handle, tvi );
end;

procedure TForm1.TreeView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   // Выделяем бледным
   if ( ssCtrl in Shift ) then
      if ( Key = Ord( 'X' ) ) or ( Key = Ord( 'x' ) ) then
         SetNodeState( ( Sender as TTreeView ).Selected, TVIS_CUT );
   // Снимаем выделение
   if Key = VK_ESCAPE then
      SetNodeState( ( Sender as TTreeView ).Selected, 0 );
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
begin
   TreeView1.Items.Item[0].Cut := true; // false
end;


Как выделить некоторые строчки в TTreeView жирным?

uses
  {...,} CommCtrl;

procedure SetNodeBoldState( Node: TTreeNode; Value: Boolean );
var 
  TVItem: TTVItem; 
begin 
   if not Assigned( Node ) then Exit;
   with TVItem do
   begin
      mask := TVIF_STATE or TVIF_HANDLE;
      hItem := Node.ItemId;
      stateMask := TVIS_BOLD;
      if Value then
         state := TVIS_BOLD
      else
         state := 0;
      TreeView_SetItem( Node.Handle, TVItem );
   end;
end;

// Выделить жирным
procedure TForm1.Button1Click(Sender: TObject);
begin
   SetNodeBoldState( TreeView1.Selected, true );
end;

// Снять выделение
procedure TForm1.Button2Click(Sender: TObject);
begin
   SetNodeBoldState( TreeView1.Selected, false );
end;


Как получить строковый путь в TTreeView?

// Способ первый
function SrNodeTree( pTreeNode: TTreeNode; var sRuta: string ): string;
begin
   sRuta := pTreeNode.Text + ' > ' + sRuta;
   if pTreeNode.Level = 0 then
      Result := sRuta
   else
      Result := SrNodeTree( pTreeNode.Parent, sRuta );
end;

procedure TForm1.TreeView1Click(Sender: TObject);
var
  sPath: string;
begin
   Caption := SrNodeTree( TreeView1.Selected, sPath );
end;

// Способ второй
function GetPathToNode( Node: TTreeNode; Separator: Char ): string;
begin
   Result := '';
   if Node = nil then
      Exit;
   while Node <> nil do
   begin
      Result := Node.Text + Separator + Result;
      Node := Node.Parent;
   end;
   Delete( Result, Length( Result ), 1 );
end;

procedure TForm1.TreeView1Click(Sender: TObject);
begin
   Caption := GetPathToNode( TreeView1.Selected, '>' );
end;

// Способ третий
function GetPath: string;
var
  Child: TTreeNode;
begin
   Child := TreeView1.Selected;
   Result := EmptyStr;
   while Assigned(Child) do
   begin
      Result := Child.Text + PathDelim + Result;
      Child := Child.Parent;
   end;
end;

procedure TForm1.TreeView1Click(Sender: TObject);
begin
   ShowMessage(GetPath);
end;


Как получить узел в TTreeView по пути заголовков?

function GetNodeInPath( Path: string; Separator: char; TreeView: TTreeView ): TTreeNode;
var
  List: TStringList;
  Node: TTreeNode;
  i: integer;
  s: string;
begin
   Result := nil;
   if ( TreeView = nil ) or ( Path = '' ) or
      ( TreeView.Items.Count = 0 ) or ( Separator = '' ) then
      Exit;
   List := TStringList.Create;
   // Меняем сепаратор на первод строки
   s := StringReplace( Path, Separator, #13#10, [rfReplaceAll] );
   // Получаем список уровней
   List.Text := s;
   // Начинаем с нулевой ноды дерева
   Node := TreeView.Items[0];
   // Проходим по всему списку уровней пути
   for i := 0 to List.Count-1 do
   begin
      // Ищем имя ноды на текущем уровне
      while ( Node <> nil ) and ( Node.Text <> List[i] ) do
         Node := Node.getNextSibling;
      // Нода не найдена
      if Node = nil then
         Break;
      // Переходим на уровень ниже
      if i < List.Count - 1 then
         Node := Node.getFirstChild;
   end;
   List.Free;
   Result := Node;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   TreeView1.Selected := GetNodeInPath( 'Каталог\Подкаталог', '\', TreeView1 );
end;


Как отключить подсказки в TTreeView?

procedure TForm1.FormShow(Sender: TObject);
const
  TVS_NOTOOLTIPS = $0080;
begin
   SetWindowLong(Treeview1.Handle, GWL_STYLE,
      GetWindowLong(TreeView1.Handle, GWL_STYLE) xor TVS_NOTOOLTIPS);
end;


Как выделять узлы в TTreeView правой кнопкой мыши?

procedure TForm1.TreeView1ContextPopup(Sender: TObject; MousePos: TPoint;
  var Handled: Boolean);
var
  tmpNode: TTreeNode;
begin
   tmpNode := ( Sender as TTreeView ).GetNodeAt( MousePos.X, MousePos.Y );
   if tmpNode <> nil then
      TTreeView( Sender ).Selected := tmpNode;
end;


Как отсортировать дочерние злементы в момент раскрытия узла?

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

procedure TForm1.TreeView1Expanded(Sender: TObject; Node: TTreeNode);
begin
   Node.AlphaSort; // Сортируем только дочерние узлы
end;


Как проверить, развернут ли полностью TTreeView?

function IsTreeviewFullyExpanded( tv: TTreeview ): boolean;
var
  Node: TTreeNode;
begin
   Assert( Assigned( tv ) );
   if tv.Items.Count > 0 then
   begin
      Node := tv.Items[0];
      Result := true;
      while Result and Assigned( Node ) do
      begin
         Result := Node.Expanded or not Node.HasChildren;
         Node := Node.GetNext;
      end;
   end
   else
      Result := false;
end;

procedure TMainFrm.Button1Click(Sender: TObject);
begin
   if IsTreeviewFullyExpanded( TreeView1 ) then
      ShowMessage( 'TTreeView полностью развернут' );
end;


Как проверить, свернут ли полностью TTreeView?

function IsTreeviewFullyCollapsed( tv: TTreeview ): boolean;
var
  Node: TTreeNode;
begin
   Assert( Assigned( tv ) );
   if tv.Items.Count > 0 then
   begin
      Node := tv.Items[0];
      Result := true;
      while Result and Assigned( Node ) do
      begin
         Result := not ( Node.Expanded and Node.HasChildren );
         Node := Node.GetNext;
      end;
   end
   else
      Result := false;
end;

procedure TMainFrm.Button1Click(Sender: TObject);
begin
   if IsTreeviewFullyCollapsed( TreeView1 ) then
      ShowMessage( 'TTreeView полностью свернут' );
end;


Как реализовать быстрый поиск в TTreeView?

uses
  {...,} ComCtrls;

procedure QuickSearch( Tree: TTreeView; SearchTarget: string );
var
  Noddy: TTreeNode;
  Searching: boolean;
begin
   Noddy := Tree.Items[0];
   Searching := true;
   while ( Searching ) and ( Noddy <> nil ) do
   begin
      if Noddy.Text = SearchTarget then
      begin
         Searching := false;
         Tree.Selected := Noddy;
         Tree.SetFocus;
      end
      else
         Noddy := Noddy.GetNext;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   QuickSearch( TreeView1, 'текст для поиска' );
end;

При использовании материала - ссылка на сайт обязательна