unit SelectInTreeView;

interface

uses
	Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
	Dialogs, StdCtrls, ExtCtrls, ComCtrls, Contnrs, xTreeView, ImgList;

type
	TNodeSearchOptions = set of (nsoVisible, nsoSearchable);
	ITreeSource = interface
		function GetImageList: TCustomImageList;

		function GetCaption(aNode: Pointer): String;
		function GetImageIndex(aNode: Pointer): Integer;
		function GetChild(aParentNode: Pointer; Index: Integer): Pointer;
		function GetChildCount(aParentNode: Pointer): Integer;
		function GetNodeSearchOptions(aNode: Pointer): TNodeSearchOptions;
	end;

	TSearchInTreeForm = class(TForm)
		ObjectTreeBar: TPanel;
		ButtonBar: TPanel;
		FilterLabel: TLabel;
		Filter: TEdit;
		OK: TButton;
		Cancel: TButton;
		SearchTree: TXTreeView;
		Timer: TTimer;

		procedure FormCreate(Sender: TObject);
		procedure FormDestroy(Sender: TObject);

		procedure FilterChange(Sender: TObject);
		procedure FilterKeyDown(Sender: TObject; var Key: Word;	Shift: TShiftState);
		procedure SearchTreeDblClick(Sender: TObject);
		procedure OKClick(Sender: TObject);
		procedure TimerTimer(Sender: TObject);

		procedure WMDeselectFilter(var aMsg: TMessage); message WM_USER;
	private
		FSource: ITreeSource;
		FRoot: TObject;

		procedure ApplyFilter(aSelected: Pointer);

		function  GetFilterDelay: Cardinal;
		procedure SetFilterDelay(const Value: Cardinal);
	public
		procedure Init(aSource: ITreeSource; aDefSelected: Pointer;
			const aFilter: String);
		function  Selected: Pointer;

		property FilterDelay: Cardinal read GetFilterDelay write SetFilterDelay;
	end;

// открывает окно поиска по дереву
// callback функция позволяющая отфильтровать узлы дерева
	TOnCheckNodeAddition = function(aData: Pointer; aNode: TTreeNode): Boolean;

	TTreeViewSearchSource = class(TInterfacedObject, ITreeSource)
	protected
		FImages: TCustomImageList;
		FNodeList: TTreeNodes;

		FOnCheckNodeAddition: TOnCheckNodeAddition;
		FCallBackData: Pointer;

		function GetImageList: TCustomImageList;

		function GetCaption(aNode: Pointer): String; virtual;
		function GetImageIndex(aNode: Pointer): Integer; virtual;
		function GetChild(aParentNode: Pointer; Index: Integer): Pointer; virtual;
		function GetChildCount(aParentNode: Pointer): Integer; virtual;
		function GetNodeSearchOptions(aNode: Pointer): TNodeSearchOptions; virtual;
	public
		constructor Create(aTreeView: TCustomTreeView; anImages: TCustomImageList = nil;
			anOnCheckNodeAddition: TOnCheckNodeAddition = nil; anOnCheckNodeData: Pointer = nil);
	end;


function DoSearchInTree(aSource: ITreeSource; aDefSelected: Pointer = nil; const aFilter: String = ''): Pointer;
function DoSearchInTreeView(aTreeView: TCustomTreeView;
	anImages: TCustomImageList = nil; const aFilter: String = '';
	anOnCheckNodeAddition: TOnCheckNodeAddition = nil;
	anOnCheckNodeData: Pointer = nil): TTreeNode;

implementation

uses
	AClasses;

{$R *.dfm}


{ TTreeViewSearchSource }

constructor TTreeViewSearchSource.Create(aTreeView: TCustomTreeView; anImages: TCustomImageList;
	anOnCheckNodeAddition: TOnCheckNodeAddition; anOnCheckNodeData: Pointer);
begin
	inherited Create;
	FImages := anImages;
	if Assigned(aTreeView) and Assigned(aTreeView.TopItem) then
		FNodeList := aTreeView.TopItem.Owner
	else
		FNodeList := nil;

	FOnCheckNodeAddition := anOnCheckNodeAddition;
	FCallBackData := anOnCheckNodeData;
end;

function TTreeViewSearchSource.GetImageList: TCustomImageList;
begin
  Result := FImages;
end;

function TTreeViewSearchSource.GetCaption(aNode: Pointer): string;
begin
	if Assigned(aNode) then
		Result := TTreeNode(aNode).Text;
end;

function TTreeViewSearchSource.GetImageIndex(aNode: Pointer): Integer;
begin
  if Assigned(aNode) then
		Result := TTreeNode(aNode).ImageIndex
	else
		Result := -1;
end;

function TTreeViewSearchSource.GetChild(aParentNode: Pointer;
	Index: Integer): Pointer;
var
  aNode: TTreeNode;
  aSaveIndex: Integer;
