//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.
ownerDraw ListView 的标题
最新推荐文章于 2019-07-17 22:21:17 发布