TListView的ListItem完全自绘

因工作需要完全自绘ListItem，模仿成电驴的样式，查找了N久相关的资料，发现很少有这方面的，最后用ListView_GetSubItemRect关键词在一个小日本的网站上找到一点相关的代码，修改后解决该问题。
至于是否存在BUG，偶用了几天还木有发现，如果有什么问题，请大家回复一下，谢谢
注意：代码只支持ViewStyle=vsReport

效果图如下：




uses
CommCtrl;
procedure LVDrawItem(Sender: TListView; Item: TListItem; State: TCustomDrawState;
var DefaultDraw: Boolean);
var
BoundRect, Rect: TRect;
i: integer;
TextFormat: Word;
LV: TListView;
procedure Draw_CheckBox_ImageList(r: TRect; aCanvas: TCanvas; Checked: Boolean);
var
R1: TRect;
begin
if Sender.Checkboxes then
begin
aCanvas.Pen.Color := clBlack;
aCanvas.Pen.Width := 2;
//画CheckBox外框，也可以修改成你想要的图标显示
aCanvas.Rectangle(r.Left + 2, r.Top + 2, r.Left + 14, r.Bottom - 2);
if Checked then
begin //画CheckBox的勾
aCanvas.MoveTo(r.Left + 4, r.Top + 6);
aCanvas.LineTo(r.Left + 6, r.Top + 11);
aCanvas.LineTo(r.Left + 11, r.Top + 5);
end;
aCanvas.Pen.Width := 1;
end;
//开始画图标
if (Item.ImageIndex > -1)and(LV.SmallImages <>nil) then
begin
//获取图标的RECT
if Boolean(ListView_GetSubItemRect(sender.Handle, item.Index, 0, LVIR_ICON, @R1)) then
begin
LV.SmallImages.Draw(LV.Canvas, R1.Left, R1.Top, Item.ImageIndex);
end;
end;
end;
begin
LV := Sender;
BoundRect := Item.DisplayRect(drBounds);
InflateRect(BoundRect, -1, 0);
if Item.Selected then
begin
if cdsFocused in State then
begin
LV.Canvas.Brush.Color := $00ECCCB9; // //clHighlight;
// LV.Canvas.Font.Color := clBtnText; //clHighlightText;
end
else
begin
LV.Canvas.Brush.Color := $00F8ECE5; //clSilver;
// LV.Canvas.Font.Color := clBtnText;
end;
end
else
begin
// LV.Canvas.Brush.Color := clWindow;
// LV.Canvas.Font.Color := clWindowText;
end;

LV.Canvas.FillRect(BoundRect); //初始化背景

for i := 0 to LV.Columns.Count - 1 do
begin
//获取SubItem的Rect
ListView_GetSubItemRect(LV.Handle, Item.Index, i, LVIR_LABEL, @Rect);
case LV.Columns[i].Alignment of
taLeftJustify:
TextFormat := 0;
taRightJustify:
TextFormat := DT_RIGHT;
taCenter:
TextFormat := DT_CENTER;
end;
case i of
0: //画Caption
begin
Draw_CheckBox_ImageList(BoundRect, LV.Canvas, Item.Checked);

InflateRect(Rect, -3, 0); //向后移3个像素,避免被后面画线框时覆盖
DrawText(
LV.Canvas.Handle,
PCHAR(Item.Caption),
Length(Item.Caption),
Rect,
DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or TextFormat);
end;
1..MaxInt: //画Subitems[i]
begin
if i - 1 <= Item.SubItems.Count - 1 then
DrawText(
LV.Canvas.Handle,
PCHAR(Item.SubItems[i - 1]),
Length(Item.SubItems[i - 1]),
Rect,
DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or TextFormat);
end;
end;

end;

LV.Canvas.Brush.Color := clWhite;

if Item.Selected then //画选中条外框
begin
if cdsFocused in State then
LV.Canvas.Brush.Color := $00DAA07A // $00E2B598; //clHighlight;
else
LV.Canvas.Brush.Color := $00E2B598; //$00DAA07A // clHighlight;
LV.Canvas.FrameRect(BoundRect); // DrawFocusRect(Item.DisplayRect(drBounds)); //
end;

DefaultDraw := False; //True;//cdsSelected in State;

with Sender.Canvas do
if Assigned(Font.OnChange) then Font.OnChange(Font);

end;

//使用技巧

procedure TFormDownLoad.LV_ResourceListCustomDrawItem(
Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
var DefaultDraw: Boolean);
begin
if (Item.Index mod 2) = 0 then
Sender.Canvas.Brush.Color := clWhite
else
Sender.Canvas.Brush.Color := $00EBEBEB;

LVDrawItem(LV_ResourceList, Item, State, DefaultDraw);

end;

Trackback: http://tb.blog.csdn.net/TrackBack.aspx?PostId=603357