unit xTreeView;

interface
uses
	Forms, ComCtrls, Controls, Messages, Classes, Windows, CommCtrl, ImgList, Graphics;

type
	TXCustomTreeView = class;
	TXTreeNode = class;

	TNodeCheckState = (nsUnchecked = 1, nsChecked = 2, nsIndeterminate = 3);

	TOnIconClick = procedure(aSender: TObject; aNode: TTreeNode; aButton: TMouseButton;
		aShift: TShiftState; aX, aY: Integer) of object;
	TOnMouseOverIcon = procedure(aSender: TObject; aNode: TTreeNode; aShift: TShiftState;
		aX, aY: Integer) of object;
	TOnNodeChecked = procedure(aSender: TXCustomTreeView; aNode: TXTreeNode) of object;
	TOnNodeChecking = procedure(aSender: TXCustomTreeView; aNode: TXTreeNode;	aCheck: Boolean) of object;
	TOnNodeCanCheck = procedure(aSender: TXCustomTreeView; aNode: TXTreeNode;
		aCheck: Boolean; var aCanCheck: Boolean) of object;
	TVNInfoTipEvent = procedure(Sender: TObject; aNode: TXTreeNode; var InfoTip: string) of object;

	TXTreeNode = class(TTreeNode)
	private
		function  GetState: TNodeCheckState;
		procedure SetState(aValue: TNodeCheckState);

		function  GetBold: Boolean;
		procedure SetBold(const Value: Boolean);
		procedure SetImageIndex(Value: TImageIndex);
	public
		property CheckState: TNodeCheckState read GetState write SetState;
		property ImageIndex: TImageIndex write SetImageIndex;
		property Bold: Boolean read GetBold write SetBold;
	end;

	TCheckboxesMode = (cbmNone, cbmIndependent, cbmHierarchical);
	TXCustomTreeView = class(TCustomTreeView)
	private
		FOnIconClick: TOnIconclick;
		FOnMouseOverIcon: TOnMouseOverIcon;
		FOnShiftStateChanged: TNotifyEvent;
		FOnNodeChecked: TOnNodeChecked;
		FOnNodeChecking: TOnNodeChecking;
		FOnNodeCanCheck: TOnNodeCanCheck;
		FOnInfoTip: TVNInfoTipEvent;

		FDragObject: TDragObject;

		FCheckImages: TCustomImageList;
		FCheckboxes: TCheckboxesMode;
	protected
		procedure CreateParams(var Params: TCreateParams); override;

		// GUI check functions
		procedure SetCheckboxes(aValue: TCheckboxesMode);
		function  GetNodeCheckState(aNode: TTreeNode): TNodeCheckState;
		procedure SetNodeCheckState(aNode: TTreeNode; aValue: TNodeCheckState);

		function  CreateNode: TTreeNode; override;
		procedure Added(Node: TTreeNode); override;

		procedure WndProc(var aMsg: TMessage); override;
		procedure WMNotify(var aMsg: TWMNotify); message WM_NOTIFY;
		procedure CNNotify(var aMsg: TWMNotify); message CN_NOTIFY;
		procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
		procedure MouseMove(aShift: TShiftState; aX, aY: Integer); override;
		procedure MouseDown(aButton: TMouseButton; aShift: TShiftState; aX, aY: Integer); override;
		procedure KeyPress(var Key: Char); override;

		procedure DoStartDrag(var aDragObject: TDragObject); override;
		procedure DoEndDrag(aTarget: TObject; aX, aY: Integer); override;

		procedure DoNodeChecking(aNode: TTreeNode; aCheck: Boolean);
		procedure DoNodeChecked(aNode: TTreeNode);
		procedure DoNodeCanCheck(aNode: TTreeNode; aCheck: Boolean; var aCanCheck: Boolean);

		procedure ShiftStateChanged; virtual;
		procedure IconClick(aNode: TTreeNode; aButton: TMouseButton; aShift: TShiftState;
			aX, aY: Integer); dynamic;
		procedure MouseOverIcon(aNode: TTreeNode; aShift: TShiftState; aX, aY: Integer); dynamic;

		property OnIconClick: TOnIconClick read FOnIconClick write FOnIconClick;
		property OnMouseOverIcon: TOnMouseOverIcon read FOnMouseOverIcon write FOnMouseOverIcon;
		property OnShiftStateChanged: TNotifyEvent read FOnShiftStateChanged write FOnShiftStateChanged;

		property OnNodeChecked: TOnNodeChecked read FOnNodeChecked write FOnNodeChecked;
		property OnNodeChecking: TOnNodeChecking read FOnNodeChecking write FOnNodeChecking;
		property OnNodeCanCheck: TOnNodeCanCheck read FOnNodeCanCheck write FOnNodeCanCheck;
		property OnInfoTip: TVNInfoTipEvent read FOnInfoTip write FOnInfoTip;
	public
		constructor Create(AOwner: TComponent); override;
		destructor  Destroy; override;

		property DragObject: TDragObject read FDragObject;
		property Checkboxes: TCheckboxesMode read FCheckboxes write SetCheckboxes;
	end;

	TXTreeView = class(TXCustomTreeView)
	published
		property OnIconClick;
		property OnMouseOverIcon;

		property Align;
		property Anchors;
		property AutoExpand;
		property BevelEdges;
		property BevelInner;
		property BevelOuter;
		property BevelKind default bkNone;
		property BevelWidth;
		property BiDiMode;
		property BorderStyle;
		property BorderWidth;
		property ChangeDelay;
		property Color;
		property Ctl3D;
		property Constraints;
		property DragKind;
		property DragCursor;
		property DragMode;
		property Enabled;
		property Font;
		property HideSelection;
		property HotTrack;
		property Images;
		property Indent;

		property MultiSelect;
		property MultiSelectStyle;
		property ParentBiDiMode;
		property ParentColor default False;
		property ParentCtl3D;
		property ParentFont;
		property ParentShowHint;
		property PopupMenu;
		property ReadOnly;
		property RightClickSelect;
		property RowSelect;
		property ShowButtons;
		property ShowHint;
		property ShowLines;
		property ShowRoot;
		property SortType;
		property StateImages;
		property TabOrder;
		property TabStop default True;
		property ToolTips;
		property Visible;
		property Checkboxes default cbmNone;
		property OnAddition;
		property OnAdvancedCustomDraw;
		property OnAdvancedCustomDrawItem;
		property OnChange;
		property OnChanging;
		property OnClick;
		property OnCollapsing;
		property OnCollapsed;
		property OnCompare;
		property OnContextPopup;
		property OnCreateNodeClass;
		property OnCustomDraw;
		property OnCustomDrawItem;
		property OnDblClick;
		property OnDeletion;
		property OnDragDrop;
		property OnDragOver;
		property OnEdited;
		property OnEditing;
		property OnEndDock;
		property OnEndDrag;
		property OnEnter;
		property OnExit;
		property OnExpanding;
		property OnExpanded;
		property OnGetImageIndex;
		property OnGetSelectedIndex;
		property OnKeyDown;
		property OnKeyPress;
		property OnKeyUp;
		property OnMouseDown;
		property OnMouseMove;
		property OnMouseUp;
		property OnNodeChecked;
		property OnNodeChecking;
		property OnNodeCanCheck;
		property OnStartDock;
		property OnStartDrag;
		property OnShiftStateChanged;
		property OnInfoTip;
		property Items;
	end;


