最新修改版树形表格（TreeView Grid）控件代码原创_冯思锐

http://blog.sina.com.cn/u/1114487833

首页博文目录关于我

个人资料

微博

加好友发纸条

写留言加关注

博客等级：
博客积分：

博客访问：
关注人气：
获赠金笔：0支
赠出金笔：0支
荣誉徽章：

正文字体大小：大中小

最新修改版树形表格（TreeView Grid）控件代码原创

(2010-08-10 19:58:46)

标签：

树形表格

delphi

treeview

grid

外汇保证金

保证金交易

多列treeview

修改过的TreeView Grid 控件代码

增加了内部 Editor TtvEdit，可以编辑

//by 冯思锐

TtvEdit = class(TmaskEdit)
private
    FTreeView: TcolTreeView;
    procedure Wmpaint(var msg: TWMPaint); message WM_PAINT;
protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure CreateParams(var Params: TCreateParams); override;
public
    procedure hide;
    procedure BoundsChanged;
end;

可以编辑：如下图

http://s2/bmiddle/426dbc19g913780972231&690&690树形表格（TreeView Grid）控件代码原创" />

各栏可以排序，入下图

http://s8/bmiddle/426dbc19g91378088d3c7&690&690树形表格（TreeView Grid）控件代码原创" />

TTreeColumn = class(TCollectionItem)

添加 property allowSort: boolean read FallowSort write FallowSort;

可以ownerDraw，如下图。

http://s8/bmiddle/426dbc19g9137811812e7&690&690树形表格（TreeView Grid）控件代码原创" />

以下是所有代码，包括一个可以 ownerDraw 标题的 ListView

unit srListview;

interface

uses
SysUtils, windows, Classes, Controls, ComCtrls, Types, messages, Graphics,
imgList, mask, forms, stdCtrls;
type

TdataType = (dtString, dtInteger, dtFloat, dtPercentage);

Tsrlistview = class(TListView)
private
    { Private declarations }
    FhdHandle: integer;
    FHdNewProc: pointer;
    FHdOldProc: pointer;
    FTextoffSet: integer;
    FclSelected: TColor;
    FclTitleEnd: TColor;
    FclTitleBegin: TColor;
    bmp: TbitMap;
    FclBegin: TColor;
    FclFrame: TColor;
    function GetHeaderSectionRect(Index: Integer): TRect;
    procedure HeaderProc(var Message: TMessage);
    procedure DrawHeaderSection(Cnvs: TCanvas; Column: TListColumn; index: integer;
      Active, Pressed: Boolean; R: TRect);
    procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY;
    procedure WMNCPAINT(var Message: TWMNCPAINT); message WM_NCPAINT;
    procedure SetclSelected(const Value: TColor);
    procedure SetclTitleBegin(const Value: TColor);
    procedure SetclTitleEnd(const Value: TColor);
    procedure SetTextoffSet(const Value: integer);
    procedure SetclBegin(const Value: TColor);
    procedure SetclFrame(const Value: TColor);
protected
    { Protected declarations }
    procedure Drawheader(Dc: HDc);
public
    { Public declarations }
    procedure invalidate; override;
    constructor Create(Aowner: TComponent); override;
    destructor Destroy; override;
published
    { Published declarations }
    property clTitleBegin: TColor read FclTitleBegin write SetclTitleBegin;
    property clTitleEnd: TColor read FclTitleEnd write SetclTitleEnd;
    property clSelected: TColor read FclSelected write SetclSelected;
    property TextoffSet: integer read FTextoffSet write SetTextoffSet;
    property clBegin: TColor read FclBegin write SetclBegin;
    property clFrame: TColor read FclFrame write SetclFrame;
end;

TcolTreeView = class;

TTreeColumn = class(TCollectionItem)
private
    FColWidth: integer;
    FTitle: string;
    FColor: TColor;
    FTransParent: boolean;
    FAlign: TAlignment;
    FTextoffset: integer;
    FCharCase: TEditCharCase;
    FallowSort: boolean;
    FdataType: TDataType;
    procedure SetColor(const Value: TColor);
    procedure SetTitle(const Value: string);
    procedure SetcolWidth(const Value: integer);
    procedure setTransparent(const Value: boolean);
protected
    function GetDisplayName: string; override;
