我给TTreeView加了个CheckBox,现在把代码都拿出来,大家看看可以怎么改比较好。

loveghb 2004-11-02 01:25:45
{******************************************************************************}
// Delphi小屋 温柔的毒药 制作
// 这个组件很简陋,你们可以随意改动
// 欢迎和我多交流,不过我先声明,我是菜鸟,讨论高深的问题会让你们失望。
// 本人Delphi的QQ群:5974000 欢迎加入,一起进步!
// mailTo: loveghb@mail.china.com duyaoghb@163.com
// 2004.11.2 嘿嘿,有点象做广告了,只是想结识点朋友而已拉。不要仍砖头
{******************************************************************************}

unit AdvTreeView;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, ComCtrls;

type
TAdvTreeView = class(TCustomTreeView)
private
{ Private declarations }
ImageList1: TImageList;
procedure myInitial();

protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

published
property Align;
property Anchors;
property AutoExpand;
property BevelEdges;
property BevelInner;
property BevelOuter;
property BevelKind default bkNone;
property BevelWidth;
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 MultiSelect;
// property MultiSelectStyle;
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 StateImages;
property TabOrder;
property TabStop default True;
property ToolTips;
property Visible;
property OnAddition;
property OnAdvancedCustomDraw;
property OnAdvancedCustomDrawItem;
property OnChange;
property OnChanging;
property OnClick;
property OnCollapsed;
property OnCollapsing;
property OnCompare;
property OnContextPopup;
property OnCreateNodeClass;
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;
{ Items must be published after OnGetImageIndex and OnGetSelectedIndex }
property Items;
end;

procedure Register;

implementation

procedure TAdvTreeView.myInitial();
var
FCheck,FNocheck: TBitmap;
bmp: TBitmap;
begin
FCheck:= TBitmap.Create;
FNoCheck:= TBitmap.Create;
bmp:= TBitmap.create;
ImageList1:= TImageList.Create(nil);
ImageList1.CreateSize(13,13);

try
bmp.handle := LoadBitmap( 0, PChar(OBM_CHECKBOXES ));
With FNoCheck Do Begin
width := bmp.width div 4;
height := bmp.height div 3;
canvas.copyrect( canvas.cliprect, bmp.canvas, canvas.cliprect );
End;

With FCheck Do Begin
width := bmp.width div 4;
height := bmp.height div 3;
canvas.copyrect(canvas.cliprect, bmp.canvas, rect( width, 0, 2*width, height ));
End;
finally
bmp.free;
end;

ImageList1.Add(FNoCheck,nil);
ImageList1.Add(FCheck,nil);
Images := ImageList1;
FCheck.Free;
FNocheck.Free;
end;

procedure TAdvTreeView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
MyHitTest : THitTests;
begin
inherited;
MyHitTest := GetHitTestInfoAt(X,Y);
if htOnIcon in MyHitTest then
begin
if Selected.ImageIndex = 0 then
begin
Selected.SelectedIndex := 1;
Selected.ImageIndex := 1;
end
else
begin
Selected.SelectedIndex := 0;
Selected.ImageIndex := 0;
end;
end;
Refresh;
end;

constructor TAdvTreeView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
myInitial;
end;

destructor TAdvTreeView.Destroy;
begin
ImageList1.Free;
inherited;
end;

procedure Register;
begin
RegisterComponents('DHouse', [TAdvTreeView]);
end;

end.
...全文
123 1 打赏 收藏 转发到动态 举报
写回复
用AI写文章
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
loveghb 2004-11-02
  • 打赏
  • 举报
回复
我怎么在论坛里找不到我自己的帖子呢?
奇怪,只能在我提问的问题里找到。

5,392

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