implementation

uses ChecksRes;

procedure SetStateParentNode(aParent: TTreeNode);
var
	aCheckCount,
	i: Integer;
begin
	if Assigned(aParent) then begin
		aCheckCount := 0;
		for i := 0 to aParent.Count - 1 do
			case aParent[i].StateIndex of
				ord(nsChecked): Inc(aCheckCount);
				ord(nsIndeterminate): begin
					aCheckCount := -1;
					break;
				end;
			end;

		if aCheckCount = 0 then
			aParent.StateIndex := ord(nsUnchecked)
		else if aCheckCount = aParent.Count then
			aParent.StateIndex := ord(nsChecked)
		else
			aParent.StateIndex := ord(nsIndeterminate);

		SetStateParentNode(aParent.Parent);
	end;
end;

procedure SetNodeState(anOwner: TXCustomTreeView;
	aNode: TTreeNode; aState: TNodeCheckState;
	aRecursive: Boolean; aGUIEvent: Boolean = False; anInvalidateImage: Boolean = True);

	procedure InvalidateCheckImage;
	var
		aR: TRect;
	begin
		if aNode.TreeView.HandleAllocated  or not anInvalidateImage then
			Exit;

		aR := aNode.DisplayRect(False);
		InvalidateRect(aNode.TreeView.Handle, @aR, True);
	end;

