加上checkbox的treeview控件源程序

unit   XTreeView;

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

    Enhaced   TTreeView   with   2-   or   3-state   checkboxes.

    Freeware.

    Copyright   ?Roman   Stedronsky   1999,   [email protected]

    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/,   

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.