TreeView, ListView

TTreeView. Проблемы CustomDraw

2017-08-11T21:46:39+07:00

Автор: Rustam Kafarov

При использовании компонента TTreeView возникают проблемы при собственной отрисовке содержимого компонента в событиях OnCustomDraw, OnCustomDrawItem, OnAdvancedCustomDraw, OnAdvancedCustomDrawItem. Проблема проявляется когда свойства Canvas компонента устанавливаются вторично. К примеру, при попытке изменить цвет фонта во второй раз, соотвествующих изменений НЕ ПОСЛЕДУЕТ. Тоже самое и со свойствами Brush, Pen.

Проверено на Дельфи 5.

Контрольный пример (на форме TTreeView и TCheckBox):

Подробнее...

В TreeView текущий Node выделяется другим шрифтом

2017-08-11T21:45:20+07:00

Code:

procedure TForm1.TreeView1CustomDrawItem(Sender: TCustomTreeView;

Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);

begin

if cdsSelected in State then

Sender.Canvas.Font.Style := Sender.Canvas.Font.Style + [fsUnderline];

end;

Выделение некоторых узлов другим шрифтом

2017-08-11T21:51:08+07:00

Code:

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;

// Example: Make the first node bold.

// Beispiel: Erster Eintrag fett machen.

procedure TForm1.Button1Click(Sender: TObject);

begin

SetNodeBoldState(TreeView1.Items[0], True);

end;

Подробнее...

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

2017-08-11T21:42:45+07:00

Code:

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;

Загрузка ini-файла в TTreeView

2017-08-11T21:45:03+07:00

Code:

procedure LoadIniToTree(const FName: string; Tree: TTreeView);

var LS, LV: TStrings;

i, j: integer;

root: TTreeNode;

n: string;

p: PString;

begin

Tree.Items.Clear; // очищаем дерево

with TIniFile.Create(FName) do // пытаемся открыть файл FName

try

LS := TStringList.Create; // список названий секций

try

ReadSections(LS); // читаем все секции в список

LV := TStringList.Create; // список пар "имя=значение"

try

for i := 0 to LS.Count-1 do // для всех секций...

begin

LV.Clear; // подготовим список

ReadSectionValues(LS[i], LV); // читаем список пар "имя=значение" для текущей секции

root := Tree.Items.Add(nil, LS[i]); // добавляем корневой узел (имя текущей секции)

for j := 0 to LV.Count-1 do // для всех пар "имя=значение"...

begin

n := LV.Names[j]; // выделяем "имя"

// добавляем дочерний по отношению к root узел,

// в качестве текста исп. "имя"

// в качестве значения поля Data = "значение"

New(p);

p^ := LV.Values[n];

Tree.Items.AddChildObject(root, n, p);

end;

finally

LV.Free;

end;

finally

LS.Free;

end;

finally

Free; // корректно уничтожаем объект TIniFile

end;

// Применение:

procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);

begin

if (TreeView1.Selected <> nil) and (TreeView1.Selected.Parent <> nil) then

begin

Edit1.Text := TreeView1.Selected.Text;

Edit2.Text := String(TreeView1.Selected.Data^);

end else

begin

Edit1.Text := '';

Edit2.Text := '';

end;

// После использования не забыть освободить память, напр. так:

procedure TForm1.TreeView1Deletion(Sender: TObject; Node: TTreeNode);

begin

if Node.Data <> nil then

Dispose(PString(Node.Data));

end;

Как копировать и вставлять TreeNode?

2017-08-11T21:43:14+07:00

Code:

var

SL : TStringList;

procedure TForm1.CutBtnClick(Sender: TObject);

var

i, j, StartLevel : integer;

TNSel : TTreeNode;

begin

TNSel := TreeView1.Selected;

if TNSel <> nil then begin

StartLevel := TNSel.Level;

i := TNSel.AbsoluteIndex;

j := i; // note for later deletion