var
	aCanCheck: Boolean;
	anInvalidate: Boolean;
	aChild: TTreeNode;
begin
	if not Assigned(aNode) then
		Exit;

	aCanCheck := True;
	if (aState <> nsIndeterminate) and Assigned(anOwner) then
		anOwner.DoNodeCanCheck(aNode, aState = nsChecked, aCanCheck);

	if not aCanCheck then
		Exit;

	if Assigned(anOwner) and (aState <> nsIndeterminate) and aGUIEvent then
		anOwner.DoNodeChecking(aNode, aState = nsChecked);

	aNode.StateIndex := Ord(aState);
	try
		if aRecursive then begin
			anInvalidate := aNode.Expanded;

			aChild := aNode.getFirstChild; //  через Items[i] очень медленно работает
			while Assigned(aChild) do begin
				SetNodeState(anOwner, aChild, aState, True, aGUIEvent, anInvalidate);
				aChild := aChild.getNextSibling;
			end;
		end;
	finally
		if Assigned(anOwner) and aGUIEvent then
			anOwner.DoNodeChecked(aNode);
	end;

	InvalidateCheckImage;
end;

procedure SetNodeListState(aList: TTreeNodes; aState: Integer);
var
	i: Integer;
begin
	if aList.Count > 0 then begin
		aList.BeginUpdate;
		try
			for i := 0 to aList.Count-1 do
				aList[i].StateIndex := aState;
		finally
			aList.EndUpdate;
		end;
	end;
end;

{ TXTreeNode }
function TXTreeNode.GetBold: Boolean;
var
  Item: TTVItem;
begin
	Result := False;
	if not Deleting then
		with Item do
		begin
			mask := TVIF_STATE;
			hItem := ItemId;
			if TreeView_GetItem(Handle, Item) then
				Result := (state and TVIS_BOLD) <> 0;
		end;
end;

function TXTreeNode.getState: TNodeCheckState;
begin
	if TXTreeView(TreeView).Checkboxes <> cbmNone then begin
		case StateIndex of
			ord(nsUnchecked): Result := nsUnchecked;
			ord(nsChecked)	: Result := nsChecked;
			else
				Result := nsIndeterminate
		end;
	end
	else
		Result := nsIndeterminate;
end;

procedure TXTreeNode.SetBold(const Value: Boolean);
var
	Item: TTVItem;
begin
	if not Deleting then
	begin
		with Item do
		begin
			mask := TVIF_STATE;
			hItem := ItemId;
			stateMask := TVIS_BOLD;

			if Value then
				state := stateMask and DWORD(-1)
			else
				state := DWORD(0);
		end;
		TreeView_SetItem(Handle, Item);
	end;
end;

procedure TXTreeNode.SetImageIndex(Value: TImageIndex);
begin
	inherited ImageIndex := Value;
	SelectedIndex := Value;
end;

procedure TXTreeNode.SetState(aValue: TNodeCheckState);
var
	anOwner: TXCustomTreeView;
begin
	anOwner := TXCustomTreeView(TreeView);
	if anOwner.Checkboxes = cbmNone then
		Exit;

	if GetState = aValue then
	 Exit; 	

	Owner.BeginUpdate;
	try
		SetNodeState(nil, Self, aValue, anOwner.Checkboxes = cbmHierarchical);
		if anOwner.Checkboxes = cbmHierarchical then
			SetStateParentNode(Parent);
	finally
		Owner.EndUpdate;
	end;
end;

constructor TXCustomTreeView.Create(AOwner: TComponent);
begin
	inherited Create(AOwner);
	FCheckImages := TCustomImageList.Create(nil);
end;

destructor TXCustomTreeView.Destroy;
begin
	FCheckImages.Free;
	inherited;
end;

