已经有最新版本，请查看

http://blog.sina.com.cn/s/blog_426dbc190100lbxy.html

以下是源代码

//  冯思锐于2009年9月

  TcolTreeView = class;

  TTreeColumn = class(TCollectionItem)
  private
    FColWidth: integer;
    FTitle: string;
    FColor: TColor;
    FTransParent: boolean;
    FAlign: TAlignment;
    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 Transparent: boolean read FTransParent write setTransparent;
  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;
  protected
    //
  public
    constructor Create(AOwner: TTreeNodes);
    destructor Destroy; override;
    property isBottomLevel: Boolean read FisBottomLevel write FisBottomLevel;
    property Texts: TStrings read FTexts write FTexts;
  end;

  TcolTreeView = class(TTreeView)
  private
    { Private declarations }
    FTextoffSet: integer;
    FclSelected: TColor;
    FclTitleEnd: TColor;
    FclTitleBegin: TColor;
    FclBegin: TColor;
    FclFrame: TColor;
    FCloumns: TTreeColumns;
    FColumns: TTreeColumns;
    FHeadHeight: integer;
    FFlatHead: boolean;
    procedure WMNCPAINT(var Message: TWMNCPAINT); message WM_NCPAINT;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    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);
    procedure SetColumns(const Value: TTreeColumns);
  protected
    { Protected declarations }
    function CreateNode: TTreeNode; override;
//    function CreateNodes: TTreeNodes; override;
  public
    { Public declarations }
    procedure invalidate; override;
    function HeadRect: TRect;
    function getTitleRect(index: integer): TRect;
    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;
    property Columns: TTreeColumns read FColumns write SetColumns;
    property HeadHeight: integer read FHeadHeight write Fheadheight;
    property FlatHead: boolean Read FFlatHead write FFlatHead;

  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;

constructor TTreeColumn.Create(Collection: TCollection);
begin
  inherited create(Collection);
  FColWidth:=60;
  FColor:=clWhite;
  FTransParent:=True;
end;

function TTreeColumn.GetDisplayName: string;
begin
  result:='第 '+inttoStr(index+1)+' 列  '+FTitle;
end;

procedure TTreeColumn.SetColor(const Value: TColor);
begin
  FColor:=value;
end;

procedure TTreeColumn.SetcolWidth(const Value: integer);
begin
  FColWidth:=value;
end;

procedure TTreeColumn.SetTitle(const Value: string);
begin
  FTitle:=value;
end;

procedure TTreeColumn.setTransparent(const Value: boolean);
begin
  FTransParent:=value;
end;

{ TcolTreeView }

constructor TcolTreeView.Create(Aowner: TComponent);
begin
  inherited create(Aowner);
  FTextoffSet:=3;
  FclSelected:=clBlue;
  FclTitleBegin:=clwhite;
  FclTitleBegin:=clGray;
  FclFrame:=clBlack;
  FHeadHeight:=22;
  FColumns:=TTreeColumns.Create(self, TTreeColumn);
end;

function TcolTreeView.CreateNode: TTreeNode;
begin
  Result := TcolNode.Create(Items);
end;
{
function TcolTreeView.CreateNodes: TTreeNodes;
begin
  //Result := TTreeNodes.Create(Self);
end;
}
procedure TcolTreeView.SetclBegin(const Value: TColor);
begin

end;

procedure TcolTreeView.SetclFrame(const Value: TColor);
begin
  FclFrame:=value;
end;

procedure TcolTreeView.SetColumns(const Value: TTreeColumns);
begin
  TCollection(Columns).Assign(value);
end;

procedure TcolTreeView.SetclSelected(const Value: TColor);
begin
  FclSelected:=value;
//  InvalidateRect(Handle, nil, True);
end;

procedure TcolTreeView.SetclTitleBegin(const Value: TColor);
begin
  FclTitleBegin:=value;
  invalidate;
 // self.Update;
 // updateWindow(handle);
 // Invalidate;
end;

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

procedure TcolTreeView.SetTextoffSet(const Value: integer);
begin
  FTextoffSet:=value;
end;