if SL = nil then

SL := TStringList.Create

else

SL.Clear;

SL.AddObject(TNSel.Text, pointer(0));

inc(i);

with TreeView1 do begin

while Items[i].Level > StartLevel do begin

{stop before next sibling to top node\}

SL.AddObject(Items[i].Text, pointer(Items[i].Level - StartLevel));

inc(i);

end; {while Items[i].Level > StartLevel\}

Items[j].Delete;

end; {with TreeView1\}

end; {if TNSel <> nil\}

end;

procedure TForm1.PasteBtnClick(Sender: TObject);

var

i, Level : integer;

TNSel, TN : TTreeNode;

begin

with TreeView1 do begin

TNSel := Selected;

if TNSel <> nil then begin

TN := Items.Insert(TNSel, SL.Strings[0]);

Level := integer(SL.Objects[0]); // should be 0

for i := 1 to SL.Count - 1 do begin

if integer(SL.Objects[i]) < Level then begin

{go up one level\}

TN := TN.Parent;

Level := integer(SL.Objects[i]);

end; {if integer(SL.Objects[i]) < Level\}

if Level = integer(SL.Objects[i]) then

{same level\}

TN := Items.Add(TN, SL.Strings[i])

else begin

{go down one level\}

TN := Items.AddChild(TN, SL.Strings[i]);

Level := integer(SL.Objects[i]);

end; {if Level = integer(SL.Objects[i])\}

end; {for i := 1 to SL.Count - 1\}

end; {if TNSel <> nil\}

end; {with TreeView1\}

end;

Как открыть первую ветвь TreeView?

2017-08-11T21:42:26+07:00

Как программным путем открыть первую ветвь и в ней выделить первый элемент?

Code:

procedure TForm1.Button1Click(Sender: TObject);

{©Drkb v.3(2007): www.drkb.ru,

®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}

begin

TreeView1.Items[0].Expand(False);

TreeView1.Items[0].Selected:=true;

TreeView1.SetFocus;

end;

Как реализовать Drag and Drop в TTreeView

2017-08-11T21:47:03+07:00

Автор: Васильев Василий

Code:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,

Dialogs, StdCtrls, ComCtrls;

type

TForm1 = class(TForm)

TreeView1: TTreeView;

Label1: TLabel;

procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);

procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

private

{ Private declarations }

procedure MoveNode(TargetNode, SourceNode: TTreeNode);

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

// Procedure which will move node and its subnodes

procedure TForm1.MoveNode(TargetNode, SourceNode: TTreeNode);

var

nodeTmp: TTreeNode;

i: Integer;

begin

with TreeView1 do

begin

nodeTmp := Items.AddChild(TargetNode, SourceNode.Text);

for i := 0 to SourceNode.Count - 1 do

begin

MoveNode(nodeTmp, SourceNode.Item[i]);

end;

procedure TForm1.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);

var

TargetNode, SourceNode: TTreeNode;

begin

with TreeView1 do

begin

TargetNode := GetNodeAt(X, Y); // Get target node

SourceNode := Selected;

if (TargetNode = nil) then

begin

EndDrag(False);

Exit;

end;

MoveNode(TargetNode, SourceNode);

SourceNode.Free;

end;

procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;

State: TDragState; var Accept: Boolean);

begin

if (Sender = TreeView1) then // If TRUE than accept the draged item

begin

Accept := True;

end;

end.

Как связать TreeView и PageControl?

2017-08-11T21:46:00+07:00

На форме стоит TreeView, PageControl и кнопка.

При смене страницы - меняется текущий узел, а при смене узла меняется страница.

Подробнее...

Как убрать всплывающие подсказки в TreeView

2017-08-11T21:47:57+07:00

Code:

{

If you have installed the Internet Explorer 4.0 or high, in TTreeView component

always displaying a hint for cutted items. It's useful but sometimes prevents and

irritates (at least, me). But there is a simple way to switch off this feature:

}