procedure TXCustomTreeView.CreateParams(var Params: TCreateParams);
begin
	inherited;
	Params.Style := Params.Style or TVS_INFOTIP;
end;

function TXCustomTreeView.CreateNode: TTreeNode;
begin
	Result := TXTreeNode.Create(Items)
end;

procedure TXCustomTreeView.Added(Node: TTreeNode);
begin
	if (FCheckboxes <> cbmNone) and Assigned(Node) then
		Node.StateIndex := ord(nsUnchecked);

	inherited Added(Node);
end;


procedure TXCustomTreeView.SetCheckboxes(aValue: TCheckboxesMode);
begin
	if FCheckboxes <> aValue then begin

		if aValue <> cbmNone then begin
			with FCheckImages do begin
				ResourceLoad(rtBitmap, resUnchecked, clOlive);
				ResourceLoad(rtBitmap, resUnchecked, clOlive);
				ResourceLoad(rtBitmap, resChecked, clOlive);
				ResourceLoad(rtBitmap, resIndeterminate, clOlive);
			end;
			StateImages := FCheckImages;

			SetNodeListState(Items, ord(nsUnchecked))
		end
		else begin
			SetNodeListState(Items, 0);
			StateImages := nil;
			FCheckImages.Clear;
		end;

		FCheckboxes := aValue;
	end;
end;

function TXCustomTreeView.GetNodeCheckState(aNode: TTreeNode): TNodeCheckState;
begin
	if Assigned(aNode) and (FCheckboxes <> cbmNone) then
		Result := TXTreeNode(aNode).CheckState
	else
		Result := nsIndeterminate;
end;

procedure TXCustomTreeView.SetNodeCheckState(aNode: TTreeNode; aValue: TNodeCheckState);
begin
	Assert(FCheckboxes <> cbmNone, 'Invalid use XTreeView, checkboxes disabled');
	if Assigned(aNode) and (FCheckboxes <> cbmNone)then begin

		Items.BeginUpdate;
		try
			SetNodeState(Self, aNode, aValue, Checkboxes = cbmHierarchical, True);
			if Checkboxes = cbmHierarchical then
				SetStateParentNode(aNode.Parent);
		finally
			Items.EndUpdate;
		end;
	end
end;


procedure TXCustomTreeView.ShiftStateChanged;
begin
	if Assigned(FOnShiftStateChanged) then
		FOnShiftStateChanged(Self);
end;

procedure TXCustomTreeView.WndProc(var aMsg: TMessage);
begin
	inherited;
	if (aMsg.Msg = WM_KEYUP) and (aMsg.WParam = VK_SHIFT) or
		(aMsg.Msg = WM_KEYDOWN) and (aMsg.WParam = VK_SHIFT) and (aMsg.LParam and (1 shl 30) = 0)
	then
		ShiftStateChanged;
end;

procedure TXCustomTreeView.WMNotify(var aMsg: TWMNotify);
begin
	case aMsg.NMHdr.code of
		TTN_NEEDTEXTW:
			aMsg.Result := 0;

		TVN_GETINFOTIP:
			if Assigned(FOnInfoTip) then
				Application.ActivateHint(Mouse.CursorPos);
		else
			inherited;
	end;
end;

procedure TXCustomTreeView.CNNotify(var aMsg: TWMNotify);
var
	aMouse: TPoint;
begin
	if aMsg.NMHdr.code = NM_RCLICK then begin
		GetCursorPos(aMouse);
		with PointToSmallPoint(ScreenToClient(aMouse)) do
			Selected := GetNodeAt(X, Y);
	end;
	inherited
end;

procedure TXCustomTreeView.CMHintShow(var Message: TMessage);
var
	Item: TXTreeNode;
	ItemRect: TRect;
	InfoTip: string;
