本文整理自网络，侵删。
代码参考互联网，本人在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;
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
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.
来源：https://www.cnblogs.com/pchmonster/ 相关阅读 >>
Delphi 多核机器上编程实现将指定进程pid放到指定cpu上运行
Delphi enablecontrols,disablecontrols函数
用Delphi通过setupapi.dll列举和停用硬件设备
Delphi cxdbtreelist1判断当父节点含有子节点时 不能删除此父节点
更多相关阅读请进入《Delphi》频道 >>