procedure TForm1.FormShow(Sender: TObject);

const

TVS_NOTOOLTIPS = $0080;

begin

SetWindowLong(Treeview1.Handle, GWL_STYLE,

GetWindowLong(TreeView1.Handle, GWL_STYLE) xor TVS_NOTOOLTIPS);

end;

Автор: Eugene Mayevski

TCustomTreeView.WMNotify. О том, что такое тип notify'а TTM_NEEDTEXT пpочтешь в хелпе. Убpать хинты можно, пеpекpыв обpаботчик для этого уведомительного сообщения.

Копировать и вставлять TreeNode

2017-08-11T21:48:17+07:00

Code:

var

SL : TStringList;

procedure TForm1.CutBtnClick(Sender: TObject);

var

i, j, StartLevel : integer;

TNSel : TTreeNode;

begin

TNSel := TreeView1.Selected;

if TNSel <> nil then begin

StartLevel := TNSel.Level;

i := TNSel.AbsoluteIndex;

j := i; // note for later deletion

if SL = nil then

SL := TStringList.Create

else

SL.Clear;

SL.AddObject(TNSel.Text, pointer(0));

inc(i);

with TreeView1 do begin

while Items[i].Level > StartLevel do begin

{stop before next sibling to top node\}

SL.AddObject(Items[i].Text, pointer(Items[i].Level - StartLevel));

inc(i);

end; {while Items[i].Level > StartLevel\}

Items[j].Delete;

end; {with TreeView1\}

end; {if TNSel <> nil\}

end;

procedure TForm1.PasteBtnClick(Sender: TObject);

var

i, Level : integer;

TNSel, TN : TTreeNode;

begin

with TreeView1 do begin

TNSel := Selected;

if TNSel <> nil then begin

TN := Items.Insert(TNSel, SL.Strings[0]);

Level := integer(SL.Objects[0]); // should be 0

for i := 1 to SL.Count - 1 do begin

if integer(SL.Objects[i]) < Level then begin

{go up one level\}

TN := TN.Parent;

Level := integer(SL.Objects[i]);

end; {if integer(SL.Objects[i]) < Level\}

if Level = integer(SL.Objects[i]) then

{same level\}

TN := Items.Add(TN, SL.Strings[i])

else begin

{go down one level\}

TN := Items.AddChild(TN, SL.Strings[i]);

Level := integer(SL.Objects[i]);

end; {if Level = integer(SL.Objects[i])\}

end; {for i := 1 to SL.Count - 1\}

end; {if TNSel <> nil\}

end; {with TreeView1\}

end;

Копировать узлы с поддеревом TTreeView во второй TTreeView

2017-08-11T21:48:37+07:00

Code:

{type

{: Callback to use to copy the data of a treenode when the

node itself is copied by CopySubtree.

@param oldnode is the old node

@param newnode is the new node

@Desc Use a callback of this type to implement your own algorithm

for a node copy. The default just uses the Assign method, which

produces a shallow copy of the nodes Data property. }

TCopyDataProc = procedure(oldnode, newnode : TTreenode);

{: The default operation is to do a shallow copy of the node, via

Assign. }

procedure DefaultCopyDataProc(oldnode, newnode : TTreenode);

begin

newnode.Assign(oldnode);

end;

{-- CopySubtree

-------------------------------------------------------}

{: Copies the source node with all child nodes to the target treeview.

@Param sourcenode is the node to copy

@Param target is the treeview to insert the copied nodes into

@Param targetnode is the node to insert the copy under, can be nil to

make the copy a top-level node.

@Param CopyProc is the (optional) callback to use to copy a node.

If Nil is passed for this parameter theDefaultCopyDataProc will be

used.

@Precondition sourcenode <> nil, target <> nil, targetnode is either

nil or a node of target

@Raises Exception if targetnode happens to be in the subtree rooted in

sourcenode. Handling that special case is rather complicated, so we

simply refuse to do it at the moment.

}{ Created 2003-04-09 by P. Below -----------------------------------------------------------------------

}

procedure CopySubtree(sourcenode : TTreenode; target : TTreeview;

targetnode : TTreenode; CopyProc : TCopyDataProc = nil);

var

anchor : TTreenode;

child : TTreenode;

begin { CopySubtree }

Assert(Assigned(sourcenode),

'CopySubtree:sourcenode cannot be nil');

Assert(Assigned(target),

'CopySubtree: target treeview cannot be nil');

Assert((targetnode = nil) or (targetnode.TreeView = target),

'CopySubtree: targetnode has to be a node in the target treeview.');

if (sourcenode.TreeView = target) and

(targetnode.HasAsParent(sourcenode) or (sourcenode =

targetnode)) then

raise Exception.Create('CopySubtree cannot copy a subtree to one of the ' +

'subtrees nodes.');

if not Assigned(CopyProc) then

CopyProc := DefaultCopyDataProc;

anchor := target.Items.AddChild(targetnode, sourcenode.Text);

CopyProc(sourcenode, anchor);

child := sourcenode.GetFirstChild;

while Assigned(child) do

begin

CopySubtree(child, target, anchor, CopyProc);

child := child.getNextSibling;

end; { While }

end; { CopySubtree }

procedure TForm1.Button1Click(Sender : TObject);

begin

if assigned(treeview1.selected) then

CopySubtree(treeview1.selected, treeview2, nil);

end;

Отмена вставки нового узла в TreeView по нажатию кнопки Esc

2017-08-11T21:42:02+07:00

Code:

unit BetterTreeView;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ComCtrls, CommCtrl;

type

TTVNewEditCancelEvent = procedure( Sender: TObject;

Node: TTreeNode; var Delete: Boolean) of object;

TBetterTreeView = class(TTreeView)

protected

FIsEditingNew: Boolean;

FOnEditCancel: TTVChangedEvent;

FOnNewEditCancel: TTVNewEditCancelEvent;

procedure Edit(const Item: TTVItem); override;

public

function NewChildAndEdit(Node: TTreeNode; const S: String)

: TTreeNode;

published

property IsEditingNew: Boolean read FIsEditingNew;

property OnEditCancel: TTVChangedEvent

read FOnEditCancel write FOnEditCancel;

property OnNewEditCancel: TTVNewEditCancelEvent

read FOnNewEditCancel write FOnNewEditCancel;

end;

implementation

procedure TBetterTreeView.Edit(const Item: TTVItem);

var

Node: TTreeNode;

Action: Boolean;

begin

with Item do begin

{ Get the node }

if (state and TVIF_PARAM) <> 0 then

Node := Pointer(lParam)

else

Node := Items.GetNode(hItem);

if pszText = nil then begin

if FIsEditingNew then begin

Action := True;

if Assigned(FOnNewEditCancel) then

FOnNewEditCancel(Self, Node, Action);

if Action then

Node.Destroy

end

else

if Assigned(FOnEditCancel) then

FOnEditCancel(Self, Node);

end

else

fFinherited;

end;

FIsEditingNew := False;

end;

function TBetterTreeView.NewChildAndEdit

(Node: TTreeNode; const S: String): TTreeNode;

begin

SetFocus;

Result := Items.AddChild(Node, S);

FIsEditingNew := True;

Node.Expand(False);

Result.EditText;

SetFocus;

end;

end.

Поместить список контролов и пунктов меню в TTreeView

2017-08-11T21:48:56+07:00

Code:

uses

ComCtrls, Menus, Classes, Forms, Controls, Windows, Messages;

function GetControlCaption(Control: TWinControl): ShortString;

// Slightly modified version of Twister's Tip

// function GetCaptionAtPoint(pt: TPoint): string;

var

TextLength: Integer;

Text: PChar;

begin

if not Boolean(Control.Handle) then Exit;

Result := Control.Name; // if Control doesn't have Caption

// Control.Name is returned

TextLength := SendMessage(Control.Handle, WM_GETTEXTLENGTH, 0, 0);

if TextLength 0 then

begin

GetMem(Text, TextLength + 1);

SendMessage(Control.Handle, WM_GETTEXT, TextLength + 1, Integer(Text));

Result := Text;

FreeMem(Text);

end;

// function GetCaptionAtPoint(pt: TPoint): ShortString;

// begin

// Result:= GetControlCaption(FindVCLWindow(pt));

// end;

procedure FindAllMenuItems(AppTree: TTreeView; MenuItem: TMenuItem; Parent: TTreeNode);

var

loop: Integer;

Node: TTreeNode;

mItem: TMenuItem;

Name: ShortString;

begin

for loop := 0 to MenuItem.Count - 1 do

begin

mItem := MenuItem.Items[loop];

Name := mItem.Caption;

Node := AppTree.Items.AddChildObject(Parent, Name, mItem);

if mItem.Count 0 then findAllMenuItems(AppTree, mItem, Node);

end;

procedure FindAllControls(AppTree: TTreeView; Comp: TComponent; Parent: TTreeNode);

var

Child: TComponent;

loop, start, Index: Integer;

Name: ShortString;

Node, Mnode: TTreeNode;

begin

start := 0;

if Comp is TApplication then

begin

// Parent:= AppTree.Items.AddObjectFirst(Parent, 'Application', nil);

// if you want to see the root ('Application') uncomment

start := 1;

end;

for loop := start to Comp.ComponentCount - 1 do

begin

Child := Comp.Components[loop];

Name := Child.Name;

if Child is TControl then

begin

if Child is TWinControl then

begin // does Child have Caption property??

Name := GetControlCaption(TWinControl(Child));

end;

Node := AppTree.Items.AddChildObject(Parent, Name, Child);

if Child.ComponentCount 0 then FindAllControls(AppTree, Child, Node);

end;

if Child is TMenu then

begin

Node := AppTree.Items.AddChildObject(Parent, Name, Child);

for Index := 0 to TMenu(Child).Items.Count - 1 do

begin

Mnode := AppTree.Items.AddChildObject(Node, TMenu(Child).Items[Index].Caption,

TMenu(Child).Items[Index]);

FindAllMenuItems(AppTree, TMenu(Child).Items[Index], Mnode);

end;

Поточность TreeView

2017-08-11T21:49:30+07:00

Автор: Mike Scott

На пустой форме у меня располагается TTreeView. Затем я сохраняю это в файле, используя WriteComponent. Это работает как положено; я могу из DOS c помощью команды "type" посмотреть двоичный файл и увидеть его содержимое, типа строк TTreeView и имя объекта. По крайней мере файл записывается и создается впечатление его "наполненности".

Затем я освобождаю компонент TTreeView, открываю поток, делаю ReadComponent и, затем, InsertControl. И получаю исключение "TreeView1 has no parent window" (TreeView1 не имеет родительского окна).

Подробнее...

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

2017-08-11T21:49:50+07:00

Code:

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; {While}

end {If}

else

Result := False

end;

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; {While}

end {If}

else

Result := False

end;

Рекурсивные механизмы спуска по дереву

2017-08-11T21:50:08+07:00

Нужно использовать рекурсивные механизмы спуска по дереву и иметь метод определения наличия child узлов у текущего узла.

Code:

function TDBTreeView.RecurseChilds(node: TTreeNode): double;

begin

while node <> nil do begin

if node.HasChildren then

Result := RecurseChilds(node.GetFirstChild);

Result := Result + GetResultForNode(node));

