ChTreeView 含有Checkbox 的TreeView

  unit   ChTreeView;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Classes,   Controls,   ComCtrls,   CommCtrl;  
   
  type  
      TOnChecked   =   procedure   (Sender:   TObject;   Node:   TTreeNode;   Checked:   Boolean)   of   object;  
      TChTreeView   =   class(TCustomTreeView)  
      private  
          {   Private   declarations   }  
          FCheckBox:   Boolean;  
          FCheckSub:   Boolean;  
          FOnChecked:   TOnChecked;  
          procedure   WMKeyDown(var   Message:   TWMKeyDown);   message   WM_KEYDOWN;  
          procedure   WMLButtonDown(var   Message:   TWMLButtonDown);   message   WM_LBUTTONDOWN;  
          procedure   WMSetItem(var   Message:   TMessage);   message   TVM_SETITEM;  
          procedure   SetCheckBox(const   Value:   Boolean);  
      protected  
          {   Protected   declarations   }  
          procedure   CreateParams(var   Params:   TCreateParams);   override;  
          function   GetChecked(Node:   TTreeNode):   Boolean;  
          procedure   SetChecked(Node:   TTreeNode;   Checked:   Boolean);  
      public  
          {   Public   declarations   }  
          constructor   Create(AOwner:   TComponent);   override;  
          property   Checked[Node:   TTreeNode]:   Boolean   read   GetChecked   write   SetChecked;  
          procedure   SetNodeChecked(Node:   TTreeNode;   Checked,   DoSubTree:   Boolean);  
      published  
          {   Published   declarations   }  
          property   Align;  
          property   Anchors;  
          property   AutoExpand;  
          property   BiDiMode;  
          property   BorderStyle;  
          property   BorderWidth;  
          property   ChangeDelay;  
          property   CheckBox:   Boolean   read   FCheckBox   write   SetCheckBox   default   false;  
          property   CheckSub:   Boolean   read   FCheckSub   write   FCheckSub   default   false;  
          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   Items;  
          property   ParentBiDiMode;  
          property   ParentColor   default   False;  
          property   ParentCtl3D;  
          property   ParentFont;  
          property   ParentShowHint;  
          property   PopupMenu;  
          property   ReadOnly   default   True;  
          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   OnChange;  
          property   OnChanging;  
          property   OnClick;  
          property   OnCollapsing;  
          property   OnCollapsed;  
          property   OnCompare;  
          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   OnChecked:   TOnChecked   read   FOnChecked   write   FOnChecked;  
          property   OnKeyDown;  
          property   OnKeyPress;  
          property   OnKeyUp;  
          property   OnMouseDown;  
          property   OnMouseMove;  
          property   OnMouseUp;  
          property   OnStartDock;  
          property   OnStartDrag;  
      end;  
   
  procedure   Register;  
   
  implementation  
   
  procedure   Register;  
  begin  
      RegisterComponents('CH   Controls',   [TChTreeView]);  
  end;  
   
  constructor   TChTreeView.Create(AOwner:   TComponent);  
  begin  
      inherited;  
      FCheckBox   :=   false;  
      FCheckSub   :=   false;  
  end;  
   
  procedure   TChTreeView.CreateParams(var   Params:   TCreateParams);  
  begin  
      inherited;  
      if   (FCheckBox)   then  
          Params.Style:=Params.Style   or   TVS_CHECKBOXES;  
  end;  
   
  function   TChTreeView.GetChecked(Node:   TTreeNode):   Boolean;  
  const  
      TVIS_CHECKED   =   $2000;  
  var  
      TvItem   :TTVItem;  
  begin  
      TvItem.Mask   :=   TVIF_STATE;  
      TvItem.hItem   :=   Node.ItemId;  
      TreeView_GetItem(Node.TreeView.Handle,   TvItem);  
      Result   :=   (TvItem.State   and   TVIS_CHECKED)   =   TVIS_CHECKED;  
  end;  
   
   
  procedure   TChTreeView.SetCheckBox(const   Value:   Boolean);  
  begin  
      if   (FCheckBox=Value)   then   Exit;  
      FCheckBox   :=   Value;  
      RecreateWnd;  
  end;  
   
  procedure   TChTreeView.SetChecked(Node:   TTreeNode;   Checked:   Boolean);  
  const  
      TVIS_CHECKED   =   $2000;  
  var  
      TvItem   :TTVItem;  
      oldState:   Boolean;  
  begin  
      oldState   :=   GetChecked(Node);  
      if   (OldState=Checked)   then  
          Exit;  
      FillChar(TvItem,   SizeOf(TvItem),   0);  
      with   TvItem   do   begin  
          hItem   :=   Node.ItemId;  
          Mask   :=   TVIF_STATE;  
          StateMask   :=   TVIS_STATEIMAGEMASK;  
          if   Checked   then  
              TvItem.State   :=TVIS_CHECKED  
          else  
              TvItem.State   :=TVIS_CHECKED   shr   1;  
          TreeView_SetItem(Node.TreeView.Handle,   TvItem);  
      end;  
  end;  
   
  procedure   TChTreeView.SetNodeChecked(Node:   TTreeNode;   Checked,  
      DoSubTree:   Boolean);  
  var  
      subNode:   TTreeNode;  
  begin  
      if   Node=nil   then   Exit;  
      SetChecked(Node,Checked);  
      if   not   DoSubTree   then   Exit;  
      subNode   :=   Node.getFirstChild;  
      while   (subNode<>nil)   do  
      begin  
          SetNodeChecked(subNode,Checked,DoSubTree);  
          subNode   :=   subNode.getNextSibling;  
      end;  
  end;  
   
  procedure   TChTreeView.WMKeyDown(var   Message:   TWMKeyDown);  
  begin  
      if   Message.CharCode   =   VK_SPACE   then  
      begin  
          SetNodeChecked(Selected,not   Checked[Selected],FCheckSub);  
          Message.Result   :=   0;  
          if   Assigned(FOnChecked)   then  
          begin  
              FOnChecked(Self,Selected,Checked[Selected]);  
          end;  
      end   else  
          inherited;  
  end;  
   
  procedure   TChTreeView.WMLButtonDown(var   Message:   TWMLButtonDown);  
  var  
      Node:   TTreeNode;  
  begin  
      if   (htOnStateIcon   in   GetHitTestInfoAt(Message.XPos,Message.YPos))   then  
      begin  
          Node   :=   GetNodeAt(Message.XPos,Message.YPos);  
          SetNodeChecked(Node,not   Checked[Node],FCheckSub);  
          Message.Result   :=   0;  
          if   Assigned(FOnChecked)   then  
          begin  
              FOnChecked(Self,Node,Checked[Node]);  
          end;  
      end   else  
          inherited;  
  end;  
   
  procedure   TChTreeView.WMSetItem(var   Message:   TMessage);  
  const  
      TVIS_CHECKED   =   $2000;  
  var  
      pitem   :PTVItem;  
      Node,Node2:   TTreeNode;  
      IsChecked,AllNotChecked:   Boolean;  
  begin  
      inherited;  
      pitem   :=   PTVItem(Message.LParam);  
      if   (pitem^.mask=TVIF_STATE)and(pitem^.StateMask   =   TVIS_STATEIMAGEMASK)   then  
      begin  
          Node   :=   Self.Items.GetNode(pitem^.hItem);  
          IsChecked   :=   ((pitem^.State   and   TVIS_CHECKED)   =   TVIS_CHECKED);  
          if   (Node.Parent<>nil)   then  
          begin  
              if   (IsChecked)   then  
                  Checked[Node.Parent]   :=   true  
              else   begin  
                  Node2   :=   Node.Parent.getFirstChild;  
                  AllNotChecked   :=   true;  
                  while(Node2<>nil)   do  
                  begin  
                      if   (Checked[Node2])   then  
                      begin  
                          AllNotChecked   :=   false;  
                          break;  
                      end;  
                      Node2   :=   Node2.getNextSibling;  
                  end;  
                  if   AllNotChecked   then  
                      Checked[Node.Parent]   :=   false;  
              end;  
          end;  
      end;  
  end;  
   
  end.