public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
published
    property TiTle: string read FTitle write SetTitle;
    property Colwidth: integer read FColWidth write SetcolWidth;
    property Color: TColor read FColor write SetColor;
    property Align: TAlignment read FAlign write FAlign;
    property Textoffset: integer Read FTextoffset write FTextoffset;
    property Transparent: boolean read FTransParent write setTransparent;
    property CharCase: TEditCharCase Read FCharCase write FCharCase;
    property allowSort: boolean read FallowSort write FallowSort;
    property dataType: TDataType read FdataType Write FDataType;
end;

TTreeColumnClass = class of TTreeColumn;

TTreeColumns = class(TCollection)
private
    FTreeView: TcolTreeView;
    function GetColumn(Index: Integer): TTreeColumn;
    procedure SetColumn(Index: Integer; Const Value: TTreeColumn);
protected
    procedure Update(Item: TCollectionItem); override;
public
    constructor Create(TreeView: TcolTreeView; ColumnClass: TTreeColumnClass);
    property Items[Index: Integer]: TTreeColumn read GetColumn write SetColumn;
end;

TcolNode=class(TTreeNode)
private
    FisBottomLevel: Boolean;
    FTexts: TStrings;
    Fid: integer;
protected
    //
public
    constructor Create(AOwner: TTreeNodes);
    destructor Destroy; override;
    property id: integer read Fid write Fid;
    property isBottomLevel: Boolean read FisBottomLevel write FisBottomLevel;
    property Texts: TStrings read FTexts write FTexts;
end;

TsrTreeView = class(TTreeView)
published
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
end;

// TcolTreeView = class;

TCustomDrawImage = procedure(Sender: Tobject; node: TcolNode; Acanvas: Tcanvas; x, y: integer) of object;
TCustomDrawText = procedure(Sender: Tobject; node: TcolNode; Acanvas: Tcanvas;
Acol: integer; ARect: TRect; dfDraw: boolean) of object;
TonVerifyText = procedure(sender: Tobject; Text: string) of object;

