ListView 实现进度条显示

代码参考互联网，本人在Win10 + Delphi 10.3.2 社区版中测试通过，现将测试通过的代码分享如下：

<

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
  System.ImageList, Vcl.ImgList;

type
  TForm1 = class(TForm)
    lv1: TListView;
    btn1: TButton;
    procedure lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem;
      State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure btn1Click(Sender: TObject);
  private
    procedure DrawSubItem(ALV: TListView; AItem: TListItem; ASubItem: Integer;
                          APosition: Single; AMax, AStyle: Integer; AIsShowProgress: Boolean;
                          ADrawColor: TColor = $00005B00; AFrameColor: TColor = $00002F00);
    function ReDrawItem(AHwndLV: HWND; AItemIndex: integer): boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses
  Winapi.CommCtrl;
{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
var
  NewColumn: TListColumn;
  NewItem: TListItem;
  i: Integer;
begin
  lv1.Items.Clear;
  lv1.Columns.Clear;
  NewColumn := lv1.Columns.Add; NewColumn.Caption := '名称';
  NewColumn := lv1.Columns.Add; NewColumn.Caption := '进度';
  NewColumn := lv1.Columns.Add; NewColumn.Caption := '进度条';

  for I := 0 to 10 do
  begin
    NewItem := lv1.Items.Add;
    NewItem.Caption := IntToStr(i);
    NewItem.SubItems.Add(IntToStr(i * 10));
    NewItem.SubItems.Add(IntToStr(i * 10));
  end;
end;

procedure TForm1.DrawSubItem(ALV: TListView; AItem: TListItem; ASubItem: Integer;
                             APosition: Single; AMax, AStyle: Integer; AIsShowProgress: Boolean;
                             ADrawColor: TColor = $00005B00; AFrameColor: TColor = $00002F00);
var
 PaintRect, r: TRect;
 i, iWidth, x, y: integer;
 S: string;
 function GetItemRect(LV_Handle, iItem, iSubItem: Integer): TRect;
 var
   Rect: TRect;
 begin
   ListView_GetSubItemRect(LV_Handle, iItem, iSubItem, LVIR_LABEL, @Rect);
   Result := Rect;
 end;
begin
  with ALV do
  begin
    PaintRect := GetItemRect(ALV.Handle, AItem.Index, ASubItem);
    r := PaintRect;
    //这一段是算出百分比
    if APosition >= AMax then
      APosition := 100
    else
      if APosition <= 0 then
        APosition := 0
      else
        APosition := Round((APosition / AMax) * 100);

    if (APosition = 0) and (not AIsShowProgress) then
    begin
      //如果是百分比是0，就直接显示空白
      Canvas.FillRect(r);
    end else begin
      //先直充背景色
      Canvas.FillRect(r);
      Canvas.Brush.Color := Color;
      //画一个外框
      InflateRect(r, -2, -2);
      Canvas.Brush.Color := AFrameColor; //$00002F00;
      Canvas.FrameRect(R);
      Canvas.Brush.Color := Color;
      InflateRect(r, -1, -1);
      InflateRect(r, -1, -1);
      //根据百分比算出要画的进度条内容宽度
      iWidth := R.Right - Round((R.Right - r.Left) * ((100 - APosition) / 100));
      case AStyle of
        0: //进度条类型，实心填充
          begin
            Canvas.Brush.Color := ADrawColor;
            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 := ADrawColor;
              canvas.LineTo(i, r.Bottom);
              Inc(i, 3);
            end;
          end;
      end;
      //画好了进度条后，现在要做的就是显示进度数字了
      Canvas.Brush.Style := bsClear;
      if APosition = Round(APosition) then
        S := Format('%d%%', [Round(APosition)])
      else
        S := FormatFloat('#0.0', APosition);

      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; // end of if (Prosition = 0) and (not IsShowProgress) then
     //进度条全部画完，把颜色设置成默认色了
    Canvas.Brush.Color := Color;

  end; // end of with LV do
end;

procedure TForm1.lv1CustomDrawItem(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 //画CheckBox的钩
//      begin
//        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 := 2; //ImageIndex的值，可以任意
//    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 := TListView(Sender);
  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 := DT_LEFT;
      taRightJustify:
        TextFormat := DT_RIGHT;
      taCenter:
        TextFormat := DT_CENTER;
    else
      TextFormat := DT_CENTER;
    end;
    case i of
      0: //画Caption,0表示Caption，不是Subitem
        begin
          //先画选择框和图标
          //Draw_CheckBox_ImageList(BoundRect, LV.Canvas, Item.Checked);
          InflateRect(Rect, -(5 + 0), 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: //画SubItem[i]
        begin
          if (i - 1) = 1 then //显示状态条，本示例是第三栏显示，
          begin
            DrawSubItem(LV, Item, i, StrToFloatDef(Item.SubItems[i - 1], 0), 100, 0, True, clMedGray);
          end
          else
          begin
            //画SubItem的文字
            InflateRect(Rect, -2, -2);

            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; //end case
  end; //end for
  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 TForm1.ReDrawItem(AHwndLV: HWND; AItemIndex: integer): boolean;
begin
  Result := ListView_RedrawItems(AHwndLV, AItemIndex, AItemIndex);
end;

end.