ListView 百分比进度条(delphi版）

在看代码之前先给大家附上效果图：

废话不多说了，直接给大家贴代码了。

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ImgList;
type
TForm1 = class(TForm)
btn1: TButton;
lv1: TListView;
trckbr1: TTrackBar;
il1: TImageList;
procedure lv1CustomDraw(Sender: TCustomListView; const ARect: TRect; var DefaultDraw: Boolean);
procedure lv1CustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure btn1Click(Sender: TObject);
procedure trckbr1Change(Sender: TObject);
private
function ReDrawItem(HwndLV: HWND; ItemIndex: integer): boolean;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
CommCtrl;
{$R *.dfm}
//画状态条
procedure DrawSubItem(LV: TListView; Item: TListItem; SubItem: Integer; Prosition: Single; Max, Style: Integer; IsShowProgress: Boolean; DrawColor: TColor = $00005B00; FrameColor: TColor = $00002F00);
//获取SubItem的区域
function GetItemRect(hWndLV: HWnd; iItem, iSubItem: Integer): TRect;
var
Rect: TRect;
begin
ListView_GetSubItemRect(hWndLV, iItem, iSubItem, iSubItem, @Rect);
Result := Rect;
end;
var
PaintRect, R: TRect;
i, iWidth, x, y: Integer;
S: string;
begin
with lv do
begin
PaintRect := GetItemRect(lv.Handle, Item.Index, SubItem);
R := PaintRect;
if Prosition >= Max then
Prosition := 100
else
begin
if Prosition <= 0 then
Prosition := 0
else
Prosition := Round((Prosition / MAX) * 100);
end;
if (Prosition = 0) and (not IsShowProgress) then
Canvas.FillRect(r) //如果是0 ，直接显示空白
else
begin
//先填充背景
Canvas.FillRect(r);
Canvas.Brush.Color := Color;
//画一个外框
InflateRect(R, -2, -2);
Canvas.Brush.Color := FrameColor;
Canvas.FrameRect(R);
Canvas.Brush.Color := Color;
InflateRect(R, -1, -1);
//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; //case 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;
procedure TForm1.lv1CustomDraw(Sender: TCustomListView; const ARect: TRect; var DefaultDraw: Boolean);
begin
end;
//上面是画进度条的，现在要给TlistView处理Item重绘的消息，事件是OnCustomDrawItem，需要说明的是，如果想要随心所欲的自画Item，那么就要全部自己来完成，不再需要系统来处理：
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);
//再画Caption的文字
InflateRect(Rect, -(5 + il1.Width), 0); //向后移3个像素,避免被后面画线框时覆盖
//InflateRect(Rect, -(5), 0); //向后移3个像素,避免被后面画线框时覆盖
DrawText(LV.Canvas.Handle, PAnsiChar(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);
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(HwndLV: HWND; ItemIndex: integer): boolean;
begin
Result := ListView_RedrawItems(HwndLV, ItemIndex, ItemIndex);
end;
procedure TForm1.btn1Click(Sender: TObject);
var
Item: TListItem;
begin
//使用：
item := LV1.Items[1];
if Item = nil then
Exit;
item.subitems[1] := '30'; //设置为30%
//然后刷新这个item
ReDrawItem(LV1.handle, Item.Index);
end;
procedure TForm1.trckbr1Change(Sender: TObject);
var
Item: TListItem;
begin
//使用：
item := LV1.Items[0];
item.subitems[1] := IntToStr(trckbr1.Position);
//然后刷新这个item
ReDrawItem(LV1.handle, Item.Index);
end;
end. 

object Form1: TForm1
Left = 416
Top = 301
Width = 494
Height = 170
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object btn1: TButton
Left = 272
Top = 96
Width = 75
Height = 25
Caption = 'btn1'
TabOrder = 0
OnClick = btn1Click
end
object lv1: TListView
Left = 16
Top = 8
Width = 457
Height = 81
Columns = <
item
Caption = '名称'
Width = 100
end
item
Caption = '分类'
Width = 100
end
item
Caption = '进度'
Width