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;