procedure TcolTreeView.WMNCPAINT(var Message: TWMNCPAINT);
var
  DC: HDC;
  cs: TControlCanvas;
  R, Rb, Hr: TRect;
  bmp: TbitMap;
  i: integer;
  s: string;
begin
  { Get window DC that is clipped to the non-client area }
    DC := GetWindowDC(Handle);
    cs:=TcontrolCanvas.Create;
    cs.Handle:=Dc;
    bmp:=Tbitmap.Create;
    try
      cs.Brush.Color:=FclTitleBegin;
      Hr:=HeadRect;
      cs.FillRect(Hr);
      for i:=0 to FColumns.Count-1 do
      begin
        R:=getTitleRect(i);
        bmp.Width:=R.Right-R.Left;
        bmp.Height:=R.Bottom-R.Top;
        Rb:=Rect(0, 0, bmp.Width, bmp.Height);
        if FFlathead then
        begin
          bmp.Canvas.Brush.Color:=FclTitleBegin;
          bmp.Canvas.FillRect(rb);
        end else
          FillTubeGradientRect(bmp.Canvas.Handle, Rb, FclTitleBegin, FclTitleEnd, false);
        if Columns.Items[i].Color<>clWhite then BlendBmp(Bmp, Columns.Items[i].color, 32);
        s:=Columns.Items[i].TiTle;
        bmp.Canvas.Brush.Style:=bsClear;
        inc(Rb.Left, FTextoffSet);
        DrawText(bmp.Canvas.Handle, pchar(s), length(s), Rb, DT_VCENTER OR DT_SINGLELINE);
        cs.Draw(R.Left, R.Top, bmp);
      end;
      cs.Pen.Color:=FclFrame;
      lineRect(Hr, cs, [shsBottom]);
    finally
      ReleaseDC(Handle, DC);
      cs.Free;
      bmp.Free;
    end;
end;

destructor TcolTreeView.Destroy;
begin
  FColumns.Free;
  inherited;
end;

procedure TcolTreeView.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  inc(Message.CalcSize_Params^.rgrc[0].Top, FHeadHeight);

end;

function TcolTreeView.HeadRect: TRect;
var
  RW: Trect;
begin
  GetWindowRect(Handle, RW);
  Result:=Rw;
  Result.Bottom:=Result.Top + FHeadHeight;
  offsetRect(Result, -Rw.Left, -Rw.Top);
end;

function TcolTreeView.getTitleRect(index: integer): TRect;
  function pleft(pid: integer): integer;
  var
    i: integer;
  begin
    Result:=0;
    for i:=0 to pid do Result:=Result+ Columns.Items[i].Colwidth;
  end;
var
  R: Trect;
begin
  R:=HeadRect;
  result:=R;
  if index = 0 then
    Result:=Rect(R.Left, R.Top, R.Left+Columns.Items[0].FColWidth, R.Bottom)
  else
    Result:=Rect(R.Left+pleft(index-1), R.Top, R.Left+pleft(index), R.Bottom);
end;

procedure TcolTreeView.invalidate;
begin
  inherited;
  sendmessage(handle, WM_NCPAINT, 0, 0);
end;

{ TcolNode }

constructor TcolNode.Create(AOwner: TTreeNodes);
begin
  inherited create(AOwner);
  FTexts:=TStringList.Create;
end;

destructor TcolNode.Destroy;
begin
  FTexts.Free;
  inherited;
end;

{ TTreeColumns }

constructor TTreeColumns.Create(TreeView: TcolTreeView; ColumnClass: TTreeColumnClass);
begin
  inherited Create(ColumnClass);
  Add;
  FTreeView:=TreeView;
end;

function TTreeColumns.GetColumn(Index: Integer): TTreeColumn;
begin
  Result :=TTreeColumn(inherited Items[Index]);
end;

procedure TTreeColumns.SetColumn(Index: Integer; const Value: TTreeColumn);
begin
  Items[Index].Assign(Value);
end;

procedure TTreeColumns.Update(Item: TCollectionItem);
begin
  inherited;
  if assigned(FTreeView) then FTreeView.Invalidate;
end;

end.