node := node.GetNextSibling;

end;

function TDBTreeView.GetResult(curnode: TTreeNode;): double;

begin

Result := 0;

if curnode = nil then Exit;

Result := RecurseChilds(curnode.GetFirstChild);

end;

Сохранить и загрузить TTreeView

2017-08-11T21:50:26+07:00

Code:

{

Treeview1.SaveToFile('...') doesn't store images.

Instead, use the code below.

}

// Save

procedure TForm1.Button1Click(Sender: TObject);

var

F: TFileStream;

begin

F := TFileStream.Create('c:\TreeView.txt', fmCreate or fmShareCompat);

try

F.WriteComponent(TreeView1);

finally

F.Free;

end;

// Load

procedure TForm1.Button2Click(Sender: TObject);

var

F: TFileStream;

begin

F := TFileStream.Create('c:\TreeView.txt', fmOpenRead or fmShareDenyWrite);

try

F.ReadComponent(TreeView1);

finally

F.Free;

end;

Ускорение работы TreeView

2017-08-11T21:44:40+07:00

Представляем вашему вниманию немного переработанный компонент TreeView, работающий быстрее своего собрата из стандартной поставки Delphi. Кроме того, была добавлена возможность вывода текста узлов и пунктов в жирном начертании (были использованы методы TreeView, хотя, по идее, необходимы были свойства TreeNode. Мне показалось, что это будет удобнее).

