ListView 实现进度条显示

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

  1 unit Unit1;
  2 
  3 interface
  4 
  5 uses
  6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
  8   System.ImageList, Vcl.ImgList;
  9 
 10 type
 11   TForm1 = class(TForm)
 12     lv1: TListView;
 13     btn1: TButton;
 14     procedure lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem;
 15       State: TCustomDrawState; var DefaultDraw: Boolean);
 16     procedure btn1Click(Sender: TObject);
 17   private
 18     procedure DrawSubItem(ALV: TListView; AItem: TListItem; ASubItem: Integer;
 19                           APosition: Single; AMax, AStyle: Integer; AIsShowProgress: Boolean;
 20                           ADrawColor: TColor = $00005B00; AFrameColor: TColor = $00002F00);
 21     function ReDrawItem(AHwndLV: HWND; AItemIndex: integer): boolean;
 22   public
 23     { Public declarations }
 24   end;
 25 
 26 var
 27   Form1: TForm1;
 28 
 29 implementation
 30 uses
 31   Winapi.CommCtrl;
 32 {$R *.dfm}
 33 
 34 procedure TForm1.btn1Click(Sender: TObject);
 35 var
 36   NewColumn: TListColumn;
 37   NewItem: TListItem;
 38   i: Integer;
 39 begin
 40   lv1.Items.Clear;
 41   lv1.Columns.Clear;
 42   NewColumn := lv1.Columns.Add; NewColumn.Caption := '名称';
 43   NewColumn := lv1.Columns.Add; NewColumn.Caption := '进度';
 44   NewColumn := lv1.Columns.Add; NewColumn.Caption := '进度条';
 45 
 46   for I := 0 to 10 do
 47   begin
 48     NewItem := lv1.Items.Add;
 49     NewItem.Caption := IntToStr(i);
 50     NewItem.SubItems.Add(IntToStr(i * 10));
 51     NewItem.SubItems.Add(IntToStr(i * 10));
 52   end;
 53 end;
 54 
 55 procedure TForm1.DrawSubItem(ALV: TListView; AItem: TListItem; ASubItem: Integer;
 56                              APosition: Single; AMax, AStyle: Integer; AIsShowProgress: Boolean;
 57                              ADrawColor: TColor = $00005B00; AFrameColor: TColor = $00002F00);
 58 var
 59  PaintRect, r: TRect;
 60  i, iWidth, x, y: integer;
 61  S: string;
 62  function GetItemRect(LV_Handle, iItem, iSubItem: Integer): TRect;
 63  var
 64    Rect: TRect;
 65  begin
 66    ListView_GetSubItemRect(LV_Handle, iItem, iSubItem, LVIR_LABEL, @Rect);
 67    Result := Rect;
 68  end;
 69 begin
 70   with ALV do
 71   begin
 72     PaintRect := GetItemRect(ALV.Handle, AItem.Index, ASubItem);
 73     r := PaintRect;
 74     //这一段是算出百分比
 75     if APosition >= AMax then
 76       APosition := 100
 77     else
 78       if APosition <= 0 then
 79         APosition := 0
 80       else
 81         APosition := Round((APosition / AMax) * 100);
 82 
 83     if (APosition = 0) and (not AIsShowProgress) then
 84     begin
 85       //如果是百分比是0，就直接显示空白
 86       Canvas.FillRect(r);
 87     end else begin
 88       //先直充背景色
 89       Canvas.FillRect(r);
 90       Canvas.Brush.Color := Color;
 91       //画一个外框
 92       InflateRect(r, -2, -2);
 93       Canvas.Brush.Color := AFrameColor; //$00002F00;
 94       Canvas.FrameRect(R);
 95       Canvas.Brush.Color := Color;
 96       InflateRect(r, -1, -1);
 97       InflateRect(r, -1, -1);
 98       //根据百分比算出要画的进度条内容宽度
 99       iWidth := R.Right - Round((R.Right - r.Left) * ((100 - APosition) / 100));
