呵,这个由盗版的嫌疑,我把别人的包装了一下type TCheckTreeNode = class(TTreeNode) private { Private declarations } FChecked: Boolean; procedure SetChecked(const Value: Boolean); public { public declarations } property Checked: Boolean read FChecked write SetChecked; end; TCheckTreeView = class(TTreeView) private { Private declarations } FPopupMenu: TPopupMenu; protected { Protected declarations } procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure CreateWnd; override; procedure CreateCheckNodeClass(Sender: TCustomTreeView; var NodeClass: TTreeNodeClass); public { Public declarations } constructor Create(AOwner: TComponent); reintroduce; overload; end;//procedure Register;implementationuses StrUtils;//procedure Register; //begin // RegisterComponents('Budded', [TCheckTreeView]); //end;{ TCheckTreeView }procedure TCheckTreeView.CreateWnd; begin inherited CreateWnd; SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) or TVS_CHECKBOXES); end;procedure TCheckTreeView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var vTreeNode: TCheckTreeNode; PT: TPoint; Rect: TRect; begin inherited; vTreeNode := TCheckTreeNode(GetNodeAt(X, Y)); if (vTreeNode <> nil) then if (Button = mbLeft) then begin if (htOnStateIcon in GetHitTestInfoAt(X, Y)) then begin vTreeNode.Checked := not vTreeNode.Checked; if not XMLUpdateNode(vTreeNode) then vTreeNode.Checked := not vTreeNode.Checked; end; end else begin vTreeNode.Selected := True; if (htOnLabel in GetHitTestInfoAt(X, Y)) or(htOnIcon in GetHitTestInfoAt(X, Y)) then begin PopupMenu.Items[0].Enabled := vTreeNode.Level <> 0; PopupMenu.Items[3].Enabled := not vTreeNode.FCheckInfo.ReadOnly; Rect := vTreeNode.DisplayRect(True); PT := ClientToScreen(Point(Rect.Left, Rect.Bottom)); PopupMenu.Popup(PT.X, PT.Y); end; end; end;constructor TCheckTreeView.Create(AOwner: TComponent); begin inherited Create(AOwner); OnCreateNodeClass := CreateCheckNodeClass; end;procedure TCheckTreeView.CreateCheckNodeClass(Sender: TCustomTreeView; var NodeClass: TTreeNodeClass); begin NodeClass := TCheckTreeNode; end;{ TCheckTreeNode }procedure TCheckTreeNode.SetChecked(const Value: Boolean); function TreeNodeSetChecked(mTreeNode: TCheckTreeNode; mChecked: Boolean): Boolean; var vTVItem: TTVItem; begin Result := False; if not Assigned(mTreeNode) then Exit; FillChar(vTVItem, SizeOf(vTVItem), 0); with vTVItem do begin hItem := mTreeNode.ItemId; mask := TVIF_STATE; StateMask := TVIS_STATEIMAGEMASK; State := IndexToStateImageMask(Succ(Ord(mChecked))); Result := TreeView_SetItem(mTreeNode.Handle, vTVItem); end; end; procedure pSelect(mTreeNode: TCheckTreeNode; mChecked: Boolean); var I: Integer; begin for I := 0 to mTreeNode.Count - 1 do TCheckTreeNode(mTreeNode[I]).Checked := mChecked; end; procedure pSelectYes(mTreeNode: TCheckTreeNode); begin if Assigned(mTreeNode.Parent) then if not TCheckTreeNode(mTreeNode.Parent).Checked then begin TreeNodeSetChecked(TCheckTreeNode(mTreeNode.Parent), True); TCheckTreeNode(mTreeNode.Parent).FChecked := True; end; end; procedure pSelectNo(mTreeNode: TCheckTreeNode); var I: Integer; begin if Assigned(mTreeNode.Parent) and TCheckTreeNode(mTreeNode.Parent).Checked then begin for I := 0 to mTreeNode.Parent.Count - 1 do if TCheckTreeNode(mTreeNode.Parent[I]).Checked then Exit; TCheckTreeNode(mTreeNode.Parent).Checked := False; end; end; begin FChecked := Value; FCheckInfo.Checked := Value; TreeNodeSetChecked(Self, Value); pSelect(Self, Value); if Value then pSelectYes(Self) else pSelectNo(Self); end;end.
TCheckTreeNode = class(TTreeNode)
private
{ Private declarations }
FChecked: Boolean;
procedure SetChecked(const Value: Boolean);
public
{ public declarations }
property Checked: Boolean read FChecked write SetChecked;
end; TCheckTreeView = class(TTreeView)
private
{ Private declarations }
FPopupMenu: TPopupMenu;
protected
{ Protected declarations }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure CreateWnd; override;
procedure CreateCheckNodeClass(Sender: TCustomTreeView; var NodeClass: TTreeNodeClass);
public
{ Public declarations }
constructor Create(AOwner: TComponent); reintroduce; overload;
end;//procedure Register;implementationuses StrUtils;//procedure Register;
//begin
// RegisterComponents('Budded', [TCheckTreeView]);
//end;{ TCheckTreeView }procedure TCheckTreeView.CreateWnd;
begin
inherited CreateWnd;
SetWindowLong(Handle, GWL_STYLE,
GetWindowLong(Handle, GWL_STYLE) or TVS_CHECKBOXES);
end;procedure TCheckTreeView.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
vTreeNode: TCheckTreeNode;
PT: TPoint;
Rect: TRect;
begin
inherited;
vTreeNode := TCheckTreeNode(GetNodeAt(X, Y));
if (vTreeNode <> nil) then
if (Button = mbLeft)
then begin
if (htOnStateIcon in GetHitTestInfoAt(X, Y)) then
begin
vTreeNode.Checked := not vTreeNode.Checked;
if not XMLUpdateNode(vTreeNode) then
vTreeNode.Checked := not vTreeNode.Checked;
end;
end
else begin
vTreeNode.Selected := True;
if (htOnLabel in GetHitTestInfoAt(X, Y))
or(htOnIcon in GetHitTestInfoAt(X, Y)) then
begin
PopupMenu.Items[0].Enabled := vTreeNode.Level <> 0;
PopupMenu.Items[3].Enabled := not vTreeNode.FCheckInfo.ReadOnly;
Rect := vTreeNode.DisplayRect(True);
PT := ClientToScreen(Point(Rect.Left, Rect.Bottom));
PopupMenu.Popup(PT.X, PT.Y);
end;
end;
end;constructor TCheckTreeView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
OnCreateNodeClass := CreateCheckNodeClass;
end;procedure TCheckTreeView.CreateCheckNodeClass(Sender: TCustomTreeView;
var NodeClass: TTreeNodeClass);
begin
NodeClass := TCheckTreeNode;
end;{ TCheckTreeNode }procedure TCheckTreeNode.SetChecked(const Value: Boolean);
function TreeNodeSetChecked(mTreeNode: TCheckTreeNode; mChecked: Boolean): Boolean;
var
vTVItem: TTVItem;
begin
Result := False;
if not Assigned(mTreeNode) then Exit; FillChar(vTVItem, SizeOf(vTVItem), 0);
with vTVItem do
begin
hItem := mTreeNode.ItemId;
mask := TVIF_STATE;
StateMask := TVIS_STATEIMAGEMASK;
State := IndexToStateImageMask(Succ(Ord(mChecked)));
Result := TreeView_SetItem(mTreeNode.Handle, vTVItem);
end;
end; procedure pSelect(mTreeNode: TCheckTreeNode; mChecked: Boolean);
var
I: Integer;
begin
for I := 0 to mTreeNode.Count - 1 do
TCheckTreeNode(mTreeNode[I]).Checked := mChecked;
end; procedure pSelectYes(mTreeNode: TCheckTreeNode);
begin
if Assigned(mTreeNode.Parent) then
if not TCheckTreeNode(mTreeNode.Parent).Checked then
begin
TreeNodeSetChecked(TCheckTreeNode(mTreeNode.Parent), True);
TCheckTreeNode(mTreeNode.Parent).FChecked := True;
end;
end; procedure pSelectNo(mTreeNode: TCheckTreeNode);
var
I: Integer;
begin
if Assigned(mTreeNode.Parent) and TCheckTreeNode(mTreeNode.Parent).Checked then
begin
for I := 0 to mTreeNode.Parent.Count - 1 do
if TCheckTreeNode(mTreeNode.Parent[I]).Checked then Exit;
TCheckTreeNode(mTreeNode.Parent).Checked := False;
end;
end;
begin
FChecked := Value;
FCheckInfo.Checked := Value;
TreeNodeSetChecked(Self, Value);
pSelect(Self, Value);
if Value
then pSelectYes(Self)
else pSelectNo(Self);
end;end.
http://www.playicq.com/dispdocnew.php?id=16731不需第三方控件,通过delphi原生TreeView再加几行代码即可让你的TreeView带CheckBox