加上checkbox的treeview控件源程序

http://topic.csdn.net/t/20031125/10/2491820.html

源代码如下:  XTreeView.pas

unit   XTreeView;

{
    ==============
    TXTreeView   1.0   (1999-07-11)
    ==============

    Enhaced   TTreeView   with   2-   or   3-state   checkboxes.

    Freeware.

    Copyright   ?Roman   Stedronsky   1999,   Roman.Stedronsky@seznam.cz

    All   rights   reserved.   You   may   use   this   software   in   an   application
    without   fee   or   royalty,   provided   this   copyright   notice   remains   intact.

    types
    -----
        TCheckState                                   defines   4   states   for   every   node   (No   check,
        Unchecked,   Checked,   Grayed)
    public   properties
    -----------------
        CheckStates[Index:   integer] set/get   the   state   for   given   node   (by   index)
    published   properties
    --------------------
        CheckBoxes when   true,   shows   checkboxes
        ThreeState when   true,   use   3-state   cycle   (un-checked-grayed)
        when   false,   use   2-state   cycle   (unchecked-checked)
        CheckBitmap defines   visual   appearance   of   checkboxes
        (Width:   64   /4x16/,   height:   16.   See   default   one.)
    events
    ------
        OnStateClick occures   after   changing   state   via   mouse
        (Not   when   changing   CheckStates!)
    Note:
    Every   new   node   is   in   the   state   csNone   by   default   (checkbox   is   not   visible).
    You   must   explicitly   change   it   by   CheckStates   property.   (You   can   also   use
    node 's   StateIndex   as   shown   below,   but   why?)

    StateIndex CheckState
  -1 csNone
  1 csUnchecked
  2 csChecked
  3 csGrayed
}

interface

uses
    Windows,   Messages,   Classes,   Graphics,   Controls,   ComCtrls,   Commctrl;

type
    TCheckState   =   (csNone,   csUnchecked,   csChecked,   csGrayed);
    TStateClickEvent   =   procedure(CheckState:   TCheckState)   of   object;

    TXTreeView   =   class(TCustomTreeView)
    protected
        {   internal   variables   }
        FBitmap:   TBitmap;
        CheckStateImages:   TImageList;
        {   property   variables   }
        FCheckBoxes:   boolean;
        FThreeState:   boolean;
        FStateClickEvent:   TStateClickEvent;
        {   property   manipulation   methods   }
        procedure   FWriteCheckBoxes(Value:   boolean);
        function   FReadCheckState(Index:   integer):   TCheckState;
        procedure   FWriteCheckState(Index:   integer;   Value:   TCheckState);
        procedure   FWriteCheckBitmap(Value:   TBitmap);
        {   internal   methods   }
        procedure   ChangeCheckState(Node:   TTreeNode);
        procedure   SetChildCS(Node:   TTreeNode);
        procedure   SetParentCS(Node:   TTreeNode);
        function   GetAllChildCS(Node:TTreeNode):integer;
        procedure   BitmapChanged(Sender:   TObject);
    public
        {   overrided   methods   }
        constructor   Create(AOwner:   TComponent);   override;
        destructor   Destroy;   override;
        procedure   CNNotify(var   Message:   TWMNotify);   message   CN_NOTIFY;
        property   CheckStates[Index:   integer]:   TCheckState   read   FReadCheckState   write   FWriteCheckState;
    published
        property   CheckBoxes:   boolean   read   FCheckBoxes   write   FWriteCheckBoxes   default   true;
        property   ThreeState:   boolean   read   FThreeState   write   FThreeState   default   false;
        property   CheckBitmap:   TBitmap   read   FBitmap   write   FWriteCheckBitmap   stored   true   default   nil;
        property   OnStateClick:   TStateClickEvent   read   FStateClickEvent   write   FStateClickEvent;
    published
        {   make   TCustomTreeView   propeties   published   (exclude   StateImages)   }
        property   Align;
        property   Anchors;
        property   AutoExpand;
        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   Items;
        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   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   OnKeyDown;
        property   OnKeyPress;
        property   OnKeyUp;
        property   OnMouseDown;
        property   OnMouseMove;
        property   OnMouseUp;
        property   OnStartDock;
        property   OnStartDrag;
    end;

procedure   Register;

implementation


{$R   XTreeView.res}

const
    cCheckStatesBitmap   =   'CheckStatesBitmap ';

procedure   Register;
begin
    RegisterComponents( 'DETOOLS ',   [TXTreeView]);
end;

{   property   manipulation   methods   }

procedure   TXTreeView.FWriteCheckBoxes(Value:   boolean);
begin
    FCheckBoxes   :=   Value;
    if   FCheckBoxes   then
        StateImages   :=   CheckStateImages
    else
        StateImages   :=   nil;
end;

function   TXTreeView.FReadCheckState(Index:   integer):   TCheckState;
begin
    if   (Index   >   -1)   and   (Index   <   Items.Count)   then
        if   Items[Index].StateIndex   =   -1   then
            Result   :=   csNone
        else
            Result   :=   TCheckState(Items[Index].StateIndex)
    else
        Result   :=   csNone;
end;

procedure   TXTreeView.FWriteCheckState(Index:   integer;   Value:   TCheckState);
begin
    if   (Index   >   -1)   and   (Index   <   Items.Count)   then
        if   Value   =   csNone   then
            Items[Index].StateIndex   :=   -1
        else
            Items[Index].StateIndex   :=   integer(Value);
end;

procedure   TXTreeView.FWriteCheckBitmap(Value:   TBitmap);
begin
    if   Value   =   nil   then
    begin
        FBitmap.Handle   :=   LoadBitmap(HInstance,   cCheckStatesBitmap)
    end
    else
        FBitmap.Assign(Value);
    CheckStateImages.Clear;   //   Does   Clear   free   memory   or   not?
    CheckStateImages.Add(FBitmap,   nil);
end;

{   internal   methods   }

procedure   TXTreeView.BitmapChanged(Sender:   TObject);
begin
    CheckStateImages.Clear;
    CheckStateImages.Add(FBitmap,   nil);
end;
//ret   values   is   1   全部选中,2   全部未选中   3   部分选中
function   TXTreeView.GetAllChildCS(Node:TTreeNode):integer;
var
    ret:integer;
    num,num1,num2,i:integer;
begin
    num1:=0;
    num2:=0;
    num:=node.Count;
    for   i:=0   to   num-1   do
    begin
        case   node.Item[i].StateIndex   of
        1:inc(num1);
        2:inc(num2);
        end;
    end;
    if   (num1=num)then
    ret:=1
    else
    if   (num2=num)then
    ret:=2
    else
    ret:=3;
    result:=ret;
end;
procedure   TXTreeView.SetChildCS(Node:   TTreeNode);
var
    tempnode:ttreenode;
    stateindex:integer;
begin
    if   (node <> nil)   then
    begin
        stateindex:=node.StateIndex;
        tempnode:=node.getFirstChild;
        while(tempnode <> nil)   do
        begin
            tempnode.StateIndex:=stateindex;
            if   (tempnode <> nil)and(tempnode.HasChildren)   then
                SetChildCS(tempnode);
            tempnode:=tempnode.getNextSibling;
        end;
    end;
end;
procedure   TXTreeView.SetParentCS(Node:   TTreeNode);
var
    tempnode:ttreenode;
begin
    if   (node <> nil)   then
    begin
        tempnode:=node.GetPrev;
        while(tempnode <> nil)do
        begin
            if   (node.HasAsParent(tempnode))then
            begin
                //如果子节点当前状态为选中，那么搜索该父节点的所有子节点，
                //如果已经全部选中，那末就将该父节点设为选中
                //否则设置该父节点为灰色
                //如果子节点当前状态为未选中，那么搜索该父节点所有子节点，
                //如果全部未选中，那么设置该父节点为未选中
                //否则设置为灰色
                case   node.StateIndex   of
                2:
                begin
                    case   GetAllChildCS(tempnode)   of
                    1:
                        tempnode.StateIndex:=2;
                    2:
                        tempnode.StateIndex:=2;                    
                    3:
                        tempnode.StateIndex:=3;
                    end;
                end;
                1:
                begin
                    case   GetAllChildCS(tempnode)   of
                    1:
                        tempnode.StateIndex:=1;
                    2,3:
                        tempnode.StateIndex:=3;
                    end;
                end;
                end;
            end;
            tempnode:=tempnode.GetPrev;
        end;
    end;
end;
procedure   TXTreeView.ChangeCheckState(Node:   TTreeNode);
begin
    if   CheckStates[Node.AbsoluteIndex]   =   csUnchecked   then
        CheckStates[Node.AbsoluteIndex]   :=   csChecked
    else
        if   CheckStates[Node.AbsoluteIndex]   =   csChecked   then
        begin
            CheckStates[Node.AbsoluteIndex]   :=   csUnchecked
            {
            if   FThreeState   then
                CheckStates[Node.AbsoluteIndex]   :=   csGrayed
            else
                CheckStates[Node.AbsoluteIndex]   :=   csUnchecked
            }
        end
        else
            CheckStates[Node.AbsoluteIndex]   :=   csUnchecked;
    SetChildCS(node);
    SetParentCS(Node);
end;
{   overrided   methods   }

constructor   TXTreeView.Create(AOwner:   TComponent);
begin
    inherited   Create(AOwner);
    CheckStateImages   :=   TImageList.Create(Self);
    FBitmap   :=   TBitmap.Create;
    FBitmap.OnChange   :=   BitmapChanged;
    FBitmap.Handle   :=   LoadBitmap(HInstance,   cCheckStatesBitmap);
    StateImages   :=   CheckStateImages;
    FThreeState   :=   false;
    CheckBoxes   :=   true;
    ParentColor   :=   False;
    TabStop   :=   True;
end;

destructor   TXTreeView.Destroy;
begin
    FBitmap.Free;
    CheckStateImages.Free;
    inherited   Destroy;
end;

procedure   TXTreeView.CNNotify(var   Message:   TWMNotify);
var
    Node:   TTreeNode;
    Point:   TPoint;
    Position:   DWORD;
begin
    case   message.nmhdr.code   of
        NM_CLICK:
            begin
                Position   :=   GetMessagePos;
                Point.x   :=   LoWord(Position);
                Point.y   :=   HiWord(Position);
                Point   :=   ScreenToClient(Point);
                Node   :=   GetNodeAt(Point.x,   Point.y);
                if   (Node   <>   nil)   then
                begin
                    if   htOnStateIcon   in   GetHitTestInfoAt(Point.x,   Point.y)   then
                    begin
                        ChangeCheckState(Node);
                        if   Assigned(FStateClickEvent)   then
                            FStateClickEvent(CheckStates[Node.AbsoluteIndex]);
                    end;
                end;
            end;
    end;
    inherited;
end;

end.