TTreeView with checkboxes

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    ImageList1: TImageList;
    procedure TreeView1Click(Sender: TObject);
    procedure TreeView1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Collapsing(Sender: TObject; Node: TTreeNode;
      var AllowCollapse: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


const
//ImageList.StateIndex=0 has some bugs, so we add one dummy image to position 0
cUnChecked = 1;
cChecked = 2;
cPartiallyChecked = 3;

var
  Form1: TForm1;

implementation
{$R *.dfm}

procedure SetChildren(Node:TTreeNode; state:Integer);
var
  tmp:TTreeNode;
begin
  // exit if node not assigned
  if not Assigned(Node) then exit;

  // set first child and all siblings to state
  Node.StateIndex := state;
  tmp := Node.getNextSibling;
  if Assigned(tmp) then SetChildren(tmp, state);

  // set all children to state
  tmp := Node.getFirstChild;
  if Assigned(tmp) then SetChildren(tmp, state);
end;

procedure SetParents(Node:TTreeNode);
var
  tmp:TTreeNode;
  state:Integer;
begin
  // exit if node not assigned
  if not Assigned(Node) then exit;

  // parent state is checked if all siblings are checked
  state := cChecked;
  tmp := Node.getFirstChild;
  while Assigned(tmp) do begin
    if tmp.StateIndex <> cChecked then begin
      state := cPartiallyChecked;
      break;
    end;
    tmp := tmp.getNextSibling;
  end;

  // parent state is unchecked if all siblings are unchecked
  if state = cPartiallyChecked then begin
    state := cUnChecked;
    tmp := Node.getFirstChild;
    while Assigned(tmp) do begin
      if tmp.StateIndex <> cUnChecked then begin
        state := cPartiallyChecked;
        break;
      end;
      tmp := tmp.getNextSibling;
    end;
  end;

  // set state, recurse to next parent
  Node.StateIndex := state;
  tmp := Node.Parent;
  if Assigned(tmp) then
    SetParents(tmp);
end;

procedure ToggleTreeViewCheckBoxes(Node:TTreeNode);
var
  tmp:TTreeNode;
begin
  if Assigned(Node) then begin
    if (Node.StateIndex = cUnChecked)
    or (Node.StateIndex = cPartiallyChecked) then begin
      Node.StateIndex := cChecked;
      SetChildren(Node.getFirstChild, cChecked);
      SetParents(Node.Parent);
    end
    else if Node.StateIndex = cChecked then begin
      Node.StateIndex := cUnChecked;
      SetChildren(Node.getFirstChild, cUnChecked);
      SetParents(Node.Parent);
    end;
  end; // if Assigned(Node)
end; (*ToggleTreeViewCheckBoxes*)

procedure TForm1.TreeView1Click(Sender: TObject);
var
  P:TPoint;
begin
  GetCursorPos(P);
  P := TreeView1.ScreenToClient(P);
  if (htOnStateIcon in TreeView1.GetHitTestInfoAt(P.X,P.Y)) then
    ToggleTreeViewCheckBoxes(TreeView1.Selected);
end;

procedure TForm1.TreeView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_SPACE) and Assigned(TreeView1.Selected) then
    ToggleTreeViewCheckBoxes(TreeView1.Selected);
end; (*TreeView1KeyDown*)

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  TreeView1.FullExpand;
end; (*FormCreate*)

procedure TForm1.TreeView1Collapsing(Sender: TObject; Node: TTreeNode;
  var AllowCollapse: Boolean);
begin
  AllowCollapse := true;
end; (*TreeView1Collapsing*)


end.