100       case AStyle of
101         0: //进度条类型，实心填充
102           begin
103             Canvas.Brush.Color := ADrawColor;
104             r.Right := iWidth;
105             Canvas.FillRect(r);
106           end;
107         1: //进度条类型，竖线填充
108           begin
109             i := r.Left;
110             while i < iWidth do
111             begin
112               Canvas.Pen.Color := Color;
113               Canvas.MoveTo(i, r.Top);
114               Canvas.Pen.Color := ADrawColor;
115               canvas.LineTo(i, r.Bottom);
116               Inc(i, 3);
117             end;
118           end;
119       end;
120       //画好了进度条后，现在要做的就是显示进度数字了
121       Canvas.Brush.Style := bsClear;
122       if APosition = Round(APosition) then
123         S := Format('%d%%', [Round(APosition)])
124       else
125         S := FormatFloat('#0.0', APosition);
126 
127       with PaintRect do
128       begin
129         x := Left + (Right - Left + 1 - Canvas.TextWidth(S)) div 2;
130         y := Top + (Bottom - Top + 1 - Canvas.TextHeight(S)) div 2;
131       end;
132       SetBkMode(Canvas.handle, TRANSPARENT);
133 
134       Canvas.TextRect(PaintRect, x, y, S);
135     end; // end of if (Prosition = 0) and (not IsShowProgress) then
136      //进度条全部画完，把颜色设置成默认色了
137     Canvas.Brush.Color := Color;
138 
139   end; // end of with LV do
140 end;
141 
142 procedure TForm1.lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem;
143   State: TCustomDrawState; var DefaultDraw: Boolean);
144 var
145   BoundRect, Rect: TRect;
146   i: integer;
147   TextFormat: Word;
148   LV: TListView;
149 begin
150   LV := TListView(Sender);
151   BoundRect := Item.DisplayRect(drBounds);
152   InflateRect(BoundRect, -1, 0);
153   //这个地方你可以根据自己的要求设置成想要的颜色，实现突出显示
154   LV.Canvas.Font.Color := clBtnText;
155   //查看是否被选中
156   if Item.Selected then
157   begin
158     if cdsFocused in State then
159     begin
160       LV.Canvas.Brush.Color := $00ECCCB9; // //clHighlight;
161     end
162     else
163     begin
164       LV.Canvas.Brush.Color := $00F8ECE5; //clSilver;
165     end;
166   end
167   else
168   begin
169     if (Item.Index mod 2) = 0 then
170       LV.Canvas.Brush.Color := clWhite
171     else
172       LV.Canvas.Brush.Color := $00F2F2F2;
173   end;
174 
175   LV.Canvas.FillRect(BoundRect); // 初始化背景
176   for i := 0 to LV.Columns.Count - 1 do
177   begin
178    //获取SubItem的Rect
179     ListView_GetSubItemRect(LV.Handle, Item.Index, i, LVIR_LABEL, @Rect);
180     case LV.Columns[i].Alignment of
181       taLeftJustify:
182         TextFormat := DT_LEFT;
183       taRightJustify:
184         TextFormat := DT_RIGHT;
185       taCenter:
186         TextFormat := DT_CENTER;
187     else
188       TextFormat := DT_CENTER;
189     end;
190     case i of
191       0: //画Caption,0表示Caption，不是Subitem
192         begin
193           InflateRect(Rect, -(5 + 0), 0); //向后移3个像素,避免被后面画线框时覆盖
194           DrawText(LV.Canvas.Handle,
195                    PCHAR(Item.Caption),
196                    Length(Item.Caption),
197                    Rect,
198                    DT_VCENTER or DT_SINGLELINE or DT_END_ELLIPSIS or TextFormat);
199 
200         end;
201       1..MaxInt: //画SubItem[i]
202         begin
203           if (i - 1) = 1 then //显示状态条，本示例是第三栏显示，
204           begin
205             DrawSubItem(LV, Item, i, StrToFloatDef(Item.SubItems[i - 1], 0), 100, 0, True, clMedGray);
206           end
207           else
208           begin
209             //画SubItem的文字
210             InflateRect(Rect, -2, -2);
211 
212             if i - 1 <= Item.SubItems.Count - 1 then
213               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);
214           end;
215         end;
216     end; //end case
217   end; //end for
218   LV.Canvas.Brush.Color := clWhite;
219 
220   if Item.Selected then //画选中条外框
221   begin
222     if cdsFocused in State then//控件是否处于激活状态
223       LV.Canvas.Brush.Color := $00DAA07A // $00E2B598; //clHighlight;
224     else
225       LV.Canvas.Brush.Color := $00E2B598; //$00DAA07A // clHighlight;
226     LV.Canvas.FrameRect(BoundRect); //
227   end;
228   DefaultDraw := False; //不让系统画了
229   with Sender.Canvas do
230     if Assigned(Font.OnChange) then
231       Font.OnChange(Font);
232 end;
233 
234 function TForm1.ReDrawItem(AHwndLV: HWND; AItemIndex: integer): boolean;
235 begin
236   Result := ListView_RedrawItems(AHwndLV, AItemIndex, AItemIndex);
237 end;
238 
239 end.