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.