TcolTreeView = class(TTreeView)
private
    { Private declarations }
    Desc: boolean;
    FsortCol: integer;
    FEditor: TtvEdit;
    FclSelected: TColor;
    FclTitleEnd: TColor;
    FclTitleBegin: TColor;
    FclBegin: TColor;
    FclFrame: TColor;
    FCloumns: TTreeColumns;
    FColumns: TTreeColumns;
    FHeadHeight: integer;
    FFlatHead: boolean;
    FCol: integer;
    FevenRow: boolean;
    FexPandIndex: TImageIndex;
    FcollapseIndex: TimageIndex;
    FAllowEdit: boolean;
    FCustomDrawImage: TCustomDrawImage;
    FonVerifyText: TonVerifyText;
    FCustomDrawText: TCustomDrawText;
    procedure doCompare(Sender: TObject; Node1, Node2: TTreeNode;
      Data: Integer; var Compare: Integer);
    procedure csDrawRow(Sender: TCustomTreeView; Node: TTreeNode;
      State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure WMNCPAINT(var Message: TWMNCPAINT); message WM_NCPAINT;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    procedure SetclSelected(const Value: TColor);
    procedure SetclTitleBegin(const Value: TColor);
    procedure SetclTitleEnd(const Value: TColor);
    procedure SetclBegin(const Value: TColor);
    procedure SetclFrame(const Value: TColor);
    procedure SetColumns(const Value: TTreeColumns);
    procedure SetCol(const Value: integer);
    procedure DrawCell(Acol: integer; Node: TColNode);
    procedure CreateEditor;
    function CompareStr(s1, s2: string): integer;
    function CompareInt(s1, s2: string): integer;
    function CompareFloat(s1, s2: string): integer;
    function ComparePercent(s1, s2: string): integer;
protected
    { Protected declarations }
    function CreateNode: TTreeNode; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
public
    { Public declarations }
    procedure invalidate; override;
    function HeadRect: TRect;
    function getTitleRect(index: integer): TRect;
    function CellRect(Acol: integer; Node: TcolNode; TextOnly: boolean = false): TRect;
    function CellText(Acol: integer; Node: TcolNode): string;
    procedure setCellText(Acol: integer; Node: TcolNode; Value: string);
    function mouseToCol(x, y: integer; Node: TcolNode): integer;
    function MouseToTitle(x, y: integer): integer;
    procedure showEditor(Acol: integer);
    procedure HideEditor;
    procedure canelEdit;
    procedure sort(TitleIndex: integer);
    constructor Create(Aowner: TComponent); override;
    destructor Destroy; override;
    property Col: integer read FCol write SetCol;
published
    { Published declarations }
    property clTitleBegin: TColor read FclTitleBegin write SetclTitleBegin;
    property clTitleEnd: TColor read FclTitleEnd write SetclTitleEnd;
    property clSelected: TColor read FclSelected write SetclSelected;
    property clBegin: TColor read FclBegin write SetclBegin;
    property clFrame: TColor read FclFrame write SetclFrame;
    property Columns: TTreeColumns read FColumns write SetColumns;
    property HeadHeight: integer read FHeadHeight write Fheadheight;
    property FlatHead: boolean Read FFlatHead write FFlatHead;
    property ExpandIndex: TImageIndex Read FexPandIndex write FexPandIndex;
    property collapseIndex: TimageIndex read FcollapseIndex write FcollapseIndex;
    property AllowEdit: boolean read FallowEdit write FAllowEdit;
    property CustomDrawImage: TCustomDrawImage read FCustomDrawImage write FCustomDrawImage;
    property CustomDrawText: TCustomDrawText read FCustomDrawText write FCustomDrawText;
    property onVerifyText: TonVerifyText read FonVerifyText write FonVerifyText;
end;

implementation

uses Commctrl, myfunctions, mycontrols;

{ Tsrlistview }
const
alignment: array[TAlignment] of integer = (DT_LEFT, DT_RIGHT, DT_CENTER);

constructor Tsrlistview.Create(Aowner: TComponent);
begin
inherited Create(AOwner);
FhdHandle:=0;
FHdNewProc := MakeObjectInstance(HeaderProc);
FhdOldProc := nil;
FTextoffSet:=3;
FclSelected:=clBlue;
FclTitleBegin:=clSilver;
FclTitleEnd:=clBtnFace;
FclBegin:=clBtnFace;
FclFrame:=clBlack;
bmp:=TbitMap.Create;
end;

destructor Tsrlistview.Destroy;
begin
DestroyHandle;
if FhdHandle <> 0 then
SetWindowLong(Fhdhandle, GWL_WNDPROC, LongInt(FHdOldProc));
FreeObjectInstance(FhdNewProc);
Fhdhandle := 0;
bmp.Free;
inherited Destroy;
end;

procedure Tsrlistview.Drawheader(Dc: HDc);
var
R : TRect;
i : integer;
ps: TPaintStruct;
cvs: TControlCanvas;
begin
if DC = 0 then DC := BeginPaint(FhdHandle, PS);
Cvs := TControlCanvas.Create;
try
    if not GetWindowRect(FhdHandle, R) then exit;
    Cvs.Handle := DC;
//    cvs.Brush.Color:=FclTitleBegin;
//    cvs.FillRect(R);
    with Cvs do
    begin
      for i := 0 to Header_GetItemCount(FhdHandle) - 1 do
      begin
        R := GetHeaderSectionRect(i);
        DrawHeaderSection(Cvs, Columns[i], i, False, false, R);
      end;
    end;
finally
    cvs.Free;
    if DC = 0 then EndPaint(FhdHandle, PS);
end;
end;

procedure Tsrlistview.DrawHeaderSection(Cnvs: TCanvas; Column: TListColumn;
index: integer; Active, Pressed: Boolean; R: TRect);
var
s: string;
RT: TRect;
function GetColumnCaption(index: integer): string;
var
    Col: TLVColumn;
begin
    Col.Mask := LVCF_TEXT;
    GetMem( Col.pszText, 255 );
    Col.cchTextMax := 255;
    try
      if ListView_GetColumn( Handle, Index, Col ) then
        Result := Col.pszText
      else
        Result := '';
    finally
      FreeMem( Col.pszText );
    end;
end;

begin
bmp.Width:=RectWidth(R);
bmp.Height:=Rectheight(R);
RT:=Rect(0, 0, bmp.Width, bmp.Height);
FillTubeGradientRect(bmp.Canvas.Handle, RT, FclTitleBegin, FclTitleEnd, false);
bmp.Canvas.Pen.Color:=FclTitleEnd;
if R.Left>0 then
begin
    bmp.Canvas.MoveTo(0, 0);
    bmp.Canvas.LineTo(0, bmp.Height);
end;
if index=Columns.Count-1 then
begin
    bmp.Canvas.MoveTo(bmp.Width, 0);
    bmp.Canvas.LineTo(bmp.Width, bmp.Height);
end;
if Column.ID mod 2=0 then
    BlendBmp(Bmp, FclBegin, 24)
else
    BlendBmp(Bmp, clWhite, 24);
s:=GetColumnCaption(index);
inflateRect(RT, -FTextoffSet, 0);
bmp.Canvas.Brush.Style:=bsClear;
DrawText(bmp.Canvas.Handle, pchar(s), length(s), RT,
    DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS);
cnvs.Draw(R.Left, R.Top, bmp);
end;

function Tsrlistview.GetHeaderSectionRect(Index: Integer): TRect;
var
R: TRect;
begin
Header_GETITEMRECT(Fhdhandle, Index, @R);
Result := R;
end;

procedure Tsrlistview.HeaderProc(var Message: TMessage);
var
R: TRect;
clBkgn: TColor;
begin
case Message.Msg of
    WM_PAINT      : DrawHeader(TWMPAINT(MESSAGE).DC);
    WM_ERASEBKGND :
    begin
      windows.GetClientRect(Fhdhandle, R);
      clBkgn:=getAlphaColor(FclTitleEnd, FclTitleBegin, 160);
      fillRect(TWMPAINT(MESSAGE).DC, R, createSolidbrush(clBkgn));
      Message.Result := 1;
    end;
    else
    with Message do
      Result := CallWindowProc(FHdOldProc, FhdHandle, Msg, WParam, LParam);
end;
end;

procedure Tsrlistview.invalidate;
begin
inherited invalidate;
if FhdHandle<>0 then InvalidateRect(FhdHandle, nil, True);

end;

procedure Tsrlistview.SetclBegin(const Value: TColor);
begin
FclBegin := Value;
invalidate;
end;

procedure Tsrlistview.SetclFrame(const Value: TColor);
begin
FclFrame := Value;
invalidate;
end;

procedure Tsrlistview.SetclSelected(const Value: TColor);
begin
FclSelected := Value;
invalidate;
end;

procedure Tsrlistview.SetclTitleBegin(const Value: TColor);
begin
FclTitleBegin := Value;
invalidate;
end;

procedure Tsrlistview.SetclTitleEnd(const Value: TColor);
begin
FclTitleEnd := Value;
invalidate;
end;

procedure Tsrlistview.SetTextoffSet(const Value: integer);
begin
FTextoffSet := Value;
invalidate;
end;

procedure Tsrlistview.WMNCPAINT(var Message: TWMNCPAINT);
const
InnerStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENINNER, BDR_RAISEDINNER, 0);
OuterStyles: array[TBevelCut] of Integer = (0, BDR_SUNKENOUTER, BDR_RAISEDOUTER, 0);
EdgeStyles: array[TBevelKind] of Integer = (0, 0, BF_SOFT, BF_FLAT);
Ctl3DStyles: array[Boolean] of Integer = (BF_MONO, 0);
var
DC: Hdc;
SaveRW, RW, Rc: TRect;
EdgeSize: integer;
WinStyle: Longint;
begin
inherited;
DC := GetWindowDC(Handle);
try
    Rc:=Rect(0, 0, width, height);
    Windows.DrawEdge(DC, Rc, BDR_RAISEDOUTER, BF_RECT);
    FrameRect(Dc, Rc, createSolidBrush(clFrame));