begin
	Assert(Assigned(aParentNode) or Assigned(FNodeList), 'Invalid params');
  Assert(Index >= 0, 'Invalid index');

	if Assigned(aParentNode) then
		Result := TTreeNode(aParentNode).Item[Index]
	else if Assigned(FNodeList) then begin
    aSaveIndex := Index;

    aNode := FNodeList.GetFirstNode;
    while Assigned(aNode) do begin
      if Index = 0 then begin
        Result := aNode;
        Exit;
      end;
      Dec(Index);
      aNode := aNode.getNextSibling;
    end;
    raise Exception.CreateFmt('Index "%d" out of bounds "%d"', [aSaveIndex, aSaveIndex - Index]);
  end
	else
		Result := nil;
end;

function TTreeViewSearchSource.GetChildCount(aParentNode: Pointer): Integer;
var
  aNode: TTreeNode;
begin
	if Assigned(aParentNode) then
		Result := TTreeNode(aParentNode).Count
	else if Assigned(FNodeList) then begin
    Result := 0;
    aNode := FNodeList.GetFirstNode;
    while Assigned(aNode) do begin
      Inc(Result);
      aNode := aNode.getNextSibling;
    end;
  end
	else
		Result := 0;
end;

function TTreeViewSearchSource.GetNodeSearchOptions(aNode: Pointer): TNodeSearchOptions;
begin
	if Assigned(aNode) and
		(not Assigned(FOnCheckNodeAddition) or
			FOnCheckNodeAddition(FCallBackData, TTreeNode(aNode)))
	then
		Result := [nsoVisible, nsoSearchable]
	else
		Result := [];
end;

function DoSearchInTreeView(aTreeView: TCustomTreeView; anImages: TCustomImageList = nil;
	const aFilter: String = '';	anOnCheckNodeAddition: TOnCheckNodeAddition = nil; anOnCheckNodeData: Pointer = nil): TTreeNode;
var
	aSource: ITreeSource;
	aSelected: Pointer;
begin
	Result := nil;
	if Assigned(aTreeView) then begin
		aSource := TTreeViewSearchSource.Create(aTreeView, anImages, anOnCheckNodeAddition, anOnCheckNodeData);
		aSelected := DoSearchInTree(aSource, nil, aFilter);
		if Assigned(aSelected) then begin
			Result := TObject(aSelected) as TTreeNode;
			aTreeView.Selected := Result;
			Result.MakeVisible;
		end;
	end;
end;

function DoSearchInTree(aSource: ITreeSource; aDefSelected: Pointer; const aFilter: String): Pointer;
var
	aForm: TSearchInTreeForm;
begin
	aForm := TSearchInTreeForm.Create(Application);
	try
		aForm.Init(aSource, aDefSelected, aFilter);

		if aForm.ShowModal = mrOK then
			Result := aForm.Selected
		else
			Result := nil;
	finally
		aForm.Free;
	end;
end;

type
	TNode = class(TList)
		FCaption: String;
    FImageIndex: Integer;
  	FData: Pointer;
		FAccepted: Boolean;
		FFiltred: Boolean;
		constructor Create(const aCaption: String; anImageIndex: Integer; aData: Pointer);
		destructor Destroy; override;
	end;

{ TNode }

constructor TNode.Create(const aCaption: String; anImageIndex: Integer; aData: Pointer);
begin
	inherited Create;
	FCaption := aCaption;
  FImageIndex := anImageIndex;
	FData := aData;
end;

destructor TNode.Destroy;
var
	i: Integer;
begin
	for i := 0 to Count - 1 do
		TObject(Items[i]).Free;
	inherited;
end;

{ TSelectIngoObjectForm }

procedure TSearchInTreeForm.FormCreate(Sender: TObject);
begin
	FRoot := TNode.Create('', -1, nil);
	BorderStyle := bsSizeable;
end;

procedure TSearchInTreeForm.FormDestroy(Sender: TObject);
begin
	FRoot.Free;
end;

procedure TSearchInTreeForm.ApplyFilter(aSelected: Pointer);
var
	aFilter: TWordsFilter;
	aSelectedNode: TTreeNode;
  aFirstFiltred: TTreeNode;

	function SetAccepted(aData: TNode): Boolean;
	var
		i: Integer;
		aChildData: TNode;
	begin
		Result := False;

		for i := 0 to aData.Count - 1 do begin
			aChildData := aData[i];
			aChildData.FFiltred := aFilter.Check(aChildData.FCaption);
			aChildData.FAccepted := SetAccepted(aChildData) or aChildData.FFiltred;
			if aChildData.FAccepted then
				Result := True;
		end;
	end;

	procedure AddNodes(aParent: TTreeNode; aData: TNode);
	var
		aChildNode: TTreeNode;
		aChildData: TNode;
		i: Integer;
	begin
		for i := 0 to aData.Count - 1 do begin
			aChildData := aData[i];
			if aChildData.FAccepted then begin
				aChildNode := SearchTree.Items.AddChildObject(aParent,
					aChildData.FCaption, aChildData.FData);

        aChildNode.ImageIndex := aChildData.FImageIndex;
        aChildNode.SelectedIndex := aChildData.FImageIndex;

				AddNodes(aChildNode, aChildData);

				if aChildData.FData = aSelected then
					aSelectedNode := aChildNode;

        if not Assigned(aFirstFiltred) and aChildData.FFiltred then
          aFirstFiltred := aChildNode;

				aChildNode.Expanded := True;
				(aChildNode as TXTreeNode).Bold := aChildData.FFiltred;
			end
		end;
	end;

