ownerDraw ListView 的标题

//By 冯思锐
unit srListview;
interface
uses
   SysUtils, windows, Classes, Controls, ComCtrls, Types, messages, Graphics;
type
   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;
procedure Register;
implementation
uses Commctrl, myfunctions;
procedure Register;
begin
   RegisterComponents('rui', [Tsrlistview]);
end;
{ Tsrlistview }
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, 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;
end.