Finally
    ReleaseDc(handle, DC);
end;
end;

procedure Tsrlistview.WMParentNotify(var Message: TWMParentNotify);
begin
inherited;
with Message do
    if (Event = WM_CREATE) and (FhdHandle = 0) then
    begin
      FhdHandle := ChildWnd;
      FhdOldProc := Pointer(GetWindowLong(FhdHandle, GWL_WNDPROC));
      SetWindowLong(FhdHandle, GWL_WNDPROC, LongInt(FhdNewProc));
    end;
end;

{ TTreeColumn }

procedure TTreeColumn.Assign(Source: TPersistent);
begin
if Source is TTreeColumn then
begin
    if Assigned(Collection) then Collection.BeginUpdate;
    try
      Colwidth:=TTreeColumn(Source).Colwidth;
      TiTle:=TTreeColumn(Source).TiTle;
      Color:=TTreeColumn(Source).Color;
      Transparent:=TTreeColumn(Source).Transparent;
    finally
      if Assigned(Collection) then Collection.EndUpdate;
    end;
end
else
    inherited Assign(Source);
end;

----接下页

阅读┊ 收藏 ┊ 喜欢 ▼ ┊打印┊举报/Report

前一篇：树形表读入TreeView 最快最简单的方法（原创）

后一篇：TreeView Grid 代码（由于博文不能太长，分两页）

新浪BLOG意见反馈留言板　欢迎批评指正

最新修改版 树形表格（TreeView Grid）控件代码 原创