Для сравнения:

TreeView:

128 сек. для загрузки 1000 элементов (без сортировки)*

270 сек. для сохранения 1000 элементов (4.5 минуты!!!)

HETreeView:

Подробнее...

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

2017-08-11T21:33:36+07:00

Подробнее...

Поиск в TreeView по тексту

2017-08-11T21:35:18+07:00

Code:

// Search a TreeItem through its Text property

// Return value is a TreeNodeObject

function Form1.TreeItemSearch(TV: TTreeView; SucheItem: string): TTreeNode;

var

i: Integer;

iItem: string;

begin

if (TV = nil) or (SucheItem = '') then Exit;

for i := 0 to TV.Items.Count - 1 do

begin

iItem := TV.Items[i].Text;

if SucheItem = iItem then

begin

Result := TV.Items[i];

Exit;

end

else

begin

Result := nil;

end;

Подробнее...

Получение узла в TTreeView по пути заголовков

2017-08-11T21:34:09+07:00

Code:

{ **** UBPFD *********** ****

>> Получение узла в TreeView по пути заголовков

Функция выдает узел TTreeNode из дерева TreeView, находящийся по пути,

указанному в Path, в котором разделителем уровней является символ Separator.

Если узел не найден - выдается nil.

Ограничение - заголовки узлов дерева не должны содержать символа Separator.

Зависимости: ComCtrls, Classes, SysUtils

Автор: lipskiy, lipskiy@mail.ru, ICQ:51219290, Санкт-Петербург

***************************************************** }

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 (TreeView.Items.Count = 0) or (Path = '') 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;

Доступ к ScrollBars от TTreeView

2017-08-11T21:32:22+07:00

Code:

with treeview do begin

perform( WM_HSCROLL, SB_LINERIGHT, 0 );

perform( WM_HSCROLL, SB_ENDSCROLL, 0 );

end;

Прокрутка TreeView, чтобы держать выделение посередине

2017-08-11T21:32:39+07:00

Code:

procedure TMyForm.TreeChange(Sender: TObject; Node: TTreeNode);

var

i : integer;

pp, cp : TTreeNode;

begin

if Assigned(Tree.Selected) then

begin

cp := Tree.Selected;

pp := cp;

for i := 1 to Round(Tree.Height/30) do

if cp <> nil then

begin

pp := cp;

cp := cp.GetPrevVisible;

end;

Tree.TopItem := pp;

end;

Убрать ScrollBars от TTreeView

2017-08-11T21:32:03+07:00

Code:

uses CommCtrl;

procedure tNoScrollbarsTreeview.createparams(var params: TCreateParams);

begin

inherited;

params.style := params.style or TVS_NOSCROLL;

end;