:: 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;
|
При использовании материала - ссылка на сайт обязательна
|
|