begin
	aFilter := TWordsFilter.Create;
	try
		aFilter.Filter := Filter.Text;

		SearchTree.Items.BeginUpdate;
		try
			SearchTree.Items.Clear;
			aSelectedNode := nil;
      aFirstFiltred := nil;
			if Trim(Filter.Text) <> '' then begin
				SetAccepted(TNode(FRoot));
				AddNodes(nil, TNode(FRoot));

				if Assigned(aSelectedNode) then
					SearchTree.Selected := aSelectedNode
				else if Assigned(aFirstFiltred) then
          SearchTree.Selected := aFirstFiltred
        else
					SearchTree.Selected := SearchTree.Items.GetFirstNode;
			end;

		finally
			SearchTree.Items.EndUpdate;
		end;
	finally
		aFilter.Free
	end;

	if aSelectedNode <> nil then
		aSelectedNode.MakeVisible;
end;

procedure TSearchInTreeForm.Init(aSource: ITreeSource; aDefSelected: Pointer;
	const aFilter: String);

	procedure AddNodes(aParent: TNode; aParentDataNode: Pointer);
	var
		aNode: TNode;

		aDataNode: Pointer;
		aDataNodeCaption: String;
		aDataNodeImageIndex: Integer;
		aDataNodeOptions: TNodeSearchOptions;
		aCount: Integer;
		i: Integer;
	begin
		aCount := FSource.GetChildCount(aParentDataNode);
		for i := 0 to aCount - 1 do begin
			aDataNode := FSource.GetChild(aParentDataNode, i);
			aDataNodeCaption := FSource.GetCaption(aDataNode);
			aDataNodeImageIndex := FSource.GetImageIndex(aDataNode);
			aDataNodeOptions := FSource.GetNodeSearchOptions(aDataNode);
			if nsoVisible in aDataNodeOptions then begin
				aNode := TNode.Create(aDataNodeCaption, aDataNodeImageIndex, aDataNode);
				aParent.Add(aNode);
				AddNodes(aNode, aDataNode);
			end;
		end;
	end;


begin
	TNode(FRoot).Clear;
	FSource := aSource;
	if Assigned(FSource) then begin
		SearchTree.Images := FSource.GetImageList;
		AddNodes(TNode(FRoot), nil);
		Filter.Text := aFilter;
		PostMessage(Handle, WM_USER, 0, 0);
		ApplyFilter(aDefSelected);
	end;
end;

function TSearchInTreeForm.Selected: Pointer;
begin
	if Assigned(SearchTree.Selected) then
		Result := SearchTree.Selected.Data
	else
		Result := nil
end;

procedure TSearchInTreeForm.FilterChange(Sender: TObject);
begin
	if Timer.Interval = 0 then
		ApplyFilter(Selected)
	else begin
		Timer.Enabled := False;
		Timer.Enabled := True;
	end;
end;

procedure TSearchInTreeForm.TimerTimer(Sender: TObject);
begin
	Timer.Enabled := False;
	ApplyFilter(Selected);
end;

procedure TSearchInTreeForm.OKClick(Sender: TObject);
begin
	if Selected <> nil then
		ModalResult := mrOk
	else
		ShowMessage('ВНИМАНИЕ! Необходимо выбрать элемент.');
end;

procedure TSearchInTreeForm.FilterKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
	case Key of
		VK_UP, VK_DOWN, VK_NEXT, VK_PRIOR:
			begin
				SearchTree.Perform(WM_KEYDOWN, Key, 0);
				Key := 0;
			end
	end;
end;

procedure TSearchInTreeForm.SearchTreeDblClick(Sender: TObject);
begin
	OKClick(nil);
end;

function TSearchInTreeForm.GetFilterDelay: Cardinal;
begin
	Result := Timer.Interval;
end;

procedure TSearchInTreeForm.SetFilterDelay(const Value: Cardinal);
begin
	if Timer.Interval <> Value then
		Timer.Interval := Value;
end;

procedure TSearchInTreeForm.WMDeselectFilter(var aMsg: TMessage);
begin
	Filter.SelStart := Length(Filter.Text);
	Filter.SelLength := 0;
end;

end.





