delphi listview 進度條

菜鳥學習筆記。好記性不如爛筆頭。老外的碼，找不到作者鏈接了，只好歸原創了，畢竟調試了嘛。：）

 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls,CommCtrl, Themes;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure ListView1CustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      var DefaultDraw: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  const
  StatusColumnIndex = 2;



implementation

{$R *.dfm}
procedure DrawStatus(DC: HDC; R: TRect; State: TCustomDrawState; Font: TFont;
  const Txt: String; Progress: Single);
var
  TxtRect: TRect;
  S: String;
  Details: TThemedElementDetails;
  SaveBrush: HBRUSH;
  SavePen: HPEN;
  TxtFont: TFont;
  SaveFont: HFONT;
  SaveTextColor: COLORREF;
begin
  FillRect(DC, R, 0);
  InflateRect(R, -1, -1);
  TxtRect := R;
  S := Format('%s %.1f%%', [Txt, Progress * 100]);
  if ThemeServices.ThemesEnabled then
  begin
    Details := ThemeServices.GetElementDetails(tpBar);
    ThemeServices.DrawElement(DC, Details, R, nil);
    InflateRect(R, -2, -2);
    R.Right := R.Left + Trunc((R.Right - R.Left) * Progress);
    Details := ThemeServices.GetElementDetails(tpChunk);
    ThemeServices.DrawElement(DC, Details, R, nil);
  end
  else
  begin
    SavePen := SelectObject(DC, CreatePen(PS_NULL, 0, 0));
    SaveBrush := SelectObject(DC, CreateSolidBrush($00EBEBEB));
    Inc(R.Right);
    Inc(R.Bottom);
    RoundRect(DC, R.Left, R.Top, R.Right, R.Bottom, 3, 3);
    R.Right := R.Left + Trunc((R.Right - R.Left) * Progress);
    DeleteObject(SelectObject(DC, CreateSolidBrush($00FFC184)));
    RoundRect(DC, R.Left, R.Top, R.Right, R.Bottom, 3, 3);
    if R.Right > R.Left + 3 then
      Rectangle(DC, R.Right - 3, R.Top, R.Right, R.Bottom);
    DeleteObject(SelectObject(DC, SaveBrush));
    DeleteObject(SelectObject(DC, SavePen));
  end;
  TxtFont := TFont.Create;
  try
    TxtFont.Assign(Font);
    TxtFont.Height := TxtRect.Bottom - TxtRect.Top;
    TxtFont.Color := clGrayText;
    SetBkMode(DC, TRANSPARENT);
    SaveFont := SelectObject(DC, TxtFont.Handle);
    SaveTextColor := SetTextColor(DC, GetSysColor(COLOR_GRAYTEXT));
    DrawText(DC, PChar(S), -1, TxtRect, DT_SINGLELINE or DT_CENTER or
      DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX);
    SetBkMode(DC, TRANSPARENT);
  finally
    DeleteObject(SelectObject(DC, SaveFont));
    SetTextColor(DC, SaveTextColor);
    TxtFont.Free;
  end;
end;
procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
var
  ListView: TListView absolute Sender;
  R: TRect;
begin
  DefaultDraw := SubItem <> StatusColumnIndex;
  if not DefaultDraw then
  begin
    ListView_GetSubItemRect(ListView.Handle, Item.Index, SubItem,
      LVIR_BOUNDS, @R);
    DrawStatus(ListView.Canvas.Handle, R, State, ListView.Font, 'Downloading',
      Random(101) / 100);
  end;
end;
end.