求一个带CHECKBOX的Treeview的源程序
解决方案 »
- sql.....
- 我的程序在前台经常出现'无法为更新定位行,一些值可能在最后一次读写已更改',,是什么原因?
- function里面可以可以给私有变量赋值吗
- 找书中文电子版<企业应用架构模式>
- 会用肥猫安装程序的进来 问个问题哈~!
- 请问在treeview中如何定位某个节点?在线等,解决就马上揭帖。
- 如何控制带孔纸的票据打印问题
- 我用ODBC联系EXCEL文件,但是在DELPHI的table控件中tablename 属性中却无法发现,?为什么
- ★★关于图形缩放时失真的问题★★????????????
- 软件开发工程师、软件工程师、程序员有什么分别?
- 一段代码的改写
- 大家来帮看看这个错误提示是什么意思?我该怎么修改》?
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