begin
	if Assigned(FOnInfoTip) then
		with TCMHintShow(Message) do
		begin
			Item := GetNodeAt(HintInfo.CursorPos.X, HintInfo.CursorPos.Y) as TXTreeNode;
			if Assigned(Item) then	begin
				InfoTip := Item.Text;
				FOnInfoTip(Self, Item, InfoTip);

				ItemRect := Item.DisplayRect(True);
				ItemRect.TopLeft := ClientToScreen(ItemRect.TopLeft);
				ItemRect.BottomRight := ClientToScreen(ItemRect.BottomRight);
				with HintInfo^ do
				begin
					HintInfo.CursorRect := ItemRect;
					HintInfo.HintStr := InfoTip;
					HintPos.Y := CursorRect.Top + GetSystemMetrics(SM_CYCURSOR);
					HintPos.X := CursorRect.Left + GetSystemMetrics(SM_CXCURSOR);
					HintInfo.HintMaxWidth := ClientWidth;
					Message.Result := 0;
				end
			end;
		end
	else
		inherited;
end;

procedure TXCustomTreeView.MouseMove(aShift: TShiftState; aX, aY: Integer);
var
	aNode: TTreeNode;
begin
	if (FCheckboxes <> cbmNone) then begin
		if htOnStateIcon in GetHitTestInfoAt(aX, aY) then
			Cursor := crHandPoint
		else
			Cursor := crDefault;
	end;

	if htOnIcon in GetHitTestInfoAt(aX, aY) then
		aNode := GetNodeAt(aX, aY)
	else
		aNode := nil;
	MouseOverIcon(aNode, aShift, aX, aY);
end;

procedure TXCustomTreeView.MouseDown(aButton: TMouseButton; aShift: TShiftState; aX, aY: Integer);
var
	aNode: TTreeNode;
begin
	aNode := GetNodeAt(aX, aY);
	if Assigned(aNode) then begin

		if htOnIcon in GetHitTestInfoAt(aX, aY) then
			IconClick(aNode, aButton, aShift, aX, aY);

		if (FCheckboxes <> cbmNone) then begin
			if htOnStateIcon in GetHitTestInfoAt(aX, aY) then
				if GetNodeCheckState(aNode) = nsChecked then
					SetNodeCheckState(aNode, nsUnchecked)
				else
					SetNodeCheckState(aNode, nsChecked);
		end;
	end;
end;

procedure TXCustomTreeView.KeyPress(var Key: Char);
begin
	if (FCheckboxes <> cbmNone) and (Key = ' ') and Assigned(Selected) then begin

		if GetNodeCheckState(Selected) = nsChecked then
			SetNodeCheckState(Selected, nsUnchecked)
		else
			SetNodeCheckState(Selected, nsChecked);

		Key := #0;
	end;

	inherited;
end;


procedure TXCustomTreeView.DoStartDrag(var aDragObject: TDragObject);
begin
	inherited DoStartDrag(aDragObject);
	if not Assigned(aDragObject) then
		aDragObject := TDragControlObject.Create(Self);
	FDragObject := aDragObject;
end;

procedure TXCustomTreeView.DoEndDrag(aTarget: TObject; aX, aY: Integer);
begin
	inherited DoEndDrag(aTarget, aX, aY);
	FDragObject.Free;
	FDragObject := nil;
end;

procedure TXCustomTreeView.IconClick(aNode: TTreeNode; aButton: TMouseButton; aShift: TShiftState;
	aX, aY: Integer);
begin
	if Assigned(FOnIconClick) then
		FOnIconClick(Self, aNode, aButton, aShift, aX, aY);
end;

procedure TXCustomTreeView.MouseOverIcon(aNode: TTreeNode; aShift: TShiftState; aX, aY: Integer);
begin
	if Assigned(FOnMouseOverIcon) then
		FOnMouseOverIcon(Self, aNode, aShift, aX, aY);
end;

procedure TXCustomTreeView.DoNodeChecking(aNode: TTreeNode;
	aCheck: Boolean);
begin
	if Assigned(FOnNodeChecking) then
		FOnNodeChecking(Self, aNode as TXTreeNode, aCheck);
end;

procedure TXCustomTreeView.DoNodeChecked(aNode: TTreeNode);
begin
	if Assigned(FOnNodeChecked) then
		FOnNodeChecked(Self, aNode as TXTreeNode)
end;

procedure TXCustomTreeView.DoNodeCanCheck(aNode: TTreeNode;
	aCheck: Boolean; var aCanCheck: Boolean);
begin
	aCanCheck := True;
	if Assigned(FOnNodeCanCheck) then
		FOnNodeCanCheck(Self, aNode as TXTreeNode, aCheck, aCanCheck);
end;



end.
