Delphi ListView 自绘图形

显示行号 | 选择喜欢的代码风格

自绘 TListView 带进度条的 Item，TListView 的 Item 条一般是由系统自绘，但 VeryCD 电驴客户端就实现了自绘，看起来很漂亮，我们用 Delphi 也可以实现！

引用 CommCtrl Unit 单元：

Delphi CommCtrl Unit 单元，是 TListView 底层控制单元：

Delphi 自绘 ListView

uses
 CommCtrl;
 
// 画状态条
procedure DrawSubItem(LV: TListView; Item: TListItem; SubItem: Integer;
 Prosition: Single; Max, Style: Integer; IsShowProgress: Boolean;
 DrawColor: TColor = $00005B00;
 FrameColor: TColor = $00002F00);
  // 获取SubItem的区域
 function GetItemRect(LV_Handle, iItem, iSubItem: Integer): TRect;
 var
    Rect: TRect;
 begin
    ListView_GetSubItemRect(LV_Handle, iItem, iSubItem, LVIR_LABEL, @Rect);
    Result := Rect;
 end;

var
 PaintRect, r: TRect;
 i, iWidth, x, y: integer;
 S: string;
begin
 try
 
    with lv do
    begin
      // LockPaint := True;
      PaintRect := GetItemRect(LV.Handle, Item.Index, SubItem);
      r := PaintRect;
      // if SubItem = DrawSubItem then
      Begin // 这一段是算出百分比
        if Prosition >= Max then
          Prosition := 100
        else
          if Prosition <= 0 then
            Prosition := 0
          else
            Prosition := Round((Prosition / Max) * 100);
 
        if (Prosition = 0) and (not IsShowProgress) then
        begin
          // 如果是百分比是0，就直接显示空白
          Canvas.FillRect(r);
 
        end 
        else 
        begin

          // 先直充背景色
          Canvas.FillRect(r);
          Canvas.Brush.Color := Color;

          // Canvas.FillRect(r);
 
          // 画一个外框
          InflateRect(r, -2, -2);
          Canvas.Brush.Color := FrameColor; // $00002F00;
          Canvas.FrameRect(R);
 
          Canvas.Brush.Color := Color;
          InflateRect(r, -1, -1);
          // Canvas.FillRect(r);
 
          InflateRect(r, -1, -1);
          // 根据百分比算出要画的进度条内容宽度
          iWidth := R.Right - Round((R.Right - r.Left) * ((100 - Prosition) /
            100));
          case Style of
            0: //进度条类型，实心填充
              begin
                Canvas.Brush.Color := DrawColor;
                r.Right := iWidth;
                Canvas.FillRect(r);
              end;
            1: //进度条类型，竖线填充
              begin
                i := r.Left;
                while i < iWidth do
                begin
                  Canvas.Pen.Color := Color;
                  Canvas.MoveTo(i, r.Top);
                  Canvas.Pen.Color := DrawColor;
                  canvas.LineTo(i, r.Bottom);
                  Inc(i, 3);
                end;
              end;
          end;

          // 画好了进度条后，现在要做的就是显示进度数字了
          Canvas.Brush.Style := bsClear;
          if Prosition = Round(Prosition) then
            S := Format('%d%%', [Round(Prosition)])
          else
            S := FormatFloat('#0.0', Prosition);
 
          with PaintRect do
          begin
            x := Left + (Right - Left + 1 - Canvas.TextWidth(S)) div 2;
            y := Top + (Bottom - Top + 1 - Canvas.TextHeight(S)) div 2;
          end;
          SetBkMode(Canvas.handle, TRANSPARENT);
          Canvas.TextRect(PaintRect, x, y, S);
 
        end;

        //进度条全部画完，把颜色设置成默认色了
        Canvas.Brush.Color := Color;
 
      end
    end;

 except

 end;

end;

上面是画进度条的，现在要给 TlistView 处理 Item 重绘的消息，事件是 Delphi 的 OnCustomDrawItem，需要说明的是，如果想要随心所欲的自画 Item，那么就要全部自己来完成，不再需要系统来处理：

procedure TForm1.ListView1CustomDrawItem(
 Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
 var DefaultDraw: Boolean);
var
 BoundRect, Rect: TRect;
 i: integer;
 TextFormat: Word;
 LV: TListView;
 
 // 这个子过程是用来画CheckBox和ImageList的
 procedure Draw_CheckBox_ImageList(r: TRect; aCanvas: TCanvas; Checked: Boolean);
 var
    R1: TRect;
    i: integer;
 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;
    // 开始画图标
    i := PDownLoadListItem(Item.Data)^.StatsImageIndex;
    if i > -1 then
    begin
    // 获取图标的RECT
      if Boolean(ListView_GetSubItemRect(sender.Handle, item.Index, 0, LVIR_ICON, @R1)) then
      begin
        ImageList_Stats.Draw(LV.Canvas, R1.Left, R1.Top, i);
        if item.ImageIndex > -1 then
          LV.SmallImages.Draw(LV.Canvas, R1.Right + 2, R1.Top, item.ImageIndex);
      end;
 
    end;
 end;
begin
 LV := ListView1;
 BoundRect := Item.DisplayRect(drBounds);
 InflateRect(BoundRect, -1, 0);
 
 // 这个地方你可以根据自己的要求设置成想要的颜色，实现突出显示
 LV.Canvas.Font.Color := clBtnText;
 
 // 查看是否是被选中
 if Item.Selected then
 begin
    if cdsFocused in State then
    begin
      LV.Canvas.Brush.Color := $00ECCCB9; // clHighlight;
    end
    else
    begin
      LV.Canvas.Brush.Color := $00F8ECE5; // clSilver;
    end;
 end
 else 
 begin
    if (Item.Index mod 2) = 0 then
      LV.Canvas.Brush.Color := clWhite
    else
      LV.Canvas.Brush.Color := $00F2F2F2;
 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，0就是表示Caption，这不是Subitems[0]
        begin
          // 先画选择框与图标
          Draw_CheckBox_ImageList(BoundRect, LV.Canvas, Item.Checked);
          // 再画Caption的文字
          InflateRect(Rect, -(5 + ImageList_Stats.Width), 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 = 2 then // 显示状态条
          begin
            // 开始处理进度条了，这个示例是第3栏显示进度条，可以自己随便定义
            DrawSubItem(TListView(Sender),
              item,
              i,
              StrToFloatDef(Item.SubItems[i - 1], 0),
              100,
              0,
              True,
              // 这里用了一个Lable来选颜色，你自己可以使用一个变量来代替
              LableProgressColor.Color, // 进度条外框颜色
              LableProgressColor.Color  // 进度条颜色
);
 
          end
          else
            // 画SubItem的文字
            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); //
 end;
 
 DefaultDraw := False; // 不让系统画了
 
 with Sender.Canvas do
    if Assigned(Font.OnChange) then Font.OnChange(Font); 
end;

function ReDrawItem(HwndLV: HWND; ItemIndex: integer): boolean;
begin
  Result := ListView_RedrawItems(HwndLV, ItemIndex, ItemIndex);
end;
  // 使用：
  item:=ListView1.Selected;
  item.subitems[1]:='30';//设置为30%
  // 然后刷新这个item
  ReDrawItem(ListView1.handle,Item.index);

Delphi 自绘 ListView 扩展阅读：

发表评论

Delphi 实战技巧

Delphi 动态创建 Component 组件

Delphi 创建 WebBrowser 默认为 IE11 模式

Delphi 或 C# 实现 WebBrowser 进行 JS 注入

Delphi 利用 IdHTTP 进行多线程下载

Delphi ListView 自绘图形